diff options
| author | Rich Hickey <richhickey@gmail.com> | 2010-04-17 11:35:00 -0400 |
|---|---|---|
| committer | Rich Hickey <richhickey@gmail.com> | 2010-04-17 11:35:00 -0400 |
| commit | eba23dbdaf93bfb8d3e2549c7a82706705e80d8e (patch) | |
| tree | a823a3c516114b62afea2d8dba6cc23db9c370c4 | |
| parent | b8e04fdc8f72157f3a6f825247ecfc97c86aff91 (diff) | |
prefer more derived interface in protocol, fixes #302
| -rw-r--r-- | src/clj/clojure/core_deftype.clj | 10 |
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] |