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.
This commit is contained in:
Yogthos
parent
a9ecae9a29
commit
331a41ee26
6 changed files with 144 additions and 50 deletions
|
|
@ -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
|
||||
;; if set non-default (*print-length* / *print-level* / *default-data-reader-fn*)
|
||||
;; are deliberately NOT interned until the printer/reader honour them.
|
||||
;; right value) — not a silent divergence.
|
||||
;;
|
||||
;; *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] …).
|
||||
|
|
|
|||
|
|
@ -47,25 +47,22 @@
|
|||
((jolt-transient? x)
|
||||
(case (jolt-transient-kind x)
|
||||
((vec) "#<transient vector>") ((set) "#<transient set>") (else "#<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))))) ")"))
|
||||
((pvec? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-readable)) "]"))))
|
||||
((pset? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "#{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '()))) "}"))))
|
||||
((pmap? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pmap-fold x (lambda (k v a)
|
||||
(cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '()))) "}"))))
|
||||
((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-readable)) ")"))))
|
||||
(else (jolt-pr-str x))))
|
||||
(define (jolt-pr-readable-dispatch x)
|
||||
(let loop ((as jolt-pr-readable-arms))
|
||||
|
|
|
|||
|
|
@ -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*.
|
||||
;; An unregistered tag stays a tagged FORM (lenient — clojure.edn raises instead).
|
||||
;; #uuid and #"regex" are built in; any other tag is applied from *data-readers*,
|
||||
;; 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
|
||||
;; the JVM's "No reader function for tag foobar" (empty-pmap is a VALUE — the
|
||||
;; old (empty-pmap) applied it as a procedure and crashed the Chez VM).
|
||||
(else (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))))))
|
||||
;; No registered reader: consult *default-data-reader-fn*, else throw a clean,
|
||||
;; catchable ex-info naming the tag, like the JVM's "No reader function for tag
|
||||
;; foobar" (empty-pmap is a VALUE — the old (empty-pmap) applied it as a
|
||||
;; 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))))))))
|
||||
|
||||
(def-var! "clojure.core" "read-string" jolt-read-string)
|
||||
(def-var! "clojure.core" "__parse-next" jolt-parse-next)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(when (fx>=? i 0) (set! acc (cons (jolt-pr-str (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-str e) a)) '())) "}"))
|
||||
((pmap? x) (string-append "{" (jolt-str-join
|
||||
(pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '())) "}"))
|
||||
;; lists / cons / lazy seqs all print as (...) — forces a finite seq.
|
||||
((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-str (seq-first s)) acc))))) ")"))
|
||||
((pvec? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-str)) "]"))))
|
||||
((pset? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "#{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '()))) "}"))))
|
||||
((pmap? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '()))) "}"))))
|
||||
;; 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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue