resolve ^Type hint to canonical class name in var :tag

(def ^String tv ...) left (:tag (meta (var tv))) as the unresolved "String";
the JVM compiler resolves the hint to java.lang.String at def time. Add a
resolve-class-hint host seam (built from the existing class-token table) and
resolve a def's :tag through it in the analyzer. The reader path
(read-string "^String x") stays unresolved, matching the JVM (only the
compiler resolves). Closes ^Type-tag-on-var.

host/chez/host-class.ss

@@ -34,11 +34,11 @@
 (def-var! "clojure.core" "class" jolt-class)
 
 ;; bare class-name tokens -> canonical JVM class-name strings.
-(for-each
+(define class-token-alist
-  (lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair)))
   '(("String" . "java.lang.String") ("Number" . "java.lang.Number")
     ("Boolean" . "java.lang.Boolean") ("Long" . "java.lang.Long")
     ("Integer" . "java.lang.Integer") ("Double" . "java.lang.Double")
+    ("Object" . "java.lang.Object") ("Character" . "java.lang.Character")
     ("InputStream" . "java.io.InputStream") ("OutputStream" . "java.io.OutputStream")
     ("File" . "java.io.File") ("Reader" . "java.io.Reader") ("Writer" . "java.io.Writer")
     ("ISeq" . "clojure.lang.ISeq") ("Keyword" . "clojure.lang.Keyword")
@@ -51,6 +51,18 @@
     ("IllegalArgumentException" . "java.lang.IllegalArgumentException")
     ("InterruptedException" . "java.lang.InterruptedException")
     ("Throwable" . "java.lang.Throwable")))
+(for-each
+  (lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair)))
+  class-token-alist)
+
+;; resolve a ^Type hint symbol-name to its canonical class name at def time
+;; (jolt-a1ir): "String" -> "java.lang.String", matching the JVM compiler. An
+;; already-canonical name maps to itself; an unknown name yields #f (left as-is).
+(define class-hint-table (make-hashtable string-hash string=?))
+(for-each (lambda (p) (hashtable-set! class-hint-table (car p) (cdr p))) class-token-alist)
+(for-each (lambda (p) (hashtable-set! class-hint-table (cdr p) (cdr p))) class-token-alist)
+(define (resolve-class-hint name) (hashtable-ref class-hint-table name #f))
+(def-var! "jolt.host" "resolve-class-hint" resolve-class-hint)
 
 ;; fully-qualified canonical class names self-evaluate to their own name string,
 ;; so (= (class 1) java.lang.Long) and (instance? clojure.lang.Atom x) resolve the

host/chez/run-corpus.ss

@@ -11,7 +11,7 @@
 ;; reset between cases so there is no leakage — same isolation a fresh process gives.
 ;;
 ;;   chez --script host/chez/run-corpus.ss
-;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2725)
+;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2726)
 ;;   JOLT_CORPUS_LIMIT=N    every-Nth stride (fast iteration; floor drops to 0)
 ;;   JOLT_DUMP_CRASH_LABELS=1   list crash + allowlisted labels
 (import (chezscheme))
@@ -88,7 +88,6 @@
 (define known-fail-labels
   '("getMessage on a thrown string"
     "type of record" "chunked-seq? always false"
-    "^Type tag on var"
     "close on throw" "macroexpand-1"
     "bean is the map" "proxy resolves nil"
     "bigdec" "bigdec int M" "bigdec suffix M"
@@ -191,7 +190,7 @@
 
 ;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
 (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
-                     (if s (string->number s) 2725)))
+                     (if s (string->number s) 2726)))
 (define floor (if limit 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"

jolt-core/jolt/analyzer.clj

@@ -26,7 +26,8 @@
                                form-ns-value? form-ns-value-name
                                form-macro? form-expand-1 resolve-global
                                form-sym-meta host-intern! form-syntax-quote-lower
-                               record-type? record-ctor-key form-position late-bind?]]))
+                               record-type? record-ctor-key form-position late-bind?
+                               resolve-class-hint]]))
 
 (declare analyze)
 
@@ -266,7 +267,18 @@
                     ;; as the value and the real init dropped (jolt-6ym).
                     has-doc (and (> (count items) 3) (string? (nth items 2)))
                     val-form (nth items (if has-doc 3 2))
-                    base-meta (or (form-sym-meta name-sym) {})
+                    base0 (or (form-sym-meta name-sym) {})
+                    ;; resolve a ^Type hint to its canonical class name at def
+                    ;; time (jolt-a1ir), as the JVM compiler does: ^String ->
+                    ;; java.lang.String. A record/unknown hint is left untouched.
+                    tag (get base0 :tag)
+                    tag-name (cond (form-sym? tag) (form-sym-name tag)
+                                   (string? tag) tag
+                                   :else nil)
+                    base-meta (if tag-name
+                                (let [c (resolve-class-hint tag-name)]
+                                  (if c (assoc base0 :tag c) base0))
+                                base0)
                     node-meta (if has-doc (assoc base-meta :doc (nth items 2)) base-meta)]
                 (host-intern! ctx cur nm)
                 (def-node cur nm (analyze ctx val-form env) node-meta))))

test/chez/unit.edn

@@ -405,7 +405,7 @@
   {:suite "type" :expr "(type (random-uuid))" :expected ":jolt/uuid"}
   {:suite "type" :expr "(type (ex-info \"x\" {}))" :expected ":jolt/ex-info"}
   {:suite "var_meta" :expr "(do (def ^:private pv 1) (:private (meta (var pv))))" :expected "true"}
-  {:suite "var_meta" :expr "(do (def ^String tv \"a\") (:tag (meta (var tv))))" :expected "String"}
+  {:suite "var_meta" :expr "(do (def ^String tv \"a\") (:tag (meta (var tv))))" :expected "java.lang.String"}
   {:suite "var_meta" :expr "(do (def dv2 \"hi\" 1) (:doc (meta (var dv2))))" :expected "hi"}
   {:suite "var_meta" :expr "(do (def mv 1) (:name (meta (var mv))))" :expected "mv"}
   {:suite "var_meta" :expr "(do (def nv 1) (:ns (meta (var nv))))" :expected "user"}