diff --git a/host/chez/printing.ss b/host/chez/printing.ss new file mode 100644 index 0000000..545b0d9 --- /dev/null +++ b/host/chez/printing.ss @@ -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)) "#" "#")) + ((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) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index cd1696f..0fbc13e 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -166,11 +166,21 @@ ;; natives. Over the seq layer + jolt-compare, so loaded after converters.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 ;; 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). (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 ;; (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.