Make ^Record param hints work (resolve the record tag) (#232)
jolt.host/record-ctor-key and record-type? were stubs returning nil since the rehost, so phint-of always produced nil — a ^Record param hint (^Sphere s) was silently dead. The inference only ever typed a record param when its callers passed a concrete ctor (whole-program), so a fn called with an untyped value (a vector element, a value threaded through recursion) read its fields generically. Resolve the tag against the record registry (records.ss): chez-find-ctor-key maps a ^Type tag to the ctor-key "ns/->Name" the inference seeds with, preferring the compile ns and falling back to any registered record of that simple name (cross-ns / imported). record-type? / record-ctor-key call it. Runtime .ss — no re-mint (the analyzer reaches record-ctor-key through the host var). With this, a ^Sphere/^Ray-hinted hit-sphere in the ray tracer types its params, so its 48 generic jolt-get field reads + boxed arithmetic become bare-index reads + fl-ops: ray tracer 38.4s -> 23.9s (~1.6x), make test / shakesmoke green, selfhost holds, 0 new divergences. A wrong hint stays safe — jrec-field-at falls back to jolt-get for a non-record. run-fieldnum.ss: a ^V-hinted param (no inferable caller) bare-indexes + unboxes, with no generic jolt-get left. Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
parent
4671e1b67e
commit
09345f10c2
3 changed files with 37 additions and 2 deletions
|
|
@ -100,6 +100,21 @@
|
|||
ks vs))
|
||||
out))
|
||||
|
||||
;; resolve a record TYPE name (a ^Type param hint's tag) to the ctor-key
|
||||
;; "ns/->Name" the inference seeds with. Prefer the ctor in `ns` (the compile ns);
|
||||
;; else any registered record with that simple name (cross-ns / imported). #f if
|
||||
;; the name isn't a record type (so a ^double/^String hint resolves to nil).
|
||||
(define (chez-find-ctor-key name ns)
|
||||
(let* ((simple (chez-shape-simple-name name))
|
||||
(target (string-append "->" simple))
|
||||
(preferred (string-append ns "/->" simple)))
|
||||
(if (hashtable-ref chez-record-shapes-tbl preferred #f)
|
||||
preferred
|
||||
(let loop ((ks (vector->list (hashtable-keys chez-record-shapes-tbl))))
|
||||
(cond ((null? ks) #f)
|
||||
((string=? (chez-shape-simple-name (car ks)) target) (car ks))
|
||||
(else (loop (cdr ks))))))))
|
||||
|
||||
;; materialize chez-protocol-methods-tbl into "ns/method" -> [proto method].
|
||||
(define (chez-protocol-methods-map)
|
||||
(let ((out (jolt-hash-map)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue