diff --git a/host/chez/atoms.ss b/host/chez/atoms.ss index f7a7fe9..816d6de 100644 --- a/host/chez/atoms.ss +++ b/host/chez/atoms.ss @@ -17,10 +17,13 @@ ;; (watches/validators are overlay features layered via jolt.host/ref-put!). (define (jolt-atom-new v . _opts) (make-jolt-atom v)) +;; deref reads an atom; it also unwraps a `reduced` (Clojure @(reduced x) => x, +;; which the overlay's `unreduced` relies on). The reduced record is in seq.ss. (define (jolt-deref x) - (if (jolt-atom? x) - (jolt-atom-val x) - (error #f "deref: unsupported reference type" x))) + (cond + ((jolt-atom? x) (jolt-atom-val x)) + ((jolt-reduced? x) (jolt-reduced-val x)) + (else (error #f "deref: unsupported reference type" x)))) ;; (swap! a f arg*) -> (reset! a (f @a arg*)); f is invoked through jolt-invoke ;; (a jolt fn value, keyword, or invokable collection). diff --git a/host/chez/natives-seq.ss b/host/chez/natives-seq.ss new file mode 100644 index 0000000..c3b5a01 --- /dev/null +++ b/host/chez/natives-seq.ss @@ -0,0 +1,99 @@ +;; seq-native shims (jolt-y6mv) — seed-native seq fns the overlay assumes are +;; clojure.core natives but which live in the Janet seed (src/jolt/core_coll.janet), +;; so they have no def-var! in the assembled prelude and resolve to jolt-nil on +;; Chez. This was the dominant prelude-parity crash bucket ('apply jolt-nil'). +;; Each is a pure fn over the existing seq layer (seq.ss) — collection arities +;; only; the 1-arg transducer arities are jolt-kxsr. Loaded last (after +;; converters.ss for jolt-compare and seq.ss for the reduced record). + +;; reduced / reduced? — the box itself is the jolt-reduced record from seq.ss +;; (so the reduce machinery there can see it); these just expose the constructor +;; and predicate. (deref a-reduced) is handled in atoms.ss. +(define (jolt-reduced-new x) (make-jolt-reduced x)) +(define (jolt-reduced-pred x) (jolt-reduced? x)) + +;; mapcat: (mapcat f coll & colls) — map f across the colls (stops at shortest), +;; then concat the results. Collection arity only. +(define (jolt-mapcat f . colls) + (apply jolt-concat (seq->list (apply jolt-map f colls)))) + +;; take-while / drop-while over the seq layer. +(define (take-while-seq pred s) + (if (jolt-nil? s) jolt-empty-list + (let ((x (seq-first s))) + (if (jolt-truthy? (jolt-invoke pred x)) + (cseq-lazy x (lambda () (take-while-seq pred (jolt-seq (seq-more s))))) + jolt-empty-list)))) +(define (jolt-take-while pred coll) (take-while-seq pred (jolt-seq coll))) +(define (jolt-drop-while pred coll) + (let loop ((s (jolt-seq coll))) + (if (and (not (jolt-nil? s)) (jolt-truthy? (jolt-invoke pred (seq-first s)))) + (loop (jolt-seq (seq-more s))) + (if (jolt-nil? s) jolt-empty-list s)))) + +;; partition: (partition n coll), (partition n step coll), or +;; (partition n step pad coll). Only complete partitions of size n are kept; +;; with pad, a short final partition is padded from pad (and may be < n if pad +;; runs out). Each partition is a seq; the whole result is a lazy seq of seqs. +(define jolt-partition + (case-lambda + ((n coll) (partition* (->idx n) (->idx n) #f #f coll)) + ((n step coll) (partition* (->idx n) (->idx step) #f #f coll)) + ((n step pad coll) (partition* (->idx n) (->idx step) #t pad coll)))) +(define (take-n n s) ; -> (values list-of-first-n remaining-seq taken-count) + (let loop ((n n) (s s) (acc '())) + (if (or (fx<=? n 0) (jolt-nil? s)) + (values (reverse acc) s (length acc)) + (loop (fx- n 1) (jolt-seq (seq-more s)) (cons (seq-first s) acc))))) +(define (partition* n step has-pad pad coll) + (let loop ((s (jolt-seq coll))) + (if (jolt-nil? s) jolt-empty-list + (let-values (((part rest taken) (take-n n s))) + (cond + ;; full partition: emit it, advance `step` from its START + ((fx=? taken n) + (cseq-lazy (list->cseq part) + (lambda () (loop (jolt-seq (advance-by step s)))))) + ;; short final partition with pad: top up to n from pad, then stop + ((and has-pad (fx>? taken 0)) + (let ((padded (append part (take-list (- n taken) (jolt-seq pad))))) + (cseq-lazy (list->cseq padded) (lambda () jolt-empty-list)))) + ;; short final partition, no pad: dropped (Clojure keeps only full ones) + (else jolt-empty-list)))))) +(define (advance-by step s) ; drop `step` elements from s (seq), returns a seq + (let loop ((step step) (s s)) + (if (or (fx<=? step 0) (jolt-nil? s)) s + (loop (fx- step 1) (jolt-seq (seq-more s)))))) +(define (take-list n s) ; up to n elements of seq s as a Scheme list + (let loop ((n n) (s s) (acc '())) + (if (or (fx<=? n 0) (jolt-nil? s)) (reverse acc) + (loop (fx- n 1) (jolt-seq (seq-more s)) (cons (seq-first s) acc))))) + +;; sort: (sort coll) uses compare; (sort cmp coll) uses cmp, whose result may be +;; a 3-way number (<0 / 0 / >0) OR a boolean (a Clojure-style less-than pred). +(define (cmp->less cmp) + (lambda (a b) + (let ((r (jolt-invoke cmp a b))) + (if (number? r) (< r 0) (jolt-truthy? r))))) +(define jolt-sort + (case-lambda + ((coll) (jolt-sort* (cmp->less jolt-compare) coll)) + ((cmp coll) (jolt-sort* (cmp->less cmp) coll)))) +(define (jolt-sort* less? coll) + (let ((s (jolt-seq coll))) + (if (jolt-nil? s) jolt-empty-list + (list->cseq (list-sort less? (seq->list s)))))) + +;; identical?: jolt reference identity. The seed defines it as (= a b) over its +;; value model (core_types.janet core-identical?), where interned keywords/small +;; values compare equal — so jolt= is the faithful port. +(define (jolt-identical? a b) (jolt= a b)) + +(def-var! "clojure.core" "reduced" jolt-reduced-new) +(def-var! "clojure.core" "reduced?" jolt-reduced-pred) +(def-var! "clojure.core" "mapcat" jolt-mapcat) +(def-var! "clojure.core" "take-while" jolt-take-while) +(def-var! "clojure.core" "drop-while" jolt-drop-while) +(def-var! "clojure.core" "partition" jolt-partition) +(def-var! "clojure.core" "sort" jolt-sort) +(def-var! "clojure.core" "identical?" jolt-identical?) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 2d45ac1..277f59b 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -160,3 +160,8 @@ ;; extends get/count/contains? to see through a transient. After collections.ss ;; (the persistent ops it delegates to). (load "host/chez/transients.ss") + +;; seq-native shims (jolt-y6mv): mapcat/take-while/drop-while/partition/sort + +;; reduced/reduced?/identical? — seed-native fns the overlay assumes are core +;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss. +(load "host/chez/natives-seq.ss") diff --git a/host/chez/seq.ss b/host/chez/seq.ss index 557da91..32b513a 100644 --- a/host/chez/seq.ss +++ b/host/chez/seq.ss @@ -30,6 +30,11 @@ (define-record-type empty-list-t (fields) (nongenerative empty-list-v1)) (define jolt-empty-list (make-empty-list-t)) +;; reduced (jolt-y6mv): a box a reducing fn returns to stop reduce early. The +;; reduce machinery below unwraps it; (deref a-reduced) / unreduced also read it. +;; reduced?/reduced are def-var!'d into clojure.core in natives-seq.ss. +(define-record-type jolt-reduced (fields val) (nongenerative jolt-reduced-v1)) + ;; ============================================================================ ;; jolt-seq — coerce a seqable to a non-empty seq, or jolt-nil when empty ;; ============================================================================ @@ -132,8 +137,14 @@ (define (jolt-filter pred coll) (filter-seq pred (jolt-seq coll) #t)) (define (jolt-remove pred coll) (filter-seq pred (jolt-seq coll) #f)) +;; honors `reduced`: a reducing fn that returns (reduced x) stops the fold and +;; unwraps to x (so does a reduced INIT). Checked at entry, so the value returned +;; by the last step is unwrapped on the next turn before the seq is consulted. (define (reduce-seq f acc s) - (if (jolt-nil? s) acc (reduce-seq f (jolt-invoke f acc (seq-first s)) (jolt-seq (seq-more s))))) + (cond + ((jolt-reduced? acc) (jolt-reduced-val acc)) + ((jolt-nil? s) acc) + (else (reduce-seq f (jolt-invoke f acc (seq-first s)) (jolt-seq (seq-more s)))))) (define jolt-reduce (case-lambda ((f coll) (let ((s (jolt-seq coll))) diff --git a/test/chez/README.md b/test/chez/README.md index 9324cb4..6273b8c 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -124,12 +124,27 @@ class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). `inf`/`-inf`/`nan` and `str` renders `Infinity`/`-Infinity`/`NaN` (Clojure). Plus variadic `assoc!`. (`str` of inf *inside a collection* still wants the long form — the Phase-2 recursive str renderer — so `[inf inside coll]` is allowlisted.) +- inc 3n `host/chez/natives-seq.ss` (jolt-y6mv): the dominant prelude-parity crash + bucket was `apply non-procedure jolt-nil` — core fns calling seed-native seq fns + (`src/jolt/core_coll.janet`) that have no Chez shim, so `var-deref` yields + jolt-nil. A static scan of the assembled prelude found 52 referenced-but-undefined + `clojure.core` names; this increment shims the safe, high-value seq fns: `mapcat`/ + `take-while`/`drop-while`/`partition` (collection arities — the 1-arg transducer + forms are jolt-kxsr), `sort` (compare default; a comparator may return a 3-way + number or a boolean less-than), and `reduced`/`reduced?` — a `jolt-reduced` record + in `seq.ss` that `reduce` short-circuits on and `deref` unwraps (so `unreduced` + works). `identical?` = `jolt=` (the seed's definition). `list?` was deferred: a + Chez lazy seq and a list are both `cseq`, so it can't be told apart without a + distinct list type (a real divergence risk). -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 ~715 runtime crashes — more host-coupled natives without a -shim, transducer arities (jolt-kxsr), `cdr`-on-`()` and `\p{}` regex classes -(jolt-y1zq), and multimethod dispatch (Phase 2 jolt-9ls5). +The remaining buckets are the punch-list the next increments chase (at 1467/2497): +~361 emit-fail (genuine host interop — qualified Java/Janet refs, runtime +`defmacro`/`eval`, out of the analyzer's subset) and ~655 runtime crashes — still +~590 `apply jolt-nil` (more host-coupled natives without a shim: `meta`/`with-meta`, +`format`, the `clojure.string` natives, bit ops, `var`/`volatile`/`future`/ +thread-binding ops), the transducer arities (jolt-kxsr — 1-arg `filter`/`map`/`take`/ +`take-while` + 3-arg `into`), `cdr`-on-`()` and `\p{}` regex classes (jolt-y1zq), and +multimethod dispatch (Phase 2 jolt-9ls5). 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 c22b095..71413c2 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -488,6 +488,44 @@ (ok (string "numedge: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3s) seq-native shims + reduced (jolt-y6mv): the dominant prelude-parity crash +# bucket was 'apply jolt-nil' — core fns calling seed-native seq fns with no Chez +# shim. host/chez/natives-seq.ss shims the safe, high-value ones (mapcat/ +# take-while/drop-while/partition collection arities, sort) over the seq layer, +# plus reduced/reduced? (reduce short-circuits on a reduced; deref unwraps it) +# and identical?. They lower to var-deref in prelude mode. Asserted as +# (= expected (expr)) -> "true" so seq-vs-vector equality (not print form) is the +# contract, exactly like the corpus gate. +(each src [# reduced + "(reduced? (reduced 1))" "(reduced? 1)" "(deref (reduced 9))" + "(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])" + "(= [1 1 2 2] (mapcat (fn [x] [x x]) [1 2]))" + "(= [1 3 2 4] (mapcat vector [1 2] [3 4]))" + "(= [1 2 3] (mapcat identity [[1 2] [3]]))" + "(= () (mapcat vector [] [1 2]))" + "(= [1 2] (take-while (fn [x] (< x 3)) [1 2 3 1]))" + "(= [3 1] (drop-while (fn [x] (< x 3)) [1 2 3 1]))" + "(= () (take-while pos? []))" + "(= [[1 2] [3 4]] (partition 2 [1 2 3 4 5]))" + "(= [[1 2] [4 5]] (partition 2 3 [1 2 3 4 5 6]))" + "(= [[1 2] [3 :p]] (partition 2 2 [:p] [1 2 3]))" + "(= [1 2 3] (sort [3 1 2]))" + "(= [3 2 1] (sort > [1 3 2]))" + "(= [nil 1 3] (sort compare [3 nil 1]))" + "(= () (sort []))" + "(identical? :a :a)" "(identical? :a :b)"] + (let [[code out err] (run-prelude src) want (cli-oracle src)] + (ok (string "seq-native: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) +# reduce-kv honors reduced is an OVERLAY fn over the native reduce — exercise it +# end-to-end through the assembled -e binary. +(when (os/stat "bin/jolt-chez") + (each src ["(= [:a] (reduce-kv (fn [a i v] (if (= i 1) (reduced a) (conj a v))) [] [:a :b :c]))" + "(= 9 (unreduced (reduced 9)))" "(= 9 (unreduced 9))"] + (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] + (ok (string "seq-native -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 9269436..114aad5 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -135,8 +135,9 @@ # 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; 3k (converters) 1326; 3l (transients) -# 1382; 3m (numeric-edge emit + variadic assoc!) 1407. Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1407"))) +# 1382; 3m (numeric-edge emit + variadic assoc!) 1407; 3n (seq-native shims + +# reduced) 1467. Strided runs scale down. +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1467"))) (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)))