simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

core: move as->/some->/some->>/doto/when-first macros to overlay

Browse source 
Phase 3 batch 3 (jolt-1j0), 5 macros. Establishes the macro-body toolkit:
fresh-sym = (symbol (str (gensym))) for a shared explicit jolt symbol (a bare
(gensym) returns a Janet symbol the destructurer rejects), and splicing binding
pairs into a TEMPLATE vector so core-let sees a tuple form, not a runtime pvec.

when-first stays first-based (lazy-safe): Clojure's (seq coll) form realizes an
infinite coll like (repeat nil) under Jolt's eager evaluator and hangs — the
per-batch battery caught it (when_first.cljc). Clojure-correct seq form waits on
Phase 5 laziness.

conformance 228/228 x3, clojure-test-suite 3930, full suite green, bench flat.
This commit is contained in:
Yogthos 2026-06-07 00:55:19 -04:00
parent e611034550
commit 31a257ce70
3 changed files with 52 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

39
jolt-core/clojure/core/30-macros.clj
View file

@ -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)))))

84
src/jolt/core.janet
View file

@ -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]

13
test/spec/macros-spec.janet
View file

@ -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)"])