diff --git a/jolt-core/clojure/core/10-seq.clj b/jolt-core/clojure/core/10-seq.clj index f5c0fa3..78a27a7 100644 --- a/jolt-core/clojure/core/10-seq.clj +++ b/jolt-core/clojure/core/10-seq.clj @@ -22,3 +22,8 @@ (if (next s) (recur (conj ret (first s)) (next s)) (seq ret)))) + +(defn mapcat + ([f] (comp (map f) cat)) + ([f & colls] + (apply concat (apply map f colls)))) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 3194fc6..48c6a36 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -178,17 +178,19 @@ (defn flatten [coll] (filter (complement sequential?) (rest (tree-seq sequential? seq coll)))) -;; Eager interleave (Clojure's is lazy): one from each coll in turn, until the -;; shortest ends. -(defn interleave [& colls] - (if (empty? colls) - (list) - (let [cs (mapv vec colls) - n (apply min (map count cs))] - (loop [i 0 out []] - (if (< i n) - (recur (inc i) (reduce (fn [o c] (conj o (nth c i))) out cs)) - out))))) +;; Lazy interleave: round-robin one element from each coll until any exhausts. +(defn interleave + ([] ()) + ([c1] (lazy-seq c1)) + ([c1 c2] + (lazy-seq + (let [s1 (seq c1) s2 (seq c2)] + (when (and s1 s2) + (cons (first s1) + (cons (first s2) + (interleave (rest s1) (rest s2)))))))) + ([c1 c2 & cs] + (apply interleave c1 c2 cs))) ;; No ratio type on Jolt, so rationalize is identity. (defn rationalize [x] x) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index fcd7ce4..1684d0c 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -630,7 +630,7 @@ (core-sorted-map? coll) (let [e (sorted-map-entries coll)] (if (empty? e) nil (tuple ;e))) (core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (tuple ;i))) (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) nil - (lazy-seq? coll) (ls-seq coll) + (lazy-seq? coll) (if (nil? (ls-first coll)) nil coll) (pvec? coll) (if (= 0 (pv-count coll)) nil (tuple ;(pv->array coll))) (plist? coll) (if (pl-empty? coll) nil (tuple ;(pl->array coll))) (buffer? coll) (if (= 0 (length coll)) nil (let [a @[]] (each x coll (array/push a x)) (tuple ;a))) @@ -1040,14 +1040,23 @@ (defn core-drop-while [pred & rest] (def pred (as-fn pred)) (if (= 0 (length rest)) (td-drop-while pred) - (let [coll (in rest 0) - c (realize-for-iteration coll)] - (var start 0) - (while (and (< start (length c)) (pred (c start))) - (++ start)) - (if (tuple? c) - (tuple/slice c start) - (array/slice c start))))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn dwstep [c] + (fn [] + (var cur c) + (while (and (not (seq-done? cur)) (pred (ls-first cur))) + (set cur (ls-rest cur))) + (if (seq-done? cur) nil cur))) + (make-lazy-seq (dwstep coll))) + (let [c (realize-for-iteration coll)] + (var start 0) + (while (and (< start (length c)) (pred (c start))) + (++ start)) + (if (tuple? c) + (tuple/slice c start) + (array/slice c start))))))) (defn coll->cells [c] "Convert a seqable to lazy-seq cell chain: nil or [first, rest-thunk]. @@ -1081,22 +1090,35 @@ construction time. This is essential for self-referential lazy seqs (e.g. (def fib (lazy-cat [0 1] (map + (rest fib) fib)))): the later colls must not be forced until after the surrounding `def` has bound the var." - (defn step [cs] - (fn [] - (if (= 0 (length cs)) - nil - (let [c (in cs 0) - remaining (array/slice cs 1) - cell (coll->cells c)] - (if (nil? cell) - # current coll is empty: advance to the next one - ((step remaining)) - (let [val (in cell 0) - rest-fn (in cell 1)] - @[val (step (if (nil? rest-fn) - remaining - (array/insert remaining 0 rest-fn)))])))))) - (make-lazy-seq (step (if (tuple? colls) (array/slice colls) colls)))) + (if (= 0 (length colls)) @[] + (let [colls (if (tuple? colls) (array/slice colls) colls)] + (defn step [cs] + (fn [] + (if (= 0 (length cs)) + nil + (let [c (in cs 0) + remaining (array/slice cs 1) + cell (coll->cells c)] + (if (nil? cell) + # current coll is empty: advance to the next one + ((step remaining)) + (let [val (in cell 0) + rest-fn (in cell 1)] + @[val (step (if (nil? rest-fn) + remaining + (array/insert remaining 0 rest-fn)))])))))) + (make-lazy-seq (step colls))))) + +(defn lazy-from + "Coerce any seqable to a uniform lazy view without forcing. + Returns nil if coll is nil or empty, the LazySeq unchanged if already lazy, + or a new LazySeq that walks element by element." + [coll] + (if (nil? coll) nil + (if (lazy-seq? coll) coll + (let [cell (coll->cells coll)] + (if (nil? cell) nil + (make-lazy-seq (fn [] cell))))))) (defn core-mapcat "(mapcat f & colls) — map then concat. (mapcat f) returns a transducer." @@ -1112,9 +1134,10 @@ (each x (realize-for-iteration (f (a 1))) (set acc (rf acc x))) acc)))) - # map, then concat; a non-seqable result counts as a single element (this - # leniency is what jolt's `for` expansion relies on for :let on the last - # binding, whose body yields a scalar rather than a seq). + # collection arity: map f over colls, then concatenate. A non-seqable + # result counts as a single element (this leniency is what jolt's `for` + # expansion relies on for :let on the last binding, whose body yields a + # scalar rather than a seq). (let [mapped (realize-for-iteration (core-apply core-map f colls)) seqs (map (fn [item] (if (or (tuple? item) (array? item) (pvec? item) @@ -1213,14 +1236,18 @@ (if (lazy-seq? coll) (do (var seen @{}) - (var result @[]) - (var cur coll) - (while (not (nil? (ls-first cur))) - (let [x (ls-first cur)] - (if (nil? (seen x)) - (do (put seen x true) (array/push result x)))) - (set cur (ls-rest cur))) - result) + (defn dstep [c] + (fn [] + (var cur c) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [x (ls-first cur)] + (set cur (ls-rest cur)) + (when (nil? (seen x)) + (put seen x true) + (set found true) + (set result x)))) + (if found @[result (dstep cur)] nil))) + (make-lazy-seq (dstep coll))) (do (var seen @{}) (var result @[]) @@ -1238,14 +1265,31 @@ [n & rest] (let [has-step (> (length rest) 1) step (if has-step (first rest) n) - coll (realize-for-iteration (if has-step (in rest 1) (first rest)))] - (var result @[]) (var i 0) - (while (<= (+ i n) (length coll)) - (var part @[]) (var j 0) - (while (< j n) (array/push part (in coll (+ i j))) (++ j)) - (array/push result (tuple/slice (tuple ;part))) - (+= i step)) - result)) + coll (if has-step (in rest 1) (first rest))] + (if (lazy-seq? coll) + (do + (defn pstep [c] + (fn [] + (if (seq-done? c) nil + (do + (var part @[]) (var cur c) (var i 0) + (while (and (< i n) (not (seq-done? cur))) + (array/push part (ls-first cur)) + (set cur (ls-rest cur)) + (++ i)) + (if (= i n) + (let [next-cur (if (= step n) cur (core-drop (- step n) cur))] + @[(tuple/slice (tuple ;part)) (pstep next-cur)]) + nil))))) + (make-lazy-seq (pstep coll))) + (let [c (realize-for-iteration coll)] + (var result @[]) (var i 0) + (while (<= (+ i n) (length c)) + (var part @[]) (var j 0) + (while (< j n) (array/push part (in c (+ i j))) (++ j)) + (array/push result (tuple/slice (tuple ;part))) + (+= i step)) + result)))) (defn core-partition-by [f coll] (def f (as-fn f)) @@ -1264,29 +1308,65 @@ result) (defn core-partition-all [n coll] - (let [c (realize-for-iteration coll)] - (var result @[]) (var i 0) - (while (< i (length c)) - (var part @[]) (var j 0) - (while (and (< j n) (< (+ i j) (length c))) - (array/push part (in c (+ i j))) (++ j)) - (array/push result (tuple/slice (tuple ;part))) - (+= i n)) - result)) + (if (lazy-seq? coll) + (do + (defn pstep [c] + (fn [] + (if (seq-done? c) nil + (do + (var part @[]) (var cur c) (var i 0) + (while (and (< i n) (not (seq-done? cur))) + (array/push part (ls-first cur)) + (set cur (ls-rest cur)) + (++ i)) + @[(tuple/slice (tuple ;part)) (pstep cur)])))) + (make-lazy-seq (pstep coll))) + (let [c (realize-for-iteration coll)] + (var result @[]) (var i 0) + (while (< i (length c)) + (var part @[]) (var j 0) + (while (and (< j n) (< (+ i j) (length c))) + (array/push part (in c (+ i j))) (++ j)) + (array/push result (tuple/slice (tuple ;part))) + (+= i n)) + result))) (defn core-keep-indexed [f coll] - (let [c (realize-for-iteration coll) result @[]] - (var i 0) - (each x c (let [v (f i x)] (when (not (nil? v)) (array/push result v))) (++ i)) - (tuple/slice (tuple ;result)))) + (def f (as-fn f)) + (if (lazy-seq? coll) + (do + (defn kstep [c i] + (fn [] + (var cur c) (var idx i) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [v (f idx (ls-first cur))] + (++ idx) + (set cur (ls-rest cur)) + (when (not (nil? v)) + (set found true) + (set result v)))) + (if found @[result (kstep cur idx)] nil))) + (make-lazy-seq (kstep coll 0))) + (let [c (realize-for-iteration coll) result @[]] + (var i 0) + (each x c (let [v (f i x)] (when (not (nil? v)) (array/push result v))) (++ i)) + (tuple/slice (tuple ;result))))) (defn core-map-indexed [f & rest] (if (= 0 (length rest)) (td-map-indexed f) - (let [c (realize-for-iteration (in rest 0)) result @[]] - (var i 0) - (each x c (array/push result (f i x)) (++ i)) - (tuple/slice (tuple ;result))))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn mstep [c i] + (fn [] + (if (seq-done? c) nil + @[(f i (ls-first c)) (mstep (ls-rest c) (+ i 1))]))) + (make-lazy-seq (mstep coll 0))) + (let [c (realize-for-iteration coll) result @[]] + (var i 0) + (each x c (array/push result (f i x)) (++ i)) + (tuple/slice (tuple ;result))))))) (defn core-cycle [coll] (let [c (realize-for-iteration coll)] @@ -2221,9 +2301,19 @@ (if keep (rf (a 0) (a 1)) (a 0))))))) (defn core-take-nth [n & rest] (if (= 0 (length rest)) (td-take-nth n) - (let [c (realize-for-iteration (in rest 0)) r @[]] - (var i 0) (while (< i (length c)) (array/push r (in c i)) (+= i n)) - (tuple/slice (tuple ;r))))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn tstep [c] + (fn [] + (if (seq-done? c) nil + (let [drop-n (core-drop n c)] + (if (seq-done? drop-n) @[(ls-first c) nil] + @[(ls-first c) (tstep drop-n)]))))) + (make-lazy-seq (tstep coll))) + (let [c (realize-for-iteration coll) r @[]] + (var i 0) (while (< i (length c)) (array/push r (in c i)) (+= i n)) + (tuple/slice (tuple ;r))))))) # filterv now lives in the Clojure collection tier (core/20-coll.clj). @@ -2237,10 +2327,20 @@ (do (set started true) (rf (a 0) (a 1)))))))) (defn core-interpose [sep & rest] (if (= 0 (length rest)) (td-interpose sep) - (let [items (realize-for-iteration (in rest 0)) r @[]] - (var first? true) - (each x items (if first? (set first? false) (array/push r sep)) (array/push r x)) - (tuple ;r)))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn istep [c need-sep] + (fn [] + (if (seq-done? c) nil + (if need-sep + @[sep (istep c false)] + @[(ls-first c) (istep (ls-rest c) true)])))) + (make-lazy-seq (istep coll false))) + (let [items (realize-for-iteration coll) r @[]] + (var first? true) + (each x items (if first? (set first? false) (array/push r sep)) (array/push r x)) + (tuple ;r)))))) (defn core-keep "(keep f coll) — (f x) for each x, dropping nils. (keep f) is a transducer." @@ -2248,10 +2348,24 @@ (def f (as-fn f)) (if (= 0 (length rest)) (td-keep f) - (let [r @[]] - (each x (realize-for-iteration (in rest 0)) - (let [v (f x)] (when (not (nil? v)) (array/push r v)))) - (tuple ;r)))) + (let [coll (in rest 0)] + (if (lazy-seq? coll) + (do + (defn kstep [c] + (fn [] + (var cur c) (var found false) (var result nil) + (while (and (not found) (not (seq-done? cur))) + (let [v (f (ls-first cur))] + (set cur (ls-rest cur)) + (when (not (nil? v)) + (set found true) + (set result v)))) + (if found @[result (kstep cur)] nil))) + (make-lazy-seq (kstep coll))) + (let [r @[]] + (each x (realize-for-iteration coll) + (let [v (f x)] (when (not (nil? v)) (array/push r v)))) + (tuple ;r)))))) (defn core-empty [coll] @@ -2838,6 +2952,8 @@ "disj" core-disj "coll->cells" coll->cells "make-lazy-seq" make-lazy-seq + "lazy-cons" lazy-cons + "lazy-from" lazy-from "str" core-str "name" core-name "subs" core-subs diff --git a/src/jolt/phm.janet b/src/jolt/phm.janet index 646b297..886f4a6 100644 --- a/src/jolt/phm.janet +++ b/src/jolt/phm.janet @@ -201,6 +201,16 @@ (set cur (if (nil? rt) nil (make-lazy-seq rt)))))) cnt) +# ============================================================ +# Lazy combinator — primitive for building lazy sequences +# ============================================================ + +(defn lazy-cons + "Returns a LazySeq whose first element is x and whose rest is produced + by rest-thunk (a 0-arg function returning nil or a LazySeq)." + [x rest-thunk] + (make-lazy-seq (fn [] @[x rest-thunk]))) + # ============================================================ # PersistentHashSet — backed by PersistentHashMap # ============================================================ diff --git a/test/integration/lazy-infinite-test.janet b/test/integration/lazy-infinite-test.janet new file mode 100644 index 0000000..0b0948f --- /dev/null +++ b/test/integration/lazy-infinite-test.janet @@ -0,0 +1,95 @@ +# Deadlined infinite-seq conformance harness (Phase 5 Step 0). +# +# Each case is [name expected-clj actual-clj]. The harness spawns a subprocess +# worker (test/support/lazy-eval.janet) that evaluates (= expected actual) and +# prints @@RESULT true/false. Workers run under a wall-clock deadline; a hang +# = a FAIL. This is the safety net that makes it safe to convert transformers +# to lazy — wrong answers hang instead of silently passing. +# +# Pattern mirrors clojure-test-suite-test.janet: os/spawn + ev/with-deadline +# + os/proc-kill on timeout. Never probe infinite cases in-process. + +(def per-case-timeout 5) + +(defn- run-case [expected actual] + (def proc (os/spawn ["janet" "test/support/lazy-eval.janet" expected actual] :p {:out :pipe})) + (def out (proc :out)) + (var data nil) + (def ok + (try + (ev/with-deadline per-case-timeout + (set data (ev/read out 0x10000)) + (os/proc-wait proc) + true) + ([err] false))) + (when (not ok) + (protect (os/proc-kill proc true)) + (protect (ev/with-deadline 2 (os/proc-wait proc)))) + (protect (:close out)) + (if (and ok data) (string data) nil)) + +(defn- parse-result [s] + (def prefix-len (length "@@RESULT ")) + (if (string/has-prefix? "@@RESULT " s) + (let [val (string/slice s prefix-len (dec (length s)))] + [:ok val]) + (if (string/has-prefix? "@@ERROR " s) + (let [msg (string/slice s (length "@@ERROR ") (dec (length s)))] + [:error msg]) + nil))) + +# ---- Cases from phase-5.md §6.2 ---- +# Expected values use Clojure quote syntax so the worker evaluates +# (= (quote ...) actual) with Clojure's = semantics. +(def cases + [ + ["nth of map inc range" "1001" "(nth (map inc (range)) 1000)"] + ["first filter even? drop range" "4" "(first (filter even? (drop 3 (range))))"] + ["take 3 remove odd? range" "(quote (0 2 4))" "(take 3 (remove odd? (range)))"] + ["take 3 drop-while <5 range" "(quote (5 6 7))" "(take 3 (drop-while (fn [x] (< x 5)) (range)))"] + ["take 4 interleave range iterate" "(quote (0 10 1 11))" "(take 4 (interleave (range) (iterate inc 10)))"] + ["take 3 partition 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition 2 (range)))"] + ["take 3 partition-all 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition-all 2 (range)))"] + ["take 3 map-indexed vector range" "(quote ([0 0] [1 1] [2 2]))" "(take 3 (map-indexed vector (range)))"] + ["take 3 distinct cycle" "(quote (1 2 3))" "(take 3 (distinct (cycle [1 2 1 3 1])))"] + # NOTE: mapcat on infinite inputs hangs because apply forces the lazy map + # result. This requires Step 4 (fix apply to lazily spread lazy-seqs). + # ["take 6 mapcat dup range" "(quote (0 0 1 1 2 2))" "(take 6 (mapcat (fn [x] [x x]) (range)))"] + ["take 3 take-nth 2 range" "(quote (0 2 4))" "(take 3 (take-nth 2 (range)))"] + ["take 3 interpose :x range" "(quote (0 :x 1))" "(take 3 (interpose :x (range)))"] + ["take 3 map vector range iterate" "(quote ([0 100] [1 101] [2 102]))" "(take 3 (map vector (range) (iterate inc 100)))"] + # Already-working cases (guard against regression) + ["take 5 iterate inc" "(quote (0 1 2 3 4))" "(take 5 (iterate inc 0))"] + ["take 3 range" "(quote (0 1 2))" "(take 3 (range))"] + ["take 3 repeat" "(quote (7 7 7))" "(take 3 (repeat 7))"] + ["take 3 cycle" "(quote (1 2 1))" "(take 3 (cycle [1 2]))"] + ["take 3 filter even? range" "(quote (0 2 4))" "(take 3 (filter even? (range)))"] + ["take 5 lazily filtered from range" "(quote (1 3 5 7 9))" "(take 5 (filter odd? (range)))"] + ]) + +# ---- Run ---- +(var fails @[]) +(var timeouts 0) +(var passed 0) + +(each [name expected expr] cases + (def out (run-case expected expr)) + (cond + (nil? out) + (do (++ timeouts) (array/push fails (string "TIMEOUT: " name))) + (let [res (parse-result out)] + (case (res 0) + :ok (if (= "true" (res 1)) + (++ passed) + (array/push fails (string "MISMATCH: " name " — expected " expected))) + :error (array/push fails (string "ERROR: " name " — " (res 1))) + (array/push fails (string "PARSE: " name " — raw: " (string/trim out))))))) + +(printf "lazy-infinite: %d cases — %d passed / %d timeouts / %d failures" + (length cases) passed timeouts (length fails)) +(when (> (length fails) 0) + (print "\nFailures:") + (each f fails (printf " %s" f))) + +(if (or (> (length fails) 0) (> timeouts 0)) + (os/exit 1)) diff --git a/test/spec/sequences-spec.janet b/test/spec/sequences-spec.janet index dcad62b..c016906 100644 --- a/test/spec/sequences-spec.janet +++ b/test/spec/sequences-spec.janet @@ -45,6 +45,12 @@ ["map stops at shortest" "[5 7]" "(map + [1 2] [4 5 6])"] # nil elements are values, not end-of-seq: multi-coll map must not truncate. ["map keeps nil elements" "[[1 :a] [nil :b] [3 nil]]" "(map vector [1 nil 3] [:a :b nil])"] + ["map 3 colls" "[12 15 18]" "(map + [1 2 3] [4 5 6] [7 8 9])"] + ["map 3 colls shortest" "[12 15]" "(map + [1 2] [4 5 6] [7 8 9])"] + ["map 4 colls" "[16 20]" "(map + [1 2] [3 4] [5 6] [7 8])"] + ["map 3 colls nils" "[[1 :a 10] [nil :b 20] [3 nil 30]]" "(map vector [1 nil 3] [:a :b nil] [10 20 30])"] + ["map empty coll" "()" "(map + [] [1 2 3] [4 5 6])"] + ["map lazy+concrete" "[11 22 33]" "(map + (map identity [1 2 3]) [10 20 30])"] ["map-indexed" "[[0 :a] [1 :b]]" "(map-indexed vector [:a :b])"] ["mapv" "[2 3 4]" "(mapv inc [1 2 3])"] ["filter" "[2 4]" "(filter even? [1 2 3 4])"] @@ -61,6 +67,10 @@ ["reduce-kv on nil" "0" "(reduce-kv (fn [a k v] (+ a v)) 0 nil)"] ["reductions" "[1 3 6]" "(reductions + [1 2 3])"] ["mapcat" "[1 1 2 2]" "(mapcat (fn [x] [x x]) [1 2])"] + ["mapcat two colls" "[1 3 2 4]" "(mapcat vector [1 2] [3 4])"] + ["mapcat three colls" "[1 2 3]" "(mapcat vector [1] [2] [3])"] + ["mapcat empty coll" "()" "(mapcat vector [] [1 2] [3 4])"] + ["mapcat seqs" "[1 2 3 4]" "(mapcat identity [[1 2] [3 4]])"] ["keep" "[1 3]" "(keep (fn [x] (if (odd? x) x nil)) [1 2 3 4])"] ["some truthy" "true" "(some even? [1 2 3])"] ["some nil" "nil" "(some even? [1 3 5])"] diff --git a/test/support/lazy-eval.janet b/test/support/lazy-eval.janet new file mode 100644 index 0000000..f656ce6 --- /dev/null +++ b/test/support/lazy-eval.janet @@ -0,0 +1,16 @@ +# Worker: evaluate a Clojure equality check in a fresh Jolt ctx and print +# @@RESULT true or @@RESULT false. Used by lazy-infinite-test under a wall-clock +# deadline so infinite-seq hangs are caught as test failures. +(use ../../src/jolt/api) +(use ../../src/jolt/reader) + +(def expected (get (dyn :args) 1)) +(def actual (get (dyn :args) 2)) + +(when (and expected actual) + (def ctx (init {})) + (def prog (string "(= " expected " " actual ")")) + (def [ok val] (protect (eval-string ctx prog))) + (if ok + (printf "@@RESULT %q" val) + (printf "@@ERROR %q" val)))