diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index d8e7298..347d467 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -4,10 +4,45 @@ ;; 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. +;; 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))) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index bba5d47..5f3cbe9 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -634,17 +634,18 @@ ;; --- Phase 2 leaf batch 2 (jolt-ded): canonical Clojure ports ---------------- ;; key/val/find first — merge-with and memoize below use them. -;; An entry is any 2-element vector in jolt ((seq m) yields tuples, find -;; builds a pvec — both count as entries; Clojure's stricter MapEntry-only -;; key/val has no analog here). -(defn- map-entryish? [e] (and (vector? e) (= 2 (count e)))) -(defn key [e] (if (map-entryish? e) (nth e 0) (throw (ex-info "key requires a map entry" {})))) -(defn val [e] (if (map-entryish? e) (nth e 1) (throw (ex-info "val requires a map entry" {})))) +;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT +;; a plain vector — (key [1 2]) throws. +(defn key [e] (if (map-entry? e) (nth e 0) (throw (ex-info "key requires a map entry" {})))) +(defn val [e] (if (map-entry? e) (nth e 1) (throw (ex-info "val requires a map entry" {})))) ;; find was previously missing from jolt entirely. Presence (contains?), not -;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by index. +;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by +;; index. The result must be a REAL entry (key/val are strict), so it is +;; minted as the first entry of a one-entry map — nil values survive (the +;; map builder switches to a phm when nil is involved). (defn find [m k] - (when (contains? m k) [k (get m k)])) + (when (contains? m k) (first {k (get m k)}))) (defn some? [x] (not (nil? x))) (defn true? [x] (= true x)) diff --git a/jolt-core/clojure/core/25-sorted.clj b/jolt-core/clojure/core/25-sorted.clj index 7abed7a..e7b1483 100644 --- a/jolt-core/clojure/core/25-sorted.clj +++ b/jolt-core/clojure/core/25-sorted.clj @@ -142,8 +142,6 @@ :seq (fn [sm] (seq (sfield sm :entries))) :rseq (fn [sm] (seq (vec (reverse (sfield sm :entries))))) :first (fn [sm] (first (sfield sm :entries))) - :keys (fn [sm] (seq (mapv first (sfield sm :entries)))) - :vals (fn [sm] (seq (mapv second (sfield sm :entries)))) :get sm-get :contains (fn [sm k] (not (neg? (find-idx sm first k)))) :assoc sm-assoc-many diff --git a/src/jolt/api.janet b/src/jolt/api.janet index 8d25027..bbdd3f6 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -87,6 +87,12 @@ # Gate the analyzer build until the kernel tier loads (see ensure-analyzer): # present-and-false here means pre-kernel compiles fall back to the interpreter. (put env :kernel-ready? false) + # Pre/at-kernel defns load interpreted in some mode (00-syntax always; the + # kernel tier too in interpret mode); stash their fn sources so the staged + # recompile pass (backend/recompile-defns!) can compile them once the + # analyzer is alive. Cleared after the kernel tier so later tiers and user + # code don't stash. + (put env :stash-defn-src? true) (each tier core-tiers (when-let [src (get stdlib-embed/sources (tier :ns))] (put env :direct-linking? core-dl) @@ -98,7 +104,9 @@ # pre-kernel tier that triggers a compile (e.g. a defn in 00-syntax) instead # falls back to the interpreter rather than building the analyzer against a # half-loaded core (which would forward-ref the missing kernel fns to nil). - (when (tier :kernel) (put env :kernel-ready? true)))) + (when (tier :kernel) + (put env :kernel-ready? true) + (put env :stash-defn-src? false)))) (put env :direct-linking? user-dl) (ctx-set-current-ns ctx saved) # Stage 3 interpreted bootstrap: the analyzer was loaded INTERPRETED (no diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index 1768c97..5abc253 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -509,6 +509,27 @@ (++ n))))) n) +(defn recompile-defns! + "Staged-bootstrap pass for early DEFNS (jolt-4j3) — the defn analog of + recompile-macros!. Pre/at-kernel overlay defns (00-syntax's destructure, + empty?/keys/vals, and the kernel tier in interpret mode) load as interpreted + closures; the evaluator stashes their fn source on the var (:defn-src). + Once the analyzer is alive, compile that source and swap the var's ROOT — + callers go through the var, so they pick up the compiled fn. Skips vars + already done; a body the analyzer can't compile stays interpreted." + [ctx] + (def mappings ((ctx-find-ns ctx "clojure.core") :mappings)) + (var n 0) + (each nm (keys mappings) + (def v (get mappings nm)) + (when (and (table? v) (get v :defn-src) (not (get v :defn-compiled))) + (def compiled (try-compile-fn ctx (get v :defn-src))) + (when compiled + (put v :root compiled) + (put v :defn-compiled true) + (++ n)))) + n) + (defn ensure-macros-compiled! "Called once the overlay is fully loaded (api/load-core-overlay!): ensure the analyzer is built, then run the staged macro-recompile pass so the early @@ -522,4 +543,8 @@ [ctx] (when (get (ctx :env) :compile-macros?) (ensure-analyzer ctx) - (when (analyzer-built? ctx) (recompile-macros! ctx)))) + (when (analyzer-built? ctx) + # defns first: the expanders call them, and a recompiled expander that + # ran before the defn pass still resolves through the var either way. + (recompile-defns! ctx) + (recompile-macros! ctx)))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 44669e5..e822d6b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -233,20 +233,8 @@ (= x (math/floor x)))) (defn core-list? [x] (or (plist? x) (and (array? x) (not (get x :jolt/type))))) -(defn core-empty? [coll] - (if (nil? coll) true - (if (core-sorted? coll) (= 0 (length (sorted-entries-arr coll))) - (if (set? coll) (= 0 (coll :cnt)) - (if (phm? coll) (= 0 (coll :cnt)) - (if (pvec? coll) (= 0 (pv-count coll)) - (if (plist? coll) (pl-empty? coll) - # Cell-based, NOT (nil? (ls-first)): a lazy-seq whose first element is - # legitimately nil (e.g. a `nil` case-constant) is non-empty. - (if (lazy-seq? coll) - (let [cell (realize-ls coll)] - (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))) - (if (struct? coll) (= 0 (length (keys coll))) - (= 0 (length coll))))))))))) +# empty? now lives in the syntax tier (core/00-syntax.clj): the expanders +# call it, so it must exist before the kernel tier compiles. (defn core-every? [pred coll] # Short-circuit on the first false — and pull lazily so an infinite seq with an @@ -463,6 +451,13 @@ (do (var result coll) (each x xs (set result (pl-cons x result))) result)) (if (set? coll) (apply phs-conj coll xs) + # conj onto a seq prepends (Clojure: a Cons cell). Without this branch a + # lazy-seq fell into the MAP fallback below — clojure.data/diff relies on + # (conj seq x) via set/union over (keys m), which is now a lazy seq. + (if (lazy-seq? coll) + (do (var result coll) + (each x xs (set result (pl-cons x (realize-for-iteration result)))) + result) (if (phm? coll) (do (var result coll) @@ -474,18 +469,28 @@ # conj a map -> merge its entries (each e (map-entries-of x) (set result (phm-assoc result (in e 0) (in e 1)))) - (set result (phm-assoc result (vnth x 0) (vnth x 1))))) + # a [k v] entry: exactly a 2-element vector (Clojure throws + # otherwise — and merge inherits this strictness through conj) + (and (or (pvec? x) (tuple? x) (array? x)) (= 2 (vcount x))) + (set result (phm-assoc result (vnth x 0) (vnth x 1))) + (error "Vector arg to map conj must be a pair"))) result) (do (var result coll) (each x xs (cond + # conj nil onto a map is a no-op (Clojure) (nil? x) nil (map-value? x) + # conj a map -> merge its entries (each e (map-entries-of x) (set result (map-assoc1 result (in e 0) (in e 1)))) - (set result (map-assoc1 result (vnth x 0) (vnth x 1))))) - result)))))))))))) + # a [k v] entry: exactly a 2-element vector (Clojure throws + # otherwise — and merge inherits this strictness through conj) + (and (or (pvec? x) (tuple? x) (array? x)) (= 2 (vcount x))) + (set result (map-assoc1 result (vnth x 0) (vnth x 1))) + (error "Vector arg to map conj must be a pair"))) + result))))))))))))) (defn core-assoc [m & kvs] (when (odd? (length kvs)) @@ -730,11 +735,12 @@ (pvec? coll) (if (= 0 (pv-count coll)) nil (tuple ;(pv->array coll))) (plist? coll) (if (pl-empty? coll) nil (tuple ;(pl->array coll))) (buffer? coll) (if (= 0 (length coll)) nil (let [a @[]] (each x coll (array/push a x)) (tuple ;a))) - (set? coll) (phs-seq coll) - (phm? coll) (tuple ;(phm-entries coll)) + # empty maps/sets seq to nil, as in Clojure ((seq {}) is nil, not ()) + (set? coll) (if (= 0 (coll :cnt)) nil (phs-seq coll)) + (phm? coll) (if (= 0 (coll :cnt)) nil (tuple ;(phm-entries coll))) (tuple? coll) (tuple/slice coll) (string? coll) (if (= 0 (length coll)) nil (tuple ;(map make-char (string/bytes coll)))) - (struct? coll) (tuple ;(map (fn [k] (tuple k (get coll k))) (keys coll))) + (struct? coll) (if (= 0 (length coll)) nil (tuple ;(map (fn [k] (tuple k (get coll k))) (keys coll)))) (array? coll) (tuple ;coll) (and (table? coll) (get coll :jolt/deftype)) coll # scalars/functions aren't seqable @@ -771,14 +777,10 @@ # merge-with now lives in the Clojure collection tier (core/20-coll.clj). -(defn core-keys [m] - # phm-entries (not phm-to-struct) so keys mapped to nil values are not dropped. - (if (core-sorted-map? m) ((sorted-op m :keys) m) - (if (phm? m) (tuple ;(map |(in $ 0) (phm-entries m))) (tuple ;(keys m))))) +# keys / vals now live in the syntax tier (core/00-syntax.clj) — canonical +# projections of (seq m), so sorted maps come back in comparator order. + -(defn core-vals [m] - (if (core-sorted-map? m) ((sorted-op m :vals) m) - (if (phm? m) (tuple ;(map |(in $ 1) (phm-entries m))) (tuple ;(map |(m $) (keys m)))))) # select-keys now lives in the Clojure collection tier (core/20-coll.clj). @@ -2264,7 +2266,9 @@ (defn core-copy-var [sym & args] nil) (defn core-macrofy [sym fn & more] fn) (defn core-new-var [sym & args] nil) -(defn core-avoid-method-too-large [& args] @{}) +# sci stub: pass the registry map through (it was @{} — a raw host table that +# strict map-conj rightly rejects; identity also keeps sci's registry intact). +(defn core-avoid-method-too-large [& args] (if (> (length args) 0) (in args 0) {})) # declare macro — accepts symbols, does nothing (forward declaration) @@ -2681,7 +2685,6 @@ "odd?" core-odd? "integer?" core-integer? "list?" core-list? - "empty?" core-empty? "every?" core-every? "+" core-+ "-" core-sub @@ -2726,8 +2729,6 @@ "__sqmap" core-sqmap "__sqset" core-sqset "into" core-into - "keys" core-keys - "vals" core-vals "with-meta" core-with-meta "map" core-map "filter" core-filter diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 353931f..39d339f 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -1272,8 +1272,20 @@ v (ns-intern ns (name-sym :name)) # (def name docstring value): docstring is form 2, value form 3 has-doc (and (> (length form) 3) (string? (in form 2))) - val (eval-form ctx bindings (in form (if has-doc 3 2)))] + val-form (in form (if has-doc 3 2)) + val (eval-form ctx bindings val-form)] (bind-root v val) + # Staged bootstrap (jolt-4j3): pre/at-kernel overlay defns load + # interpreted; stash the fn source so backend/recompile-defns! can + # compile them once the analyzer is alive — the defn analog of + # :macro-src. Only set while api/load-core-overlay! loads the early + # tiers (the flag scopes it away from user code). + (when (and (get (ctx :env) :stash-defn-src?) + (function? val) + (array? val-form) (> (length val-form) 0) + (or (sym-name? (first val-form) "fn") + (sym-name? (first val-form) "fn*"))) + (put v :defn-src val-form)) (let [extra (if has-doc (merge name-meta {:doc (in form 2)}) name-meta)] (when (not (empty? extra)) (put v :meta (merge (or (get v :meta) {}) extra)))) diff --git a/test/integration/lazy-infinite-test.janet b/test/integration/lazy-infinite-test.janet index a29a5dd..1e068e2 100644 --- a/test/integration/lazy-infinite-test.janet +++ b/test/integration/lazy-infinite-test.janet @@ -75,7 +75,9 @@ ["LAZY take-while" "6" "(do (def c (atom 0)) (dorun (take-while (fn [x] (swap! c inc) (< x 5)) (range))) @c)"] ["LAZY drop-while" "6" "(do (def c (atom 0)) (dorun (take 3 (drop-while (fn [x] (swap! c inc) (< x 5)) (range)))) @c)"] ["LAZY distinct" "4" "(do (def c (atom 0)) (dorun (take 3 (distinct (map (fn [x] (swap! c inc) x) (cycle [1 2 1 3 1]))))) @c)"] - ["LAZY take-nth" "7" "(do (def c (atom 0)) (dorun (take 3 (take-nth 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"] + # 5, was 7: the canonical lazy take-nth (40-lazy, jolt-ded batch 3) realizes + # only the elements the taken outputs and their drops touch. + ["LAZY take-nth" "5" "(do (def c (atom 0)) (dorun (take 3 (take-nth 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"] ["LAZY map-indexed" "3" "(do (def c (atom 0)) (dorun (take 3 (map-indexed (fn [i x] (swap! c inc) [i x]) (range)))) @c)"] ["LAZY keep" "6" "(do (def c (atom 0)) (dorun (take 3 (keep (fn [x] (swap! c inc) (if (odd? x) x nil)) (range)))) @c)"] ["LAZY keep-indexed" "6" "(do (def c (atom 0)) (dorun (take 3 (keep-indexed (fn [i x] (swap! c inc) (if (odd? i) x)) (range)))) @c)"] diff --git a/test/integration/macro-expansion-test.janet b/test/integration/macro-expansion-test.janet index 2dd21c3..4b4adfc 100644 --- a/test/integration/macro-expansion-test.janet +++ b/test/integration/macro-expansion-test.janet @@ -75,3 +75,17 @@ (os/setenv "JOLT_INTERPRET_MACROS" nil) (print "compiled macro expansion passed!") + +# 6. Early overlay DEFNS get the same staged-recompile treatment (jolt-4j3): +# 00-syntax fns (destructure, and the expander-called keys/vals/empty?) load +# interpreted pre-kernel, then compile in the same end-of-init pass. +(each nm ["destructure" "empty?" "keys" "vals"] + (def v (macro-var ictx nm)) + (assert v (string nm " var exists")) + (assert (get v :defn-compiled) + (string nm " early defn is compiled (interpret mode)"))) +(def cctx2 (init {:compile? true})) +(assert (get (macro-var cctx2 "destructure") :defn-compiled) + "early defn compiled in compile mode too") +(assert (not (get (macro-var octx "destructure") :defn-compiled)) + "oracle mode keeps early defns interpreted") diff --git a/test/integration/self-host-test.janet b/test/integration/self-host-test.janet index d545b1b..3e1bcc3 100644 --- a/test/integration/self-host-test.janet +++ b/test/integration/self-host-test.janet @@ -70,9 +70,17 @@ # Proof the self-hosted pipeline actually ran: only backend/ensure-analyzer # populates jolt.analyzer. An interpret-only ctx never loads it. (assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer loaded under :compile?")) +# Interpret mode now loads the analyzer too — for compiled macro expansion +# (ensure-macros-compiled!, every mode). The fully-interpreted oracle is the +# :compile-macros? false ctx, which must never touch the analyzer. (let [ctx (init-cached {})] (eval-one ctx (parse-string "(+ 1 2)")) - (assert (zero? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer NOT loaded when interpreting")) + (assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) + "analyzer loaded when interpreting (compiled expanders)")) +(let [ctx (init-cached {:compile-macros? false})] + (eval-one ctx (parse-string "(+ 1 2)")) + (assert (zero? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) + "analyzer NOT loaded in the interpreted-macro oracle")) # clojure.core overlay: fns moved from core.janet to jolt-core/clojure/core.clj # load into clojure.core at init and work the same compiled or interpreted. diff --git a/test/spec/maps-spec.janet b/test/spec/maps-spec.janet index 4b39baa..5be1d87 100644 --- a/test/spec/maps-spec.janet +++ b/test/spec/maps-spec.janet @@ -155,3 +155,25 @@ ["update-vals empty" "{}" "(update-vals {} inc)"] ["update-vals nil" "{}" "(update-vals nil inc)"] ["update-vals keeps keys" "[:a :b]" "(sort (keys (update-vals {:a 1 :b 2} inc)))"]) + +# keys/vals/empty? are 00-syntax overlay fns now (jolt-4j3) — expander-called, +# so they live in the first tier and get the staged defn recompile. +(defspec "maps / keys-vals-empty? as overlay fns" + ["keys" "(quote (:a))" "(keys {:a 1})"] + ["keys empty map" "nil" "(keys {})"] + ["keys nil" "nil" "(keys nil)"] + ["vals" "(quote (1))" "(vals {:a 1})"] + ["vals empty" "nil" "(vals {})"] + ["keys sorted order" "[1 2 3]" "(vec (keys (sorted-map 2 :b 1 :a 3 :c)))"] + ["vals sorted order" "[:a :b :c]" "(vec (vals (sorted-map 2 :b 1 :a 3 :c)))"] + ["keys/vals zip" "{:a 1 :b 2}" "(zipmap (keys {:a 1 :b 2}) (vals {:a 1 :b 2}))"] + ["empty? map" "true" "(empty? {})"] + ["empty? vec" "[true false]" "[(empty? []) (empty? [1])]"] + ["empty? list" "[true false]" "[(empty? ()) (empty? (list 1))]"] + ["empty? string" "[true false]" "[(empty? \"\") (empty? \"a\")]"] + ["empty? nil" "true" "(empty? nil)"] + ["empty? set" "[true false]" "[(empty? #{}) (empty? #{1})]"] + ["empty? lazy" "[true false]" "[(empty? (filter pos? [-1])) (empty? (map inc [1]))]"] + ["empty? lazy nil elem" "false" "(empty? (cons nil nil))"] + ["empty? sorted" "[true false]" "[(empty? (sorted-map)) (empty? (sorted-set 1))]"] + ["empty? number throws" :throws "(empty? 5)"])