Resolve .method calls through a priority arm registry

record-method-dispatch was rebound with (set! record-method-dispatch ...) in six
files, each wrapping the previous binding, so precedence was whatever the rt.ss
load order happened to be — the true outermost arm was inst-time's Date arm, not
the one you'd guess. A type-gated wrapper that only whitelists its own methods
then errored on everything else, stealing universal Object methods from the arms
beneath it: (.getClass (java.util.Date.)) threw "No method getClass on Date",
same for File, while (class ...) and (.getClass "s") worked.

Replace the wrapper stack with an ordered list of arms (register-method-arm!,
ascending priority), each returning 'pass to defer. getClass is now one arm at
the top reached by every value, so it can't be shadowed; the three duplicate
getClass checks (dot-forms, host-static, base) collapse into it. Each former
wrapper is an arm at an explicit priority instead of an implicit load-order slot.
A library can register its own arm rather than set!-wrapping the dispatcher.

Runtime only, no re-mint. make test green (0 new/stale divergences), +1 corpus
row for getClass on Date/File.

host/chez/java/dot-forms.ss

@@ -17,8 +17,6 @@
 ;; A record (jrec) is jolt-map? here (records.ss makes it so) and a collection,
 ;; so its protocol method (no dash, not a coll method) lands in the base.
 
-(define %dot-rmd record-method-dispatch)
-
 ;; Vectors / maps / sets only (records are jolt-map? here). Raw seqs are excluded:
 ;; coll-interop accepts some seq representations and not others (a
 ;; plain (seq v) returns nil from .count, a lazy-seq returns the count), an
