A defrecord exposes its clojure.lang interfaces for protocol dispatch

value-host-tags returned only ("Object") for a record, so a protocol extended to
clojure.lang.IRecord / IPersistentMap / Associative / Seqable / … (and not to the
record's own type) dispatched to the Object default. core.logic extends IWalkTerm
to IRecord, and walking a record value hit Object's (walk-term [v f] (f v)) — which
re-enters walk* and loops forever (the test-53-lossy-records hang).

A defrecord now carries the map/record interface tags it genuinely satisfies. The
record's own type is still tried first (jrec-tag, before these tags), so a direct
extend to the record type wins, and record equality / map? / record? are unchanged.
A bare deftype stays opaque (its tag + Object; declared interfaces dispatch via its
inline methods). Runtime only, no re-mint.
This commit is contained in:
Yogthos 2026-06-27 10:57:37 -04:00
parent 5411db3729
commit 580e3a1407

View file

@ -505,6 +505,21 @@
;; a bare procedure (fn) — extend-protocol to clojure.lang.{Fn,IFn,AFn}.
((procedure? obj) '("Fn" "IFn" "AFn" "Object"))
((jolt-nil? obj) '("nil"))
;; a defrecord IS the clojure.lang map/record interfaces, so a protocol
;; extended to IRecord / IPersistentMap / Associative / Seqable / … (and not
;; to the record's own type) dispatches to it — e.g. core.logic extends
;; IWalkTerm to clojure.lang.IRecord, and walking a record value must hit
;; that, not the Object default (which would recur forever). The record's
;; own type is tried first (dispatch checks jrec-tag before these tags).
((jrec-record? obj)
(cons (jrec-tag obj)
'("IRecord" "clojure.lang.IRecord" "IPersistentMap" "clojure.lang.IPersistentMap"
"APersistentMap" "Associative" "ILookup" "Seqable" "Counted"
"IPersistentCollection" "IObj" "IMeta" "Map" "java.util.Map"
"Iterable" "java.lang.Iterable" "Object")))
;; a bare deftype is opaque — its declared interfaces dispatch via the
;; inline methods registered under its own tag (tried before these tags).
((jrec? obj) (list (jrec-tag obj) "Object"))
(else '("Object"))))
(define (record-tag obj) (and (jrec? obj) (jrec-tag obj)))