From 31c8f5678424354f24933e831876b69dfe08432b Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 24 Jun 2026 15:16:02 -0400 Subject: [PATCH] Host interop for clojure.data.json: readers, numbers, dates, exceptions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Shaking out clojure.data.json's own test suite (now 134/137): - Reader.read(char[],off,len) bulk read + PushbackReader.unread(char[],off,len) on the string/pushback reader jhosts; instance? java.io.PushbackReader/ Reader/StringReader (data.json re-wraps a reader unless it's already a PushbackReader, so this is load-bearing for repeated reads). - number protocol dispatch by actual type: a flonum is Double (not Long), exact ratio is Ratio, exact integer is Long — value-host-tags split. - Integer/toHexString|toOctalString|toBinaryString|toString; .isNaN/.isInfinite as instance methods on numbers. - EOFException ctor/class; .isArray on a class-name string. - dispatch tags for the uuid/bigdec/inst host values so a protocol extended to java.util.UUID / java.math.BigDecimal / java.util.Date / java.time.Instant reaches its impl; canonical-host-tag strips java.math./java.time. - instant/zoned/local time values compare = by epoch-ms (two parsed Instants). - java.time.Instant/parse, java.sql.Date ctor + valueOf, TimeZone/getDefault, DateTimeFormatter/ISO_INSTANT. All runtime .ss (no re-mint). 9 corpus rows certified vs JVM; make test + shakesmoke green, 0 new divergences. --- host/chez/host-static-classes.ss | 68 ++++++++++++++++++++++++++------ host/chez/host-static-methods.ss | 9 ++++- host/chez/host-static.ss | 3 ++ host/chez/inst-time.ss | 21 +++++++++- host/chez/natives-str.ss | 2 + host/chez/records.ss | 19 +++++++-- test/chez/corpus.edn | 9 +++++ 7 files changed, 112 insertions(+), 19 deletions(-) diff --git a/host/chez/host-static-classes.ss b/host/chez/host-static-classes.ss index 59a2b02..488d91d 100644 --- a/host/chez/host-static-classes.ss +++ b/host/chez/host-static-classes.ss @@ -201,10 +201,21 @@ (define (sr-pos self) (vector-ref (jhost-state self) 1)) (define (sr-pos! self p) (vector-set! (jhost-state self) 1 p)) (register-host-methods! "string-reader" - (list (cons "read" (lambda (self) + (list (cons "read" (lambda (self . rest) (let ((s (sr-s self)) (p (sr-pos self))) - (if (>= p (string-length s)) -1 ; EOF -> exact int -1 (= JVM) - (begin (sr-pos! self (+ p 1)) (->num (char->integer (string-ref s p)))))))) + (cond + ;; .read() -> one char code, -1 at EOF + ((null? rest) + (if (>= p (string-length s)) -1 + (begin (sr-pos! self (+ p 1)) (->num (char->integer (string-ref s p)))))) + ;; .read(cbuf, off, len) -> fill cbuf, return count or -1 at EOF + (else + (let ((slen (string-length s))) + (if (>= p slen) -1 + (let ((cbuf (car rest)) (off (jnum->exact (cadr rest))) (len (jnum->exact (caddr rest)))) + (let ((n (min len (- slen p))) (dv (jolt-array-vec cbuf))) + (let loop ((i 0)) (when (< i n) (vector-set! dv (+ off i) (string-ref s (+ p i))) (loop (+ i 1)))) + (sr-pos! self (+ p n)) (->num n)))))))))) (cons "mark" (lambda (self . _) (vector-set! (jhost-state self) 2 (sr-pos self)) jolt-nil)) (cons "reset" (lambda (self) (sr-pos! self (vector-ref (jhost-state self) 2)) jolt-nil)) (cons "skip" (lambda (self n) (let ((n (jnum->exact n))) @@ -237,15 +248,37 @@ (define (read-unit r) ; read one code unit (flonum) from any reader, -1 at EOF (record-method-dispatch r "read" jolt-nil)) (register-host-methods! "pushback-reader" - (list (cons "read" (lambda (self) - (let ((pushed (vector-ref (jhost-state self) 1))) - (if (pair? pushed) - (begin (vector-set! (jhost-state self) 1 (cdr pushed)) (car pushed)) - (read-unit (vector-ref (jhost-state self) 0)))))) - (cons "unread" (lambda (self ch) - (vector-set! (jhost-state self) 1 - (cons (if (char? ch) (->num (char->integer ch)) ch) (vector-ref (jhost-state self) 1))) - jolt-nil)) + (list (cons "read" + (lambda (self . rest) + (define (read1) + (let ((pushed (vector-ref (jhost-state self) 1))) + (if (pair? pushed) + (begin (vector-set! (jhost-state self) 1 (cdr pushed)) (car pushed)) + (read-unit (vector-ref (jhost-state self) 0))))) + (if (null? rest) + (read1) + ;; .read(cbuf, off, len) -> read one code unit at a time into cbuf, + ;; return count or -1 at immediate EOF. + (let ((off (jnum->exact (cadr rest))) (len (jnum->exact (caddr rest))) (dv (jolt-array-vec (car rest)))) + (let loop ((i 0)) + (if (>= i len) (->num i) + (let ((c (jnum->exact (read1)))) + (if (= c -1) (if (= i 0) -1 (->num i)) + (begin (vector-set! dv (+ off i) (integer->char c)) (loop (+ i 1))))))))))) + (cons "unread" + (lambda (self ch . rest) + (if (null? rest) + ;; unread(int|char) — push one code unit back + (vector-set! (jhost-state self) 1 + (cons (if (char? ch) (->num (char->integer ch)) ch) (vector-ref (jhost-state self) 1))) + ;; unread(char[] cbuf, off, len) — push cbuf[off,off+len) so cbuf[off] + ;; reads back first (the list head). + (let ((dv (jolt-array-vec ch)) (off (jnum->exact (car rest))) (len (jnum->exact (cadr rest)))) + (let loop ((i (- (+ off len) 1)) (acc (vector-ref (jhost-state self) 1))) + (if (< i off) + (vector-set! (jhost-state self) 1 acc) + (loop (- i 1) (cons (->num (char->integer (vector-ref dv i))) acc)))))) + jolt-nil)) (cons "close" (lambda (self) jolt-nil)) (cons "getLineNumber" (lambda (self) 0)))) @@ -335,7 +368,7 @@ '("Throwable" "Exception" "RuntimeException" "IllegalArgumentException" "IllegalStateException" "InterruptedException" "UnsupportedOperationException" "IOException" "NumberFormatException" "ArithmeticException" "NullPointerException" "ClassCastException" "IndexOutOfBoundsException" - "FileNotFoundException" "UnsupportedEncodingException")) + "FileNotFoundException" "UnsupportedEncodingException" "EOFException" "java.io.EOFException")) ;; ---- URLEncoder / URLDecoder (www-form-urlencoded) -------------------------- (define (url-unreserved? b) @@ -572,6 +605,15 @@ ((string=? iface "Associative") (or (pmap? val) (htable-sorted-map? val) (and (pvec? val) (not (jolt-map-entry? val))))) + ;; reader jhosts — data.json re-wraps a reader in a new + ;; PushbackReader unless (instance? PushbackReader r), so this + ;; must hold for repeated reads from one reader to work. + ((string=? iface "PushbackReader") + (and (jhost? val) (string=? (jhost-tag val) "pushback-reader"))) + ((string=? iface "StringReader") + (and (jhost? val) (string=? (jhost-tag val) "string-reader"))) + ((or (string=? iface "Reader") (string=? iface "BufferedReader")) + (reader-jhost? val)) (else 'none)))) (if (eq? hit 'none) 'pass (if hit #t #f)))))) diff --git a/host/chez/host-static-methods.ss b/host/chez/host-static-methods.ss index f3afc03..500a423 100644 --- a/host/chez/host-static-methods.ss +++ b/host/chez/host-static-methods.ss @@ -119,12 +119,19 @@ (cons "parseLong" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "parseLong"))) (cons "valueOf" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "valueOf"))))) +;; JVM Integer.toHexString/etc. treat the int as 32-bit unsigned. +(define (int->u32 n) (if (< n 0) (+ n 4294967296) n)) (register-class-statics! "Integer" (list (cons "MAX_VALUE" (->num 2147483647)) (cons "MIN_VALUE" (->num -2147483648)) (cons "valueOf" (lambda (x . r) (if (number? x) (->num x) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "valueOf")))) - (cons "parseInt" (lambda (x . r) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "parseInt"))))) + (cons "parseInt" (lambda (x . r) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "parseInt"))) + ;; lowercase, like the JVM; a negative int is the 32-bit unsigned form. + (cons "toHexString" (lambda (x) (string-downcase (number->string (int->u32 (jnum->exact x)) 16)))) + (cons "toOctalString" (lambda (x) (number->string (int->u32 (jnum->exact x)) 8))) + (cons "toBinaryString" (lambda (x) (number->string (int->u32 (jnum->exact x)) 2))) + (cons "toString" (lambda (x . r) (number->string (jnum->exact x) (if (null? r) 10 (jnum->exact (car r)))))))) (register-class-statics! "Boolean" (list (cons "parseBoolean" (lambda (s) (string=? "true" (ascii-string-down (if (string? s) s (jolt-str-render-one s)))))) diff --git a/host/chez/host-static.ss b/host/chez/host-static.ss index 2798be1..12c471b 100644 --- a/host/chez/host-static.ss +++ b/host/chez/host-static.ss @@ -85,6 +85,9 @@ ((string=? method "floatValue") (->num n)) ((string=? method "toString") (jolt-num->string n)) ((string=? method "hashCode") (->num (jnum->exact n))) + ;; Double/Float .isNaN / .isInfinite (a non-flonum is neither). + ((string=? method "isNaN") (and (flonum? n) (not (= n n)))) + ((string=? method "isInfinite") (and (flonum? n) (infinite? n))) (else (error #f (string-append "No method " method " for number"))))) ;; ---- emit entry points ------------------------------------------------------ diff --git a/host/chez/inst-time.ss b/host/chez/inst-time.ss index e32e4c2..aece504 100644 --- a/host/chez/inst-time.ss +++ b/host/chez/inst-time.ss @@ -243,6 +243,15 @@ (register-hash-arm! jinst? (lambda (x) (jolt-hash (jinst-ms x)))) +;; java.time.Instant/ZonedDateTime/LocalDateTime values (mk-instant/mk-zoned/mk-local +;; jhosts) are equal when same kind + same epoch-ms — two parsed Instants compare =. +(define (time-jhost? x) (and (jhost? x) (member (jhost-tag x) '("instant" "zoned-dt" "local-dt")) #t)) +(register-eq-arm! (lambda (a b) (or (time-jhost? a) (time-jhost? b))) + (lambda (a b) (and (time-jhost? a) (time-jhost? b) + (string=? (jhost-tag a) (jhost-tag b)) + (= (ms-of a) (ms-of b))))) +(register-hash-arm! time-jhost? (lambda (x) (jolt-hash (ms-of x)))) + (define (inst-pr i) (string-append "#inst \"" (inst-rfc3339 i) "\"")) (register-pr-arm! jinst? inst-pr) (register-str-render! jinst? inst-rfc3339) @@ -327,7 +336,10 @@ (cons "ofLocalizedDateTime" (lambda (fs) (style-fmt 'datetime fs))))) (register-class-statics! "Instant" (list (cons "ofEpochMilli" (lambda (ms) (mk-instant (ms->exact ms)))) - (cons "now" (lambda () (mk-instant (now-ms)))))) + (cons "now" (lambda () (mk-instant (now-ms)))) + ;; Instant/parse an ISO-8601 instant ("…T…Z") -> an instant value. + (cons "parse" (lambda (s) (mk-instant (jinst-ms (jolt-inst-from-string + (if (string? s) s (jolt-str-render-one s))))))))) (register-class-statics! "ZoneId" (list (cons "systemDefault" (lambda () (make-jhost "zone-id" (vector "system")))) (cons "of" (lambda (id) (make-jhost "zone-id" (vector id)))))) @@ -352,6 +364,13 @@ (register-class-ctor! "java.util.Date" date-ctor) (register-class-ctor! "Timestamp" date-ctor) (register-class-ctor! "java.sql.Timestamp" date-ctor) +;; java.sql.Date: (Date. year-1900 month0 day) builds UTC midnight of that civil +;; date; valueOf parses "yyyy-MM-dd" to the same instant (so the two agree). +(define (sql-date-midnight y mo d) (make-jinst (* 1000 (* (days-from-civil y mo d) 86400)))) +(register-class-ctor! "java.sql.Date" + (lambda (y m d) (sql-date-midnight (+ 1900 (jnum->exact y)) (+ 1 (jnum->exact m)) (jnum->exact d)))) +(register-class-statics! "java.sql.Date" + (list (cons "valueOf" (lambda (s) (parse-ms "yyyy-MM-dd" (if (string? s) s (jolt-str-render-one s))))))) ;; 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). diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss index 3bb1614..cfa4fb2 100644 --- a/host/chez/natives-str.ss +++ b/host/chez/natives-str.ss @@ -178,6 +178,8 @@ jolt-nil) ((string=? method "subSequence") (substring s (jolt->idx (arg 0)) (jolt->idx (arg 1)))) + ;; Class.isArray over a class-name string: array classes are "[…" (e.g. "[C"). + ((string=? method "isArray") (and (fx>? (string-length s) 0) (char=? (string-ref s 0) #\[))) (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/records.ss b/host/chez/records.ss index 3a3d880..6d57d65 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -118,9 +118,11 @@ ;; host type-tag candidates for a non-record value (extend-protocol on builtins). (define (value-host-tags obj) - (cond ((and (number? obj) (and (exact? obj) (not (integer? obj)))) - '("Ratio" "Number" "Object")) - ((number? obj) '("Long" "Integer" "Number" "Double" "Object")) + ;; numbers dispatch by actual type (a Double is NOT a Long): flonum -> Double, + ;; exact ratio -> Ratio, exact integer -> Long. + (cond ((flonum? obj) '("Double" "Float" "Number" "Object")) + ((and (number? obj) (exact? obj) (not (integer? obj))) '("Ratio" "Number" "Object")) + ((number? obj) '("Long" "Integer" "BigInteger" "BigInt" "Number" "Object")) ((string? obj) '("String" "CharSequence" "Object")) ((boolean? obj) '("Boolean" "Object")) ((keyword? obj) '("Keyword" "Named" "Object")) @@ -133,6 +135,12 @@ ((or (cseq? obj) (empty-list-t? obj)) '("ASeq" "ISeq" "IPersistentCollection" "Sequential" "Collection" "Object")) ;; java.net.URI jhost — extend-protocol java.net.URI (hiccup ToURI/ToStr). ((and (jhost? obj) (string=? (jhost-tag obj) "uri")) '("URI" "java.net.URI" "Object")) + ;; host value types a library may extend a protocol to by class (data.json + ;; extends JSONWriter to java.util.UUID / java.util.Date / java.math.BigDecimal). + ((juuid? obj) '("UUID" "java.util.UUID" "Object")) + ((jinst? obj) '("Date" "java.util.Date" "Timestamp" "java.sql.Timestamp" "Object")) + ((jbigdec? obj) '("BigDecimal" "java.math.BigDecimal" "Number" "Object")) + ((and (jhost? obj) (string=? (jhost-tag obj) "instant")) '("Instant" "java.time.Instant" "Object")) ;; a bare procedure (fn) — extend-protocol to clojure.lang.{Fn,IFn,AFn}. ((procedure? obj) '("Fn" "IFn" "AFn" "Object")) ((jolt-nil? obj) '("nil")) @@ -183,7 +191,8 @@ "PersistentHashSet" "APersistentSet" "IPersistentSet" "ASeq" "ISeq" "IPersistentCollection" "Associative" "Sequential" "Map" "java.util.Map" "List" "java.util.List" "Set" "java.util.Set" - "Collection" "java.util.Collection")) + "Collection" "java.util.Collection" + "UUID" "BigDecimal" "Date" "Timestamp" "Instant")) h)) (define (strip-prefix s p) (let ((pl (string-length p))) @@ -192,6 +201,8 @@ (let ((base (or (strip-prefix type-name "java.lang.") (strip-prefix type-name "java.util.") (strip-prefix type-name "java.net.") + (strip-prefix type-name "java.math.") + (strip-prefix type-name "java.time.") (strip-prefix type-name "clojure.lang.") type-name))) (and (hashtable-ref host-type-set base #f) base))) diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index 39337fa..92e5625 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -2985,4 +2985,13 @@ {: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))"} + {:suite "interop / numbers & classes" :label "Integer/toHexString lowercase" :expected "\"ff\"" :actual "(Integer/toHexString 255)"} + {:suite "interop / numbers & classes" :label "Integer/toHexString wide" :expected "\"1234\"" :actual "(Integer/toHexString 4660)"} + {:suite "interop / numbers & classes" :label ".isNaN on a double" :expected "true" :actual "(.isNaN (/ 0.0 0.0))"} + {:suite "interop / numbers & classes" :label ".isInfinite on a double" :expected "true" :actual "(.isInfinite (/ 1.0 0.0))"} + {:suite "interop / numbers & classes" :label ".isNaN false for finite" :expected "false" :actual "(.isNaN 1.0)"} + {:suite "interop / numbers & classes" :label "protocol dispatch Long vs Double" :expected "[:l :d]" :actual "(do (defprotocol N (-n [x])) (extend java.lang.Long N {:-n (fn [_] :l)}) (extend java.lang.Double N {:-n (fn [_] :d)}) [(-n 5) (-n 5.0)])"} + {:suite "interop / numbers & classes" :label "instance? PushbackReader" :expected "true" :actual "(instance? java.io.PushbackReader (java.io.PushbackReader. (java.io.StringReader. \"x\")))"} + {:suite "interop / numbers & classes" :label "EOFException catch by class" :expected "\"boom\"" :actual "(try (throw (java.io.EOFException. \"boom\")) (catch java.io.EOFException e (.getMessage e)))"} + {:suite "interop / numbers & classes" :label "Reader.read into char[]" :expected "[4 \"abcd\"]" :actual "(let [r (java.io.StringReader. \"abcd\") b (char-array 4)] (let [n (.read r b 0 4)] [n (String. b 0 n)]))"} ]