Byte-array <-> bytevector interop + charset-aware (String. bytes cs)

The host carries bytes two ways: Chez bytevectors (what String/.getBytes
produce) and jolt byte-arrays (what byte-array / the Java-array shims use). They
didn't interconvert, so code mixing the two — like clj-http-lite, which buffers
into (byte-array n) but encodes via .getBytes and decodes via (String. ^[B body
charset) — broke.

- byte-array now also accepts a bytevector or a string (UTF-8 bytes), so the two
  representations convert freely at interop seams.
- (String. bytes [charset]) decodes a bytevector OR a jolt byte-array with the
  named charset (UTF-8 default; ISO-8859-1/latin1/ascii = one byte/char). It
  previously only took a bytevector and ignored the charset.

Runtime .ss shims, no re-mint. Unit covers both directions + charset.
This commit is contained in:
Yogthos 2026-06-22 13:20:27 -04:00
parent c5e1e0544a
commit 3253df979a
3 changed files with 44 additions and 5 deletions

View file

@ -514,9 +514,31 @@
(error #f "NoSuchElementException")))))))
;; ---- String / BigInteger / MapEntry constructors ----------------------------
;; (String. x) / (String. bytes): a bytevector decodes UTF-8; else stringify.
;; (String. bytes [charset]) decodes bytes (a bytevector OR a jolt byte-array)
;; with the named charset (UTF-8 default; ISO-8859-1/latin1/ascii = one byte per
;; char); else stringify. clj-http-lite's body coercion is (String. ^[B body cs).
(define (string-charset-name rest)
(if (pair? rest)
(let ((c (car rest)))
(cond ((string? c) c)
((and (jhost? c) (string=? (jhost-tag c) "charset"))
(let ((p (assq 'name (jhost-state c)))) (if p (jolt-str-render-one (cdr p)) "UTF-8")))
(else "UTF-8")))
"UTF-8"))
(define (decode-bytevector bv rest)
(let ((cs (ascii-string-down (string-charset-name rest))))
(cond
((or (string=? cs "utf-8") (string=? cs "utf8")) (utf8->string bv))
((or (string=? cs "iso-8859-1") (string=? cs "latin1") (string=? cs "iso8859-1")
(string=? cs "us-ascii") (string=? cs "ascii"))
(list->string (map integer->char (bytevector->u8-list bv))))
(else (guard (e (#t (list->string (map integer->char (bytevector->u8-list bv))))) (utf8->string bv))))))
(register-class-ctor! "String"
(lambda (x . _) (cond ((bytevector? x) (utf8->string x)) ((string? x) x) (else (jolt-str-render-one x)))))
(lambda (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))
((string? x) x)
(else (jolt-str-render-one x)))))
(register-class-ctor! "BigInteger"
(lambda (v) (parse-int-or-throw v 10 "BigInteger")))
(register-class-ctor! "MapEntry" (lambda (k v) (make-map-entry k v)))

View file

@ -46,10 +46,20 @@
(else (make-jolt-array
(list->vector (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c)))))
(seq->list (jolt-seq a)))) 'char))))
;; (byte-array n [init]) | (byte-array coll). Also coerces the host's OTHER byte
;; carrier — a Chez bytevector (what String/.getBytes produce) — and a string's
;; UTF-8 bytes, so bytevector and byte-array interconvert across interop seams.
(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)
(make-jolt-array (list->vector (map na-byte-of (seq->list (jolt-seq a)))) 'byte)))
(cond
((number? a) (make-jolt-array (make-vector (exact (na-idx a)) (na-byte-of (if (pair? rest) (car rest) 0))) 'byte))
((bytevector? a) (make-jolt-array (list->vector (bytevector->u8-list a)) 'byte))
((string? a) (make-jolt-array (list->vector (bytevector->u8-list (string->utf8 a))) 'byte))
(else (make-jolt-array (list->vector (map na-byte-of (seq->list (jolt-seq a)))) 'byte))))
;; jolt byte-array -> Chez bytevector (for String decode / utf8->string).
(define (na-bytearray->bv arr)
(let* ((v (jolt-array-vec arr)) (n (vector-length v)) (bv (make-bytevector n)))
(do ((i 0 (+ i 1))) ((= i n)) (bytevector-u8-set! bv i (bitwise-and (exact (vector-ref v i)) #xff)))
bv))
(define (na-make-array a . rest) ; (make-array len) | (make-array type len ...)
(make-jolt-array (make-vector (exact (na-idx (if (number? a) a (car rest)))) jolt-nil) 'object))
(define (na-into-array a . rest) (na-from-seq (if (pair? rest) (car rest) a) 'object))

View file

@ -465,4 +465,11 @@
{:suite "hostshim" :expr "(do (__register-class-ctor! \"Box4\" (fn [] (jolt.host/tagged-table :my/box4))) (__register-instance-check! (fn [cn val] (if (= cn \"Box4\") (= :my/box4 (jolt.host/ref-get val :jolt/type)) nil))) (instance? Box4 \"not-a-box\"))" :expected "false"}
{:suite "hostshim" :expr "(jolt.host/table? (jolt.host/tagged-table :t))" :expected "true"}
{:suite "hostshim" :expr "(jolt.host/table? \"x\")" :expected "false"}
{:suite "bytes" :expr "(seq (byte-array \"hi\"))" :expected "(104 105)"}
{:suite "bytes" :expr "(seq (byte-array (.getBytes \"AB\" \"UTF-8\")))" :expected "(65 66)"}
{:suite "bytes" :expr "(alength (byte-array (.getBytes \"hello\" \"UTF-8\")))" :expected "5"}
{:suite "bytes" :expr "(String. (byte-array [104 105]))" :expected "hi"}
{:suite "bytes" :expr "(String. (byte-array [104 105]) \"UTF-8\")" :expected "hi"}
{:suite "bytes" :expr "(int (first (String. (byte-array [200]) \"ISO-8859-1\")))" :expected "200"}
{:suite "bytes" :expr "(String. (.getBytes \"round\" \"UTF-8\") \"UTF-8\")" :expected "round"}
]