(class x) returns a JVM-faithful Class value

class / .getClass now return a Class value that renders like the JVM —
(str c)/.toString -> "class <name>", pr -> "<name>", .getName/.getSimpleName/
.getCanonicalName work — but stays = and hash equal to its name string, so
(= (class x) String), class-keyed maps, multimethod dispatch on class, and
instance? keep working against the bare class-name tokens. instance? unwraps
a Class passed as the type arg.

clojure.test/class-match? no longer assumes (class e) is a string (a jolt-ism;
on the JVM a Class isn't a string either) — reads the name via .getName.

Matches JVM Class.toString, which libraries surface in error messages
(clojure.data.json DJSON-54 expects "...of class java.net.URI"). data.json
suite 139/139 bar the one UTF-16 surrogate test (Unicode-scalar char model).

5 corpus rows certified vs JVM; make test + shakesmoke green, 0 new divergences.
This commit is contained in:
Yogthos 2026-06-24 16:46:09 -04:00
parent 9092b30f8b
commit 8c7b98e5f2
5 changed files with 43 additions and 8 deletions

View file

@ -41,11 +41,17 @@
;; (thrown? Class …) match (records.ss ex-info-map?/ex-info-class). ;; (thrown? Class …) match (records.ss ex-info-map?/ex-info-class).
((ex-info-map? x) (ex-info-class x)) ((ex-info-map? x) (ex-info-class x))
(else (jolt-str-render-one (jolt-type x))))) (else (jolt-str-render-one (jolt-type x)))))
(define (jolt-class x) ;; the class NAME of x (string), or nil for nil. (class x) wraps it in a Class
;; value (make-class-obj, host-static-classes.ss) so it renders like a JVM Class
;; while staying = its name string.
(define (jolt-class-name x)
(let loop ((as jolt-class-arms)) (let loop ((as jolt-class-arms))
(cond ((null? as) (jolt-class-base x)) (cond ((null? as) (jolt-class-base x))
(((caar as) x) ((cdar as) x)) (((caar as) x) ((cdar as) x))
(else (loop (cdr as)))))) (else (loop (cdr as))))))
(define (jolt-class x)
(let ((n (jolt-class-name x)))
(if (jolt-nil? n) jolt-nil (make-class-obj n))))
(def-var! "clojure.core" "class" jolt-class) (def-var! "clojure.core" "class" jolt-class)

View file

