simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

satisfies? recognizes reify, consistent with instance?

Browse source 
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:
Yogthos 2026-06-14 23:00:48 -04:00
parent 5a1532167c
commit 236dca28d9
2 changed files with 19 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/jolt/evaluator.janet
View file

@ -1725,16 +1725,24 @@
(let [tbl (get mm-var :jolt/methods)] (let [tbl (get mm-var :jolt/methods)]
(when tbl (each k (keys tbl) (set m (phm-assoc m k (get tbl k)))))) (when tbl (each k (keys tbl) (set m (phm-assoc m k (get tbl k))))))
m))) 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?" (ns-intern core "satisfies?"
(fn [proto obj] (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) (def type-tag (or (record-tag obj)
(if (and (table? obj) (get obj :jolt/protocol-methods)) (if (and (table? obj) (get obj :jolt/protocol-methods))
(get obj :jolt/deftype)))) (get obj :jolt/deftype))))
(if type-tag (cond
(let [pn (proto :name) (and protos (string? pn-str)
pn-str (if (struct? pn) (pn :name) pn)] (truthy? (some (fn [p] (= (last (string/split "." p))
(type-satisfies? ctx type-tag pn-str)) (last (string/split "." pn-str))))
protos))) true
type-tag (type-satisfies? ctx type-tag pn-str)
false))) false)))
# instance?: the overlay macro passes the TYPE NAME quoted (class names don't # instance?: the overlay macro passes the TYPE NAME quoted (class names don't
# evaluate to values on jolt); the value arg arrives evaluated. # evaluate to values on jolt); the value arg arrives evaluated.

6
test/spec/protocols-spec.janet
View file

@ -42,6 +42,12 @@
"(do (defprotocol P (m [_])) (defrecord R [] P (m [_] 1)) (satisfies? P (->R)))"] "(do (defprotocol P (m [_])) (defrecord R [] P (m [_] 1)) (satisfies? P (->R)))"]
["satisfies? false" "false" ["satisfies? false" "false"
"(do (defprotocol P (m [_])) (defrecord R []) (satisfies? P (->R)))"] "(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" ["instance? record" "true"
"(do (defrecord R [a]) (instance? R (->R 1)))"] "(do (defrecord R [a]) (instance? R (->R 1)))"]
["dot constructor" "5" ["dot constructor" "5"