Permalink
Browse files

* src/main/clojure/clojure/core/match.clj: add defpred, add validatio…

…n on :when, fix related tests
  • Loading branch information...
1 parent 17075bb commit 15663c79cf91521aa344f7378d18a0ed726280bd @swannodette swannodette committed Feb 26, 2012
Showing with 20 additions and 5 deletions.
  1. +13 −2 src/main/clojure/clojure/core/match.clj
  2. +7 −3 src/test/clojure/clojure/core/match/test/core.clj
@@ -1321,6 +1321,14 @@
;; predicates are desired, use guard patterns.
;;
+(def preds (atom {}))
+
+(defmacro defpred
+ ([name]
+ (swap! preds assoc name name))
+ ([name f]
+ (swap! preds assoc name f)))
+
(declare predicate-pattern?)
(deftype PredicatePattern [p gs _meta]
@@ -1529,8 +1537,11 @@
[[p _ sym]] (with-meta (emit-pattern p) {:as sym}))
(defmethod emit-pattern-for-syntax [Object :when]
- [[p _ gs]] (let [gs (if (not (vector? gs)) [gs] gs)]
- (predicate-pattern (emit-pattern p) (set gs))))
+ [[p _ gs]]
+ (let [gs (if (not (vector? gs)) [gs] gs)]
+ (assert (every? symbol? gs) (str "Invalid predicate expression " gs))
+ (assert (every? #(contains? @preds %) gs) (str "Unknown predicate in " gs))
+ (predicate-pattern (emit-pattern p) (set gs))))
(defmethod emit-pattern-for-syntax [Object :guard]
[[p _ gs]] (let [gs (if (not (vector? gs)) [gs] gs)]
@@ -161,6 +161,10 @@
(defn div3? [n]
(= (mod n 3) 0))
+(defpred even?)
+(defpred odd?)
+(defpred div3?)
+
(deftest guard-pattern-match-1
(is (= (let [y '(2 3 4 5)]
(match [y]
@@ -189,9 +193,9 @@
(deftest guard-pattern-match-4
(is (= (match [1 2]
- [(a :guard #(odd? %)) (b :when #(odd? %))] :a1
+ [(a :guard #(odd? %)) (b :when odd?)] :a1
[(a :guard #(odd? %)) _] :a2
- [_ (b :when #(even? %))] :a3
+ [_ (b :when even?)] :a3
:else :a4)
:a2)))
@@ -239,7 +243,7 @@
op (first e)
op? #(= % op)]
(match [e]
- [([p :when op? x ([p2 :when op? y z] :seq)] :seq)] (list p x y z)))
+ [([p :guard op? x ([p2 :guard op? y z] :seq)] :seq)] (list p x y z)))
'(+ 1 2 3))))
(deftest quoted-symbol

0 comments on commit 15663c7

Please sign in to comment.