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

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).

host/chez/java/host-class.ss

@@ -62,6 +62,26 @@
   (lambda (x) (if (string=? (chez-condition-exc-class x) "ArityException")
                   "clojure.lang.ArityException"
                   "java.lang.IllegalArgumentException")))
+;; A fn def'd into a var reports a JVM-style class name "ns$munged-name" (the
+;; forward CHAR_MAP), so clojure.spec.alpha's fn-sym (which splits on $ and
+;; demunges) recovers the predicate's symbol. Anonymous / unregistered fns stay
+;; clojure.lang.IFn (fn-sym yields :unknown, as on the JVM).
+(define class-munge-map
+  '((#\? . "_QMARK_") (#\! . "_BANG_") (#\* . "_STAR_") (#\+ . "_PLUS_")
+    (#\> . "_GT_") (#\< . "_LT_") (#\= . "_EQ_") (#\/ . "_SLASH_") (#\- . "_")
+    (#\& . "_AMPERSAND_") (#\% . "_PERCENT_") (#\~ . "_TILDE_") (#\^ . "_CARET_")
+    (#\| . "_BAR_") (#\: . "_COLON_")))
+(define (class-munge-name s)
+  (let ((out (open-output-string)))
+    (string-for-each
+     (lambda (c) (let ((t (assv c class-munge-map))) (if t (display (cdr t) out) (write-char c out))))
+     s)
+    (get-output-string out)))
+(register-class-arm!
+  (lambda (x) (and (procedure? x) (hashtable-ref proc-name-tbl x #f)))
+  (lambda (x) (let ((p (hashtable-ref proc-name-tbl x #f)))
+                (string-append (car p) "$" (class-munge-name (cdr p))))))
+
 (define (jolt-class-name x)
   (let loop ((as jolt-class-arms))
     (cond ((null? as) (jolt-class-base x))

host/chez/java/host-static-classes.ss

@@ -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

host/chez/rt.ss

@@ -114,7 +114,16 @@
 ;; evaluates to #'ns/name (a first-class var), so (var? (def x 1)) is true and
 ;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the
 ;; return, so this is transparent there.
-(define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c))
+;; proc -> (ns . name) for the var it was def'd into, so (class a-fn) can report a
+;; JVM-style class name and clojure.spec.alpha's fn-sym can recover the symbol of a
+;; bare-fn predicate. Weak so GC'd fns drop out. Last def of a given proc wins.
+(define proc-name-tbl (make-weak-eq-hashtable))
+(define (def-var! ns name v)
+  ;; first def of a given proc wins, so an alias like (def inc' inc) — which binds
+  ;; the SAME proc to a second var — doesn't rename inc.
+  (when (and (procedure? v) (not (hashtable-contains? proc-name-tbl v)))
+    (hashtable-set! proc-name-tbl v (cons ns name)))
+  (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c))
 ;; jolt.host/throwable — build a typed throwable a library can throw so (class …),
 ;; instance?, .getMessage and ex-message all reflect the named JVM class (e.g. an
 ;; http client throwing java.net.ConnectException). Strictly better than a

test/chez/corpus.edn

@@ -3387,5 +3387,6 @@
   {:suite "host-interop / UUID + Long + shiftLeft" :label "(UUID. msb lsb), .shiftLeft, (Long. n)" :expected "[\"00000000-0000-007b-0000-0000000001c8\" 40 10 42]" :actual "[(str (java.util.UUID. 123 456)) (.shiftLeft 5 3) (.shiftRight 40 2) (Long. 42)]"}
   {:suite "host-interop / ThreadLocal proxy" :label "(proxy [ThreadLocal] [] (initialValue [] v)) get/set" :expected "[42 7]" :actual "(let [tl (proxy [ThreadLocal] [] (initialValue [] 42))] [(.get tl) (do (.set tl 7) (.get tl))])"}
   {:suite "host-interop / Compiler/demunge" :label "demunge reverses name munging" :expected "\"a/b?\"" :actual "(clojure.lang.Compiler/demunge \"a$b_QMARK_\")"}
+  {:suite "host-interop / a fn reports its munged class" :label "(class a-def'd-fn) is ns$munged-name, with the IFn hierarchy as ancestors" :expected "[\"clojure.core$odd_QMARK_\" true]" :actual "[(.getName (class odd?)) (boolean (some #{java.lang.Runnable} (ancestors (class odd?))))]"}
   {:suite "host-interop / MultiFn methods" :label ".getMethod / .dispatchFn on a multimethod" :expected "[true true true]" :actual "(do (defmulti mmc identity) (defmethod mmc :a [_] 1) [(some? (.getMethod mmc :a)) (nil? (.getMethod mmc :z)) (ifn? (.dispatchFn mmc))])"}
 ]

test/chez/unit.edn

@@ -479,7 +479,7 @@
   {:suite "type" :expr "(type (filter odd? [1 2 3]))" :expected "clojure.lang.PersistentList"}
   {:suite "type" :expr "(type (lazy-seq (cons 1 nil)))" :expected "clojure.lang.LazySeq"}
   {:suite "type" :expr "(type (take 2 (iterate inc 0)))" :expected "clojure.lang.PersistentList"}
-  {:suite "type" :expr "(type inc)" :expected "clojure.lang.IFn"}
+  {:suite "type" :expr "(type inc)" :expected "clojure.core$inc"}
   {:suite "type" :expr "(type (sorted-map :a 1))" :expected ":map"}
   {:suite "type" :expr "(type (sorted-set 1))" :expected ":jolt/sorted-set"}
   {:suite "type" :expr "(type (with-meta [1] {:type :custom}))" :expected ":custom"}