Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
MATCH-56: exception when matching empty vector
added new multimethod `test-with-min-size-inline` to handle rest
vector pattern case.

Removed "touched" logic - premature optimization.
  • Loading branch information
swannodette committed Jun 17, 2013
1 parent d09ef3b commit 59df5b3
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 30 deletions.
51 changes: 21 additions & 30 deletions src/main/clojure/clojure/core/match.clj
Expand Up @@ -131,6 +131,7 @@
(defmulti tag (fn [t] t))
(defmulti test-inline vector-type)
(defmulti test-with-size-inline vector-type)
(defmulti test-with-min-size-inline vector-type)
(defmulti count-inline vector-type)
(defmulti nth-inline vector-type)
(defmulti nth-offset-inline vector-type)
Expand Down Expand Up @@ -171,6 +172,11 @@
`(and ~(test-inline t ocr)
(== ~(count-inline t (with-tag t ocr)) ~size)))

(defmethod test-with-min-size-inline ::vector
[t ocr size]
`(and ~(test-inline t ocr)
(>= ~(count-inline t (with-tag t ocr)) ~size)))

(defmethod count-inline ::vector
[_ ocr] `(count ~ocr))

Expand Down Expand Up @@ -1139,20 +1145,6 @@
;; Vector patterns match any Sequential data structure. Note this means that
;; the lazy semantics may mean poorer performance for sequences.

(defn touched? [vp]
(-> vp meta :touched))

(defn touch [vp]
(let [meta (meta vp)]
(with-meta vp (assoc meta :touched true))))

(defn touch-all-first [rows]
(->> rows
(map (fn [[p & ps :as row]]
(if (not (touched? p))
(assoc row 0 (touch p))
row)))))

(declare vector-pattern?)

(defn calc-rest?-and-min-size [rows env]
Expand Down Expand Up @@ -1248,8 +1240,10 @@

IPatternCompile
(to-source* [this ocr]
(if (and (touched? this) (not rest?) size (check-size? t))
(test-with-size-inline t ocr size)
(if (check-size? t)
(if rest?
(test-with-min-size-inline t ocr size)
(test-with-size-inline t ocr size))
(test-inline t ocr)))

IContainsRestPattern
Expand All @@ -1271,19 +1265,17 @@
ISpecializeMatrix
(specialize-matrix [this matrix]
(let [rows (rows matrix)
ocrs (occurrences matrix)]
(if (not (touched? (ffirst rows)))
(pattern-matrix (touch-all-first rows) ocrs)
(let [focr (first ocrs)
env {:focr focr
:fp (ffirst rows)
:pat this}
[rest? min-size] (calc-rest?-and-min-size rows env)
env' (assoc env
:rest? rest? :min-size min-size :tag (:t this))
nrows (specialize-vector-pattern-matrix rows env')
nocrs (vector-pattern-matrix-ocrs ocrs env')]
(pattern-matrix nrows nocrs))))))
ocrs (occurrences matrix)
focr (first ocrs)
env {:focr focr
:fp (ffirst rows)
:pat this}
[rest? min-size] (calc-rest?-and-min-size rows env)
env' (assoc env
:rest? rest? :min-size min-size :tag (:t this))
nrows (specialize-vector-pattern-matrix rows env')
nocrs (vector-pattern-matrix-ocrs ocrs env')]
(pattern-matrix nrows nocrs))))

(defn vector-pattern
([] (vector-pattern [] ::vector nil nil))
Expand Down Expand Up @@ -1533,7 +1525,6 @@
(defmethod groupable? [VectorPattern VectorPattern]
[a b]
(cond
(not (touched? b)) true
(= (:size a) (:size b)) true
(and (:rest? a) (<= (:size a) (:size b))) true
(and (:rest? b) (<= (:size b) (:size a))) true
Expand Down
12 changes: 12 additions & 0 deletions src/test/clojure/clojure/core/match/test/core.clj
Expand Up @@ -789,3 +789,15 @@
(deftest match-55
(is (= (match [ [1 2] ] [([& _] :seq)] true)
true)))

(deftest match-56
(is (= (let [x []]
(match [x]
[[h & t]] [h t]
:else :nomatch))
:nomatch))
(is (= (let [x [1]]
(match [x]
[[h & t]] [h t]
:else :nomatch))
[1 []])))

0 comments on commit 59df5b3

Please sign in to comment.