Typed-array identity + JVM flonum printing (Inc 3)

host/chez/host-static.ss

@@ -208,7 +208,12 @@
   (list (cons "valueOf" (lambda (x . _) (if (jolt-nil? x) "null" (jolt-str-render-one x))))))
 
 (register-class-statics! "Class"
-  (list (cons "forName" (lambda (nm) (make-jhost "class" (list (cons 'name nm)))))))
+  ;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and
+  ;; class compare equal); other names become a class jhost.
+  (list (cons "forName" (lambda (nm)
+                          (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[))
+                              nm
+                              (make-jhost "class" (list (cons 'name nm))))))))
 
 ;; ---- System helpers (defined before use above via top-level order) ----------
 (define (sys-get-property k . dflt)

host/chez/natives-array.ss

@@ -8,6 +8,14 @@
 
 (define-record-type jolt-array (fields (mutable vec) kind) (nongenerative jolt-array-v1))
 
+;; JVM array class name per element kind ((class (int-array 3)) -> "[I", like the
+;; JVM's Class.getName for arrays). Object arrays use the descriptor form.
+(define (na-array-class-name arr)
+  (case (jolt-array-kind arr)
+    ((int) "[I") ((long) "[J") ((short) "[S") ((double) "[D")
+    ((float) "[F") ((boolean) "[Z") ((byte) "[B") ((char) "[C")
+    (else "[Ljava.lang.Object;")))
+
 (define (na-idx i) (if (and (number? i) (not (exact? i))) (exact (floor i)) i))
 (define (na-from-seq x kind) (make-jolt-array (list->vector (seq->list (jolt-seq x))) kind))
 ;; (T-array size) | (T-array size init) | (T-array seq)
@@ -22,13 +30,22 @@
 
 ;; --- constructors -----------------------------------------------------------
 (define (na-object-array a . rest)  (na-num-array a rest jolt-nil 'object))
-(define (na-int-array a . rest)     (na-num-array a rest 0.0 'int))
-(define (na-long-array a . rest)    (na-num-array a rest 0.0 'long))
-(define (na-short-array a . rest)   (na-num-array a rest 0.0 'short))
+;; integer kinds default to exact 0 (JVM int/long/short 0 -> "0", not "0.0").
+(define (na-int-array a . rest)     (na-num-array a rest 0 'int))
+(define (na-long-array a . rest)    (na-num-array a rest 0 'long))
+(define (na-short-array a . rest)   (na-num-array a rest 0 'short))
 (define (na-double-array a . rest)  (na-num-array a rest 0.0 'double))
 (define (na-float-array a . rest)   (na-num-array a rest 0.0 'float))
 (define (na-boolean-array a . rest) (na-num-array a rest #f 'boolean))
-;; char-array stays in io.ss (a char-SEQ that io/reader / str / slurp consume).
+;; char-array is a real 'char array (instance? "[C"), seqing as chars via the
+;; dispatchers below — io/reader (extended here) and str/slurp consume the seq.
+(define (na-char-array a . rest)
+  (cond
+    ((string? a) (make-jolt-array (list->vector (string->list a)) 'char))
+    ((number? a) (make-jolt-array (make-vector (exact (na-idx a)) #\nul) 'char))
+    (else (make-jolt-array
+           (list->vector (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c)))))
+                              (seq->list (jolt-seq a)))) 'char))))
 (define (na-byte-array a . rest)
   (if (number? a)
       (make-jolt-array (make-vector (exact (na-idx a)) (na-byte-of (if (pair? rest) (car rest) 0))) 'byte)
@@ -102,6 +119,37 @@
         (%na-ref-put! t k v))))
 (def-var! "jolt.host" "ref-put!" jolt-ref-put!)
 
+;; --- array identity: type / class / instance? recognize arrays ---------------
+;; (type arr) / (class arr) -> the JVM array class name; (class …) delegates to
+;; (jolt-type …) for arrays, so extending jolt-type covers both.
+(define %na-type jolt-type)
+(set! jolt-type (lambda (x) (if (jolt-array? x) (na-array-class-name x) (%na-type x))))
+(def-var! "clojure.core" "type" jolt-type)
+
+;; instance? over an array class token ([I, [C, …). The token reaches us as a
+;; string (Class/forName "[C") or symbol; normalize, and pass a non-array string
+;; token on as a symbol so the inner wrappers' symbol-t-name doesn't choke.
+(define %na-instance-check instance-check)
+(set! instance-check
+  (lambda (type-sym val)
+    (let ((tname (cond ((string? type-sym) type-sym)
+                       ((symbol-t? type-sym) (symbol-t-name type-sym))
+                       (else #f))))
+      (cond
+        ((and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[))
+         (and (jolt-array? val) (string=? (na-array-class-name val) tname)))
+        ((string? type-sym) (%na-instance-check (jolt-symbol #f type-sym) val))
+        (else (%na-instance-check type-sym val))))))
+(def-var! "clojure.core" "instance-check" instance-check)
+
+;; clojure.java.io/reader over a char-array reads its chars (the JVM char[] branch).
+(def-var! "clojure.java.io" "reader"
+  (lambda (x)
+    (if (jolt-array? x)
+        (host-new "StringReader"
+                  (apply string-append (map jolt-str-render-one (seq->list (jolt-seq x)))))
+        (jolt-io-reader x))))
+
 ;; --- bind into clojure.core -------------------------------------------------
 (for-each (lambda (p) (def-var! "clojure.core" (car p) (cdr p)))
   (list
@@ -109,7 +157,9 @@
     (cons "long-array" na-long-array) (cons "short-array" na-short-array)
     (cons "double-array" na-double-array) (cons "float-array" na-float-array)
     (cons "boolean-array" na-boolean-array)
-    (cons "byte-array" na-byte-array) (cons "make-array" na-make-array)
+    (cons "byte-array" na-byte-array) (cons "char-array" na-char-array)
+    (cons "array?" (lambda (x) (jolt-array? x)))
+    (cons "make-array" na-make-array)
     (cons "into-array" na-into-array) (cons "to-array" na-to-array) (cons "aclone" na-aclone)
     (cons "aset-int" na-aset-int) (cons "aset-long" na-aset-long)
     (cons "aset-short" na-aset-short) (cons "aset-double" na-aset-double)

host/chez/rt.ss

@@ -129,8 +129,9 @@
 (load "host/chez/predicates.ss")
 
 ;; --- jolt number printing ----------------------------------------------------
-;; jolt models every number as a Clojure double: integer-valued values print
-;; without a ".0" ((* 1.0 5) prints as "5", (/ 1 2) as "0.5").
+;; jolt has a numeric tower (exact integer / ratio / double, distinguished by
+;; class). Exact integer-valued values print without a ".0" ((+ 1 2) -> "3");
+;; a double prints with one ((* 1.0 5) -> "5.0", as the JVM does).
 (define (jolt-num->string x)
   (cond
     ;; the -e / element printer renders the infinities and NaN in READABLE form
@@ -139,7 +140,7 @@
     ((and (flonum? x) (fl= x +inf.0)) "##Inf")
     ((and (flonum? x) (fl= x -inf.0)) "##-Inf")
     ((and (flonum? x) (not (fl= x x))) "##NaN")
-    ((and (rational? x) (integer? x)) (number->string (exact x)))
+    ((and (exact? x) (integer? x)) (number->string x))
     (else (number->string x))))
 
 ;; Program-final-value printer. jolt's `-e` prints in str-style: strings raw (no

host/chez/run-corpus.ss

@@ -11,7 +11,7 @@
 ;; reset between cases so there is no leakage — same isolation a fresh process gives.
 ;;
 ;;   chez --script host/chez/run-corpus.ss
-;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2705)
+;;   JOLT_CHEZ_ZJ_FLOOR=N   override the regression floor (default 2718)
 ;;   JOLT_CORPUS_LIMIT=N    every-Nth stride (fast iteration; floor drops to 0)
 ;;   JOLT_DUMP_CRASH_LABELS=1   list crash + allowlisted labels
 (import (chezscheme))
@@ -102,10 +102,6 @@
     "reader conditional" "reader cond :jolt" "reader cond no match"
     "reader cond splice" "reader cond splice no match"
     "nil nested" "bool nested" "source order through syntax-quote"
-    "make-array" "into-array" "to-array" "aclone vec"
-    "boolean-array" "int-array" "long-array" "double-array"
-    "float-array" "short-array" "doubles" "floats" "reader over char[]"
-    "char-array of string"
     "cancel an in-flight future returns true" "future-cancelled? after cancel"
     "no param vector"))
 (define known-fail (make-hashtable string-hash string=?))
@@ -200,7 +196,7 @@
 
 ;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
 (define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
-                     (if s (string->number s) 2705)))
+                     (if s (string->number s) 2718)))
 (define floor (if limit 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"