simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Class/forName honesty + class/isa? conformance for builtins (#243)

Browse source 
Class/forName claimed every java.*/clojure.* name found (and any "x.y.Class"
matched the registered Class via a short-name fallback), so a library's
(class-found? "optional.Dep") feature-probe always said yes — tools.logging then
tried to build the java.util.logging / log4j backends jolt lacks and crashed.
Resolve forName by exact registry lookup + an honest prefix that excludes the
unbacked optional packages (java.util.logging, javax.management), so the probe
sees them absent and skips the backend.

class of a persistent collection / namespace now reports its JVM class name
(clojure.lang.PersistentHashSet, …Namespace, …) instead of jolt's internal :set/
:object tag, and isa? consults JVM class assignability — Object as every class's
root plus a modeled clojure.lang/java.util hierarchy — so (isa? (class x) C) and a
class-keyed multimethod dispatch like the JVM (e.g. (isa? Keyword Object) was
false). Adds the bare class tokens (Fn/Namespace/Set/…) these dispatch on.

(type x) is unchanged — it keeps jolt's documented internal-keyword form. Six
JVM-certified corpus rows. make test green, 0 new divergences.

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-26 21:02:44 +00:00 • committed by GitHub
parent 283a0f0eec
commit 6c03dffd00
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
6 changed files with 80 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

25
host/chez/java/host-class.ss
View file

@ -40,6 +40,16 @@
;; class, so (= clojure.lang.ExceptionInfo (class e)) and clojure.test's
;; (thrown? Class …) match (records.ss ex-info-map?/ex-info-class).
((ex-info-map? x) (ex-info-class x))
;; persistent collections + namespace report their JVM class names (not jolt's
;; internal :vector/:set/… type keyword), so class-based dispatch — e.g. a
;; defmulti on [(class a) (class b)] — sees a real clojure.lang.* class.
((jns? x) "clojure.lang.Namespace")
((pvec? x) "clojure.lang.PersistentVector")
((pset? x) "clojure.lang.PersistentHashSet")
((pmap? x) "clojure.lang.PersistentArrayMap")
((jolt-lazyseq? x) "clojure.lang.LazySeq")
((empty-list-t? x) "clojure.lang.PersistentList$EmptyList")
((cseq? x) "clojure.lang.PersistentList")
(else (jolt-str-render-one (jolt-type 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
@ -93,7 +103,20 @@
("IndexOutOfBoundsException" . "java.lang.IndexOutOfBoundsException")
("UnsupportedEncodingException" . "java.io.UnsupportedEncodingException")
("FileNotFoundException" . "java.io.FileNotFoundException")
("Throwable" . "java.lang.Throwable")))
("Throwable" . "java.lang.Throwable")
;; clojure.lang / java.util types that class-based multimethods dispatch on.
("Fn" . "clojure.lang.Fn") ("IFn" . "clojure.lang.IFn")
("Namespace" . "clojure.lang.Namespace") ("Named" . "clojure.lang.Named")
("Set" . "java.util.Set") ("List" . "java.util.List") ("Map" . "java.util.Map")
("Collection" . "java.util.Collection") ("Iterable" . "java.lang.Iterable")
("CharSequence" . "java.lang.CharSequence") ("Comparable" . "java.lang.Comparable")
("Runnable" . "java.lang.Runnable") ("Callable" . "java.util.concurrent.Callable")
("IPersistentSet" . "clojure.lang.IPersistentSet")
("IPersistentVector" . "clojure.lang.IPersistentVector")
("IPersistentMap" . "clojure.lang.IPersistentMap")
("IPersistentCollection" . "clojure.lang.IPersistentCollection")
("Sequential" . "clojure.lang.Sequential") ("Seqable" . "clojure.lang.Seqable")
("Associative" . "clojure.lang.Associative")))
(for-each
(lambda (pair) (def-var! "clojure.core" (car pair) (cdr pair)))
class-token-alist)

33
host/chez/java/host-static-classes.ss
View file

