added per-defmulti hierarchies, patch from mb

2 files changed, 14 insertions, 8 deletions

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index b5592c54..a56a503e 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -1011,12 +1011,16 @@
   ([x form & more] `(-> (-> ~x ~form) ~@more)))
 
 ;;multimethods
+(def global-hierarchy)
+
 (defmacro defmulti
   "Creates a new multimethod with the associated dispatch function.
   The docstring and attribute-map are optional.
 
   Options are key-value pairs and may be one of:
-    :default    the default dispatch value, defaults to :default"
+    :default    the default dispatch value, defaults to :default
+    :hierarchy  the isa? hierarchy to use for dispatching
+                defaults to the global hierarchy"
   {:arglists '([name docstring? attr-map? dispatch-fn & options])}
   [mm-name & options]
   (let [docstring   (if (string? (first options))
@@ -1042,10 +1046,11 @@
                       m)]
     (when (= (count options) 1)
       (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))
-    (let [options (apply hash-map options)
-          default (get options :default :default)]
+    (let [options   (apply hash-map options)
+          default   (get options :default :default)
+          hierarchy (get options :hierarchy #'global-hierarchy)]
       `(def ~(with-meta mm-name m)
-         (new clojure.lang.MultiFn ~dispatch-fn ~default)))))
+         (new clojure.lang.MultiFn ~dispatch-fn ~default ~hierarchy)))))
 
 (defmacro defmethod
   "Creates and installs a new method of multimethod associated with dispatch-value. "
diff --git a/src/jvm/clojure/lang/MultiFn.java b/src/jvm/clojure/lang/MultiFn.java
index 7fd1ec1f..48ad0554 100644
--- a/src/jvm/clojure/lang/MultiFn.java
+++ b/src/jvm/clojure/lang/MultiFn.java
@@ -17,6 +17,7 @@ import java.util.Map;
 public class MultiFn extends AFn{
 final public IFn dispatchFn;
 final public Object defaultDispatchVal;
+final public IRef hierarchy;
 IPersistentMap methodTable;
 IPersistentMap preferTable;
 IPersistentMap methodCache;
@@ -26,14 +27,14 @@ static final Var assoc = RT.var("clojure.core", "assoc");
 static final Var dissoc = RT.var("clojure.core", "dissoc");
 static final Var isa = RT.var("clojure.core", "isa?");
 static final Var parents = RT.var("clojure.core", "parents");
-static final Var hierarchy = RT.var("clojure.core", "global-hierarchy");
 
-public MultiFn(IFn dispatchFn, Object defaultDispatchVal) throws Exception{
+public MultiFn(IFn dispatchFn, Object defaultDispatchVal, IRef hierarchy) throws Exception{
 	this.dispatchFn = dispatchFn;
 	this.defaultDispatchVal = defaultDispatchVal;
 	this.methodTable = PersistentHashMap.EMPTY;
 	this.methodCache = getMethodTable();
 	this.preferTable = PersistentHashMap.EMPTY;
+    this.hierarchy = hierarchy;
 	cachedHierarchy = null;
 }
 
@@ -79,14 +80,14 @@ private boolean prefers(Object x, Object y) throws Exception{
 }
 
 private boolean isA(Object x, Object y) throws Exception{
-	return RT.booleanCast(isa.invoke(x, y));
+    return RT.booleanCast(isa.invoke(hierarchy.deref(), x, y));
 }
 
 private boolean dominates(Object x, Object y) throws Exception{
 	return prefers(x, y) || isA(x, y);
 }
 
-private IPersistentMap resetCache(){
+private IPersistentMap resetCache() throws Exception{
 	methodCache = getMethodTable();
 	cachedHierarchy = hierarchy.deref();
 	return methodCache;