Skip to content

Experiments w/ lowering the machinery around printing #254

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Experiments w/ lowering the machinery around printing #254

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2d4e286
- experiments w/ lowering the machinery around printing
swannodette Jun 7, 2025
34203d6
- fix
swannodette Jun 7, 2025
a8b7b48
* pr-writer-impl
swannodette Jun 7, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
157 changes: 106 additions & 51 deletions src/main/cljs/cljs/core.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -181,13 +181,6 @@
:jsdoc ["@type {*}"]}
*loaded-libs* nil)

(defn- pr-opts []
{:flush-on-newline *flush-on-newline*
:readably *print-readably*
:meta *print-meta*
:dup *print-dup*
:print-length *print-length*})

(declare into-array)

(defn enable-console-print!
Expand Down Expand Up @@ -896,6 +889,46 @@

;; Printing support

(defn- pr-opts*
[flush-on-newline readably meta dup print-length]
(reify
ILookup
(-lookup [this k]
(-lookup this k nil))
(-lookup [this k not-found]
(case k
:flush-on-newline flush-on-newline
:readably readably
:meta meta
:dup dup
:print-length print-length
not-found))
IAssociative
(-contains-key? [coll k]
(case k
:flush-on-newline true
:readably true
:meta true
:dup true
:print-length true
false))
(-assoc [this k v]
(case k
:flush-on-newline (pr-opts* v readably meta dup print-length)
:readably (pr-opts* flush-on-newline v meta dup print-length)
:meta (pr-opts* flush-on-newline readably v dup print-length)
:dup (pr-opts* flush-on-newline readably meta v print-length)
:print-length (pr-opts* flush-on-newline readably meta dup v)
this))))

(defn pr-opts []
(pr-opts*
*flush-on-newline*
*print-readably*
*print-meta*
*print-dup*
*print-length*))

(deftype StringBufferWriter [sb]
IWriter
(-write [_ s] (.append sb s))
Expand Down Expand Up @@ -10442,18 +10475,18 @@ reduces them without incurring seq initialization"
(do
(-write writer begin)
(if (zero? (:print-length opts))
(when (seq coll)
(when (-seq coll)
(-write writer (or (:more-marker opts) "...")))
(do
(when (seq coll)
(print-one (first coll) writer opts))
(loop [coll (next coll) n (dec (:print-length opts))]
(when-let [coll (-seq coll)]
(print-one (-first coll) writer opts))
(loop [coll (-next coll) n (dec (:print-length opts))]
(if (and coll (or (nil? n) (not (zero? n))))
(do
(-write writer sep)
(print-one (first coll) writer opts)
(recur (next coll) (dec n)))
(when (and (seq coll) (zero? n))
(print-one (-first coll) writer opts)
(recur (-next coll) (dec n)))
(when (and (-seq coll) (zero? n))
(-write writer sep)
(-write writer (or (:more-marker opts) "...")))))))
(-write writer end)))))
Expand All @@ -10462,6 +10495,13 @@ reduces them without incurring seq initialization"
(doseq [s ss]
(-write writer s)))

(defn write-all-array [writer arr]
(let [len (alength arr)]
(loop [i 0]
(when (< i len)
(-write writer (aget arr i))
(recur (inc i))))))

(defn string-print [x]
(when (nil? *print-fn*)
(throw (js/Error. "No *print-fn* fn set for evaluation environment")))
Expand All @@ -10483,10 +10523,9 @@ reduces them without incurring seq initialization"

(defn ^:private quote-string
[s]
(str \"
(.replace s (js/RegExp "[\\\\\"\b\f\n\r\t]" "g")
(fn [match] (unchecked-get char-escapes match)))
\"))
(let [s' ^string (.replace s (js/RegExp "[\\\\\"\b\f\n\r\t]" "g")
(fn [match] (unchecked-get char-escapes match)))]
(str \" s' \")))

(declare print-map)

Expand Down Expand Up @@ -10515,23 +10554,27 @@ reduces them without incurring seq initialization"
(-pr-writer obj writer opts)

(or (true? obj) (false? obj))
(-write writer (str obj))
(-write writer (.toString obj))

(number? obj)
(-write writer
(cond
^boolean (js/isNaN obj) "##NaN"
(identical? obj js/Number.POSITIVE_INFINITY) "##Inf"
(identical? obj js/Number.NEGATIVE_INFINITY) "##-Inf"
:else (str obj)))
:else (.toString obj)))

(object? obj)
(do
(-write writer "#js ")
(print-map
(map (fn [k]
(MapEntry. (cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword) (unchecked-get obj k) nil))
(js-keys obj))
(prim-seq
(.map
(fn [k]
(MapEntry.
(cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword)
(unchecked-get obj k) nil))
(js-keys obj)))
pr-writer writer opts))

(array? obj)
Expand All @@ -10547,45 +10590,48 @@ reduces them without incurring seq initialization"
name (if (or (nil? name) (gstring/isEmpty name))
"Function"
name)]
(write-all writer "#object[" name
(if *print-fn-bodies*
(str " \"" (str obj) "\"")
"")
"]"))
(write-all-array writer
(array
"#object[" name
(if *print-fn-bodies*
(str " \"" ^string (.toString obj) "\"")
"")
"]")))

