Permalink
Browse files

MATCH-70: incorrect map pattern matching behavior

  • Loading branch information...
1 parent e1756f9 commit a07c2e9620df5b9d331bd6c380d47c15bf7cd60d @swannodette swannodette committed Jun 2, 2013
@@ -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
@@ -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]
@@ -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
@@ -30,3 +30,6 @@
(defprotocol IVectorPattern
(split [this n]))
+
+;; marker
+(defprotocol IExistentialPattern)
@@ -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}]

1 comment on commit a07c2e9

dpp commented on a07c2e9 Jun 2, 2013

Awesome!

Please sign in to comment.