Permalink
Browse files

* src/main/clojure/clojure/core/match/core.clj: MATCH-19: Don't use b…

…acktracking in the presence of recur
  • Loading branch information...
1 parent 6265d45 commit af4ca0425daee7dd7421716f6a151d2dda988a9a @swannodette swannodette committed Oct 2, 2011
Showing with 42 additions and 13 deletions.
  1. +30 −13 src/main/clojure/clojure/core/match/core.clj
  2. +12 −0 src/test/clojure/clojure/core/match/test/core.clj
@@ -335,7 +335,13 @@
(defrecord FailNode []
INodeCompile
(n-to-clj [this]
- `(throw clojure.core.match.core/backtrack)))
+ (if *recur-present*
+ (if @*breadcrumbs*
+ `(throw (Exception. (str "No match found. "
+ "Followed " ~(count *match-breadcrumbs*) " branches."
+ " Breadcrumbs: " '~*match-breadcrumbs*)))
+ `(throw (Exception. (str "No match found."))))
+ `(throw clojure.core.match.core/backtrack))))
(defn ^FailNode fail-node []
(FailNode.))
@@ -371,18 +377,24 @@
(n-to-clj [this]
(let [clauses (doall (mapcat (partial apply dag-clause-to-clj occurrence) cases))
bind-expr (-> occurrence meta :bind-expr)
- backtrack-expr (if @*backtrack-with-errors*
- `(throw (Exception. (str "Could not match" ~occurrence)))
- `(throw clojure.core.match.core/backtrack))
- cond-expr (doall (concat `(cond ~@clauses)
- `(:else ~backtrack-expr)))]
- (if bind-expr
- `(try ~(doall (concat `(let [~occurrence ~bind-expr]) (list cond-expr)))
- (catch Exception e#
- ~(n-to-clj default)))
- `(try ~cond-expr
- (catch Exception e#
- ~(n-to-clj default)))))))
+ cond-expr (if *recur-present*
+ (doall (concat `(cond ~@clauses)
+ `(:else ~(n-to-clj default))))
+ (doall (concat `(cond ~@clauses)
+ `(:else ~(if @*backtrack-with-errors*
+ `(throw (Exception. (str "Could not match" ~occurrence)))
+ `(throw clojure.core.match.core/backtrack))))))]
+ (if *recur-present*
+ (if bind-expr
+ `~(doall (concat `(let [~occurrence ~bind-expr]) (list cond-expr)))
+ `~cond-expr)
+ (if bind-expr
+ `(try ~(doall (concat `(let [~occurrence ~bind-expr]) (list cond-expr)))
+ (catch Exception e#
+ ~(n-to-clj default)))
+ `(try ~cond-expr
+ (catch Exception e#
+ ~(n-to-clj default))))))))
(defn ^SwitchNode switch-node
([occurrence cases default]
@@ -1226,6 +1238,11 @@
(defmethod pattern-compare [WildcardPattern WildcardPattern]
[a b] 0)
+(defmethod pattern-compare [Object WildcardPattern]
+ [a b] (if *recur-present* 0 1))
+
+(prefer-method pattern-compare [Object WildcardPattern] [LiteralPattern Object])
+
(defmethod pattern-compare [LiteralPattern Object]
[a b] 1)
@@ -17,6 +17,18 @@
:else 5))
4)))
+(deftest pattern-match-recur-1
+ (is (= ((fn [x y z done]
+ (if (not done)
+ (match [x y z]
+ [_ false true] (recur x y z 1)
+ [false true _ ] (recur x y z 2)
+ [_ _ false] (recur x y z 3)
+ [_ _ true] (recur x y z 4)
+ :else 5)
+ done)) true true true false)
+ 4)))
+
(deftest pattern-match-bind-1
(is (= (let [x 1 y 2 z 4]
(match [x y z]

0 comments on commit af4ca04

Please sign in to comment.