Map raw Chez runtime errors to their JVM exception classes

A wrong-arity or non-seqable error that Chez raises carried no jolt exception
class, so (class e) was :object and (thrown? ArityException …) / (thrown?
IllegalArgumentException …) never matched. Classify these by message:
incorrect-number-of-arguments -> clojure.lang.ArityException, not-seqable ->
java.lang.IllegalArgumentException, with ArityException modeled as a subclass of
IllegalArgumentException. (class e) and instance? now match the JVM.

All java-layer (records-interop.ss classifies, host-class.ss reports the class +
the ArityException token). medley 281 -> 283 passing.

jolt-o9dc

host/chez/java/host-class.ss

@@ -54,6 +54,14 @@
 ;; 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.
+;; a raw Chez condition Clojure raises a specific class for (records-interop.ss
+;; chez-condition-exc-class) reports that JVM class, so (class e) and a
+;; (thrown? ArityException …) test match — not the opaque :object fallback.
+(register-class-arm!
+  (lambda (x) (and (chez-condition-exc-class x) #t))
+  (lambda (x) (if (string=? (chez-condition-exc-class x) "ArityException")
+                  "clojure.lang.ArityException"
+                  "java.lang.IllegalArgumentException")))
 (define (jolt-class-name x)
   (let loop ((as jolt-class-arms))
     (cond ((null? as) (jolt-class-base x))
@@ -94,6 +102,7 @@
     ("Charset" . "java.nio.charset.Charset") ("Base64" . "java.util.Base64")
     ("Exception" . "java.lang.Exception")
     ("IllegalArgumentException" . "java.lang.IllegalArgumentException")
+    ("ArityException" . "clojure.lang.ArityException")
     ("IllegalStateException" . "java.lang.IllegalStateException")
     ("RuntimeException" . "java.lang.RuntimeException")
     ("UnsupportedOperationException" . "java.lang.UnsupportedOperationException")
@@ -165,7 +174,7 @@
     "java.lang.IndexOutOfBoundsException" "java.io.FileNotFoundException"
     "java.io.UnsupportedEncodingException"
     ;; clojure.lang.ExceptionInfo / IExceptionInfo compared against (class e)
-    "clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo"
+    "clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo" "clojure.lang.ArityException"
     "java.util.regex.Pattern" "java.net.URI" "java.util.UUID"
     "clojure.lang.PersistentQueue"
     "clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.Atom"))

host/chez/java/records-interop.ss

@@ -16,6 +16,7 @@
   '(("ExceptionInfo" . "RuntimeException")
     ("RuntimeException" . "Exception")
     ("IllegalArgumentException" . "RuntimeException")
+    ("ArityException" . "IllegalArgumentException")
     ("NumberFormatException" . "IllegalArgumentException")
     ("IllegalStateException" . "RuntimeException")
     ("UnsupportedOperationException" . "RuntimeException")
@@ -51,6 +52,24 @@
           ((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
           (else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
 
+;; A raw Chez condition (an arity or non-seqable error Chez itself raised, not a
+;; jolt ex-info) carries no jolt exception class. Map the ones Clojure raises a
+;; specific class for, by message, so (class e) and (instance? C e) match the JVM.
+;; Returns a simple class name or #f.
+(define (ri-substring? needle hay)
+  (let ((nl (string-length needle)) (hl (string-length hay)))
+    (let loop ((i 0))
+      (cond ((> (+ i nl) hl) #f)
+            ((string=? needle (substring hay i (+ i nl))) #t)
+            (else (loop (+ i 1)))))))
+(define (chez-condition-exc-class v)
+  (and (condition? v) (message-condition? v)
+       (let ((m (condition-message v)))
+         (and (string? m)
+              (cond ((ri-substring? "incorrect number of arguments" m) "ArityException")
+                    ((ri-substring? "not seqable" m) "IllegalArgumentException")
+                    (else #f))))))
+
 ;; instance-check: (type-sym val) — type/protocol membership. Host shims loaded
 ;; later (io, inst-time, natives-array, natives-queue, host-static-classes)
 ;; register an arm with register-instance-check-arm! instead of set!-wrapping
@@ -61,6 +80,13 @@
 (define (register-instance-check-arm! f)   ; f: (type-sym val) -> #t | #f | 'pass
   (set! instance-check-registry (cons f instance-check-registry)))
 
+;; (instance? C raw-condition): match when C is the condition's mapped class or a
+;; supertype of it (ArityException is also an IllegalArgumentException, etc.).
+(register-instance-check-arm!
+  (lambda (type-sym val)
+    (let ((k (chez-condition-exc-class val)))
+      (if k (if (exception-isa? k (last-dot (symbol-t-name type-sym))) #t #f) 'pass))))
+
 (define (instance-check-base type-sym val)
   (let ((tname (symbol-t-name type-sym)))
     (cond

test/chez/corpus.edn

@@ -1834,6 +1834,9 @@
   {:suite "dynamic vars / portable defaults" :label "binding *read-eval*" :expected "false" :actual "(binding [*read-eval* false] *read-eval*)"}
   {:suite "special forms / letfn" :label "mutual recursion" :expected "true" :actual "(letfn [(e? [n] (if (zero? n) true (o? (dec n)))) (o? [n] (if (zero? n) false (e? (dec n))))] (e? 10))"}
   {:suite "core vars / present and callable" :label "*out* *err* *warn-on-reflection* await restart-agent" :expected "[true true false true true]" :actual "[(boolean *out*) (boolean *err*) *warn-on-reflection* (ifn? await) (ifn? restart-agent)]"}
+  {:suite "exceptions / runtime error classes" :label "arity error is ArityException" :expected "true" :actual "(instance? clojure.lang.ArityException (try ((fn [a b] a) 1) (catch Throwable e e)))"}
+  {:suite "exceptions / runtime error classes" :label "ArityException is an IllegalArgumentException" :expected "true" :actual "(instance? IllegalArgumentException (try ((fn [a b] a) 1) (catch Throwable e e)))"}
+  {:suite "exceptions / runtime error classes" :label "non-seqable is IllegalArgumentException" :expected "true" :actual "(instance? IllegalArgumentException (try (doall (mapcat identity 0)) (catch Throwable e e)))"}
   {:suite "dynamic vars / portable defaults" :label "*data-readers* map, *math-context* nil" :expected "[true true]" :actual "[(map? *data-readers*) (nil? *math-context*)]"}
   {:suite "regex / re-pattern & string ops" :label "re-pattern build" :expected "\"hi\"" :actual "(re-find (re-pattern \"\\\\w+\") \"hi!\")"}
   {:suite "regex / re-pattern & string ops" :label "re-pattern is regex?" :expected "true" :actual "(regex? (re-pattern \"a\"))"}