Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Support for 'flattened' syntax for :when and :as keywords. For exampl…

…e, [a :when even? b] is grouped as [(a :when even?) b]. Also works with nested patterns. Changed (quote :when) syntax to allow quoted keywords to match literal keyword. [a ':when b] will now match when the second item is literally :when.
  • Loading branch information...
commit d69abfaf68a86d5b9d73070e666720770779118f 1 parent 819f7f7
@miner miner authored swannodette committed
View
47 src/main/clojure/clojure/core/match.clj
@@ -1352,7 +1352,8 @@
(defmethod emit-pattern clojure.lang.ISeq
[pat] (if (and (= (count pat) 2)
(= (first pat) 'quote)
- (symbol? (second pat)))
+ (or (symbol? (second pat))
+ (keyword? (second pat))))
(literal-pattern (second pat))
(emit-pattern-for-syntax pat)))
@@ -1398,8 +1399,43 @@
(vec (remove #(= % :default)
(keys (.getMethodTable ^clojure.lang.MultiFn emit-pattern-for-syntax))))))))
+
+(defn- pattern-keyword? [kw]
+ (#{:when :as} kw))
+
+(defn- interpose1
+ "Like regular interpose, but guarantees that at least one interposing sep is used. For example, (interpose1 'x '(1)) => (1 x)"
+ [sep coll]
+ (let [result (interpose sep coll)]
+ (cond (seq (rest result)) result
+ (not (seq result)) (list sep)
+ :else (list (first result) sep))))
+
+(let [void (gensym)]
+ ;; void is a unique placeholder for nothing -- we can't use nil because that's a legal symbol in a pattern row
+ (defn- regroup-keywords [pattern]
+ (cond (vector? pattern)
+ (first (reduce (fn [[result p q] r]
+ (cond (= void p) [result q r]
+ (and (not= void r) (pattern-keyword? q)) [(conj result (list (regroup-keywords p) q r)) void void]
+ :else [(conj result (regroup-keywords p)) q r]))
+ [[] void void]
+ (conj pattern void void)))
+ (seq? pattern) (if (= (second pattern) '|)
+ (interpose1 '| (map regroup-keywords (take-nth 2 pattern)))
+ (cons (regroup-keywords (first pattern)) (rest pattern)))
+ :else pattern)))
+
+ (defn- group-keywords
+ "Returns a pattern with pattern-keywords (:when and :as) properly grouped. The original pattern
+may use the 'flattened' syntax. For example, a 'flattened' pattern row like [a b :when even?]
+is grouped as [a (b :when even?)]."
+ [pattern]
+ (if (vector? pattern) (regroup-keywords pattern) pattern))
+
+
(defn emit-clause [[pat action]]
- (let [p (into [] (map emit-pattern pat))]
+ (let [p (into [] (map emit-pattern (group-keywords pat)))]
(pattern-row p action)))
(defn- wildcards-and-duplicates
@@ -1439,6 +1475,7 @@
vars " is not a vector"))))
(letfn [(check-pattern [pat nvars rownum]
+ (let [pat (group-keywords pat)]
(cond
(not (vector? pat)) (throw (AssertionError.
(str "Pattern row " rownum
@@ -1458,8 +1495,7 @@
(str "Pattern row " rownum
": Pattern row reuses wildcards in " pat
". The following wildcards are ambiguous: " (apply str (interpose ", " duplicates))
- ". There's no guarantee that the matched values will be same. Rename the occurrences uniquely.")))))]
-
+ ". There's no guarantee that the matched values will be same. Rename the occurrences uniquely."))))))]
(let [nvars (count vars)
cls (partition 2 clauses)]
(doseq [[[pat _] rownum] (map vector (butlast cls) (rest (range)))]
@@ -1569,4 +1605,5 @@
(let [bindvars# (take-nth 2 bindings)]
`(let ~bindings
(match [~@bindvars#]
- ~@body))))
+ ~@body))))
+
View
27 src/test/clojure/clojure/core/match/test/core.clj
@@ -169,6 +169,33 @@
:else []))
:a1)))
+;; like guard-pattern-match-1 but uses 'flattened' syntax for guard
+(deftest guard-pattern-match-2
+ (is (= (let [y '(2 3 4 5)]
+ (match [y]
+ [([_ a :when even? _ _] :seq)] :a0
+ [([_ b :when [odd? div3?] _ _] :seq)] :a1
+ :else []))
+ :a1)))
+
+;; uses 'flattened' syntax for guard
+(deftest guard-pattern-match-3
+ (is (= (let [x 2 y 3 z [4 5]]
+ (match [x y z]
+ [a :when even? _ [b c] :as d] (+ (first d) c)
+ [_ b :when [odd? div3?] _] :a1
+ :else []))
+ 9)))
+
+;; use ':when pattern to match literal :when (as opposed to guard syntax)
+(deftest literal-when-match-1
+ (is (= (let [x :as y :when z 1]
+ (match [x y z]
+ [a ':when 1] :success
+ [:as _ 2] :fail
+ :else :fail))
+ :success)))
+
(extend-type java.util.Date
IMatchLookup
(val-at* [this k not-found]
Please sign in to comment.
Something went wrong with that request. Please try again.