core: move for to the syntax tier (and fix multi-group :when)
Port of core-for: desugar a comprehension to nested map/mapcat over the binding colls, :let -> let*, :while -> take-while on the coll. Lives in 00-syntax because doseq (already there) expands to it; the macro body uses only kernel/seed fns so it runs at analyzer-build time. doseq no longer depends on a Janet macro. Fixed a latent bug the Janet macro had: :when wrapped the inner form in (list ...) unconditionally, but for an outer binding group the inner form is already a seq, so mapcat produced a seq-of-seqs instead of flattening. e.g. (for [x [0 1] :when (odd? x) y [:a :b]] [x y]) gave ((... ...)) instead of ([1 :a] [1 :b]). Now the (list ...) wrap is only applied to the last group's scalar body; outer groups contribute their seq directly. Added :let+:when, multi-group :when, and destructuring regression cases. conformance 228x3, fixpoint, clojure-test-suite 3930, full suite green, bench flat.
This commit is contained in:
Yogthos
parent
40b0f525f3
commit
023fe637ce
3 changed files with 57 additions and 59 deletions
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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)"]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue