Honor *print-length* / *print-level* / *default-data-reader-fn*

Both printers (jolt-pr-str, jolt-pr-readable) now thread a print depth and
read the two limit vars. *print-length* truncates each collection to N
elements + "...", walking seqs lazily so an infinite seq prints under the
limit without realizing it. *print-level* renders a collection at depth >=
the level as "#". The reader consults *default-data-reader-fn* for an
unregistered #tag before falling back (tagged form on the data seam, throw
on the edn seam). All three interned with nil defaults.

docs/spec/coverage.md

@@ -3,16 +3,16 @@
 Generated 2026-06-26 by `tools/spec_coverage.py` — do not edit by hand.
 
 Surface: **694** clojure.core vars (ClojureDocs export; 648 with
-community examples). jolt interns 591 of them.
+community examples). jolt interns 594 of them.
 
 | Status | Count | Meaning |
 |---|---|---|
-| implemented+tested | 587 | in jolt and exercised by spec/conformance |
+| implemented+tested | 590 | in jolt and exercised by spec/conformance |
 | implemented-untested | 4 | in jolt, no direct test — spec entries will add them |
 | resolvable-not-interned | 0 | works in code but invisible to ns introspection (conformance finding) |
 | missing-portable | 0 | portable semantics, jolt lacks it — implementation gap |
 | special-form | 16 | specified in §3, not a library var |
-| dynamic-var | 14 | classification needed: portable default vs host-dependent |
+| dynamic-var | 11 | classification needed: portable default vs host-dependent |
 | agents-taps | 16 | out of scope pending concurrency design note |
 | stm-refs | 11 | out of scope pending concurrency design note |
 | jvm-specific | 46 | catalogued, not specified |
@@ -39,7 +39,7 @@ UNVERIFIED field; that column will be added as entries land.
 | `*compile-path*` | dynamic-var | ✓ |
 | `*compiler-options*` | dynamic-var | ✓ |
 | `*data-readers*` | implemented+tested | ✓ |
-| `*default-data-reader-fn*` | dynamic-var | ✓ |
+| `*default-data-reader-fn*` | implemented+tested | ✓ |
 | `*e` | implemented+tested | ✓ |
 | `*err*` | implemented+tested | ✓ |
 | `*file*` | implemented-untested | ✓ |
@@ -50,8 +50,8 @@ UNVERIFIED field; that column will be added as entries land.
 | `*ns*` | implemented+tested | ✓ |
 | `*out*` | implemented+tested | ✓ |
 | `*print-dup*` | implemented+tested | ✓ |
-| `*print-length*` | dynamic-var | ✓ |
+| `*print-length*` | implemented+tested | ✓ |
-| `*print-level*` | dynamic-var | ✓ |
+| `*print-level*` | implemented+tested | ✓ |
 | `*print-meta*` | implemented+tested | ✓ |
 | `*print-namespace-maps*` | implemented-untested | ✓ |
 | `*print-readably*` | implemented+tested | ✓ |

host/chez/dynamic-var-defaults.ss

@@ -29,11 +29,19 @@
 ;; *print-meta* — when true, pr prints metadata with a ^ prefix; default false.
 (def-var! "clojure.core" "*print-meta*" #f)
 
+;; *print-length* / *print-level* — collection print limits, honored by both
+;; printers (rt.ss jolt-pr-str + printing.ss jolt-pr-readable). nil = unlimited
+;; (the default); a number truncates elements / collapses depth to "#".
+;; *print-length* limits a lazy/infinite seq before realizing it.
+(def-var! "clojure.core" "*print-length*" jolt-nil)
+(def-var! "clojure.core" "*print-level*" jolt-nil)
+;; *default-data-reader-fn* — a (fn [tag value]) the reader consults for an
+;; unregistered #tag before raising; nil = no default handler.
+(def-var! "clojure.core" "*default-data-reader-fn*" jolt-nil)
+
 ;; Portable clojure.core dynamic vars whose DEFAULT already matches jolt's
 ;; behaviour, so exposing them is sound (resolve/binding work, reads return the
-;; right value) — not a silent divergence. The ones that change observable output
+;; right value) — not a silent divergence.
-;; if set non-default (*print-length* / *print-level* / *default-data-reader-fn*)
-;; are deliberately NOT interned until the printer/reader honour them.
 ;;
 ;; *read-eval* — gates #=() read-eval. jolt's reader has no #=, so it reads true
 ;; (no eval-on-read happens regardless); a lib can (binding [*read-eval* false] …).

host/chez/printing.ss

@@ -47,25 +47,22 @@
     ((jolt-transient? x)
      (case (jolt-transient-kind x)
        ((vec) "#<transient vector>") ((set) "#<transient set>") (else "#<transient map>")))
-    ((pvec? x)
+    ((pvec? x) (if (jolt-print-hash?) "#"
-     (let ((acc '()))
+                   (with-deeper-print
-       (let loop ((i (fx- (pvec-count x) 1)))
+                     (string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-readable)) "]"))))
-         (when (fx>=? i 0)
+    ((pset? x) (if (jolt-print-hash?) "#"
-           (set! acc (cons (jolt-pr-readable (pvec-nth-d x i jolt-nil)) acc))
+                   (with-deeper-print
-           (loop (fx- i 1))))
+                     (string-append "#{" (jolt-str-join (jolt-limited-list-strs
-       (string-append "[" (jolt-str-join acc) "]")))
+                       (pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '()))) "}"))))
-    ((pset? x)
+    ((pmap? x) (if (jolt-print-hash?) "#"
-     (string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '())) "}"))
+                   (with-deeper-print
-    ((pmap? x)
+                     (string-append "{" (jolt-str-join (jolt-limited-list-strs
-     (string-append "{" (jolt-str-join
                        (pmap-fold x (lambda (k v a)
-                      (cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '())) "}"))
+                                      (cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '()))) "}"))))
-    ((empty-list-t? x) "()")
+    ((empty-list-t? x) (if (jolt-print-hash?) "#" "()"))
-    ((cseq? x)
+    ((cseq? x) (if (jolt-print-hash?) "#"
-     (string-append "(" (jolt-str-join
+                   (with-deeper-print
-       (let loop ((s x) (acc '()))
+                     (string-append "(" (jolt-str-join (jolt-limited-seq-strs x jolt-pr-readable)) ")"))))
-         (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))))
 (define (jolt-pr-readable-dispatch x)
   (let loop ((as jolt-pr-readable-arms))

host/chez/reader.ss

@@ -631,16 +631,38 @@
                      (guard (e (#t #f))
                        (let ((fn (var-deref (symbol-t-ns v) (symbol-t-name v))))
                          (and (procedure? fn) fn)))))))))
+;; the bare tag SYMBOL for a :#name / :#ns/name reader keyword (strip the leading
+;; #, split a qualified tag on /). *default-data-reader-fn* receives it.
+(define (rdr-tag->symbol tag)
+  (let* ((nm (keyword-t-name tag))
+         (bare (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\#))
+                   (substring nm 1 (string-length nm)) nm)))
+    (let loop ((i 0))
+      (cond ((>= i (string-length bare)) (jolt-symbol #f bare))
+            ((char=? (string-ref bare i) #\/)
+             (jolt-symbol (substring bare 0 i) (substring bare (+ i 1) (string-length bare))))
+            (else (loop (+ i 1)))))))
+;; *default-data-reader-fn* — a (fn [tag value]) consulted for an unregistered
+;; tag, or #f when unset/nil. Honors a `binding` (var-deref reads the stack).
+(define (rdr-default-data-reader-fn)
+  (guard (e (#t #f))
+    (let ((v (var-deref "clojure.core" "*default-data-reader-fn*")))
+      (and (not (jolt-nil? v)) (procedure? v) v))))
+
 ;; read-string / read data seam: construct the value for a #tag literal. #inst,
-;; #uuid and #"regex" are built in; any other tag is applied from *data-readers*.
+;; #uuid and #"regex" are built in; any other tag is applied from *data-readers*,
-;; An unregistered tag stays a tagged FORM (lenient — clojure.edn raises instead).
+;; then *default-data-reader-fn*. An unregistered tag with no default handler stays
+;; a tagged FORM (lenient — clojure.edn raises instead).
 (define (rdr-construct-tag tag inner)
   (cond
     ((eq? tag (keyword #f "#inst")) (jolt-inst-from-string inner))
     ((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string inner))
     ((eq? tag (keyword #f "regex")) (jolt-re-pattern inner))
     (else (let ((fn (rdr-data-reader-fn tag)))
-            (if fn (jolt-invoke fn inner) (rdr-make-tagged tag inner))))))
+            (if fn (jolt-invoke fn inner)
+                (let ((dfn (rdr-default-data-reader-fn)))
+                  (if dfn (jolt-invoke dfn (rdr-tag->symbol tag) inner)
+                      (rdr-make-tagged tag inner))))))))
 
 (define (rdr-form->data x)
   (cond
@@ -695,13 +717,16 @@
   (cond
     ((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string form))
     ((eq? tag (keyword #f "#inst")) (jolt-inst-from-string form))
-    ;; No registered reader: throw a clean, catchable ex-info naming the tag, like
+    ;; No registered reader: consult *default-data-reader-fn*, else throw a clean,
-    ;; the JVM's "No reader function for tag foobar" (empty-pmap is a VALUE — the
+    ;; catchable ex-info naming the tag, like the JVM's "No reader function for tag
-    ;; old (empty-pmap) applied it as a procedure and crashed the Chez VM).
+    ;; foobar" (empty-pmap is a VALUE — the old (empty-pmap) applied it as a
-    (else (let* ((nm (keyword-t-name tag))
+    ;; procedure and crashed the Chez VM).
+    (else (let ((dfn (rdr-default-data-reader-fn)))
+            (if dfn (jolt-invoke dfn (rdr-tag->symbol tag) form)
+                (let* ((nm (keyword-t-name tag))
                        (bare (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\#))
                                  (substring nm 1 (string-length nm)) nm)))
-            (jolt-throw (jolt-ex-info (string-append "No reader function for tag " bare) empty-pmap))))))
+                  (jolt-throw (jolt-ex-info (string-append "No reader function for tag " bare) empty-pmap))))))))
 
 (def-var! "clojure.core" "read-string" jolt-read-string)
 (def-var! "clojure.core" "__parse-next" jolt-parse-next)

host/chez/rt.ss

@@ -185,6 +185,55 @@
 ;; bare nil renders as the empty string (a nil ELEMENT inside a collection still
 ;; prints "nil", which jolt-pr-str handles).
 (define (jolt-final-str x) (if (jolt-nil? x) "" (jolt-pr-str x)))
+;; --- *print-level* / *print-length* -----------------------------------------
+;; Both vars default to nil (= unlimited). A non-nil number limits collection
+;; nesting depth / element count in BOTH printers (jolt-pr-str here and
+;; jolt-pr-readable in printing.ss). Cells captured lazily — the vars are def'd
+;; after rt.ss. The nil default takes a fast path: jolt-print-hash? is #f and the
+;; limited-string walkers never truncate.
+(define plevel-cell #f)
+(define plength-cell #f)
+(define (jolt-print-level)
+  (unless plevel-cell (set! plevel-cell (jolt-var "clojure.core" "*print-level*")))
+  (let ((v (jolt-var-get plevel-cell))) (and (number? v) v)))
+(define (jolt-print-length)
+  (unless plength-cell (set! plength-cell (jolt-var "clojure.core" "*print-length*")))
+  (let ((v (jolt-var-get plength-cell))) (and (number? v) v)))
+(define jolt-print-depth (make-thread-parameter 0))
+;; A collection at depth >= *print-level* renders as "#". The top-level collection
+;; is depth 0, so *print-level* 0 collapses any collection, 1 keeps the outermost.
+(define (jolt-print-hash?)
+  (let ((lvl (jolt-print-level))) (and lvl (fx>=? (jolt-print-depth) lvl))))
+;; Rendered element strings of a vector (by index), honoring *print-length*: at
+;; most N, then "...". render-one runs at the current (already bumped) depth.
+(define (jolt-limited-vec-strs x render-one)
+  (let ((len (pvec-count x)) (lim (jolt-print-length)))
+    (let loop ((i 0) (acc '()))
+      (cond ((fx>=? i len) (reverse acc))
+            ((and lim (fx>=? i lim)) (reverse (cons "..." acc)))
+            (else (loop (fx+ i 1) (cons (render-one (pvec-nth-d x i jolt-nil)) acc)))))))
+;; Rendered element strings of a seq, walked lazily so an infinite seq is realized
+;; only up to *print-length*.
+(define (jolt-limited-seq-strs s render-one)
+  (let ((lim (jolt-print-length)))
+    (let loop ((s s) (i 0) (acc '()))
+      (cond ((jolt-nil? s) (reverse acc))
+            ((and lim (fx>=? i lim)) (reverse (cons "..." acc)))
+            (else (loop (jolt-seq (seq-more s)) (fx+ i 1) (cons (render-one (seq-first s)) acc)))))))
+;; Truncate an already-collected element-string list (set / map, finite) to
+;; *print-length*, appending "..." when more remain.
+(define (jolt-limited-list-strs strs)
+  (let ((lim (jolt-print-length)))
+    (if (not lim) strs
+        (let loop ((s strs) (i 0) (acc '()))
+          (cond ((null? s) (reverse acc))
+                ((fx>=? i lim) (reverse (cons "..." acc)))
+                (else (loop (cdr s) (fx+ i 1) (cons (car s) acc))))))))
+;; bump the print depth around a collection's element rendering.
+(define-syntax with-deeper-print
+  (syntax-rules ()
+    ((_ body ...) (parameterize ((jolt-print-depth (fx+ (jolt-print-depth) 1))) body ...))))
+
 ;; A host shim registers a type's str-style rendering via register-pr-str-arm! (or
 ;; register-pr-arm! in printing.ss for both printers at once) instead of
 ;; set!-wrapping jolt-pr-str. Disjoint types, checked before the base cases.
@@ -205,18 +254,23 @@
                         (if (or (jolt-nil? ns) (not ns) (eq? ns '())) (symbol-t-name x)
                             (string-append ns "/" (symbol-t-name x)))))
     ((regex-t? x) (string-append "#\"" (regex-t-source x) "\""))
-    ((pvec? x) (let ((acc '())) (let loop ((i (fx- (pvec-count x) 1)))
+    ((pvec? x) (if (jolt-print-hash?) "#"
-                 (when (fx>=? i 0) (set! acc (cons (jolt-pr-str (pvec-nth-d x i jolt-nil)) acc)) (loop (fx- i 1))))
+                   (with-deeper-print
-                 (string-append "[" (jolt-str-join acc) "]")))
+                     (string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-str)) "]"))))
-    ((pset? x) (string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '())) "}"))
+    ((pset? x) (if (jolt-print-hash?) "#"
-    ((pmap? x) (string-append "{" (jolt-str-join
+                   (with-deeper-print
-                 (pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '())) "}"))
+                     (string-append "#{" (jolt-str-join (jolt-limited-list-strs
-    ;; lists / cons / lazy seqs all print as (...) — forces a finite seq.
+                       (pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '()))) "}"))))
-    ((empty-list-t? x) "()")
+    ((pmap? x) (if (jolt-print-hash?) "#"
-    ((cseq? x) (string-append "(" (jolt-str-join
+                   (with-deeper-print
-                 (let loop ((s x) (acc '()))
+                     (string-append "{" (jolt-str-join (jolt-limited-list-strs
-                   (if (jolt-nil? s) (reverse acc)
+                       (pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '()))) "}"))))
-                       (loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
+    ;; lists / cons / lazy seqs all print as (...) — forces a finite seq (or up to
+    ;; *print-length* of an infinite one).
+    ((empty-list-t? x) (if (jolt-print-hash?) "#" "()"))
+    ((cseq? x) (if (jolt-print-hash?) "#"
+                   (with-deeper-print
+                     (string-append "(" (jolt-str-join (jolt-limited-seq-strs x jolt-pr-str)) ")"))))
     (else (format "~a" x))))
 (define (jolt-pr-str x)
   (let loop ((as jolt-pr-str-arms))

test/chez/corpus.edn

@@ -3251,4 +3251,14 @@
   {:suite "vectors / large trie" :label "assoc in a large vector" :expected "[1098 :x 1100]" :actual "(let [v (assoc (vec (range 1100)) 1099 :x)] [(nth v 1098) (nth v 1099) (count v)])"}
   {:suite "vectors / large trie" :label "pop down across a level boundary" :expected "[1023 1022]" :actual "(let [p (pop (vec (range 1024)))] [(count p) (peek p)])"}
   {:suite "vectors / large trie" :label "pop to empty then rebuild" :expected "[0 5]" :actual "(let [e (loop [v (vec (range 100))] (if (seq v) (recur (pop v)) v))] [(count e) (count (into e (range 5)))])"}
+  {:suite "printer / print-length" :label "truncates an infinite seq before realizing it" :expected "true" :actual "(= \"(0 1 2 ...)\" (binding [*print-length* 3] (pr-str (range))))"}
+  {:suite "printer / print-length" :label "truncates a vector with ellipsis" :expected "true" :actual "(= \"[1 2 ...]\" (binding [*print-length* 2] (pr-str [1 2 3 4])))"}
+  {:suite "printer / print-length" :label "exactly N elements prints no ellipsis" :expected "true" :actual "(= \"(0 1 2)\" (binding [*print-length* 3] (pr-str (range 3))))"}
+  {:suite "printer / print-length" :label "nil default is unlimited" :expected "true" :actual "(= \"[1 2 3 4 5]\" (pr-str [1 2 3 4 5]))"}
+  {:suite "printer / print-level" :label "collapses a collection past the level to #" :expected "true" :actual "(= \"[:a [:b #]]\" (binding [*print-level* 2] (pr-str [:a [:b [:c 1]]])))"}
+  {:suite "printer / print-level" :label "level 0 collapses the top collection" :expected "true" :actual "(= \"#\" (binding [*print-level* 0] (pr-str [1 2])))"}
+  {:suite "printer / print-level" :label "level 1 keeps the outermost collection" :expected "true" :actual "(= \"[# 3]\" (binding [*print-level* 1] (pr-str [[1 2] 3])))"}
+  {:suite "printer / print-level" :label "scalars print regardless of level" :expected "true" :actual "(= \"[1 2]\" (binding [*print-level* 1] (pr-str [1 2])))"}
+  {:suite "reader / default-data-reader-fn" :label "consulted for an unregistered tag" :expected "true" :actual "(= [(quote foo) 42] (binding [*default-data-reader-fn* (fn [tag v] [tag v])] (read-string \"#foo 42\")))"}
+  {:suite "printer / print-vars" :label "print-length / print-level / default-data-reader-fn default to nil" :expected "[true true true]" :actual "[(nil? *print-length*) (nil? *print-level*) (nil? *default-data-reader-fn*)]"}
 ]