From 01f98c2e89bff30454dee1d05abd7a5453174662 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 1 Jul 2026 15:59:01 -0400 Subject: [PATCH] Route deftype/reify interface dispatch through one seam MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- host/chez/records.ss | 20 +++++++++++++++++++- host/chez/seq.ss | 8 ++++---- test/chez/corpus.edn | 2 ++ 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/host/chez/records.ss b/host/chez/records.ss index c0593d9..eec4807 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -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))) diff --git a/host/chez/seq.ss b/host/chez/seq.ss index 1f65905..ac9e7ed 100644 --- a/host/chez/seq.ss +++ b/host/chez/seq.ss @@ -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))))))) diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index 74eb5f4..344a85d 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -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)))"} ]