(instance? js/Date obj)
(let [normalize (fn [n len]
(loop [ns (str n)]
(loop [ns (.toString n)]
(if (< (count ns) len)
(recur (str "0" ns))
(recur (str "0" ^string ns))
ns)))]
(write-all writer
"#inst \""
(normalize (.getUTCFullYear obj) 4) "-"
(normalize (inc (.getUTCMonth obj)) 2) "-"
(normalize (.getUTCDate obj) 2) "T"
(normalize (.getUTCHours obj) 2) ":"
(normalize (.getUTCMinutes obj) 2) ":"
(normalize (.getUTCSeconds obj) 2) "."
(normalize (.getUTCMilliseconds obj) 3) "-"
"00:00\""))

(regexp? obj) (write-all writer "#\"" (.-source obj) "\"")

(js-symbol? obj) (write-all writer "#object[" (.toString obj) "]" )
(write-all-array writer
(array
"#inst \""
(normalize (.getUTCFullYear obj) 4) "-"
(normalize (inc (.getUTCMonth obj)) 2) "-"
(normalize (.getUTCDate obj) 2) "T"
(normalize (.getUTCHours obj) 2) ":"
(normalize (.getUTCMinutes obj) 2) ":"
(normalize (.getUTCSeconds obj) 2) "."
(normalize (.getUTCMilliseconds obj) 3) "-"
"00:00\"")))

(regexp? obj) (write-all-array writer (array "#\"" (.-source obj) "\""))

(js-symbol? obj) (write-all-array writer (array "#object[" (.toString obj) "]"))

:else
(if (some-> obj .-constructor .-cljs$lang$ctorStr)
(write-all writer
"#object[" (.replace (.. obj -constructor -cljs$lang$ctorStr)
(js/RegExp. "/" "g") ".") "]")
(write-all-array writer
(array "#object[" (.replace (.. obj -constructor -cljs$lang$ctorStr)
(js/RegExp. "/" "g") ".") "]"))
(let [name (some-> obj .-constructor .-name)
name (if (or (nil? name) (gstring/isEmpty name))
"Object"
name)]
(if (nil? (. obj -constructor))
(write-all writer "#object[" name "]")
(write-all writer "#object[" name " " (str obj) "]"))))))))
(write-all-array writer (array "#object[" name "]"))
(write-all-array writer (array "#object[" name " " (.toString obj) "]")))))))))

(defn- pr-writer
"Prefer this to pr-seq, because it makes the printing function
Expand Down Expand Up @@ -10711,15 +10757,15 @@ reduces them without incurring seq initialization"
(recur new-ns entries (assoc lm (strip-ns k) v)))))
[ns lm]))))

(defn print-prefix-map [prefix m print-one writer opts]
(defn print-prefix-map [^string prefix m print-one writer opts]
(pr-sequential-writer
writer
(fn [e w opts]
(do (print-one (key e) w opts)
(-write w \space)
(print-one (val e) w opts)))
(str prefix "{") ", " "}"
opts (seq m)))
opts (-seq m)))

(defn print-map [m print-one writer opts]
(let [[ns lift-map] (when (map? m)
Expand Down Expand Up @@ -11795,6 +11841,15 @@ reduces them without incurring seq initialization"

(set! (.. ExceptionInfo -prototype -__proto__) js/Error.prototype)

(extend-protocol ISeqable
nil
(-seq [this] nil)

array
(-seq [this]
(when-not (zero? (alength this))
(IndexedSeq. this 0 nil))))

(extend-type ExceptionInfo
IPrintWithWriter
(-pr-writer [obj writer opts]
Expand Down
Loading