Permalink
Browse files

* src/main/clojure/clojure/core/match/core.clj: Fixes MATCH-5: rest p…

…atterns in seq patterns infer their type
  • Loading branch information...
1 parent 2f5d82b commit d8e767948977837bfb138b9383d6f7c2d175c09e @swannodette swannodette committed Sep 26, 2011
Showing with 27 additions and 9 deletions.
  1. +11 −8 src/main/clojure/clojure/core/match/core.clj
  2. +16 −1 src/test/clojure/clojure/core/match/test/core.clj
View
19 src/main/clojure/clojure/core/match/core.clj
@@ -1263,19 +1263,22 @@
;; # emit-pattern Methods
(defn emit-patterns
- ([ps] (emit-patterns ps []))
- ([ps v]
+ ([ps t] (emit-patterns ps t []))
+ ([ps t v]
(if (empty? ps)
v
(let [p (first ps)]
(cond
- (= p '&) (let [p (second ps)]
- (recur (nnext ps) (conj v (rest-pattern (emit-pattern p)))))
- :else (recur (next ps) (conj v (emit-pattern (first ps)))))))))
+ (= p '&) (let [p (second ps)
+ rp (if (and (vector? p) (= t :seq))
+ (seq-pattern (emit-patterns p t))
+ (emit-pattern p))]
+ (recur (nnext ps) t (conj v (rest-pattern rp))))
+ :else (recur (next ps) t (conj v (emit-pattern (first ps)))))))))
(defmethod emit-pattern clojure.lang.IPersistentVector
[pat]
- (let [ps (emit-patterns pat)]
+ (let [ps (emit-patterns pat :vector)]
(vector-pattern ps *vector-type* 0 (some rest-pattern? ps))))
(defmethod emit-pattern clojure.lang.IPersistentMap
@@ -1335,10 +1338,10 @@
(let [p (first pat)]
(if (empty? p)
(literal-pattern ())
- (seq-pattern (emit-patterns p)))))
+ (seq-pattern (emit-patterns p :seq)))))
(defmethod emit-pattern-for-syntax ::vector
- [[p t offset-key offset]] (let [ps (emit-patterns p)]
+ [[p t offset-key offset]] (let [ps (emit-patterns p :vector)]
(vector-pattern ps t offset (some rest-pattern? ps))))
(defmethod emit-pattern-for-syntax :only
View
17 src/test/clojure/clojure/core/match/test/core.clj
@@ -379,4 +379,19 @@
[[3 1]] :a0
[[([1 a] :as b)]] [:a1 a b]
:else :a2))
- [:a1 2 [1 2]])))
+ [:a1 2 [1 2]])))
+
+(deftest seq-infer-rest-1
+ (is (= (let [l '(1 2 3)]
+ (match [l]
+ [([a & [b & [c]]] :seq)] :a0
+ :else :a1))
+ :a0)))
+
+(comment
+ ;; TODO: should not match - David
+ (let [l '(1 2 3)]
+ (match [l]
+ [([a & [b & [c d]]] :seq)] :a0
+ :else :a1))
+ )

0 comments on commit d8e7679

Please sign in to comment.