Conformance: SimpleDateFormat parse + read over host readers

- java.text.SimpleDateFormat.parse parses the RFC1123/1036/asctime patterns
  (day/month names, 2-digit-year sliding window, tz token), and .format renders
  z/Z/X timezone tokens (GMT/+0000/Z) instead of emitting them literally. Date
  gains toLocalDate/toLocalDateTime/before/after/equals. Fixes ring.util.time.
- read / read+string work over a host java.io reader (StringReader wrapped in a
  PushbackReader): drain, parse one form, push the tail back. Fixes cuerdas
  istr / << string interpolation (and selmer's <<), which read embedded forms
  from the template via (read pushback-reader).

host/chez/inst-time.ss

@@ -150,9 +150,83 @@
               ((char=? c #\m) (display (if (= k 1) (number->string mi) (pad2 mi)) out) (loop (+ i k)))
               ((char=? c #\s) (display (if (= k 1) (number->string se) (pad2 se)) out) (loop (+ i k)))
               ((char=? c #\a) (display (if (< hh 12) "AM" "PM") out) (loop (+ i k)))
+              ;; timezone — format-ms renders UTC, the HTTP zone is GMT: z/zzz -> GMT,
+              ;; Z (RFC822) -> +0000, X (ISO) -> Z.
+              ((char=? c #\z) (display "GMT" out) (loop (+ i k)))
+              ((char=? c #\Z) (display "+0000" out) (loop (+ i k)))
+              ((char=? c #\X) (display "Z" out) (loop (+ i k)))
               (else (write-char c out) (loop (+ i 1)))))))
       (get-output-string out))))
 
+;; --- SimpleDateFormat .parse: pattern-driven parse to epoch-ms (UTC/GMT) ------
+(define (month-from-name s)
+  (let ((m3 (ascii-string-down (substring s 0 (min 3 (string-length s))))))
+    (let loop ((i 0))
+      (cond ((= i 12) #f)
+            ((string=? (ascii-string-down (substring (vector-ref month-names i) 0 3)) m3) (+ i 1))
+            (else (loop (+ i 1)))))))
+(define (parse-ms pattern input)
+  (let ((pn (string-length pattern)) (inn (string-length input))
+        (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 (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
+      (let loop ((j ii) (acc 0) (any #f))
+        (if (and (< j inn) (digit? (string-ref input j)))
+            (loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref input j)) 48)) #t)
+            (if any (cons acc j) (pfail)))))
+    (define (read-alpha ii)              ; -> (str . next)
+      (let loop ((j ii)) (if (and (< j inn) (char-alphabetic? (string-ref input j))) (loop (+ j 1))
+                             (cons (substring input ii j) j))))
+    (define (read-tz ii)                 ; consume GMT/UTC/Z or ±hhmm; -> next
+      (cond ((>= ii inn) ii)
+            ((char-alphabetic? (string-ref input ii)) (cdr (read-alpha ii)))
+            ((or (char=? (string-ref input ii) #\+) (char=? (string-ref input ii) #\-))
+             (let loop ((j (+ ii 1))) (if (and (< j inn) (or (digit? (string-ref input j)) (char=? (string-ref input j) #\:))) (loop (+ j 1)) j)))
+            (else ii)))
+    (let loop ((pi 0) (ii 0))
+      (if (>= pi pn)
+          (begin
+            (when (eq? pm 'pm) (when (< hh 12) (set! hh (+ hh 12))))
+            (when (eq? pm 'am) (when (= hh 12) (set! hh 0)))
+            (make-jinst (* 1000 (+ (* (days-from-civil y mo d) 86400) (* hh 3600) (* mi 60) ss))))
+          (let ((c (string-ref pattern pi)))
+            (cond
+              ((char-alphabetic? c)
+               (let ((k (run-len pi c)))
+                 (cond
+                   ((char=? c #\y) (let ((r (read-digits ii)))
+                                     ;; 2-digit year (value < 100): JVM sliding window — 00-68 -> 20xx,
+                                     ;; 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)))
+                                     (loop (+ pi k) (cdr r))))
+                   ((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-digits ii))) (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))))
+                   ((or (char=? c #\H) (char=? c #\h)) (let ((r (read-digits ii))) (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 #\s) (let ((r (read-digits ii))) (set! ss (car r)) (loop (+ pi k) (cdr r))))
+                   ((char=? c #\E) (loop (+ pi k) (cdr (read-alpha ii))))
+                   ((char=? c #\a) (let ((r (read-alpha ii)))
+                                     (set! pm (if (string=? (ascii-string-down (car r)) "pm") 'pm 'am))
+                                     (loop (+ pi k) (cdr r))))
+                   ((or (char=? c #\z) (char=? c #\Z) (char=? c #\X)) (loop (+ pi k) (read-tz ii)))
+                   (else (loop (+ pi k) ii)))))
+              ((char=? c #\')
+               (if (and (< (+ pi 1) pn) (char=? (string-ref pattern (+ pi 1)) #\'))
+                   (loop (+ pi 2) (if (and (< ii inn) (char=? (string-ref input ii) #\')) (+ ii 1) ii))
+                   (let lit ((pj (+ pi 1)) (ij ii))
+                     (cond ((>= pj pn) (loop pj ij))
+                           ((char=? (string-ref pattern pj) #\') (loop (+ pj 1) ij))
+                           ((and (< ij inn) (char=? (string-ref input ij) (string-ref pattern pj))) (lit (+ pj 1) (+ ij 1)))
+                           (else (pfail))))))
+              ;; literal: match it; a pattern space tolerates missing/extra spaces.
+              ((char=? c #\space)
+               (let skip ((ij ii)) (if (and (< ij inn) (char=? (string-ref input ij) #\space)) (skip (+ ij 1)) (loop (+ pi 1) ij))))
+              ((and (< ii inn) (char=? (string-ref input ii) c)) (loop (+ pi 1) (+ ii 1)))
+              (else (pfail))))))))
+
 ;; --- value integration: get / = / hash / pr / type / instance? --------------
 (define kw-jolt-type (keyword "jolt" "type"))
 (define kw-ms (keyword #f "ms"))
@@ -303,6 +377,10 @@
 (register-class-ctor! "java.text.SimpleDateFormat" sdf-ctor)
 (register-host-methods! "sdf"
   (list (cons "setTimeZone" (lambda (self tz) jolt-nil))
+        (cons "setLenient" (lambda (self b) jolt-nil))
+        (cons "applyPattern" (lambda (self p) (vector-set! (jhost-state self) 0 (jolt-str-render-one p)) jolt-nil))
+        (cons "toPattern" (lambda (self) (vector-ref (jhost-state self) 0)))
+        (cons "parse" (lambda (self s) (parse-ms (vector-ref (jhost-state self) 0) (jolt-str-render-one s))))
         (cons "format" (lambda (self d) (format-ms (vector-ref (jhost-state self) 0) (ms-of d))))))
 
 ;; a jinst's java.util.Date method surface (record-method-dispatch arm).
@@ -313,6 +391,13 @@
       ((jinst? obj)
        (cond ((string=? method-name "getTime") (jinst-ms obj))
              ((string=? method-name "toInstant") (mk-instant (jinst-ms obj)))
+             ((string=? method-name "toLocalDate") (mk-local (jinst-ms obj)))
+             ((string=? method-name "toLocalDateTime") (mk-local (jinst-ms obj)))
              ((string=? method-name "toString") (inst-rfc3339 obj))
+             ((string=? method-name "equals") (and (pair? (if (jolt-nil? rest-args) '() (seq->list rest-args)))
+                                                   (jinst? (car (seq->list rest-args)))
+                                                   (= (jinst-ms obj) (jinst-ms (car (seq->list rest-args))))))
+             ((string=? method-name "before") (< (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
+             ((string=? method-name "after") (> (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
              (else (error #f (string-append "No method " method-name " on Date")))))
       (else (%it-rmd obj method-name rest-args)))))

host/chez/io.ss

@@ -130,6 +130,23 @@
 (define (reader-jhost? x)
   (and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader"))))
 
+;; Refill a host reader so subsequent read/slurp see `s` (the unconsumed tail).
+(define (reader-refill! r s)
+  (cond
+    ((string=? (jhost-tag r) "string-reader")
+     (vector-set! (jhost-state r) 0 s) (vector-set! (jhost-state r) 1 0))
+    ((string=? (jhost-tag r) "pushback-reader")
+     (vector-set! (jhost-state r) 0 (host-new "StringReader" s))
+     (vector-set! (jhost-state r) 1 '()))))
+;; Read ONE form from a host reader (StringReader/PushbackReader): drain the
+;; remaining chars, parse one form, push the tail back. -> (values form found?).
+;; (read r) over a java.io reader — cuerdas' interpolation reads this way.
+(define (host-reader-read-form r)
+  (let* ((s (drain-reader r)) (pr (jolt-parse-next s)))
+    (if (jolt-nil? pr)
+        (begin (reader-refill! r "") (values jolt-nil #f))
+        (begin (reader-refill! r (jolt-nth pr 1)) (values (jolt-nth pr 0) #t)))))
+
 ;; clojure.edn/read over a reader (jolt-uicd): the overlay edn.clj's drain-reader is
 ;; janet/type-coupled, so on Chez we drain the jhost reader to a string and read the
 ;; first EDN form (read-string). Re-asserted over the prelude in post-prelude.ss.

host/chez/post-prelude.ss

@@ -101,3 +101,40 @@
 ;; :jolt/deftype)) — the get-trick invokes a sorted-map's comparator on
 ;; :jolt/deftype and throws (jolt-3bbj). Matches the JVM (instance? IRecord).
 (def-var! "clojure.core" "record?" (lambda (x) (jrec? x)))
+
+;; read / read+string over a HOST reader jhost (java.io StringReader/PushbackReader):
+;; the overlay's IReader protocol only covers the reify map-reader, so a (read
+;; pushback-reader) — cuerdas' string interpolation — would miss. Intercept a host
+;; reader; everything else (the *in* reify) delegates to the overlay.
+(let ((ov-read (var-deref "clojure.core" "read")))
+  (def-var! "clojure.core" "read"
+    (case-lambda
+      (() (jolt-invoke ov-read))
+      ((stream)
+       (if (reader-jhost? stream)
+           (let-values (((form found?) (host-reader-read-form stream)))
+             (if found? form (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))))
+           (jolt-invoke ov-read stream)))
+      ((stream e? ev)
+       (if (reader-jhost? stream)
+           (let-values (((form found?) (host-reader-read-form stream)))
+             (cond (found? form)
+                   ((jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap))))
+                   (else ev)))
+           (jolt-invoke ov-read stream e? ev))))))
+(let ((ov-rps (var-deref "clojure.core" "read+string")))
+  (def-var! "clojure.core" "read+string"
+    (case-lambda
+      (() (jolt-invoke ov-rps))
+      ((stream) (jolt-invoke (var-deref "clojure.core" "read+string") stream #t jolt-nil))
+      ((stream e? ev)
+       (if (reader-jhost? stream)
+           (let* ((s (drain-reader stream)) (pr (jolt-parse-next s)))
+             (if (jolt-nil? pr)
+                 (begin (reader-refill! stream "")
+                        (if (jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))
+                            (jolt-vector ev "")))
+                 (let ((rest (jolt-nth pr 1)))
+                   (reader-refill! stream rest)
+                   (jolt-vector (jolt-nth pr 0) (substring s 0 (- (string-length s) (string-length rest)))))))
+           (jolt-invoke ov-rps stream e? ev))))))

test/chez/unit.edn

@@ -101,6 +101,13 @@
   {:suite "hostctor" :expr "(instance? java.net.URI (java.net.URI. \"/x\"))" :expected "true"}
   {:suite "hostctor" :expr "(let [a (java.util.ArrayList.)] (.add a 1) (.add a 2) (.add a 3) (.remove a 0) [(.size a) (vec (.toArray a))])" :expected "[2 [2 3]]"}
   {:suite "hostctor" :expr "[(.indexOf [:a :b :c] :b) (.indexOf (list :a :b) :b) (.indexOf [:a] :z) (.indexOf (range 0 10) 1)]" :expected "[1 1 -1 1]"}
+  {:suite "sdf" :expr "(.format (java.text.SimpleDateFormat. \"EEE, dd MMM yyyy HH:mm:ss zzz\") (java.util.Date. 1348401170000))" :expected "Sun, 23 Sep 2012 11:52:50 GMT"}
+  {:suite "sdf" :expr "(.getTime (.parse (java.text.SimpleDateFormat. \"EEE, dd MMM yyyy HH:mm:ss zzz\") \"Sun, 23 Sep 2012 11:52:50 GMT\"))" :expected "1348401170000"}
+  {:suite "sdf" :expr "(.getTime (.parse (java.text.SimpleDateFormat. \"EEEE, dd-MMM-yy HH:mm:ss zzz\") \"Sunday, 23-Sep-12 11:52:50 GMT\"))" :expected "1348401170000"}
+  {:suite "sdf" :expr "(.getTime (.parse (java.text.SimpleDateFormat. \"EEE MMM d HH:mm:ss yyyy\") \"Sun Sep 23 11:52:50 2012\"))" :expected "1348401170000"}
+  {:suite "sdf" :expr "(let [f (java.text.SimpleDateFormat. \"yyyy-MM-dd\")] (.format f (.parse f \"2023-07-15\")))" :expected "2023-07-15"}
+  {:suite "reader" :expr "(let [r (-> \"foo bar baz\" java.io.StringReader. java.io.PushbackReader.)] [(read r) (slurp r)])" :expected "[foo  bar baz]"}
+  {:suite "reader" :expr "(let [r (-> \"(+ 1 2) 99\" java.io.StringReader. java.io.PushbackReader.)] [(read r) (read r)])" :expected "[(+ 1 2) 99]"}
   {:suite "dotform" :expr "(.equals \"a\" \"a\")" :expected "true"}
   {:suite "dotform" :expr "(.equals \"a\" \"b\")" :expected "false"}
   {:suite "dotform" :expr "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" :expected "v=41"}