enhanced prefers to prefer whole trees to others

fixed supers, which didn't trace interfaces

2 files changed, 22 insertions, 9 deletions

diff --git a/src/clj/clojure/boot.clj b/src/clj/clojure/boot.clj
index 4e33578c..1f1a66bc 100644
--- a/src/clj/clojure/boot.clj
+++ b/src/clj/clojure/boot.clj
@@ -2854,9 +2854,10 @@
 (defn supers 
   "Returns the immediate and indirect superclasses and interfaces of c, if any"
   [#^Class class]
-  (loop [ret #{} c class]
-    (if c
-      (recur (into ret (bases c)) (.getSuperclass c))
+  (loop [ret (set (bases class)) cs ret]
+    (if (seq cs)
+      (let [c (first cs) bs (bases c)]
+        (recur (into ret bs) (into (disj cs c) bs)))
       (not-empty ret))))
 
 (defn isa?
@@ -3465,8 +3466,7 @@
 (defmethod print-method java.util.Collection [o, #^Writer w]
  (print-ctor o #(print-sequential "[" print-method " " "]" %1 %2) w))
 
-(prefer-method print-method clojure.lang.IPersistentList java.util.Collection)
-(prefer-method print-method clojure.lang.IPersistentVector java.util.Collection)
+(prefer-method print-method clojure.lang.IPersistentCollection java.util.Collection)
 
 (def #^{:tag String 
         :doc "Returns escape string for char or nil if none"}
@@ -3532,7 +3532,7 @@
               #(print-sequential "#{" print-method " " "}" (seq %1) %2)
               w))
 
-(prefer-method print-method clojure.lang.IPersistentSet java.util.Set)
+;(prefer-method print-method clojure.lang.IPersistentSet java.util.Set)
 
 (def #^{:tag String 
         :doc "Returns name string for char or nil if none"} 
diff --git a/src/jvm/clojure/lang/MultiFn.java b/src/jvm/clojure/lang/MultiFn.java
index 954f0b56..527a0d38 100644
--- a/src/jvm/clojure/lang/MultiFn.java
+++ b/src/jvm/clojure/lang/MultiFn.java
@@ -26,6 +26,7 @@ Object cachedHierarchy;
 static final Var assoc = RT.var("clojure", "assoc");
 static final Var dissoc = RT.var("clojure", "dissoc");
 static final Var isa = RT.var("clojure", "isa?");
+static final Var parents = RT.var("clojure", "parents");
 static final Var hierarchy = RT.var("clojure", "global-hierarchy");
 
 public MultiFn(IFn dispatchFn, Object defaultDispatchVal) throws Exception{
@@ -49,7 +50,7 @@ synchronized public MultiFn removeMethod(Object dispatchVal) throws Exception{
 	return this;
 }
 
-synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchValY){
+synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchValY) throws Exception{
 	if(prefers(dispatchValY, dispatchValX))
 		throw new IllegalStateException(
 				String.format("Preference conflict: %s is already preferred to %s", dispatchValY, dispatchValX));
@@ -61,9 +62,21 @@ synchronized public MultiFn preferMethod(Object dispatchValX, Object dispatchVal
 	return this;
 }
 
-private boolean prefers(Object x, Object y){
+private boolean prefers(Object x, Object y) throws Exception{
 	IPersistentSet xprefs = (IPersistentSet) preferTable.valAt(x);
-	return xprefs != null && xprefs.contains(y);
+	if(xprefs != null && xprefs.contains(y))
+		return true;
+	for(ISeq ps = RT.seq(parents.invoke(y)); ps != null; ps = ps.rest())
+		{
+		if(prefers(x, ps.first()))
+			return true;
+		}
+	for(ISeq ps = RT.seq(parents.invoke(x)); ps != null; ps = ps.rest())
+		{
+		if(prefers(ps.first(), y))
+			return true;
+		}
+	return false;
 }
 
 private boolean isA(Object x, Object y) throws Exception{