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

extenders excludes inline defrecord/deftype impls

Browse source 
deftype/defrecord inline protocol methods went through extend-type ->
register-method, so a record implementing a protocol inline showed up in
(extenders P) — the JVM only lists extend/extend-type/extend-protocol
registrations there (inline impls compile into the class). Add
register-inline-method: it registers for dispatch under the record tag but
skips the extender mark. The mark lives inside type-registry so the per-case
corpus prune restores it. Closes corpus lists-extended-type + seq-of-tags.
This commit is contained in:
Yogthos 2026-06-21 23:35:11 -04:00
parent 10d2b992f7
commit ccc76fd69f
4 changed files with 45 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

16
jolt-core/clojure/core/30-macros.clj
View file

@ -307,13 +307,17 @@
(:volatile-mutable mt)))
true false)))
fields)
;; inline impls register for dispatch but are NOT extenders of the
;; protocol (the JVM compiles them into the class) — register-inline-method,
;; not extend-type.
impl (fn [proto specs]
`(extend-type ~tname ~proto
`(do
~@(map (fn [spec]
(let [argv (nth spec 1)
inst (first argv)
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
`(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec)))))
`(register-inline-method ~(name tname) ~(name proto) ~(name (first spec))
(fn ~argv (let [~@binds] ~@(drop 2 spec))))))
specs)))]
`(do
(def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags] [~@field-muts]))
@ -445,8 +449,11 @@
;; each method body sees the record fields, bound from the instance (the
;; method's first param), matching Clojure's defrecord method scope. vec the
;; spliced binding seq so ~@ splices its elements, not the lazy-seq itself.
;; inline impls register for dispatch but are NOT extenders of the
;; protocol (the JVM compiles them into the class) — register-inline-method,
;; not extend-type.
impl (fn [proto specs]
`(extend-type ~name-sym ~proto
`(do
~@(map (fn [spec]
(let [argv (nth spec 1)
inst (first argv)
@ -455,7 +462,8 @@
;; instead of going through the runtime tag guard.
hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym)))
binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
`(~(first spec) ~hinted (let [~@binds] ~@(drop 2 spec)))))
`(register-inline-method ~(name name-sym) ~(name proto) ~(name (first spec))
(fn ~hinted (let [~@binds] ~@(drop 2 spec))))))
specs)))]
`(do
;; deftype already defines ->name (= the ctor); no (name. …) interop needed,