@@ -84,7 +82,7 @@
     ((string=? name "equals")    (list (if (jolt= obj (car args)) #t #f)))
     (else #f)))
 
-(set! record-method-dispatch
+(register-method-arm! 30
   (lambda (obj method-name rest-args)
     (let* ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args)))
            (field? (and (> (string-length method-name) 0)
@@ -93,9 +91,6 @@
                       (substring method-name 1 (string-length method-name))
                       method-name)))
       (cond
-        ;; (.getClass x) universal — the class token for any value, before the
-        ;; collection/map field-lookup arms below would read it as a missing key.
-        ((string=? method-name "getClass") (jolt-class obj))
         ;; clojure.lang.MultiFn .dispatchFn / .getMethod — clojure.spec.alpha's
         ;; multi-spec walks a multimethod through these.
         ((jolt-multifn? obj)
@@ -107,7 +102,7 @@
                   (mm-find-isa obj dv)
                   (hashtable-ref methods (jolt-multifn-default obj) #f)
                   jolt-nil)))
-           (else (%dot-rmd obj method-name rest-args))))
+           (else 'pass)))
         ;; (.applyTo f args): apply a fn to a seq of args (clojure.spec instrument).
         ((and (procedure? obj) (string=? mname "applyTo"))
          (apply jolt-invoke obj (seq->list (jolt-seq (car rest)))))
@@ -119,7 +114,7 @@
            ((or (string=? mname "valAt") (string=? mname "get"))
             (t-get obj (car rest) (if (null? (cdr rest)) jolt-nil (cadr rest))))
            ((string=? mname "count") (t-count obj))
-           (else (%dot-rmd obj method-name rest-args))))
+           (else 'pass)))
         ;; a deftype/record's OWN declared method (matched by name AND arity) wins
         ;; over the generic collection interop below — e.g. data.priority-map
         ;; declares both seq[this] (Seqable) and seq[this ascending] (Sorted), and
@@ -145,4 +140,4 @@
            (else
             (let ((v (jolt-get obj (keyword #f mname) jolt-nil)))
               (if (procedure? v) (apply jolt-invoke v obj rest) v)))))
-        (else (%dot-rmd obj method-name rest-args))))))
+        (else 'pass)))))

host/chez/java/host-static-classes.ss

@@ -642,8 +642,7 @@
 ;; record-method-dispatch already routes string? -> jolt-string-method. Add a
 ;; regex-t arm (Pattern .split / .matcher-less surface used by corpus) by wrapping
 ;; once more — a regex-t isn't a jhost.
-(define %hs-rmd2 record-method-dispatch)
-(set! record-method-dispatch
+(register-method-arm! 42
   (lambda (obj method-name rest-args)
     (let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
       (cond
@@ -667,7 +666,7 @@
                ((string=? method-name "group") (apply jolt-matcher-group obj rest))
                ((string=? method-name "groupCount") (jolt-matcher-group-count obj))
                (else (error #f (string-append "No method " method-name " on Matcher")))))
-        (else (%hs-rmd2 obj method-name rest-args))))))
+        (else 'pass)))))
 
 ;; ---- def-var! the registry entry points so emit can also reach them ---------
 (def-var! "clojure.core" "host-static-ref" host-static-ref)
@@ -709,15 +708,14 @@
 
 ;; htable arm: dispatch (.method obj a*) through the table's tag method registry;
 ;; an unregistered method falls through (sorted colls are htables too).
-(define %hs-rmd-htable record-method-dispatch)
-(set! record-method-dispatch
+(register-method-arm! 43
   (lambda (obj method-name rest-args)
     (let ((tag (and (htable? obj) (hashtable-ref (htable-h obj) "jolt/type" #f))))
       (let* ((mh (and tag (hashtable-ref tagged-methods-tbl (tag->method-key tag) #f)))
              (f  (and mh (hashtable-ref mh method-name #f))))
         (if f
             (apply f obj (if (jolt-nil? rest-args) '() (seq->list rest-args)))
-            (%hs-rmd-htable obj method-name rest-args))))))
+            'pass)))))
 
 (def-var! "clojure.core" "__register-class-methods!"
   (lambda (tag members) (register-tagged-methods! tag (jmap->static-alist members)) jolt-nil))

host/chez/java/host-static.ss

@@ -90,13 +90,9 @@
        (list->cseq (if asc keep (reverse keep)))))
     (else (error #f (string-append "No method " method " on sorted collection")))))
 
-(define %hs-record-method-dispatch record-method-dispatch)
-(set! record-method-dispatch
+(register-method-arm! 44
   (lambda (obj method-name rest-args)
     (cond
-      ;; (.getClass x) is universal — the class token for any value (incl. numbers
-      ;; / jhost) — before the per-type arms that would otherwise reject it.
-      ((string=? method-name "getClass") (jolt-class obj))
       ((jhost? obj)
        (let ((mh (hashtable-ref host-methods-tbl (jhost-tag obj) #f)))
          (let ((f (and mh (hashtable-ref mh method-name #f))))
@@ -104,7 +100,7 @@
                (apply f obj (if (jolt-nil? rest-args) '() (seq->list rest-args)))
                (error #f (string-append "No method " method-name " on host " (jhost-tag obj)))))))
       ((number? obj) (apply number-method method-name obj (if (jolt-nil? rest-args) '() (seq->list rest-args))))
-      (else (%hs-record-method-dispatch obj method-name rest-args)))))
+      (else 'pass))))
 
 ;; java.lang.Number method surface (the boxed-number methods cljc code calls). The
 ;; integer projections wrap modulo their width (ring-codec relies on byteValue

host/chez/java/inst-time.ss

@@ -562,8 +562,7 @@
         (cons "format" (lambda (self d) (format-ms (vector-ref (jhost-state self) 0) (ms-of d))))))
 
 ;; a jinst's java.util.Date method surface (record-method-dispatch arm).
-(define %it-rmd record-method-dispatch)
-(set! record-method-dispatch
+(register-method-arm! 40
   (lambda (obj method-name rest-args)
     (cond
       ((jinst? obj)
@@ -586,7 +585,7 @@
              ((string=? method-name "before") (< (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
              ((string=? method-name "after") (> (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
              (else (error #f (string-append "No method " method-name " on Date")))))
-      (else (%it-rmd obj method-name rest-args)))))
+      (else 'pass))))
 
 ;; Clojure's built-in data readers, so a library that merges default-data-readers
 ;; or binds *data-readers* (e.g. aero's reader opts) resolves #inst / #uuid.

host/chez/java/io.ss

@@ -240,14 +240,13 @@
                (else (loop (- i 1))))))
       (else #f))))
 
-(define %io-rmd record-method-dispatch)
-(set! record-method-dispatch
+(register-method-arm! 41
   (lambda (obj method-name rest-args)
     (if (jfile? obj)
         (let* ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args)))
                (r (jfile-method obj method-name rest)))
           (if r (car r) (error #f "no File method" method-name)))
-        (%io-rmd obj method-name rest-args))))
+        'pass)))
 
 ;; .isDirectory / .listFiles emit to jolt-host-call (rt.ss), not record-method-
 ;; dispatch — the shims there assume a path STRING target. Make them jfile-aware

host/chez/records.ss

@@ -797,14 +797,9 @@
 ;; "#<compound condition>".
 (def-var! "jolt.host" "condition-message"
   (lambda (c) (if (condition? c) (condition->message-string c) jolt-nil)))
-(define (record-method-dispatch obj method-name rest-args)
+(define (record-method-dispatch-base obj method-name rest-args)
   (let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
     (cond
-      ;; (.getClass x): universal Object method — the class token for any value
-      ;; (jolt has no Class objects; the token is the canonical name string, on
-      ;; which .getName/.getSimpleName work via the String method shim).
-      ((and (string=? method-name "getClass") (not (jrec? obj)) (not (jreify? obj)))
-       (jolt-class obj))
       ((and (jrec? obj) (find-method-any-protocol-arity (jrec-tag obj) method-name (+ 1 (length rest))))
        => (lambda (f) (apply jolt-invoke f obj rest)))
       ;; (.field inst): a deftype/record field read with no matching method.
@@ -936,6 +931,36 @@
       (else (error #f (string-append "No method " method-name " for value: "
                                      (jolt-pr-str obj)))))))
 
+;; ---- method-dispatch arm registry ------------------------------------------
+;; A .method call (record-method-dispatch) is resolved by an ordered list of arms
+;; (ascending priority), each (obj method-name rest-args) -> result | 'pass.
+;; This replaces a stack of (set! record-method-dispatch ...) rebindings across
+;; six files whose precedence was implicit in load order — priority is now
+;; explicit data. record-method-dispatch-base is the final fallback (the
+;; string/keyword/symbol/Object-method surface). A host shim / library registers
+;; an arm with register-method-arm! instead of set!-wrapping the dispatcher.
+(define method-dispatch-arms '())   ; list of (priority . arm), ascending priority
+(define (register-method-arm! priority arm)
+  (set! method-dispatch-arms
+    (let ins ((as method-dispatch-arms))
+      (cond ((null? as) (list (cons priority arm)))
+            ((< priority (caar as)) (cons (cons priority arm) as))
+            (else (cons (car as) (ins (cdr as))))))))
+(define (record-method-dispatch obj method-name rest-args)
+  (let loop ((as method-dispatch-arms))
+    (if (null? as)
+        (record-method-dispatch-base obj method-name rest-args)
+        (let ((r ((cdar as) obj method-name rest-args)))
+          (if (eq? r 'pass) (loop (cdr as)) r)))))
+
+;; (.getClass x): a universal Object method reached by EVERY value before any
+;; per-type arm — the class token for the value (jolt has no Class objects; the
+;; token is the canonical name string, on which .getName/.getSimpleName work).
+;; One arm, so a type arm that only whitelists its own methods can't steal it.
+(register-method-arm! 5
+  (lambda (obj method-name rest-args)
+    (if (string=? method-name "getClass") (jolt-class obj) 'pass)))
+
 ;; reify: instance-local method table. obj is a jreify carrying a method ht +
 ;; the protocol short-names it implements (for satisfies?/instance?).
 (define-record-type jreify (fields methods protos) (nongenerative chez-jreify-v1))

test/chez/corpus.edn

@@ -3508,4 +3508,5 @@
   {:suite "protocols / interface dispatch" :label "extend-protocol to an interface a builtin implements dispatches (instance? and protocol dispatch agree)" :expected "[:assoc :ifn :seqable]" :actual "(do (defprotocol PA (ma [_])) (extend-protocol PA clojure.lang.Associative (ma [_] :assoc)) (defprotocol PF (mf [_])) (extend-protocol PF clojure.lang.IFn (mf [_] :ifn)) (defprotocol PS (ms [_])) (extend-protocol PS clojure.lang.Seqable (ms [_] :seqable)) [(ma [1 2]) (mf :k) (ms (map inc [1 2]))])"}
   {: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\")))]"}
 ]