satisfies? recognizes reify, consistent with instance?
A reify's protocol methods are instance-local, so they aren't in the global type registry that type-satisfies? consults — satisfies? returned false for a reify even when it implemented the protocol. Check the protocols the reify records on itself (the same :jolt/protocols list instance? uses), matching short names like instance? does. Covers single- and multi-protocol reify.
This commit is contained in:
parent
5a1532167c
commit
236dca28d9
2 changed files with 19 additions and 5 deletions
|
|
@ -1725,16 +1725,24 @@
|
|||
(let [tbl (get mm-var :jolt/methods)]
|
||||
(when tbl (each k (keys tbl) (set m (phm-assoc m k (get tbl k))))))
|
||||
m)))
|
||||
# satisfies?: evaluated protocol value + instance (matches the prior arm).
|
||||
# satisfies?: evaluated protocol value + instance. Recognizes a reify the same
|
||||
# way instance? does — by the protocols it records on itself (a reify's methods
|
||||
# are instance-local, so they aren't in the global type registry that
|
||||
# type-satisfies? consults).
|
||||
(ns-intern core "satisfies?"
|
||||
(fn [proto obj]
|
||||
(def pn (proto :name))
|
||||
(def pn-str (if (struct? pn) (pn :name) pn))
|
||||
(def protos (if (table? obj) (get obj :jolt/protocols)))
|
||||
(def type-tag (or (record-tag obj)
|
||||
(if (and (table? obj) (get obj :jolt/protocol-methods))
|
||||
(get obj :jolt/deftype))))
|
||||
(if type-tag
|
||||
(let [pn (proto :name)
|
||||
pn-str (if (struct? pn) (pn :name) pn)]
|
||||
(type-satisfies? ctx type-tag pn-str))
|
||||
(cond
|
||||
(and protos (string? pn-str)
|
||||
(truthy? (some (fn [p] (= (last (string/split "." p))
|
||||
(last (string/split "." pn-str))))
|
||||
protos))) true
|
||||
type-tag (type-satisfies? ctx type-tag pn-str)
|
||||
false)))
|
||||
# instance?: the overlay macro passes the TYPE NAME quoted (class names don't
|
||||
# evaluate to values on jolt); the value arg arrives evaluated.
|
||||
|
|
|
|||
|
|
@ -42,6 +42,12 @@
|
|||
"(do (defprotocol P (m [_])) (defrecord R [] P (m [_] 1)) (satisfies? P (->R)))"]
|
||||
["satisfies? false" "false"
|
||||
"(do (defprotocol P (m [_])) (defrecord R []) (satisfies? P (->R)))"]
|
||||
["satisfies? reify" "true"
|
||||
"(do (defprotocol P (m [_])) (satisfies? P (reify P (m [_] 1))))"]
|
||||
["satisfies? reify multi-protocol" "[true true]"
|
||||
"(do (defprotocol P (m [_])) (defprotocol Q (n [_])) (let [r (reify P (m [_] 1) Q (n [_] 2))] [(satisfies? P r) (satisfies? Q r)]))"]
|
||||
["satisfies? reify other proto" "false"
|
||||
"(do (defprotocol P (m [_])) (defprotocol Q (n [_])) (satisfies? Q (reify P (m [_] 1))))"]
|
||||
["instance? record" "true"
|
||||
"(do (defrecord R [a]) (instance? R (->R 1)))"]
|
||||
["dot constructor" "5"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue