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

Merge pull request #192 from jolt-lang/spike/datajson-tests

Browse source 
data.json host interop: readers, number dispatch, dates, exceptions (suite 134/137)
This commit is contained in:
Dmitri Sotnikov 2026-06-24 19:21:55 +00:00 • committed by GitHub
commit 348d91c1d1
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 112 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

68
host/chez/host-static-classes.ss
View file

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

9
host/chez/host-static-methods.ss
View file

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

3
host/chez/host-static.ss
View file

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

21
host/chez/inst-time.ss
View file

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

2
host/chez/natives-str.ss
View file

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

19
host/chez/records.ss
View file

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

9
test/chez/corpus.edn
View file

@ -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)]))"}
]