extenders excludes inline defrecord/deftype impls

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.

host/chez/records.ss

@@ -176,11 +176,29 @@
                     ((and (> (string-length type-name) 10) (string=? (substring type-name 0 10) "java.util.")) (substring type-name 10 (string-length type-name)))
                     (else type-name))))
     (and (hashtable-ref host-type-set base #f) base)))
+;; An extend/extend-type/extend-protocol registration marks the tag as an
+;; extender of the protocol (recorded inside type-registry so the per-case prune
+;; restores it). deftype/defrecord inline impls go through register-inline-method
+;; and skip the mark: the JVM compiles inline protocol methods into the class, so
+;; extenders excludes them.
+(define extend-mark "__jolt_extend__")
+(define (mark-extend! tag proto-name)
+  (let ((ti (hashtable-ref type-registry tag #f)))
+    (when ti (let ((pi (hashtable-ref ti proto-name #f)))
+               (when pi (hashtable-set! pi extend-mark #t))))))
 (define (register-method type-name proto-name method-name fn)
-  (let ((host (canonical-host-tag type-name)))
+  (let* ((host (canonical-host-tag type-name))
-    (register-protocol-method (or host (string-append (chez-current-ns) "." type-name)) proto-name method-name fn)
+         (tag (or host (string-append (chez-current-ns) "." type-name))))
+    (register-protocol-method tag proto-name method-name fn)
+    (mark-extend! tag proto-name)
     jolt-nil))
 
+;; register-inline-method: a deftype/defrecord inline impl. Registers for dispatch
+;; under the ns-qualified record tag but does NOT mark it as an extender.
+(define (register-inline-method type-name proto-name method-name fn)
+  (register-protocol-method (string-append (chez-current-ns) "." type-name) proto-name method-name fn)
+  jolt-nil)
+
 ;; protocol-dispatch: look up the impl by the value's type tag (record) or host
 ;; candidates, invoke it; reified objects carry instance-local methods.
 (define (protocol-dispatch proto-name method-name obj rest-args)
@@ -245,14 +263,19 @@
     (cond ((< i 0) s) ((char=? (string-ref s i) #\.) (substring s (+ i 1) (string-length s))) (else (loop (- i 1))))))
 (define (memp pred lst) (cond ((null? lst) #f) ((pred (car lst)) lst) (else (memp pred (cdr lst)))))
 
-;; extenders: type-tags implementing a protocol, as symbols (extends? reads this).
+;; extenders: type-tags that extend a protocol via extend/extend-type/extend-
+;; protocol, as symbols (extends? reads this). Inline deftype/defrecord impls are
+;; excluded — only tags carrying the extend mark count, matching the JVM.
 (define (extenders proto)
   (let* ((pn (jolt-get proto (keyword #f "name") jolt-nil))
          (pn-str (if (symbol-t? pn) (symbol-t-name pn) pn))
          (out '()))
     (vector-for-each
-      (lambda (tag) (when (let ((ti (hashtable-ref type-registry tag #f))) (and ti (hashtable-ref ti pn-str #f)))
+      (lambda (tag)
-                      (set! out (cons (jolt-symbol jolt-nil tag) out))))
+        (let ((ti (hashtable-ref type-registry tag #f)))
+          (when ti (let ((pi (hashtable-ref ti pn-str #f)))
+                     (when (and pi (hashtable-ref pi extend-mark #f))
+                       (set! out (cons (jolt-symbol jolt-nil tag) out)))))))
       (hashtable-keys type-registry))
     (if (null? out) jolt-nil (list->cseq out))))
 
@@ -305,6 +328,7 @@
 (def-var! "clojure.core" "make-protocol" make-protocol)
 (def-var! "clojure.core" "register-protocol-methods!" register-protocol-methods!)
 (def-var! "clojure.core" "register-method" register-method)
+(def-var! "clojure.core" "register-inline-method" register-inline-method)
 (def-var! "clojure.core" "protocol-dispatch" (lambda (pn mn obj rest) (protocol-dispatch pn mn obj rest)))
 (def-var! "clojure.core" "satisfies?" jolt-satisfies?)
 (def-var! "clojure.core" "extenders" extenders)

host/chez/run-corpus.ss

@@ -11,7 +11,7 @@
 ;; reset between cases so there is no leakage — same isolation a fresh process gives.
 ;;
 ;;   chez --script host/chez/run-corpus.ss
-;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2720)
+;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2722)
 ;;   JOLT_CORPUS_LIMIT=N    every-Nth stride (fast iteration; floor drops to 0)
 ;;   JOLT_DUMP_CRASH_LABELS=1   list crash + allowlisted labels
 (import (chezscheme))
@@ -89,7 +89,6 @@
   '("getMessage on a thrown string"
     "type of record" "chunked-seq? always false"
     "^Type tag on var"
-    "lists extended type" "seq of tags"
     "close on throw" "macroexpand-1"
     "bean is the map" "proxy resolves nil"
     "*in* is bound" "*in* bound"
@@ -193,7 +192,7 @@
 
 ;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
 (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
-                     (if s (string->number s) 2720)))
+                     (if s (string->number s) 2722)))
 (define floor (if limit 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"

jolt-core/clojure/core/30-macros.clj

@@ -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,