Devirt: fall back to dispatch when the static tag has no direct impl

The devirtualized protocol call emitted find-protocol-method on the inferred
record tag, but a record can satisfy a protocol via an Object/host-tag default
rather than a direct impl — find-protocol-method on its own tag misses that,
while protocol-resolve walks to the default. So a record relying on
(extend-protocol P Object ...) resolved under ordinary dispatch but applied #f
under devirt and crashed. Closed-world opt builds only; the gate previously
covered just direct inline/extend-type impls so it shipped green.

Emit devirt-resolve, which tries the static tag and falls back to
protocol-resolve on a miss — same fast path, correct regardless of how the
record satisfies the protocol. Mirrors jrec-field-at falling back to jolt-get.
The receiver binds to one temp so it feeds the resolve and the application
without double-evaluating a side-effecting arg 0.

Also widen the whole-program fixpoint to :any on hitting the iteration cap: a
non-converged pre-fixpoint is more specific than the least fixpoint, so seeding
it would be unsound. Not reached in practice (~2 passes); a defensive floor.

run-devirt.ss gains an Object-default case. make test / shakesmoke green,
selfhost holds, 0 new divergences.
This commit is contained in:
Yogthos 2026-06-26 09:57:46 -04:00
parent de31221573
commit f60216e294
5 changed files with 273 additions and 238 deletions

View file

@ -579,6 +579,16 @@
(let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
(apply (protocol-resolve proto-name method-name obj) obj rest)))
;; devirt-resolve: the impl for a call the inference proved monomorphic. Try the
;; static type tag directly (the fast path that skips receiver-type computation),
;; and fall back to ordinary dispatch when it misses — a record can satisfy a
;; protocol via an Object/host-tag default rather than a direct impl, which
;; find-protocol-method on its own tag wouldn't see. Mirrors jrec-field-at falling
;; back to jolt-get: correct regardless of how precise the inference was.
(define (devirt-resolve type-tag proto-name method-name obj)
(or (find-protocol-method type-tag proto-name method-name)
(protocol-resolve proto-name method-name obj)))
;; dot-dispatch fallback used by emit for (.method record args): find the method
;; in ANY protocol the record's type implements.
;; java.util.Iterator over a jolt seqable: (.iterator coll) returns a jiterator