Route deftype/reify interface dispatch through one seam

The "does value V declare method M; if so call it" decision was re-derived in a
dozen places with two different lookup helpers — records.ss jrec-cl and
collections.ss rec-coll-method were a byte-for-byte duplicate — and reduce only
honored a reify's own reduce method, not a deftype's:

  (reduce + 100 (->Rng 5))  ; Rng deftype implementing IReduceInit
  => "not seqable"          ; JVM: 110

Add iface-method / iface-call: one lookup that resolves a method for a deftype OR
a reify, with arity, and is the seam a core fn's interface arm collapses to.
jrec-cl now aliases rec-coll-method (the duplicate is gone). reduce routes its
IReduceInit arm through iface-method, so a deftype's reduce drives the reduction
like a reify's, reduced short-circuit included.

Runtime only, no re-mint. make test green (0 new/stale), +2 corpus rows.
This commit is contained in:
Yogthos 2026-07-01 15:59:01 -04:00
parent 0b07b376bb
commit 01f98c2e89
3 changed files with 25 additions and 5 deletions

View file

@ -304,7 +304,25 @@
;; implements a clojure.lang collection interface carries the op as an inline
;; method — prefer that method, else fall back to the field/map behavior. (jrec-cl
;; finds the method; find-method-any-protocol / jolt-invoke resolve at call time.)
(define (jrec-cl coll name) (and (jrec? coll) (find-method-any-protocol (jrec-tag coll) name)))
;; Same lookup as collections.ss rec-coll-method — one definition, aliased here.
(define jrec-cl rec-coll-method)
;; iface-method: the single deftype/reify interface-method lookup. Returns the
;; impl fn for METHOD declared by V (a deftype/record OR a reify), or #f. NARGS
;; (including `this`) selects the matching arity for a deftype; #f means any
;; arity. Core fns route interface dispatch through this instead of each
;; re-deriving jrec-vs-reify lookup and arity handling.
(define (iface-method v method nargs)
(cond ((jrec? v)
(if nargs (find-method-any-protocol-arity (jrec-tag v) method nargs)
(find-method-any-protocol (jrec-tag v) method)))
((jreify? v) (let ((rm (reified-methods v))) (and rm (hashtable-ref rm method #f))))
(else #f)))
;; Call METHOD on V with ARGS (a list, `this` excluded) if V declares it, else run
;; FALLBACK. The one seam a core fn's deftype/reify arm collapses to.
(define (iface-call v method args fallback)
(let ((m (iface-method v method (+ 1 (length args)))))
(if m (apply jolt-invoke m v args) (fallback))))
(define %r-jolt-count jolt-count)
(set! jolt-count (lambda (coll)
(cond ((jrec-cl coll "count") => (lambda (m) (jolt-invoke m coll)))

View file

@ -421,11 +421,11 @@
(if (jolt-nil? s) (jolt-invoke f) ; (reduce f []) -> (f)
(reduce-seq f (seq-first s) (jolt-seq (seq-more s))))))
((f init coll)
;; IReduceInit: a reify/record with its own `reduce` method drives the
;; reduction (reduce f init (reify clojure.lang.IReduceInit (reduce [_ f i] ...))).
;; IReduceInit: a deftype/record OR reify with its own `reduce` method drives
;; the reduction, e.g. (reduce f init (reify clojure.lang.IReduceInit
;; (reduce [_ f i] ...))) or the same on a deftype.
(cond
((and (jreify? coll) (reified-methods coll)
(hashtable-ref (reified-methods coll) "reduce" #f))
((iface-method coll "reduce" 3)
=> (lambda (m) (let ((r (jolt-invoke m coll f init)))
(if (jolt-reduced? r) (jolt-reduced-val r) r))))
(else (reduce-seq f init (jolt-seq coll)))))))

View file

@ -3509,4 +3509,6 @@
{:suite "protocols / instance? matches dispatch" :label "instance? agrees with what a value's class implements" :expected "[true true false true true]" :actual "[(instance? clojure.lang.Associative [1 2]) (instance? clojure.lang.IFn :k) (instance? java.util.Map [1 2]) (instance? clojure.lang.Seqable (map inc [1 2])) (instance? clojure.lang.IPersistentVector [1 2])]"}
{:suite "class / hierarchy views agree" :label "isa?/supers see the modeled exception + collection hierarchy" :expected "[true true true true]" :actual "[(isa? clojure.lang.ExceptionInfo java.lang.RuntimeException) (contains? (supers java.lang.NumberFormatException) java.lang.RuntimeException) (isa? clojure.lang.Keyword clojure.lang.IFn) (contains? (ancestors clojure.lang.PersistentVector) java.util.List)]"}
{:suite "host-interop / getClass" :label ".getClass is a universal Object method, reached on every value type" :expected "[\"java.util.Date\" \"java.io.File\"]" :actual "[(.getName (.getClass (java.util.Date.))) (.getName (.getClass (java.io.File. \"x\")))]"}
{:suite "reduce / IReduceInit" :label "reduce drives a deftype's own reduce method (init arity)" :expected "110" :actual "(do (deftype Rng [n] clojure.lang.IReduceInit (reduce [_ f init] (loop [i 0 acc init] (if (< i n) (recur (inc i) (f acc i)) acc)))) (reduce + 100 (->Rng 5)))"}
{:suite "reduce / IReduceInit" :label "a deftype reduce honors reduced short-circuit" :expected "3" :actual "(do (deftype Rng [n] clojure.lang.IReduceInit (reduce [_ f init] (loop [i 0 acc init] (if (< i n) (let [a (f acc i)] (if (reduced? a) @a (recur (inc i) a))) acc)))) (reduce (fn [acc x] (if (= x 3) (reduced acc) (+ acc x))) 0 (->Rng 10)))"}
]