Permalink
Browse files

Added new multimethod mutually-exclusive-inequality?

Allows those types that have the ability to check at compile time
whether or not they are always different no matter what they are
matching to brag about it.
  • Loading branch information...
chrismgray authored and swannodette committed Jan 13, 2012
1 parent 6a3213f commit ac92c6df3f70f56fbe12f9d3f46585e66102c50b
Showing with 34 additions and 2 deletions.
  1. +34 −2 src/main/clojure/clojure/core/match.clj
@@ -253,6 +253,16 @@
(defmethod safe-pattern-compare :default
[a b] (pattern-compare a b))
+(defmulti mutually-exclusive-inequality?
+ "Returns true if it is possible to tell at compile time whether two
+ different versions of the same object can never match the same
+ object."
+ type)
+
+(defmethod mutually-exclusive-inequality? :default
+ [x]
+ false)
+
;; =============================================================================
;; # Pattern Rows
@@ -873,7 +883,7 @@
(pr-str l))))
(defn ^LiteralPattern literal-pattern [l]
- (LiteralPattern. l nil))
+ (LiteralPattern. l (meta l)))
(defn literal-pattern? [x]
(instance? LiteralPattern x))
@@ -1291,7 +1301,12 @@
;; Pattern Comparisons
(defmethod pattern-compare [WildcardPattern WildcardPattern]
- [a b] 0)
+ [a b]
+ 1)
+
+(defmethod mutually-exclusive-inequality? WildcardPattern
+ [x]
+ false)
;; NOTE: if recur is present we want all objects to equal wildcards, this is
;; because we push the wildcard matches along as well in the matrix specialization
@@ -1319,9 +1334,17 @@
(= la lb) 0
:else 1)))
+(defmethod mutually-exclusive-inequality? LiteralPattern
+ [x]
+ (not (-> x meta :local)))
+
(defmethod pattern-compare [GuardPattern GuardPattern]
[^GuardPattern a ^GuardPattern b] (if (= (.gs a) (.gs b)) 0 1))
+(defmethod mutually-exclusive-inequality? GuardPattern
+ [x]
+ false)
+
(defmethod pattern-compare [GuardPattern WildcardPattern]
[^GuardPattern a ^WildcardPattern b]
(let [p (.p a)]
@@ -1336,6 +1359,11 @@
(every? identity (map pattern-equals as bs)))
0 1)))
+(defmethod mutually-exclusive-inequality? OrPattern
+ [x]
+ (let [xs (.ps x)]
+ (every? mutually-exclusive-inequality? xs)))
+
(defmethod pattern-compare [VectorPattern VectorPattern]
[^VectorPattern a ^VectorPattern b]
(cond
@@ -1345,6 +1373,10 @@
(and (.rest? b) (<= (.size b) (.size a))) 0
:else 1))
+(defmethod mutually-exclusive-inequality? VectorPattern
+ [x]
+ (every? mutually-exclusive-inequality? (.v x)))
+
;; =============================================================================
;; # Interface

0 comments on commit ac92c6d

Please sign in to comment.