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

Merge pull request #195 from jolt-lang/spike/java-time-phase1

Browse source 
java.time on Chez: LocalDate..ZonedDateTime + formatters — runs tick (api_test 352/7)
This commit is contained in:
Dmitri Sotnikov 2026-06-24 22:51:33 +00:00 • committed by GitHub
commit dcfc764b69
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
9 changed files with 2238 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -45,11 +45,23 @@
(and (digit? (string-ref s j)) (and (digit? (string-ref s j))
(loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref s j)) 48)))))))) (loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref s j)) 48))))))))
(define (jolt-inst-from-string ts) (define (jolt-inst-from-string ts0)
;; a leading '-' marks a negative (proleptic) year; the rest of the field may be
;; more than 4 digits (java.time prints -999999999-…). Read the year up to the
;; first '-' that separates it from the month.
(define neg-year (and (> (string-length ts0) 0) (char=? (string-ref ts0 0) #\-)))
(define ts (if neg-year (substring ts0 1 (string-length ts0)) ts0))
(define len (string-length ts)) (define len (string-length ts))
(define (fail) (error #f (string-append "Unrecognized #inst timestamp: " ts))) (define (fail) (error #f (string-append "Unrecognized #inst timestamp: " ts0)))
(let* ((year (or (digits-at ts 0 4) (fail))) (define (read-year)
(i 4) (month 1) (day 1) (hh 0) (mm 0) (ss 0) (frac-ms 0) (off-s 0)) ;; >=4 digits up to a non-digit; java.time uses min-4 but allows more.
(let loop ((j 0) (acc 0) (n 0))
(if (and (< j len) (digit? (string-ref ts j)))
(loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref ts j)) 48)) (+ n 1))
(if (>= n 4) (cons acc j) #f))))
(let* ((yr (or (read-year) (fail)))
(year (if neg-year (- (car yr)) (car yr)))
(i (cdr yr)) (month 1) (day 1) (hh 0) (mm 0) (ss 0) (frac-ms 0) (off-s 0))
;; -MM ;; -MM
(when (and (< i len) (char=? (string-ref ts i) #\-) (digits-at ts (+ i 1) 2)) (when (and (< i len) (char=? (string-ref ts i) #\-) (digits-at ts (+ i 1) 2))
(set! month (digits-at ts (+ i 1) 2)) (set! i (+ i 3))) (set! month (digits-at ts (+ i 1) 2)) (set! i (+ i 3)))
@ -170,11 +182,14 @@
(y 1970) (mo 1) (d 1) (hh 0) (mi 0) (ss 0) (pm 'none)) (y 1970) (mo 1) (d 1) (hh 0) (mi 0) (ss 0) (pm 'none))
(define (pfail) (error #f (string-append "ParseException: unparseable date \"" input "\""))) (define (pfail) (error #f (string-append "ParseException: unparseable date \"" input "\"")))
(define (run-len i c) (let loop ((j i)) (if (and (< j pn) (char=? (string-ref pattern j) c)) (loop (+ j 1)) (- j i)))) (define (run-len i c) (let loop ((j i)) (if (and (< j pn) (char=? (string-ref pattern j) c)) (loop (+ j 1)) (- j i))))
(define (read-digits ii) ; -> (val . next), pfail if none ;; read up to `maxw` digits (#f = unbounded). A fixed-width field (k>=2, e.g.
(let loop ((j ii) (acc 0) (any #f)) ;; HHmm) caps the read at its run length so adjacent numeric fields split.
(if (and (< j inn) (digit? (string-ref input j))) (define (read-digits-w ii maxw) ; -> (val . next), pfail if none
(loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref input j)) 48)) #t) (let loop ((j ii) (acc 0) (n 0) (any #f))
(if (and (< j inn) (digit? (string-ref input j)) (or (not maxw) (< n maxw)))
(loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref input j)) 48)) (+ n 1) #t)
(if any (cons acc j) (pfail))))) (if any (cons acc j) (pfail)))))
(define (read-digits ii) (read-digits-w ii #f))
(define (read-alpha ii) ; -> (str . next) (define (read-alpha ii) ; -> (str . next)
(let loop ((j ii)) (if (and (< j inn) (char-alphabetic? (string-ref input j))) (loop (+ j 1)) (let loop ((j ii)) (if (and (< j inn) (char-alphabetic? (string-ref input j))) (loop (+ j 1))
(cons (substring input ii j) j)))) (cons (substring input ii j) j))))
@ -195,23 +210,23 @@
((char-alphabetic? c) ((char-alphabetic? c)
(let ((k (run-len pi c))) (let ((k (run-len pi c)))
(cond (cond
((char=? c #\y) (let ((r (read-digits ii))) ((char=? c #\y) (let ((r (read-digits-w ii (if (>= k 3) #f k))))
;; 2-digit year (value < 100): JVM sliding window — 00-68 -> 20xx, ;; 2-digit year (value < 100): JVM sliding window — 00-68 -> 20xx,
;; 69-99 -> 19xx (rfc1036 HTTP dates). A full year stays as-is. ;; 69-99 -> 19xx (rfc1036 HTTP dates). A full year stays as-is.
(set! y (let ((v (car r))) (if (< v 100) (if (< v 69) (+ 2000 v) (+ 1900 v)) v))) (set! y (let ((v (car r))) (if (and (= k 2) (< v 100)) (if (< v 69) (+ 2000 v) (+ 1900 v)) v)))
(loop (+ pi k) (cdr r)))) (loop (+ pi k) (cdr r))))
((char=? c #\M) (if (>= k 3) ((char=? c #\M) (if (>= k 3)
(let ((r (read-alpha ii))) (set! mo (or (month-from-name (car r)) (pfail))) (loop (+ pi k) (cdr r))) (let ((r (read-alpha ii))) (set! mo (or (month-from-name (car r)) (pfail))) (loop (+ pi k) (cdr r)))
(let ((r (read-digits ii))) (set! mo (car r)) (loop (+ pi k) (cdr r))))) (let ((r (read-digits-w ii (if (>= k 2) k #f)))) (set! mo (car r)) (loop (+ pi k) (cdr r)))))
((char=? c #\d) (let ((r (read-digits ii))) (set! d (car r)) (loop (+ pi k) (cdr r)))) ((char=? c #\d) (let ((r (read-digits-w ii (if (>= k 2) k #f)))) (set! d (car r)) (loop (+ pi k) (cdr r))))
((or (char=? c #\H) (char=? c #\h)) (let ((r (read-digits ii))) (set! hh (car r)) (loop (+ pi k) (cdr r)))) ((or (char=? c #\H) (char=? c #\h)) (let ((r (read-digits-w ii (if (>= k 2) k #f)))) (set! hh (car r)) (loop (+ pi k) (cdr r))))
((char=? c #\m) (let ((r (read-digits ii))) (set! mi (car r)) (loop (+ pi k) (cdr r)))) ((char=? c #\m) (let ((r (read-digits-w ii (if (>= k 2) k #f)))) (set! mi (car r)) (loop (+ pi k) (cdr r))))
((char=? c #\s) (let ((r (read-digits ii))) (set! ss (car r)) (loop (+ pi k) (cdr r)))) ((char=? c #\s) (let ((r (read-digits-w ii (if (>= k 2) k #f)))) (set! ss (car r)) (loop (+ pi k) (cdr r))))
((char=? c #\E) (loop (+ pi k) (cdr (read-alpha ii)))) ((char=? c #\E) (loop (+ pi k) (cdr (read-alpha ii))))
((char=? c #\a) (let ((r (read-alpha ii))) ((char=? c #\a) (let ((r (read-alpha ii)))
(set! pm (if (string=? (ascii-string-down (car r)) "pm") 'pm 'am)) (set! pm (if (string=? (ascii-string-down (car r)) "pm") 'pm 'am))
(loop (+ pi k) (cdr r)))) (loop (+ pi k) (cdr r))))
((or (char=? c #\z) (char=? c #\Z) (char=? c #\X)) (loop (+ pi k) (read-tz ii))) ((or (char=? c #\z) (char=? c #\Z) (char=? c #\X) (char=? c #\x) (char=? c #\V) (char=? c #\v)) (loop (+ pi k) (read-tz ii)))
(else (loop (+ pi k) ii))))) (else (loop (+ pi k) ii)))))
((char=? c #\') ((char=? c #\')
(if (and (< (+ pi 1) pn) (char=? (string-ref pattern (+ pi 1)) #\')) (if (and (< (+ pi 1) pn) (char=? (string-ref pattern (+ pi 1)) #\'))
@ -245,7 +260,9 @@
;; java.time.Instant/ZonedDateTime/LocalDateTime values (mk-instant/mk-zoned/mk-local ;; 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 =. ;; 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" "local-date" "sql-date")) #t)) ;; java.time LocalDate/LocalTime/LocalDateTime own their = / hash in java-time.ss;
;; this arm covers the ms-based shim values (instant / zoned-dt / sql-date).
(define (time-jhost? x) (and (jhost? x) (member (jhost-tag x) '("instant" "zoned-dt" "sql-date")) #t))
(register-eq-arm! (lambda (a b) (or (time-jhost? a) (time-jhost? b))) (register-eq-arm! (lambda (a b) (or (time-jhost? a) (time-jhost? b)))
(lambda (a b) (and (time-jhost? a) (time-jhost? b) (lambda (a b) (and (time-jhost? a) (time-jhost? b)
(string=? (jhost-tag a) (jhost-tag b)) (string=? (jhost-tag a) (jhost-tag b))
@ -274,7 +291,6 @@
((string=? tn "Timestamp") #f) ((string=? tn "Timestamp") #f)
(else 'pass))) (else 'pass)))
((and (jhost? val) (string=? (jhost-tag val) "instant")) (if (string=? tn "Instant") #t 'pass)) ((and (jhost? val) (string=? (jhost-tag val) "instant")) (if (string=? tn "Instant") #t 'pass))
((and (jhost? val) (string=? (jhost-tag val) "local-dt")) (if (string=? tn "LocalDateTime") #t 'pass))
;; java.sql.Date is a java.util.Date subclass (but not a Timestamp). ;; java.sql.Date is a java.util.Date subclass (but not a Timestamp).
((and (jhost? val) (string=? (jhost-tag val) "sql-date")) ((and (jhost? val) (string=? (jhost-tag val) "sql-date"))
(cond ((or (string=? tn "Date")) #t) ((string=? tn "Timestamp") #f) (else 'pass))) (cond ((or (string=? tn "Date")) #t) ((string=? tn "Timestamp") #f) (else 'pass)))
@ -284,16 +300,31 @@
(def-var! "clojure.core" "inst-ms*" (lambda (i) (jinst-ms i))) (def-var! "clojure.core" "inst-ms*" (lambda (i) (jinst-ms i)))
;; --- java.time shim values (jhost objects over host-static.ss registries) ----- ;; --- java.time shim values (jhost objects over host-static.ss registries) -----
;; "local-date" stores an epoch-day (java-time.ss owns the type); ms-of projects it
;; to UTC midnight so existing date math keeps working. "local-dt" stores epoch-day +
;; nano-of-day; the others store epoch-ms.
(define (ms-of d) (define (ms-of d)
(cond ((number? d) d) (cond ((number? d) d)
((jinst? d) (jinst-ms d)) ((jinst? d) (jinst-ms d))
((and (jhost? d) (member (jhost-tag d) '("instant" "zoned-dt" "local-dt" "local-date" "calendar" "sql-date"))) ((and (jhost? d) (string=? (jhost-tag d) "local-date"))
(* (vector-ref (jhost-state d) 0) 86400000))
((and (jhost? d) (string=? (jhost-tag d) "local-date-time"))
(+ (* (vector-ref (jhost-state d) 0) 86400000)
(quotient (vector-ref (jhost-state d) 1) 1000000)))
((and (jhost? d) (member (jhost-tag d) '("instant" "zoned-dt" "calendar" "sql-date")))
(vector-ref (jhost-state d) 0)) (vector-ref (jhost-state d) 0))
(else (error #f "not a date value" d)))) (else (error #f "not a date value" d))))
(define (mk-instant ms) (make-jhost "instant" (vector ms))) (define (mk-instant ms) (make-jhost "instant" (vector ms)))
(define (mk-zoned ms) (make-jhost "zoned-dt" (vector ms))) (define (mk-zoned ms) (make-jhost "zoned-dt" (vector ms)))
(define (mk-local ms) (make-jhost "local-dt" (vector ms))) ;; LocalDateTime from epoch-ms (UTC): the java-time.ss "local-date-time" jhost,
(define (mk-local-date ms) (make-jhost "local-date" (vector ms))) ;; state [epoch-day nano-of-day].
(define (mk-local ms)
(let* ((ems (exact (truncate ms)))
(ed (inst-floor-div ems 86400000))
(mod (inst-floor-mod ems 86400000)))
(make-jhost "local-date-time" (vector ed (* mod 1000000)))))
;; local-date from epoch-ms: the epoch-day of the UTC day containing ms.
(define (mk-local-date ms) (make-jhost "local-date" (vector (inst-floor-div (exact (truncate ms)) 86400000))))
;; start of the UTC day containing ms. ;; start of the UTC day containing ms.
(define (start-of-utc-day ms) (define (start-of-utc-day ms)
(* (inst-floor-div (exact (truncate ms)) 86400000) 86400000)) (* (inst-floor-div (exact (truncate ms)) 86400000) 86400000))
@ -310,13 +341,10 @@
(register-host-methods! "zoned-dt" (register-host-methods! "zoned-dt"
(list (cons "toLocalDateTime" (lambda (self) (mk-local (ms-of self)))) (list (cons "toLocalDateTime" (lambda (self) (mk-local (ms-of self))))
(cons "toInstant" (lambda (self) (mk-instant (ms-of self)))))) (cons "toInstant" (lambda (self) (mk-instant (ms-of self))))))
(register-host-methods! "local-dt" ;; LocalDate.atZone(zone): the UTC layer treats it as a zoned value at midnight.
(list (cons "atZone" (lambda (self zone) (mk-zoned (ms-of self)))) ;; (java-time.ss registers atStartOfDay and the rest of the local-date surface.)
(cons "toLocalDate" (lambda (self) (mk-local-date (ms-of self))))))
;; LocalDate.atStartOfDay(zone): midnight of the UTC day (the layer is UTC).
(register-host-methods! "local-date" (register-host-methods! "local-date"
(list (cons "atStartOfDay" (lambda (self . zone) (mk-zoned (start-of-utc-day (ms-of self))))) (list (cons "atZone" (lambda (self zone) (mk-zoned (ms-of self))))))
(cons "atZone" (lambda (self zone) (mk-zoned (ms-of self))))))
(register-host-methods! "dt-formatter" (register-host-methods! "dt-formatter"
(list (cons "withLocale" (lambda (self locale) (mk-formatter (fmt-pat self)))) (list (cons "withLocale" (lambda (self locale) (mk-formatter (fmt-pat self))))
(cons "withZone" (lambda (self zone) (mk-formatter (fmt-pat self)))) (cons "withZone" (lambda (self zone) (mk-formatter (fmt-pat self))))
@ -380,6 +408,9 @@
(list (cons "getDefault" (lambda () (make-jhost "locale" (vector "default")))) (list (cons "getDefault" (lambda () (make-jhost "locale" (vector "default"))))
(cons "ENGLISH" (make-jhost "locale" (vector "en"))) (cons "ENGLISH" (make-jhost "locale" (vector "en")))
(cons "US" (make-jhost "locale" (vector "en-US"))) (cons "US" (make-jhost "locale" (vector "en-US")))
(cons "FRENCH" (make-jhost "locale" (vector "fr")))
(cons "FRANCE" (make-jhost "locale" (vector "fr-FR")))
(cons "GERMAN" (make-jhost "locale" (vector "de")))
(cons "ROOT" (make-jhost "locale" (vector "root"))))) (cons "ROOT" (make-jhost "locale" (vector "root")))))
;; java.util.Date / java.sql.Timestamp: #inst's classes. (Date.) = now, (Date. ms) ;; java.util.Date / java.sql.Timestamp: #inst's classes. (Date.) = now, (Date. ms)
@ -391,6 +422,10 @@
(register-class-ctor! "java.util.Date" date-ctor) (register-class-ctor! "java.util.Date" date-ctor)
(register-class-ctor! "Timestamp" date-ctor) (register-class-ctor! "Timestamp" date-ctor)
(register-class-ctor! "java.sql.Timestamp" date-ctor) (register-class-ctor! "java.sql.Timestamp" date-ctor)
;; Date/from(Instant) -> a java.util.Date at the instant's epoch-ms.
(let ((date-statics (list (cons "from" (lambda (inst) (make-jinst (ms->exact (ms-of inst))))))))
(register-class-statics! "Date" date-statics)
(register-class-statics! "java.util.Date" date-statics))
;; java.sql.Date: a distinct class from java.util.Date (a "sql-date" jhost over ;; java.sql.Date: a distinct class from java.util.Date (a "sql-date" jhost over
;; epoch-ms) so a protocol extended to both routes a sql.Date to its own impl. ;; epoch-ms) so a protocol extended to both routes a sql.Date to its own impl.
;; (Date. year-1900 month0 day) builds UTC midnight of that civil date; valueOf ;; (Date. year-1900 month0 day) builds UTC midnight of that civil date; valueOf

2072
host/chez/java-time.ss Normal file
View file

File diff suppressed because it is too large Load diff

24
host/chez/records.ss
View file

@ -141,6 +141,23 @@
((jinst? obj) '("Date" "java.util.Date" "Timestamp" "java.sql.Timestamp" "Object")) ((jinst? obj) '("Date" "java.util.Date" "Timestamp" "java.sql.Timestamp" "Object"))
((jbigdec? obj) '("BigDecimal" "java.math.BigDecimal" "Number" "Object")) ((jbigdec? obj) '("BigDecimal" "java.math.BigDecimal" "Number" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "instant")) '("Instant" "java.time.Instant" "Object")) ((and (jhost? obj) (string=? (jhost-tag obj) "instant")) '("Instant" "java.time.Instant" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "local-date")) '("LocalDate" "java.time.LocalDate" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "local-time")) '("LocalTime" "java.time.LocalTime" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "local-date-time")) '("LocalDateTime" "java.time.LocalDateTime" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "duration")) '("Duration" "java.time.Duration" "TemporalAmount" "java.time.temporal.TemporalAmount" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "period")) '("Period" "java.time.Period" "TemporalAmount" "java.time.temporal.TemporalAmount" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "month-enum")) '("Month" "java.time.Month" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "dow-enum")) '("DayOfWeek" "java.time.DayOfWeek" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "year")) '("Year" "java.time.Year" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "year-month")) '("YearMonth" "java.time.YearMonth" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "chrono-unit")) '("ChronoUnit" "java.time.temporal.ChronoUnit" "TemporalUnit" "java.time.temporal.TemporalUnit" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "chrono-field")) '("ChronoField" "java.time.temporal.ChronoField" "TemporalField" "java.time.temporal.TemporalField" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "zone-offset")) '("ZoneOffset" "java.time.ZoneOffset" "ZoneId" "java.time.ZoneId" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "zone-id")) '("ZoneId" "java.time.ZoneId" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "zoned-date-time")) '("ZonedDateTime" "java.time.ZonedDateTime" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "offset-date-time")) '("OffsetDateTime" "java.time.OffsetDateTime" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "offset-time")) '("OffsetTime" "java.time.OffsetTime" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "clock")) '("Clock" "java.time.Clock" "Object"))
;; java.sql.Date — a distinct class from java.util.Date so a protocol ;; java.sql.Date — a distinct class from java.util.Date so a protocol
;; extended to both (data.json's JSONWriter) routes a sql.Date to its impl. ;; extended to both (data.json's JSONWriter) routes a sql.Date to its impl.
((and (jhost? obj) (string=? (jhost-tag obj) "sql-date")) '("java.sql.Date" "Date" "java.util.Date" "Object")) ((and (jhost? obj) (string=? (jhost-tag obj) "sql-date")) '("java.sql.Date" "Date" "java.util.Date" "Object"))
@ -195,7 +212,12 @@
"ASeq" "ISeq" "IPersistentCollection" "Associative" "Sequential" "ASeq" "ISeq" "IPersistentCollection" "Associative" "Sequential"
"Map" "java.util.Map" "List" "java.util.List" "Set" "java.util.Set" "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" "java.sql.Date")) "UUID" "BigDecimal" "Date" "Timestamp" "Instant" "java.sql.Date"
;; java.time value types (extend-protocol Duration / ZonedDateTime / …)
"Duration" "Period" "LocalDate" "LocalTime" "LocalDateTime"
"ZonedDateTime" "OffsetDateTime" "OffsetTime" "ZoneId" "ZoneOffset"
"Clock" "Year" "YearMonth" "Month" "DayOfWeek"
"ChronoUnit" "ChronoField" "TemporalAmount" "TemporalUnit" "TemporalField"))
h)) h))
(define (strip-prefix s p) (define (strip-prefix s p)
(let ((pl (string-length p))) (let ((pl (string-length p)))

6
host/chez/rt.ss
View file

@ -351,6 +351,12 @@
;; jolt-pr-str / jolt-type / instance-check and uses host-static.ss's registries. ;; jolt-pr-str / jolt-type / instance-check and uses host-static.ss's registries.
(load "host/chez/inst-time.ss") (load "host/chez/inst-time.ss")
;; java.time value types: LocalDate / LocalTime / LocalDateTime / Instant as
;; tz-free jhost values (epoch-day / nano-of-day / epoch-ms). Loads after
;; inst-time.ss — it reuses its civil<->days helpers, the jhost registries, and
;; re-registers a few LocalDateTime/Instant statics to use the richer reps.
(load "host/chez/java-time.ss")
;; Chez-side data reader: read-string / __parse-next / ;; Chez-side data reader: read-string / __parse-next /
;; __read-tagged. Loads after inst-time.ss — __read-tagged reuses its #uuid/#inst ;; __read-tagged. Loads after inst-time.ss — __read-tagged reuses its #uuid/#inst
;; constructors, and the reader needs the full value/collection layer above. ;; constructors, and the reader needs the full value/collection layer above.

12
host/chez/seed/image.ss
View file

File diff suppressed because one or more lines are too long

2
host/chez/seed/prelude.ss
View file

File diff suppressed because one or more lines are too long

28
jolt-core/clojure/core/00-syntax.clj
View file

@ -217,17 +217,19 @@
as-sym (get pat :as) as-sym (get pat :as)
bound (conj (conj (conj (conj acc g) init) gm) coerce) bound (conj (conj (conj (conj acc g) init) gm) coerce)
base (if as-sym (conj (conj bound as-sym) gm) bound) base (if as-sym (conj (conj bound as-sym) gm) bound)
;; group binds a :keys/:strs/:syms list. dnsp is the destructuring
;; namespace from a qualified key like :ns/keys — it both prefixes
;; the lookup key and overrides a bare symbol's namespace.
group group
(fn* [a kw kind] (fn* group [a names kind dnsp]
(let* [names (get pat kw)] (if names
(if names
(reduce (reduce
;; s is a symbol (a b) or a keyword (:a :b); name/ ;; s is a symbol (a b) or a keyword (:a :b); name/
;; namespace handle both, so :keys [:major] binds ;; namespace handle both, so :keys [:major] binds
;; `major` looking up :major (str would keep the colon). ;; `major` looking up :major (str would keep the colon).
(fn* [aa s] (fn* [aa s]
(let* [local (name s) (let* [local (name s)
nsp (namespace s) nsp (or (namespace s) dnsp)
keyform (cond keyform (cond
(= kind :kw) (keyword (if nsp (str nsp "/" local) local)) (= kind :kw) (keyword (if nsp (str nsp "/" local) local))
(= kind :str) local (= kind :str) local
@ -238,13 +240,21 @@
`(get ~gm ~keyform ~(nth fo 1)) `(get ~gm ~keyform ~(nth fo 1))
`(get ~gm ~keyform))))) `(get ~gm ~keyform)))))
a names) a names)
a))) a))
g1 (group base :keys :kw) g1 (group base (get pat :keys) :kw nil)
g2 (group g1 :strs :str) g2 (group g1 (get pat :strs) :str nil)
g3 (group g2 :syms :sym)] g3 (group g2 (get pat :syms) :sym nil)]
;; remaining keys: a qualified :ns/keys|:ns/strs|:ns/syms groups under
;; its namespace; any other keyword is skipped; a non-keyword is a
;; nested binding pattern.
(reduce (fn* [a k] (reduce (fn* [a k]
(if (keyword? k) (if (keyword? k)
a (let* [kn (name k) kns (namespace k)]
(cond
(and kns (= kn "keys")) (group a (get pat k) :kw kns)
(and kns (= kn "strs")) (group a (get pat k) :str kns)
(and kns (= kn "syms")) (group a (get pat k) :sym kns)
:else a))
(proc k `(get ~gm ~(get pat k)) a))) (proc k `(get ~gm ~(get pat k)) a)))
g3 (keys pat))) g3 (keys pat)))
:else (throw (str "unsupported destructuring pattern: " (pr-str pat))))) :else (throw (str "unsupported destructuring pattern: " (pr-str pat)))))

15
jolt-core/jolt/analyzer.clj
View file

@ -478,12 +478,23 @@
(defn- analyze-dot [ctx items env] (defn- analyze-dot [ctx items env]
(when (< (count items) 3) (when (< (count items) 3)
(throw (str "Malformed (. target member ...) form"))) (throw (str "Malformed (. target member ...) form")))
(let [member (nth items 2)] (let [target (nth items 1)
member (nth items 2)
;; (. Class method args*) with a class target is a static call —
;; equivalent to (Class/method args*). resolve-global tags a class
;; symbol :kind :class; a local of the same name shadows it.
class-target (when (and (form-sym? target)
(not (local? env (form-sym-name target))))
(let [r (resolve-global ctx target)]
(when (= :class (:kind r)) (:name r))))]
(cond (cond
(and class-target (form-sym? member))
(invoke (host-static class-target (form-sym-name member))
(mapv #(analyze ctx % env) (drop 3 items)))
(form-sym? member) (form-sym? member)
{:op :host-call {:op :host-call
:method (form-sym-name member) :method (form-sym-name member)
:target (analyze ctx (nth items 1) env) :target (analyze ctx target env)
:args (mapv #(analyze ctx % env) (drop 3 items))} :args (mapv #(analyze ctx % env) (drop 3 items))}
;; (. obj :kw) is a keyword lookup — invoke the keyword on the target. ;; (. obj :kw) is a keyword lookup — invoke the keyword on the target.
(form-keyword? member) (form-keyword? member)

36
test/chez/corpus.edn
View file

@ -2999,4 +2999,40 @@
{: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 "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 "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)]))"} {: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)]))"}
{:suite "interop / java.time" :label "LocalDate toString" :expected "\"2020-01-15\"" :actual "(str (java.time.LocalDate/of 2020 1 15))"}
{:suite "interop / java.time" :label "LocalDate plusDays over leap day" :expected "\"2020-02-29\"" :actual "(str (.plusDays (java.time.LocalDate/of 2020 2 28) 1))"}
{:suite "interop / java.time" :label "LocalDate equality" :expected "true" :actual "(= (java.time.LocalDate/of 2020 1 15) (java.time.LocalDate/of 2020 1 15))"}
{:suite "interop / java.time" :label "LocalDate compare" :expected "-1" :actual "(compare (java.time.LocalDate/of 2020 1 15) (java.time.LocalDate/of 2020 1 16))"}
{:suite "interop / java.time" :label "LocalDate ofEpochDay round-trip" :expected "1" :actual "(.toEpochDay (java.time.LocalDate/of 1970 1 2))"}
{:suite "interop / java.time" :label "LocalDate parse" :expected "\"2020-01-15\"" :actual "(str (java.time.LocalDate/parse \"2020-01-15\"))"}
{:suite "interop / java.time" :label "LocalDate getDayOfWeek name" :expected "\"WEDNESDAY\"" :actual "(.name (.getDayOfWeek (java.time.LocalDate/of 2020 1 15)))"}
{:suite "interop / java.time" :label "LocalTime toString" :expected "\"10:30:15\"" :actual "(str (java.time.LocalTime/of 10 30 15))"}
{:suite "interop / java.time" :label "LocalTime plusHours wraps midnight" :expected "\"01:30\"" :actual "(str (.plusHours (java.time.LocalTime/of 23 30) 2))"}
{:suite "interop / java.time" :label "LocalDateTime toString" :expected "\"2020-01-15T10:30\"" :actual "(str (java.time.LocalDateTime/of 2020 1 15 10 30 0))"}
{:suite "interop / java.time" :label "Instant ofEpochMilli toString" :expected "\"2020-01-15T10:30:00Z\"" :actual "(str (java.time.Instant/ofEpochMilli 1579084200000))"}
{:suite "interop / java.time" :label "Instant ofEpochMilli round-trip" :expected "1579084200000" :actual "(.toEpochMilli (java.time.Instant/ofEpochMilli 1579084200000))"}
{:suite "interop / java.time" :label "Duration ofSeconds toString" :expected "\"PT1M30S\"" :actual "(str (java.time.Duration/ofSeconds 90))"}
{:suite "interop / java.time" :label "Duration between instants" :expected "\"PT1H1M1S\"" :actual "(str (java.time.Duration/between (java.time.Instant/ofEpochSecond 0) (java.time.Instant/ofEpochSecond 3661)))"}
{:suite "interop / java.time" :label "Period between dates" :expected "\"P1Y2M2D\"" :actual "(str (java.time.Period/between (java.time.LocalDate/of 2020 1 1) (java.time.LocalDate/of 2021 3 3)))"}
{:suite "interop / java.time" :label "Period parse round-trip" :expected "\"P1Y2M3D\"" :actual "(str (java.time.Period/parse \"P1Y2M3D\"))"}
{:suite "interop / java.time" :label "Period normalized" :expected "\"P2Y1M5D\"" :actual "(str (.normalized (java.time.Period/of 1 13 5)))"}
{:suite "interop / java.time" :label "Month of toString" :expected "\"FEBRUARY\"" :actual "(.toString (java.time.Month/of 2))"}
{:suite "interop / java.time" :label "Month length leap" :expected "29" :actual "(.length (java.time.Month/of 2) true)"}
{:suite "interop / java.time" :label "DayOfWeek constant prints name" :expected "\"MONDAY\"" :actual "(str java.time.DayOfWeek/MONDAY)"}
{:suite "interop / java.time" :label "YearMonth toString" :expected "\"2020-02\"" :actual "(str (java.time.YearMonth/of 2020 2))"}
{:suite "interop / java.time" :label "ChronoUnit DAYS between" :expected "14" :actual "(.between java.time.temporal.ChronoUnit/DAYS (java.time.LocalDate/of 2020 1 1) (java.time.LocalDate/of 2020 1 15))"}
{:suite "interop / java.time" :label "LocalDate plus ChronoUnit DAYS" :expected "\"2020-01-04\"" :actual "(str (.plus (java.time.LocalDate/of 2020 1 1) 3 java.time.temporal.ChronoUnit/DAYS))"}
{:suite "interop / java.time" :label "LocalDate until ChronoUnit DAYS" :expected "31" :actual "(.until (java.time.LocalDate/of 2020 1 1) (java.time.LocalDate/of 2020 2 1) java.time.temporal.ChronoUnit/DAYS)"}
{:suite "interop / java.time" :label "ZoneOffset ofHoursMinutes toString" :expected "\"+02:00\"" :actual "(str (java.time.ZoneOffset/ofHoursMinutes 2 0))"}
{:suite "interop / java.time" :label "ZoneOffset ofTotalSeconds toString" :expected "\"-04:30\"" :actual "(str (java.time.ZoneOffset/ofTotalSeconds -16200))"}
{:suite "interop / java.time" :label "ZoneOffset UTC toString" :expected "\"Z\"" :actual "(str java.time.ZoneOffset/UTC)"}
{:suite "interop / java.time" :label "ZoneOffset of getTotalSeconds" :expected "7200" :actual "(.getTotalSeconds (java.time.ZoneOffset/of \"+02:00\"))"}
{:suite "interop / java.time" :label "ZoneOffset ofHoursMinutes negative" :expected "\"-04:30\"" :actual "(.getId (java.time.ZoneOffset/ofHoursMinutes -4 -30))"}
{:suite "interop / java.time" :label "OffsetDateTime toInstant" :expected "\"2020-01-15T08:30:00Z\"" :actual "(str (.toInstant (java.time.OffsetDateTime/of 2020 1 15 10 30 0 0 (java.time.ZoneOffset/ofHours 2))))"}
{:suite "interop / java.time" :label "OffsetDateTime toString" :expected "\"2020-01-15T10:30+02:00\"" :actual "(str (java.time.OffsetDateTime/of 2020 1 15 10 30 0 0 (java.time.ZoneOffset/ofHours 2)))"}
{:suite "interop / java.time" :label "ZonedDateTime withZoneSameInstant UTC" :expected "\"2020-01-15T08:30Z\"" :actual "(str (.withZoneSameInstant (java.time.ZonedDateTime/parse \"2020-01-15T10:30:00+02:00[Europe/Paris]\") java.time.ZoneOffset/UTC))"}
{:suite "interop / java.time" :label "ZonedDateTime of toInstant fixed offset" :expected "\"2020-01-15T08:30:00Z\"" :actual "(str (.toInstant (java.time.ZonedDateTime/of 2020 1 15 10 30 0 0 (java.time.ZoneId/of \"+02:00\"))))"}
{:suite "interop / java.time" :label "DateTimeFormatter ofPattern format" :expected "\"2020-01-15 10:30:00\"" :actual "(.format (java.time.format.DateTimeFormatter/ofPattern \"yyyy-MM-dd HH:mm:ss\") (java.time.LocalDateTime/of 2020 1 15 10 30 0))"}
{:suite "interop / java.time" :label "ISO_LOCAL_DATE_TIME format" :expected "\"2020-01-15T10:30:00\"" :actual "(.format java.time.format.DateTimeFormatter/ISO_LOCAL_DATE_TIME (java.time.LocalDateTime/of 2020 1 15 10 30 0))"}
{:suite "interop / java.time" :label "ISO_OFFSET_DATE_TIME format" :expected "\"2020-01-15T10:30:00+02:00\"" :actual "(.format java.time.format.DateTimeFormatter/ISO_OFFSET_DATE_TIME (java.time.OffsetDateTime/of 2020 1 15 10 30 0 0 (java.time.ZoneOffset/ofHours 2)))"}
] ]