Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
MATCH-70: incorrect map pattern matching behavior
  • Loading branch information
swannodette committed Jun 2, 2013
1 parent e1756f9 commit a07c2e9
Show file tree
Hide file tree
Showing 3 changed files with 76 additions and 7 deletions.
55 changes: 50 additions & 5 deletions src/main/clojure/clojure/core/match.clj
Expand Up @@ -547,13 +547,23 @@
(map leaf-bind-expr ocrs))]
(concat (:bindings f) wc-bindings)))

(defn existential-pattern? [x]
(instance? clojure.core.match.protocols.IExistentialPattern x))

(defn wildcard-or-existential? [x]
(or (wildcard-pattern? x)
(existential-pattern? x)))

(defn pattern-score [pm i j]
(let [p (pattern-at pm i j)]
(cond
;; we have constructor with no wildcards above it
(and (constructor? p)
(every? #(not (wildcard-pattern? %))
(take j (column pm i)))) 2
(constructor? p)
(let [cs (take j (column pm i))]
(if (every? (comp not wildcard-or-existential?) cs)
(if-not (existential-pattern? p)
2
1)
0))
;;(wildcard-pattern? p) (not (useful? (drop-nth pm i) j))
;;IMPORTANT NOTE: this calculation is very very slow,
;;we should look at this more closely - David
Expand Down Expand Up @@ -1014,6 +1024,34 @@
;; Map patterns match maps, or any object that satisfies IMatchLookup.
;;

(defn specialize-map-key-pattern-matrix [rows]
(let [p (:p (ffirst rows))]
(->> rows
(map #(drop-nth % 0))
(map #(prepend % p))
vec)))

(defrecord MapKeyPattern [p]
IExistentialPattern

IPatternCompile
(to-source* [this ocr]
`(not= ~ocr ::not-found))

ISpecializeMatrix
(specialize-matrix [this rows ocrs]
(let [nrows (specialize-map-key-pattern-matrix rows)]
(pattern-matrix nrows ocrs))))

(defn map-key-pattern [p]
(MapKeyPattern. p))

(defn map-key-pattern? [x]
(instance? MapKeyPattern x))

(defmethod print-method MapKeyPattern [p ^Writer writer]
(.write writer (str "<MapKeyPattern: " (:p p) ">")))

(declare map-pattern? guard-pattern)

(defn row-keys [row env]
Expand All @@ -1032,14 +1070,21 @@
(reduce concat)
(reduce set/union #{})))

(defn wrap-values [m]
(->> m
(map (fn [[k v]]
[k (if (wildcard-pattern? v)
(map-key-pattern v) v)]))
(into {})))

(defn get-ocr-map
[p {:keys [only all-keys wc-map]}]
(if (map-pattern? p)
(merge
(when only
(zipmap all-keys
(repeat (literal-pattern ::not-found))))
wc-map (:m p))
wc-map (wrap-values (:m p)))
wc-map))

(defn specialize-map-pattern-row
Expand Down
3 changes: 3 additions & 0 deletions src/main/clojure/clojure/core/match/protocols.clj
Expand Up @@ -30,3 +30,6 @@

(defprotocol IVectorPattern
(split [this n]))

;; marker
(defprotocol IExistentialPattern)
25 changes: 23 additions & 2 deletions src/test/clojure/clojure/core/match/test/core.clj
Expand Up @@ -79,8 +79,29 @@
[{:a _ :b 2}] :a0
[{:a 1 :b 1}] :a1
[{:c 3 :d _ :e 4}] :a2
:else []))
:a1)))
:else nil))
:a1))
(is (= (let [x {:a 1 :b 2}]
(match [x]
[{:a _ :b 2}] :a0
[{:a 1 :b 1}] :a1
[{:c 3 :d _ :e 4}] :a2
:else nil))
:a0))
(is (= (let [x {:c 3 :d 9 :e 4}]
(match [x]
[{:a _ :b 2}] :a0
[{:a 1 :b 1}] :a1
[{:c 3 :d _ :e 4}] :a2
:else nil))
:a2))
(is (= (let [x {:c 3 :e 4}]
(match [x]
[{:a _ :b 2}] :a0
[{:a 1 :b 1}] :a1
[{:c 3 :d _ :e 4}] :a2
:else nil))
nil)))

(deftest map-pattern-match-2
(is (= (let [x {:a 1 :b 1}]
Expand Down

1 comment on commit a07c2e9

@dpp
Copy link

@dpp dpp commented on a07c2e9 Jun 2, 2013

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Awesome!

Please sign in to comment.