diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index c34a509..5aea21a 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -43,3 +43,42 @@ `(let [n# ~n] (loop [~i 0] (when (< ~i n#) ~@body (recur (inc ~i))))))) + +;; A fresh jolt symbol inside a macro body: (gensym) here resolves to Janet's +;; builtin (a Janet symbol the destructurer rejects), so round-trip through str. +(defn- fresh-sym [] (symbol (str (gensym)))) + +;; Lazy-safe: take only the head via first (Clojure uses (seq coll), but Jolt's +;; eager seq would realize an infinite coll like (repeat nil) and hang). Matches +;; the prior Janet behavior; the nil/false-head distinction waits on Phase 5 +;; laziness. +(defmacro when-first [bindings & body] + (let [x (bindings 0) coll (bindings 1)] + `(when-let [~x (first ~coll)] ~@body))) + +;; doto threads a single fresh-bound value as the first arg of each form (side +;; effects), returning the value. A shared explicit gensym is needed because the +;; forms are built outside the let's template. +(defmacro doto [x & forms] + (let [g (fresh-sym) + steps (map (fn [f] (if (seq? f) (apply list (first f) g (rest f)) (list f g))) forms)] + `(let [~g ~x] ~@steps ~g))) + +;; Threading-with-rebinding macros. The binding pairs are spliced into a TEMPLATE +;; vector (so core-let sees a tuple form, not a runtime pvec value). +(defn- thread-binds [g steps] + (reduce (fn [acc s] (conj (conj acc g) s)) [] (butlast steps))) + +(defmacro as-> [expr name & forms] + (let [pairs (reduce (fn [acc f] (conj (conj acc name) f)) [] (butlast forms))] + `(let [~name ~expr ~@pairs] ~(if (empty? forms) name (last forms))))) + +(defmacro some-> [expr & forms] + (let [g (fresh-sym) + steps (map (fn [f] `(if (nil? ~g) nil (-> ~g ~f))) forms)] + `(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps))))) + +(defmacro some->> [expr & forms] + (let [g (fresh-sym) + steps (map (fn [f] `(if (nil? ~g) nil (->> ~g ~f))) forms)] + `(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps))))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index d8d2aa2..b0e046f 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -2153,29 +2153,6 @@ @[(sym* "let*") @[form-sym temp] @[(sym* "do") ;body]] nil]]) -(defn core-doto - "Macro: (doto obj (method args)...) → let obj, call methods, return obj" - [obj & forms] - (def sym (gensym "doto")) - (def result @[{:jolt/type :symbol :ns nil :name "let*"} - @[sym obj]]) - (each f forms - (if (array? f) - # (doto x (f a b)) -> (f x a b) (thread x as first arg, not a method call) - (array/push result @[(first f) sym ;(tuple/slice f 1)]) - (array/push result @[f sym]))) - (array/push result sym) - result) - - -(defn core-when-first - "Macro: (when-first [sym coll] & body) -> (when-let [sym (first coll)] body...)" - [bindings & body] - (def sym (in bindings 0)) - (def coll-form (in bindings 1)) - @[{:jolt/type :symbol :ns nil :name "when-let"} - @[sym @[{:jolt/type :symbol :ns nil :name "first"} coll-form]] - ;body]) (defn core-condp "Macro: (condp pred expr clause1 val1 ... default)" @@ -2277,48 +2254,6 @@ arr) ;rest-forms]) (apply core-thread-last [@[f x] ;rest-forms]))))) -(defn core-some-> - "Macro: (some-> expr & forms) — thread first, stop at nil" - [expr & forms] - (if (= 0 (length forms)) expr - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} expr] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "some?"} - {:jolt/type :symbol :ns nil :name "some->__x"}] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} - (if (array? f) - (let [arr (array/slice f)] - (array/insert arr 1 {:jolt/type :symbol :ns nil :name "some->__x"}) - arr) - @[f {:jolt/type :symbol :ns nil :name "some->__x"}])] - (apply core-some-> [{:jolt/type :symbol :ns nil :name "some->__x"} ;rest-forms])] - nil]]))) - -(defn core-some->> - "Macro: (some->> expr & forms) — thread last, stop at nil" - [expr & forms] - (if (= 0 (length forms)) expr - (let [f (first forms) - rest-forms (tuple/slice forms 1)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} expr] - @[{:jolt/type :symbol :ns nil :name "if"} - @[{:jolt/type :symbol :ns nil :name "some?"} - {:jolt/type :symbol :ns nil :name "some->__x"}] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[{:jolt/type :symbol :ns nil :name "some->__x"} - (if (array? f) - (let [arr (array/slice f)] - (array/push arr {:jolt/type :symbol :ns nil :name "some->__x"}) - arr) - @[f {:jolt/type :symbol :ns nil :name "some->__x"}])] - (apply core-some->> [{:jolt/type :symbol :ns nil :name "some->__x"} ;rest-forms])] - nil]]))) - (defn core-cond-> "Macro: (cond-> expr test form ...) — thread first only when test is true" [expr & clauses] @@ -2361,18 +2296,6 @@ result-form])))) @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses g)]) -(defn core-as-> - "Macro: (as-> expr name & forms) — bind name to expr, thread through forms" - [expr name & forms] - (defn build [fs acc] - (if (= 0 (length fs)) - acc - (let [f (first fs)] - @[{:jolt/type :symbol :ns nil :name "let*"} - @[name acc] - (build (tuple/slice fs 1) f)]))) - (build forms expr)) - (defn core-push-thread-bindings [b] (push-thread-bindings b)) (defn core-pop-thread-bindings [] (pop-thread-bindings)) @@ -3774,17 +3697,12 @@ "for" core-for "when" core-when "when-not" core-when-not - "when-first" core-when-first "when-let" core-when-let - "doto" core-doto "condp" core-condp "->" core-thread-first "->>" core-thread-last - "some->" core-some-> - "some->>" core-some->> "cond->" core-cond-> "cond->>" core-cond->> - "as->" core-as-> "defn" core-defn "defn-" core-defn- "derive" core-derive @@ -3866,7 +3784,7 @@ (defn core-macro-names "Set of core binding names that are macros." [] - @{"and" true "or" true "cond" true "case" true "for" true "when" true "when-not" true "when-let" true "doto" true "defn" true "defn-" true "declare" 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 "binding" true "lazy-seq" true "lazy-cat" true "when-first" true "condp" true "some->" true "some->>" true "cond->" true "cond->>" true "as->" true "->" true "->>" true "letfn" true "doseq" true "delay" true "assert" true "future" true}) + @{"and" true "or" true "cond" true "case" true "for" true "when" true "when-not" true "when-let" true "defn" true "defn-" true "declare" 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 "binding" true "lazy-seq" true "lazy-cat" true "condp" true "cond->" true "cond->>" true "->" true "->>" true "letfn" true "doseq" true "delay" true "assert" true "future" true}) (def init-core! (fn [& args] diff --git a/test/spec/macros-spec.janet b/test/spec/macros-spec.janet index f55a98f..e605a4c 100644 --- a/test/spec/macros-spec.janet +++ b/test/spec/macros-spec.janet @@ -43,4 +43,15 @@ ["when-some multi" "14" "(when-some [x 7] (inc x) (* x 2))"] ["when-some nil" "nil" "(when-some [x nil] x)"] ["while loop" "3" "(let [a (atom 0)] (while (< @a 3) (swap! a inc)) @a)"] - ["dotimes sum" "10" "(let [a (atom 0)] (dotimes [i 5] (swap! a + i)) @a)"]) + ["dotimes sum" "10" "(let [a (atom 0)] (dotimes [i 5] (swap! a + i)) @a)"] + ["as-> threads" "12" "(as-> 5 x (+ x 1) (* x 2))"] + ["as-> no forms" "5" "(as-> 5 x)"] + ["some-> through" "6" "(some-> {:a {:b 5}} :a :b inc)"] + ["some-> short-circuit" "nil" "(some-> {:a nil} :a :b)"] + ["some->> through" "9" "(some->> [1 2 3] (map inc) (reduce +))"] + ["some->> nil" "nil" "(some->> nil (map inc))"] + ["doto returns obj" "[1 2]" "(deref (doto (atom []) (swap! conj 1) (swap! conj 2)))"] + ["when-first" "20" "(when-first [x [10 20 30]] (* x 2))"] + ["when-first empty" "nil" "(when-first [x []] :body)"] + ["when-first nil coll" "nil" "(when-first [x nil] :body)"] + ["when-first range" "0" "(when-first [x (range 5)] x)"])