From 43c52f15fcdd41cdec8d50fe4e271d4f45ae7c82 Mon Sep 17 00:00:00 2001
From: Steve Miner <steveminer@gmail.com>
Date: Thu, 20 Oct 2011 15:53:00 -0400
Subject: [PATCH] Support for 'flattened' syntax for :when and :as keywords.  For example, [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.

---
 src/main/clojure/clojure/core/match.clj           |   47 ++++++++++++++++++--
 src/test/clojure/clojure/core/match/test/core.clj |   27 ++++++++++++
 2 files changed, 69 insertions(+), 5 deletions(-)

diff --git a/src/main/clojure/clojure/core/match.clj b/src/main/clojure/clojure/core/match.clj
index 16f09c4..0480a12 100644
--- a/src/main/clojure/clojure/core/match.clj
+++ b/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))))
\ No newline at end of file
+         ~@body))))
+
diff --git a/src/test/clojure/clojure/core/match/test/core.clj b/src/test/clojure/clojure/core/match/test/core.clj
index c0f4465..acf3676 100644
--- a/src/test/clojure/clojure/core/match/test/core.clj
+++ b/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]
-- 
1.7.4.1