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

File diff suppressed because it is too large Load diff