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:
parent
5411db3729
commit
580e3a1407
1 changed files with 15 additions and 0 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue