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))))
|
||||
[] 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))))
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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))"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue