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.
This commit is contained in:
parent
d4acd69a73
commit
0b07b376bb
7 changed files with 46 additions and 33 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue