From 842dd4011ed074f61c32f93eba552ff84e9a5e9f Mon Sep 17 00:00:00 2001
From: Steve Miner <steveminer@gmail.com>
Date: Wed, 12 Oct 2011 11:11:10 -0400
Subject: [PATCH] Allow flattened-style pattern rows as short-hand for grouping :when and :as at the top-level such as [a :when even?]

---
 src/main/clojure/clojure/core/match.clj           |   29 ++++++++++++++++++--
 src/test/clojure/clojure/core/match/test/core.clj |   27 +++++++++++++++++++
 2 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/src/main/clojure/clojure/core/match.clj b/src/main/clojure/clojure/core/match.clj
index 910d9d1..bb57190 100644
--- a/src/main/clojure/clojure/core/match.clj
+++ b/src/main/clojure/clojure/core/match.clj
@@ -1398,8 +1398,30 @@
                (vec (remove #(= % :default)
                             (keys (.getMethodTable ^clojure.lang.MultiFn emit-pattern-for-syntax))))))))
 
+
+(defn- pattern-keyword? [kw]
+  (#{:when :as} kw))
+
+
+(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- group-top-level-keywords 
+  "Returns a pattern with pattern-keywords (:when and :as) properly grouped.  The original pattern
+may use the 'flattened' syntax at the top level.  For example, a 'flattened' pattern row like
+ [a b :when even?] is grouped as [a (b :when even?)]."
+ [pattern]
+ (if (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 p q r)) void void]
+                           :else [(conj result p) q r]))
+                   [[] void void]
+                   (conj pattern void void)))
+   pattern)))
+
 (defn emit-clause [[pat action]]
-  (let [p (into [] (map emit-pattern pat))]
+  (let [p (into [] (map emit-pattern (group-top-level-keywords pat)))]
     (pattern-row p action)))
 
 ;; This could be scattered around in other functions to be more efficient
@@ -1414,6 +1436,7 @@
                                      vars " is not a vector"))))
 
   (letfn [(check-pattern [pat nvars rownum]
+           (let [pat (group-top-level-keywords pat)]
             (cond 
              (not (vector? pat)) (throw (AssertionError. 
                                          (str "Pattern row " rownum
@@ -1427,7 +1450,7 @@
                      (str "Pattern row " rownum
                           ": Pattern row has differing number of patterns. "
                           pat " has " (count pat) " pattern/s, expecting "
-                          nvars " for occurrences " vars)))))]
+                          nvars " for occurrences " vars))))))]
 
     (let [nvars (count vars)
           cls (partition 2 clauses)]
@@ -1532,4 +1555,4 @@
             *line* (-> &form meta :line)
             *locals* (dissoc &env '_)
             *warned* (atom false)]
-    `~(clj-form vars clauses)))
\ No newline at end of file
+    `~(clj-form vars clauses)))
diff --git a/src/test/clojure/clojure/core/match/test/core.clj b/src/test/clojure/clojure/core/match/test/core.clj
index c0f4465..f6a53f5 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)))
 
+;; uses 'flattened' syntax for guard
+(deftest guard-pattern-match-2
+  (is (= (let [x 2 y 3 z [4 5]]
+           (match [x y z]
+             [_ a :when even? [b c] :as d] :a0
+             [_ b :when [odd? div3?] _] :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 OR 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