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>

host/chez/host-contract.ss

@@ -361,8 +361,19 @@
 
 (define (hc-syntax-quote-lower ctx inner)
   (hc-sq-lower ctx inner (make-hashtable string-hash string=?)))
-(define (hc-record-type? ctx name) #f)
+;; a ^Type param hint: name is the tag (a symbol, sometimes a string). Resolve it
-(define (hc-record-ctor-key ctx name) jolt-nil)
+;; against the record registry (records.ss) so the inference seeds the param as
+;; that record — the open-world / cross-ns path where no caller type is inferred.
+(define (hc-record-tag-name name)
+  (cond ((symbol-t? name) (symbol-t-name name))
+        ((string? name) name)
+        (else #f)))
+(define (hc-record-type? ctx name)
+  (let ((nm (hc-record-tag-name name)))
+    (if (and nm (chez-find-ctor-key nm (chez-current-ns))) #t #f)))
+(define (hc-record-ctor-key ctx name)
+  (let ((nm (hc-record-tag-name name)))
+    (or (and nm (chez-find-ctor-key nm (chez-current-ns))) jolt-nil)))
 ;; record + protocol-method shapes for the inference, from the runtime registries
 ;; (records.ss) populated as deftype/defprotocol forms load.
 (define (hc-record-shapes ctx) (chez-record-shapes-map))

host/chez/records.ss

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

host/chez/run-fieldnum.ss

@@ -59,6 +59,15 @@
 (check "field-field arithmetic unboxes to fl*" (contains-sub? dot-emit "fl*") #t)
 (check "field-field arithmetic unboxes to fl+" (contains-sub? dot-emit "fl+") #t)
 
+;; a ^V param hint types the param with no inferable caller (open-world / cross-fn:
+;; the receiver isn't a ctor return). This is the record-ctor-key path — without it
+;; the hint is dead and the reads fall back to generic jolt-get + boxed arithmetic.
+(define hinted (anode "(def hyp (fn [^V v] (+ (* (:x v) (:x v)) (* (:y v) (:y v)))))"))
+(define hint-emit (emit (run-passes hinted (make-analyze-ctx "user"))))
+(check "^V param hint bare-indexes field reads" (contains-sub? hint-emit "jrec-field-at") #t)
+(check "^V param hint unboxes arithmetic" (contains-sub? hint-emit "fl*") #t)
+(check "^V param hint leaves no generic jolt-get" (contains-sub? hint-emit "jolt-get") #f)
+
 ;; an UNTAGGED field stays generic — no fl-op (the read is :any, not :double).
 (evals "(defrecord W [p q])")
 (define dotw (anode "(def dotw (fn [a b] (* (:p a) (:p b))))"))