From faf321779af962a1ff8c2e29b308d7cd64d4a440 Mon Sep 17 00:00:00 2001
From: David Nolen <david.nolen@gmail.com>
Date: Sat, 15 Oct 2011 11:48:40 -0400
Subject: [PATCH] * src/main/clojure/clojure/core/match.clj: Add Stephen Miner's match-let

---
 src/main/clojure/clojure/core/match.clj            |   41 +++++++++++++++++++-
 .../clojure/core/match/test/core/error_msg.clj     |   20 ++++++++--
 2 files changed, 55 insertions(+), 6 deletions(-)

diff --git a/src/main/clojure/clojure/core/match.clj b/src/main/clojure/clojure/core/match.clj
index 910d9d1..6c25e16 100644
--- a/src/main/clojure/clojure/core/match.clj
+++ b/src/main/clojure/clojure/core/match.clj
@@ -1402,6 +1402,31 @@
   (let [p (into [] (map emit-pattern pat))]
     (pattern-row p action)))
 
+(defn- wildcards-and-duplicates
+  "Returns a vector of two elements: the set of all wildcards and the set of duplicate wildcards.  The underbar _ is excluded from both."
+  [patterns]
+  (loop [remaining patterns seen #{} dups #{}]
+    (if-let [patterns (seq remaining)]
+      (let [pat (first patterns)
+            pats (rest patterns)]
+        (cond (or (= pat '_) (= pat '&)) (recur pats seen dups)
+              (symbol? pat) (if (contains? seen pat)
+                              (recur pats seen (conj dups pat))
+                              (recur pats (conj seen pat) dups))
+              (vector? pat) (recur (concat pats pat) seen dups)
+              (map? pat) (recur (concat pats (vals pat)) seen dups)
+              (seq? pat) (case (second pat)
+                           :as (recur (concat pats (take-nth 2 pat)) seen dups)
+                           | (let [wds (map wildcards-and-duplicates (map list (take-nth 2 pat)))
+                                   mseen (apply set/union (map first wds))]
+                               (recur pats (set/union seen mseen) (apply set/union dups (set/intersection seen mseen) (map second wds))))
+                           (recur (conj pats (first pat)) seen dups))
+              :else (recur pats seen dups)))
+      [seen dups])))
+
+(defn- find-duplicate-wildcards [pattern]
+  (second (wildcards-and-duplicates pattern)))
+
 ;; This could be scattered around in other functions to be more efficient
 ;; Turn off *syntax-check* to disable
 (defn- check-matrix-args [vars clauses]
@@ -1427,7 +1452,13 @@
                      (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))))
+            (when-let [duplicates (seq (find-duplicate-wildcards pat))]
+              (throw (AssertionError.
+                     (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.")))))]
 
     (let [nvars (count vars)
           cls (partition 2 clauses)]
@@ -1532,4 +1563,10 @@
             *line* (-> &form meta :line)
             *locals* (dissoc &env '_)
             *warned* (atom false)]
-    `~(clj-form vars clauses)))
\ No newline at end of file
+    `~(clj-form vars clauses)))
+
+(defmacro match-let [bindings & body]
+  (let [bindvars# (take-nth 2 bindings)]
+    `(let ~bindings
+       (match [~@bindvars#]
+         ~@body))))
diff --git a/src/test/clojure/clojure/core/match/test/core/error_msg.clj b/src/test/clojure/clojure/core/match/test/core/error_msg.clj
index 466c457..f0ab113 100644
--- a/src/test/clojure/clojure/core/match/test/core/error_msg.clj
+++ b/src/test/clojure/clojure/core/match/test/core/error_msg.clj
@@ -79,10 +79,22 @@
                   [1 2] 1
                   :else 1))))
 
-(deftest match-differing-patterns
+(deftest match-duplicate-wildcards
   (is (thrown-with-msg?
         AssertionError
-        #"Pattern row 1: Pattern row has differing number of patterns. \[1 2\] has 2 pattern/s, expecting 1 for occurrences \[x\]"
-        (m-to-clj [x]
-                  [1 2] 1
+        #"Pattern row 1: Pattern row reuses wildcards in \[a a\].  The following wildcards are ambiguous: a.  There's no guarantee that the matched values will be same.  Rename the occurrences uniquely."
+        (m-to-clj [x y]
+                  [a a] a
+                  :else 1))))
+
+(deftest match-duplicate-wildcards2
+  (is (thrown-with-msg?
+        AssertionError
+        #"Pattern row 1: Pattern row reuses wildcards in \[.*\].  The following wildcards are ambiguous: aa, x.  There's no guarantee that the matched values will be same.  Rename the occurrences uniquely."
+        (m-to-clj [xx yy]
+                  [x ([:black [:red [:red a x b] y c] z d] |
+                      [:black [:red a x [:red b y c]] z d] |
+                      [:black a x [:red [:red b y c] z d]] |
+                      [:black aa x [:red [:black aa y c] z d]] |
+                      [:black a x [:red b y [:red c z d]]]) ]     a
                   :else 1))))
-- 
1.7.4.1