Permalink
Browse files

* src/match/core.clj: locals matching

  • Loading branch information...
1 parent f2fd461 commit 10b735782b65c7be392a1387253d86c4758a342e @swannodette swannodette committed Aug 22, 2011
Showing with 27 additions and 6 deletions.
  1. +17 −6 src/match/core.clj
  2. +10 −0 test/match/test/core.clj
View
@@ -3,9 +3,10 @@
(:require [clojure.set :as set])
(:import [java.io Writer]))
-(def ^:dynamic *syntax-check* true)
-(def ^:dynamic *line*)
-(def ^:dynamic *warned* (atom false))
+(def ^{:dynamic true} *syntax-check* true)
+(def ^{:dynamic true} *line*)
+(def ^{:dynamic true} *locals*)
+(def ^{:dynamic true} *warned* (atom false))
(defn warn [msg]
(if (not @*warned*)
@@ -97,7 +98,7 @@
(p-to-clj [this ocr]
(cond
(= l ()) `(empty? ~ocr)
- (symbol? l) `(= ~ocr '~l)
+ (and (symbol? l) (not (-> l meta :local))) `(= ~ocr '~l)
:else `(= ~ocr ~l)))
Object
(toString [_]
@@ -287,7 +288,13 @@
;; Pattern Comparison
(defmethod pattern-compare [LiteralPattern LiteralPattern]
- [^LiteralPattern a ^LiteralPattern b] (compare (.l a) (.l b)))
+ [^LiteralPattern a ^LiteralPattern b]
+ (let [la (.l a)
+ lb (.l b)]
+ (cond
+ (symbol? la) 1
+ (symbol? lb) -1
+ :else (compare (.l a) (.l b)))))
(defmethod pattern-compare [LiteralPattern Object]
[a b] -1)
@@ -846,7 +853,9 @@
(defmethod emit-pattern clojure.lang.Symbol
[pat]
- (wildcard-pattern pat))
+ (if (get *locals* pat)
+ (literal-pattern (with-meta pat (assoc (meta pat) :local true)))
+ (wildcard-pattern pat)))
(defmethod emit-pattern :default
[pat]
@@ -969,6 +978,7 @@
(defmacro match-1 [vars & clauses]
"Pattern match a single value."
(binding [*line* (-> &form meta :line)
+ *locals* &env
*warned* (atom false)]
(let [[vars clauses] [[vars] (mapcat (fn [[row action]]
(if (not= row :else)
@@ -982,6 +992,7 @@
(defmacro match [vars & clauses]
"Pattern match multiple values."
(binding [*line* (-> &form meta :line)
+ *locals* &env
*warned* (atom false)]
`~(-> (emit-matrix vars clauses)
compile
@@ -257,3 +257,13 @@
(_ :when #(= (count %) 2)) :a1
:else :a2))
:a1)))
+
+(deftest match-local-1
+ (is (= (let [x 2
+ y 2]
+ (match [x]
+ [0] :a0
+ [1] :a1
+ [y] :a2
+ :else :a3))
+ :a2)))

0 comments on commit 10b7357

Please sign in to comment.