Skip to content
Browse files

refactor map pattern occurences code

  • Loading branch information...
1 parent b5689f7 commit 2ad670635d89c1086378f9e9339c43c3ed9ac27e @swannodette swannodette committed
Showing with 25 additions and 22 deletions.
  1. +25 −22 src/main/clojure/clojure/core/match.clj
View
47 src/main/clojure/clojure/core/match.clj
@@ -1094,6 +1094,25 @@
(defn specialize-map-pattern-matrix [rows env]
(vec (map #(specialize-map-pattern-row % env) rows)))
+(defn map-pattern-matrix-ocr-sym [k env]
+ (let [focr (:focr env)
+ ocr (gensym (str (name focr) "_" (name k) "__"))]
+ (with-meta ocr
+ {:occurrence-type :map
+ :key k
+ :map-sym focr
+ :bind-expr (val-at-expr focr k ::not-found)})))
+
+(defn map-pattern-matrix-ocrs [ocrs env]
+ (let [focr (:focr env)
+ mocrs (map #(map-pattern-matrix-ocr-sym % env)
+ (:all-keys env))
+ mocrs (vec
+ (if @(:only? env)
+ (cons focr mocrs)
+ mocrs))]
+ (into mocrs (drop-nth ocrs 0))))
+
(deftype MapPattern [m _meta]
clojure.lang.ILookup
(valAt [this k]
@@ -1117,30 +1136,14 @@
ISpecializeMatrix
(specialize-matrix [this rows ocrs]
(let [focr (first ocrs)
- only? (atom false)
env {:focr focr
- :only? only?}
+ :only? (atom false)}
all-keys (get-all-keys rows env)
- wc-map (zipmap all-keys (repeatedly wildcard-pattern))
- nrows (specialize-map-pattern-matrix rows
- (assoc env
- :all-keys all-keys
- :wc-map wc-map))
- 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)))
+ env' (assoc env
+ :all-keys all-keys
+ :wc-map (zipmap all-keys (repeatedly wildcard-pattern)))
+ nrows (specialize-map-pattern-matrix rows env')
+ nocrs (map-pattern-matrix-ocrs ocrs env')
_ (trace-dag "MapPattern specialization")]
(pattern-matrix nrows nocrs))))

0 comments on commit 2ad6706

Please sign in to comment.
Something went wrong with that request. Please try again.