jolt/jolt-core/clojure/core/00-syntax.clj
Yogthos 703a59d40b core: close the compile-path gaps that broke uberscripting Selmer + config
Loading these libs via require worked (load-ns-source interprets, macros
expand lazily) but the same code inlined by uberscript routes through
eval-toplevel and compiled, surfacing four gaps:

- a ^{:map} metadata def name reads as (def (with-meta name m) v); the
  analyzer died extracting the name (config.core's defonce env). It now
  throws uncompilable so the interpreter, which handles it, takes over.
- declare was a no-op, so a compiled forward reference to a declared
  name that collides with a janet root binding bound to the host fn
  (selmer.parser's (declare parse) compiled to janet's 1-arg parse).
  declare now expands to no-init defs, the interpreter interns them,
  and the analyzer routes no-init def to the interpreter.
- class? was missing (selmer.util's exception macro calls it at
  expansion time). Always false, like ratio? — no Class objects here.
- require of an unlocatable namespace silently left an empty ns behind,
  deferring the failure to an unresolved symbol far from the cause. It
  now throws like Clojure's FileNotFoundException. Namespaces entered
  in-session count as loaded (Clojure puts them in *loaded-libs*), and
  the SCI bootstrap opts out via :lenient-require? since its
  clj-targeted requires can't all exist on this host.
2026-06-11 01:31:50 -04:00

447 lines
22 KiB
Clojure

;; 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: code here may use ONLY special forms (if/do/let*/fn*/not) and
;; SEED primitives (first/next/rest/nth/count/seq/...), plus earlier defs in
;; THIS file. It must NOT use kernel-tier fns (second/peek/subvec/...) or
;; anything defined later — those don't exist yet when this tier loads. Raw
;; fn*/let* (no destructuring) and no when/cond/and/or above their defmacros.
;;
;; This tier's defns load interpreted and are recompiled by the staged pass
;; (backend/recompile-defns!) once the analyzer is alive — same lifecycle as
;; the defmacro expanders.
;; empty?/keys/vals live HERE (not 20-coll) because the expanders below call
;; them at expansion time, which first happens during the kernel-tier compile.
;; empty? keeps O(1) dispatch for counted things; only the lazy/list fallback
;; goes through seq's cell check.
(def empty?
(fn* empty? [coll]
(if (nil? coll)
true
(if (vector? coll)
(zero? (count coll))
(if (map? coll)
(zero? (count coll))
(if (set? coll)
(zero? (count coll))
(if (string? coll)
(zero? (count coll))
(nil? (seq coll)))))))))
;; Canonical: the seq of entries/elements, projected. (keys {}) is nil; sorted
;; maps iterate in comparator order ((seq sm) is the value's own :seq op).
(def keys
(fn* keys [m]
(let* [s (seq m)]
(if s (map (fn* [e] (nth e 0)) s) nil))))
(def vals
(fn* vals [m]
(let* [s (seq m)]
(if s (map (fn* [e] (nth e 1)) s) nil))))
(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)))))
;; ns is sugar over the namespace-op fns (in-ns/require/use/import/refer-clojure,
;; all ctx-capturing clojure.core fns) — matching Clojure, where require is a fn and
;; the ns macro expands its clauses into require calls. Each spec is quoted
;; individually and passed as data; non-list clauses (docstring, attr-map,
;; :gen-class, …) are ignored. So ns compiles to a plain (do …) of invokes.
;; MUST live in this first tier: the self-hosted analyzer build (triggered while
;; 10-seq loads) processes jolt.analyzer's own (ns …) form, so ns has to exist by
;; then. Its body resolves fn/map/reduce/cond at EXPANSION time, by which point all
;; of 00-syntax has loaded, so using them here is fine.
(defmacro ns [nm & clauses]
(let [calls (reduce
(fn [acc clause]
(if (seq? clause)
(let [head (first clause) args (rest clause)]
(cond
(= head :require) (conj acc `(require ~@(map (fn [s] `(quote ~s)) args)))
(= head :use) (conj acc `(use ~@(map (fn [s] `(quote ~s)) args)))
(= head :import) (conj acc `(import ~@(map (fn [s] `(quote ~s)) args)))
(= head :refer-clojure)
(conj acc `(refer-clojure ~@(map (fn [s] `(quote ~s)) args)))
:else acc))
acc))
[] clauses)]
`(do (in-ns (quote ~nm)) ~@calls)))
;; 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 interns unbound vars (Clojure semantics). The interpreter
;; resolves forward refs lazily either way, but the COMPILER classifies globals at
;; compile time: without the var, a declared name that collides with a Janet root
;; binding (parse, hash, …) would compile to the host fn instead of the var.
(defmacro declare [& syms]
`(do ~@(map (fn* [s] `(def ~s)) syms)))
;; 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)))
gm (symbol (str (gensym)))
;; kwargs: a map pattern may bind against the sequential rest
;; of a fn — (& {:keys [...]}) — which is a seq of alternating
;; k/v args, or a single trailing map. Coerce like Clojure (and
;; like the interpreter's destructure-bind, so interpret/compile
;; agree): a sequential value with one map element is that map,
;; otherwise (apply hash-map). A real map value is used as-is, so
;; ordinary map destructuring is unaffected. g holds init once;
;; gm is the coerced map every lookup (and :as) reads from.
coerce `(if (sequential? ~g)
(if (and (= 1 (count ~g)) (map? (first ~g)))
(first ~g)
(apply hash-map ~g))
~g)
or-map (get pat :or)
as-sym (get pat :as)
bound (conj (conj (conj (conj acc g) init) gm) coerce)
base (if as-sym (conj (conj bound as-sym) gm) bound)
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 ~gm ~keyform ~(nth fo 1))
`(get ~gm ~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 ~gm ~(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 ...)).
;; Emits the fn MACRO (not the fn* primitive) so destructuring params desugar — fn*
;; requires plain symbols (like Clojure). Unnamed (as before): self-recursion
;; resolves through the def'd var, so this only adds the desugaring step.
;; 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))))
;; Collect test constants pairwise (so a trailing unpaired default is
;; excluded), flattening list/or-group tests into individual constants.
;; seed-only fns (reduce/conj/first/rest/drop/empty?/seq?) — analyzer.clj
;; uses case during its own build, before some/distinct load.
collect (fn* collect [cls acc]
(if (or (empty? cls) (empty? (rest cls)))
acc
(let [t (first cls)
acc (if (seq? t) (reduce conj acc t) (conj acc t))]
(collect (drop 2 cls) acc))))
;; first duplicate constant, wrapped in [x] (so a duplicate nil is detected);
;; nil = none. Clojure rejects duplicate case constants at compile time.
first-dup (fn* fd [items seen]
(if (empty? items)
nil
(let [x (first items)]
(if (reduce (fn [f s] (or f (= s x))) false seen)
[x]
(fd (rest items) (conj seen x))))))
dup (first-dup (collect clauses []) [])
build (fn build [cls]
(if (empty? cls)
;; no clause matched and no default — Clojure throws here.
`(throw (ex-info (str "No matching clause: " ~g) {}))
(if (empty? (rest cls))
(first cls)
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
(if dup
(throw (str "Duplicate case test constant: " (first dup)))
`(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)))