Chez Phase 2 (inc B): readable printer + output seams

__pr-str1/__write/__with-out-str/__eprint/__eprintf resolved to jolt-nil, so the
whole overlay print family (pr-str/pr/prn/print/println/print-str/prn-str/
println-str) hit the apply-jolt-nil crash bucket. jolt-pr-str is str-style
(strings raw); pr-str needs readable (pr) style — strings quoted+escaped at every
level. printing.ss adds the readable renderer (mirrors jolt-pr-str, recurses,
delegates scalars), plus the infinities long-form and a transient arm (those
were crash->divergence reveals once pr-str ran).

jolt-9zhh.
This commit is contained in:
Yogthos 2026-06-18 11:20:56 -04:00
parent 9b0d6acadc
commit d7c6290ec0
2 changed files with 93 additions and 0 deletions

83
host/chez/printing.ss Normal file
View file

@ -0,0 +1,83 @@
;; readable printer + output seams (jolt-cf1q.3 Phase 2 inc B) — the __pr-str1 /
;; __write / __with-out-str host seams the overlay's pr-str/pr/prn/print/println/
;; *-str family is built on (jolt-core/clojure/core/20-coll.clj). They resolved to
;; jolt-nil, so the whole print family hit the apply-jolt-nil crash bucket.
;;
;; jolt-pr-str (rt.ss) is STR-style: strings render raw. pr-str needs READABLE
;; (pr) style: strings quoted+escaped at every nesting level. This adds the
;; readable renderer; it mirrors jolt-pr-str but quotes strings and recurses into
;; itself, delegating scalars (nil/bool/number/keyword/symbol/char/regex) to
;; jolt-pr-str (already readable for those). The canonical ORDERED printer is
;; still future work — unordered colls render in HAMT order, compared via `=`.
;; inner string escape (no surrounding quotes): " \ newline tab return.
(define (jolt-str-escape s)
(let loop ((cs (string->list s)) (acc '()))
(if (null? cs)
(list->string (reverse acc))
(loop (cdr cs)
(let ((c (car cs)))
(case c
((#\") (cons #\" (cons #\\ acc)))
((#\\) (cons #\\ (cons #\\ acc)))
((#\newline) (cons #\n (cons #\\ acc)))
((#\tab) (cons #\t (cons #\\ acc)))
((#\return) (cons #\r (cons #\\ acc)))
(else (cons c acc))))))))
(define (jolt-pr-readable x)
(cond
((string? x) (string-append "\"" (jolt-str-escape x) "\""))
;; pr renders the infinities / NaN long-form (Clojure .toString), at every
;; nesting level — unlike the -e printer's inf/-inf/nan.
((and (flonum? x) (fl= x +inf.0)) "Infinity")
((and (flonum? x) (fl= x -inf.0)) "-Infinity")
((and (flonum? x) (not (fl= x x))) "NaN")
;; transients print as a cold tagged type (the seed routes this through a
;; print-method multimethod; the readable fallback renders it directly).
;; forward refs to transients.ss (loaded later) — resolved at call time.
((jolt-transient? x)
(if (pvec? (jolt-transient-coll x)) "#<transient vector>" "#<transient map>"))
((pvec? x)
(let ((acc '()))
(let loop ((i (fx- (pvec-count x) 1)))
(when (fx>=? i 0)
(set! acc (cons (jolt-pr-readable (pvec-nth-d x i jolt-nil)) acc))
(loop (fx- i 1))))
(string-append "[" (jolt-str-join acc) "]")))
((pset? x)
(string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '())) "}"))
((pmap? x)
(string-append "{" (jolt-str-join
(pmap-fold x (lambda (k v a)
(cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '())) "}"))
((empty-list-t? x) "()")
((cseq? x)
(string-append "(" (jolt-str-join
(let loop ((s x) (acc '()))
(if (jolt-nil? s) (reverse acc)
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-readable (seq-first s)) acc))))) ")"))
(else (jolt-pr-str x))))
;; __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)
;; __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))))
;; __eprint / __eprintf: stderr seams.
(define (jolt-eprint s) (display s (current-error-port)) jolt-nil)
(define (jolt-eprintf fmt . args)
(apply fprintf (current-error-port) fmt args) jolt-nil)
(def-var! "clojure.core" "__pr-str1" jolt-pr-str1)
(def-var! "clojure.core" "__write" jolt-write)
(def-var! "clojure.core" "__with-out-str" jolt-with-out-str)
(def-var! "clojure.core" "__eprint" jolt-eprint)
(def-var! "clojure.core" "__eprintf" jolt-eprintf)

View file

@ -166,11 +166,21 @@
;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss. ;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss.
(load "host/chez/natives-seq.ss") (load "host/chez/natives-seq.ss")
;; readable printer + output seams (jolt-9zhh, Phase 2 inc B): __pr-str1/__write/
;; __with-out-str/__eprint/__eprintf — the host seams the overlay print family
;; (pr-str/pr/prn/print/println/*-str) is built on. After converters.ss (uses
;; jolt-pr-str/jolt-str-join) + seq.ss (jolt-invoke).
(load "host/chez/printing.ss")
;; collection constructors + rand (jolt-agw6, Phase 2 inc A): bind the public ;; collection constructors + rand (jolt-agw6, Phase 2 inc A): bind the public
;; clojure.core names hash-map/hash-set/array-map/set/rand to the existing ;; clojure.core names hash-map/hash-set/array-map/set/rand to the existing
;; pmap/pset ctors. After collections.ss (the ctors) + seq.ss (seq->list). ;; pmap/pset ctors. After collections.ss (the ctors) + seq.ss (seq->list).
(load "host/chez/natives-coll.ss") (load "host/chez/natives-coll.ss")
;; bit ops + parse-long/parse-double (jolt-cf1q.3 inc C): host-coupled scalar
;; seed natives over the all-flonum number model.
(load "host/chez/natives-num.ss")
;; multimethods (jolt-9ls5): defmulti/defmethod dispatch runtime. Needs jolt-invoke ;; multimethods (jolt-9ls5): defmulti/defmethod dispatch runtime. Needs jolt-invoke
;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss), ;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss),
;; jolt-pr-str (above), and the var-cell machinery — so loaded last. ;; jolt-pr-str (above), and the var-cell machinery — so loaded last.