Merge pull request #193 from jolt-lang/spike/pprint-port

Port real clojure.pprint (pretty-printer + cl-format); data.json pprint passes

host/chez/host-static-classes.ss

@@ -137,6 +137,32 @@
 (def-var! "clojure.core" "*out*" (make-jhost "port-writer" (vector (current-output-port))))
 (def-var! "clojure.core" "*err*" (make-jhost "port-writer" (vector (current-error-port))))
 
+;; PrintWriter — a thin wrapper over a target writer. write/append/print forward
+;; the rendered text to the target. clojure.data.json's pretty printer builds
+;; (PrintWriter. *out*) where *out* is bound to clojure.pprint's pretty-writer (a
+;; jolt record), so forwarding routes column-aware through clojure.pprint/-write;
+;; for a host writer target it falls back to that writer's own write.
+(define (pw-forward target s)
+  (cond
+    ((and (jhost? target) (string=? (jhost-tag target) "port-writer"))
+     (display s (vector-ref (jhost-state target) 0)))
+    ((and (jhost? target) (memv #t (list (string=? (jhost-tag target) "writer")
+                                         (string=? (jhost-tag target) "string-builder"))))
+     (sb-set! target (string-append (sb-str target) s)))
+    (else
+     (jolt-invoke (var-deref "clojure.pprint" "-write") target s))))
+(register-class-ctor! "PrintWriter"
+  (lambda args (make-jhost "print-writer" (vector (if (pair? args) (car args) jolt-nil)))))
+(register-class-ctor! "java.io.PrintWriter"
+  (lambda args (make-jhost "print-writer" (vector (if (pair? args) (car args) jolt-nil)))))
+(register-host-methods! "print-writer"
+  (list (cons "write" (lambda (self x . rest) (pw-forward (vector-ref (jhost-state self) 0) (append-text x rest)) jolt-nil))
+        (cons "print" (lambda (self x) (pw-forward (vector-ref (jhost-state self) 0) (render-piece x)) jolt-nil))
+        (cons "append" (lambda (self x . rest) (pw-forward (vector-ref (jhost-state self) 0) (append-text x rest)) self))
+        (cons "flush" (lambda (self) jolt-nil))
+        (cons "close" (lambda (self) jolt-nil))
+        (cons "toString" (lambda (self) ""))))
+
 ;; ---- java.util.HashMap ------------------------------------------------------
 ;; A mutable map keyed by jolt values (jolt-hash / jolt=2). State #(chez-hashtable).
 ;; Constructors: () | (capacity) | (capacity load-factor) [sizing args ignored] |

host/chez/inst-time.ss

@@ -368,7 +368,9 @@
 ;; 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))))
+  (case-lambda
+    ((ms) (make-jinst (ms->exact (ms-of ms))))   ; (Date. epoch-ms)
+    ((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)))))))
 

host/chez/printing.ss

@@ -95,14 +95,37 @@
 ;; __pr-str1: render ONE value readably (the overlay's pr-str joins these).
 (define (jolt-pr-str1 x) (jolt-pr-readable x))
 
-;; __write: push a string to *out* (current-output-port, so __with-out-str's
+;; __write: push a string to output. Normally this goes to the current Chez port
-;; redirect captures it). Returns nil.
+;; (so __with-out-str's redirect captures it). When clojure.pprint is active it
-(define (jolt-write s) (display s) jolt-nil)
+;; installs __pprint-write-hook; jolt-write then offers each string to the hook,
+;; which routes it column-aware into a clojure.pprint pretty-writer if *out* is
+;; bound to one (returns truthy) and otherwise declines (returns nil) so the
+;; string falls through to the port. This is the JVM behaviour where core print
+;; honours *out*; jolt only needs it for the pretty-printer.
+(define jolt-pprint-write-hook jolt-nil)
+;; suppressed while __with-out-str captures output to a string port: there the
+;; redirect, not *out*, defines where text goes (pr-str / print-str rely on it).
+(define jolt-pprint-hook-suppressed (make-thread-parameter #f))
+(define (jolt-write s)
+  (if (and (not (jolt-nil? jolt-pprint-write-hook))
+           (not (jolt-pprint-hook-suppressed))
+           (jolt-truthy? (jolt-invoke jolt-pprint-write-hook s)))
+      jolt-nil
+      (begin (display s) jolt-nil)))
+(def-var! "clojure.core" "__set-pprint-write-hook!"
+  (lambda (f) (set! jolt-pprint-write-hook f) jolt-nil))
+;; clojure.pprint wraps its writing in this so core print routes into the active
+;; pretty-writer even under an outer with-out-str (which sets suppressed). A
+;; pr-str/print-str nested inside then re-suppresses, so its capture still works.
+(def-var! "clojure.core" "__with-pprint-routing"
+  (lambda (thunk)
+    (parameterize ((jolt-pprint-hook-suppressed #f)) (jolt-invoke thunk))))
 
 ;; __with-out-str: run a jolt thunk with *out* rebound to a string port, return
 ;; the captured text.
 (define (jolt-with-out-str thunk)
-  (with-output-to-string (lambda () (jolt-invoke thunk))))
+  (with-output-to-string
+    (lambda () (parameterize ((jolt-pprint-hook-suppressed #t)) (jolt-invoke thunk)))))
 
 ;; __eprint / __eprintf: stderr seams. Flush each write — like the JVM's
 ;; auto-flushing System.err — so a long-running process (a server that never