core: pr/prn/pr-str/print/println to the overlay; pr-str escapes strings now

Round 6 of the seed shrink (the printer round, scoped by the perf wall). The
five wrappers move to 20-coll over two new host seams: __write (push a string
to *out*) and __pr-str1 (render one value readably). The renderer itself
stays in the seed — it's representation-coupled (pvec/phm/phs/sorted
internals) and shared with the hot str, and rendering through overlay calls
would pay the per-element call cost everywhere big values get printed.
print-method as a real multimethod is follow-up work.

The new spec rows caught a renderer bug: string bodies were never escaped, so
(pr-str "a\"b") didn't round-trip through the reader. pr-render now
escapes quote/backslash/control chars per Clojure.
This commit is contained in:
Yogthos 2026-06-11 14:12:12 -04:00
parent 5cac9efd4e
commit 1de5ede246
3 changed files with 60 additions and 41 deletions

View file

@ -17,6 +17,32 @@
;; even?/odd? stay in the seed: (filter even? ...) is idiomatic-hot and the ;; even?/odd? stay in the seed: (filter even? ...) is idiomatic-hot and the
;; overlay versions cost an extra call layer per element (seq-pipe bench 4x). ;; overlay versions cost an extra call layer per element (seq-pipe bench 4x).
;; The printing family, over two host seams: __write (push a string to *out*)
;; and __pr-str1 (render ONE value readably). The renderer itself stays host —
;; it's representation-coupled (pvec/phm/phs/sorted internals) and shared with
;; the hot str. print uses str semantics (unreadable), pr/pr-str readable;
;; println/prn append the newline. Defined this early because printf and the
;; print-str family below call them. (print-method as a real multimethod is a
;; separate project.)
(defn pr-str [& xs]
(loop [out "" s (seq xs) first? true]
(if s
(recur (str out (if first? "" " ") (__pr-str1 (first s))) (next s) false)
out)))
(defn pr [& xs] (__write (apply pr-str xs)) nil)
(defn prn [& xs] (apply pr xs) (__write "\n") nil)
(defn print [& xs]
(__write (loop [out "" s (seq xs) first? true]
(if s
(recur (str out (if first? "" " ") (str (first s))) (next s) false)
out)))
nil)
(defn println [& xs] (apply print xs) (__write "\n") nil)
;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't ;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't
;; canonicalize collection keys across representations (a {:a 1} literal vs ;; canonicalize collection keys across representations (a {:a 1} literal vs
;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection ;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection

View file

@ -1476,6 +1476,8 @@
(def n (ns :name)) (def n (ns :name))
(if (and (struct? n) (= :symbol (get n :jolt/type))) (n :name) (string n))) (if (and (struct? n) (= :symbol (get n :jolt/type))) (n :name) (string n)))
(def- pr-char-escapes
{34 "\\\"" 92 "\\\\" 10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b"})
(var pr-render nil) (var pr-render nil)
# Format a number the way Clojure prints it: infinity and NaN have named forms # Format a number the way Clojure prints it: infinity and NaN have named forms
@ -1525,14 +1527,23 @@
ns (name-of (v :ns))] ns (name-of (v :ns))]
(if ns (string "#'" ns "/" nm) (string "#'" nm)))) (if ns (string "#'" ns "/" nm) (string "#'" nm))))
(defn- pr-push-escaped
"Readable string body: escape per char-escapes (quote, backslash, \\n & co),
so pr-str round-trips through the reader (this was unescaped, jolt pre-r6)."
[buf s]
(each c (string/bytes s)
(if-let [esc (get pr-char-escapes c)]
(buffer/push-string buf esc)
(buffer/push-byte buf c))))
(set pr-render (set pr-render
(fn [buf v] (fn [buf v]
(cond (cond
(nil? v) (buffer/push-string buf "nil") (nil? v) (buffer/push-string buf "nil")
(= true v) (buffer/push-string buf "true") (= true v) (buffer/push-string buf "true")
(= false v) (buffer/push-string buf "false") (= false v) (buffer/push-string buf "false")
(string? v) (do (buffer/push-string buf "\"") (buffer/push-string buf v) (buffer/push-string buf "\"")) (string? v) (do (buffer/push-string buf "\"") (pr-push-escaped buf v) (buffer/push-string buf "\""))
(buffer? v) (do (buffer/push-string buf "\"") (buffer/push-string buf (string v)) (buffer/push-string buf "\"")) (buffer? v) (do (buffer/push-string buf "\"") (pr-push-escaped buf (string v)) (buffer/push-string buf "\""))
(keyword? v) (do (buffer/push-string buf ":") (buffer/push-string buf (string v))) (keyword? v) (do (buffer/push-string buf ":") (buffer/push-string buf (string v)))
(core-char? v) (do (buffer/push-string buf "\\") (core-char? v) (do (buffer/push-string buf "\\")
(buffer/push-string buf (buffer/push-string buf
@ -1651,18 +1662,9 @@
# print/println use str semantics (bare strings); pr/prn use readable (quoted). # print/println use str semantics (bare strings); pr/prn use readable (quoted).
# All space-separate their args, like Clojure. # All space-separate their args, like Clojure.
(defn core-print [& xs] # print/println live in the Clojure collection tier (core/20-coll.clj) over
(var i 0) # the __write / __pr-str1 host seams; str-render-one stays for core-str.
(while (< i (length xs)) (defn core-write [s] (prin s) nil)
(if (> i 0) (prin " "))
(prin (str-render-one (xs i)))
(++ i))
nil)
(defn core-println [& xs]
(apply core-print xs)
(prin "\n")
nil)
# newline lives in the Clojure collection tier (core/20-coll.clj). # newline lives in the Clojure collection tier (core/20-coll.clj).
@ -1823,28 +1825,9 @@
(with-dyns [:out buf] (thunk)) (with-dyns [:out buf] (thunk))
(string buf)) (string buf))
(defn core-pr [& xs] # pr/prn/pr-str live in the Clojure collection tier (core/20-coll.clj); the
(var i 0) # renderer itself stays host (representation-coupled, shared with hot str).
(while (< i (length xs)) (defn core-pr-str1 [x] (let [b @""] (pr-render b x) (string b)))
(if (> i 0) (prin " "))
(let [b @""] (pr-render b (xs i)) (prin (string b)))
(++ i))
nil)
(defn core-prn [& xs]
(apply core-pr xs)
(prin "\n")
nil)
(defn core-pr-str [& xs]
(def buf @"")
(var i 0)
(let [n (length xs)]
(while (< i n)
(pr-render buf (xs i))
(when (< (+ i 1) n) (buffer/push-string buf " "))
(++ i)))
(string buf))
# ============================================================ # ============================================================
# Java-style arrays — backed by Janet's C primitives. Byte arrays use Janet # Java-style arrays — backed by Janet's C primitives. Byte arrays use Janet
@ -2672,6 +2655,8 @@
"hash-ordered-coll" core-hash-ordered-coll "hash-ordered-coll" core-hash-ordered-coll
"hash-unordered-coll" core-hash-unordered-coll "hash-unordered-coll" core-hash-unordered-coll
"gensym" gensym "gensym" gensym
"__write" core-write
"__pr-str1" core-pr-str1
"__make-uuid" make-uuid "__make-uuid" make-uuid
"compare" core-compare "compare" core-compare
"type" core-type "type" core-type
@ -2737,11 +2722,6 @@
"regex?" regex? "regex?" regex?
"str-triml" string/triml "str-triml" string/triml
"str-trimr" string/trimr "str-trimr" string/trimr
"print" core-print
"println" core-println
"pr" core-pr
"prn" core-prn
"pr-str" core-pr-str
# Java-style arrays (buffers for bytes, arrays otherwise) # Java-style arrays (buffers for bytes, arrays otherwise)
"aclone" core-aclone "aclone" core-aclone
"object-array" core-object-array "object-array" core-object-array

View file

@ -54,3 +54,16 @@
["line-seq empty" "nil" "(with-in-str \"\" (seq (line-seq *in*)))"] ["line-seq empty" "nil" "(with-in-str \"\" (seq (line-seq *in*)))"]
["line-seq is lazy seq" "true" "(with-in-str \"a\\nb\" (seq? (line-seq *in*)))"] ["line-seq is lazy seq" "true" "(with-in-str \"a\\nb\" (seq? (line-seq *in*)))"]
["line-seq count" "3" "(with-in-str \"1\\n2\\n3\" (count (line-seq *in*)))"]) ["line-seq count" "3" "(with-in-str \"1\\n2\\n3\" (count (line-seq *in*)))"])
# The print family is overlay now (seed-shrink round 6), over the __write /
# __pr-str1 host seams: pr is readable, print is str semantics, *-ln appends.
(defspec "io / print family (overlay)"
["pr-str multi-arg spacing" "\"\\\"a\\\" [1 2] :k\"" "(pr-str \"a\" [1 2] :k)"]
["pr-str zero args" "\"\"" "(pr-str)"]
["pr-str escapes" "\"\\\"a\\\\\\\"b\\\"\"" "(pr-str \"a\\\"b\")"]
["print is unreadable" "\"a b\"" "(with-out-str (print \"a\" \"b\"))"]
["println appends newline" "\"x 1\\n\"" "(with-out-str (println \"x\" 1))"]
["prn is readable + newline" "\"[1 \\\"s\\\"]\\n\"" "(with-out-str (prn [1 \"s\"]))"]
["pr writes no newline" "\"\\\\a\"" "(with-out-str (pr \\a))"]
["print nil arg" "\"\"" "(with-out-str (print nil))"]
["prn keyword" "\":k\\n\"" "(with-out-str (prn :k))"])