From 260b0f4a3386ca7cc4624261ddcbcc9c4ce4a863 Mon Sep 17 00:00:00 2001
From: Steve Miner <steveminer@gmail.com>
Date: Fri, 14 Oct 2011 13:59:05 -0400
Subject: [PATCH] Revised patch for supporting 'flattened' :when and :as in row patterns.  :when and :as are automatically grouped with the preceding pattern so you don't have to wrap them in parens.

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

diff --git a/src/main/clojure/clojure/core/match.clj b/src/main/clojure/clojure/core/match.clj
index 910d9d1..382b56a 100644
--- a/src/main/clojure/clojure/core/match.clj
+++ b/src/main/clojure/clojure/core/match.clj
@@ -1398,8 +1398,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)))
+          (list? 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)))
 
 ;; This could be scattered around in other functions to be more efficient
@@ -1414,6 +1449,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
@@ -1427,7 +1463,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 +1568,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..96448ae 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 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