diff --git a/host/chez/host-static-classes.ss b/host/chez/host-static-classes.ss index deb5d40..59a2b02 100644 --- a/host/chez/host-static-classes.ss +++ b/host/chez/host-static-classes.ss @@ -73,12 +73,19 @@ (cons "iterator" (lambda (self) (make-jiterator (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" (lambda args (make-jhost "string-builder" ;; a numeric first arg is a CAPACITY hint, not content. (vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) ""))))) (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 "length" (lambda (self) (->num (string-length (sb-str self))))) (cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i)))) @@ -88,6 +95,9 @@ (substring cur 0 n) (string-append cur (make-string (- n (string-length cur)) #\nul))))) 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 ----------------------------------------------------------- ;; 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-host-methods! "writer" (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 "close" (lambda (self) jolt-nil)) (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 (register-host-methods! "file-writer" (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 "close" (lambda (self) (fw-flush! self) jolt-nil)) (cons "toString" (lambda (self) (fw-buf self))))) @@ -120,7 +130,7 @@ ;; (tools.logging, selmer) compile and run. (register-host-methods! "port-writer" (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 "close" (lambda (self) jolt-nil)) (cons "toString" (lambda (self) "")))) @@ -291,6 +301,15 @@ (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. 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 (fxstring (vector->list v))))) ((string? x) x) (else (jolt-str-render-one x))))) (register-class-ctor! "BigInteger" diff --git a/host/chez/inst-time.ss b/host/chez/inst-time.ss index c71fa69..e32e4c2 100644 --- a/host/chez/inst-time.ss +++ b/host/chez/inst-time.ss @@ -356,8 +356,11 @@ ;; 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). (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))) -(register-class-statics! "java.util.TimeZone" (list (cons "getTimeZone" timezone-of))) +(define timezone-statics + (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 ;; is UTC); .format(date) renders the date per the pattern via the format-ms engine. diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss index 58f182f..3bb1614 100644 --- a/host/chez/natives-str.ss +++ b/host/chez/natives-str.ss @@ -166,6 +166,18 @@ ((or (string=? method "getName") (string=? method "getCanonicalName")) s) ((string=? method "getSimpleName") (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 (fxidx (arg 0)) (jolt->idx (arg 1)))) (else (error #f (string-append "No method " method " for value"))))) ;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) --- diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 8fdc579..4c58522 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -177,7 +177,21 @@ ((#\0) (loop (+ i 2) (cons #\nul acc))) ((#\u) (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) + (fxint 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 1) (cons c acc))))))) diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index e476c58..39337fa 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -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 "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 / 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))"} ]