simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #265 from jolt-lang/conformance/lazy-map

Browse source 
seq fns are lazy by default (LazySeq), like Clojure
This commit is contained in:
Dmitri Sotnikov 2026-06-28 05:31:25 +00:00 • committed by GitHub
commit 83ff96c3c8
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
10 changed files with 80 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

6
host/chez/host-contract.ss
View file

@ -46,7 +46,9 @@
;; ANY non-empty seq is a list form for analysis (a macro/eval form built via
;; concat/map/cons is a lazy cseq with list?=#f, but evaluating it still means
;; calling its head) — not just reader-built lists.
(define (hc-list? x) (or (empty-list-t? x) (cseq? x)))
;; a lazy seq is a list form too: a macro that builds its expansion with map/for
;; (now a LazySeq, not an eager cseq) and splices it must still analyze.
(define (hc-list? x) (or (empty-list-t? x) (cseq? x) (jolt-lazyseq? x)))
(define (hc-vec? x) (pvec? x))
(define (hc-map? x) (and (pmap? x) (jolt-nil? (jolt-get x hc-kw-jolt-type))))
;; A set form is the reader's tagged map {:jolt/type :jolt/set :value <pvec>} OR a
@ -106,7 +108,7 @@
;; list items -> jolt vector (pvec); the analyzer mapv's over the result.
(define (hc-elements x)
(cond ((empty-list-t? x) empty-pvec)
((cseq? x) (make-pvec (list->vector (seq->list x))))
((or (cseq? x) (jolt-lazyseq? x)) (make-pvec (list->vector (seq->list x))))
(else empty-pvec)))
(define (hc-vec-items x) x) ; already a pvec
(define (hc-set-items x)

1
host/chez/java/host-static-classes.ss
View file

@ -751,6 +751,7 @@
((string=? iface "IPersistentSet") (or (pset? val) (htable-sorted-set? val)))
((string=? iface "ISeq")
(or (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)))
((string=? iface "LazySeq") (jolt-lazyseq? val))
;; Seqable is anything (seq x) works on — every persistent
;; collection, not just seqs (a vector IS Seqable, not an ISeq).
((string=? iface "Seqable")

15
host/chez/natives-seq.ss
View file

@ -105,8 +105,9 @@
(if (null? colls)
(td-mapcat f)
;; lazily concat the per-element results — no seq->list, so mapcat over an
;; infinite source stays lazy.
(lazy-concat-seq (apply jolt-map f colls))))
;; infinite source stays lazy; the outer lazy-seq node defers the first
;; element so a side-effecting f does not fire at construction (LazySeq).
(jolt-make-lazy-seq (lambda () (jolt-seq (lazy-concat-seq (apply jolt-map f colls)))))))
;; take-while / drop-while: 1-arg -> transducer; 2-arg -> a seq over the coll.
(define (take-while-seq pred s)
@ -118,7 +119,7 @@
(define jolt-take-while
(case-lambda
((pred) (td-take-while pred))
((pred coll) (take-while-seq pred (jolt-seq coll)))))
((pred coll) (jolt-make-lazy-seq (lambda () (jolt-seq (take-while-seq pred (jolt-seq coll))))))))
(define (drop-while-seq pred coll)
(let loop ((s (jolt-seq coll)))
(if (and (not (jolt-nil? s)) (jolt-truthy? (jolt-invoke pred (seq-first s))))
@ -127,7 +128,7 @@
(define jolt-drop-while
(case-lambda
((pred) (td-drop-while pred))
((pred coll) (drop-while-seq pred coll))))
((pred coll) (jolt-make-lazy-seq (lambda () (jolt-seq (drop-while-seq pred coll)))))))
;; partition: (partition n coll), (partition n step coll), or
;; (partition n step pad coll). Only complete partitions of size n are kept;
@ -135,9 +136,9 @@
;; 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))))
((n coll) (jolt-make-lazy-seq (lambda () (jolt-seq (partition* (->idx n) (->idx n) #f #f coll)))))
((n step coll) (jolt-make-lazy-seq (lambda () (jolt-seq (partition* (->idx n) (->idx step) #f #f coll)))))
((n step pad coll) (jolt-make-lazy-seq (lambda () (jolt-seq (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))

2
host/chez/predicates.ss
View file

@ -16,7 +16,7 @@
;; seq, (rest list), (seq coll), (map …) are seqs but not lists.
(define (jolt-list-pred? x) (or (and (cseq? x) (cseq-list? x)) (empty-list-t? x)))
(define (jolt-coll-pred? x)
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x)))
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x) (jolt-lazyseq? x)))
(define (jolt-number? x) (number? x))
(define (jolt-string? x) (string? x))
(define (jolt-char-pred? x) (char? x))

4
host/chez/records.ss
View file

@ -484,6 +484,10 @@
;; reports PersistentList / IPersistentList / IPersistentStack — extend-protocol
;; clojure.lang.IPersistentList (algo.monads' writer monad) dispatches on one.
((or (cseq? obj) (empty-list-t? obj)) '("PersistentList" "IPersistentList" "IPersistentStack" "ASeq" "ISeq" "IPersistentCollection" "Sequential" "Collection" "Iterable" "java.lang.Iterable" "Object"))
;; a lazy seq (map/filter/… result) is clojure.lang.LazySeq: a Sequential
;; ISeq, but not a PersistentList — matching the JVM so extend-protocol /
;; instance? on a deferred seq dispatch like an eager one where they should.
((jolt-lazyseq? obj) '("LazySeq" "ISeq" "IPersistentCollection" "Sequential" "Collection" "Iterable" "java.lang.Iterable" "Object"))
;; a var is clojure.lang.Var (also IDeref / IFn) — reitit's Expand protocol
;; extends to Var so a #'handler route dispatches.
((var-cell? obj) '("Var" "clojure.lang.Var" "IDeref" "IFn" "Object"))

2
host/chez/seed/prelude.ss
View file

@ -375,7 +375,7 @@
(guard (e (#t #f))
(def-var! "clojure.core" "rationalize" (letrec ((rationalize (lambda (x) (let fnrec4398 ((x x)) x)))) rationalize)))
(guard (e (#t #f))
(def-var! "clojure.core" "dedupe" (letrec ((dedupe (case-lambda (() (let fnrec4399 () (lambda (rf) (let fnrec4400 ((rf rf)) (let* ((pv (jolt-invoke (var-deref "clojure.core" "volatile!") (let* ((_o$4401 #f) (_o$4402 jolt-nil)) (jolt-vector _o$4401 _o$4402))))) (case-lambda (() (let fnrec4403 () (jolt-invoke rf))) ((result) (let fnrec4404 ((result result)) (jolt-invoke rf result))) ((result input) (let fnrec4405 ((result result) (input input)) (let* ((G__129 (jolt-invoke (var-deref "clojure.core" "deref") pv)) (seen (jolt-nth G__129 0 jolt-nil)) (prior (jolt-nth G__129 1 jolt-nil))) (begin (jolt-invoke (var-deref "clojure.core" "vreset!") pv (let* ((_o$4406 #t) (_o$4407 input)) (jolt-vector _o$4406 _o$4407))) (if (jolt-truthy? (let* ((and__25__auto seen)) (if (jolt-truthy? and__25__auto) (jolt= prior input) and__25__auto))) result (jolt-invoke rf result input)))))))))))) ((coll) (let fnrec4408 ((coll coll)) (let* ((step (letrec ((step (lambda (s prev) (let fnrec4409 ((s s) (prev prev)) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4410 () (let* ((s (jolt-seq s))) (if (jolt-truthy? s) (let* ((x (jolt-first s))) (if (jolt= x prev) (jolt-invoke (var-deref "clojure.core" "coll->cells") (step (jolt-rest s) prev)) (jolt-invoke (var-deref "clojure.core" "coll->cells") (jolt-cons x (step (jolt-rest s) x))))) jolt-nil))))))))) step))) (let* ((s (jolt-seq coll))) (if (jolt-truthy? s) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4411 () (jolt-invoke (var-deref "clojure.core" "coll->cells") (let* ((_a$4415 (jolt-first s)) (_a$4416 (let* ((_a$4412 step) (_a$4413 (jolt-rest s)) (_a$4414 (jolt-first s))) (jolt-invoke _a$4412 _a$4413 _a$4414)))) (jolt-cons _a$4415 _a$4416)))))) (jolt-list ))))))))) dedupe)))
(def-var! "clojure.core" "dedupe" (letrec ((dedupe (case-lambda (() (let fnrec4399 () (lambda (rf) (let fnrec4400 ((rf rf)) (let* ((pv (jolt-invoke (var-deref "clojure.core" "volatile!") (let* ((_o$4401 #f) (_o$4402 jolt-nil)) (jolt-vector _o$4401 _o$4402))))) (case-lambda (() (let fnrec4403 () (jolt-invoke rf))) ((result) (let fnrec4404 ((result result)) (jolt-invoke rf result))) ((result input) (let fnrec4405 ((result result) (input input)) (let* ((G__129 (jolt-invoke (var-deref "clojure.core" "deref") pv)) (seen (jolt-nth G__129 0 jolt-nil)) (prior (jolt-nth G__129 1 jolt-nil))) (begin (jolt-invoke (var-deref "clojure.core" "vreset!") pv (let* ((_o$4406 #t) (_o$4407 input)) (jolt-vector _o$4406 _o$4407))) (if (jolt-truthy? (let* ((and__25__auto seen)) (if (jolt-truthy? and__25__auto) (jolt= prior input) and__25__auto))) result (jolt-invoke rf result input)))))))))))) ((coll) (let fnrec4408 ((coll coll)) (let* ((step (letrec ((step (lambda (s prev) (let fnrec4409 ((s s) (prev prev)) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4410 () (let* ((s (jolt-seq s))) (if (jolt-truthy? s) (let* ((x (jolt-first s))) (if (jolt= x prev) (jolt-invoke (var-deref "clojure.core" "coll->cells") (step (jolt-rest s) prev)) (jolt-invoke (var-deref "clojure.core" "coll->cells") (jolt-cons x (step (jolt-rest s) x))))) jolt-nil))))))))) step))) (jolt-invoke (var-deref "clojure.core" "make-lazy-seq") (lambda () (let fnrec4411 () (let* ((s (jolt-seq coll))) (if (jolt-truthy? s) (jolt-invoke (var-deref "clojure.core" "coll->cells") (let* ((_a$4415 (jolt-first s)) (_a$4416 (let* ((_a$4412 step) (_a$4413 (jolt-rest s)) (_a$4414 (jolt-first s))) (jolt-invoke _a$4412 _a$4413 _a$4414)))) (jolt-cons _a$4415 _a$4416))) jolt-nil))))))))))) dedupe)))
(guard (e (#t #f))
(def-var! "clojure.core" "seq-to-map-for-destructuring" (letrec ((seq-to-map-for-destructuring (lambda (s) (let fnrec4417 ((s s)) (if (jolt-truthy? (jolt-next s)) (let* ((m (jolt-hash-map)) (xs (jolt-seq s))) (let loop4418 ((m m) (xs xs)) (if (jolt-truthy? xs) (if (jolt-truthy? (jolt-next xs)) (let* ((_a$4422 (let* ((_a$4419 m) (_a$4420 (jolt-first xs)) (_a$4421 (jolt-invoke (var-deref "clojure.core" "second") xs))) (jolt-assoc _a$4419 _a$4420 _a$4421))) (_a$4423 (jolt-invoke (var-deref "clojure.core" "nnext") xs))) (loop4418 _a$4422 _a$4423)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "No value supplied for key: " (jolt-first xs)))) m))) (if (jolt-truthy? (jolt-seq s)) (jolt-first s) (jolt-hash-map))))))) seq-to-map-for-destructuring)))
(guard (e (#t #f))

62
host/chez/seq.ss
View file

@ -261,10 +261,16 @@
(if (any-nil? seqs) jolt-empty-list
(cseq-lazy (apply jolt-invoke f (map seq-first seqs))
(lambda () (map-seq* f (map (lambda (s) (jolt-seq (seq-more s))) seqs))))))
;; map is fully lazy: Clojure's (map f coll) is a LazySeq whose body — including
;; (f (first coll)) — runs only when forced, so a side-effecting f does not fire
;; at construction. Wrap the (eager-headed) map-seq in a lazy-seq node; forcing it
;; once yields the cseq chain, which then iterates with no per-element overhead.
;; jolt-seq coerces map-seq's result (cseq | jolt-empty-list) to cseq | nil, the
;; contract force-lazyseq relies on (see jolt-rest).
(define (jolt-map f . colls)
(if (null? (cdr colls))
(map-seq f (jolt-seq (car colls)))
(map-seq* f (map jolt-seq colls))))
(jolt-make-lazy-seq (lambda () (jolt-seq (map-seq f (jolt-seq (car colls))))))
(jolt-make-lazy-seq (lambda () (jolt-seq (map-seq* f (map jolt-seq colls)))))))
(define (filter-seq pred s keep)
(let loop ((s s))
@ -272,8 +278,12 @@
((eq? keep (jolt-truthy? (jolt-invoke pred (seq-first s))))
(cseq-lazy (seq-first s) (lambda () (filter-seq pred (jolt-seq (seq-more s)) keep))))
(else (loop (jolt-seq (seq-more s)))))))
(define (jolt-filter pred coll) (filter-seq pred (jolt-seq coll) #t))
(define (jolt-remove pred coll) (filter-seq pred (jolt-seq coll) #f))
;; filter/remove are fully lazy (LazySeq): defer the predicate and the source seq
;; until forced, like Clojure. (lazy-seq* = a 0-arg lazy node coercing to cseq|nil.)
(define (jolt-filter pred coll)
(jolt-make-lazy-seq (lambda () (jolt-seq (filter-seq pred (jolt-seq coll) #t)))))
(define (jolt-remove pred coll)
(jolt-make-lazy-seq (lambda () (jolt-seq (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
@ -343,21 +353,28 @@
;; (take 0 (rest s)) never seqs coll. Realizing one more, as forcing seq-more at
;; the boundary would, over-runs the source by one (medley's sequence-padded).
(define (jolt-take n coll)
;; (take Double/POSITIVE_INFINITY coll) takes the whole coll on the JVM (the
;; count never reaches 0); test.check's rose-tree unchunk relies on it. Coercing
;; +inf.0 to a fixnum index would throw, so take all up front.
(if (and (flonum? n) (infinite? n))
(if (> n 0.0) (jolt-seq coll) jolt-empty-list)
(let ((n (->idx n)))
(let loop ((n n) (s (jolt-seq coll)))
(cond
((or (fx<=? n 0) (jolt-nil? s)) jolt-empty-list)
((fx=? n 1) (cseq-lazy (seq-first s) (lambda () jolt-empty-list)))
(else (cseq-lazy (seq-first s) (lambda () (loop (fx- n 1) (jolt-seq (seq-more s)))))))))))
;; lazy (LazySeq): realize exactly n elements, none at construction. (take
;; Double/POSITIVE_INFINITY coll) takes the whole coll on the JVM (the count
;; never reaches 0); test.check's rose-tree unchunk relies on it. Coercing +inf.0
;; to a fixnum index would throw, so take all up front in that case.
(jolt-make-lazy-seq
(lambda ()
(jolt-seq
(if (and (flonum? n) (infinite? n))
(if (> n 0.0) (jolt-seq coll) jolt-empty-list)
(let ((n (->idx n)))
(let loop ((n n) (s (jolt-seq coll)))
(cond
((or (fx<=? n 0) (jolt-nil? s)) jolt-empty-list)
((fx=? n 1) (cseq-lazy (seq-first s) (lambda () jolt-empty-list)))
(else (cseq-lazy (seq-first s) (lambda () (loop (fx- n 1) (jolt-seq (seq-more s))))))))))))))
(define (jolt-drop n coll)
(let loop ((n (->idx n)) (s (jolt-seq coll)))
(if (or (fx<=? n 0) (jolt-nil? s)) (if (jolt-nil? s) jolt-empty-list s)
(loop (fx- n 1) (jolt-seq (seq-more s))))))
(jolt-make-lazy-seq
(lambda ()
(jolt-seq
(let loop ((n (->idx n)) (s (jolt-seq coll)))
(if (or (fx<=? n 0) (jolt-nil? s)) (if (jolt-nil? s) jolt-empty-list s)
(loop (fx- n 1) (jolt-seq (seq-more s)))))))))
;; lazily append seq a then the seqable produced by the thunk `brest` — the rest
;; is NOT forced until a is exhausted, so concat is fully lazy (Clojure semantics).
@ -368,9 +385,12 @@
(if (jolt-nil? a) (jolt-seq (brest))
(cseq-lazy (seq-first a) (lambda () (concat2 (jolt-seq (seq-more a)) brest)))))
(define (jolt-concat . colls)
(cond ((null? colls) jolt-empty-list)
((null? (cdr colls)) (jolt-seq (car colls)))
(else (concat2 (jolt-seq (car colls)) (lambda () (apply jolt-concat (cdr colls)))))))
(jolt-make-lazy-seq
(lambda ()
(jolt-seq
(cond ((null? colls) jolt-empty-list)
((null? (cdr colls)) (jolt-seq (car colls)))
(else (concat2 (jolt-seq (car colls)) (lambda () (apply jolt-concat (cdr colls))))))))))
;; Lazily concatenate a (possibly infinite) SEQ of colls — what (apply concat ss)
;; means, but without realizing ss. Pulls one coll at a time, concatenating it with