@ -643,5 +643,29 @@
(else 'none)))) (else 'none))))
(if (eq? hit 'none) 'pass (if hit #t #f)))))) (if (eq? hit 'none) 'pass (if hit #t #f))))))
;; java.lang.Class value: (class x) / (.getClass x) return one. It renders like
;; the JVM — str/.toString -> "class <name>", pr -> "<name>", .getName -> "<name>"
;; — but stays = and hash equal to its name STRING, so (= (class x) String),
;; class-keyed maps/sets, multimethod dispatch on class, and instance? all keep
;; working against the bare class-name tokens.
(define (make-class-obj name) (make-jhost "class" (vector name)))
(define (jclass? x) (and (jhost? x) (string=? (jhost-tag x) "class")))
(define (jclass-name x) (vector-ref (jhost-state x) 0))
(define (class-key x) (cond ((jclass? x) (jclass-name x)) ((string? x) x) (else #f)))
(register-eq-arm! (lambda (a b) (or (jclass? a) (jclass? b)))
(lambda (a b) (let ((ka (class-key a)) (kb (class-key b)))
(and ka kb (string=? ka kb) #t))))
(register-hash-arm! jclass? (lambda (x) (jolt-hash (jclass-name x))))
(register-str-render! jclass? (lambda (x) (string-append "class " (jclass-name x))))
(register-pr-arm! jclass? (lambda (x) (jclass-name x)))
(register-host-methods! "class"
(list (cons "getName" (lambda (self) (jclass-name self)))
(cons "getCanonicalName" (lambda (self) (jclass-name self)))
(cons "getSimpleName" (lambda (self) (hsc-last-segment (jclass-name self))))
(cons "toString" (lambda (self) (string-append "class " (jclass-name self))))
(cons "isArray" (lambda (self) (let ((n (jclass-name self)))
(and (fx>? (string-length n) 0) (char=? (string-ref n 0) #\[)))))
(cons "getClass" (lambda (self) (make-class-obj "java.lang.Class")))))
;; (jolt.host/table? x) — is x a host tagged-table? ;; (jolt.host/table? x) — is x a host tagged-table?
(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f))) (def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))

View file

@ -72,11 +72,10 @@
((ex-info-map? val) (exception-isa? (last-dot (ex-info-class val)) (last-dot tname))) ((ex-info-map? val) (exception-isa? (last-dot (ex-info-class val)) (last-dot tname)))
(else (case-string tname val))))) (else (case-string tname val)))))
(define (instance-check type-sym val) (define (instance-check type-sym0 val)
;; normalize a bare (non-array) string class token to a symbol so every arm and ;; a Class value as the type arg (instance? (class x) y) -> use its name string.
;; the base table can read its name; array tokens ("[I") stay strings for the (let* ((type-sym (if (jclass? type-sym0) (jclass-name type-sym0) type-sym0))
;; natives-array arm. (ts (if (and (string? type-sym)
(let ((ts (if (and (string? type-sym)
(or (= 0 (string-length type-sym)) (or (= 0 (string-length type-sym))
(not (char=? (string-ref type-sym 0) #\[)))) (not (char=? (string-ref type-sym 0) #\[))))
(jolt-symbol #f type-sym) (jolt-symbol #f type-sym)

View file

@ -74,8 +74,9 @@
(let [w (last-seg wanted)] (let [w (last-seg wanted)]
(if (or (= w "Exception") (= w "Throwable")) (if (or (= w "Exception") (= w "Throwable"))
true true
(let [c (class e)] (let [c (class e)
(and (string? c) (= (last-seg c) w)))))) cn (cond (nil? c) nil (string? c) c :else (.getName c))]
(and cn (= (last-seg cn) w))))))
;; --- assertion macros ------------------------------------------------------ ;; --- assertion macros ------------------------------------------------------

View file

@ -548,6 +548,11 @@
{:suite "host-interop / class tokens & readers" :label "(class x) matches the token" :expected "true" :actual "(= String (class \"abc\"))"} {:suite "host-interop / class tokens & readers" :label "(class x) matches the token" :expected "true" :actual "(= String (class \"abc\"))"}
{:suite "host-interop / class tokens & readers" :label "defmulti on class dispatches" :expected ":str" :actual "(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))"} {:suite "host-interop / class tokens & readers" :label "defmulti on class dispatches" :expected ":str" :actual "(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))"}
{:suite "host-interop / class tokens & readers" :label "defmethod on nil dispatch value" :expected ":nil" :actual "(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))"} {:suite "host-interop / class tokens & readers" :label "defmethod on nil dispatch value" :expected ":nil" :actual "(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))"}
{:suite "host-interop / class tokens & readers" :label "Class str is class-prefixed" :expected "\"class java.lang.String\"" :actual "(str (class \"\"))"}
{:suite "host-interop / class tokens & readers" :label "Class getName" :expected "\"java.lang.String\"" :actual "(.getName (class \"\"))"}
{:suite "host-interop / class tokens & readers" :label "Class getSimpleName" :expected "\"Long\"" :actual "(.getSimpleName (class 5))"}
{:suite "host-interop / class tokens & readers" :label "Class of equal-typed values is =" :expected "true" :actual "(= (class 5) (class 6))"}
{:suite "host-interop / class tokens & readers" :label "Class in a thrown message" :expected "\"of class java.lang.String\"" :actual "(try (throw (Exception. (str \"of \" (class \"\")))) (catch Exception e (.getMessage e)))"}
{:suite "host-interop / class tokens & readers" :label "ctor sugar still constructs" :expected "\"x\"" :actual "(.toString (StringBuilder. \"x\"))"} {:suite "host-interop / class tokens & readers" :label "ctor sugar still constructs" :expected "\"x\"" :actual "(.toString (StringBuilder. \"x\"))"}
{:suite "host-interop / class tokens & readers" :label "return-hinted defn parses" :expected "7" :actual "(do (defn- hb ^bytes [b] b) (hb 7))"} {:suite "host-interop / class tokens & readers" :label "return-hinted defn parses" :expected "7" :actual "(do (defn- hb ^bytes [b] b) (hb 7))"}
{:suite "host-interop / class tokens & readers" :label "hinted multi-arity parses" :expected ":two" :actual "((fn ([x] :one) (^String [x y] :two)) 1 2)"} {:suite "host-interop / class tokens & readers" :label "hinted multi-arity parses" :expected ":two" :actual "((fn ([x] :one) (^String [x y] :two)) 1 2)"}