Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

MATCH-61: only emit init expressions *once*

Add a new dynamic var `*root*` which is set to true. When compiling we
now emit via `root-bind-node` the initial bindings for the match
expression only *once*. Remove binding hack from
`first-row-wildcards-case`.
  • Loading branch information...
commit 7b02b83478862a8fcaa3367871d043d4a40d9413 1 parent f96177e
@swannodette swannodette authored
View
30 src/main/clojure/clojure/core/match.clj
@@ -70,6 +70,7 @@
`(throw clojure.core.match/backtrack))
(def ^{:dynamic true} *recur-backtrack* nil)
+(def ^{:dynamic true} *root* true)
(defn warn [msg]
(if (not @*warned*)
@@ -651,14 +652,12 @@
[ocr ocr])))
ocrs))
-(defn switch-or-bind-node [col ocrs clauses default]
- (if (some expression? ocrs)
- (let [bs (bind-variables ocrs)
- ocr (ocrs col)
- node (switch-node ocr clauses default)]
- (bind-node bs node))
- (let [ocr (ocrs col)]
- (switch-node ocr clauses default))))
+(defn root-bind-node [matrix]
+ (let [ocrs (occurrences matrix)
+ node (compile matrix)]
+ (if (some expression? ocrs)
+ (bind-node (bind-variables ocrs) node)
+ node)))
;; -----------------------------------------------------------------------------
;; # Compilation Cases
@@ -688,11 +687,8 @@
[rows ocrs]
(let [f (first rows)
a (:action f)
- bs (row-bindings f ocrs)
- node (leaf-node a bs)]
- (if (some expression? ocrs)
- (bind-node (bind-variables ocrs) node)
- node)))
+ bs (row-bindings f ocrs)]
+ (leaf-node a bs)))
(defn expand-matrix [matrix col]
(reduce
@@ -714,10 +710,10 @@
(let [expanded (expand-matrix matrix col)
[S D B] (split-matrix expanded)]
(if-not *recur-present*
- (switch-or-bind-node col ocrs
+ (switch-node (ocrs col)
(cases S)
(default-case D))
- (switch-or-bind-node col ocrs
+ (switch-node (ocrs col)
(binding [*recur-backtrack* B]
(cases S))
(binding [*recur-backtrack* nil]
@@ -736,6 +732,10 @@ col with the first column and compile the result"
(defn compile [{:keys [rows ocrs] :as pm}]
(cond
+ *root*
+ (binding [*root* false]
+ (root-bind-node pm))
+
(empty? rows)
(empty-rows-case)
View
8 src/test/clojure/clojure/core/match/test/core.clj
@@ -827,3 +827,11 @@
[([h & t] :seq)] [h t]
[_] :a1))
:a1)))
+
+(deftest match-61
+ (is (= (let [q '(a) y '(b) z '(c)]
+ (match [q (seq y) z]
+ [([_] :seq) _ _] 'a
+ [_ _ _] 'b))
+ 'a)))
+
Please sign in to comment.
Something went wrong with that request. Please try again.