From 7db5fabc8d6a68add42372daa86c00a530b4db69 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 21 Jun 2026 23:52:47 -0400 Subject: [PATCH] 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 | 16 ++++++++++++++-- host/chez/run-corpus.ss | 5 ++--- host/chez/seed/image.ss | 2 +- jolt-core/jolt/analyzer.clj | 16 ++++++++++++++-- test/chez/unit.edn | 2 +- 5 files changed, 32 insertions(+), 9 deletions(-) diff --git a/host/chez/host-class.ss b/host/chez/host-class.ss index 70e668d..9d9a333 100644 --- a/host/chez/host-class.ss +++ b/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 - (lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair))) +(define class-token-alist '(("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 diff --git a/host/chez/run-corpus.ss b/host/chez/run-corpus.ss index 603fb8d..b4f7cb9 100644 --- a/host/chez/run-corpus.ss +++ b/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" diff --git a/host/chez/seed/image.ss b/host/chez/seed/image.ss index bfdc0bf..f19bbf1 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -81,7 +81,7 @@ (guard (e (#t #f)) (def-var! "jolt.analyzer" "analyze-letfn" (letrec ((analyze-letfn (lambda (ctx items env) (let fnrec1601 ((ctx ctx) (items items) (env env)) (let* ((specs (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (names (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__49_) (let fnrec1610 ((p__49_ p__49_)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") p__49_)))))) specs)) (env* (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env names)) (binds (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (spec) (let fnrec1611 ((spec spec)) (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") spec)))) (let* ((_o$1612 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first cl))) (_o$1613 (jolt-invoke (var-deref "jolt.analyzer" "analyze-fn") ctx (jolt-invoke (var-deref "clojure.core" "vec") (jolt-cons (jolt-first cl) cl)) env*))) (jolt-vector _o$1612 _o$1613))))) specs))) (let* ((_o$1602 (keyword #f "op")) (_o$1603 (keyword #f "let")) (_o$1604 (keyword #f "letrec")) (_o$1605 #t) (_o$1606 (keyword #f "bindings")) (_o$1607 binds) (_o$1608 (keyword #f "body")) (_o$1609 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env*))) (jolt-hash-map _o$1602 _o$1603 _o$1604 _o$1605 _o$1606 _o$1607 _o$1608 _o$1609))))))) analyze-letfn))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-special" (letrec ((analyze-special (lambda (ctx op items env) (let fnrec1614 ((ctx ctx) (op op) (items items) (env env)) (let* ((G__39 op)) (if (jolt= G__39 "quote") (jolt-invoke (var-deref "jolt.ir" "quote-node") (jolt-invoke (var-deref "clojure.core" "second") items)) (if (jolt= G__39 "if") (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count items) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (> (jolt-count items) 4)))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Wrong number of args (" (jolt-dec (jolt-count items)) ") passed to: if")) jolt-nil) (jolt-invoke (var-deref "jolt.ir" "if-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env) (if (> (jolt-count items) 3) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 3) env) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil)))) (if (jolt= G__39 "do") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-rest items) env) (if (jolt= G__39 "throw") (jolt-invoke (var-deref "jolt.ir" "throw-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (if (jolt= G__39 "def") (let* ((name-sym (jolt-nth items 1))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") name-sym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "def name with map metadata") jolt-nil) (if (< (jolt-count items) 3) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$1630 (keyword #f "op")) (_o$1631 (keyword #f "def")) (_o$1632 (keyword #f "ns")) (_o$1633 cur) (_o$1634 (keyword #f "name")) (_o$1635 nm) (_o$1636 (keyword #f "no-init")) (_o$1637 #t)) (jolt-hash-map _o$1630 _o$1631 _o$1632 _o$1633 _o$1634 _o$1635 _o$1636 _o$1637)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (has-doc (let* ((and__13__auto (> (jolt-count items) 3))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "string?") (jolt-nth items 2)) and__13__auto))) (val-form (jolt-nth items (if (jolt-truthy? has-doc) 3 2))) (base-meta (let* ((or__14__auto (jolt-invoke (var-deref "jolt.host" "form-sym-meta") name-sym))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))) (node-meta (if (jolt-truthy? has-doc) (jolt-assoc base-meta (keyword #f "doc") (jolt-nth items 2)) base-meta))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (jolt-invoke (var-deref "jolt.ir" "def-node") cur nm (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx val-form env) node-meta)))))) (if (jolt= G__39 "let*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env))) (jolt-invoke (var-deref "jolt.ir" "let-node") (jolt-first r) (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) (jolt-invoke (var-deref "clojure.core" "second") r)))) (if (jolt= G__39 "loop*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") "loop")) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env)) (env** (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "clojure.core" "second") r) rname))) (let* ((_o$1622 (keyword #f "op")) (_o$1623 (keyword #f "loop")) (_o$1624 (keyword #f "recur-name")) (_o$1625 rname) (_o$1626 (keyword #f "bindings")) (_o$1627 (jolt-first r)) (_o$1628 (keyword #f "body")) (_o$1629 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env**))) (jolt-hash-map _o$1622 _o$1623 _o$1624 _o$1625 _o$1626 _o$1627 _o$1628 _o$1629))) (if (jolt= G__39 "recur") (let* ((rt (jolt-get env (keyword #f "recur")))) (begin (if (jolt-not rt) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "recur outside loop/fn") jolt-nil) (let* ((_o$1616 (keyword #f "op")) (_o$1617 (keyword #f "recur")) (_o$1618 (keyword #f "recur-name")) (_o$1619 rt) (_o$1620 (keyword #f "args")) (_o$1621 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__50_) (let fnrec1615 ((p__50_ p__50_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__50_ env))) (jolt-rest items)))) (jolt-hash-map _o$1616 _o$1617 _o$1618 _o$1619 _o$1620 _o$1621)))) (if (jolt= G__39 "try") (jolt-invoke (var-deref "jolt.analyzer" "analyze-try") ctx items env) (if (jolt= G__39 "letfn") (jolt-invoke (var-deref "jolt.analyzer" "analyze-letfn") ctx items env) (if (jolt= G__39 "fn*") (jolt-invoke (var-deref "jolt.analyzer" "analyze-fn") ctx items env) (if (jolt= G__39 "syntax-quote") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-syntax-quote-lower") ctx (jolt-invoke (var-deref "clojure.core" "second") items)) env) (if (jolt= G__39 "var") (let* ((sym (jolt-invoke (var-deref "clojure.core" "second") items)) (r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx sym))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (jolt-invoke (var-deref "jolt.ir" "the-var") (jolt-get r (keyword #f "ns")) (jolt-get r (keyword #f "name"))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "var of non-var " (jolt-invoke (var-deref "jolt.host" "form-sym-name") sym))))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " op)))))))))))))))))))) analyze-special))) + (def-var! "jolt.analyzer" "analyze-special" (letrec ((analyze-special (lambda (ctx op items env) (let fnrec1614 ((ctx ctx) (op op) (items items) (env env)) (let* ((G__39 op)) (if (jolt= G__39 "quote") (jolt-invoke (var-deref "jolt.ir" "quote-node") (jolt-invoke (var-deref "clojure.core" "second") items)) (if (jolt= G__39 "if") (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count items) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (> (jolt-count items) 4)))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Wrong number of args (" (jolt-dec (jolt-count items)) ") passed to: if")) jolt-nil) (jolt-invoke (var-deref "jolt.ir" "if-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env) (if (> (jolt-count items) 3) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 3) env) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil)))) (if (jolt= G__39 "do") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-rest items) env) (if (jolt= G__39 "throw") (jolt-invoke (var-deref "jolt.ir" "throw-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (if (jolt= G__39 "def") (let* ((name-sym (jolt-nth items 1))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") name-sym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "def name with map metadata") jolt-nil) (if (< (jolt-count items) 3) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$1630 (keyword #f "op")) (_o$1631 (keyword #f "def")) (_o$1632 (keyword #f "ns")) (_o$1633 cur) (_o$1634 (keyword #f "name")) (_o$1635 nm) (_o$1636 (keyword #f "no-init")) (_o$1637 #t)) (jolt-hash-map _o$1630 _o$1631 _o$1632 _o$1633 _o$1634 _o$1635 _o$1636 _o$1637)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (has-doc (let* ((and__13__auto (> (jolt-count items) 3))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "string?") (jolt-nth items 2)) and__13__auto))) (val-form (jolt-nth items (if (jolt-truthy? has-doc) 3 2))) (base0 (let* ((or__14__auto (jolt-invoke (var-deref "jolt.host" "form-sym-meta") name-sym))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))) (tag (jolt-get base0 (keyword #f "tag"))) (tag-name (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") tag)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") tag) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") tag)) tag (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))) (base-meta (if (jolt-truthy? tag-name) (let* ((c (jolt-invoke (var-deref "jolt.host" "resolve-class-hint") tag-name))) (if (jolt-truthy? c) (jolt-assoc base0 (keyword #f "tag") c) base0)) base0)) (node-meta (if (jolt-truthy? has-doc) (jolt-assoc base-meta (keyword #f "doc") (jolt-nth items 2)) base-meta))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (jolt-invoke (var-deref "jolt.ir" "def-node") cur nm (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx val-form env) node-meta)))))) (if (jolt= G__39 "let*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env))) (jolt-invoke (var-deref "jolt.ir" "let-node") (jolt-first r) (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) (jolt-invoke (var-deref "clojure.core" "second") r)))) (if (jolt= G__39 "loop*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") "loop")) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env)) (env** (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "clojure.core" "second") r) rname))) (let* ((_o$1622 (keyword #f "op")) (_o$1623 (keyword #f "loop")) (_o$1624 (keyword #f "recur-name")) (_o$1625 rname) (_o$1626 (keyword #f "bindings")) (_o$1627 (jolt-first r)) (_o$1628 (keyword #f "body")) (_o$1629 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env**))) (jolt-hash-map _o$1622 _o$1623 _o$1624 _o$1625 _o$1626 _o$1627 _o$1628 _o$1629))) (if (jolt= G__39 "recur") (let* ((rt (jolt-get env (keyword #f "recur")))) (begin (if (jolt-not rt) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "recur outside loop/fn") jolt-nil) (let* ((_o$1616 (keyword #f "op")) (_o$1617 (keyword #f "recur")) (_o$1618 (keyword #f "recur-name")) (_o$1619 rt) (_o$1620 (keyword #f "args")) (_o$1621 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__50_) (let fnrec1615 ((p__50_ p__50_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__50_ env))) (jolt-rest items)))) (jolt-hash-map _o$1616 _o$1617 _o$1618 _o$1619 _o$1620 _o$1621)))) (if (jolt= G__39 "try") (jolt-invoke (var-deref "jolt.analyzer" "analyze-try") ctx items env) (if (jolt= G__39 "letfn") (jolt-invoke (var-deref "jolt.analyzer" "analyze-letfn") ctx items env) (if (jolt= G__39 "fn*") (jolt-invoke (var-deref "jolt.analyzer" "analyze-fn") ctx items env) (if (jolt= G__39 "syntax-quote") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-syntax-quote-lower") ctx (jolt-invoke (var-deref "clojure.core" "second") items)) env) (if (jolt= G__39 "var") (let* ((sym (jolt-invoke (var-deref "clojure.core" "second") items)) (r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx sym))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (jolt-invoke (var-deref "jolt.ir" "the-var") (jolt-get r (keyword #f "ns")) (jolt-get r (keyword #f "name"))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "var of non-var " (jolt-invoke (var-deref "jolt.host" "form-sym-name") sym))))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " op)))))))))))))))))))) analyze-special))) (guard (e (#t #f)) (def-var! "jolt.analyzer" "method-head?" (letrec ((method-head? (lambda (nm) (let fnrec1638 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 1))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 0 1)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not (jolt= "-" (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))) and__13__auto)) and__13__auto)) and__13__auto)))))) method-head?))) (guard (e (#t #f)) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index e043255..88f32d6 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/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)))) diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 326920e..5c3767c 100644 --- a/test/chez/unit.edn +++ b/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"}