Merge pull request #288 from jolt-lang/conformance/deftype-method-seam

Route deftype/reify interface dispatch through one seam

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)))

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
+     ;; IReduceInit: a deftype/record OR reify with its own `reduce` method drives
-     ;; reduction (reduce f init (reify clojure.lang.IReduceInit (reduce [_ f i] ...))).
+     ;; 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)
+       ((iface-method coll "reduce" 3)
-             (hashtable-ref (reified-methods coll) "reduce" #f))
         => (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)))))))

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)))"}
 ]