From 2d4e286b2318ef5e77f7b9a3d9b95ab6bcc1288b Mon Sep 17 00:00:00 2001 From: davidnolen Date: Fri, 6 Jun 2025 21:18:56 -0400 Subject: [PATCH 1/3] - experiments w/ lowering the machinery around printing --- src/main/cljs/cljs/core.cljs | 72 ++++++++++++++++++++++++++++-------- 1 file changed, 57 insertions(+), 15 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 79a8fe96d..19c55e9df 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -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! @@ -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)) @@ -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))] + (let [coll (-seq coll)] + (when 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))))) @@ -11795,6 +11828,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] From 34203d6f34968ef4dd8b04f2a7e896362acd6aa8 Mon Sep 17 00:00:00 2001 From: davidnolen Date: Fri, 6 Jun 2025 22:07:44 -0400 Subject: [PATCH 2/3] - fix --- src/main/cljs/cljs/core.cljs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 19c55e9df..32a6c0e01 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -10477,8 +10477,8 @@ reduces them without incurring seq initialization" (if (zero? (:print-length opts)) (when (-seq coll) (-write writer (or (:more-marker opts) "..."))) - (let [coll (-seq coll)] - (when coll + (do + (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)))) From a8b7b4824570bc21e2171898f1b55c687d2f1b3b Mon Sep 17 00:00:00 2001 From: davidnolen Date: Fri, 6 Jun 2025 22:47:52 -0400 Subject: [PATCH 3/3] * pr-writer-impl - .toString vs. str - no lazy seq - write-all -> write-all-array --- src/main/cljs/cljs/core.cljs | 87 +++++++++++++++++++++--------------- 1 file changed, 50 insertions(+), 37 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 32a6c0e01..5514c3425 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -10495,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"))) @@ -10516,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) @@ -10548,7 +10554,7 @@ 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 @@ -10556,15 +10562,19 @@ reduces them without incurring seq initialization" ^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) @@ -10580,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 @@ -10744,7 +10757,7 @@ 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] @@ -10752,7 +10765,7 @@ reduces them without incurring seq initialization" (-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)