From 24b217d314f8fdbdadbeae75811631cf6240b5de Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 7 Jun 2026 01:04:21 -0400 Subject: [PATCH] core: move cond->>/assert/delay/future/letfn macros to overlay Phase 3 batch 4 (jolt-1j0), 5 macros. cond->> (thread-last) is safe; cond-> stays (compiler uses it). delay/future expand to make-delay/future-call host fns; letfn builds its fn* binding via a template (cons/list in a macro body make a plist the evaluator can't call as a form). conformance 228/228 x3, clojure-test-suite 3930, full suite green, bench flat. --- jolt-core/clojure/core/30-macros.clj | 24 ++++++++++++ src/jolt/core.janet | 56 +--------------------------- test/spec/macros-spec.janet | 12 +++++- 3 files changed, 36 insertions(+), 56 deletions(-) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 5aea21a..1854f4b 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -82,3 +82,27 @@ (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))))) + +;; cond-> stays in Janet (the compiler uses it); cond->> (thread-last) is safe. +(defmacro cond->> [expr & clauses] + (let [g (fresh-sym) + steps (map (fn [pair] `(if ~(first pair) (->> ~g ~(second pair)) ~g)) + (partition 2 clauses))] + `(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps))))) + +(defmacro assert [x & [message]] + (let [msg (if message message (str "Assert failed: " (pr-str x)))] + `(when-not ~x (throw (ex-info ~msg {}))))) + +(defmacro delay [& body] + `(make-delay (fn [] ~@body))) + +(defmacro future [& body] + `(future-call (fn [] ~@body))) + +;; Build the fn* form via a template (a reader-list array): cons/list in a macro +;; body produce a plist the evaluator can't call as a form. +(defmacro letfn [fnspecs & body] + (let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec)))) + [] fnspecs)] + `(let* [~@binds] ~@body))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index b0e046f..22e7f78 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -1929,10 +1929,6 @@ false)) # future macro: (future body...) -> (future-call (fn* [] body...)) -(defn core-future [& body] - @[{:jolt/type :symbol :ns nil :name "future-call"} - @[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]]) - (defn core-deref [ref & opts] (cond (and (table? ref) (= :jolt/atom (ref :jolt/type))) @@ -2275,27 +2271,6 @@ result-form])))) @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses g)]) -(defn core-cond->> - "Macro: (cond->> expr test form ...) — thread last only when test is true" - [expr & clauses] - (def g (gensym)) - (defn build [cls result-form] - (if (= 0 (length cls)) - result-form - (let [t (first cls) - f (in cls 1) - f-call (if (array? f) - (let [arr (array/slice f)] - (array/push arr result-form) - arr) - @[f result-form])] - (build (tuple/slice cls 2) - @[{:jolt/type :symbol :ns nil :name "if"} - t - f-call - result-form])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses g)]) - (defn core-push-thread-bindings [b] (push-thread-bindings b)) (defn core-pop-thread-bindings [] (pop-thread-bindings)) @@ -2462,10 +2437,6 @@ # Clojure's realized? is only defined on IPending; reject anything else. (error (string "realized? not supported on " (type x))))) -# delay macro: (delay body...) -> (make-delay (fn* [] body...)) -(defn core-delay [& body] - @[{:jolt/type :symbol :ns nil :name "make-delay"} - @[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]]) # Proxy stub — returns nil form (macro, args not evaluated) (defn core-proxy [& args] nil) @@ -2548,16 +2519,6 @@ # letfn — mutually-recursive local fns. Expands to let* of fn* bindings; jolt # closures capture the (shared, mutable) bindings table, so forward references # between the fns resolve at call time. -(defn core-letfn [specs & body] - (def binds @[]) - (each spec specs - (let [fname (spec 0) - rest (tuple/slice spec 1)] - (array/push binds fname) - # rest is either ([args] body...) for single-arity or a list of - # ([args] body) clauses for multi-arity; (fn* ;rest) handles both. - (array/push binds @[{:jolt/type :symbol :ns nil :name "fn*"} ;rest]))) - @[{:jolt/type :symbol :ns nil :name "let*"} (tuple/slice (tuple ;binds)) ;body]) # doseq — like `for` but eager and returns nil. Reuse `for`, force realization # with `count`, discard the result. @@ -2569,16 +2530,6 @@ nil]) # assert — (assert x) / (assert x message). Throws when x is falsy. -(defn core-assert [x & more] - (def msg-form - (if (> (length more) 0) - (first more) - (let [b @""] (pr-render b x) (string "Assert failed: " (string b))))) - @[{:jolt/type :symbol :ns nil :name "if"} - x - nil - @[{:jolt/type :symbol :ns nil :name "throw"} - @[{:jolt/type :symbol :ns nil :name "ex-info"} msg-form {}]]]) # resolve stub — returns nil (symbols not found in Jolt's clojure.core) (defn core-resolve [sym] nil) # shadowed by the resolve special form (needs ctx) @@ -3383,9 +3334,7 @@ "pop" core-pop "trampoline" core-trampoline "format" core-format - "letfn" core-letfn "doseq" core-doseq - "assert" core-assert "first" core-first "rest" core-rest "next" core-next @@ -3424,7 +3373,6 @@ "record?" core-record? "promise" core-promise "deliver" core-deliver - "future" core-future "future-call" core-future-call "future?" core-future? "future-done?" core-future-done? @@ -3499,7 +3447,6 @@ "realized?" core-realized? "delay?" core-delay? "make-delay" core-make-delay - "delay" core-delay "take" core-take "drop" core-drop "take-while" core-take-while @@ -3702,7 +3649,6 @@ "->" core-thread-first "->>" core-thread-last "cond->" core-cond-> - "cond->>" core-cond->> "defn" core-defn "defn-" core-defn- "derive" core-derive @@ -3784,7 +3730,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 "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}) + @{"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 "->" true "->>" true "doseq" true}) (def init-core! (fn [& args] diff --git a/test/spec/macros-spec.janet b/test/spec/macros-spec.janet index e605a4c..a087dbd 100644 --- a/test/spec/macros-spec.janet +++ b/test/spec/macros-spec.janet @@ -54,4 +54,14 @@ ["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)"]) + ["when-first range" "0" "(when-first [x (range 5)] x)"] + ["cond->> threads" "12" "(cond->> 5 true (+ 1) false (* 100) true (* 2))"] + ["cond->> skip" "10" "(cond->> 10 false (+ 1))"] + ["assert pass" ":ok" "(do (assert (= 1 1)) :ok)"] + ["assert throws" ":threw" "(try (assert (= 1 2)) (catch :default e :threw))"] + ["assert message" "\"nope\"" "(try (assert false \"nope\") (catch :default e (ex-message e)))"] + ["delay value" "42" "(deref (delay 42))"] + ["delay forces once" "1" "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"] + ["future deref" "9" "(deref (future (* 3 3)))"] + ["letfn simple" "25" "(letfn [(sq [x] (* x x))] (sq 5))"] + ["letfn mutual" "true" "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 8))"])