Skip to content

Commit

Permalink
refactor map pattern
Browse files Browse the repository at this point in the history
  • Loading branch information
@swannodette
swannodette committed May 9, 2013
1 parent fe24a88 commit b5689f7
Showing 1 changed file with 86 additions and 60 deletions.
146 changes: 86 additions & 60 deletions src/main/clojure/clojure/core/match.clj
View file
Expand Up @@ -1043,7 +1043,65 @@


(declare map-pattern? guard-pattern) (declare map-pattern? guard-pattern)


(defn row-keys [row env]
(let [p (first row)
only (-> p meta :only)]
(when (and (not @(:only? env))
(seq only))
(reset! (:only? env) true))
[(set (keys (:m p)))
(set only)]))

(defn get-all-keys [rows env]
(->> rows
(remove (comp wildcard-pattern? first))
(map #(row-keys % env))
(reduce concat)
(reduce set/union #{})))

(defn get-ocr-map [p env]
(if (map-pattern? p)
(let [m (:m p)
wcs (repeatedly wildcard-pattern)
[not-found-map wc-map]
(if-let [only (:only env)]
[(zipmap (:all-keys env)
(repeat (literal-pattern ::not-found)))
(zipmap only wcs)]
[{} (:wc-map env)])]
(merge not-found-map (:wc-map env) m))
(:wc-map env)))

(defn specialize-map-pattern-row [row env]
(let [p (first row)
only (seq (-> p meta :only))
ocr-map (get-ocr-map p (assoc env :only only))
ps (doall (map ocr-map (:all-keys env)))
ps (if @(:only? env)
(if only
(let [a (with-meta (gensym) {:tag 'java.util.Map})]
(cons
(guard-pattern (wildcard-pattern)
(set [(if *clojurescript*
`(fn [~a] (= (set (keys ~a)) #{~@only}))
`(fn [~a] (= (.keySet ~a) #{~@only})))]))
ps))
(cons (wildcard-pattern) ps))
ps)]
(reduce prepend (drop-nth-bind row 0 (:focr env))
(reverse ps))))

(defn specialize-map-pattern-matrix [rows env]
(vec (map #(specialize-map-pattern-row % env) rows)))

(deftype MapPattern [m _meta] (deftype MapPattern [m _meta]
clojure.lang.ILookup
(valAt [this k]
(.valAt this k nil))
(valAt [this k not-found]
(case k
:m m
not-found))
clojure.lang.IObj clojure.lang.IObj
(meta [_] _meta) (meta [_] _meta)
(withMeta [_ new-meta] (withMeta [_ new-meta]
Expand All @@ -1058,75 +1116,43 @@
(str m " :only " (or (:only _meta) []))) (str m " :only " (or (:only _meta) [])))
ISpecializeMatrix ISpecializeMatrix
(specialize-matrix [this rows ocrs] (specialize-matrix [this rows ocrs]
(let [focr (first ocrs) (let [focr (first ocrs)
only? (atom false) only? (atom false)
all-keys (->> rows env {:focr focr
(remove (comp wildcard-pattern? first)) :only? only?}
(map (fn [row] all-keys (get-all-keys rows env)
(let [^MapPattern p (first row) wc-map (zipmap all-keys (repeatedly wildcard-pattern))
only (-> p meta :only)] nrows (specialize-map-pattern-matrix rows
(when (and (not @only?) (seq only)) (assoc env
(reset! only? true)) :all-keys all-keys
[(set (keys (.m p))) :wc-map wc-map))
(set only)]))) nocrs (let [map-ocr focr
(reduce concat) ocr-sym
(reduce set/union #{})) (fn ocr-sym [k]
wcs (repeatedly wildcard-pattern) (let [ocr (gensym (str (name map-ocr) "_" (name k) "__"))]
wc-map (zipmap all-keys wcs) (with-meta ocr
nrows (->> rows {:occurrence-type :map
(map (fn [row] :key k
(let [p (first row) :map-sym map-ocr
only (seq (-> p meta :only)) :bind-expr (val-at-expr map-ocr k ::not-found)})))
ocr-map (if (map-pattern? p) mocrs (map ocr-sym all-keys)
(let [^MapPattern p p mocrs (if @only?
m (.m p) (cons map-ocr mocrs)
[not-found-map wc-map] (if only mocrs)]
[(zipmap all-keys (into (into [] mocrs)
(repeat (literal-pattern ::not-found))) (drop-nth ocrs 0)))
(zipmap only wcs)] _ (trace-dag "MapPattern specialization")]
[{} wc-map])]
(merge not-found-map wc-map m))
wc-map)
ps (map ocr-map all-keys)
ps (if @only?
(if only
(let [a (with-meta (gensym) {:tag 'java.util.Map})]
(cons (guard-pattern (wildcard-pattern)
(set [(if *clojurescript*
`(fn [~a] (= (set (keys ~a)) #{~@only}))
`(fn [~a] (= (.keySet ~a) #{~@only})))]))
ps))
(cons (wildcard-pattern) ps))
ps)]
(reduce prepend (drop-nth-bind row 0 focr)
(reverse ps)))))
vec)
nocrs (let [map-ocr focr
ocr-sym (fn ocr-sym [k]
(let [ocr (gensym (str (name map-ocr) "_" (name k) "__"))]
(with-meta ocr
{:occurrence-type :map
:key k
:map-sym map-ocr
:bind-expr (val-at-expr map-ocr k ::not-found)})))
mocrs (map ocr-sym all-keys)
mocrs (if @only?
(cons map-ocr mocrs)
mocrs)]
(into (into [] mocrs)
(drop-nth ocrs 0)))
_ (trace-dag "MapPattern specialization")]
(pattern-matrix nrows nocrs)))) (pattern-matrix nrows nocrs))))


(defn ^MapPattern map-pattern (defn map-pattern
([] (MapPattern. {} nil)) ([] (MapPattern. {} nil))
([m] {:pre [(map? m)]} ([m] {:pre [(map? m)]}
(MapPattern. m nil))) (MapPattern. m nil)))


(defn map-pattern? [x] (defn map-pattern? [x]
(instance? MapPattern x)) (instance? MapPattern x))


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


;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
Expand Down

0 comments on commit b5689f7

Please sign in to comment.