From 394bbe07c3a50c2c20c65a42922c4c26bae52a3b Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 7 Jun 2026 01:08:44 -0400 Subject: [PATCH] core: move condp macro to overlay Phase 3 batch 5 (jolt-1j0). condp with a recursive emit building the nested if chain, including the test :>> result-fn form and the trailing default. This exhausts the cleanly-portable safe macros. conformance 228/228 x3, full suite green. --- jolt-core/clojure/core/30-macros.clj | 19 +++++++++++++++++++ src/jolt/core.janet | 22 +--------------------- test/spec/macros-spec.janet | 6 +++++- 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 1854f4b..3c2a8bd 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -106,3 +106,22 @@ (let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec)))) [] fnspecs)] `(let* [~@binds] ~@body))) + +;; condp: clauses are test-expr result-expr, or test-expr :>> result-fn (calls +;; result-fn on the truthy (pred test-expr value)); a lone trailing expr is the +;; default. The recursive emit builds a nested if chain. +(defmacro condp [pred expr & clauses] + (let [gp (fresh-sym) ge (fresh-sym) + emit (fn emit [args] + (let [n (if (= :>> (second args)) 3 2) + clause (take n args) + more (drop n args) + cn (count clause)] + (cond + (= 0 cn) `(throw (ex-info (str "No matching clause: " ~ge) {})) + (= 1 cn) (first clause) + (= 2 cn) `(if (~gp ~(first clause) ~ge) ~(second clause) ~(emit more)) + :else `(if-let [p# (~gp ~(first clause) ~ge)] + (~(nth clause 2) p#) + ~(emit more)))))] + `(let [~gp ~pred ~ge ~expr] ~(emit clauses)))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 22e7f78..e834c57 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -2150,25 +2150,6 @@ nil]]) -(defn core-condp - "Macro: (condp pred expr clause1 val1 ... default)" - [pred expr & clauses] - (def g (gensym)) - (defn build [cls] - (if (= 0 (length cls)) - nil - (if (= 1 (length cls)) - (first cls) - (let [c (first cls) - v (first (tuple/slice cls 1))] - @[{:jolt/type :symbol :ns nil :name "if"} - (if (and (struct? c) (= :symbol (c :jolt/type)) (= ":>>" (c :name))) - @[v g] - @[pred c g]) - v - (build (tuple/slice cls 2))])))) - @[{:jolt/type :symbol :ns nil :name "let*"} @[g expr] (build clauses)]) - (defn core-for "Macro: (for [binding-form coll :when test :let [bindings]] body) List comprehension. Basic support for :when and :let." @@ -3645,7 +3626,6 @@ "when" core-when "when-not" core-when-not "when-let" core-when-let - "condp" core-condp "->" core-thread-first "->>" core-thread-last "cond->" core-cond-> @@ -3730,7 +3710,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 "->" true "->>" true "doseq" 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 "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 a087dbd..505d1e7 100644 --- a/test/spec/macros-spec.janet +++ b/test/spec/macros-spec.janet @@ -64,4 +64,8 @@ ["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))"]) + ["letfn mutual" "true" "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 8))"] + ["condp match" ":two" "(condp = 2 1 :one 2 :two 3 :three)"] + ["condp default" ":else" "(condp = 9 1 :one 2 :two :else)"] + ["condp :>> form" "\"got 2\"" "(condp some [1 2 3] #{0 9} :>> (fn [x] (str \"got \" x)) #{2 6} :>> (fn [x] (str \"got \" x)))"] + ["condp no match" ":threw" "(try (condp = 9 1 :one) (catch :default e :threw))"])