diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 6179401..9f2c6c8 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -149,3 +149,8 @@ ;; double/gensym — host-coupled seed natives def-var!'d into clojure.core. Loaded ;; LAST because `str` reuses jolt-pr-str (defined just above). (load "host/chez/converters.ss") + +;; transients (jolt-kl2l): copy-on-write transient collections + persistent disj; +;; extends get/count/contains? to see through a transient. After collections.ss +;; (the persistent ops it delegates to). +(load "host/chez/transients.ss") diff --git a/host/chez/transients.ss b/host/chez/transients.ss new file mode 100644 index 0000000..62cda65 --- /dev/null +++ b/host/chez/transients.ss @@ -0,0 +1,73 @@ +;; transients (jolt-kl2l) — copy-on-write over the persistent collections. +;; +;; A first cut: each transient op rebuilds the persistent collection (no in-place +;; mutation perf), but the SEMANTICS match — the overlay's transient users (into, +;; frequencies, group-by) get correct results. get/count/contains? are extended to +;; see THROUGH a transient to its held collection (frequencies/group-by do +;; (get tm k) on a transient map). vector? on a transient vector is false (it's a +;; jolt-transient record, not a pvec), which group-by relies on. Loaded after +;; collections.ss (the persistent ops it delegates to) and converters.ss. + +(define-record-type jolt-transient (fields (mutable coll) (mutable active)) + (nongenerative jolt-transient-v1)) + +(define (jolt-transient-new coll) (make-jolt-transient coll #t)) + +(define (jolt-trans-check t who) + (unless (jolt-transient? t) (error #f (string-append who ": not a transient") t)) + (unless (jolt-transient-active t) + (error #f (string-append who ": transient used after persistent!")))) + +(define (jolt-persistent! t) + (jolt-trans-check t "persistent!") + (jolt-transient-active-set! t #f) + (jolt-transient-coll t)) + +(define (jolt-conj! t . xs) + (jolt-trans-check t "conj!") + (jolt-transient-coll-set! t (apply jolt-conj (jolt-transient-coll t) xs)) + t) +(define (jolt-assoc! t k v) + (jolt-trans-check t "assoc!") + (jolt-transient-coll-set! t (jolt-assoc (jolt-transient-coll t) k v)) + t) +(define (jolt-dissoc! t . ks) + (jolt-trans-check t "dissoc!") + (jolt-transient-coll-set! t (apply jolt-dissoc (jolt-transient-coll t) ks)) + t) +(define (jolt-disj! t . xs) + (jolt-trans-check t "disj!") + (jolt-transient-coll-set! t (apply jolt-disj (jolt-transient-coll t) xs)) + t) +(define (jolt-pop! t) + (jolt-trans-check t "pop!") + (jolt-transient-coll-set! t (jolt-pop (jolt-transient-coll t))) + t) + +;; persistent disj over sets (pset-disj already exists in collections.ss). +(define (jolt-disj s . xs) + (let loop ((s s) (xs xs)) (if (null? xs) s (loop (pset-disj s (car xs)) (cdr xs))))) + +;; get / count / contains? see through a transient. Redefine the native procedures +;; (captured first) so the existing emit lowerings (jolt-get/jolt-count/ +;; jolt-contains?) unwrap a transient before delegating; non-transients are +;; untouched. +(define (jolt-deref-transient x) (if (jolt-transient? x) (jolt-transient-coll x) x)) +(define %prev-jolt-get jolt-get) +(set! jolt-get + (case-lambda + ((coll k) (%prev-jolt-get (jolt-deref-transient coll) k)) + ((coll k d) (%prev-jolt-get (jolt-deref-transient coll) k d)))) +(define %prev-jolt-count jolt-count) +(set! jolt-count (lambda (coll) (%prev-jolt-count (jolt-deref-transient coll)))) +(define %prev-jolt-contains? jolt-contains?) +(set! jolt-contains? (lambda (coll k) (%prev-jolt-contains? (jolt-deref-transient coll) k))) + +(def-var! "clojure.core" "transient" jolt-transient-new) +(def-var! "clojure.core" "persistent!" jolt-persistent!) +(def-var! "clojure.core" "conj!" jolt-conj!) +(def-var! "clojure.core" "assoc!" jolt-assoc!) +(def-var! "clojure.core" "dissoc!" jolt-dissoc!) +(def-var! "clojure.core" "disj!" jolt-disj!) +(def-var! "clojure.core" "pop!" jolt-pop!) +(def-var! "clojure.core" "disj" jolt-disj) diff --git a/test/chez/README.md b/test/chez/README.md index 2597b98..0134ce2 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -104,21 +104,25 @@ corpus case with all of core present, bucketing the result — JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast) -Parity baseline: inc 3j **1220/2497**; inc 3k (converters, jolt-t6cr) **1326/2497**, -0 NEW divergences (13 allowlisted: dynamic vars `*ns*`/`*clojure-version*`/ -`*unchecked-math*`, var/`*ns*` rendering, class names, eval-order, with-open — all -deferred Phase-2 / dynamic-var gaps). inc 3k added `host/chez/converters.ss`: -`str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/`int`/`double`/`gensym` (seed natives, -matching `core_print.janet`/`core_io.janet` semantics — `str` reuses the printer, -`compare` is the 3-way port, the symbol no-ns sentinel is `#f` to match emit's -quoted-symbol lowering so `(= 'x (symbol "x"))` holds). +Parity baseline: inc 3j **1220/2497**; 3k (converters, jolt-t6cr) **1326**; +3l (transients, jolt-kl2l) **1382/2497**, 0 NEW divergences (13 allowlisted: +dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`, var/`*ns*` rendering, +class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). +- inc 3k `host/chez/converters.ss`: `str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/ + `int`/`double`/`gensym` (seed natives — `str` reuses the printer, `compare` is the + 3-way port, the symbol no-ns sentinel is `#f` to match emit's quoted-symbol + lowering so `(= 'x (symbol "x"))` holds). +- inc 3l `host/chez/transients.ss`: `transient`/`persistent!`/`conj!`/`assoc!`/ + `dissoc!`/`disj!`/`pop!` as copy-on-write over the persistent collections (correct + semantics, no in-place perf), plus persistent `disj`. `get`/`count`/`contains?` + are redefined to see THROUGH a transient (frequencies/group-by do `(get tm k)` on a + transient map); `vector?` on a transient vector is false, which group-by relies on. The remaining buckets are the punch-list the next increments chase: ~360 emit-fail (genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of -the analyzer's subset) and ~800 runtime crashes, dominated by core fns calling -host-coupled seed natives with no Chez shim yet (transients — inc 3l jolt-kl2l), -plus smaller buckets (`##Inf`/`##NaN` literals → unbound `inf`/`nan`, seq-prim -transducer arities — inc 3m jolt-q3w8; multimethod dispatch — Phase 2 jolt-9ls5). +the analyzer's subset) and ~740 runtime crashes, including `##Inf`/`##NaN` literals → +unbound `inf`/`nan` and seq-prim transducer arities (inc 3m jolt-q3w8), multimethod +dispatch (Phase 2 jolt-9ls5), and more host-coupled natives without a shim. Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/ reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet index 19e62dc..f966cf2 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -427,6 +427,46 @@ (ok (string "conv: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3q) transients (jolt-kl2l): transient/persistent!/conj!/assoc!/dissoc!/disj!/ +# pop! as copy-on-write over the persistent collections (host/chez/transients.ss), +# plus persistent disj. get/count/contains? see THROUGH a transient (frequencies +# and group-by do (get tm k) on a transient map). vector? on a transient vector +# is false. Map/set print order isn't canonical, so assert via get/count/contains?. +(each src ["(persistent! (conj! (transient []) 1 2 3))" + "(count (conj! (conj! (transient []) 1) 2))" + "(get (assoc! (transient {}) :a 5) :a)" + "(get (transient {:x 9}) :x)" + "(contains? (assoc! (transient {}) :k 1) :k)" + "(count (persistent! (dissoc! (assoc! (assoc! (transient {}) :a 1) :b 2) :a)))" + "(vector? (transient []))" + "(persistent! (pop! (conj! (transient [1 2 3]) 4)))" + "(count (persistent! (disj! (transient #{1 2 3}) 2)))" + "(contains? (disj #{1 2 3} 2) 2)" + "(count (disj #{1 2 3} 2))"] + (let [[code out err] (run-prelude src) want (cli-oracle src)] + (ok (string "transient: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) + +# frequencies/group-by/into are OVERLAY fns built on transients — they need the +# full assembled prelude, so exercise them end-to-end through the jolt-chez -e +# binary (which loads rt.ss + the prelude). This doubles as a smoke test of the +# assembled -e-capable jolt-chez itself. +(defn run-jolt-chez [src] + (def proc (os/spawn ["bin/jolt-chez" "-e" src] :p {:out :pipe :err :pipe})) + (def out (ev/read (proc :out) 0x100000)) + (def err (ev/read (proc :err) 0x100000)) + [(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]) +(when (os/stat "bin/jolt-chez") + (each src ["(get (frequencies [1 1 2 3 3 3]) 3)" + "(get (frequencies [:a :b :a]) :a)" + "(get (group-by even? [1 2 3 4 5]) true)" + "(count (get (group-by even? (range 10)) false))" + "(into [] (range 5))" + "(count (into #{} [1 2 2 3]))"] + (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] + (ok (string "jolt-chez -e: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err))))) + # 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers. diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index ef6eac1..4c87f71 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -129,9 +129,9 @@ # Regression floor (inc 3j baseline): raise as runtime gaps close, like the probe # reach-floor and the suite baseline. The gate fails if parity drops below it, or # on any NEW (un-allowlisted) divergence — a real Chez correctness regression. -# Full-corpus baseline: inc 3j 1220/2497; inc 3k (converters) 1326. Strided runs -# scale the floor down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1326"))) +# Full-corpus baseline: inc 3j 1220/2497; 3k (converters) 1326; 3l (transients) +# 1382. Strided runs scale the floor down. +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1382"))) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))