simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compiler research (#10)

Browse source 
adds self-hosted compiler is functionally:
 
- The default compile path is the portable pipeline using jolt.analyzer (Clojure) → host-neutral IR → backend.janet.
- The analyzer is itself Clojure, compiled by jolt for true self-hosting.
- bootstrap-fixpoint passes (stage1 == stage2 == stage3): rebuilding the compiler on its own output.
- clojure.core is now self-hosted in the overlay.
- Stateful forms (defmacro/ns/deftype/defmulti/require/in-ns) are interpreted by design.
This commit is contained in:
Dmitri Sotnikov 2026-06-09 07:30:25 +08:00 • committed by GitHub
parent 607779866e
commit d3194aae59
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
68 changed files with 6590 additions and 2019 deletions
Download patch file Download diff file Expand all files Collapse all files

46
jolt-core/clojure/core/00-kernel.clj Normal file
View file

@ -0,0 +1,46 @@
;; clojure.core — kernel tier (stage just above the Janet seed).
;;
;; These are the structural fns the self-hosted compiler itself uses
;; (jolt.analyzer): second/peek/subvec/mapv/update. Because the compiler must be
;; able to compile the *rest* of clojure.core, anything it calls has to exist
;; before it is built. So this tier is loaded FIRST and, in compile mode, is
;; bootstrap-compiled directly into clojure.core (not routed through the
;; self-hosted pipeline, which would need these to already exist — the
;; circularity that previously forced `second` to stay in Janet). With this tier
;; in place the analyzer is built against the Clojure definitions and the Janet
;; primitives are gone.
;;
;; Constraint: depend only on core-renames primitives (first/next/nth/count/conj/
;; vec/map/apply/assoc/get/…, all hardwired to the Janet seed) and on each other.
(defn second [coll] (first (next coll)))
(defn peek [coll]
(cond
(nil? coll) nil
;; vectors (incl. jolt's eager seq results): last element; lists/seqs: first.
(vector? coll) (if (zero? (count coll)) nil (nth coll (dec (count coll))))
(seq? coll) (first coll)
:else (throw (str "peek not supported on: " coll))))
(defn subvec
([v start] (subvec v start (count v)))
([v start end]
(when (not (vector? v)) (throw (str "subvec requires a vector")))
;; Clojure coerces indices with (int ...): NaN -> 0, floats/ratios truncate
;; toward zero ((quot x 1)); non-numbers throw. Only then range-check.
(let [coerce (fn [x]
(cond
(not (number? x)) (throw (str "subvec index must be a number"))
(not= x x) 0
:else (quot x 1)))
s (coerce start)
e (coerce end)]
(when (or (< s 0) (< e s) (< (count v) e))
(throw (str "subvec index out of range: " s " " e)))
(loop [i s acc []]
(if (< i e) (recur (inc i) (conj acc (nth v i))) acc)))))
(defn mapv [f & colls] (vec (apply map f colls)))
(defn update [m k f & args] (assoc m k (apply f (get m k) args)))

345
jolt-core/clojure/core/00-syntax.clj Normal file
View file

@ -0,0 +1,345 @@
;; clojure.core — syntax tier. The control macros the compiler and every later
;; tier depend on (when/cond/and/or/...), expressed as defmacro. Loaded FIRST
;; (before 00-kernel), interpreted, so the macros exist before any code that uses
;; them is compiled — including the kernel tier, the self-hosted analyzer, and the
;; seq/coll tiers.
;;
;; CONSTRAINT: a macro here may use ONLY special forms (if/do/let*/fn*/not) and
;; core-renames SEED primitives (first/next/rest/nth/count/empty?/...). It must
;; NOT use kernel-tier fns (second/peek/subvec/...) or anything defined later —
;; those don't exist yet when this tier loads.
(defmacro when [test & body]
`(if ~test (do ~@body)))
(defmacro when-not [test & body]
`(if (not ~test) (do ~@body)))
(defmacro and [& exprs]
(if (empty? exprs)
true
(if (empty? (rest exprs))
(first exprs)
`(let* [and# ~(first exprs)] (if and# (and ~@(rest exprs)) and#)))))
(defmacro or [& exprs]
(if (empty? exprs)
nil
(if (empty? (rest exprs))
(first exprs)
`(let* [or# ~(first exprs)] (if or# or# (or ~@(rest exprs)))))))
;; :else (any truthy value) is just a test, so no special case — (if :else e ...)
;; takes e.
(defmacro cond [& clauses]
(if (empty? clauses)
nil
`(if ~(first clauses) ~(nth clauses 1) (cond ~@(drop 2 clauses)))))
;; Threading: a list form threads x in as the first (->) or last (->>) arg; a bare
;; symbol becomes (form x). Recursive; the expand-once cache makes that free.
(defmacro -> [x & forms]
(if (empty? forms)
x
(let [form (first forms)
threaded (if (seq? form)
`(~(first form) ~x ~@(rest form))
`(~form ~x))]
`(-> ~threaded ~@(rest forms)))))
(defmacro ->> [x & forms]
(if (empty? forms)
x
(let [form (first forms)
threaded (if (seq? form)
`(~(first form) ~@(rest form) ~x)
`(~form ~x))]
`(->> ~threaded ~@(rest forms)))))
;; Forward declaration is a no-op on Jolt — the compiler resolves forward refs via
;; pending cells (matching the prior Janet macro).
(defmacro declare [& syms] `(do))
;; destructure — Clojure's binding-vector expander, ported from the Janet seed
;; (was core-destructure). Turns a binding vector that may contain destructuring
;; patterns into a plain binding vector (alternating symbol / init-form) built from
;; nth/nthnext/get, so the COMPILER only ever sees plain symbols (analyze-bindings
;; rejects patterns). `let` consumes it directly; `loop`/`fn` reuse it transitively
;; through `let`. Written with let*/fn* and seed primitives only — it never uses
;; let/loop/fn, so expanding its own body can't recurse back into destructure.
;; Note map? is true for symbol structs too, so the symbol? clause must come first.
;; def+fn* (not defn) because the defn macro is not defined until later in the tier.
(def destructure
(fn* destructure [bindings]
(let* [find-or
(fn* [or-map nm]
(reduce (fn* [acc k]
(if (and (symbol? k) (= nm (name k)))
[true (get or-map k)]
acc))
[false nil]
(if or-map (keys or-map) [])))
amp? (fn* [x] (and (symbol? x) (= "&" (name x))))
proc
(fn* proc [pat init acc]
(cond
(symbol? pat) (conj (conj acc pat) init)
(vector? pat)
(let* [g (symbol (str (gensym)))
n (count pat)
vloop
(fn* vloop [i idx a]
(if (< i n)
(let* [elem (nth pat i)]
(cond
(amp? elem)
(vloop (+ i 2) idx (proc (nth pat (inc i)) `(nthnext ~g ~idx) a))
(= elem :as)
(vloop (+ i 2) idx (proc (nth pat (inc i)) g a))
:else
(vloop (inc i) (inc idx) (proc elem `(nth ~g ~idx nil) a))))
a))]
(vloop 0 0 (conj (conj acc g) init)))
(map? pat)
(let* [g (symbol (str (gensym)))
or-map (get pat :or)
as-sym (get pat :as)
base (if as-sym
(conj (conj (conj (conj acc g) init) as-sym) g)
(conj (conj acc g) init))
group
(fn* [a kw kind]
(let* [names (get pat kw)]
(if names
(reduce
;; s is a symbol (a b) or a keyword (:a :b); name/
;; namespace handle both, so :keys [:major] binds
;; `major` looking up :major (str would keep the colon).
(fn* [aa s]
(let* [local (name s)
nsp (namespace s)
keyform (cond
(= kind :kw) (keyword (if nsp (str nsp "/" local) local))
(= kind :str) local
:else `(quote ~(symbol nsp local)))
fo (find-or or-map local)]
(conj (conj aa (symbol local))
(if (nth fo 0)
`(get ~g ~keyform ~(nth fo 1))
`(get ~g ~keyform)))))
a names)
a)))
g1 (group base :keys :kw)
g2 (group g1 :strs :str)
g3 (group g2 :syms :sym)]
(reduce (fn* [a k]
(if (keyword? k)
a
(proc k `(get ~g ~(get pat k)) a)))
g3 (keys pat)))
:else (throw (str "unsupported destructuring pattern"))))
ploop
(fn* ploop [i acc]
(if (< i (count bindings))
(ploop (+ i 2) (proc (nth bindings i) (nth bindings (inc i)) acc))
acc))]
(ploop 0 []))))
;; let desugars destructuring patterns to plain bindings (via destructure) so the
;; COMPILER sees only plain symbols — analyze-bindings rejects patterns as
;; uncompilable, relying on this macro to have expanded them. (The interpreter
;; could destructure let* directly, but the compiler can't.) let* is sequential, so
;; a later init can reference an earlier destructured name. Splice via [~@..] so the
;; binding vector is a tuple form (destructure returns a pvec), not a pvec literal.
(defmacro let [bindings & body]
`(let* [~@(destructure bindings)] ~@body))
;; loop binds destructuring forms like let, but recur must target the loop* vars,
;; whose count can't change. So (matching Clojure): gensym one loop var per binding,
;; loop* over those, and destructure them via an inner let each iteration; an outer
;; let establishes the destructured names so later inits can see them. Plain loops
;; (no patterns) pass straight through to loop*.
(defmacro loop [bindings & body]
(let [d (destructure bindings)]
(if (= d bindings)
`(loop* ~bindings ~@body)
(let [bs (take-nth 2 bindings)
vs (take-nth 2 (drop 1 bindings))
gs (map (fn [b] (if (symbol? b) b (symbol (str (gensym))))) bs)
outer (reduce (fn [acc t]
(let [b (nth t 0) v (nth t 1) g (nth t 2)]
(if (symbol? b) (conj (conj acc g) v)
(conj (conj (conj (conj acc g) v) b) g))))
[] (map vector bs vs gs))
inner (reduce (fn [acc t] (conj (conj acc (nth t 0)) (nth t 1)))
[] (map vector bs gs))
loopv (reduce (fn [acc g] (conj (conj acc g) g)) [] gs)]
;; splice via [~@..] so the binding vectors are tuple forms, not pvecs.
`(let [~@outer] (loop* [~@loopv] (let [~@inner] ~@body)))))))
;; fn: desugar destructuring params to plain symbols + a body let (matching
;; Clojure's maybe-destructured), so fn* only ever sees plain params (the compiler's
;; analyze-fn requires that). Plain params pass through untouched. Handles an
;; optional name and single- or multi-arity. md/mk are fn* (not fn) to avoid a cycle.
;; md walks a param seq, replacing non-symbol patterns with gensyms and recording
;; [pattern gensym] let-bindings; mk turns one arity (params . body) into a rewritten
;; arity. Output: single arity splices the arity's elements straight into fn*; multi
;; arity splices the rewritten clauses.
(defmacro fn [& raw]
(let [nm (if (symbol? (first raw)) (first raw) nil)
aftn (if nm (next raw) raw)
md (fn* go [ps nps lets]
(if (seq ps)
(if (symbol? (first ps))
(go (next ps) (conj nps (first ps)) lets)
;; bare (gensym) here is Janet's (a Janet symbol the destructurer
;; rejects); round-trip through str for a jolt symbol.
(let [g (symbol (str (gensym)))]
(go (next ps) (conj nps g) (conj (conj lets (first ps)) g))))
[nps lets]))
mk (fn* [sig]
(let [r (md (seq (first sig)) [] [])]
(if (empty? (nth r 1))
sig
;; build the params/let vectors via [~@..] so they are tuple forms
;; (the accumulators are plain seqs, the wrong representation).
(let [pv `[~@(nth r 0)]
lv `[~@(nth r 1)]]
`(~pv (let ~lv ~@(rest sig)))))))]
(if (vector? (first aftn))
(let [a (mk aftn)]
(if nm `(fn* ~nm ~@a) `(fn* ~@a)))
(let [as (vec (map mk aftn))]
(if nm `(fn* ~nm ~@as) `(fn* ~@as))))))
;; defn: drop an optional leading docstring and attr-map, then (def name (fn* ...)).
;; Both single- and multi-arity reduce to (fn* ~@body) — fn* takes either a params
;; vector + body or a sequence of ([params] body) clauses, so no arity branching is
;; needed. (map? is true for symbol forms too, so guard the attr-map with symbol?.)
;; Defined before fresh-sym below, which is a defn-.
(defmacro defn [fn-name & body]
(let [body (if (and (seq body) (string? (first body))) (rest body) body)
body (if (and (seq body) (map? (first body)) (not (symbol? (first body))))
(rest body) body)]
`(def ~fn-name (fn* ~@body))))
;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
;; defn- delegates to defn with :private metadata).
(defmacro defn- [fn-name & body] `(defn ~fn-name ~@body))
;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a Janet symbol
;; the destructurer rejects). This defn compiles fine: by the time a tier triggers
;; the analyzer build the kernel is in place (the build is gated until then).
(defn- fresh-sym [] (symbol (str (gensym))))
;; cond->: thread expr through each (test form) pair, only when the test is truthy.
;; Linear nested let*, a distinct fresh symbol per step.
(defmacro cond-> [expr & clauses]
(let [step (fn step [prev cls]
(if (empty? cls)
prev
(let [t (first cls)
f (nth cls 1)
gn (fresh-sym)
call (if (seq? f) `(~(first f) ~prev ~@(rest f)) `(~f ~prev))]
`(let* [~gn (if ~t ~call ~prev)] ~(step gn (drop 2 cls))))))
g0 (fresh-sym)]
`(let* [~g0 ~expr] ~(step g0 clauses))))
;; case: nested =/or tests (no jump table). Test constants are NOT evaluated —
;; symbols and list constants are quoted; a list in test position is a set (or).
(defmacro case [expr & clauses]
(let [g (fresh-sym)
mk-const (fn [c] (if (or (symbol? c) (seq? c)) `(quote ~c) c))
mk-test (fn [c]
(if (seq? c)
`(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
`(= ~g ~(mk-const c))))
build (fn build [cls]
(if (empty? cls)
nil
(if (empty? (rest cls))
(first cls)
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
`(let* [~g ~expr] ~(build clauses))))
;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in
;; take-while. The last group with no modifiers is a plain map (no flatten needed).
;; Faithful port of the prior Janet macro (single body expr). The body uses only
;; kernel/seed fns so it runs at analyzer-build time. `fn` (not fn*) carries the
;; binding so destructuring forms work.
(defmacro for [bindings body]
(let [scan (fn scan [bvec i bind coll mods]
(if (and (< i (count bvec)) (keyword? (nth bvec i)))
(let [k (nth bvec i)
v (nth bvec (inc i))]
(cond
(= k :when) (scan bvec (+ i 2) bind coll (conj mods [:when v]))
(= k :let) (scan bvec (+ i 2) bind coll (conj mods [:let v]))
(= k :while) (scan bvec (+ i 2) bind `(take-while (fn [~bind] ~v) ~coll) mods)
:else (scan bvec (inc i) bind coll mods)))
[i bind coll mods]))
parse-groups (fn parse-groups [bvec i groups]
(if (>= i (count bvec))
groups
(let [r (scan bvec (+ i 2) (nth bvec i) (nth bvec (inc i)) [])]
(parse-groups bvec (nth r 0)
(conj groups [(nth r 1) (nth r 2) (nth r 3)])))))
;; Apply the group's modifiers around a contribution that is ALREADY a seq
;; (a (list body) for the last group, an inner comprehension otherwise), so
;; :when just returns it or [] — no extra (list ...) that mapcat couldn't
;; flatten. :let binds around it; mods apply outer-to-inner (left to right).
wrap-mods (fn wrap-mods [mods inner]
(if (empty? mods)
inner
(let [m (first mods)
sub (wrap-mods (rest mods) inner)]
(if (= (first m) :when)
`(if ~(nth m 1) ~sub [])
`(let* ~(nth m 1) ~sub)))))
build (fn build [idx groups]
(let [g (nth groups idx)
my-bind (nth g 0)
my-coll (nth g 1)
my-mods (nth g 2)
is-last (= idx (dec (count groups)))]
(if (and is-last (empty? my-mods))
;; fast path: last group, no modifiers -> a plain map of body
`(map (fn [~my-bind] ~body) ~my-coll)
;; general: mapcat over a seq contribution (wrap a last-group
;; body in a one-element list so mapcat yields the bodies).
(let [base (if is-last `(list ~body) (build (inc idx) groups))]
`(mapcat (fn [~my-bind] ~(wrap-mods my-mods base)) ~my-coll)))))]
(if (>= (count bindings) 2)
(build 0 (parse-groups bindings 0 []))
body)))
;; doseq runs body for side effects across the bindings, returning nil. Same
;; shortcut as the prior Janet macro: realize a `for` comprehension with count
;; (for handles :when/:let/:while and multiple bindings).
(defmacro doseq [bindings & body]
`(do (count (for ~bindings (do ~@body nil))) nil))
;; when-let must live in this (early) tier, not 30-macros with its if-let/if-some/
;; when-some siblings: 20-coll uses it (not-empty), and 20-coll loads before 30. The
;; name binds only in the taken branch (temp# tests the value); via `let` so the
;; binding form may itself destructure, matching Clojure.
(defmacro when-let [bindings & body]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp# (let [~form temp#] ~@body) nil))))
;; lazy-seq / lazy-cat live here (not 30-macros) because the seq/coll tiers use
;; them and compile-as-they-load: the macro must be registered before those tiers
;; or (lazy-seq …) compiles to a call of the macro-as-function and leaks its
;; expansion at runtime (jolt-r81). They use only seed fns (make-lazy-seq/
;; coll->cells/concat) + map, all available from the start.
;; lazy-seq defers its body: make-lazy-seq holds a thunk that realizes the body
;; to cells when forced. lazy-cat wraps each coll in a lazy-seq and concats.
(defmacro lazy-seq [& body]
`(make-lazy-seq (fn* [] (coll->cells (do ~@body)))))
(defmacro lazy-cat [& colls]
`(concat ~@(map (fn [c] `(lazy-seq ~c)) colls)))

61
jolt-core/clojure/core/10-seq.clj Normal file
View file

@ -0,0 +1,61 @@
;; clojure.core — seq tier. Pure-Clojure leaf sequence fns on top of the kernel
;; tier (00-kernel) and the Janet seed. Loaded after the kernel tier; in compile
;; mode these self-host through the now-built analyzer (interpreted otherwise).
;;
;; Migration rule for adding fns here: the fn must (1) NOT be in
;; compiler/core-renames (that map emits core-X Janet symbols directly), (2) have
;; no internal Janet callers of its core-X binding, and (3) NOT be used by the
;; self-hosted compiler (jolt-core/jolt/*.clj). Compiler-facing structural fns go
;; in the kernel tier (00-kernel) instead — see its header.
(defn ffirst [coll] (first (first coll)))
(defn nfirst [coll] (next (first coll)))
(defn fnext [coll] (first (next coll)))
(defn nnext [coll] (next (next coll)))
;; Canonical Clojure defs: pure first/next/loop/recur, no Janet realize-for-iteration.
(defn last [s]
(if (next s) (recur (next s)) (first s)))
(defn butlast [s]
(loop [ret [] s s]
(if (next s)
(recur (conj ret (first s)) (next s))
(seq ret))))
;; partition-by: (partition-by f) is a stateful transducer (buffer a run, emit on
;; key change, flush on completion — via volatiles, matching Clojure); (partition-by
;; f coll) is the lazy collection arity.
(defn partition-by
([f]
(fn [rf]
(let [buf (volatile! [])
pv (volatile! nil)
started (volatile! false)]
(fn
([] (rf))
([result]
(let [b @buf
result (if (zero? (count b))
result
(do (vreset! buf []) (unreduced (rf result b))))]
(rf result)))
([result input]
(let [val (f input)]
(if (or (not @started) (= val @pv))
(do (vreset! started true) (vreset! pv val) (vswap! buf conj input) result)
(let [b @buf]
(vreset! buf []) (vreset! pv val)
(let [ret (rf result b)]
(when-not (reduced? ret) (vswap! buf conj input))
ret)))))))))
([f coll]
(let [step (fn step [s]
(lazy-seq
(let [s (seq s)]
(when s
(let [fst (first s)
fv (f fst)
run (cons fst (take-while (fn [x] (= fv (f x))) (rest s)))]
(cons run (step (lazy-seq (drop (count run) s)))))))))]
(step coll))))

345
jolt-core/clojure/core/20-coll.clj Normal file
View file

@ -0,0 +1,345 @@
;; clojure.core — collection tier. Pure, eager fns expressed as compositions of
;; already-frozen core primitives (reduce/assoc/get/conj/filter/vec/count/>=).
;; No host internals, no laziness, no macros — so they compile cleanly and stay
;; redefinable. Loaded after the seq tier; self-hosted in compile mode.
;;
;; Same migration rule as the seq tier (see 10-seq.clj): not in core-renames, no
;; internal Janet callers, not used by the self-hosted compiler.
;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't
;; canonicalize collection keys across representations (a {:a 1} literal vs
;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection
;; value needs the PHM base (the prior Janet impl used make-phm for this reason).
(defn frequencies [coll]
(reduce (fn [counts x] (assoc counts x (inc (get counts x 0)))) (hash-map) coll))
(defn group-by [f coll]
(reduce (fn [ret x] (let [k (f x)] (assoc ret k (conj (get ret k []) x)))) (hash-map) coll))
(defn not-empty [coll]
(if (or (nil? coll) (zero? (count coll))) nil coll))
(defn filterv [pred coll]
(vec (filter pred coll)))
;; Greatest/least x by (k x). Canonical Clojure multi-arity: the first pair uses
;; strict < / > and the fold uses <= / >= — this exact ordering reproduces the
;; JVM IEEE-754 NaN behavior (e.g. (min-key identity 1 ##NaN) => ##NaN). > / <
;; throw on non-numbers, as Clojure does.
(defn max-key
([k x] x)
([k x y] (if (> (k x) (k y)) x y))
([k x y & more]
(let [kx (k x) ky (k y)
v (if (> kx ky) x y)
kv (if (> kx ky) kx ky)]
(loop [v v kv kv more more]
(if (seq more)
(let [w (first more) kw (k w)]
(if (>= kw kv) (recur w kw (next more)) (recur v kv (next more))))
v)))))
(defn min-key
([k x] x)
([k x y] (if (< (k x) (k y)) x y))
([k x y & more]
(let [kx (k x) ky (k y)
v (if (< kx ky) x y)
kv (if (< kx ky) kx ky)]
(loop [v v kv kv more more]
(if (seq more)
(let [w (first more) kw (k w)]
(if (<= kw kv) (recur w kw (next more)) (recur v kv (next more))))
v)))))
;; Function combinators (pure HOFs).
(defn juxt [& fs]
(fn [& args] (mapv (fn [f] (apply f args)) fs)))
(defn every-pred [& preds]
(fn [& xs] (every? (fn [p] (every? p xs)) preds)))
(defn some [pred coll]
(when-let [s (seq coll)]
(or (pred (first s)) (recur pred (next s)))))
(defn some-fn [& preds]
(fn [& xs] (some (fn [p] (some p xs)) preds)))
(defn not-any? [pred coll] (not (some pred coll)))
(defn not-every? [pred coll] (not (every? pred coll)))
(defn split-at [n coll] [(take n coll) (drop n coll)])
(defn split-with [pred coll] [(take-while pred coll) (drop-while pred coll)])
(defn ident? [x] (or (keyword? x) (symbol? x)))
(defn qualified-ident? [x] (or (qualified-symbol? x) (qualified-keyword? x)))
(defn simple-ident? [x] (or (simple-symbol? x) (simple-keyword? x)))
;; Jolt has no ratio or bigdecimal types, so these are constants / reduce to int?.
(defn ratio? [x] false)
(defn decimal? [x] false)
(defn rational? [x] (int? x))
(defn nat-int? [x] (and (int? x) (>= x 0)))
(defn neg-int? [x] (and (int? x) (neg? x)))
(defn pos-int? [x] (and (int? x) (pos? x)))
(defn replicate [n x] (map (fn [_] x) (range n)))
(defn take-last [n coll]
(let [c (vec coll) len (count c)]
(when (pos? len) (subvec c (max 0 (- len n))))))
(defn drop-last
([coll] (drop-last 1 coll))
([n coll] (let [c (vec coll)] (subvec c 0 (max 0 (- (count c) n))))))
(defn distinct?
([x] true)
([x y] (not (= x y)))
([x y & more]
(if (not (= x y))
(loop [s #{x y} xs more]
(if xs
(let [x (first xs)]
(if (contains? s x) false (recur (conj s x) (next xs))))
true))
false)))
(defn replace [smap coll] (mapv (fn [x] (get smap x x)) coll))
(defn nthnext [coll n]
(loop [n n xs (seq coll)]
(if (and xs (pos? n))
(recur (dec n) (next xs))
xs)))
(defn bounded-count [n coll] (min n (count coll)))
(defn run! [proc coll] (reduce (fn [_ x] (proc x) nil) nil coll) nil)
(defn completing
([f] (completing f identity))
([f cf] (fn ([] (f)) ([x] (cf x)) ([x y] (f x y)))))
;; Matches Clojure exactly: n<=0 returns coll unchanged; for n>0 the walk yields
;; (seq xs), and an exhausted/nil walk falls back to () via (or ... ()) — so
;; (nthrest nil 100) is () (not nil), while (nthrest nil 0) is nil.
(defn nthrest [coll n]
(if (pos? n)
(or (loop [n n xs coll]
(let [s (and (pos? n) (seq xs))]
(if s (recur (dec n) (rest s)) (seq xs))))
(list))
coll))
(defn abs [x] (if (neg? x) (- 0 x) x))
(defn NaN? [x]
(if (number? x) (not (= x x)) (throw (str "NaN? requires a number"))))
;; No distinct host object / undefined types on Jolt.
(defn object? [x] false)
(defn undefined? [x] false)
(defn keyword-identical? [a b] (= a b))
(defn comparator [pred]
(fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
;; Lazy: the running accumulators, one at a time (matches Clojure).
(defn reductions
([f coll]
(lazy-seq
(let [s (seq coll)]
(if s
(reductions f (first s) (rest s))
(list (f))))))
([f init coll]
(cons init
(lazy-seq
(when-let [s (seq coll)]
(reductions f (f init (first s)) (rest s)))))))
;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
;; via the (now lazy) mapcat.
(defn tree-seq [branch? children root]
(let [walk (fn walk [node]
(lazy-seq
(cons node
(when (branch? node)
(mapcat walk (children node))))))]
(walk root)))
;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
;; Flattens lists too (sequential?), matching Clojure/CLJS.
(defn flatten [coll]
(filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
(defn xml-seq [root]
(tree-seq (complement string?) (comp seq :content) root))
;; Lazy interleave: round-robin one element from each coll until any exhausts.
(defn interleave
([] ())
([c1] (lazy-seq c1))
([c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
(when (and s1 s2)
(cons (first s1)
(cons (first s2)
(interleave (rest s1) (rest s2))))))))
([c1 c2 & cs]
(lazy-seq
(let [ss (map seq (list* c1 c2 cs))]
(when (every? identity ss)
(concat (map first ss)
(apply interleave (map rest ss))))))))
;; No ratio type on Jolt, so rationalize is identity.
(defn rationalize [x] x)
;; trampoline: repeatedly calls f with args until a non-function result.
;; rand-int: random integer in [0, n). Uses Janet math/random.
;; Eager dedupe of consecutive equal elements (Jolt has no transducer arity yet).
(defn dedupe [coll]
(let [step (fn step [s prev]
(make-lazy-seq
(fn* []
(let [s (seq s)]
(if s
(let [x (first s)]
(if (= x prev)
(coll->cells (step (rest s) prev))
(coll->cells (cons x (step (rest s) x)))))
nil)))))]
(let [s (seq coll)]
(if s
(make-lazy-seq
(fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
()))))
;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs:
;; builds a map from consecutive pairs, dropping a trailing unpaired element.
(defn seq-to-map-for-destructuring [s]
(if (sequential? s)
(loop [m {} xs (seq s)]
(if (and xs (next xs))
(recur (assoc m (first xs) (second xs)) (next (next xs)))
m))
s))
;; Phase 4 (jolt-1j0): host-coupled fns that are pure logic over existing core
;; primitives, so they need no new jolt.host surface.
;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
;; with-meta are the irreducible host primitives; vary-meta is just their compose.
(defn vary-meta [obj f & args]
(with-meta obj (apply f (meta obj) args)))
;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
(defn namespace-munge [s]
(apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
;; so reduced short-circuits — and the vector path indexes correctly. (The prior
;; Janet version saw a pvec as a table and folded over its internal keys; it also
;; ignored reduced.) nil folds to init, matching Clojure.
(defn reduce-kv [f init coll]
(cond
(vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
(map? coll) (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
(nil? coll) init
:else (throw (str "reduce-kv not supported on: " coll))))
;; ex-info accessors. The Janet constructor (ex-info) stays — it builds the tagged
;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
(defn- ex-unwrap [e]
(if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
(defn ex-data [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
(defn ex-message [e]
(let [e (ex-unwrap e)]
(cond (ex-info-val? e) (get e :message)
(string? e) e
:else nil)))
(defn ex-cause [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
;; Tagged-value predicates. The constructors (atom/volatile!/...) stay in Janet,
;; but every tagged value carries its kind under :jolt/type (records under
;; :jolt/deftype), reachable via get — which is nil on non-tables — so the
;; predicates are pure over get and move out of the seed.
(defn atom? [x] (= (get x :jolt/type) :jolt/atom))
(defn volatile? [x] (= (get x :jolt/type) :jolt/volatile))
(defn reader-conditional? [x] (= (get x :jolt/type) :jolt/reader-conditional))
(defn tagged-literal? [x] (= (get x :jolt/type) :jolt/tagged-literal))
(defn record? [x] (some? (get x :jolt/deftype)))
;; Jolt has no chunked seqs (Phase 5 territory), so this is always false.
(defn chunked-seq? [x] false)
;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
;; the native ops (which already validate and notify watches); get-validator reads a
;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
;; mutation kernel the overlay can't express over core fns (a nil value removes the
;; key). compare-and-set! compares by value, matching the prior Janet behavior.
(defn swap-vals! [a f & args]
(let [old (deref a)] [old (apply swap! a f args)]))
(defn reset-vals! [a newval]
(let [old (deref a)] (reset! a newval) [old newval]))
(defn compare-and-set! [a oldval newval]
(if (= oldval (deref a)) (do (reset! a newval) true) false))
(defn get-validator [a] (get a :validator))
(defn add-watch [a key f]
(jolt.host/ref-put! (get a :watches) key f) a)
(defn remove-watch [a key]
(jolt.host/ref-put! (get a :watches) key nil) a)
(defn set-validator! [a f]
(jolt.host/ref-put! a :validator f) nil)
;; Volatiles. The constructor (volatile!) stays native — it builds the mutable box —
;; but vreset! sets the box's slot through ref-put! and vswap! is pure over it + get.
(defn vreset! [vol newval]
(jolt.host/ref-put! vol :val newval) newval)
(defn vswap! [vol f & args]
(vreset! vol (apply f (get vol :val) args)))
;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
;; future? stays native (deref/future-cancel/realized? call it); future-call and
;; future-cancel stay native too (OS threads).
(defn future-done? [x]
(if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
(defn future-cancelled? [x]
(and (future? x) (boolean (get x :cancelled))))
;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
(defn ns-name [ns]
(let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
;; constructors (object-array/make-array/to-array/...) stay native — they build the
;; mutable backing.
(defn aget [arr & idxs]
(reduce (fn [v i] (nth v i)) arr idxs))
(defn alength [arr] (count arr))
(defn aset [arr & idxs+val]
(let [n (count idxs+val)
val (nth idxs+val (dec n))
target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
(jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
val))

226
jolt-core/clojure/core/30-macros.clj Normal file
View file

@ -0,0 +1,226 @@
;; clojure.core — macro tier. Macros expressed in Clojure (defmacro + syntax-quote)
;; rather than as hand-built Janet form-transformers. Loaded after the fn tiers,
;; so a macro here may use any already-frozen core fn/macro.
;;
;; IMPORTANT — only macros NOT used by the self-hosted compiler (jolt-core/jolt/*)
;; or by the earlier overlay tiers belong here; those (and/or/when/when-not/
;; when-let/cond/case/doseq/declare/cond->/->) must stay available before this
;; tier loads, so they remain in Janet for now. Everything here is user-facing.
;;
;; Migration: remove the Janet core-X macro fn AND its core-macro-names entry when
;; moving a macro here (defmacro installs the :macro flag itself).
(defmacro comment [& body] nil)
;; Single arglist (Jolt defmacro is single-arity); the optional else defaults nil
;; via rest-destructuring.
(defmacro if-not [test then & [else]]
`(if (not ~test) ~then ~else))
;; Conditional binding macros: the name is bound ONLY in the taken branch (the
;; auto-gensym temp# tests the value; the else/empty branch sees the surrounding
;; scope). temp# is a single template-local gensym — referenced twice, same symbol.
(defmacro if-let [bindings then & [else]]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if temp# (let [~form temp#] ~then) ~else))))
;; when-let lives in 00-syntax (not here): 20-coll uses it, which loads before this tier.
(defmacro if-some [bindings then & [else]]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if (some? temp#) (let [~form temp#] ~then) ~else))))
(defmacro when-some [bindings & body]
(let [form (bindings 0) tst (bindings 1)]
`(let [temp# ~tst]
(if (some? temp#) (let [~form temp#] ~@body) nil))))
(defmacro while [test & body]
`(loop [] (when ~test ~@body (recur))))
(defmacro dotimes [bindings & body]
(let [i (bindings 0) n (bindings 1)]
`(let [n# ~n]
(loop [~i 0]
(when (< ~i n#) ~@body (recur (inc ~i)))))))
;; A fresh jolt symbol inside a macro body: (gensym) here resolves to Janet's
;; builtin (a Janet symbol the destructurer rejects), so round-trip through str.
(defn- fresh-sym [] (symbol (str (gensym))))
;; Lazy-safe: take only the head via first (Clojure uses (seq coll), but Jolt's
;; eager seq would realize an infinite coll like (repeat nil) and hang). Matches
;; the prior Janet behavior; the nil/false-head distinction waits on Phase 5
;; laziness.
(defmacro when-first [bindings & body]
(let [x (bindings 0) coll (bindings 1)]
`(when-let [~x (first ~coll)] ~@body)))
;; doto threads a single fresh-bound value as the first arg of each form (side
;; effects), returning the value. A shared explicit gensym is needed because the
;; forms are built outside the let's template.
(defmacro doto [x & forms]
(let [g (fresh-sym)
steps (map (fn [f] (if (seq? f) (apply list (first f) g (rest f)) (list f g))) forms)]
`(let [~g ~x] ~@steps ~g)))
;; Threading-with-rebinding macros. The binding pairs are spliced into a TEMPLATE
;; vector (so core-let sees a tuple form, not a runtime pvec value).
(defn- thread-binds [g steps]
(reduce (fn [acc s] (conj (conj acc g) s)) [] (butlast steps)))
(defmacro as-> [expr name & forms]
(let [pairs (reduce (fn [acc f] (conj (conj acc name) f)) [] (butlast forms))]
`(let [~name ~expr ~@pairs] ~(if (empty? forms) name (last forms)))))
(defmacro some-> [expr & forms]
(let [g (fresh-sym)
steps (map (fn [f] `(if (nil? ~g) nil (-> ~g ~f))) forms)]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro some->> [expr & forms]
(let [g (fresh-sym)
steps (map (fn [f] `(if (nil? ~g) nil (->> ~g ~f))) forms)]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro cond->> [expr & clauses]
(let [g (fresh-sym)
steps (map (fn [pair] `(if ~(first pair) (->> ~g ~(second pair)) ~g))
(partition 2 clauses))]
`(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
(defmacro assert [x & [message]]
(let [msg (if message message (str "Assert failed: " (pr-str x)))]
`(when-not ~x (throw (ex-info ~msg {})))))
(defmacro delay [& body]
`(make-delay (fn [] ~@body)))
(defmacro future [& body]
`(future-call (fn [] ~@body)))
;; Build the fn* form via a template (a reader-list array): cons/list in a macro
;; body produce a plist the evaluator can't call as a form.
(defmacro letfn [fnspecs & body]
(let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec))))
[] fnspecs)]
`(let* [~@binds] ~@body)))
;; Dynamic binding: install a thread-binding frame of var->value (array-map keeps
;; var-get happy, unlike a phm), restore on exit.
(defmacro binding [bindings & body]
(let [pairs (reduce (fn [acc p] (conj (conj acc `(var ~(first p))) (second p)))
[] (partition 2 bindings))]
`(let* [frame# (array-map ~@pairs)]
(push-thread-bindings frame#)
(try (do ~@body) (finally (pop-thread-bindings))))))
;; condp: clauses are test-expr result-expr, or test-expr :>> result-fn (calls
;; result-fn on the truthy (pred test-expr value)); a lone trailing expr is the
;; default. The recursive emit builds a nested if chain.
(defmacro condp [pred expr & clauses]
(let [gp (fresh-sym) ge (fresh-sym)
emit (fn emit [args]
(let [n (if (= :>> (second args)) 3 2)
clause (take n args)
more (drop n args)
cn (count clause)]
(cond
(= 0 cn) `(throw (ex-info (str "No matching clause: " ~ge) {}))
(= 1 cn) (first clause)
(= 2 cn) `(if (~gp ~(first clause) ~ge) ~(second clause) ~(emit more))
:else `(if-let [p# (~gp ~(first clause) ~ge)]
(~(nth clause 2) p#)
~(emit more)))))]
`(let [~gp ~pred ~ge ~expr] ~(emit clauses))))
;; --- protocols, records, types ---------------------------------------------
;; These emit Jolt's protocol/type special forms (protocol-dispatch,
;; register-method, make-reified, deftype).
;; Group a flat seq that starts with a head symbol followed by its list specs
;; into [[head spec spec ...] ...] runs. Used by extend-protocol and defrecord.
(defn- group-by-head [items]
(reduce (fn [acc x]
(if (symbol? x)
(conj acc [x])
(conj (pop acc) (conj (peek acc) x))))
[] items))
;; The protocol value is built by make-protocol (a fn call) rather than an embedded
;; tagged map literal: the interpreter would otherwise self-evaluate such a struct
;; instead of evaluating its fields. methods is a {kw {:name str}} map (only :name
;; is consulted). Each method is a thin dispatch fn over protocol-dispatch.
(defmacro defprotocol [pname & sigs]
(let [methods (reduce (fn [m sig]
(assoc m (keyword (name (first sig))) {:name (name (first sig))}))
{} sigs)]
`(do
(def ~pname (make-protocol ~(name pname) ~methods))
~@(map (fn [sig]
`(def ~(first sig)
(fn* [this# & rest#] (protocol-dispatch ~pname ~(first sig) this# rest#))))
sigs))))
(defmacro extend-type [tsym psym & impls]
`(do ~@(map (fn [spec]
`(register-method ~tsym ~psym ~(first spec)
(fn* ~(nth spec 1) ~@(drop 2 spec))))
impls)))
(defmacro extend-protocol [psym & type-impls]
`(do ~@(map (fn [g] `(extend-type ~(first g) ~psym ~@(rest g)))
(group-by-head type-impls))))
;; extend (the fn form) is not supported — stub to nil, as before.
(defmacro extend [& args] nil)
;; JVM proxies are unsupported.
(defmacro proxy [& args] nil)
;; definterface is JVM-only; bind the name to an empty marker.
(defmacro definterface [name-sym & body] `(def ~name-sym {}))
;; Build a method map {kw (fn* ...)} as an embedded map literal — make-reified
;; evaluates it (the fn* forms become fns) via build-eval-map, which yields a
;; struct it can iterate; a (hash-map ...) call would instead yield a phm it can't.
(defmacro reify [& forms]
(loop [items (seq forms) proto nil methods {}]
(if (empty? items)
`(make-reified ~proto ~methods)
(let [x (first items)]
(if (symbol? x)
(recur (rest items) (if proto proto x) methods)
(recur (rest items) proto
(assoc methods (keyword (name (first x)))
`(fn* ~(nth x 1) ~@(drop 2 x)))))))))
(defmacro defrecord [name-sym fields & body]
(let [tn (name name-sym)
dot (symbol (str tn "."))
arrow (symbol (str "->" tn))
mapf (symbol (str "map->" tn))
m (fresh-sym)
;; each method body sees the record fields, bound from the instance (the
;; method's first param), matching Clojure's defrecord method scope. vec the
;; spliced binding seq so ~@ splices its elements, not the lazy-seq itself.
impl (fn [proto specs]
`(extend-type ~name-sym ~proto
~@(map (fn [spec]
(let [argv (nth spec 1)
inst (first argv)
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
specs)))]
`(do
(deftype ~name-sym ~fields)
(def ~arrow (fn* ~fields (~dot ~@fields)))
(def ~mapf (fn* [~m] (~arrow ~@(map (fn [f] `(get ~m ~(keyword (name f)))) fields))))
~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body)))))
;; --- laziness --------------------------------------------------------------
;; lazy-seq / lazy-cat moved to the 00-syntax tier: the seq/coll tiers (10-seq,
;; 20-coll) use lazy-seq, and in compile mode a tier's forms are compiled as it
;; loads — so the macro must be registered BEFORE those tiers, else (lazy-seq …)
;; compiles as a call to the macro-as-function and leaks its expansion at runtime
;; (jolt-r81). They only need seed fns (make-lazy-seq/coll->cells/concat).

100
jolt-core/clojure/core/40-lazy.clj Normal file
View file

@ -0,0 +1,100 @@
;; clojure.core — lazy tier. Canonical CLJS-based lazy seq fns.
;; Loaded after 30-macros.clj, so lazy-seq macro is available.
;;
;; Each fn ported from CLJS core.cljs, stripped of chunked-seq branches.
;; --- distinct ---
(defn distinct [coll]
(let [step (fn step [xs seen]
(lazy-seq
((fn [[f :as xs] seen]
(when-let [s (seq xs)]
(if (contains? seen f)
(recur (rest s) seen)
(cons f (step (rest s) (conj seen f))))))
xs seen)))]
(step coll #{})))
;; --- keep ---
(defn keep
([f]
(fn [rf]
(fn ([] (rf)) ([result] (rf result))
([result input]
(let [v (f input)]
(if (nil? v) result (rf result v)))))))
([f coll]
(lazy-seq
(when-let [s (seq coll)]
(let [x (f (first s))]
(if (nil? x)
(keep f (rest s))
(cons x (keep f (rest s)))))))))
;; --- keep-indexed ---
(defn keep-indexed
([f]
(fn [rf]
(let [ia (volatile! -1)]
(fn ([] (rf)) ([result] (rf result))
([result input]
(let [i (vswap! ia inc)
v (f i input)]
(if (nil? v) result (rf result v))))))))
([f coll]
(letfn [(keepi [idx coll]
(lazy-seq
(when-let [s (seq coll)]
(let [x (f idx (first s))]
(if (nil? x)
(keepi (inc idx) (rest s))
(cons x (keepi (inc idx) (rest s))))))))]
(keepi 0 coll))))
;; --- map-indexed ---
(defn map-indexed
([f]
(fn [rf]
(let [i (volatile! -1)]
(fn ([] (rf)) ([result] (rf result))
([result input] (rf result (f (vswap! i inc) input)))))))
([f coll]
(letfn [(mapi [idx coll]
(lazy-seq
(when-let [s (seq coll)]
(cons (f idx (first s)) (mapi (inc idx) (rest s))))))]
(mapi 0 coll))))
;; --- cycle ---
(defn cycle [coll]
(if-let [vals (seq coll)]
(let [n (count vals)]
(letfn [(cstep [i]
(lazy-seq
(cons (nth vals (mod i n)) (cstep (inc i)))))]
(cstep 0)))
()))
;; --- repeatedly ---
(defn repeatedly
([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f))))
;; --- repeat ---
(defn repeat
([x] (lazy-seq (cons x (repeat x))))
([n x] (take n (repeat x))))
;; --- iterate ---
(defn iterate [f x]
(lazy-seq (cons x (iterate f (f x)))))
;; --- partition-all ---
(defn partition-all
([n coll] (partition-all n n coll))
([n step coll]
(lazy-seq
(when-let [s (seq coll)]
(cons (take n s) (partition-all n step (nthrest coll step)))))))

96
jolt-core/clojure/core/MIGRATION.md Normal file
View file

@ -0,0 +1,96 @@
# clojure.core migration worklist (jolt-1j0)
Tracking the move of clojure.core from native Janet (`src/jolt/core.janet`,
4145 lines / 421 `core-*` fns) into the self-hosted Clojure overlay
(`jolt-core/clojure/core/`). Goal: shrink the Janet seed to `core-renames` +
genuinely host-coupled fns.
## Phase 0 classification (heuristic — validate per batch)
| Bucket | Count | Disposition |
|---|---|---|
| SEED (in `compiler/core-renames`) | 73 | stay in Janet (compiler emits `core-X` directly) |
| MACRO (in `core-macro-names`) | 44 | Phase 3 |
| HOST-coupled (atoms/vars/meta/proxy/transient/arrays/futures/ns/io) | 80 | Phase 4 (where feasible) / stay |
| LAZY-coupled | 28 | Phase 5 |
| MOVABLE pure-eager (candidates) | 193 | **Phase 2** |
Counts are heuristic (name + body markers); the MOVABLE list still has some
host/lazy leakage (e.g. transient `assoc!`/`conj!`, `doall`/`dorun`,
`chunk-*`, `deliver`) to filter out as each batch is actually moved.
**Key finding:** after removing SEED + HOST, the self-hosted compiler
(`jolt-core/jolt/{ir,analyzer}.clj`) uses **no** additional clojure.core fns
beyond the kernel tier (`second`/`peek`/`subvec`/`mapv`/`update`) plus host
primitives (`atom`/`swap!`/`reset!`). So **Phase 1 (compiler-dep kernel tier)
is essentially already complete** — to verify, not build.
## Performance baseline (test/bench/core-bench.janet, compile mode, min of 5, ms)
| bench | ms |
|---|---|
| fib | 128 |
| seq-pipe | 88 |
| reduce | 391 |
| into-vec | 194 |
| map-build | 681 |
| map-read | 6 |
| str-join | 244 |
| hof | 604 |
| **TOTAL** | **2336** |
Re-run after each phase; watch for regressions as fns move from native Janet to
self-hosted Clojure (interpreted/compiled, slower than native primitives).
## Per-batch workflow + gate (every migration step)
1. Canonical Clojure def in the overlay tier; remove the Janet `core-X` defn +
its `core-bindings` entry (confirm leaf first: only defn+binding refs).
2. **Add regression tests** for each moved fn — spec cases (test/spec/*-spec.janet,
interpret) and, for any fn whose behavior is subtle or was buggy, a case in the
3-mode conformance set (test/integration/conformance-test.janet).
3. Gate: conformance ×3 modes · clojure-test-suite ≥ baseline · stage2==stage3
fixpoint · fib compiled-fast · core-bench A/B under identical load (the
absolute number is load-sensitive — compare batch-vs-prior back to back).
If a moved fn surfaces a latent bug (e.g. nthrest's nil-vs-() result, the
if-let/when-let else-scope leak), fix it to match Clojure and add a regression
test, rather than preserving the bug.
## MOVABLE candidates (Phase 2 worklist, 193)
>Eduction NaN? abs aclone alength ancestors array-map array-seq assoc! associative? bean bigdec bigint biginteger boolean boolean? booleans byte bytes bytes? cat char char-escape-string char-name-string char? chars chunk chunk-append chunk-buffer chunk-cons chunk-first chunk-next chunk-rest chunked-seq? class clojure-version comparator compare-and-set! completing conj! counted? decimal? deliver denominator derive descendants destructure disj disj! dissoc! distinct? doall dorun double? doubles drop-last eduction empty ensure-reduced enumeration-seq ex-cause ex-data ex-info ex-info? ex-message find float? floats force halt-when hash-combine hash-map hash-ordered-coll hash-set hash-unordered-coll ident? ifn? indexed? infinite? inst-ms inst? integer? ints isa? iterator-seq key keyword keyword-identical? list* list? longs macrofy map-entry? memfn munge nat-int? neg-int? not-any? not-every? nthnext nthrest numerator numeric= object? parents persistent! pop pop! pos-int? pr prefers println-str prn-str promise qualified-ident? qualified-keyword? qualified-symbol? rand rand-nth random-sample ratio? rational? rationalize re-groups re-matcher record? reduce-kv reduced reduced? reductions replace replicate resolve reversible? rseq rsubseq run! seq-to-map-for-destructuring seque set set? short shorts shuffle simple-ident? simple-keyword? simple-symbol? some-search sort sort-by sorted-map sorted-map-by sorted-map? sorted-set sorted-set-by sorted-set? special-symbol? split-at split-with str-join str-replace-all str-replace-first str-split subseq supers symbol tagged-literal tagged-literal? take-last test transduce unchecked-add unchecked-byte unchecked-char unchecked-dec unchecked-divide-int unchecked-double unchecked-float unchecked-inc unchecked-int unchecked-multiply unchecked-negate unchecked-remainder-int unchecked-short unchecked-subtract undefined? underive uri? uuid? val vector volatile! volatile? xml-seq
## HOST-coupled (Phase 4 / stay, 80)
add-watch aget alter-meta! alter-var-root aset aset-boolean aset-byte aset-char aset-double aset-float aset-int aset-long aset-short atom atom? avoid-method-too-large boolean-array bounded-count byte-array char-array construct-proxy copy-core-var copy-var delay? deref double-array float-array future-call future-cancel future-cancelled? future-done? future? get-proxy-class get-validator init-proxy int-array intern into-array long-array make-array make-delay meta namespace namespace-munge new-var ns-name object-array pop-thread-bindings prefer-method print-dup print-method print-str proxy-call-with-super proxy-mappings proxy-super push-thread-bindings reader-conditional reader-conditional? remove-watch reset! reset-meta! reset-vals! set-validator! short-array swap! swap-vals! thread-first thread-last to-array to-array-2d transient transient? update-proxy var-dynamic? var-get var-set var? vary-meta vreset! vswap! with-meta
## LAZY-coupled (Phase 5, 28)
concat cycle dedupe distinct flatten interleave interpose iterate keep keep-indexed line-seq macro-names map-indexed mapcat partition partition-all partition-by rand-int random-uuid realized? repeat repeatedly seqable? sequence sequential? take-nth trampoline tree-seq unreduced
## Phase 3 (macros) — status & findings
20 macros moved to the overlay: 19 user-facing in `30-macros.clj`, plus `when`
in a new `00-syntax.clj` tier loaded **before** the kernel (interpreted defmacros,
so the macros exist before any code that uses them compiles).
Macro-authoring toolkit for jolt (learned the hard way):
- single-template hygiene: auto-gensym `foo#`
- shared explicit fresh symbol: `(symbol (str (gensym)))` — a bare `(gensym)` in a
macro body returns a *Janet* symbol the destructurer rejects
- let-rebinding: splice binding *pairs* into a TEMPLATE vector (`[~a ~b ~@pairs]`),
not a pre-built pvec value — `core-let` wants a tuple form
- build sub-forms via templates, never `cons`/`list` (those make plists the
evaluator can't run as a form)
- Jolt `defmacro` is **single-arity** — use `& rest`/destructuring
- syntax-tier macros may use only special forms + core-renames seed primitives
**Performance wall (the hot macros stay in Janet for now):** the load-order story
works, but moving the *hot* fundamental control macros (`and`/`or`/`cond`/
`when-not`) regressed the battery — as interpreted overlay defmacros they expand
slower than native Janet, and since they appear in nearly every form the
cumulative overhead tipped a heavy suite file over the 6 s per-file timeout
(3930 -> 3911, +1 timeout). They are correct (conformance 228×3, all edge cases),
but reverted. Moving `and/or/cond/when-not/case/doseq/declare/cond->/->/->>`
needs a **fast (compiled) macro-expansion path**, not interpreted defmacros.
Deferred: `defn/defn-/fn/let/loop` (fundamental + same speed concern), the type
machinery (`defrecord/defprotocol/extend-*/reify/proxy/definterface` → Phase 4),
`lazy-seq/lazy-cat` (→ Phase 5).

212
jolt-core/jolt/analyzer.clj Normal file
View file

@ -0,0 +1,212 @@
(ns jolt.analyzer
"Portable Clojure analyzer: reader form -> host-neutral IR (see jolt.ir).
Pure jolt-core — depends only on the host contract (jolt.host) and IR
constructors (jolt.ir), never on Janet. The contract fns are referred unqualified
(host form predicates are `form-*` to avoid colliding with clojure.core), so the
bootstrap can compile this namespace via its plain :var path. ctx is an opaque
host handle threaded to the contract fns; the analyzer never inspects it.
Coverage grows toward compiler.janet; unsupported forms throw :jolt/uncompilable
so the caller falls back to the interpreter (the hybrid contract).
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}.
Definitions are ordered so only `analyze` (mutually recursive) is forward
declared — the bootstrap compiles forward refs through var cells, but keeping
them to one keeps the compiled namespace simple."
(:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke
def-node let-node fn-node vector-node map-node
quote-node throw-node]]
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
form-vec? form-map? form-set? form-char?
form-literal? form-elements form-vec-items
form-map-pairs form-special? compile-ns
form-macro? form-expand-1 resolve-global
form-sym-meta host-intern! form-syntax-quote-lower]]))
(declare analyze)
(def ^:private handled
#{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"
"syntax-quote"})
(defn- uncompilable [why]
(throw (str "jolt/uncompilable: " why)))
(def ^:private gensym-counter (atom 0))
(defn- gen-name [prefix]
(let [n @gensym-counter]
(swap! gensym-counter inc)
(str "_r$" prefix n)))
(defn- empty-env [] {:locals #{}})
(defn- local? [env nm] (contains? (:locals env) nm))
(defn- add-locals [env names] (update env :locals #(reduce conj % names)))
(defn- with-recur [env name] (assoc env :recur name))
(defn- analyze-seq [ctx forms env]
(let [v (mapv #(analyze ctx % env) forms)
n (count v)]
(cond
(zero? n) (const nil)
(= 1 n) (first v)
:else (do-node (subvec v 0 (dec n)) (peek v)))))
(defn- analyze-bindings [ctx bvec env]
(loop [i 0 env env pairs []]
(if (< i (count bvec))
(let [bsym (nth bvec i)]
(when-not (form-sym? bsym) (uncompilable "destructuring binding"))
(let [nm (form-sym-name bsym)
init (analyze ctx (nth bvec (inc i)) env)]
(recur (+ i 2) (add-locals env [nm]) (conj pairs [nm init]))))
[pairs env])))
(defn- parse-params [pvec]
(loop [i 0 fixed [] rest-name nil]
(if (< i (count pvec))
(let [p (nth pvec i)]
(when-not (form-sym? p) (uncompilable "destructuring fn param"))
(if (= "&" (form-sym-name p))
(let [r (nth pvec (inc i))]
(when-not (form-sym? r) (uncompilable "destructuring fn rest"))
(recur (+ i 2) fixed (form-sym-name r)))
(recur (inc i) (conj fixed (form-sym-name p)) rest-name)))
{:fixed fixed :rest rest-name})))
(defn- analyze-arity [ctx pvec body env fn-name]
(let [pp (parse-params (vec (form-vec-items pvec)))
fixed (:fixed pp)
rst (:rest pp)
;; Always a recur target, variadic included: the back end gives the rest
;; param an ordinary positional slot (holding the collected seq), so recur
;; is a self-call carrying the rest seq directly — Clojure semantics.
rname (gen-name "arity")
names (cond-> (vec fixed) rst (conj rst) fn-name (conj fn-name))
env* (-> (add-locals env names) (with-recur rname))
arity {:params fixed :recur-name rname
:body (analyze-seq ctx body env*)}]
;; :rest only when variadic — an absent :rest reads back nil, same as before,
;; but keeps a fixed arity a nil-free struct rather than a phm.
(if rst (assoc arity :rest rst) arity)))
(defn- analyze-fn [ctx items env]
(let [named (form-sym? (nth items 1))
fn-name (when named (form-sym-name (nth items 1)))
rest-items (if named (drop 2 items) (drop 1 items))
first* (first rest-items)]
(cond
(form-vec? first*)
(fn-node fn-name [(analyze-arity ctx first* (rest rest-items) env fn-name)])
(form-list? first*)
(fn-node fn-name
(mapv (fn [clause]
(let [cl (vec (form-elements clause))]
(analyze-arity ctx (first cl) (rest cl) env fn-name)))
rest-items))
:else (uncompilable "fn: bad params"))))
(defn- analyze-try [ctx items env]
(let [clauses (rest items)
body (atom [])
catch-sym (atom nil)
catch-body (atom nil)
finally-body (atom nil)]
(doseq [c clauses]
(let [head (when (form-list? c) (first (vec (form-elements c))))
hname (when (and head (form-sym? head)) (form-sym-name head))]
(cond
(= hname "catch")
(let [cl (vec (form-elements c))]
(reset! catch-sym (form-sym-name (nth cl 2)))
(reset! catch-body (drop 3 cl)))
(= hname "finally")
(reset! finally-body (rest (vec (form-elements c))))
:else (swap! body conj c))))
{:op :try
:body (analyze-seq ctx @body env)
:catch-sym @catch-sym
:catch-body (when @catch-body
(analyze-seq ctx @catch-body (add-locals env [@catch-sym])))
:finally (when @finally-body (analyze-seq ctx @finally-body env))}))
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
"if" (if-node (analyze ctx (nth items 1) env)
(analyze ctx (nth items 2) env)
(if (> (count items) 3)
(analyze ctx (nth items 3) env)
(const nil)))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)
nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env) (form-sym-meta name-sym)))
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
r (analyze-bindings ctx bvec env)]
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
"loop*" (let [bvec (vec (form-vec-items (nth items 1)))
rname (gen-name "loop")
r (analyze-bindings ctx bvec env)
env** (with-recur (second r) rname)]
{:op :loop :recur-name rname :bindings (first r)
:body (analyze-seq ctx (drop 2 items) env**)})
"recur" (let [rt (:recur env)]
(when-not rt (uncompilable "recur outside loop/fn"))
{:op :recur :recur-name rt
:args (mapv #(analyze ctx % env) (rest items))})
"try" (analyze-try ctx items env)
"fn*" (analyze-fn ctx items env)
;; Lower the backtick to construction code (zero runtime cost), then analyze
;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile.
"syntax-quote" (analyze ctx (form-syntax-quote-lower ctx (second items)) env)
(uncompilable (str "special form " op))))
(defn- analyze-symbol [ctx form env]
(let [nm (form-sym-name form) ns (form-sym-ns form)]
(cond
(and (nil? ns) (local? env nm)) (local nm)
ns (let [r (resolve-global ctx form)]
(if (= :var (:kind r))
(var-ref (:ns r) (:name r))
(uncompilable (str "qualified ref " ns "/" nm))))
:else (let [r (resolve-global ctx form)]
(case (:kind r)
:var (var-ref (:ns r) (:name r))
:host (host-ref (:name r))
(var-ref (compile-ns ctx) nm))))))
(defn- analyze-list [ctx form env]
(let [items (vec (form-elements form))]
(if (zero? (count items))
(quote-node form)
(let [head (first items)
hname (when (and (form-sym? head) (nil? (form-sym-ns head))) (form-sym-name head))
shadowed (and hname (local? env hname))]
(cond
(and hname (not shadowed) (contains? handled hname))
(analyze-special ctx hname items env)
(and hname (not shadowed) (form-special? hname))
(uncompilable (str "special form " hname))
(and (form-sym? head) (not shadowed) (form-macro? ctx head))
(analyze ctx (form-expand-1 ctx form) env)
:else
(invoke (analyze ctx head env)
(mapv #(analyze ctx % env) (rest items))))))))
(defn analyze
([ctx form] (analyze ctx form (empty-env)))
([ctx form env]
(cond
(form-literal? form) (const form)
(form-sym? form) (analyze-symbol ctx form env)
(form-vec? form) (vector-node (mapv #(analyze ctx % env) (form-vec-items form)))
(form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env)
(analyze ctx (second p) env)])
(form-map-pairs form)))
(form-set? form) (uncompilable "set literal")
(form-list? form) (analyze-list ctx form env)
:else (uncompilable "unsupported form"))))

57
jolt-core/jolt/ir.clj Normal file
View file

@ -0,0 +1,57 @@
(ns jolt.ir
"Host-neutral intermediate representation for the Jolt compiler.
The analyzer (jolt.analyzer) produces IR; a host back end consumes it. IR nodes
are plain maps tagged with :op — no host values embedded. Globals reference vars
by name (:ns/:name), never by a host var cell, so the IR is portable and
AOT-safe. This namespace is pure Clojure (portable jolt-core): it depends on
nothing host-specific.")
;; Node constructors. Kept as data so any back end can pattern-match on :op.
(defn const [v] {:op :const :val v})
(defn local [name] {:op :local :name name})
;; A global var reference, by name. The back end resolves it to a host var.
(defn var-ref [ns name] {:op :var :ns ns :name name})
;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
(defn rt [name] {:op :rt :name name})
;; A name that resolves only via the host's own environment (e.g. + or int? on
;; Janet) — the back end emits a host-appropriate reference.
(defn host-ref [name] {:op :host :name name})
(defn if-node [test then else] {:op :if :test test :then then :else else})
(defn do-node [statements ret] {:op :do :statements statements :ret ret})
(defn invoke [f args] {:op :invoke :fn f :args args})
;; meta is the var metadata (e.g. {:dynamic true} / {:redef true}) the back end
;; applies to the cell; absent when the def name carried none.
(defn def-node
([ns name init] {:op :def :ns ns :name name :init init})
([ns name init meta]
(if meta
{:op :def :ns ns :name name :init init :meta meta}
{:op :def :ns ns :name name :init init})))
(defn let-node [bindings body] {:op :let :bindings bindings :body body})
;; A fn is one or more arities. Each arity: {:params [..] :body ir}, plus :rest
;; name when variadic. :name is absent for an anonymous fn.
(defn fn-node [name arities]
(if name
{:op :fn :name name :arities arities}
{:op :fn :arities arities}))
(defn vector-node [items] {:op :vector :items items})
(defn map-node [pairs] {:op :map :pairs pairs})
(defn set-node [items] {:op :set :items items})
(defn quote-node [form] {:op :quote :form form})
(defn throw-node [expr] {:op :throw :expr expr})
(defn op [node] (:op node))