From 3721423a64d67f8c184857599f141bd6bf02dabb Mon Sep 17 00:00:00 2001 From: Yogthos Date: Mon, 22 Jun 2026 00:21:05 -0400 Subject: [PATCH] real chunked seqs for vector seqs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A vector's seq is now a real chunked-seq (chunked-seq? true), matching Clojure/ CLJS. Each vector-seq cell carries its backing vector + element index as two cseq fields (cvec/ci, no extra allocation vs the old lazy cell), so: - chunk-first hands out a 32-element block (a pvec slice), chunk-rest is the seq at the next block boundary — the ChunkedSeq contract (chunk-first ++ chunk-rest == the seq); - reduce/transduce take a fast path that walks the backing vector by index in a tight loop with no per-element seq cells (reduce over a 1M-vector ~0.4s). The seq cell stays a cseq, so first/rest/count/printing and the ~26 cseq? dispatch sites are untouched. The eager chunk-buffer model (chunk-buffer/chunk/ chunk-cons) is preserved for the round-trip case. No seed change (runtime only). --- host/chez/natives-array.ss | 32 +++++++++++++++++++++++++++----- host/chez/post-prelude.ss | 3 +++ host/chez/run-corpus.ss | 5 ++--- host/chez/seq.ss | 30 ++++++++++++++++++++++++------ 4 files changed, 56 insertions(+), 14 deletions(-) diff --git a/host/chez/natives-array.ss b/host/chez/natives-array.ss index 4937032..5f53cee 100644 --- a/host/chez/natives-array.ss +++ b/host/chez/natives-array.ss @@ -80,15 +80,37 @@ (define (na-short x) (let ((s (bitwise-and (exact (floor x)) #xffff))) (if (>= s #x8000) (- s #x10000) s))) -;; --- chunked seqs (Jolt does not chunk; eager equivalents over a buffer) ----- +;; --- chunked seqs ----------------------------------------------------------- +;; A vector's seq is a REAL chunked-seq: (seq v) carries its backing vector + +;; element index (seq.ss cseq-vec), so chunked-seq? is true and chunk-first hands +;; out a 32-element block (a pvec slice) while chunk-rest is the seq at the next +;; block boundary — the Clojure/CLJS ChunkedSeq contract (chunk-first ++ +;; chunk-rest == the seq). The eager buffer model (chunk-buffer/chunk-append/ +;; chunk) builds a plain cseq; chunk-cons/first/rest fall back to seq ops over it. +(define na-chunk-size 32) (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)) +;; backing (vector . end-of-block index) for a vector-seq cell, or #f. +(define (na-vblock s) + (and (cseq? s) (cseq-cvec s) + (let* ((v (cseq-cvec s)) (i (cseq-ci s))) + (cons v (fxmin (fx+ i na-chunk-size) (pvec-count v)))))) +(define (na-chunked-seq? x) (and (na-vblock x) #t)) +(define (na-chunk-first s) + (let ((vb (na-vblock s))) + (if vb (make-pvec (vec-copy-range (pvec-v (car vb)) (cseq-ci s) (cdr vb))) + (jolt-first s)))) ; eager-buffer fallback +(define (na-chunk-rest s) + (let ((vb (na-vblock s))) + (if vb (if (fx>=? (cdr vb) (pvec-count (car vb))) jolt-empty-list (vec->seq (car vb) (cdr vb))) + (jolt-rest s)))) +(define (na-chunk-next s) + (let ((vb (na-vblock s))) + (if vb (if (fx>=? (cdr vb) (pvec-count (car vb))) jolt-nil (vec->seq (car vb) (cdr vb))) + (jolt-next s)))) ;; --- extend the collection dispatchers to see a jolt-array ------------------ (define %na-count jolt-count) @@ -172,4 +194,4 @@ (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))) + (cons "chunk-next" na-chunk-next) (cons "chunked-seq?" na-chunked-seq?))) diff --git a/host/chez/post-prelude.ss b/host/chez/post-prelude.ss index 2f1c782..6534f1d 100644 --- a/host/chez/post-prelude.ss +++ b/host/chez/post-prelude.ss @@ -94,3 +94,6 @@ (def-var! "clojure.core" "rational?" jolt-rational?) (def-var! "clojure.core" "decimal?" jolt-decimal?) (def-var! "clojure.core" "==" jolt-num-equiv) +;; chunked-seq? is true for a vector's seq (a real chunked-seq); the overlay's +;; always-false stub loaded over the host fn, so re-assert it (jolt-hs5q). +(def-var! "clojure.core" "chunked-seq?" na-chunked-seq?) diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index 376eda8..f1979c3 100644 --- a/host/chez/run-corpus.ss +++ b/host/chez/run-corpus.ss @@ -11,7 +11,7 @@ ;; reset between cases so there is no leakage — same isolation a fresh process gives. ;; ;; chez --script host/chez/run-corpus.ss -;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2727) +;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2728) ;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0) ;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels (import (chezscheme)) @@ -87,7 +87,6 @@ ;; a NEW (unlisted) divergence or a drop below the floor. (define known-fail-labels '("getMessage on a thrown string" - "chunked-seq? always false" "close on throw" "macroexpand-1" "bean is the map" "proxy resolves nil" "transient vector" "transient map" @@ -189,7 +188,7 @@ ;; Regression floor: fail on any NEW divergence or if pass drops below the floor. (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR"))) - (if s (string->number s) 2727))) + (if s (string->number s) 2728))) (define floor (if limit 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n" diff --git a/host/chez/seq.ss b/host/chez/seq.ss index d1acc72..ce0f417 100644 --- a/host/chez/seq.ss +++ b/host/chez/seq.ss @@ -24,10 +24,18 @@ ;; since one record type backs both (clojure.core/list? — jolt-75sv). The marker ;; lives on the cell, so (rest a-list) / (seq a-vector) / (map …) yield plain seq ;; cells and are not list?. -(define-record-type cseq (fields head (mutable tail) (mutable forced?) list?) (nongenerative chez-cseq-v2)) -(define (cseq-realized head tail) (make-cseq head tail #t #f)) ; tail already a seq -(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f #f)) -(define (cseq-list head tail) (make-cseq head tail #t #t)) ; a PersistentList node +;; cvec/ci: for a vector-backed seq cell, the backing vector and this cell's +;; element index — so it is a real chunked-seq (chunked-seq? true, chunk-first +;; hands out a 32-element block, chunk-rest is the seq at the next block) and +;; reduce iterates the vector directly with no per-element cells (jolt-hs5q). +;; cvec is #f for every other seq; stored as two fields (not a cons) so a vector +;; seq cell costs no extra allocation. The rest of the seq layer ignores them, so +;; first/rest/count/printing are unchanged. +(define-record-type cseq (fields head (mutable tail) (mutable forced?) list? cvec ci) (nongenerative chez-cseq-v3)) +(define (cseq-realized head tail) (make-cseq head tail #t #f #f 0)) ; tail already a seq +(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f #f #f 0)) +(define (cseq-list head tail) (make-cseq head tail #t #t #f 0)) ; a PersistentList node +(define (cseq-vec head tail-thunk v i) (make-cseq head tail-thunk #f #f v i)) ; vector-backed (define (seq-first s) (cseq-head s)) (define (seq-more s) ; force the tail; returns a seq (cseq | jolt-nil) (if (cseq-forced? s) (cseq-tail s) @@ -47,9 +55,9 @@ ;; ============================================================================ (define (list->cseq xs) ; Scheme list -> realized cseq chain (jolt-nil if empty) (if (null? xs) jolt-nil (cseq-realized (car xs) (list->cseq (cdr xs))))) -(define (vec->seq v i) ; lazy index seq over a persistent vector +(define (vec->seq v i) ; chunked index seq over a persistent vector (if (fx>=? i (pvec-count v)) jolt-nil - (cseq-lazy (pvec-nth-d v i jolt-nil) (lambda () (vec->seq v (fx+ i 1)))))) + (cseq-vec (pvec-nth-d v i jolt-nil) (lambda () (vec->seq v (fx+ i 1))) v i))) (define (str->seq s i) (if (fx>=? i (string-length s)) jolt-nil (cseq-lazy (string-ref s i) (lambda () (str->seq s (fx+ i 1)))))) @@ -168,10 +176,20 @@ ;; 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. +;; reduce a vector's backing store directly by index from element i — no per- +;; element seq cells. Honors `reduced`. The chunked-seq fast path. +(define (vec-reduce f acc v i) + (let ((n (pvec-count v)) (raw (pvec-v v))) + (let loop ((i i) (acc acc)) + (cond ((jolt-reduced? acc) (jolt-reduced-val acc)) + ((fx>=? i n) acc) + (else (loop (fx+ i 1) (jolt-invoke f acc (vector-ref raw i)))))))) (define (reduce-seq f acc s) (cond ((jolt-reduced? acc) (jolt-reduced-val acc)) ((jolt-nil? s) acc) + ;; a vector-backed (chunked) seq reduces its vector directly, in a tight loop. + ((and (cseq? s) (cseq-cvec s)) (vec-reduce f acc (cseq-cvec s) (cseq-ci s))) (else (reduce-seq f (jolt-invoke f acc (seq-first s)) (jolt-seq (seq-more s)))))) (define jolt-reduce (case-lambda