diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 0404da0..59c0c3a 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -66,6 +66,16 @@ (def final-scm (emit/emit (backend/analyze-form ctx (in forms (- n 1))))) (emit/program def-scm final-scm)) +# Drain a pipe to EOF. A single (ev/read pipe N) can return BEFORE the child has +# flushed everything — a program with a stdout side effect (newline/print) flushes +# in two writes, and the first ev/read sometimes catches only the first chunk, so +# the trailing real value is lost (intermittent gate divergence). Loop until EOF. +(defn- drain [pipe] + (def b @"") + (var c (ev/read pipe 0x10000)) + (while c (buffer/push b c) (set c (ev/read pipe 0x10000))) + (string b)) + (defn run-on-chez "Compile `src` and run it on Chez; returns [exit-code stdout stderr]." [ctx src &opt scheme-out] @@ -73,10 +83,10 @@ (def path (or scheme-out "/tmp/chez-jolt-prog.ss")) (spit path prog) (def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (def err (ev/read (proc :err) 0x100000)) + (def out (drain (proc :out))) + (def err (drain (proc :err))) (def code (os/proc-wait proc)) - [code (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]) + [code (string/trim out) (string/trim err)]) # --- clojure.core prelude assembly (jolt-9ziu) -------------------------------- # The -e-capable jolt-chez path: emit EVERY non-macro clojure.core form across @@ -172,7 +182,7 @@ path (or scheme-out (string "/tmp/jolt-chez-e-" (os/getpid) ".ss"))] (spit path prog) (def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (def err (ev/read (proc :err) 0x100000)) + (def out (drain (proc :out))) + (def err (drain (proc :err))) (def code (os/proc-wait proc)) - [code (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]))) + [code (string/trim out) (string/trim err)]))) diff --git a/host/chez/natives-xform.ss b/host/chez/natives-xform.ss new file mode 100644 index 0000000..5275ac3 --- /dev/null +++ b/host/chez/natives-xform.ss @@ -0,0 +1,51 @@ +;; volatiles + sequence / transduce (jolt-cf1q.3, jolt-xjx6) — the transducer +;; application surface. +;; +;; `sequence` and `transduce` are seed natives that were jolt-nil on the prelude. +;; The stateful transducer arities (take-nth/map-indexed/partition-by/dedupe/ +;; distinct, all overlay) use volatile!/vswap!/vreset!/deref, also unshimmed — so +;; the whole (sequence xform coll) / (transduce xform f coll) surface crashed. +;; +;; Volatiles are a native mutable box (jvol) — the overlay vreset!/vswap! drive a +;; volatile through jolt.host/ref-put!+get, but a Chez volatile is a record, not a +;; tagged table, so those overlay versions are overridden natively in +;; post-prelude.ss. transduce/sequence build on the existing into-xform / reduce- +;; seq machinery (natives-seq.ss / seq.ss). Loaded after those + atoms.ss (deref). + +;; --- volatiles --------------------------------------------------------------- +(define-record-type jvol (fields (mutable v)) (nongenerative chez-jvol-v1)) +(define (jolt-volatile! x) (make-jvol x)) +(define (jolt-vreset! vol x) (jvol-v-set! vol x) x) +(define (jolt-vswap! vol f . args) + (let ((nv (apply jolt-invoke f (jvol-v vol) args))) (jvol-v-set! vol nv) nv)) +(define (jolt-volatile-pred? x) (jvol? x)) +;; deref reads a volatile too (partition-all/-by transducers @-deref their box). +(define %xf-deref jolt-deref) +(set! jolt-deref (lambda (x) (if (jvol? x) (jvol-v x) (%xf-deref x)))) + +(def-var! "clojure.core" "volatile!" jolt-volatile!) +(def-var! "clojure.core" "deref" jolt-deref) + +;; --- transduce / sequence ---------------------------------------------------- +;; (transduce xform f coll) / (transduce xform f init coll): build the transformed +;; reducing fn (xform f), reduce it over coll (reduce-seq honors `reduced`), then +;; run the completion (1-arg) arity. The 3-arg init defaults to (f) — the rf's +;; 0-arity, e.g. (+) = 0, (conj) = []. +(define jolt-transduce + (case-lambda + ((xform f coll) (jolt-transduce xform f (jolt-invoke f) coll)) + ((xform f init coll) + (let* ((xf (jolt-invoke xform f)) + (res (reduce-seq xf init (jolt-seq coll)))) + (jolt-invoke xf res))))) + +;; (sequence coll) -> a seq; (sequence xform coll) -> coll transformed by xform. +;; Materialized eagerly through into-xform then seq'd (corpus inputs are finite; a +;; fully-lazy pull is future work). Honors reduced via into-xform/reduce-seq. +(define jolt-sequence + (case-lambda + ((coll) (jolt-seq coll)) + ((xform coll) (jolt-seq (into-xform (jolt-vector) xform coll))))) + +(def-var! "clojure.core" "transduce" jolt-transduce) +(def-var! "clojure.core" "sequence" jolt-sequence) diff --git a/host/chez/post-prelude.ss b/host/chez/post-prelude.ss index 88ea85a..1826bf7 100644 --- a/host/chez/post-prelude.ss +++ b/host/chez/post-prelude.ss @@ -13,3 +13,9 @@ ;; override.) (def-var! "clojure.core" "char?" jolt-char-pred?) (def-var! "clojure.core" "atom?" jolt-atom?) +;; volatiles: a Chez volatile is a jvol record, but the overlay vreset!/vswap!/ +;; volatile? drive it via jolt.host/ref-put!+get / :jolt/type (tagged-table only). +;; Override with the native versions (defined in natives-xform.ss). +(def-var! "clojure.core" "vreset!" jolt-vreset!) +(def-var! "clojure.core" "vswap!" jolt-vswap!) +(def-var! "clojure.core" "volatile?" jolt-volatile-pred?) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 1de77d9..7eb4834 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -212,3 +212,8 @@ ;; iterate/cycle/dedupe/take-nth/keep/interpose/reductions/tree-seq/lazy-cat). ;; Loaded LAST so %ls-seq captures the fully-extended (sorted-aware) jolt-seq. (load "host/chez/lazy-bridge.ss") + +;; volatiles + sequence / transduce (jolt-xjx6, Phase 2): native volatile boxes + +;; the transduce/sequence entry points over into-xform/reduce-seq. After +;; natives-seq.ss (into-xform), seq.ss (reduce-seq) + atoms.ss (deref). +(load "host/chez/natives-xform.ss") diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 5cf0077..f298140 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -176,8 +176,12 @@ # referential lazy-cat (fib) stays productive. Unblocks repeat/iterate/cycle/ # dedupe/take-nth/keep/interpose/reductions/map-indexed/distinct/interleave/ # tree-seq->flatten/partition-all/lazy-cat) 1886. +# Phase 2 inc H (jolt-xjx6: native volatiles (jvol) + sequence/transduce over the +# existing into-xform/reduce-seq — unblocks (sequence xform coll), (transduce +# xform f coll), and the stateful transducer xforms take-nth/map-indexed/ +# partition-by that drive a volatile) 1898. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1886"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1898"))) (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)))