diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index b2bebfd..a76a958 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -96,6 +96,59 @@ `(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))] `(let* [~g ~expr] ~(build clauses)))) +;; for: list comprehension, desugared to nested map/mapcat over the binding colls. +;; Per binding group: :when wraps the inner form in (if test (list inner) []) so +;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in +;; take-while. The last group with no modifiers is a plain map (no flatten needed). +;; Faithful port of the prior Janet macro (single body expr). The body uses only +;; kernel/seed fns so it runs at analyzer-build time. `fn` (not fn*) carries the +;; binding so destructuring forms work. +(defmacro for [bindings body] + (let [scan (fn scan [bvec i bind coll mods] + (if (and (< i (count bvec)) (keyword? (nth bvec i))) + (let [k (nth bvec i) + v (nth bvec (inc i))] + (cond + (= k :when) (scan bvec (+ i 2) bind coll (conj mods [:when v])) + (= k :let) (scan bvec (+ i 2) bind coll (conj mods [:let v])) + (= k :while) (scan bvec (+ i 2) bind `(take-while (fn [~bind] ~v) ~coll) mods) + :else (scan bvec (inc i) bind coll mods))) + [i bind coll mods])) + parse-groups (fn parse-groups [bvec i groups] + (if (>= i (count bvec)) + groups + (let [r (scan bvec (+ i 2) (nth bvec i) (nth bvec (inc i)) [])] + (parse-groups bvec (nth r 0) + (conj groups [(nth r 1) (nth r 2) (nth r 3)]))))) + ;; Apply the group's modifiers around a contribution that is ALREADY a seq + ;; (a (list body) for the last group, an inner comprehension otherwise), so + ;; :when just returns it or [] — no extra (list ...) that mapcat couldn't + ;; flatten. :let binds around it; mods apply outer-to-inner (left to right). + wrap-mods (fn wrap-mods [mods inner] + (if (empty? mods) + inner + (let [m (first mods) + sub (wrap-mods (rest mods) inner)] + (if (= (first m) :when) + `(if ~(nth m 1) ~sub []) + `(let* ~(nth m 1) ~sub))))) + build (fn build [idx groups] + (let [g (nth groups idx) + my-bind (nth g 0) + my-coll (nth g 1) + my-mods (nth g 2) + is-last (= idx (dec (count groups)))] + (if (and is-last (empty? my-mods)) + ;; fast path: last group, no modifiers -> a plain map of body + `(map (fn [~my-bind] ~body) ~my-coll) + ;; general: mapcat over a seq contribution (wrap a last-group + ;; body in a one-element list so mapcat yields the bodies). + (let [base (if is-last `(list ~body) (build (inc idx) groups))] + `(mapcat (fn [~my-bind] ~(wrap-mods my-mods base)) ~my-coll)))))] + (if (>= (count bindings) 2) + (build 0 (parse-groups bindings 0 [])) + body))) + ;; doseq runs body for side effects across the bindings, returning nil. Same ;; shortcut as the prior Janet macro: realize a `for` comprehension with count ;; (for handles :when/:let/:while and multiple bindings). diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 91e1ef3..c5542af 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -2081,63 +2081,6 @@ nil]]) -(defn core-for - "Macro: (for [binding-form coll :when test :let [bindings]] body) - List comprehension. Basic support for :when and :let." - [bindings body] - (defn parse-groups [bvec] - (var groups @[]) - (var i 0) - (while (< i (length bvec)) - (def bind (bvec i)) - (var coll (bvec (+ i 1))) - (def mods @[]) - (+= i 2) - (while (and (< i (length bvec)) (keyword? (bvec i))) - (case (bvec i) - :when (do (array/push mods @[{:jolt/type :symbol :ns nil :name "when"} (bvec (+ i 1))]) (+= i 2)) - :let (do (array/push mods @[{:jolt/type :symbol :ns nil :name "let"} (bvec (+ i 1))]) (+= i 2)) - # :while terminates iteration of this binding's collection - :while (do (set coll @[{:jolt/type :symbol :ns nil :name "take-while"} - @[{:jolt/type :symbol :ns nil :name "fn"} [bind] (bvec (+ i 1))] - coll]) - (+= i 2)) - (do (+= i 1)))) - (array/push groups @[bind coll mods])) - groups) - (defn wrap-mods [mods inner-form] - (if (= 0 (length mods)) - inner-form - (let [m (in mods (- (length mods) 1)) - rest-mods (array/slice mods 0 (- (length mods) 1)) - kind (get (m 0) :name)] - (wrap-mods rest-mods - (if (= kind "when") - @[{:jolt/type :symbol :ns nil :name "if"} (m 1) - @[{:jolt/type :symbol :ns nil :name "list"} inner-form] @[]] - @[{:jolt/type :symbol :ns nil :name "let*"} (m 1) inner-form]))))) - (defn build [group-idx groups] - (if (>= group-idx (length groups)) - body - (let [g (in groups group-idx) - my-bind (in g 0) - my-coll (in g 1) - my-mods (in g 2) - inner (build (+ group-idx 1) groups) - inner-form (wrap-mods my-mods inner) - is-last (= group-idx (- (length groups) 1)) - has-mods (> (length my-mods) 0)] - (if (and is-last (not has-mods)) - @[{:jolt/type :symbol :ns nil :name "map"} - @[{:jolt/type :symbol :ns nil :name "fn"} [my-bind] inner-form] - my-coll] - @[{:jolt/type :symbol :ns nil :name "mapcat"} - @[{:jolt/type :symbol :ns nil :name "fn"} [my-bind] inner-form] - my-coll])))) - (if (>= (length bindings) 2) - (build 0 (parse-groups bindings)) - body)) - (defn core-push-thread-bindings [b] (push-thread-bindings b)) (defn core-pop-thread-bindings [] (pop-thread-bindings)) @@ -3473,7 +3416,6 @@ "add-watch" core-add-watch "remove-watch" core-remove-watch "not" core-not - "for" core-for "when-let" core-when-let "defn" core-defn "defn-" core-defn- @@ -3554,7 +3496,7 @@ (defn core-macro-names "Set of core binding names that are macros." [] - @{"for" true "when-let" true "defn" true "defn-" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "lazy-seq" true "lazy-cat" true}) + @{"when-let" true "defn" true "defn-" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "lazy-seq" true "lazy-cat" true}) (def init-core! (fn [& args] diff --git a/test/spec/control-flow-spec.janet b/test/spec/control-flow-spec.janet index eab82a6..ed21b78 100644 --- a/test/spec/control-flow-spec.janet +++ b/test/spec/control-flow-spec.janet @@ -68,6 +68,9 @@ ["for :when" "[0 2 4]" "(for [x (range 6) :when (even? x)] x)"] ["for :while" "[0 1 2]" "(for [x (range 10) :while (< x 3)] x)"] ["for :let" "[0 1 4]" "(for [x (range 3) :let [sq (* x x)]] sq)"] + ["for :let+:when" "[4 6 8]" "(for [x (range 5) :let [y (* x 2)] :when (> y 3)] y)"] + ["for multi :when" "[[1 :a] [1 :b]]" "(for [x [0 1] :when (odd? x) y [:a :b]] [x y])"] + ["for destructure" "[3 7]" "(for [[a b] [[1 2] [3 4]]] (+ a b))"] ["doseq side-effect" "6" "(let [a (atom 0)] (doseq [x [1 2 3]] (swap! a (fn [v] (+ v x)))) @a)"] ["doseq nested" "4" "(let [c (atom 0)] (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"] ["doseq :when" "[1 3]" "(let [a (atom [])] (doseq [x [1 2 3] :when (odd? x)] (swap! a conj x)) @a)"]