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.
This commit is contained in:
parent
24b217d314
commit
394bbe07c3
3 changed files with 25 additions and 22 deletions
|
|
@ -106,3 +106,22 @@
|
||||||
(let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec))))
|
(let [binds (reduce (fn [acc spec] (conj (conj acc (first spec)) `(fn* ~@(rest spec))))
|
||||||
[] fnspecs)]
|
[] fnspecs)]
|
||||||
`(let* [~@binds] ~@body)))
|
`(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))))
|
||||||
|
|
|
||||||
|
|
@ -2150,25 +2150,6 @@
|
||||||
nil]])
|
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
|
(defn core-for
|
||||||
"Macro: (for [binding-form coll :when test :let [bindings]] body)
|
"Macro: (for [binding-form coll :when test :let [bindings]] body)
|
||||||
List comprehension. Basic support for :when and :let."
|
List comprehension. Basic support for :when and :let."
|
||||||
|
|
@ -3645,7 +3626,6 @@
|
||||||
"when" core-when
|
"when" core-when
|
||||||
"when-not" core-when-not
|
"when-not" core-when-not
|
||||||
"when-let" core-when-let
|
"when-let" core-when-let
|
||||||
"condp" core-condp
|
|
||||||
"->" core-thread-first
|
"->" core-thread-first
|
||||||
"->>" core-thread-last
|
"->>" core-thread-last
|
||||||
"cond->" core-cond->
|
"cond->" core-cond->
|
||||||
|
|
@ -3730,7 +3710,7 @@
|
||||||
(defn core-macro-names
|
(defn core-macro-names
|
||||||
"Set of core binding names that are macros."
|
"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!
|
(def init-core!
|
||||||
(fn [& args]
|
(fn [& args]
|
||||||
|
|
|
||||||
|
|
@ -64,4 +64,8 @@
|
||||||
["delay forces once" "1" "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"]
|
["delay forces once" "1" "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"]
|
||||||
["future deref" "9" "(deref (future (* 3 3)))"]
|
["future deref" "9" "(deref (future (* 3 3)))"]
|
||||||
["letfn simple" "25" "(letfn [(sq [x] (* x x))] (sq 5))"]
|
["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))"])
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue