Port real clojure.pprint (pretty-printer + cl-format)

Replace the 33-line pprint shim with a column-aware pretty printer and a
Common Lisp cl-format engine, ported from the ClojureScript implementation
(no STM — atom-backed fields) and adapted to JVM-Clojure interop. Provides
pprint/write/write-out/with-pprint-dispatch/formatter-out/cl-format and
simple/code dispatch.

core print routes column-aware into an active pretty-writer via a __write
hook (suppressed inside with-out-str captures); PrintWriter host class
forwards into the wrapped writer. Re-mint: pprint is baked into the seed.

Unblocks clojure.data.json/pprint (its pretty-printing test passes).
Directives ~R/~P/~C/~F/~E/~G/~$/~(~) not ported (unused by the targets).

make test + shakesmoke green, 0 new divergences, selfhost holds.
This commit is contained in:
Yogthos 2026-06-24 16:09:09 -04:00
parent 348d91c1d1
commit f66cf486b0
5 changed files with 3043 additions and 730 deletions

View file

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

View file

@ -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
;; redirect captures it). Returns nil.
(define (jolt-write s) (display s) jolt-nil)
;; __write: push a string to output. Normally this goes to the current Chez port
;; (so __with-out-str's redirect captures it). When clojure.pprint is active it
;; 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

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long