summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRich Hickey <richhickey@gmail.com>2010-04-17 11:35:00 -0400
committerRich Hickey <richhickey@gmail.com>2010-04-17 11:35:00 -0400
commiteba23dbdaf93bfb8d3e2549c7a82706705e80d8e (patch)
treea823a3c516114b62afea2d8dba6cc23db9c370c4
parentb8e04fdc8f72157f3a6f825247ecfc97c86aff91 (diff)
prefer more derived interface in protocol, fixes #302
-rw-r--r--src/clj/clojure/core_deftype.clj10
1 files changed, 8 insertions, 2 deletions
diff --git a/src/clj/clojure/core_deftype.clj b/src/clj/clojure/core_deftype.clj
index 7fc2a026..c1b72ac2 100644
--- a/src/clj/clojure/core_deftype.clj
+++ b/src/clj/clojure/core_deftype.clj
@@ -373,15 +373,21 @@
(when c
(cons c (super-chain (.getSuperclass c)))))
+(defn- pref
+ ([] nil)
+ ([a] a)
+ ([#^Class a #^Class b]
+ (if (.isAssignableFrom a b) b a)))
+
(defn find-protocol-impl [protocol x]
(if (instance? (:on-interface protocol) x)
x
(let [c (class x)
impl #(get (:impls protocol) %)]
(or (impl c)
- ;todo - fix this so takes most-derived interface as well
(and c (or (first (remove nil? (map impl (butlast (super-chain c)))))
- (first (remove nil? (map impl (disj (supers c) Object))))
+ (when-let [t (reduce pref (filter impl (disj (supers c) Object)))]
+ (impl t))
(impl Object)))))))
(defn find-protocol-method [protocol methodk x]