@ -848,6 +848,21 @@
(reg-class-supers! "java.net.UnknownHostException" '("java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.ConnectException" '("java.net.SocketException" "java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
(reg-class-supers! "java.net.SocketTimeoutException" '("java.io.InterruptedIOException" "java.io.IOException" "java.lang.Exception" "java.lang.Throwable" "java.lang.Object"))
;; clojure.lang / java.util ancestry for the builtins (class) reports, so a
;; class-keyed multimethod / (isa? (class x) SomeClass) dispatches like the JVM.
;; (Object is supplied universally by class-isa?, so it need not be listed.)
(reg-class-supers! "clojure.lang.IFn" '("clojure.lang.Fn" "java.lang.Runnable" "java.util.concurrent.Callable"))
(reg-class-supers! "clojure.lang.Keyword" '("clojure.lang.Named" "java.lang.Comparable"))
(reg-class-supers! "clojure.lang.Symbol" '("clojure.lang.Named" "java.lang.Comparable"))
(reg-class-supers! "java.lang.String" '("java.lang.CharSequence" "java.lang.Comparable"))
(reg-class-supers! "clojure.lang.PersistentHashSet" '("clojure.lang.APersistentSet" "clojure.lang.IPersistentSet" "clojure.lang.IPersistentCollection" "java.util.Set" "java.util.Collection" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentTreeSet" '("clojure.lang.APersistentSet" "clojure.lang.IPersistentSet" "clojure.lang.IPersistentCollection" "java.util.Set" "java.util.Collection" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentVector" '("clojure.lang.APersistentVector" "clojure.lang.IPersistentVector" "clojure.lang.IPersistentCollection" "clojure.lang.Sequential" "clojure.lang.Associative" "java.util.List" "java.util.Collection" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentArrayMap" '("clojure.lang.APersistentMap" "clojure.lang.IPersistentMap" "clojure.lang.IPersistentCollection" "clojure.lang.Associative" "java.util.Map" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentHashMap" '("clojure.lang.APersistentMap" "clojure.lang.IPersistentMap" "clojure.lang.IPersistentCollection" "clojure.lang.Associative" "java.util.Map" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentList" '("clojure.lang.ASeq" "clojure.lang.ISeq" "clojure.lang.IPersistentCollection" "clojure.lang.Sequential" "clojure.lang.Seqable" "java.util.List" "java.util.Collection" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.LazySeq" '("clojure.lang.ISeq" "clojure.lang.IPersistentCollection" "clojure.lang.Sequential" "clojure.lang.Seqable" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.Cons" '("clojure.lang.ASeq" "clojure.lang.ISeq" "clojure.lang.Sequential" "clojure.lang.Seqable" "java.lang.Iterable"))
;; transitive closure of direct supers (set semantics via an accumulator list)
(define (class-ancestors-list name)
@ -875,6 +890,24 @@
(else (loop (cdr names))))))
'pass)))
;; JVM class assignability for isa? (20-coll): true when child and parent are both
;; class values and parent is child, java.lang.Object (every class's root), or a
;; modeled ancestor of child (full name or last segment). nil for non-class args, so
;; isa? falls through to its hierarchy/vector logic.
(def-var! "jolt.host" "class-isa?"
(lambda (child parent)
(let ((cc (class-key child)) (pp (class-key parent)))
(if (and cc pp)
(let ((pseg (hsc-last-segment pp)))
(if (let loop ((names (cons cc (class-ancestors-list cc))))
(cond ((string=? pp "java.lang.Object") #t)
((null? names) #f)
((or (string=? pp (car names))
(string=? pseg (hsc-last-segment (car names)))) #t)
(else (loop (cdr names)))))
#t jolt-nil))
jolt-nil))))
;; (jolt.host/class-supers name) / (jolt.host/class-ancestors name) — a jolt seq of
;; super / ancestor class-name strings, or nil when jolt models no hierarchy for it.
(def-var! "jolt.host" "class-supers"

16
host/chez/java/host-static-methods.ss
View file

@ -214,12 +214,22 @@
;; class object; anything else throws a catchable ClassNotFoundException, like the
;; JVM — so the common `(try (Class/forName "optional.Dep") (catch …))` probe a
;; library uses to detect an absent dependency works (e.g. ring's joda-time check).
;; java.* / clojure.* packages jolt does NOT back, even though the broad prefix
;; below would otherwise claim them — optional backends a library feature-probes
;; with (Class/forName …) (e.g. tools.logging's java.util.logging / log4j). Listing
;; them here keeps class-found? honest so the probe sees them absent and skips the
;; backend (jolt has its own logging) instead of trying to use it and crashing.
(define forname-absent-prefixes
'("java.util.logging." "javax.management." "java.lang.management."))
(define (forname-known? nm)
(or (lookup-class class-statics-tbl nm)
(lookup-class class-ctors-tbl nm)
;; exact lookups only — lookup-class would fall back to the short class name, so
;; any "x.y.Class" would spuriously match the registered java.lang.Class.
(or (hashtable-ref class-statics-tbl nm #f)
(hashtable-ref class-ctors-tbl nm #f)
(let ((pre? (lambda (p) (and (>= (string-length nm) (string-length p))
(string=? (substring nm 0 (string-length p)) p)))))
(or (pre? "java.") (pre? "clojure.") (pre? "jolt.")))))
(and (or (pre? "java.") (pre? "clojure.") (pre? "jolt."))
(not (exists pre? forname-absent-prefixes))))))
(register-class-statics! "Class"
(list (cons "forName"
(lambda (nm . _)

2
host/chez/seed/prelude.ss
View file

@ -263,7 +263,7 @@
(guard (e (#t #f))
(def-var-with-meta! "clojure.core" "global-hierarchy" (jolt-invoke (var-deref "clojure.core" "atom") (jolt-invoke (var-deref "clojure.core" "make-hierarchy"))) (let* ((_o$4454 (keyword #f "private")) (_o$4455 #t)) (jolt-hash-map _o$4454 _o$4455))))
(guard (e (#t #f))
(def-var! "clojure.core" "isa?" (letrec ((isa? (case-lambda ((child parent) (let fnrec4456 ((child child) (parent parent)) (isa? (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "clojure.core" "global-hierarchy")) child parent))) ((h child parent) (let fnrec4457 ((h h) (child child) (parent parent)) (let* ((or__26__auto (jolt= child parent))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((or__26__auto (jolt-contains? (let* ((_a$4458 (jolt-get h (keyword #f "ancestors"))) (_a$4459 child) (_a$4460 (jolt-hash-set))) (jolt-get _a$4458 _a$4459 _a$4460)) parent))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "vector?") parent))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "vector?") child))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (let* ((_a$4461 (jolt-count parent)) (_a$4462 (jolt-count child))) (jolt= _a$4461 _a$4462)))) (if (jolt-truthy? and__25__auto) (let* ((ret #t) (i 0)) (let loop4463 ((ret ret) (i i)) (if (let* ((or__26__auto (jolt-not ret))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt= i (jolt-count parent)))) ret (let* ((_a$4467 (let* ((_a$4464 h) (_a$4465 (jolt-nth child i)) (_a$4466 (jolt-nth parent i))) (isa? _a$4464 _a$4465 _a$4466))) (_a$4468 (jolt-inc i))) (loop4463 _a$4467 _a$4468))))) and__25__auto)) and__25__auto)) and__25__auto))))))))))) isa?)))
(def-var! "clojure.core" "isa?" (letrec ((isa? (case-lambda ((child parent) (let fnrec4456 ((child child) (parent parent)) (isa? (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "clojure.core" "global-hierarchy")) child parent))) ((h child parent) (let fnrec4457 ((h h) (child child) (parent parent)) (let* ((or__26__auto (jolt= child parent))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((or__26__auto (jolt-invoke (var-deref "jolt.host" "class-isa?") child parent))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((or__26__auto (jolt-contains? (let* ((_a$4458 (jolt-get h (keyword #f "ancestors"))) (_a$4459 child) (_a$4460 (jolt-hash-set))) (jolt-get _a$4458 _a$4459 _a$4460)) parent))) (if (jolt-truthy? or__26__auto) or__26__auto (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "vector?") parent))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (jolt-invoke (var-deref "clojure.core" "vector?") child))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (let* ((_a$4461 (jolt-count parent)) (_a$4462 (jolt-count child))) (jolt= _a$4461 _a$4462)))) (if (jolt-truthy? and__25__auto) (let* ((ret #t) (i 0)) (let loop4463 ((ret ret) (i i)) (if (let* ((or__26__auto (jolt-not ret))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt= i (jolt-count parent)))) ret (let* ((_a$4467 (let* ((_a$4464 h) (_a$4465 (jolt-nth child i)) (_a$4466 (jolt-nth parent i))) (isa? _a$4464 _a$4465 _a$4466))) (_a$4468 (jolt-inc i))) (loop4463 _a$4467 _a$4468))))) and__25__auto)) and__25__auto)) and__25__auto))))))))))))) isa?)))
(guard (e (#t #f))
(def-var! "clojure.core" "parents" (letrec ((parents (case-lambda ((tag) (let fnrec4469 ((tag tag)) (parents (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "clojure.core" "global-hierarchy")) tag))) ((h tag) (let fnrec4470 ((h h) (tag tag)) (jolt-invoke (var-deref "clojure.core" "not-empty") (jolt-get (jolt-get h (keyword #f "parents")) tag))))))) parents)))
(guard (e (#t #f))