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

A fn def'd into a var reports a JVM-style class name (clojure.core$odd_QMARK_)

Browse source 
jolt fns reported (class f) = clojure.lang.IFn, so they carried no defining
symbol — clojure.spec.alpha's fn-sym (which reads a fn's class name to recover its
symbol) produced garbage, so explain-data's :pred for a bare-fn predicate was `/`
instead of e.g. clojure.core/keyword?.

Now def-var! records proc -> (ns . name) (first def of a proc wins, so an alias
like (def inc' inc) doesn't rename inc), and jolt-class-name returns "ns$munged"
for a known fn — matching the JVM, where (class odd?) is clojure.core$odd_QMARK_.
A munged fn class's ancestors include clojure.lang.AFunction's hierarchy
(IFn/AFn/Fn/Runnable/Callable), so (ancestors (class f)) still holds. Anonymous /
unregistered fns stay clojure.lang.IFn (fn-sym yields :unknown, as on the JVM).

This fixes explain-data / s/form / s/describe of bare-fn predicates in
clojure.spec.alpha (and unblocks parts of its suite + test.check's reporter test).

make test green (+1 corpus row, the (type inc) unit row updated to the JVM value),
shakesmoke byte-identical, runtime only (no re-mint).
This commit is contained in:
Yogthos 2026-06-27 21:03:12 -04:00
parent 10592fa746
commit 0becba7f93
5 changed files with 43 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -953,12 +953,21 @@
(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"))
;; A munged fn class name "ns$name" (jolt-class for a def'd fn) isn't in the table;
;; like the JVM (a fn extends clojure.lang.AFunction) its super is AFunction, whose
;; registered supers give AFn / IFn / Fn / Runnable / Callable transitively.
(define (str-has-dollar? s)
(let loop ((i 0)) (and (< i (string-length s)) (or (char=? (string-ref s i) #\$) (loop (+ i 1))))))
(define (class-direct-supers name)
(or (hashtable-ref class-supers-tbl name #f)
(and (str-has-dollar? name) '("clojure.lang.AFunction"))
'()))
;; transitive closure of direct supers (set semantics via an accumulator list)
(define (class-ancestors-list name)
(let loop ((pending (hashtable-ref class-supers-tbl name '())) (seen '()))
(let loop ((pending (class-direct-supers name)) (seen '()))
(cond ((null? pending) (reverse seen))
((member (car pending) seen) (loop (cdr pending) seen))
(else (loop (append (hashtable-ref class-supers-tbl (car pending) '()) (cdr pending))
(else (loop (append (class-direct-supers (car pending)) (cdr pending))
(cons (car pending) seen))))))
;; (instance? Class e) on a throwable tagged-table carrying a JVM :class matches the