From 526ab9a50475433505b530541ae42066127834dc Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 30 May 2025 15:34:52 -0500 Subject: [PATCH 01/14] update to new parent pom --- pom.template.xml | 2 +- pom.xml | 2 +- project.clj | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/pom.template.xml b/pom.template.xml index c99ccb834..b10649dd0 100644 --- a/pom.template.xml +++ b/pom.template.xml @@ -207,7 +207,7 @@ org.clojure pom.contrib - 0.1.2 + 1.3.0 --> diff --git a/pom.xml b/pom.xml index 755cebc9b..8e310075a 100644 --- a/pom.xml +++ b/pom.xml @@ -207,7 +207,7 @@ org.clojure pom.contrib - 0.1.2 + 1.3.0 --> diff --git a/project.clj b/project.clj index 647d5a664..3977529e5 100644 --- a/project.clj +++ b/project.clj @@ -1,6 +1,6 @@ (defproject org.clojure/clojurescript "0.0-SNAPSHOT" :description "ClojureScript compiler and core runtime library" - :parent [org.clojure/pom.contrib "0.1.2"] + :parent [org.clojure/pom.contrib "1.3.0"] :url "https://github.com/clojure/clojurescript" :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} From 6fb3ce18dae51dc507b27adfe52e1f6fa1d8c497 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 30 May 2025 17:04:50 -0500 Subject: [PATCH 02/14] update build deployment plugins --- pom.template.xml | 128 ++++++++++++++++++++++++++--------------------- pom.xml | 128 ++++++++++++++++++++++++++--------------------- script/build | 3 +- 3 files changed, 141 insertions(+), 118 deletions(-) diff --git a/pom.template.xml b/pom.template.xml index b10649dd0..dabde1b99 100644 --- a/pom.template.xml +++ b/pom.template.xml @@ -203,20 +203,6 @@ https://github.com/clojure/clojurescript - - - - org.sonatype.oss - oss-parent - 7 - - UTF-8 src/main/clojure @@ -226,13 +212,30 @@ true + + + central + https://central.sonatype.com + + + central-snapshot + https://central.sonatype.com/repository/maven-snapshots/ + + + + + org.apache.maven.plugins + maven-source-plugin + 3.3.1 + + org.codehaus.mojo build-helper-maven-plugin - 1.5 + 3.0.0 add-clojure-source-dirs @@ -286,7 +289,7 @@ maven-jar-plugin - 2.4 + 2.4.2 @@ -318,7 +321,7 @@ maven-assembly-plugin - 2.4 + 3.7.1 aot-jar @@ -352,62 +355,71 @@ maven-gpg-plugin 3.1.0 - - --pinentry-mode - loopback - + + --pinentry-mode + loopback + org.apache.maven.plugins maven-compiler-plugin - 3.1 + 3.8.1 21 21 + + + + org.apache.maven.plugins + maven-release-plugin + 2.5.3 + + + + + + + org.sonatype.central + central-publishing-maven-plugin + 0.7.0 + true + + central + true + + + - sonatype-oss-release - - - - - org.apache.maven.plugins - maven-deploy-plugin - 2.7 - - true - - - - org.sonatype.plugins - nexus-staging-maven-plugin - 1.7.0 - - - default-deploy - deploy - - - deploy - - - - - - https://oss.sonatype.org/ - - sonatype-nexus-staging - - - - + sign + + + + + org.apache.maven.plugins + maven-gpg-plugin + 1.5 + + + sign-artifacts + verify + + sign + + + + + + diff --git a/pom.xml b/pom.xml index 8e310075a..a0f07896c 100644 --- a/pom.xml +++ b/pom.xml @@ -203,20 +203,6 @@ https://github.com/clojure/clojurescript - - - - org.sonatype.oss - oss-parent - 7 - - UTF-8 src/main/clojure @@ -226,13 +212,30 @@ true + + + central + https://central.sonatype.com + + + central-snapshot + https://central.sonatype.com/repository/maven-snapshots/ + + + + + org.apache.maven.plugins + maven-source-plugin + 3.3.1 + + org.codehaus.mojo build-helper-maven-plugin - 1.5 + 3.0.0 add-clojure-source-dirs @@ -286,7 +289,7 @@ maven-jar-plugin - 2.4 + 3.4.2 @@ -318,7 +321,7 @@ maven-assembly-plugin - 2.4 + 3.7.1 aot-jar @@ -352,62 +355,71 @@ maven-gpg-plugin 3.1.0 - - --pinentry-mode - loopback - + + --pinentry-mode + loopback + org.apache.maven.plugins maven-compiler-plugin - 3.1 + 3.8.1 21 21 + + + + org.apache.maven.plugins + maven-release-plugin + 2.5.3 + + + + + + + org.sonatype.central + central-publishing-maven-plugin + 0.7.0 + true + + central + true + + + - sonatype-oss-release - - - - - org.apache.maven.plugins - maven-deploy-plugin - 2.7 - - true - - - - org.sonatype.plugins - nexus-staging-maven-plugin - 1.7.0 - - - default-deploy - deploy - - - deploy - - - - - - https://oss.sonatype.org/ - - sonatype-nexus-staging - - - - + sign + + + + + org.apache.maven.plugins + maven-gpg-plugin + 1.5 + + + sign-artifacts + verify + + sign + + + + + + diff --git a/script/build b/script/build index ebcd00558..9ecd7f03e 100755 --- a/script/build +++ b/script/build @@ -66,8 +66,7 @@ mv $AOT_CACHE_FILE src/main/cljs/cljs/core.cljs.cache.aot.edn # For Hudson server if [ "$HUDSON" = "true" ]; then - mvn -B -ntp --fail-at-end -Psonatype-oss-release $CLJS_SCRIPT_MVN_OPTS \ - clean deploy nexus-staging:release + mvn -B -ntp --fail-at-end -DskipStaging=true -Psign $CLJS_SCRIPT_MVN_OPTS clean deploy echo "Creating tag $TAG" git tag -f "$TAG" From 4c45e0235131ac78d279a9e2a2518e61e96cc684 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 2 Jun 2025 16:55:41 -0500 Subject: [PATCH 03/14] build source and javadoc jars for Maven central deployment --- pom.template.xml | 28 +++++++++++++++++++++++++--- pom.xml | 30 ++++++++++++++++++++++++++---- 2 files changed, 51 insertions(+), 7 deletions(-) diff --git a/pom.template.xml b/pom.template.xml index dabde1b99..884a2d628 100644 --- a/pom.template.xml +++ b/pom.template.xml @@ -221,7 +221,7 @@ central-snapshot https://central.sonatype.com/repository/maven-snapshots/ - + @@ -229,8 +229,17 @@ org.apache.maven.plugins maven-source-plugin 3.3.1 + + + attach-sources + package + + jar + + + - + org.codehaus.mojo @@ -289,7 +298,7 @@ maven-jar-plugin - 2.4.2 + 3.4.2 @@ -317,6 +326,19 @@ + + javadoc-jar + package + + jar + + + + ** + + javadoc + + diff --git a/pom.xml b/pom.xml index a0f07896c..b524959cc 100644 --- a/pom.xml +++ b/pom.xml @@ -229,6 +229,15 @@ org.apache.maven.plugins maven-source-plugin 3.3.1 + + + attach-sources + package + + jar + + + @@ -317,6 +326,19 @@ + + javadoc-jar + package + + jar + + + + ** + + javadoc + + @@ -355,10 +377,10 @@ maven-gpg-plugin 3.1.0 - - --pinentry-mode - loopback - + + --pinentry-mode + loopback + From d26872c35229bc16c773008ebdc3f1dae177a3e5 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 2 Jun 2025 16:58:15 -0500 Subject: [PATCH 04/14] use release plugin --- script/build | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/script/build b/script/build index 9ecd7f03e..e50a121f0 100755 --- a/script/build +++ b/script/build @@ -66,7 +66,7 @@ mv $AOT_CACHE_FILE src/main/cljs/cljs/core.cljs.cache.aot.edn # For Hudson server if [ "$HUDSON" = "true" ]; then - mvn -B -ntp --fail-at-end -DskipStaging=true -Psign $CLJS_SCRIPT_MVN_OPTS clean deploy + mvn -B -ntp --fail-at-end -DskipStaging=true -Psign $CLJS_SCRIPT_MVN_OPTS clean deploy release echo "Creating tag $TAG" git tag -f "$TAG" From 2e81eb3b1626e9021509a5ffd935b0091a389141 Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Mon, 2 Jun 2025 17:03:14 -0500 Subject: [PATCH 05/14] Revert "use release plugin" This reverts commit d26872c35229bc16c773008ebdc3f1dae177a3e5. --- script/build | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/script/build b/script/build index e50a121f0..9ecd7f03e 100755 --- a/script/build +++ b/script/build @@ -66,7 +66,7 @@ mv $AOT_CACHE_FILE src/main/cljs/cljs/core.cljs.cache.aot.edn # For Hudson server if [ "$HUDSON" = "true" ]; then - mvn -B -ntp --fail-at-end -DskipStaging=true -Psign $CLJS_SCRIPT_MVN_OPTS clean deploy release + mvn -B -ntp --fail-at-end -DskipStaging=true -Psign $CLJS_SCRIPT_MVN_OPTS clean deploy echo "Creating tag $TAG" git tag -f "$TAG" From 4d13556023452ec85d23f13d1f25798e07d6931c Mon Sep 17 00:00:00 2001 From: David Nolen Date: Thu, 5 Jun 2025 20:26:47 -0400 Subject: [PATCH 06/14] Fix protocol fn DCE issue (#252) * fixes invoke to cljs.core/str in protocol fns * add another trivial dce test w/ a protocol fn --- src/main/clojure/cljs/core.cljc | 4 ++-- src/test/cljs_build/trivial/core2.cljs | 3 +++ src/test/clojure/cljs/build_api_tests.clj | 13 +++++++++++++ 3 files changed, 18 insertions(+), 2 deletions(-) create mode 100644 src/test/cljs_build/trivial/core2.cljs diff --git a/src/main/clojure/cljs/core.cljc b/src/main/clojure/cljs/core.cljc index 72f465427..8418c5eca 100644 --- a/src/main/clojure/cljs/core.cljc +++ b/src/main/clojure/cljs/core.cljc @@ -3287,9 +3287,9 @@ argseq#)))) (if (:macro meta) `(throw (js/Error. - (str "Invalid arity: " (- (alength (js-arguments)) 2)))) + (.join (array "Invalid arity: " (- (alength (js-arguments)) 2)) ""))) `(throw (js/Error. - (str "Invalid arity: " (alength (js-arguments)))))))))) + (.join (array "Invalid arity: " (alength (js-arguments))) "")))))))) ~@(map #(fn-method name %) fdecl) ;; optimization properties (set! (. ~name ~'-cljs$lang$maxFixedArity) ~maxfa) diff --git a/src/test/cljs_build/trivial/core2.cljs b/src/test/cljs_build/trivial/core2.cljs new file mode 100644 index 000000000..5e2f4fb0d --- /dev/null +++ b/src/test/cljs_build/trivial/core2.cljs @@ -0,0 +1,3 @@ +(ns trivial.core2) + +(. js/console (-lookup 1 2)) diff --git a/src/test/clojure/cljs/build_api_tests.clj b/src/test/clojure/cljs/build_api_tests.clj index e788c1ace..f65c1580f 100644 --- a/src/test/clojure/cljs/build_api_tests.clj +++ b/src/test/clojure/cljs/build_api_tests.clj @@ -720,6 +720,19 @@ (build/build (build/inputs (io/file inputs "trivial/core.cljs")) opts cenv) (is (< (.length out-file) 10000)))) +(deftest trivial-output-size-protocol + (let [out (.getPath (io/file (test/tmp-dir) "trivial-output-protocol-test-out")) + out-file (io/file out "main.js") + {:keys [inputs opts]} {:inputs (str (io/file "src" "test" "cljs_build")) + :opts {:main 'trivial.core2 + :output-dir out + :output-to (.getPath out-file) + :optimizations :advanced}} + cenv (env/default-compiler-env)] + (test/delete-out-files out) + (build/build (build/inputs (io/file inputs "trivial/core2.cljs")) opts cenv) + (is (< (.length out-file) 10000)))) + (deftest cljs-3255-nil-inputs-build (let [out (.getPath (io/file (test/tmp-dir) "3255-test-out")) out-file (io/file out "main.js") From 0bf4c3ff9eb4b2a8af8294f6b7314c756fd32f4a Mon Sep 17 00:00:00 2001 From: David Nolen Date: Fri, 6 Jun 2025 16:53:54 -0400 Subject: [PATCH 07/14] More DCE cleanup (#253) Tiny DCE improvements - just use empty list in IndexedSeq - just invoke toString on StringBuffer - inline toString impl for EmptyList - reify should not emit basis static method - reify should set meta to nil if no actual meta, not empty map --- src/main/cljs/cljs/core.cljs | 7 +++---- src/main/clojure/cljs/core.cljc | 19 ++++++++++++++----- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 3e789b6dc..79a8fe96d 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -909,7 +909,7 @@ writer (StringBufferWriter. sb)] (-pr-writer obj writer (pr-opts)) (-flush writer) - (str sb))) + (.toString sb))) ;;;;;;;;;;;;;;;;;;; Murmur3 ;;;;;;;;;;;;;;; @@ -1648,7 +1648,7 @@ reduces them without incurring seq initialization" (-first [_] (aget arr i)) (-rest [_] (if (< (inc i) (alength arr)) (IndexedSeq. arr (inc i) nil) - (list))) + ())) INext (-next [_] (if (< (inc i) (alength arr)) @@ -3206,8 +3206,7 @@ reduces them without incurring seq initialization" (deftype EmptyList [meta] Object - (toString [coll] - (pr-str* coll)) + (toString [coll] "()") (equiv [this other] (-equiv this other)) (indexOf [coll x] diff --git a/src/main/clojure/cljs/core.cljc b/src/main/clojure/cljs/core.cljc index 8418c5eca..1424674a2 100644 --- a/src/main/clojure/cljs/core.cljc +++ b/src/main/clojure/cljs/core.cljc @@ -1365,7 +1365,7 @@ [& impls] (core/let [t (with-meta (gensym - (core/str "t_" + (core/str "t_reify_" (string/replace (core/str (munge ana/*cljs-ns*)) "." "$"))) {:anonymous true}) meta-sym (gensym "meta") @@ -1382,7 +1382,11 @@ IMeta (~'-meta [~this-sym] ~meta-sym) ~@impls)) - (new ~t ~@locals ~(ana/elide-reader-meta (meta &form)))))) + (new ~t ~@locals + ;; if the form meta is empty, emit nil + ~(core/let [form-meta (ana/elide-reader-meta (meta &form))] + (core/when-not (empty? form-meta) + form-meta)))))) (core/defmacro specify! "Identical to reify but mutates its first argument." @@ -1789,17 +1793,22 @@ [t fields & impls] (validate-fields "deftype" t fields) (core/let [env &env - r (:name (cljs.analyzer/resolve-var (dissoc env :locals) t)) + v (cljs.analyzer/resolve-var (dissoc env :locals) t) + r (:name v) [fpps pmasks] (prepare-protocol-masks env impls) protocols (collect-protocols impls env) t (vary-meta t assoc :protocols protocols - :skip-protocol-flag fpps) ] + :skip-protocol-flag fpps)] `(do (deftype* ~t ~fields ~pmasks ~(if (seq impls) `(extend-type ~t ~@(dt->et t impls fields)))) - (set! (.-getBasis ~t) (fn [] '[~@fields])) + ;; don't emit static basis method w/ reify + ;; nor for core types + ~@(core/when-not (core/or (string/starts-with? (name t) "t_reify") + (= 'cljs.core (:ns v))) + [`(set! (.-getBasis ~t) (fn [] '[~@fields]))]) (set! (.-cljs$lang$type ~t) true) (set! (.-cljs$lang$ctorStr ~t) ~(core/str r)) (set! (.-cljs$lang$ctorPrWriter ~t) (fn [this# writer# opt#] (-write writer# ~(core/str r)))) From e34ba40399add1bee917f7073687cfdcf4262019 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 9 Jun 2025 09:00:00 -0400 Subject: [PATCH 08/14] pr-writer-impl lower level impl for js object printing * remove pr-writer-impl dependence on lazy seq, MapEntry - use Array.map instead of map - reify IMapEntry instead of concrete MapEntry * use primitive regex method --- src/main/cljs/cljs/core.cljs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 79a8fe96d..f6a8d24ea 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -10529,9 +10529,15 @@ reduces them without incurring seq initialization" (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)) + (.map + (js-keys obj) + (fn [k] + (reify + IMapEntry + (-key [_] + (cond-> k (some? (.match k #"^[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*$")) keyword)) + (-val [_] + (unchecked-get obj k))))) pr-writer writer opts)) (array? obj) From ffacd2314221e262c9460506a9688d3103041804 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 9 Jun 2025 12:03:18 -0400 Subject: [PATCH 09/14] Remove pr-opts calls, backwards compatibility tweaks (#257) * remove calls to pr-opts - just use dynamic binding - keep it backwards compatible * add long missing infer-tag case for :try --- src/main/cljs/cljs/core.cljs | 61 +++++++++++++++++++++-------- src/main/clojure/cljs/analyzer.cljc | 1 + 2 files changed, 46 insertions(+), 16 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index f6a8d24ea..f67cb27a1 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -267,6 +267,31 @@ "Returns true if x is not nil, false otherwise." [x] (not (nil? x))) +(defn- pr-opts-fnl [opts] + (if-not (nil? opts) + (:flush-on-newline opts) + *flush-on-newline*)) + +(defn- pr-opts-readably [opts] + (if-not (nil? opts) + (:readably opts) + *print-readably*)) + +(defn- pr-opts-meta [opts] + (if-not (nil? opts) + (:meta opts) + *print-meta*)) + +(defn- pr-opts-dup [opts] + (if-not (nil? opts) + (:dup opts) + *print-dup*)) + +(defn- pr-opts-len [opts] + (if-not (nil? opts) + (:print-length opts) + *print-length*)) + (defn object? "Returns true if x's constructor is Object" [x] @@ -907,7 +932,7 @@ [^not-native obj] (let [sb (StringBuffer.) writer (StringBufferWriter. sb)] - (-pr-writer obj writer (pr-opts)) + (-pr-writer obj writer nil) (-flush writer) (.toString sb))) @@ -10441,13 +10466,13 @@ reduces them without incurring seq initialization" (-write writer "#") (do (-write writer begin) - (if (zero? (:print-length opts)) + (if (zero? (pr-opts-len opts)) (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))] + (loop [coll (next coll) n (dec (pr-opts-len opts))] (if (and coll (or (nil? n) (not (zero? n)))) (do (-write writer sep) @@ -10491,7 +10516,7 @@ reduces them without incurring seq initialization" (declare print-map) (defn print-meta? [opts obj] - (and (boolean (get opts :meta)) + (and (boolean (pr-opts-meta opts)) (implements? IMeta obj) (not (nil? (meta obj))))) @@ -10544,7 +10569,7 @@ reduces them without incurring seq initialization" (pr-sequential-writer writer pr-writer "#js [" " " "]" opts obj) (string? obj) - (if (:readably opts) + (if (pr-opts-readably opts) (-write writer (quote-string obj)) (-write writer obj)) @@ -10643,18 +10668,18 @@ reduces them without incurring seq initialization" ([] (newline nil)) ([opts] (string-print "\n") - (when (get opts :flush-on-newline) + (when (pr-opts-fnl opts) (flush)))) (defn pr-str "pr to a string, returning it. Fundamental entrypoint to IPrintWithWriter." [& objs] - (pr-str-with-opts objs (pr-opts))) + (pr-str-with-opts objs nil)) (defn prn-str "Same as pr-str followed by (newline)" [& objs] - (prn-str-with-opts objs (pr-opts))) + (prn-str-with-opts objs nil)) (defn pr "Prints the object(s) using string-print. Prints the @@ -10662,38 +10687,42 @@ reduces them without incurring seq initialization" By default, pr and prn print in a way that objects can be read by the reader" [& objs] - (pr-with-opts objs (pr-opts))) + (pr-with-opts objs nil)) (def ^{:doc "Prints the object(s) using string-print. print and println produce output for human consumption."} print (fn cljs-core-print [& objs] - (pr-with-opts objs (assoc (pr-opts) :readably false)))) + (binding [*print-readably* false] + (pr-with-opts objs nil)))) (defn print-str "print to a string, returning it" [& objs] - (pr-str-with-opts objs (assoc (pr-opts) :readably false))) + (binding [*print-readably* false] + (pr-str-with-opts objs nil))) (defn println "Same as print followed by (newline)" [& objs] - (pr-with-opts objs (assoc (pr-opts) :readably false)) + (binding [*print-readably* false] + (pr-with-opts objs nil)) (when *print-newline* - (newline (pr-opts)))) + (newline nil))) (defn println-str "println to a string, returning it" [& objs] - (prn-str-with-opts objs (assoc (pr-opts) :readably false))) + (binding [*print-readably* false] + (prn-str-with-opts objs nil))) (defn prn "Same as pr followed by (newline)." [& objs] - (pr-with-opts objs (pr-opts)) + (pr-with-opts objs nil) (when *print-newline* - (newline (pr-opts)))) + (newline nil))) (defn- strip-ns [named] diff --git a/src/main/clojure/cljs/analyzer.cljc b/src/main/clojure/cljs/analyzer.cljc index 8c61c4586..a13c08545 100644 --- a/src/main/clojure/cljs/analyzer.cljc +++ b/src/main/clojure/cljs/analyzer.cljc @@ -1568,6 +1568,7 @@ :throw impl/IGNORE_SYM :let (infer-tag env (:body ast)) :loop (infer-tag env (:body ast)) + :try (infer-tag env (:body ast)) :do (infer-tag env (:ret ast)) :fn-method (infer-tag env (:body ast)) :def (infer-tag env (:init ast)) From e611bd0b0b1afbc6cf45ed13b374599cf762f6eb Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 9 Jun 2025 17:02:08 -0400 Subject: [PATCH 10/14] avoid call to assoc, use -assoc --- src/main/cljs/cljs/core.cljs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index f67cb27a1..5c94309c4 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -10624,7 +10624,7 @@ reduces them without incurring seq initialization" to a StringBuffer." [obj writer opts] (if-let [alt-impl (:alt-impl opts)] - (alt-impl obj writer (assoc opts :fallback-impl pr-writer-impl)) + (alt-impl obj writer (-assoc opts :fallback-impl pr-writer-impl)) (pr-writer-impl obj writer opts))) (defn pr-seq-writer [objs writer opts] From 078d59df2095c9a3f60b216e8d478c4614b55597 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 9 Jun 2025 23:38:54 -0400 Subject: [PATCH 11/14] Use primitives in print-map (#258) * lower print-map - lift pr-map-entry-helper, implement ISeqable - lift-ns uses array of MapEntry instead of actual map --- src/main/cljs/cljs/core.cljs | 50 +++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 5c94309c4..12025eaac 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -10520,6 +10520,14 @@ reduces them without incurring seq initialization" (implements? IMeta obj) (not (nil? (meta obj))))) +(defn- pr-map-entry [k v] + (reify + IMapEntry + (-key [_] k) + (-val [_] v) + ISeqable + (-seq [_] (IndexedSeq. #js [k v] 0 nil)))) + (defn- pr-writer-impl [obj writer opts] (cond @@ -10557,12 +10565,9 @@ reduces them without incurring seq initialization" (.map (js-keys obj) (fn [k] - (reify - IMapEntry - (-key [_] - (cond-> k (some? (.match k #"^[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*$")) keyword)) - (-val [_] - (unchecked-get obj k))))) + (pr-map-entry + (cond-> k (some? (.match k #"^[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*$")) keyword) + (unchecked-get obj k)))) pr-writer writer opts)) (array? obj) @@ -10731,20 +10736,22 @@ reduces them without incurring seq initialization" (keyword nil (name named)))) (defn- lift-ns - "Returns [lifted-ns lifted-map] or nil if m can't be lifted." + "Returns #js [lifted-ns lifted-map] or nil if m can't be lifted." [m] (when *print-namespace-maps* - (loop [ns nil - [[k v :as entry] & entries] (seq m) - lm (empty m)] - (if entry - (when (or (keyword? k) (symbol? k)) - (if ns - (when (= ns (namespace k)) - (recur ns entries (assoc lm (strip-ns k) v))) - (when-let [new-ns (namespace k)] - (recur new-ns entries (assoc lm (strip-ns k) v))))) - [ns lm])))) + (let [lm #js []] + (loop [ns nil + [[k v :as entry] & entries] (seq m)] + (if entry + (when (or (keyword? k) (symbol? k)) + (if ns + (when (= ns (namespace k)) + (.push lm (pr-map-entry (strip-ns k) v)) + (recur ns entries)) + (when-let [new-ns (namespace k)] + (.push lm (pr-map-entry (strip-ns k) v)) + (recur new-ns entries)))) + #js [ns lm]))))) (defn print-prefix-map [prefix m print-one writer opts] (pr-sequential-writer @@ -10757,10 +10764,11 @@ reduces them without incurring seq initialization" opts (seq m))) (defn print-map [m print-one writer opts] - (let [[ns lift-map] (when (map? m) - (lift-ns m))] + (let [ns&lift-map (when (map? m) + (lift-ns m)) + ns (some-> ns&lift-map (aget 0))] (if ns - (print-prefix-map (str "#:" ns) lift-map print-one writer opts) + (print-prefix-map (str "#:" ns) (aget ns&lift-map 1) print-one writer opts) (print-prefix-map nil m print-one writer opts)))) (extend-protocol IPrintWithWriter From 9bb394258ac7755833fdaced57ac6be5ed9d7fa5 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Tue, 10 Jun 2025 08:47:24 -0400 Subject: [PATCH 12/14] Remove the circularity that str has with IndexedSeq (#255) * remove the circularity that str has with IndexedSeq - add private str_ for cljs.core usage - keep str for now to avoid any potential breakage - add some simple tests for apply + str_ - the other cases already well covered by existing tests around printing --- src/main/cljs/cljs/core.cljs | 203 +++++++++++++++++------------- src/main/clojure/cljs/core.cljc | 18 +++ src/test/cljs/cljs/core_test.cljs | 9 ++ 3 files changed, 140 insertions(+), 90 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index 12025eaac..b97f00fa2 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -357,7 +357,7 @@ (defn type->str [ty] (if-let [s (.-cljs$lang$ctorStr ty)] s - (str ty))) + (str_ ty))) ;; INTERNAL - do not use, only for Node.js (defn load-file [file] @@ -1175,7 +1175,7 @@ :else (throw (new js/Error "no conversion to symbol")))) ([ns name] (let [sym-str (if-not (nil? ns) - (str ns "/" name) + (str_ ns "/" name) name)] (Symbol. ns name sym-str nil nil)))) @@ -1184,7 +1184,7 @@ (isMacro [_] (. (val) -cljs$lang$macro)) (toString [_] - (str "#'" sym)) + (str_ "#'" sym)) IDeref (-deref [_] (val)) IMeta @@ -1299,7 +1299,7 @@ (native-satisfies? ISeqable coll) (-seq coll) - :else (throw (js/Error. (str coll " is not ISeqable")))))) + :else (throw (js/Error. (str_ coll " is not ISeqable")))))) (defn first "Returns the first item in the collection. Calls seq on its @@ -1448,7 +1448,7 @@ (-compare [this other] (if (instance? js/Date other) (garray/defaultCompare (.valueOf this) (.valueOf other)) - (throw (js/Error. (str "Cannot compare " this " to " other)))))) + (throw (js/Error. (str_ "Cannot compare " this " to " other)))))) (defprotocol Inst (inst-ms* [inst])) @@ -1967,7 +1967,7 @@ reduces them without incurring seq initialization" (-nth coll n) :else - (throw (js/Error. (str "nth not supported on this type " + (throw (js/Error. (str_ "nth not supported on this type " (type->str (type coll))))))) ([coll n not-found] (cond @@ -2000,7 +2000,7 @@ reduces them without incurring seq initialization" (-nth coll n not-found) :else - (throw (js/Error. (str "nth not supported on this type " + (throw (js/Error. (str_ "nth not supported on this type " (type->str (type coll)))))))) (defn nthrest @@ -2495,7 +2495,7 @@ reduces them without incurring seq initialization" (number? x) (if (number? y) (garray/defaultCompare x y) - (throw (js/Error. (str "Cannot compare " x " to " y)))) + (throw (js/Error. (str_ "Cannot compare " x " to " y)))) (satisfies? IComparable x) (-compare x y) @@ -2504,7 +2504,7 @@ reduces them without incurring seq initialization" (if (and (or (string? x) (array? x) (true? x) (false? x)) (identical? (type x) (type y))) (garray/defaultCompare x y) - (throw (js/Error. (str "Cannot compare " x " to " y)))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y)))))) (defn ^:private compare-indexed "Compare indexed collection." @@ -3072,6 +3072,29 @@ reduces them without incurring seq initialization" ;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;; +(defn- str_ + "Implementation detail. Internal str without circularity on IndexedSeq. + @param x + @param {...*} var_args" + [x var-args] + (cond + ;; works whether x is undefined or null (cljs nil) + (nil? x) "" + ;; if we have no more parameters, return + (undefined? var-args) (.join #js [x] "") + ;; var arg case without relying on CLJS fn machinery which creates + ;; a circularity via IndexedSeq + :else + (let [sb (StringBuffer.) + args (js-arguments) + len (alength args)] + (loop [i 0] + (if (< i len) + (do + (.append sb (cljs.core/str_ (aget args i))) + (recur (inc i))) + (.toString sb)))))) + (defn str "With no args, returns the empty string. With one arg x, returns x.toString(). (str nil) returns the empty string. With more than @@ -3081,10 +3104,10 @@ reduces them without incurring seq initialization" "" (.join #js [x] ""))) ([x & ys] - (loop [sb (StringBuffer. (str x)) more ys] - (if more - (recur (. sb (append (str (first more)))) (next more)) - (.toString sb))))) + (loop [sb (StringBuffer. (str x)) more ys] + (if more + (recur (. sb (append (str (first more)))) (next more)) + (.toString sb))))) (defn subs "Returns the substring of s beginning at start inclusive, and ending @@ -3419,7 +3442,7 @@ reduces them without incurring seq initialization" (deftype Keyword [ns name fqn ^:mutable _hash] Object - (toString [_] (str ":" fqn)) + (toString [_] (str_ ":" fqn)) (equiv [this other] (-equiv this other)) @@ -3443,7 +3466,7 @@ reduces them without incurring seq initialization" (-namespace [_] ns) IPrintWithWriter - (-pr-writer [o writer _] (-write writer (str ":" fqn)))) + (-pr-writer [o writer _] (-write writer (str_ ":" fqn)))) (defn keyword? "Return true if x is a Keyword" @@ -3473,7 +3496,7 @@ reduces them without incurring seq initialization" [x] (if (implements? INamed x) (-namespace x) - (throw (js/Error. (str "Doesn't support namespace: " x))))) + (throw (js/Error. (str_ "Doesn't support namespace: " x))))) (defn ident? "Return true if x is a symbol or keyword" @@ -3525,7 +3548,7 @@ reduces them without incurring seq initialization" (keyword? name) (cljs.core/name name) (symbol? name) (cljs.core/name name) :else name)] - (Keyword. ns name (str (when ns (str ns "/")) name) nil)))) + (Keyword. ns name (str_ (when ns (str_ ns "/")) name) nil)))) (deftype LazySeq [meta ^:mutable fn ^:mutable s ^:mutable __hash] Object @@ -4187,7 +4210,7 @@ reduces them without incurring seq initialization" (string? coll) (string-iter coll) (array? coll) (array-iter coll) (seqable? coll) (seq-iter coll) - :else (throw (js/Error. (str "Cannot create iterator from " coll))))) + :else (throw (js/Error. (str_ "Cannot create iterator from " coll))))) (deftype Many [vals] Object @@ -4199,7 +4222,7 @@ reduces them without incurring seq initialization" (isEmpty [this] (zero? (.-length vals))) (toString [this] - (str "Many: " vals))) + (str_ "Many: " vals))) (def ^:private NONE #js {}) @@ -4213,21 +4236,21 @@ reduces them without incurring seq initialization" (Many. #js [val o]))) (remove [this] (if (identical? val NONE) - (throw (js/Error. (str "Removing object from empty buffer"))) + (throw (js/Error. (str_ "Removing object from empty buffer"))) (let [ret val] (set! val NONE) ret))) (isEmpty [this] (identical? val NONE)) (toString [this] - (str "Single: " val))) + (str_ "Single: " val))) (deftype Empty [] Object (add [this o] (Single. o)) (remove [this] - (throw (js/Error. (str "Removing object from empty buffer")))) + (throw (js/Error. (str_ "Removing object from empty buffer")))) (isEmpty [this] true) (toString [this] @@ -4374,8 +4397,8 @@ reduces them without incurring seq initialization" (defn even? "Returns true if n is even, throws an exception if n is not an integer" [n] (if (integer? n) - (zero? (bit-and n 1)) - (throw (js/Error. (str "Argument must be an integer: " n))))) + (zero? (bit-and n 1)) + (throw (js/Error. (str_ "Argument must be an integer: " n))))) (defn odd? "Returns true if n is odd, throws an exception if n is not an integer" @@ -5549,7 +5572,7 @@ reduces them without incurring seq initialization" ret)))))) (defn- vector-index-out-of-bounds [i cnt] - (throw (js/Error. (str "No item " i " in vector of length " cnt)))) + (throw (js/Error. (str_ "No item " i " in vector of length " cnt)))) (defn- first-array-for-longvec [pv] ;; invariants: (count pv) > 32. @@ -5778,14 +5801,14 @@ reduces them without incurring seq initialization" IVector (-assoc-n [coll n val] (cond - (and (<= 0 n) (< n cnt)) - (if (<= (tail-off coll) n) + (and (<= 0 n) (< n cnt)) + (if (<= (tail-off coll) n) (let [new-tail (aclone tail)] (aset new-tail (bit-and n 0x01f) val) (PersistentVector. meta cnt shift root new-tail nil)) (PersistentVector. meta cnt shift (do-assoc coll shift root n val) tail nil)) - (== n cnt) (-conj coll val) - :else (throw (js/Error. (str "Index " n " out of bounds [0," cnt "]"))))) + (== n cnt) (-conj coll val) + :else (throw (js/Error. (str_ "Index " n " out of bounds [0," cnt "]"))))) IReduce (-reduce [v f] @@ -6104,7 +6127,7 @@ reduces them without incurring seq initialization" (-assoc-n [coll n val] (let [v-pos (+ start n)] (if (or (neg? n) (<= (inc end) v-pos)) - (throw (js/Error. (str "Index " n " out of bounds [0," (-count coll) "]"))) + (throw (js/Error. (str_ "Index " n " out of bounds [0," (-count coll) "]"))) (build-subvec meta (assoc v v-pos val) start (max end (inc v-pos)) nil)))) IReduce @@ -6292,7 +6315,7 @@ reduces them without incurring seq initialization" :else (throw (js/Error. - (str "Index " n " out of bounds for TransientVector of length" cnt)))) + (str_ "Index " n " out of bounds for TransientVector of length" cnt)))) (throw (js/Error. "assoc! after persistent!")))) (-pop! [tcoll] @@ -7199,7 +7222,7 @@ reduces them without incurring seq initialization" idx (array-index-of ret k)] (if (== idx -1) (doto ret (.push k) (.push v)) - (throw (js/Error. (str "Duplicate key: " k))))) + (throw (js/Error. (str_ "Duplicate key: " k))))) (recur (+ i 2)))) (let [cnt (/ (alength arr) 2)] (PersistentArrayMap. nil cnt arr nil))))) @@ -8268,7 +8291,7 @@ reduces them without incurring seq initialization" (loop [i 0 ^not-native out (transient (.-EMPTY PersistentHashMap))] (if (< i len) (if (<= (alength vs) i) - (throw (js/Error. (str "No value supplied for key: " (aget ks i)))) + (throw (js/Error. (str_ "No value supplied for key: " (aget ks i)))) (recur (inc i) (-assoc! out (aget ks i) (aget vs i)))) (persistent! out)))))) @@ -8280,7 +8303,7 @@ reduces them without incurring seq initialization" (when (< i len) (-assoc! ret (aget arr i) (aget arr (inc i))) (if (not= (-count ret) (inc (/ i 2))) - (throw (js/Error. (str "Duplicate key: " (aget arr i)))) + (throw (js/Error. (str_ "Duplicate key: " (aget arr i)))) (recur (+ i 2))))) (-persistent! ret)))) @@ -9143,7 +9166,7 @@ reduces them without incurring seq initialization" (if in (let [in' (next in)] (if (nil? in') - (throw (js/Error. (str "No value supplied for key: " (first in)))) + (throw (js/Error. (str_ "No value supplied for key: " (first in)))) (recur (next in') (assoc! out (first in) (first in')) ))) (persistent! out)))) @@ -9155,7 +9178,7 @@ reduces them without incurring seq initialization" (.-arr keyvals) (into-array keyvals))] (if (odd? (alength arr)) - (throw (js/Error. (str "No value supplied for key: " (last arr)))) + (throw (js/Error. (str_ "No value supplied for key: " (last arr)))) (.createAsIfByAssoc PersistentArrayMap arr)))) (defn seq-to-map-for-destructuring @@ -9518,7 +9541,7 @@ reduces them without incurring seq initialization" (dotimes [i len] (-conj! t (aget items i)) (when-not (= (count t) (inc i)) - (throw (js/Error. (str "Duplicate key: " (aget items i)))))) + (throw (js/Error. (str_ "Duplicate key: " (aget items i)))))) (-persistent! t)))) (set! (.-createAsIfByAssoc PersistentHashSet) @@ -9767,7 +9790,7 @@ reduces them without incurring seq initialization" (-name x) (if (string? x) x - (throw (js/Error. (str "Doesn't support name: " x)))))) + (throw (js/Error. (str_ "Doesn't support name: " x)))))) (defn zipmap "Returns a map with the keys mapped to the corresponding vals." @@ -10508,7 +10531,7 @@ reduces them without incurring seq initialization" (defn ^:private quote-string [s] - (str \" + (str_ \" (.replace s (js/RegExp "[\\\\\"\b\f\n\r\t]" "g") (fn [match] (unchecked-get char-escapes match))) \")) @@ -10548,7 +10571,7 @@ reduces them without incurring seq initialization" (-pr-writer obj writer opts) (or (true? obj) (false? obj)) - (-write writer (str obj)) + (-write writer (str_ obj)) (number? obj) (-write writer @@ -10556,7 +10579,7 @@ 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 (str_ obj))) (object? obj) (do @@ -10585,15 +10608,15 @@ reduces them without incurring seq initialization" name)] (write-all writer "#object[" name (if *print-fn-bodies* - (str " \"" (str obj) "\"") + (str_ " \"" (str_ obj) "\"") "") "]")) (instance? js/Date obj) (let [normalize (fn [n len] - (loop [ns (str n)] + (loop [ns (str_ n)] (if (< (count ns) len) - (recur (str "0" ns)) + (recur (str_ "0" ns)) ns)))] (write-all writer "#inst \"" @@ -10621,7 +10644,7 @@ reduces them without incurring seq initialization" name)] (if (nil? (. obj -constructor)) (write-all writer "#object[" name "]") - (write-all writer "#object[" name " " (str obj) "]")))))))) + (write-all writer "#object[" name " " (str_ obj) "]")))))))) (defn- pr-writer "Prefer this to pr-seq, because it makes the printing function @@ -10651,7 +10674,7 @@ reduces them without incurring seq initialization" [objs opts] (if (empty? objs) "" - (str (pr-sb-with-opts objs opts)))) + (str_ (pr-sb-with-opts objs opts)))) (defn prn-str-with-opts "Same as pr-str-with-opts followed by (newline)" @@ -10660,7 +10683,7 @@ reduces them without incurring seq initialization" "\n" (let [sb (pr-sb-with-opts objs opts)] (.append sb \newline) - (str sb)))) + (str_ sb)))) (defn- pr-with-opts "Prints a sequence of objects using string-print, observing all @@ -10760,7 +10783,7 @@ reduces them without incurring seq initialization" (do (print-one (key e) w opts) (-write w \space) (print-one (val e) w opts))) - (str prefix "{") ", " "}" + (str_ prefix "{") ", " "}" opts (seq m))) (defn print-map [m print-one writer opts] @@ -10768,7 +10791,7 @@ reduces them without incurring seq initialization" (lift-ns m)) ns (some-> ns&lift-map (aget 0))] (if ns - (print-prefix-map (str "#:" ns) (aget ns&lift-map 1) print-one writer opts) + (print-prefix-map (str_ "#:" ns) (aget ns&lift-map 1) print-one writer opts) (print-prefix-map nil m print-one writer opts)))) (extend-protocol IPrintWithWriter @@ -10901,43 +10924,43 @@ reduces them without incurring seq initialization" (-compare [x y] (if (symbol? y) (compare-symbols x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) Keyword (-compare [x y] (if (keyword? y) (compare-keywords x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) Subvec (-compare [x y] (if (vector? y) (compare-indexed x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) PersistentVector (-compare [x y] (if (vector? y) (compare-indexed x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) MapEntry (-compare [x y] (if (vector? y) (compare-indexed x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) BlackNode (-compare [x y] (if (vector? y) (compare-indexed x y) - (throw (js/Error. (str "Cannot compare " x " to " y))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y))))) RedNode (-compare [x y] (if (vector? y) (compare-indexed x y) - (throw (js/Error. (str "Cannot compare " x " to " y)))))) + (throw (js/Error. (str_ "Cannot compare " x " to " y)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Reference Types ;;;;;;;;;;;;;;;; @@ -10998,7 +11021,7 @@ reduces them without incurring seq initialization" ([prefix-string] (when (nil? gensym_counter) (set! gensym_counter (atom 0))) - (symbol (str prefix-string (swap! gensym_counter inc))))) + (symbol (str_ prefix-string (swap! gensym_counter inc))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Delay ;;;;;;;;;;;;;;;;;;;; @@ -11228,7 +11251,7 @@ reduces them without incurring seq initialization" (nil? x) nil (satisfies? IEncodeJS x) (-clj->js x) (keyword? x) (keyword-fn x) - (symbol? x) (str x) + (symbol? x) (str_ x) (map? x) (let [m (js-obj)] (doseq [[k v] x] (gobject/set m (keyfn k) (thisfn v))) @@ -11252,7 +11275,7 @@ reduces them without incurring seq initialization" ([x] (js->clj x :keywordize-keys false)) ([x & opts] (let [{:keys [keywordize-keys]} opts - keyfn (if keywordize-keys keyword str) + keyfn (if keywordize-keys keyword str_) f (fn thisfn [x] (cond (satisfies? IEncodeClojure x) @@ -11427,9 +11450,9 @@ reduces them without incurring seq initialization" (or (when-not (contains? (tp tag) parent) (when (contains? (ta tag) parent) - (throw (js/Error. (str tag "already has" parent "as ancestor")))) + (throw (js/Error. (str_ tag "already has" parent "as ancestor")))) (when (contains? (ta parent) tag) - (throw (js/Error. (str "Cyclic derivation:" parent "has" tag "as ancestor")))) + (throw (js/Error. (str_ "Cyclic derivation:" parent "has" tag "as ancestor")))) {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent)) :ancestors (tf (:ancestors h) tag td parent ta) :descendants (tf (:descendants h) parent ta tag td)}) @@ -11492,7 +11515,7 @@ reduces them without incurring seq initialization" be)] (when-not (dominates (first be2) k prefer-table @hierarchy) (throw (js/Error. - (str "Multiple methods in multimethod '" name + (str_ "Multiple methods in multimethod '" name "' match dispatch value: " dispatch-val " -> " k " and " (first be2) ", and neither is preferred")))) be2) @@ -11523,7 +11546,7 @@ reduces them without incurring seq initialization" (-dispatch-fn [mf])) (defn- throw-no-method-error [name dispatch-val] - (throw (js/Error. (str "No method in multimethod '" name "' for dispatch value: " dispatch-val)))) + (throw (js/Error. (str_ "No method in multimethod '" name "' for dispatch value: " dispatch-val)))) (deftype MultiFn [name dispatch-fn default-dispatch-val hierarchy method-table prefer-table method-cache cached-hierarchy] @@ -11689,7 +11712,7 @@ reduces them without incurring seq initialization" (-prefer-method [mf dispatch-val-x dispatch-val-y] (when (prefers* dispatch-val-y dispatch-val-x prefer-table) - (throw (js/Error. (str "Preference conflict in multimethod '" name "': " dispatch-val-y + (throw (js/Error. (str_ "Preference conflict in multimethod '" name "': " dispatch-val-y " is already preferred to " dispatch-val-x)))) (swap! prefer-table (fn [old] @@ -11764,7 +11787,7 @@ reduces them without incurring seq initialization" IPrintWithWriter (-pr-writer [_ writer _] - (-write writer (str "#uuid \"" uuid "\""))) + (-write writer (str_ "#uuid \"" uuid "\""))) IHash (-hash [this] @@ -11776,7 +11799,7 @@ reduces them without incurring seq initialization" (-compare [this other] (if (instance? UUID other) (garray/defaultCompare uuid (.-uuid other)) - (throw (js/Error. (str "Cannot compare " this " to " other)))))) + (throw (js/Error. (str_ "Cannot compare " this " to " other)))))) (defn uuid "Returns a UUID consistent with the string s." @@ -11790,14 +11813,14 @@ reduces them without incurring seq initialization" (letfn [(^string quad-hex [] (let [unpadded-hex ^string (.toString (rand-int 65536) 16)] (case (count unpadded-hex) - 1 (str "000" unpadded-hex) - 2 (str "00" unpadded-hex) - 3 (str "0" unpadded-hex) + 1 (str_ "000" unpadded-hex) + 2 (str_ "00" unpadded-hex) + 3 (str_ "0" unpadded-hex) unpadded-hex)))] (let [ver-tripple-hex ^string (.toString (bit-or 0x4000 (bit-and 0x0fff (rand-int 65536))) 16) res-tripple-hex ^string (.toString (bit-or 0x8000 (bit-and 0x3fff (rand-int 65536))) 16)] (uuid - (str (quad-hex) (quad-hex) "-" (quad-hex) "-" + (str_ (quad-hex) (quad-hex) "-" (quad-hex) "-" ver-tripple-hex "-" res-tripple-hex "-" (quad-hex) (quad-hex) (quad-hex)))))) @@ -11971,7 +11994,7 @@ reduces them without incurring seq initialization" IPrintWithWriter (-pr-writer [o writer opts] - (-write writer (str "#" tag " ")) + (-write writer (str_ "#" tag " ")) (pr-writer form writer opts))) (defn tagged-literal? @@ -12024,11 +12047,11 @@ reduces them without incurring seq initialization" (if (seq ks) (recur (next ks) - (str + (str_ (cond-> ret - (not (identical? ret "")) (str "|")) + (not (identical? ret "")) (str_ "|")) (first ks))) - (str ret "|\\$")))))) + (str_ ret "|\\$")))))) DEMUNGE_PATTERN) (defn- ^string munge-str [name] @@ -12044,10 +12067,10 @@ reduces them without incurring seq initialization" (.toString sb))) (defn munge [name] - (let [name' (munge-str (str name)) + (let [name' (munge-str (str_ name)) name' (cond (identical? name' "..") "_DOT__DOT_" - (js-reserved? name') (str name' "$") + (js-reserved? name') (str_ name' "$") :else name')] (if (symbol? name) (symbol name') @@ -12062,17 +12085,17 @@ reduces them without incurring seq initialization" (if-let [match (.exec r munged-name)] (let [[x] match] (recur - (str ret + (str_ ret (.substring munged-name last-match-end (- (. r -lastIndex) (. x -length))) (if (identical? x "$") "/" (gobject/get DEMUNGE_MAP x))) (. r -lastIndex))) - (str ret + (str_ ret (.substring munged-name last-match-end (.-length munged-name))))))) (defn demunge [name] - ((if (symbol? name) symbol str) - (let [name' (str name)] + ((if (symbol? name) symbol str_) + (let [name' (str_ name)] (if (identical? name' "_DOT__DOT_") ".." (demunge-str name'))))) @@ -12151,14 +12174,14 @@ reduces them without incurring seq initialization" (deftype Namespace [obj name] Object (findInternedVar [this sym] - (let [k (munge (str sym))] + (let [k (munge (str_ sym))] (when ^boolean (gobject/containsKey obj k) - (let [var-sym (symbol (str name) (str sym)) + (let [var-sym (symbol (str_ name) (str_ sym)) var-meta {:ns this}] (Var. (ns-lookup obj k) var-sym var-meta))))) (getName [_] name) (toString [_] - (str name)) + (str_ name)) IEquiv (-equiv [_ other] (if (instance? Namespace other) @@ -12183,10 +12206,10 @@ reduces them without incurring seq initialization" (defn find-ns-obj "Bootstrap only." [ns] - (let [munged-ns (munge (str ns)) + (let [munged-ns (munge (str_ ns)) segs (.split munged-ns ".")] (case *target* - "nodejs" (if ^boolean js/COMPILED + "nodejs" (if ^boolean js/COMPILED ; Under simple optimizations on nodejs, namespaces will be in module ; rather than global scope and must be accessed by a direct call to eval. ; The first segment may refer to an undefined variable, so its evaluation @@ -12201,7 +12224,7 @@ reduces them without incurring seq initialization" (next segs)) (find-ns-obj* goog/global segs)) ("default" "webworker") (find-ns-obj* goog/global segs) - (throw (js/Error. (str "find-ns-obj not supported for target " *target*)))))) + (throw (js/Error. (str_ "find-ns-obj not supported for target " *target*)))))) (defn ns-interns* "Returns a map of the intern mappings for the namespace. @@ -12213,7 +12236,7 @@ reduces them without incurring seq initialization" (let [var-sym (symbol (demunge k))] (assoc ret var-sym (Var. #(gobject/get ns-obj k) - (symbol (str sym) (str var-sym)) {:ns ns}))))] + (symbol (str_ sym) (str_ var-sym)) {:ns ns}))))] (reduce step {} (js-keys ns-obj))))) (defn create-ns @@ -12244,9 +12267,9 @@ reduces them without incurring seq initialization" [ns] (when (nil? NS_CACHE) (set! NS_CACHE (atom {}))) - (let [ns-str (str ns) + (let [ns-str (str_ ns) ns (if (not ^boolean (gstring/contains ns-str "$macros")) - (symbol (str ns-str "$macros")) + (symbol (str_ ns-str "$macros")) ns) the-ns (get @NS_CACHE ns)] (if-not (nil? the-ns) @@ -12277,7 +12300,7 @@ reduces them without incurring seq initialization" (defn ^:private parsing-err "Construct message for parsing for non-string parsing error" [val] - (str "Expected string, got: " (if (nil? val) "nil" (goog/typeOf val)))) + (str_ "Expected string, got: " (if (nil? val) "nil" (goog/typeOf val)))) (defn ^number parse-long "Parse string of decimal digits with optional leading -/+ and return an diff --git a/src/main/clojure/cljs/core.cljc b/src/main/clojure/cljs/core.cljc index 1424674a2..8393a1a67 100644 --- a/src/main/clojure/cljs/core.cljc +++ b/src/main/clojure/cljs/core.cljc @@ -849,6 +849,24 @@ (core/defn- string-expr [e] (vary-meta e assoc :tag 'string)) +(core/defmacro str_ + ([] "") + ([x] + (if (typed-expr? &env x '#{string}) + x + (string-expr (core/list 'js* "cljs.core.str_(~{})" x)))) + ([x & ys] + (core/let [interpolate (core/fn [x] + (if (typed-expr? &env x '#{string clj-nil}) + "~{}" + "cljs.core.str_(~{})")) + strs (core/->> (core/list* x ys) + (map interpolate) + (interpose ",") + (apply core/str))] + (string-expr (list* 'js* (core/str "[" strs "].join('')") x ys))))) + +;; TODO: should probably be a compiler pass to avoid the code duplication (core/defmacro str ([] "") ([x] diff --git a/src/test/cljs/cljs/core_test.cljs b/src/test/cljs/cljs/core_test.cljs index 9c4a62528..58720b5a1 100644 --- a/src/test/cljs/cljs/core_test.cljs +++ b/src/test/cljs/cljs/core_test.cljs @@ -2056,3 +2056,12 @@ [1 2 {:a 1, :b 2, :c 3}])) (is (= (test-keys :d 4 {:a 1, :b 2, :c 3}) [1 2 {:d 4, :a 1, :b 2, :c 3}])))) + +(deftest test-str_ + (is (= "" (apply cljs.core/str_ nil))) + (is (= "" (apply cljs.core/str_ []))) + (is (= "1" (apply cljs.core/str_ 1 []))) + (is (= "12" (apply cljs.core/str_ 1 [2]))) + (is (= "1two:threefour#{:five}[:six]#{:seven}{:eight :nine}" + (apply cljs.core/str_ 1 ["two" :three 'four #{:five} [:six] #{:seven} {:eight :nine}]))) + (is (= "1234" (apply cljs.core/str_ 1 2 [3 4])))) \ No newline at end of file From ad83b3edd3ef088ef63f9e3c05bf594824e569ab Mon Sep 17 00:00:00 2001 From: David Nolen Date: Tue, 10 Jun 2025 09:52:49 -0400 Subject: [PATCH 13/14] More trivial source build tests verifying DCE doesn't regress (#259) * add two more trivial output tests - keyword should be very small - vector by itself should be reasonable - bump windows version --- .github/workflows/test.yaml | 4 +-- src/test/cljs_build/trivial/core2.cljs | 2 +- src/test/cljs_build/trivial/core3.cljs | 3 +++ src/test/cljs_build/trivial/core4.cljs | 3 +++ src/test/clojure/cljs/build_api_tests.clj | 30 +++++++++++++++++++++-- 5 files changed, 37 insertions(+), 5 deletions(-) create mode 100644 src/test/cljs_build/trivial/core3.cljs create mode 100644 src/test/cljs_build/trivial/core4.cljs diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index e6a4590d0..e98aa8818 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -62,7 +62,7 @@ jobs: # Runtime Tests runtime-windows-test: name: Runtime Windows Tests - runs-on: windows-2019 + runs-on: windows-2022 steps: - uses: actions/checkout@v2 @@ -215,7 +215,7 @@ jobs: # Compiler Windows Tests compiler-windows-test: name: Compiler Windows Tests - runs-on: windows-2019 + runs-on: windows-2022 steps: - uses: actions/checkout@v2 diff --git a/src/test/cljs_build/trivial/core2.cljs b/src/test/cljs_build/trivial/core2.cljs index 5e2f4fb0d..a79e64e80 100644 --- a/src/test/cljs_build/trivial/core2.cljs +++ b/src/test/cljs_build/trivial/core2.cljs @@ -1,3 +1,3 @@ (ns trivial.core2) -(. js/console (-lookup 1 2)) +(.log js/console (-lookup 1 2)) diff --git a/src/test/cljs_build/trivial/core3.cljs b/src/test/cljs_build/trivial/core3.cljs new file mode 100644 index 000000000..a66db571c --- /dev/null +++ b/src/test/cljs_build/trivial/core3.cljs @@ -0,0 +1,3 @@ +(ns trivial.core3) + +(.log js/console :foo) diff --git a/src/test/cljs_build/trivial/core4.cljs b/src/test/cljs_build/trivial/core4.cljs new file mode 100644 index 000000000..f8f4c6d25 --- /dev/null +++ b/src/test/cljs_build/trivial/core4.cljs @@ -0,0 +1,3 @@ +(ns trivial.core4) + +(.log js/console []) diff --git a/src/test/clojure/cljs/build_api_tests.clj b/src/test/clojure/cljs/build_api_tests.clj index f65c1580f..f05a4ac3f 100644 --- a/src/test/clojure/cljs/build_api_tests.clj +++ b/src/test/clojure/cljs/build_api_tests.clj @@ -718,7 +718,7 @@ cenv (env/default-compiler-env)] (test/delete-out-files out) (build/build (build/inputs (io/file inputs "trivial/core.cljs")) opts cenv) - (is (< (.length out-file) 10000)))) + (is (< (.length out-file) 10240)))) (deftest trivial-output-size-protocol (let [out (.getPath (io/file (test/tmp-dir) "trivial-output-protocol-test-out")) @@ -731,7 +731,33 @@ cenv (env/default-compiler-env)] (test/delete-out-files out) (build/build (build/inputs (io/file inputs "trivial/core2.cljs")) opts cenv) - (is (< (.length out-file) 10000)))) + (is (< (.length out-file) 10240)))) + +(deftest trivial-output-size-keyword + (let [out (.getPath (io/file (test/tmp-dir) "trivial-output-keyword-test-out")) + out-file (io/file out "main.js") + {:keys [inputs opts]} {:inputs (str (io/file "src" "test" "cljs_build")) + :opts {:main 'trivial.core3 + :output-dir out + :output-to (.getPath out-file) + :optimizations :advanced}} + cenv (env/default-compiler-env)] + (test/delete-out-files out) + (build/build (build/inputs (io/file inputs "trivial/core3.cljs")) opts cenv) + (is (< (.length out-file) 10240)))) + +(deftest trivial-output-size-vector + (let [out (.getPath (io/file (test/tmp-dir) "trivial-output-vector-test-out")) + out-file (io/file out "main.js") + {:keys [inputs opts]} {:inputs (str (io/file "src" "test" "cljs_build")) + :opts {:main 'trivial.core4 + :output-dir out + :output-to (.getPath out-file) + :optimizations :advanced}} + cenv (env/default-compiler-env)] + (test/delete-out-files out) + (build/build (build/inputs (io/file inputs "trivial/core4.cljs")) opts cenv) + (is (< (.length out-file) 32768)))) (deftest cljs-3255-nil-inputs-build (let [out (.getPath (io/file (test/tmp-dir) "3255-test-out")) From 90a40f69d5d3f2c34aa2c2e6612bb14296b2e383 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Fri, 13 Jun 2025 05:47:11 -0400 Subject: [PATCH 14/14] Add code size ratchet for PHM --- src/test/cljs_build/trivial/core5.cljs | 3 +++ src/test/clojure/cljs/build_api_tests.clj | 13 +++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 src/test/cljs_build/trivial/core5.cljs diff --git a/src/test/cljs_build/trivial/core5.cljs b/src/test/cljs_build/trivial/core5.cljs new file mode 100644 index 000000000..1e7f87756 --- /dev/null +++ b/src/test/cljs_build/trivial/core5.cljs @@ -0,0 +1,3 @@ +(ns trivial.core5) + +(.log js/console {}) \ No newline at end of file diff --git a/src/test/clojure/cljs/build_api_tests.clj b/src/test/clojure/cljs/build_api_tests.clj index f05a4ac3f..a1a2f3871 100644 --- a/src/test/clojure/cljs/build_api_tests.clj +++ b/src/test/clojure/cljs/build_api_tests.clj @@ -759,6 +759,19 @@ (build/build (build/inputs (io/file inputs "trivial/core4.cljs")) opts cenv) (is (< (.length out-file) 32768)))) +(deftest trivial-output-size-map + (let [out (.getPath (io/file (test/tmp-dir) "trivial-output-map-test-out")) + out-file (io/file out "main.js") + {:keys [inputs opts]} {:inputs (str (io/file "src" "test" "cljs_build")) + :opts {:main 'trivial.core5 + :output-dir out + :output-to (.getPath out-file) + :optimizations :advanced}} + cenv (env/default-compiler-env)] + (test/delete-out-files out) + (build/build (build/inputs (io/file inputs "trivial/core5.cljs")) opts cenv) + (is (< (.length out-file) 92160)))) + (deftest cljs-3255-nil-inputs-build (let [out (.getPath (io/file (test/tmp-dir) "3255-test-out")) out-file (io/file out "main.js") pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.

Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy