simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Resolve .method calls through a priority arm registry

Browse source 
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.
This commit is contained in:
Yogthos 2026-07-01 15:52:24 -04:00
parent d4acd69a73
commit 0b07b376bb
7 changed files with 46 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

10
host/chez/java/host-static-classes.ss
View file

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