Host interop for clojure.data.json: readers, numbers, dates, exceptions
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.
This commit is contained in:
Yogthos
parent
18874ce4ab
commit
31c8f56784
7 changed files with 112 additions and 19 deletions
|
|
@ -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))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -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 ------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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) ---
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue