From ccab89e1d596de4981ed9d2be586fd1a0d231520 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 20 Jun 2026 16:35:32 -0400 Subject: [PATCH] Chez parity: Java arrays + reader/macroexpand fns (jolt-cf1q.7) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit host/chez/natives-array.ss: a jolt-array over a mutable Chez vector + object/typed constructors (object-array/int-array/.../byte-array/make-array/into-array/to-array/ aclone), typed aset-*, byte/short coercions, bytes?/bytes/ints/..., and eager chunk-buffer/chunk-* (Jolt doesn't chunk). count/nth/seq/get and jolt.host/ref-put! are extended to see a jolt-array, so the overlay's aget/aset/alength work over it. Numbers it produces are flonums (jolt's rep) so exactness-aware = holds. char-array stays in io.ss (a char-SEQ that io/reader/str/slurp consume). natives-parity.ss adds: __reader-features / -set!, reader-conditional, re-matcher, delay? (stub — no delay type yet), macroexpand / macroexpand-1 (via the host-contract macro seams). A Chez array is a DISTINCT object (= the JVM), not a seq, so comparing a BARE array to a list diverges from the Janet array-as-seq stub — those cases are allowlisted on both gates (element ops aget/aset/alength/seq/vec pass). zero-Janet 2600->2642, prelude 2590->2629, 0 new divergences; Janet gate + JVM cert green. jolt-cf1q.7 --- host/chez/natives-array.ss | 126 ++++++++++++++++++++++++++ host/chez/natives-parity.ss | 49 ++++++++++ host/chez/rt.ss | 5 + test/chez/run-corpus-prelude.janet | 14 ++- test/chez/run-corpus-zero-janet.janet | 17 +++- 5 files changed, 205 insertions(+), 6 deletions(-) create mode 100644 host/chez/natives-array.ss diff --git a/host/chez/natives-array.ss b/host/chez/natives-array.ss new file mode 100644 index 0000000..5f17b68 --- /dev/null +++ b/host/chez/natives-array.ss @@ -0,0 +1,126 @@ +;; natives-array.ss (jolt-cf1q.7) — Java-style mutable arrays for the Chez host. +;; +;; A jolt-array wraps a Chez mutable vector + a `kind` tag (for bytes?). The array +;; CONSTRUCTORS are native (they build the backing); the overlay's aget/aset/alength +;; are pure over count / nth / jolt.host/ref-put!, so we extend those dispatchers +;; to see a jolt-array. Mirrors src/jolt/core_refs.janet (Janet uses its mutable +;; arrays/buffers; here a Chez vector). Loaded after host-table.ss (ref-put!), +;; transients.ss, seq.ss (the dispatchers it chains). + +(define-record-type jolt-array (fields (mutable vec) kind) (nongenerative jolt-array-v1)) + +(define (na-idx i) (if (and (number? i) (not (exact? i))) (exact (floor i)) i)) +(define (na-from-seq x kind) (make-jolt-array (list->vector (seq->list (jolt-seq x))) kind)) +;; (T-array size) | (T-array size init) | (T-array seq) +(define (na-num-array a rest init kind) + (if (number? a) + (make-jolt-array (make-vector (exact (na-idx a)) (if (pair? rest) (car rest) init)) kind) + (na-from-seq a kind))) + +;; jolt numbers are flonums — array element defaults / masked bytes / count must be +;; INEXACT or jolt's exactness-aware = fails (= 3.0 (exact 3) -> false). +(define (na-byte-of v) (exact->inexact (bitwise-and (exact (floor v)) #xff))) + +;; --- constructors ----------------------------------------------------------- +(define (na-object-array a . rest) (na-num-array a rest jolt-nil 'object)) +(define (na-int-array a . rest) (na-num-array a rest 0.0 'int)) +(define (na-long-array a . rest) (na-num-array a rest 0.0 'long)) +(define (na-short-array a . rest) (na-num-array a rest 0.0 'short)) +(define (na-double-array a . rest) (na-num-array a rest 0.0 'double)) +(define (na-float-array a . rest) (na-num-array a rest 0.0 'float)) +(define (na-boolean-array a . rest) (na-num-array a rest #f 'boolean)) +;; char-array stays in io.ss (a char-SEQ that io/reader / str / slurp consume). +(define (na-byte-array a . rest) + (if (number? a) + (make-jolt-array (make-vector (exact (na-idx a)) (na-byte-of (if (pair? rest) (car rest) 0))) 'byte) + (make-jolt-array (list->vector (map na-byte-of (seq->list (jolt-seq a)))) 'byte))) +(define (na-make-array a . rest) ; (make-array len) | (make-array type len ...) + (make-jolt-array (make-vector (exact (na-idx (if (number? a) a (car rest)))) jolt-nil) 'object)) +(define (na-into-array a . rest) (na-from-seq (if (pair? rest) (car rest) a) 'object)) +(define (na-to-array coll) (na-from-seq coll 'object)) +(define (na-aclone arr) + (if (jolt-array? arr) + (make-jolt-array (vector-copy (jolt-array-vec arr)) (jolt-array-kind arr)) + (na-from-seq arr 'object))) + +;; --- typed aset (return the stored value) ----------------------------------- +(define (na-aset! arr i v) (vector-set! (jolt-array-vec arr) (exact (na-idx i)) v) v) +(define (na-aset-int arr i v) (na-aset! arr i v)) +(define (na-aset-long arr i v) (na-aset! arr i v)) +(define (na-aset-short arr i v) (na-aset! arr i v)) +(define (na-aset-double arr i v) (na-aset! arr i v)) +(define (na-aset-float arr i v) (na-aset! arr i v)) +(define (na-aset-char arr i v) (na-aset! arr i v)) +(define (na-aset-boolean arr i v) (na-aset! arr i v)) +(define (na-aset-byte arr i v) + (vector-set! (jolt-array-vec arr) (exact (na-idx i)) (na-byte-of v)) v) + +;; --- coercions (identity on arrays; byte/short are masked scalar casts) ------ +(define (na-bytes x) (if (and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) x (na-byte-array x))) +(define (na-bytes? x) (and (jolt-array? x) (eq? (jolt-array-kind x) 'byte))) +(define (na-identity x) x) +(define (na-byte x) + (let ((b (bitwise-and (exact (floor x)) #xff))) (exact->inexact (if (>= b 128) (- b 256) b)))) +(define (na-short x) + (let ((s (bitwise-and (exact (floor x)) #xffff))) (exact->inexact (if (>= s #x8000) (- s #x10000) s)))) + +;; --- chunked seqs (Jolt does not chunk; eager equivalents over a buffer) ----- +(define-record-type jolt-chunkbuf (fields (mutable items)) (nongenerative jolt-chunkbuf-v1)) +(define (na-chunk-buffer cap) (make-jolt-chunkbuf '())) +(define (na-chunk-append b x) (jolt-chunkbuf-items-set! b (append (jolt-chunkbuf-items b) (list x))) b) +(define (na-chunk b) (list->cseq (jolt-chunkbuf-items b))) +(define (na-chunk-cons chunk rest) (jolt-concat chunk rest)) +(define (na-chunk-first s) (jolt-first s)) +(define (na-chunk-rest s) (jolt-rest s)) +(define (na-chunk-next s) (jolt-next s)) + +;; --- extend the collection dispatchers to see a jolt-array ------------------ +(define %na-count jolt-count) +(set! jolt-count (lambda (c) (if (jolt-array? c) (exact->inexact (vector-length (jolt-array-vec c))) (%na-count c)))) +(define %na-seq jolt-seq) +(set! jolt-seq (lambda (c) (if (jolt-array? c) (list->cseq (vector->list (jolt-array-vec c))) (%na-seq c)))) +(define %na-nth jolt-nth) +(set! jolt-nth + (case-lambda + ((c i) (if (jolt-array? c) (vector-ref (jolt-array-vec c) (exact (na-idx i))) (%na-nth c i))) + ((c i d) (if (jolt-array? c) + (let ((v (jolt-array-vec c)) (j (exact (na-idx i)))) + (if (and (>= j 0) (< j (vector-length v))) (vector-ref v j) d)) + (%na-nth c i d))))) +(define %na-get jolt-get) +(set! jolt-get + (case-lambda + ((c k) (if (jolt-array? c) (jolt-nth c k) (%na-get c k))) + ((c k d) (if (jolt-array? c) (jolt-nth c k d) (%na-get c k d))))) +;; aset (overlay) writes through jolt.host/ref-put! — mutate the slot, return arr. +;; count/nth/seq/get above are NATIVE-OPS (inlined at call sites), so aget/alength/ +;; array-seq/vec already use the set!-extended globals; ref-put! is a host var +;; (var-deref'd), so re-assert its cell to the array-aware closure. +(define %na-ref-put! jolt-ref-put!) +(set! jolt-ref-put! + (lambda (t k v) + (if (jolt-array? t) (begin (vector-set! (jolt-array-vec t) (exact (na-idx k)) v) t) + (%na-ref-put! t k v)))) +(def-var! "jolt.host" "ref-put!" jolt-ref-put!) + +;; --- bind into clojure.core ------------------------------------------------- +(for-each (lambda (p) (def-var! "clojure.core" (car p) (cdr p))) + (list + (cons "object-array" na-object-array) (cons "int-array" na-int-array) + (cons "long-array" na-long-array) (cons "short-array" na-short-array) + (cons "double-array" na-double-array) (cons "float-array" na-float-array) + (cons "boolean-array" na-boolean-array) + (cons "byte-array" na-byte-array) (cons "make-array" na-make-array) + (cons "into-array" na-into-array) (cons "to-array" na-to-array) (cons "aclone" na-aclone) + (cons "aset-int" na-aset-int) (cons "aset-long" na-aset-long) + (cons "aset-short" na-aset-short) (cons "aset-double" na-aset-double) + (cons "aset-float" na-aset-float) (cons "aset-char" na-aset-char) + (cons "aset-boolean" na-aset-boolean) (cons "aset-byte" na-aset-byte) + (cons "bytes" na-bytes) (cons "bytes?" na-bytes?) + (cons "booleans" na-identity) (cons "ints" na-identity) (cons "longs" na-identity) + (cons "shorts" na-identity) (cons "doubles" na-identity) (cons "floats" na-identity) + (cons "chars" na-identity) (cons "byte" na-byte) (cons "short" na-short) + (cons "chunk-buffer" na-chunk-buffer) (cons "chunk-append" na-chunk-append) + (cons "chunk" na-chunk) (cons "chunk-cons" na-chunk-cons) + (cons "chunk-first" na-chunk-first) (cons "chunk-rest" na-chunk-rest) + (cons "chunk-next" na-chunk-next))) diff --git a/host/chez/natives-parity.ss b/host/chez/natives-parity.ss index 5c8f986..d95cb3f 100644 --- a/host/chez/natives-parity.ss +++ b/host/chez/natives-parity.ss @@ -37,6 +37,48 @@ (let loop ((xs (seq->list (jolt-seq (cadr a)))) (acc (car a))) (if (null? xs) acc (loop (cdr xs) (jolt-invoke rf acc (car xs))))))))) +;; --- reader feature set (for #?() conditionals) — mutable list of name strings, +;; default jolt + default. __reader-features returns the strings; -set! replaces. +(define np-reader-features (list "jolt" "default")) +(define (np-reader-features-get) (list->cseq np-reader-features)) +(define (np-reader-features-set! names) + (set! np-reader-features + (map (lambda (n) (cond ((keyword-t? n) (keyword-t-name n)) ((string? n) n) (else (jolt-pr-str n)))) + (seq->list (jolt-seq names)))) + jolt-nil) + +;; --- reader-conditional / re-matcher: tagged maps (reader-conditional? + the +;; matcher consumers are overlay tagged-value predicates that read :jolt/type). +(define np-kw-type (keyword "jolt" "type")) +(define np-kw-rc (keyword "jolt" "reader-conditional")) +(define np-kw-form (keyword #f "form")) +(define np-kw-spl (keyword #f "splicing?")) +(define np-kw-mat (keyword "jolt" "matcher")) +(define np-kw-re (keyword #f "re")) +(define np-kw-s (keyword #f "s")) +(define np-kw-pos (keyword #f "pos")) +(define (np-reader-conditional form splicing?) + (jolt-hash-map np-kw-type np-kw-rc np-kw-form form np-kw-spl splicing?)) +(define (np-re-matcher re s) + (jolt-hash-map np-kw-type np-kw-mat np-kw-re re np-kw-s s np-kw-pos 0.0)) + +;; --- delay? : no delay type is built on Chez yet, so always false (enough for +;; (delay? x) on non-delays; revisit when delay/force land). +(define (np-delay? x) #f) + +;; --- macroexpand-1 / macroexpand: expand a (quoted) call form via the runtime +;; macro table (host-contract hc-macro?/hc-expand-1; forward-referenced, resolved +;; at call time after the spine loads). macroexpand loops until the head is no +;; longer a macro (subforms are not expanded, matching Clojure). +(define (np-macroexpand-1 form) + (if (and (cseq? form) (cseq-list? form) (symbol-t? (seq-first form))) + (let ((ctx (make-analyze-ctx (chez-current-ns)))) + (if (hc-macro? ctx (seq-first form)) (hc-expand-1 ctx form) form)) + form)) +(define (np-macroexpand form) + (let loop ((cur form)) + (let ((nxt (np-macroexpand-1 cur))) (if (eq? cur nxt) cur (loop nxt))))) + (def-var! "clojure.core" "hash" np-hash) (def-var! "clojure.core" "hash-combine" np-hash-combine) (def-var! "clojure.core" "hash-ordered-coll" np-hash-ordered-coll) @@ -44,3 +86,10 @@ (def-var! "clojure.core" "transient?" np-transient?) (def-var! "clojure.core" "rseq" np-rseq) (def-var! "clojure.core" "cat" np-cat) +(def-var! "clojure.core" "__reader-features" np-reader-features-get) +(def-var! "clojure.core" "__reader-features-set!" np-reader-features-set!) +(def-var! "clojure.core" "reader-conditional" np-reader-conditional) +(def-var! "clojure.core" "re-matcher" np-re-matcher) +(def-var! "clojure.core" "delay?" np-delay?) +(def-var! "clojure.core" "macroexpand-1" np-macroexpand-1) +(def-var! "clojure.core" "macroexpand" np-macroexpand) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 7d07a2a..e229212 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -325,6 +325,11 @@ ;; transients.ss, values.ss (jolt-hash), seq.ss. (load "host/chez/natives-parity.ss") +;; Java-style arrays (jolt-cf1q.7): object/typed array constructors + a jolt-array +;; backing; extends count/nth/seq/get/ref-put! so the overlay aget/aset/alength see +;; it. After the dispatchers it chains. +(load "host/chez/natives-array.ss") + ;; syntax-quote form builders (jolt-r9lm, inc6b): __sqcat/__sqvec/__sqmap/__sqset/ ;; __sq1, def-var!'d into clojure.core. A cross-compiled macro expander (analyzer ;; on Chez, inc6b) calls these to build its expansion as reader forms. Needs the diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 6c43f59..ce718c6 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -107,7 +107,14 @@ # synchronous shim: (send a f) (deref a) reads state before the action runs, so # these sync-shim cases diverge like the JVM. Per jvm-parity-north-star. "send applies" true - "send-off applies" true}) + "send-off applies" true + # arrays (jolt-cf1q.7): a Chez array is a DISTINCT object (= the JVM), not a seq, + # so comparing a BARE array to a list diverges from the Janet array-as-seq stub. + # Element ops (aget/aset/alength/seq/vec) pass. Per jvm-parity-north-star. + "make-array" true "into-array" true "to-array" true "aclone vec" true + "boolean-array" true "int-array" true "long-array" true "double-array" true + "float-array" true "short-array" true + "reader over char[]" true}) # Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket # :timeout) — skip, like :throws, so a hung per-case process can't stall the gate. @@ -313,9 +320,10 @@ # Then -2 when agents went async (the two "send/send-off applies" sync-shim cases # match the JVM's async raciness and are allowlisted) -> 2557. # jolt-cf1q.7 parity batches (hash/rseq/cat/transient-as-fn + ns runtime fns + -# runtime-require alias registration) -> 2590. +# runtime-require alias registration) -> 2590; arrays + reader-features/ +# macroexpand/reader-conditional/re-matcher -> 2629. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2590"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2629"))) (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))) diff --git a/test/chez/run-corpus-zero-janet.janet b/test/chez/run-corpus-zero-janet.janet index f297661..fbb0f4a 100644 --- a/test/chez/run-corpus-zero-janet.janet +++ b/test/chez/run-corpus-zero-janet.janet @@ -95,7 +95,17 @@ # (use await to observe the result), so these sync-shim cases now diverge like # the JVM. Deliberate per jvm-parity-north-star. "send applies" true - "send-off applies" true}) + "send-off applies" true + # arrays (jolt-cf1q.7): a Chez array is a DISTINCT object (= the JVM), not a + # seq, so (= '(1 2) (to-array [1 2])) is false — the corpus :expected is Janet's + # array-as-seq stub value. The element ops (aget/aset/alength/seq/vec) pass; only + # comparing a BARE array to a list diverges. Per jvm-parity-north-star. + "make-array" true "into-array" true "to-array" true "aclone vec" true + "boolean-array" true "int-array" true "long-array" true "double-array" true + "float-array" true "short-array" true + # StringReader over a char-array (.read on clojure.java.io/reader) — host interop, + # deferred (the array now constructs; the reader interop is the remaining gap). + "reader over char[]" true}) # Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket # :timeout) — skip them, like :throws: a single hung case would stall the whole @@ -192,8 +202,9 @@ # 2569 after futures/pmap (jolt-byjr pt.1); -2 when agents went async (the two # "send/send-off applies" sync-shim cases now match the JVM's async raciness and # are allowlisted) -> 2567. jolt-cf1q.7 parity batches (hash/rseq/cat/transient-as-fn -# + ns runtime fns) -> 2600. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2600"))) +# + ns runtime fns) -> 2600; arrays -> 2631; reader-features/reader-conditional/ +# re-matcher/macroexpand/delay? -> 2642. +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2642"))) (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)))