From b0cb3afbf2b4e89fc7db13a511cf896fa2b46071 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 4 Jun 2026 15:48:04 -0400 Subject: [PATCH] =?UTF-8?q?feat:=20transducers=20=E2=80=94=20map/filter/re?= =?UTF-8?q?move/take/drop/take-while/drop-while/map-indexed=20return=20tra?= =?UTF-8?q?nsducers=20on=20no-coll=20arity;=20transduce/into-xform/sequenc?= =?UTF-8?q?e/eduction/reduced/unreduced;=20reduce=20honors=20reduced?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .beads/interactions.jsonl | 2 + .beads/issues.jsonl | 4 +- src/jolt/core.janet | 179 +++++++++++++++++++++++++++----------- test/conformance.janet | 14 +++ 4 files changed, 148 insertions(+), 51 deletions(-) diff --git a/.beads/interactions.jsonl b/.beads/interactions.jsonl index a82d49b..e136c2b 100644 --- a/.beads/interactions.jsonl +++ b/.beads/interactions.jsonl @@ -13,3 +13,5 @@ {"id":"int-0d2b12ab","kind":"field_change","created_at":"2026-06-04T18:56:25.718778Z","actor":"Yogthos","issue_id":"jolt-90c","extra":{"field":"status","new_value":"closed","old_value":"open"}} {"id":"int-a86d84ba","kind":"field_change","created_at":"2026-06-04T18:57:26.21495Z","actor":"Yogthos","issue_id":"jolt-h0n","extra":{"field":"status","new_value":"closed","old_value":"open"}} {"id":"int-5ddb241f","kind":"field_change","created_at":"2026-06-04T18:57:27.904474Z","actor":"Yogthos","issue_id":"jolt-7dy","extra":{"field":"status","new_value":"deferred","old_value":"open"}} +{"id":"int-9a5516da","kind":"field_change","created_at":"2026-06-04T19:41:39.048731Z","actor":"Yogthos","issue_id":"jolt-4zg","extra":{"field":"status","new_value":"closed","old_value":"open"}} +{"id":"int-b700eb9e","kind":"field_change","created_at":"2026-06-04T19:48:03.780728Z","actor":"Yogthos","issue_id":"jolt-l8f","extra":{"field":"status","new_value":"closed","old_value":"open"}} diff --git a/.beads/issues.jsonl b/.beads/issues.jsonl index 3e80b40..985165b 100644 --- a/.beads/issues.jsonl +++ b/.beads/issues.jsonl @@ -14,5 +14,5 @@ {"_type":"issue","id":"jolt-7n5","title":"MED: REPL display — def/defn should print #'ns/name; lazy-seq printer realizes only head ((0 \u003cfunction\u003e))","status":"closed","priority":3,"issue_type":"bug","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:59Z","created_by":"Yogthos","updated_at":"2026-06-04T18:55:11Z","closed_at":"2026-06-04T18:55:11Z","dependency_count":0,"dependent_count":0,"comment_count":0} {"_type":"issue","id":"jolt-h0n","title":"MED: missing core fns — letfn fnil trampoline doseq cycle partition-all reductions dedupe keep-indexed map-indexed transduce reduce-kv assoc-in peek subvec read-string format","status":"closed","priority":3,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:09:58Z","created_by":"Yogthos","updated_at":"2026-06-04T18:57:26Z","closed_at":"2026-06-04T18:57:26Z","dependency_count":0,"dependent_count":0,"comment_count":0} {"_type":"issue","id":"jolt-cn4","title":"regex engine is a common subset (PEG-backed); lookaround/backrefs/named-groups unsupported","status":"open","priority":4,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T19:27:50Z","created_by":"Yogthos","updated_at":"2026-06-04T19:27:50Z","dependency_count":0,"dependent_count":0,"comment_count":0} -{"_type":"issue","id":"jolt-4zg","title":"char type: chars represented as 1-char strings; (seq \"ab\") yields strings not \\a \\b — deferred design decision","status":"open","priority":4,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T19:27:49Z","created_by":"Yogthos","updated_at":"2026-06-04T19:27:49Z","dependency_count":0,"dependent_count":0,"comment_count":0} -{"_type":"issue","id":"jolt-l8f","title":"transduce + transducer arities (1-arg map/filter/take); niche, deferred","status":"open","priority":4,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:57:27Z","created_by":"Yogthos","updated_at":"2026-06-04T18:57:27Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-4zg","title":"char type: chars represented as 1-char strings; (seq \"ab\") yields strings not \\a \\b — deferred design decision","status":"closed","priority":4,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T19:27:49Z","created_by":"Yogthos","updated_at":"2026-06-04T19:41:39Z","closed_at":"2026-06-04T19:41:39Z","dependency_count":0,"dependent_count":0,"comment_count":0} +{"_type":"issue","id":"jolt-l8f","title":"transduce + transducer arities (1-arg map/filter/take); niche, deferred","status":"closed","priority":4,"issue_type":"feature","owner":"yogthos@gmail.com","created_at":"2026-06-04T18:57:27Z","created_by":"Yogthos","updated_at":"2026-06-04T19:48:04Z","closed_at":"2026-06-04T19:48:04Z","dependency_count":0,"dependent_count":0,"comment_count":0} diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 8f78a8b..95e5e0a 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -346,26 +346,15 @@ (if (string? coll) (tuple ;(map |(string/from-bytes $) (string/bytes coll))) (tuple))))))) -(defn core-into [to from] - (let [items (realize-for-iteration from)] - (cond - # map target: each item is a [k v] pair (or map entry) to assoc - (or (phm? to) (struct? to) (and (table? to) (get to :jolt/deftype))) - (do - (var result to) - (each item items - (set result (core-assoc result (in item 0) (in item 1)))) - result) - # list target (jolt lists are arrays): conj prepends -> reversed order - (array? to) - (do - (var result (array/slice to)) - (each x items (array/insert result 0 x)) - result) - # vector target (jolt vectors are tuples): conj appends - (tuple? to) - (tuple/slice (tuple ;(array/concat (array/slice to) (array/slice items)))) - to))) +(defn- into-conj [to items] + (cond + (or (phm? to) (struct? to) (and (table? to) (get to :jolt/deftype))) + (do (var result to) + (each item items (set result (core-assoc result (in item 0) (in item 1)))) + result) + (array? to) (do (var result (array/slice to)) (each x items (array/insert result 0 x)) result) + (tuple? to) (tuple/slice (tuple ;(array/concat (array/slice to) (array/slice items)))) + to)) (defn core-merge [& maps] (if (phm? (first maps)) @@ -402,9 +391,86 @@ (table/to-struct result)) # ============================================================ -# Sequence operations +# Transducers # ============================================================ +# A transducer is (fn [rf] rf') where rf' is a reducing fn with arities +# []=init, [acc]=complete, [acc x]=step. map/filter/take/... return a +# transducer when called with no collection. +(defn core-reduced [x] @{:jolt/type :jolt/reduced :val x}) +(defn core-reduced? [x] (and (table? x) (= :jolt/reduced (x :jolt/type)))) +(defn core-unreduced [x] (if (core-reduced? x) (x :val) x)) +(defn- ensure-reduced [x] (if (core-reduced? x) x (core-reduced x))) + +(defn td-map [f] + (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (rf (a 0) (f (a 1))))))) +(defn td-filter [pred] + (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (if (truthy? (pred (a 1))) (rf (a 0) (a 1)) (a 0)))))) +(defn td-remove [pred] (td-filter (fn [x] (not (pred x))))) +(defn td-keep [f] + (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (let [v (f (a 1))] (if (nil? v) (a 0) (rf (a 0) v))))))) +(defn td-take [n] + (fn [rf] + (var left n) + (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (if (<= left 0) (core-reduced (a 0)) + (let [r (rf (a 0) (a 1))] (set left (dec left)) + (if (<= left 0) (ensure-reduced r) r))))))) +(defn td-drop [n] + (fn [rf] + (var left n) + (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (if (> left 0) (do (set left (dec left)) (a 0)) (rf (a 0) (a 1))))))) +(defn td-take-while [pred] + (fn [rf] + (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (if (truthy? (pred (a 1))) (rf (a 0) (a 1)) (core-reduced (a 0))))))) +(defn td-drop-while [pred] + (fn [rf] + (var dropping true) + (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) + (do (when (and dropping (not (truthy? (pred (a 1))))) (set dropping false)) + (if dropping (a 0) (rf (a 0) (a 1)))))))) +(defn td-map-indexed [f] + (fn [rf] + (var i -1) + (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (do (++ i) (rf (a 0) (f i (a 1)))))))) + +(defn- transduce-reduce + "Reduce coll with reducing fn rf and seed init, honoring `reduced`." + [rf init coll] + (var acc init) (var stop false) + (each x (if (set? coll) (phs-seq coll) (realize-for-iteration coll)) + (when (not stop) + (set acc (rf acc x)) + (when (core-reduced? acc) (set acc (acc :val)) (set stop true)))) + acc) + +(defn core-transduce + "(transduce xform f coll) or (transduce xform f init coll)." + [xform f & rest] + (let [has-init (= 2 (length rest)) + init (if has-init (in rest 0) (f)) + coll (if has-init (in rest 1) (in rest 0)) + rf (xform f)] + (rf (transduce-reduce rf init coll)))) + +(defn core-into + "(into to from) or (into to xform from)." + [to & rest] + (if (= 2 (length rest)) + (let [xform (in rest 0) from (in rest 1)] + (core-transduce xform (fn [& a] (case (length a) 0 to 1 (a 0) (core-conj (a 0) (a 1)))) to from)) + (into-conj to (realize-for-iteration (in rest 0))))) + +(defn core-sequence + "(sequence coll) or (sequence xform coll) — eager here (returns a seq/tuple)." + [a & rest] + (if (= 0 (length rest)) + (core-seq a) + (tuple ;(core-transduce a (fn [& x] (case (length x) 0 @[] 1 (x 0) (do (array/push (x 0) (x 1)) (x 0)))) @[] (in rest 0))))) (defn- seq-done? "True when cursor c (a lazy-seq or a concrete collection) is exhausted. @@ -416,6 +482,8 @@ (or (nil? c) (= 0 (length c))))) (defn core-map [f & colls] + (if (= 0 (length colls)) + (td-map f) # transducer arity (if (= 1 (length colls)) (let [coll (colls 0)] (if (lazy-seq? coll) @@ -474,10 +542,12 @@ (if (and ok (= (length args) (length cs))) @[(apply f args) (step next-cs next-idxs next-reals)] nil))) - (make-lazy-seq (step init-cs init-idxs init-reals))))) + (make-lazy-seq (step init-cs init-idxs init-reals)))))) -(defn core-filter [pred coll] - (if (lazy-seq? coll) +(defn core-filter [pred & rest] + (if (= 0 (length rest)) (td-filter pred) + (let [coll (in rest 0)] + (if (lazy-seq? coll) # lazy input -> lazy output (supports infinite seqs) (do (defn fstep [c] @@ -493,13 +563,11 @@ (var result @[]) (each x (if (set? coll) (phs-seq coll) coll) (if (pred x) (array/push result x))) - (if (tuple? coll) (tuple/slice (tuple ;result)) result)))) + (if (tuple? coll) (tuple/slice (tuple ;result)) result)))))) -(defn core-remove [pred coll] - (core-filter (fn [x] (not (pred x))) coll)) - -(defn core-reduced [x] @{:jolt/type :jolt/reduced :val x}) -(defn core-reduced? [x] (and (table? x) (= :jolt/reduced (x :jolt/type)))) +(defn core-remove [pred & rest] + (if (= 0 (length rest)) (td-remove pred) + (core-filter (fn [x] (not (pred x))) (in rest 0)))) (def core-reduce (fn [& args] @@ -524,7 +592,9 @@ acc) (error "Wrong number of args passed to: reduce")))) -(defn core-take [n coll] +(defn core-take [n & rest] + (if (= 0 (length rest)) (td-take n) + (let [coll (in rest 0)] (if (lazy-seq? coll) (do (var result @[]) @@ -541,9 +611,11 @@ (while (and (< i n) (< i (length coll))) (array/push result (coll i)) (++ i)) - (if (tuple? coll) (tuple/slice (tuple ;result)) result)))) + (if (tuple? coll) (tuple/slice (tuple ;result)) result)))))) -(defn core-drop [n coll] +(defn core-drop [n & rest] + (if (= 0 (length rest)) (td-drop n) + (let [coll (in rest 0)] (if (lazy-seq? coll) (do (var cur coll) @@ -555,9 +627,11 @@ (do (if (tuple? coll) (tuple/slice coll (min n (length coll))) - (array/slice coll (min n (length coll))))))) + (array/slice coll (min n (length coll))))))))) -(defn core-take-while [pred coll] +(defn core-take-while [pred & rest] + (if (= 0 (length rest)) (td-take-while pred) + (let [coll (in rest 0)] (if (lazy-seq? coll) (do (var result @[]) (var cur coll) (var go true) @@ -569,16 +643,18 @@ (do (var result @[]) (each x coll (if (pred x) (array/push result x) (break))) - (if (tuple? coll) (tuple/slice (tuple ;result)) result)))) + (if (tuple? coll) (tuple/slice (tuple ;result)) result)))))) -(defn core-drop-while [pred coll] - (var c (if (lazy-seq? coll) (realize-ls coll) 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 core-drop-while [pred & rest] + (if (= 0 (length rest)) (td-drop-while pred) + (let [coll (in rest 0) + c (if (lazy-seq? coll) (realize-ls coll) 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]. @@ -799,11 +875,12 @@ (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 coll] - (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-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))))) (defn core-cycle [coll] (let [c (realize-for-iteration coll)] @@ -2384,6 +2461,10 @@ "reduce" core-reduce "every-pred" core-every-pred "find" core-find + "transduce" core-transduce + "sequence" core-sequence + "eduction" core-sequence + "unreduced" core-unreduced "keyword" core-keyword "symbol" core-symbol "namespace" core-namespace diff --git a/test/conformance.janet b/test/conformance.janet index b264f83..b237d9b 100644 --- a/test/conformance.janet +++ b/test/conformance.janet @@ -243,6 +243,20 @@ ["pr-str char" "\"\\\\a\"" "(pr-str \\a)"] ["chars in vec" "[\\a \\b]" "[\\a \\b]"] ["apply str chars" "\"hi\"" "(apply str [\\h \\i])"] + + ### ==== transducers ==== + ["transduce map" "9" "(transduce (map inc) + 0 [1 2 3])"] + ["transduce comp" "12" "(transduce (comp (map inc) (filter even?)) + 0 [1 2 3 4 5])"] + ["transduce conj" "[2 3 4]" "(transduce (map inc) conj [] [1 2 3])"] + ["into xform" "[2 3 4]" "(into [] (map inc) [1 2 3])"] + ["into comp xform" "[1 9 25]" "(into [] (comp (filter odd?) (map (fn [x] (* x x)))) [1 2 3 4 5])"] + ["into take xform" "[0 1 2]" "(into [] (take 3) (range 100))"] + ["sequence xform" "(quote (2 3 4))" "(sequence (map inc) [1 2 3])"] + ["transduce no-init" "6" "(transduce (map inc) + [0 1 2])"] + ["transduce drop" "[3 4 5]" "(into [] (drop 2) [1 2 3 4 5])"] + ["transduce remove" "[1 3 5]" "(into [] (remove even?) [1 2 3 4 5])"] + ["transduce take-while" "[1 2]" "(into [] (take-while (fn [x] (< x 3))) [1 2 3 4 1])"] + ["transduce map-indexed" "[[0 :a] [1 :b]]" "(into [] (map-indexed (fn [i x] [i x])) [:a :b])"] ]) (var pass 0)