From d61c86a068bc85da483c96e38dc6d8f5edbc42dc Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 10 Jun 2026 12:53:47 -0400 Subject: [PATCH] =?UTF-8?q?core:=20Stage=203=20turn=202b=20=E2=80=94=20hos?= =?UTF-8?q?t=20IO,=20ns=20introspection,=20thread-binding=20family?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The names turn 2a's leak removal exposed as honestly missing, now proper: - slurp/spit/flush (host-classified): path-based IO over Janet files; spit takes :append; flush flushes *out*. printf prints formatted (no newline) over the existing format. file-seq walks paths via two host dir primitives through the overlay's tree-seq. - ns-map / ns-unmap / ns-refers (ctx fns). ns-refers required fixing the refer MODEL: refer/use/:refer now map the SOURCE VAR into the target ns (the Clojure model) instead of copying its value into a new var — so source-ns redefinitions propagate, the :macro flag travels for free, and refers are identifiable by the var's home :ns. - Thread-binding family: with-bindings*/with-bindings, bound-fn*/bound-fn, bound?, thread-bound?, get-thread-bindings. The captured binding map is a Janet struct keyed by the var tables — the exact frame representation var-get reads — so it re-pushes correctly (a phm frame is invisible to var lookup). - load-string and eval interned as VALUES at the api layer (they need the loader's compile-or-interpret routing); the eval special form still handles direct calls. Suite 4532 -> 4572 (baseline floor 4540 across timeout variance, clean 86), conformance 326x3, stdlib battery, all specs+unit (+21 turn-2b rows). Coverage: missing-portable 27 -> 10 (left: the *in*-model readers, the with-local-vars/with-precision/extenders tail). --- docs/spec/coverage.md | 46 ++++++++-------- jolt-core/clojure/core/20-coll.clj | 29 ++++++++++ jolt-core/clojure/core/30-macros.clj | 6 +++ src/jolt/api.janet | 15 ++++++ src/jolt/core.janet | 54 +++++++++++++++++++ src/jolt/evaluator.janet | 40 ++++++++++---- .../integration/clojure-test-suite-test.janet | 2 +- test/spec/stage3-io-ns-spec.janet | 39 ++++++++++++++ 8 files changed, 197 insertions(+), 34 deletions(-) create mode 100644 test/spec/stage3-io-ns-spec.janet diff --git a/docs/spec/coverage.md b/docs/spec/coverage.md index 77025c3..37fe708 100644 --- a/docs/spec/coverage.md +++ b/docs/spec/coverage.md @@ -3,14 +3,14 @@ Generated 2026-06-10 by `tools/spec_coverage.py` — do not edit by hand. Surface: **694** clojure.core vars (ClojureDocs export; 648 with -community examples). jolt interns 535 of them. +community examples). jolt interns 552 of them. | Status | Count | Meaning | |---|---|---| -| implemented+tested | 397 | in jolt and exercised by spec/conformance | -| implemented-untested | 138 | in jolt, no direct test — spec entries will add them | +| implemented+tested | 415 | in jolt and exercised by spec/conformance | +| implemented-untested | 137 | in jolt, no direct test — spec entries will add them | | resolvable-not-interned | 2 | works in code but invisible to ns introspection (conformance finding) | -| missing-portable | 27 | portable semantics, jolt lacks it — implementation gap | +| missing-portable | 10 | portable semantics, jolt lacks it — implementation gap | | special-form | 15 | specified in §3, not a library var | | dynamic-var | 31 | classification needed: portable default vs host-dependent | | agents-taps | 22 | out of scope pending concurrency design note | @@ -114,7 +114,7 @@ UNVERIFIED field; that column will be added as entries land. | `any?` | implemented+tested | ✓ | | `apply` | implemented+tested | ✓ | | `areduce` | jvm-specific | ✓ | -| `array-map` | implemented-untested | ✓ | +| `array-map` | implemented+tested | ✓ | | `as->` | implemented+tested | ✓ | | `aset` | implemented+tested | ✓ | | `aset-boolean` | implemented-untested | ✓ | @@ -155,9 +155,9 @@ UNVERIFIED field; that column will be added as entries land. | `boolean-array` | implemented-untested | ✓ | | `boolean?` | implemented+tested | ✓ | | `booleans` | implemented-untested | ✓ | -| `bound-fn` | missing-portable | ✓ | -| `bound-fn*` | missing-portable | ✓ | -| `bound?` | missing-portable | ✓ | +| `bound-fn` | implemented-untested | ✓ | +| `bound-fn*` | implemented+tested | ✓ | +| `bound?` | implemented+tested | ✓ | | `bounded-count` | implemented+tested | ✓ | | `butlast` | implemented+tested | ✓ | | `byte` | implemented-untested | ✓ | @@ -267,7 +267,7 @@ UNVERIFIED field; that column will be added as entries land. | `enumeration-seq` | implemented-untested | ✓ | | `error-handler` | agents-taps | ✓ | | `error-mode` | agents-taps | ✓ | -| `eval` | missing-portable | ✓ | +| `eval` | implemented+tested | ✓ | | `even?` | implemented+tested | ✓ | | `every-pred` | implemented+tested | ✓ | | `every?` | implemented+tested | ✓ | @@ -282,7 +282,7 @@ UNVERIFIED field; that column will be added as entries land. | `extends?` | implemented-untested | ✓ | | `false?` | implemented+tested | ✓ | | `ffirst` | implemented+tested | ✓ | -| `file-seq` | missing-portable | ✓ | +| `file-seq` | implemented+tested | ✓ | | `filter` | implemented+tested | ✓ | | `filterv` | implemented+tested | ✓ | | `finally` | special-form | ✓ | @@ -298,7 +298,7 @@ UNVERIFIED field; that column will be added as entries land. | `float-array` | implemented-untested | ✓ | | `float?` | implemented+tested | ✓ | | `floats` | implemented-untested | ✓ | -| `flush` | missing-portable | ✓ | +| `flush` | implemented+tested | ✓ | | `fn` | implemented+tested | ✓ | | `fn?` | implemented+tested | ✓ | | `fnext` | implemented+tested | ✓ | @@ -320,7 +320,7 @@ UNVERIFIED field; that column will be added as entries land. | `get-in` | implemented+tested | ✓ | | `get-method` | implemented+tested | ✓ | | `get-proxy-class` | implemented-untested | ✓ | -| `get-thread-bindings` | missing-portable | ✓ | +| `get-thread-bindings` | implemented+tested | ✓ | | `get-validator` | implemented+tested | ✓ | | `group-by` | implemented+tested | ✓ | | `halt-when` | implemented-untested | ✓ | @@ -383,7 +383,7 @@ UNVERIFIED field; that column will be added as entries land. | `load` | jvm-specific | ✓ | | `load-file` | jvm-specific | ✓ | | `load-reader` | jvm-specific | ✓ | -| `load-string` | missing-portable | ✓ | +| `load-string` | implemented+tested | ✓ | | `loaded-libs` | jvm-specific | ✓ | | `locking` | implemented+tested | ✓ | | `long` | implemented-untested | ✓ | @@ -437,13 +437,13 @@ UNVERIFIED field; that column will be added as entries land. | `ns-aliases` | implemented+tested | ✓ | | `ns-imports` | implemented-untested | ✓ | | `ns-interns` | implemented-untested | ✓ | -| `ns-map` | missing-portable | ✓ | +| `ns-map` | implemented+tested | ✓ | | `ns-name` | implemented+tested | ✓ | | `ns-publics` | implemented+tested | ✓ | -| `ns-refers` | missing-portable | ✓ | +| `ns-refers` | implemented+tested | ✓ | | `ns-resolve` | implemented+tested | ✓ | | `ns-unalias` | implemented+tested | ✓ | -| `ns-unmap` | missing-portable | ✓ | +| `ns-unmap` | implemented+tested | ✓ | | `nth` | implemented+tested | ✓ | | `nthnext` | implemented+tested | ✓ | | `nthrest` | implemented+tested | ✓ | @@ -484,7 +484,7 @@ UNVERIFIED field; that column will be added as entries land. | `print-method` | implemented-untested | ✓ | | `print-simple` | jvm-specific | ✓ | | `print-str` | implemented+tested | ✓ | -| `printf` | missing-portable | ✓ | +| `printf` | implemented+tested | ✓ | | `println` | implemented+tested | ✓ | | `println-str` | implemented+tested | ✓ | | `prn` | implemented+tested | ✓ | @@ -536,7 +536,7 @@ UNVERIFIED field; that column will be added as entries land. | `ref-max-history` | stm-refs | | | `ref-min-history` | stm-refs | ✓ | | `ref-set` | stm-refs | ✓ | -| `refer` | implemented-untested | ✓ | +| `refer` | implemented+tested | ✓ | | `refer-clojure` | implemented-untested | ✓ | | `reify` | implemented+tested | ✓ | | `release-pending-sends` | agents-taps | ✓ | @@ -594,7 +594,7 @@ UNVERIFIED field; that column will be added as entries land. | `simple-ident?` | implemented+tested | ✓ | | `simple-keyword?` | implemented+tested | ✓ | | `simple-symbol?` | implemented+tested | ✓ | -| `slurp` | missing-portable | ✓ | +| `slurp` | implemented+tested | ✓ | | `some` | implemented+tested | ✓ | | `some->` | implemented+tested | ✓ | | `some->>` | implemented+tested | ✓ | @@ -608,7 +608,7 @@ UNVERIFIED field; that column will be added as entries land. | `sorted-set-by` | implemented+tested | ✓ | | `sorted?` | implemented+tested | ✓ | | `special-symbol?` | implemented-untested | ✓ | -| `spit` | missing-portable | ✓ | +| `spit` | implemented+tested | ✓ | | `split-at` | implemented+tested | ✓ | | `split-with` | implemented+tested | ✓ | | `splitv-at` | implemented+tested | | @@ -638,7 +638,7 @@ UNVERIFIED field; that column will be added as entries land. | `tap>` | agents-taps | ✓ | | `test` | implemented-untested | ✓ | | `the-ns` | implemented+tested | ✓ | -| `thread-bound?` | missing-portable | ✓ | +| `thread-bound?` | implemented+tested | ✓ | | `throw` | special-form | ✓ | | `time` | implemented+tested | ✓ | | `to-array` | implemented-untested | ✓ | @@ -705,8 +705,8 @@ UNVERIFIED field; that column will be added as entries land. | `when-not` | implemented+tested | ✓ | | `when-some` | implemented+tested | ✓ | | `while` | implemented+tested | ✓ | -| `with-bindings` | missing-portable | ✓ | -| `with-bindings*` | missing-portable | ✓ | +| `with-bindings` | implemented+tested | ✓ | +| `with-bindings*` | implemented+tested | ✓ | | `with-in-str` | missing-portable | ✓ | | `with-loading-context` | jvm-specific | | | `with-local-vars` | missing-portable | ✓ | diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 24ef2f3..8eec17f 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -151,6 +151,35 @@ ;; Clojure 1.9: true for ANY argument incl. nil (used as a spec predicate). (defn any? [x] true) +;; printf: print (no newline) the formatted string to *out*. +(defn printf [fmt & args] (print (apply format fmt args))) + +;; bound?: every var has a root value. (jolt vars store the root in :root; +;; a nil-valued root reads as unbound — documented divergence.) +(defn bound? [& vars] + (every? (fn [v] (some? (get v :root))) vars)) + +;; Run f with a frame of dynamic bindings installed; restore on exit. +(defn with-bindings* [binding-map f & args] + (push-thread-bindings binding-map) + (try + (apply f args) + (finally (pop-thread-bindings)))) + +;; Capture the CURRENT thread bindings; the returned fn re-installs them +;; around every call (binding conveyance — Clojure's bound-fn*). +(defn bound-fn* [f] + (let [bs (get-thread-bindings)] + (fn [& args] (apply with-bindings* bs f args)))) + +(defn thread-bound? [& vars] + (every? (fn [v] (__thread-bound? v)) vars)) + +;; file-seq: the tree of paths under root (root included), directories walked +;; via the host dir primitives. Paths (strings), not File objects. +(defn file-seq [root] + (tree-seq __dir? __list-dir root)) + (defn comparator [pred] (fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0))) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 01029a1..18610eb 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -73,6 +73,12 @@ [] (partition 2 bindings))] `(with-redefs-fn (hash-map ~@pairs) (fn [] ~@body)))) +(defmacro with-bindings [binding-map & body] + `(with-bindings* ~binding-map (fn [] ~@body))) + +(defmacro bound-fn [& fntail] + `(bound-fn* (fn ~@fntail))) + (defmacro defonce [name expr] `(let [v# (resolve (quote ~name))] (if (and v# (some? (var-get v#))) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index dc2cfc9..f9dbdc5 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -145,6 +145,21 @@ # clojure.core and compiled by the self-hosted pipeline (or interpreted when # :compile? is off). Phase 4 kernel-shrink seam — see that file. (load-core-overlay! ctx) + # load-string and eval as VALUES need the loader's compile-or-interpret + # routing, which lives above the evaluator — intern them here. (The eval + # special form still handles direct calls; this covers value position, + # e.g. (map eval forms).) + (let [core (ctx-find-ns ctx "clojure.core")] + (ns-intern core "load-string" + (fn [s] + (var cur s) + (var result nil) + (while (> (length (string/trim cur)) 0) + (def [form rest-src] (parse-next cur)) + (set cur rest-src) + (when (not (nil? form)) (set result (eval-toplevel ctx form)))) + result)) + (ns-intern core "eval" (fn [form] (eval-toplevel ctx form)))) ctx)) # --- Context snapshot/fork (cheap isolated copies) -------------------------- diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 68ddac3..883572b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1832,6 +1832,53 @@ # Host time source for the `time` macro (monotonic, milliseconds). (defn core-current-time-ms [] (* 1000 (os/clock :monotonic))) +# Host IO (host-classified in the spec): path-based slurp/spit, *out* flush. +(defn core-slurp [path] (string (slurp path))) + +(defn core-spit [path content & opts] + (def append? (do (var a false) (var i 0) + (while (< i (length opts)) + (when (and (= :append (in opts i)) (in opts (+ i 1))) (set a true)) + (+= i 2)) + a)) + (def f (file/open path (if append? :a :w))) + (file/write f (str-render-one content)) + (file/close f) + nil) + +(defn core-flush [] + (def out (dyn :out)) + (when out (file/flush out)) + nil) + +# Thread-binding introspection over the frame stack (types/cur-binding-stack). +(defn core-get-thread-bindings [] + # Innermost frame wins: merge frames oldest-first. The result is a Janet + # STRUCT keyed by the var tables themselves — the exact frame representation + # var-get reads (identity-keyed get) — so the map can be re-pushed by + # with-bindings*/bound-fn* and remains lookup-able with (get m the-var). + (def acc @{}) + (each frame (snapshot-bindings) + (each entry (realize-for-iteration frame) + (put acc (in entry 0) (in entry 1)))) + (table/to-struct acc)) + +(defn core-thread-bound?* [v] + (var found false) + (each frame (snapshot-bindings) + (each entry (realize-for-iteration frame) + (when (= (in entry 0) v) (set found true)))) + found) + +# Directory primitives for file-seq (paths, not File objects — host-classified). +(defn core-dir? [path] + (def st (os/stat path)) + (and st (= :directory (st :mode)))) + +(defn core-list-dir [path] + (def entries (os/dir path)) + (map (fn [e] (string path "/" e)) (sort entries))) + # Clojure compare: a total order over comparable values. nil sorts first; # numbers numerically; strings/keywords lexically; symbols by ns then name; # booleans false var} (jolt has no private vars, so publics = interns). # Keys are symbol structs (value-hashed), matching Clojure's symbol keys. + (def mappings->symbol-map (fn [ns pred] + (var m (make-phm)) + (loop [[nm v] :pairs (ns :mappings)] + (when (pred nm v) + (set m (phm-assoc m {:jolt/type :symbol :ns nil :name nm} v)))) + m)) (ns-intern core "ns-publics" + (fn [&opt ns-d] + (mappings->symbol-map (ns-or-current ns-d) (fn [nm v] true)))) + # ns-map: all mappings (interns + refers; jolt has no class imports in maps). + (ns-intern core "ns-map" + (fn [&opt ns-d] + (mappings->symbol-map (ns-or-current ns-d) (fn [nm v] true)))) + # ns-refers: mappings whose var's HOME ns differs from this ns (copied in by + # refer/use/require :refer). + (ns-intern core "ns-refers" (fn [&opt ns-d] (def ns (ns-or-current ns-d)) - (var m (make-phm)) - (loop [[nm v] :pairs (ns :mappings)] - (set m (phm-assoc m {:jolt/type :symbol :ns nil :name nm} v))) - m)) + (def my-name (ns :name)) + (mappings->symbol-map ns (fn [nm v] + (and (table? v) (not= (get v :ns) my-name)))))) + (ns-intern core "ns-unmap" + (fn [ns-d sym] + (def ns (ns-or-current ns-d)) + (put (ns :mappings) (if (struct? sym) (sym :name) (string sym)) nil) + nil)) core) # Dispatch a special form by its string name. diff --git a/test/integration/clojure-test-suite-test.janet b/test/integration/clojure-test-suite-test.janet index 7a2b70f..ee1ecb7 100644 --- a/test/integration/clojure-test-suite-test.janet +++ b/test/integration/clojure-test-suite-test.janet @@ -43,7 +43,7 @@ # Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the # overlay, which required fixing two leniencies (a char is not callable; take # validates its count) — correct beyond those fns, so the suite rose broadly. -(def baseline-pass 4532) +(def baseline-pass 4540) # A file is "clean" when it ran with zero failures AND zero errors. (def baseline-clean-files 86) # Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so diff --git a/test/spec/stage3-io-ns-spec.janet b/test/spec/stage3-io-ns-spec.janet new file mode 100644 index 0000000..c22c2be --- /dev/null +++ b/test/spec/stage3-io-ns-spec.janet @@ -0,0 +1,39 @@ +# Specification: Stage 3 turn 2b — host-classified IO fns, ns introspection, +# the thread-binding family, and load-string/eval as values. These were +# previously either missing or silently leaked from Janet's root environment. +(use ../support/harness) + +(defspec "io / slurp, spit, printf, flush (host-classified)" + ["slurp returns string" "true" "(string? (slurp \"project.janet\"))"] + ["slurp content" "true" "(do (require (quote [clojure.string :as s])) (s/includes? (slurp \"project.janet\") \"jolt\"))"] + ["spit + slurp round" "\"hello\"" "(do (spit \"/tmp/jolt-spit-test.txt\" \"hello\") (slurp \"/tmp/jolt-spit-test.txt\"))"] + ["spit append" "\"ab\"" "(do (spit \"/tmp/jolt-spit-test.txt\" \"a\") (spit \"/tmp/jolt-spit-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-spit-test.txt\"))"] + ["printf formats" "\"x=1 y=a\"" "(with-out-str (printf \"x=%d y=%s\" 1 \"a\"))"] + ["printf no newline" "false" "(do (require (quote [clojure.string :as s])) (s/includes? (with-out-str (printf \"%d\" 1)) \"\\n\"))"] + ["flush returns nil" "nil" "(flush)"] + ["file-seq finds files" "true" "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))"]) + +(defspec "ns / ns-map, ns-unmap, ns-refers" + ["ns-map has var" "true" "(do (def nmv 1) (some? (get (ns-map (quote user)) (quote nmv))))"] + ["ns-unmap removes" "nil" "(do (def nuv 1) (ns-unmap (quote user) (quote nuv)) (resolve (quote nuv)))"] + ["ns-refers sees refer" "true" "(do (require (quote clojure.string)) (refer (quote clojure.string)) (some? (get (ns-refers (quote user)) (quote join))))"]) + +(defspec "vars / thread-binding family" + ["bound? on def" "true" "(do (def bvv 1) (bound? (var bvv)))"] + ["with-bindings* binds" "5" + "(do (def ^:dynamic dynv 1) (with-bindings* (array-map (var dynv) 5) (fn [] dynv)))"] + ["with-bindings* restores" "1" + "(do (def ^:dynamic dynw 1) (with-bindings* (array-map (var dynw) 5) (fn [] nil)) dynw)"] + ["with-bindings macro" "7" + "(do (def ^:dynamic dynx 1) (with-bindings (array-map (var dynx) 7) dynx))"] + ["thread-bound? inside" "[true false]" + "(do (def ^:dynamic dyny 1) [(with-bindings* (array-map (var dyny) 2) (fn [] (thread-bound? (var dyny)))) (thread-bound? (var dyny))])"] + ["bound-fn* conveys" "9" + "(do (def ^:dynamic dynz 1) (def f (with-bindings* (array-map (var dynz) 9) (fn [] (bound-fn* (fn [] dynz))))) (f))"] + ["get-thread-bindings" "3" + "(do (def ^:dynamic dyng 1) (with-bindings* (array-map (var dyng) 3) (fn [] (get (get-thread-bindings) (var dyng)))))"]) + +(defspec "eval & load-string as values" + ["load-string evals all" "3" "(load-string \"(def lsv 1) (+ lsv 2)\")"] + ["eval as value" "[2 3]" "(mapv eval [(quote (+ 1 1)) (quote (+ 1 2))])"] + ["eval special still works" "3" "(eval (quote (+ 1 2)))"])