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

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

Browse source
This commit is contained in:
Yogthos 2026-06-21 22:36:14 -04:00
parent f2747679e9
commit 9e0a930eb4
7 changed files with 85 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

60
host/chez/natives-array.ss
View file

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