String/char-array interop: getChars, String(char[]), str of StringBuilder, append(csq,start,end)

- String.getChars copies into a char-array; String. builds from a char[]
  (whole or offset/count slice); subSequence returns the substring.
- str of a StringBuilder returns its content (was the opaque host object;
  .toString already worked).
- Appendable.append gains the 3-arg subsequence form append(csq,start,end)
  on StringBuilder/StringWriter/file/port writers.
- reader combines a \uXXXX surrogate pair into the one Unicode scalar
  (😃) instead of crashing on the lone high surrogate; a stray surrogate
  maps to U+FFFD. (A high-plane char re-escaped as \uXXXXX stays the
  irreducible UTF-16/scalar divergence.)
- TimeZone/getDefault.

These let clojure.data.json read and write JSON; its own suite goes from
not loading to 97/133 assertions passing (remainder: per-type writer
dispatch for uuid/bigdec/date, EOFException, niche date interop).
This commit is contained in:
Yogthos 2026-06-24 14:36:13 -04:00
parent c6b8f31608
commit 8bd781e6a8
5 changed files with 59 additions and 7 deletions

View file

@ -73,12 +73,19 @@
(cons "iterator" (lambda (self) (make-jiterator (list->cseq (al->list self))))) (cons "iterator" (lambda (self) (make-jiterator (list->cseq (al->list self)))))
(cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self))))))) (cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self)))))))
;; Appendable.append text: append(x) renders x; append(csq,start,end) appends the
;; subsequence csq[start,end) (data.json's writer appends string runs this way).
(define (append-text x rest)
(if (null? rest)
(render-piece x)
(substring (render-piece x) (jnum->exact (car rest)) (jnum->exact (cadr rest)))))
(register-class-ctor! "StringBuilder" (register-class-ctor! "StringBuilder"
(lambda args (make-jhost "string-builder" (lambda args (make-jhost "string-builder"
;; a numeric first arg is a CAPACITY hint, not content. ;; a numeric first arg is a CAPACITY hint, not content.
(vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) ""))))) (vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) "")))))
(register-host-methods! "string-builder" (register-host-methods! "string-builder"
(list (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self)) (list (cons "append" (lambda (self x . rest) (sb-set! self (string-append (sb-str self) (append-text x rest))) self))
(cons "toString" (lambda (self) (sb-str self))) (cons "toString" (lambda (self) (sb-str self)))
(cons "length" (lambda (self) (->num (string-length (sb-str self))))) (cons "length" (lambda (self) (->num (string-length (sb-str self)))))
(cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i)))) (cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i))))
@ -88,6 +95,9 @@
(substring cur 0 n) (substring cur 0 n)
(string-append cur (make-string (- n (string-length cur)) #\nul))))) (string-append cur (make-string (- n (string-length cur)) #\nul)))))
jolt-nil)))) jolt-nil))))
;; (str sb) / print a StringBuilder -> its accumulated content, like the JVM
;; (str calls toString). Without this str renders the opaque host object.
(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "string-builder"))) sb-str)
;; ---- StringWriter ----------------------------------------------------------- ;; ---- StringWriter -----------------------------------------------------------
;; Writer.write(int) writes the CHAR for that code; append(char) appends the char. ;; Writer.write(int) writes the CHAR for that code; append(char) appends the char.
@ -95,7 +105,7 @@
(register-class-ctor! "StringWriter" (lambda args (make-jhost "writer" (vector "")))) (register-class-ctor! "StringWriter" (lambda args (make-jhost "writer" (vector ""))))
(register-host-methods! "writer" (register-host-methods! "writer"
(list (cons "write" (lambda (self x) (sb-set! self (string-append (sb-str self) (writer-piece x))) jolt-nil)) (list (cons "write" (lambda (self x) (sb-set! self (string-append (sb-str self) (writer-piece x))) jolt-nil))
(cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self)) (cons "append" (lambda (self x . rest) (sb-set! self (string-append (sb-str self) (append-text x rest))) self))
(cons "flush" (lambda (self) jolt-nil)) (cons "flush" (lambda (self) jolt-nil))
(cons "close" (lambda (self) jolt-nil)) (cons "close" (lambda (self) jolt-nil))
(cons "toString" (lambda (self) (sb-str self))))) (cons "toString" (lambda (self) (sb-str self)))))
@ -109,7 +119,7 @@
(define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self))) ; jolt-spit: io.ss (define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self))) ; jolt-spit: io.ss
(register-host-methods! "file-writer" (register-host-methods! "file-writer"
(list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil)) (list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil))
(cons "append" (lambda (self x) (fw-append! self (render-piece x)) self)) (cons "append" (lambda (self x . rest) (fw-append! self (append-text x rest)) self))
(cons "flush" (lambda (self) (fw-flush! self) jolt-nil)) (cons "flush" (lambda (self) (fw-flush! self) jolt-nil))
(cons "close" (lambda (self) (fw-flush! self) jolt-nil)) (cons "close" (lambda (self) (fw-flush! self) jolt-nil))
(cons "toString" (lambda (self) (fw-buf self))))) (cons "toString" (lambda (self) (fw-buf self)))))
@ -120,7 +130,7 @@
;; (tools.logging, selmer) compile and run. ;; (tools.logging, selmer) compile and run.
(register-host-methods! "port-writer" (register-host-methods! "port-writer"
(list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil)) (list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil))
(cons "append" (lambda (self x) (display (render-piece x) (vector-ref (jhost-state self) 0)) self)) (cons "append" (lambda (self x . rest) (display (append-text x rest) (vector-ref (jhost-state self) 0)) self))
(cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil)) (cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil))
(cons "close" (lambda (self) jolt-nil)) (cons "close" (lambda (self) jolt-nil))
(cons "toString" (lambda (self) "")))) (cons "toString" (lambda (self) ""))))
@ -291,6 +301,15 @@
(lambda (x . rest) (lambda (x . rest)
(cond ((bytevector? x) (decode-bytevector x rest)) (cond ((bytevector? x) (decode-bytevector x rest))
((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (decode-bytevector (na-bytearray->bv x) rest)) ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (decode-bytevector (na-bytearray->bv x) rest))
;; (String. char[] [offset count]) — the whole array or a slice. Buffered
;; readers (data.json) build a string from a fill buffer this way.
((and (jolt-array? x) (eq? (jolt-array-kind x) 'char))
(let ((v (jolt-array-vec x)))
(if (pair? rest)
(let* ((off (jnum->exact (car rest))) (cnt (jnum->exact (cadr rest))) (out (make-string cnt)))
(let loop ((i 0)) (when (fx<? i cnt) (string-set! out i (vector-ref v (fx+ off i))) (loop (fx+ i 1))))
out)
(list->string (vector->list v)))))
((string? x) x) ((string? x) x)
(else (jolt-str-render-one x))))) (else (jolt-str-render-one x)))))
(register-class-ctor! "BigInteger" (register-class-ctor! "BigInteger"

View file

@ -356,8 +356,11 @@
;; java.util.TimeZone: an opaque id holder (format-ms is UTC, so a non-UTC zone is ;; java.util.TimeZone: an opaque id holder (format-ms is UTC, so a non-UTC zone is
;; not honored — only the UTC case the corpus uses is exercised). ;; not honored — only the UTC case the corpus uses is exercised).
(define (timezone-of id) (make-jhost "timezone" (vector (if (string? id) id (jolt-str-render-one id))))) (define (timezone-of id) (make-jhost "timezone" (vector (if (string? id) id (jolt-str-render-one id)))))
(register-class-statics! "TimeZone" (list (cons "getTimeZone" timezone-of))) (define timezone-statics
(register-class-statics! "java.util.TimeZone" (list (cons "getTimeZone" timezone-of))) (list (cons "getTimeZone" timezone-of)
(cons "getDefault" (lambda () (timezone-of "default")))))
(register-class-statics! "TimeZone" timezone-statics)
(register-class-statics! "java.util.TimeZone" timezone-statics)
;; java.text.SimpleDateFormat: holds a pattern; .setTimeZone is accepted (format-ms ;; java.text.SimpleDateFormat: holds a pattern; .setTimeZone is accepted (format-ms
;; is UTC); .format(date) renders the date per the pattern via the format-ms engine. ;; is UTC); .format(date) renders the date per the pattern via the format-ms engine.

View file

@ -166,6 +166,18 @@
((or (string=? method "getName") (string=? method "getCanonicalName")) s) ((or (string=? method "getName") (string=? method "getCanonicalName")) s)
((string=? method "getSimpleName") ((string=? method "getSimpleName")
(let ((i (str-last-index-of s "."))) (if (>= i 0) (substring s (+ i 1) (string-length s)) s))) (let ((i (str-last-index-of s "."))) (if (>= i 0) (substring s (+ i 1) (string-length s)) s)))
;; .getChars srcBegin srcEnd dst dstBegin — copy s[srcBegin,srcEnd) into the
;; char-array dst at dstBegin (used by buffered readers, e.g. data.json).
((string=? method "getChars")
(let ((src-begin (jolt->idx (arg 0))) (src-end (jolt->idx (arg 1)))
(dv (jolt-array-vec (arg 2))) (dst-begin (jolt->idx (arg 3))))
(let loop ((i src-begin) (j dst-begin))
(when (fx<? i src-end)
(vector-set! dv j (string-ref s i))
(loop (fx+ i 1) (fx+ j 1)))))
jolt-nil)
((string=? method "subSequence")
(substring s (jolt->idx (arg 0)) (jolt->idx (arg 1))))
(else (error #f (string-append "No method " method " for value"))))) (else (error #f (string-append "No method " method " for value")))))
;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) --- ;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) ---

View file

@ -177,7 +177,21 @@
((#\0) (loop (+ i 2) (cons #\nul acc))) ((#\0) (loop (+ i 2) (cons #\nul acc)))
((#\u) ((#\u)
(let-values (((cp j) (rdr-hex->int s (+ i 2) 4))) (let-values (((cp j) (rdr-hex->int s (+ i 2) 4)))
(loop j (cons (integer->char cp) acc)))) ;; A \u escape is a UTF-16 code unit. jolt chars are Unicode scalars,
;; so combine a high+low surrogate pair (😃 -> U+1F603) into
;; the one scalar char. A lone surrogate has no scalar — emit U+FFFD
;; rather than crash (the irreducible UTF-16/scalar divergence).
(cond
((and (fx>=? cp #xD800) (fx<=? cp #xDBFF)
(fx<? (fx+ j 1) end)
(char=? (string-ref s j) #\\) (char=? (string-ref s (fx+ j 1)) #\u))
(let-values (((lo k) (rdr-hex->int s (+ j 2) 4)))
(if (and (fx>=? lo #xDC00) (fx<=? lo #xDFFF))
(loop k (cons (integer->char
(fx+ #x10000 (fx* (fx- cp #xD800) 1024) (fx- lo #xDC00))) acc))
(loop j (cons #\xFFFD acc)))))
((and (fx>=? cp #xD800) (fx<=? cp #xDFFF)) (loop j (cons #\xFFFD acc)))
(else (loop j (cons (integer->char cp) acc))))))
(else (loop (+ i 2) (cons e acc)))))) (else (loop (+ i 2) (cons e acc))))))
(else (loop (+ i 1) (cons c acc))))))) (else (loop (+ i 1) (cons c acc)))))))

View file

@ -2981,4 +2981,8 @@
{:suite "interop / instance? on host interfaces" :label "map is not a Collection" :expected "false" :actual "(instance? java.util.Collection {:a 1})"} {:suite "interop / instance? on host interfaces" :label "map is not a Collection" :expected "false" :actual "(instance? java.util.Collection {:a 1})"}
{:suite "interop / instance? on host interfaces" :label "vector is Associative" :expected "true" :actual "(instance? clojure.lang.Associative [1])"} {:suite "interop / instance? on host interfaces" :label "vector is Associative" :expected "true" :actual "(instance? clojure.lang.Associative [1])"}
{:suite "interop / instance? on host interfaces" :label "string is not Number" :expected "false" :actual "(instance? java.lang.Number \"s\")"} {:suite "interop / instance? on host interfaces" :label "string is not Number" :expected "false" :actual "(instance? java.lang.Number \"s\")"}
{:suite "interop / String & StringBuilder char ops" :label "String from char-array slice" :expected "\"abc\"" :actual "(String. (char-array [\\a \\b \\c \\d]) 0 3)"}
{:suite "interop / String & StringBuilder char ops" :label "str of StringBuilder" :expected "\"hi\"" :actual "(let [sb (StringBuilder.)] (.append sb \"hi\") (str sb))"}
{:suite "interop / String & StringBuilder char ops" :label "append subsequence" :expected "\"bcd\"" :actual "(let [sb (StringBuilder.)] (.append sb \"abcde\" 1 4) (.toString sb))"}
{:suite "interop / String & StringBuilder char ops" :label "String.getChars into buffer" :expected "\"abc\"" :actual "(let [a (char-array 4)] (.getChars \"abcd\" 0 3 a 0) (String. a 0 3))"}
] ]