From 526ab9a50475433505b530541ae42066127834dc Mon Sep 17 00:00:00 2001 From: Alex Miller Date: Fri, 30 May 2025 15:34:52 -0500 Subject: [PATCH 01/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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/19] 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") From 55491752ad2ec03f773692ddbd1ce97cac7e3722 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Sun, 6 Jul 2025 09:59:08 -0400 Subject: [PATCH 15/19] Refactor has-extern? / js-tag (#246) * fix up tests so they don't throw if no warnings * resolve-extern, which can be used by both has-extern? and js-tag, returns both resolved prefix and var info * remove various hacks around extern resolution (Number, Window, prototype etc.), resolve-extern handles everything * undefined is a ref cycle, special case * change normalize-js-tag so it marks the ctor prop * add normalize-unresolved-prefix to fix up the cases we can't find * add impl unit tests * more unit test - can finally resolve crypto.subtle, verify type inference as well * add lift-tag-to-js helper * in resolve-var add the ctor to the tag to track later, this also lets the extra information flow * in analyze-dot check to see if the target is a constructor - if it is use that as tag instead, Function is not useful * test assertion that we can figure out the return even if a extern js ctor is bound to a local * add compiler test case for inferring return of Number.isNaN * add non-ctor inference for array, string, boolean and number, will be useful later * add js/isNaN test * add isArray extern test * don't return raised js/Foo types for boolean, number, string * remove ^boolean hint from array? ass test * remove hint for make-array, add test * remove hints for isFinite and isSafeInteger, tests * can infer distinct?, add test * remove various ^boolean cases no longer needed * FIXME comments about dubious ^boolean cases * move ^boolean hint from special-symbol? to contains? where it belongs, test case * goog.object/containsKey type inference doesn't work for reason, leave a trail for later * goog.string/contains does work, add test * remove hint from NaN? * FIXME note about re-matches, another dubious case of ^boolean hints --- src/main/cljs/cljs/core.cljs | 30 ++-- src/main/clojure/cljs/analyzer.cljc | 150 +++++++++++----- src/main/clojure/cljs/compiler.cljc | 3 +- src/main/clojure/cljs/externs.clj | 17 +- src/test/clojure/cljs/compiler_tests.clj | 19 +- src/test/clojure/cljs/externs_infer_tests.clj | 164 ++++++++++++++++-- .../clojure/cljs/externs_parsing_tests.clj | 6 + .../clojure/cljs/type_inference_tests.clj | 40 +++++ 8 files changed, 350 insertions(+), 79 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index b97f00fa2..e1c7b067e 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -243,7 +243,7 @@ [x] (coercive-= x nil)) -(defn ^boolean array? +(defn array? "Returns true if x is a JavaScript array." [x] (if (identical? *target* "nodejs") @@ -444,7 +444,7 @@ (declare apply) -(defn ^array make-array +(defn make-array "Construct a JavaScript array of the specified dimensions. Accepts ignored type argument for compatibility with Clojure. Note that there is no efficient way to allocate multi-dimensional arrays in JavaScript; as such, this function @@ -1055,8 +1055,8 @@ (bit-xor (-hash o) 0) (number? o) - (if ^boolean (js/isFinite o) - (if-not ^boolean (.isSafeInteger js/Number o) + (if (js/isFinite o) + (if-not (.isSafeInteger js/Number o) (hash-double o) (js-mod (Math/floor o) 2147483647)) (case o @@ -2355,7 +2355,7 @@ reduces them without incurring seq initialization" "Returns true if n is a JavaScript number with no decimal part." [n] (and (number? n) - (not ^boolean (js/isNaN n)) + (not (js/isNaN n)) (not (identical? n js/Infinity)) (== (js/parseFloat n) (js/parseInt n 10)))) @@ -2432,7 +2432,7 @@ reduces them without incurring seq initialization" (or (identical? x js/Number.POSITIVE_INFINITY) (identical? x js/Number.NEGATIVE_INFINITY))) -(defn contains? +(defn ^boolean contains? "Returns true if key is present in the given collection, otherwise returns false. Note that for numerically indexed collections like vectors and arrays, this tests if the numeric key is within the @@ -2462,12 +2462,12 @@ reduces them without incurring seq initialization" (contains? coll k)) (MapEntry. k (get coll k) nil)))) -(defn ^boolean distinct? +(defn distinct? "Returns true if no two of the arguments are =" ([x] true) ([x y] (not (= x y))) ([x y & more] - (if (not (= x y)) + (if (not (= x y)) (loop [s #{x y} xs more] (let [x (first xs) etc (next xs)] @@ -8351,6 +8351,7 @@ reduces them without incurring seq initialization" (if (identical? node root) nil (set! root node)) + ;; FIXME: can we figure out something better here? (if ^boolean (.-val added-leaf?) (set! count (inc count))) tcoll)) @@ -8372,6 +8373,7 @@ reduces them without incurring seq initialization" (if (identical? node root) nil (set! root node)) + ;; FIXME: can we figure out something better here? (if ^boolean (.-val removed-leaf?) (set! count (dec count))) tcoll))) @@ -10562,6 +10564,7 @@ reduces them without incurring seq initialization" (pr-writer (meta obj) writer opts) (-write writer " ")) (cond + ;; FIXME: can we figure out something better here? ;; handle CLJS ctors ^boolean (.-cljs$lang$type obj) (.cljs$lang$ctorPrWriter obj obj writer opts) @@ -10576,7 +10579,7 @@ reduces them without incurring seq initialization" (number? obj) (-write writer (cond - ^boolean (js/isNaN obj) "##NaN" + (js/isNaN obj) "##NaN" (identical? obj js/Number.POSITIVE_INFINITY) "##Inf" (identical? obj js/Number.NEGATIVE_INFINITY) "##-Inf" :else (str_ obj))) @@ -11942,7 +11945,7 @@ reduces them without incurring seq initialization" (fn [x y] (cond (pred x y) -1 (pred y x) 1 :else 0))) -(defn ^boolean special-symbol? +(defn special-symbol? "Returns true if x names a special form" [x] (contains? @@ -12175,6 +12178,8 @@ reduces them without incurring seq initialization" Object (findInternedVar [this sym] (let [k (munge (str_ sym))] + ;; FIXME: this shouldn't need ^boolean due to GCL library analysis, + ;; but not currently working (when ^boolean (gobject/containsKey obj k) (let [var-sym (symbol (str_ name) (str_ sym)) var-meta {:ns this}] @@ -12268,7 +12273,7 @@ reduces them without incurring seq initialization" (when (nil? NS_CACHE) (set! NS_CACHE (atom {}))) (let [ns-str (str_ ns) - ns (if (not ^boolean (gstring/contains ns-str "$macros")) + ns (if (not (gstring/contains ns-str "$macros")) (symbol (str_ ns-str "$macros")) ns) the-ns (get @NS_CACHE ns)] @@ -12292,7 +12297,7 @@ reduces them without incurring seq initialization" [x] (instance? goog.Uri x)) -(defn ^boolean NaN? +(defn NaN? "Returns true if num is NaN, else false" [val] (js/isNaN val)) @@ -12321,6 +12326,7 @@ reduces them without incurring seq initialization" [s] (if (string? s) (cond + ;; FIXME: another cases worth thinking about ^boolean (re-matches #"[\x00-\x20]*[+-]?NaN[\x00-\x20]*" s) ##NaN ^boolean (re-matches #"[\x00-\x20]*[+-]?(Infinity|((\d+\.?\d*|\.\d+)([eE][+-]?\d+)?)[dDfF]?)[\x00-\x20]*" diff --git a/src/main/clojure/cljs/analyzer.cljc b/src/main/clojure/cljs/analyzer.cljc index a13c08545..2a6364c8c 100644 --- a/src/main/clojure/cljs/analyzer.cljc +++ b/src/main/clojure/cljs/analyzer.cljc @@ -980,10 +980,10 @@ (defn normalize-js-tag [x] ;; if not 'js, assume constructor (if-not (= 'js x) - (with-meta 'js - {:prefix (conj (->> (string/split (name x) #"\.") - (map symbol) vec) - 'prototype)}) + (let [props (->> (string/split (name x) #"\.") (map symbol)) + [xs y] ((juxt butlast last) props)] + (with-meta 'js + {:prefix (vec (concat xs [(with-meta y {:ctor true})]))})) x)) (defn ->type-set @@ -1030,46 +1030,89 @@ boolean Boolean symbol Symbol}) -(defn has-extern?* +(defn resolve-extern + "Given a foreign js property list, return a resolved js property list and the + extern var info" + ([pre] + (resolve-extern pre (get-externs))) ([pre externs] - (let [pre (if-some [me (find - (get-in externs '[Window prototype]) - (first pre))] - (if-some [tag (-> me first meta :tag)] - (into [tag 'prototype] (next pre)) - pre) - pre)] - (has-extern?* pre externs externs))) - ([pre externs top] + (resolve-extern pre externs externs {:resolved []})) + ([pre externs top ret] (cond - (empty? pre) true + (empty? pre) ret :else (let [x (first pre) me (find externs x)] (cond - (not me) false + (not me) nil :else (let [[x' externs'] me - xmeta (meta x')] - (if (and (= 'Function (:tag xmeta)) (:ctor xmeta)) - (or (has-extern?* (into '[prototype] (next pre)) externs' top) - (has-extern?* (next pre) externs' top) - ;; check base type if it exists - (when-let [super (:super xmeta)] - (has-extern?* (into [super] (next pre)) externs top))) - (recur (next pre) externs' top)))))))) + info' (meta x') + ret (cond-> ret + ;; we only care about var info for the last property + ;; also if we already added it, don't override it + ;; because we're now resolving type information + ;; not instance information anymore + ;; i.e. [console] -> [Console] but :tag is Console _not_ Function vs. + ;; [console log] -> [Console prototype log] where :tag is Function + (and (empty? (next pre)) + (not (contains? ret :info))) + (assoc :info info'))] + ;; handle actual occurrences of types, i.e. `Console` + (if (and (or (:ctor info') (:iface info')) (= 'Function (:tag info'))) + (or + ;; then check for "static" property + (resolve-extern (next pre) externs' top + (update ret :resolved conj x)) + + ;; first look for a property on the prototype + (resolve-extern (into '[prototype] (next pre)) externs' top + (update ret :resolved conj x)) + + ;; finally check the super class if there is one + (when-let [super (:super info')] + (resolve-extern (into [super] (next pre)) externs top + (assoc ret :resolved [])))) + + (or + ;; If the tag of the property isn't Function or undefined, + ;; try to resolve it similar to the super case above, + ;; this handles singleton cases like `console` + (let [tag (:tag info')] + (when (and tag (not (contains? '#{Function undefined} tag))) + ;; check prefix first, during cljs.externs parsing we always generate prefixes + ;; for tags because of types like webCrypto.Crypto + (resolve-extern (into (or (-> tag meta :prefix) [tag]) (next pre)) externs top + (assoc ret :resolved [])))) + + ;; assume static property + (recur (next pre) externs' top + (update ret :resolved conj x)))))))))) + +(defn normalize-unresolved-prefix + [pre] + (cond-> pre + (< 1 (count pre)) + (cond-> + (-> pre pop peek meta :ctor) + (-> pop + (conj 'prototype) + (conj (peek pre)))))) + +(defn has-extern?* + [pre externs] + (boolean (resolve-extern pre externs))) (defn has-extern? ([pre] (has-extern? pre (get-externs))) ([pre externs] (or (has-extern?* pre externs) - (when (= 1 (count pre)) - (let [x (first pre)] - (or (get-in externs (conj '[Window prototype] x)) - (get-in externs (conj '[Number] x))))) (-> (last pre) str (string/starts-with? "cljs$"))))) +(defn lift-tag-to-js [tag] + (symbol "js" (str (alias->type tag tag)))) + (defn js-tag ([pre] (js-tag pre :tag)) @@ -1078,12 +1121,13 @@ ([pre tag-type externs] (js-tag pre tag-type externs externs)) ([pre tag-type externs top] - (when-let [[p externs' :as me] (find externs (first pre))] - (let [tag (-> p meta tag-type)] - (if (= (count pre) 1) - (when tag (symbol "js" (str (alias->type tag tag)))) - (or (js-tag (next pre) tag-type externs' top) - (js-tag (into '[prototype] (next pre)) tag-type (get top tag) top))))))) + (when-let [tag (get-in (resolve-extern pre externs) [:info tag-type])] + (case tag + ;; don't lift these, analyze-dot will raise them for analysis + ;; representing these types as js/Foo is a hassle as it widens the + ;; return types unnecessarily i.e. #{boolean js/Boolean} + (boolean number string) tag + (lift-tag-to-js tag))))) (defn dotted-symbol? [sym] (let [s (str sym)] @@ -1274,8 +1318,9 @@ (assoc shadowed-by-local :op :local)) :else - (let [pre (->> (string/split (name sym) #"\.") (map symbol) vec)] - (when (and (not (has-extern? pre)) + (let [pre (->> (string/split (name sym) #"\.") (map symbol) vec) + res (resolve-extern (->> (string/split (name sym) #"\.") (map symbol) vec))] + (when (and (not res) ;; ignore exists? usage (not (-> sym meta ::no-resolve))) (swap! env/*compiler* update-in @@ -1284,10 +1329,12 @@ {:name sym :op :js-var :ns 'js - :tag (with-meta (or (js-tag pre) (:tag (meta sym)) 'js) {:prefix pre})} + :tag (with-meta (or (js-tag pre) (:tag (meta sym)) 'js) + {:prefix pre + :ctor (-> res :info :ctor)})} (when-let [ret-tag (js-tag pre :ret-tag)] {:js-fn-var true - :ret-tag ret-tag}))))) + :ret-tag ret-tag}))))) (let [s (str sym) lb (handle-symbol-local sym (get locals sym)) current-ns (-> env :ns :name)] @@ -2585,12 +2632,12 @@ :children [:expr]})) (def js-prim-ctor->tag - '{js/Object object - js/String string - js/Array array - js/Number number + '{js/Object object + js/String string + js/Array array + js/Number number js/Function function - js/Boolean boolean}) + js/Boolean boolean}) (defn prim-ctor? "Test whether a tag is a constructor for a JS primitive" @@ -3543,13 +3590,25 @@ (list* '. dot-form) " with classification " (classify-dot-form dot-form)))))) +;; this only for a smaller set of types that we want to infer +;; we don't generally want to consider function for example, these +;; specific cases are ones we either try to optimize or validate +(def ^{:private true} + tag->js-prim-ctor + '{string js/String + array js/Array + number js/Number + boolean js/Boolean}) + (defn analyze-dot [env target field member+ form] (let [v [target field member+] {:keys [dot-action target method field args]} (build-dot-form v) enve (assoc env :context :expr) targetexpr (analyze enve target) form-meta (meta form) - target-tag (:tag targetexpr) + target-tag (as-> (:tag targetexpr) $ + (or (some-> $ meta :ctor lift-tag-to-js) + (tag->js-prim-ctor $ $))) prop (or field method) tag (or (:tag form-meta) (and (js-tag? target-tag) @@ -3581,7 +3640,8 @@ (let [pre (-> tag meta :prefix)] (when-not (has-extern? pre) (swap! env/*compiler* update-in - (into [::namespaces (-> env :ns :name) :externs] pre) merge {})))) + (into [::namespaces (-> env :ns :name) :externs] + (normalize-unresolved-prefix pre)) merge {})))) (case dot-action ::access (let [children [:target]] {:op :host-field diff --git a/src/main/clojure/cljs/compiler.cljc b/src/main/clojure/cljs/compiler.cljc index b96c09b36..fcc03ab96 100644 --- a/src/main/clojure/cljs/compiler.cljc +++ b/src/main/clojure/cljs/compiler.cljc @@ -641,7 +641,8 @@ (defn safe-test? [env e] (let [tag (ana/infer-tag env e)] - (or (#{'boolean 'seq} tag) (truthy-constant? e)))) + (or ('#{boolean seq} (ana/js-prim-ctor->tag tag tag)) + (truthy-constant? e)))) (defmethod emit* :if [{:keys [test then else env unchecked]}] diff --git a/src/main/clojure/cljs/externs.clj b/src/main/clojure/cljs/externs.clj index c5343e1b1..d25987cde 100644 --- a/src/main/clojure/cljs/externs.clj +++ b/src/main/clojure/cljs/externs.clj @@ -61,12 +61,23 @@ (and (= type :string-lit) (= "undefined" value))) +(defn add-prefix + "Externs inference uses :prefix meta to both resolve externs as well as generate + missing externs information. Google Closure Compiler default externs includes + nested types like webCrypto.Crypto. Add prefix information to the returned symbol to + simplify resolution later." + [type-str] + (with-meta (symbol type-str) + {:prefix (->> (string/split (name type-str) #"\.") + (map symbol) vec)})) + (defn simplify-texpr [texpr] (case (:type texpr) - :string-lit (some-> (:value texpr) symbol) - (:star :qmark) 'any - :bang (simplify-texpr (-> texpr :children first)) + :string-lit (-> texpr :value add-prefix) + :star 'any + ;; TODO: qmark should probably be #{nil T} + (:qmark :bang) (simplify-texpr (-> texpr :children first)) :pipe (let [[x y] (:children texpr)] (if (undefined? y) (simplify-texpr x) diff --git a/src/test/clojure/cljs/compiler_tests.clj b/src/test/clojure/cljs/compiler_tests.clj index bb6a9bfc3..95204e650 100644 --- a/src/test/clojure/cljs/compiler_tests.clj +++ b/src/test/clojure/cljs/compiler_tests.clj @@ -15,7 +15,8 @@ [cljs.util :as util] [cljs.tagged-literals :as tags] [clojure.java.io :as io] - [clojure.string :as str]) + [clojure.string :as str] + [clojure.test :as test]) (:import [java.io File])) (defn analyze @@ -374,6 +375,22 @@ window))]))] (is (re-find #"window__\$1" code))))) +(deftest test-externs-infer-is-nan + (testing "Not calls to truth_ if (.isNaN js/Number ...) is used as a test" + (let [code (env/with-compiler-env (env/default-compiler-env) + (compile-form-seq + '[(if (.isNaN js/Number 1) true false)]))] + (is (nil? (re-find #"truth_" code)))))) + +(deftest test-goog-lib-infer-boolean + (testing "Can infer goog.string/contains returns boolean" + (let [code (env/with-compiler-env (env/default-compiler-env) + (compile-form-seq + '[(ns test.foo + (:require [goog.string :as gstring])) + (if (gstring/contains "foobar" "foo") true false)]))] + (is (nil? (re-find #"truth_" code)))))) + ;; CLJS-1225 (comment diff --git a/src/test/clojure/cljs/externs_infer_tests.clj b/src/test/clojure/cljs/externs_infer_tests.clj index 8ca7ff9aa..967164d1f 100644 --- a/src/test/clojure/cljs/externs_infer_tests.clj +++ b/src/test/clojure/cljs/externs_infer_tests.clj @@ -23,6 +23,35 @@ "goog.isArrayLike;" "Java.type;" "Object.out;" "Object.out.println;" "Object.error;" "Object.error.println;"]) +(deftest test-normalize-js-tag + (is (= 'js (ana/normalize-js-tag 'js))) + (is (= '[Foo] (-> 'js/Foo ana/normalize-js-tag meta :prefix))) + (is (true? (-> 'js/Foo ana/normalize-js-tag meta :prefix last meta :ctor))) + (is (= '[Foo Bar] (-> 'js/Foo.Bar ana/normalize-js-tag meta :prefix))) + (is (true? (-> 'js/Foo.Bar ana/normalize-js-tag meta :prefix last meta :ctor)))) + +(deftest test-normalize-unresolved-prefix + (let [pre (-> (ana/normalize-js-tag 'js/Foo) meta :prefix (conj 'bar))] + (is (= '[Foo prototype bar] (ana/normalize-unresolved-prefix pre)))) + (let [pre '[Foo bar]] + (is (= '[Foo bar] (ana/normalize-unresolved-prefix pre))))) + +(comment + + (test/test-vars [#'test-normalize-js-tag]) + (test/test-vars [#'test-normalize-unresolved-prefix]) + + ) + +(deftest test-resolve-extern + (let [externs + (externs/externs-map + (closure/load-externs + {:externs ["src/test/externs/test.js"] + :use-only-custom-externs true}))] + (is (some? (ana/resolve-extern '[baz] externs))) + (is (nil? (ana/resolve-extern '[Foo gozMethod] externs))))) + (deftest test-has-extern?-basic (let [externs (externs/externs-map (closure/load-externs @@ -35,6 +64,35 @@ (is (true? (ana/has-extern? '[baz] externs))) (is (false? (ana/has-extern? '[Baz] externs))))) +(deftest test-resolve-extern + (let [externs (externs/externs-map)] + (is (= '[Number] + (-> (ana/resolve-extern '[Number] externs) :resolved))) + (is (= '[Number prototype valueOf] + (-> (ana/resolve-extern '[Number valueOf] externs) :resolved))) + (is (= '[Console] + (-> (ana/resolve-extern '[console] externs) :resolved))) + (is (= '[Console prototype log] + (-> (ana/resolve-extern '[console log] externs) :resolved))) + (is (= '[undefined] + (-> (ana/resolve-extern '[undefined] externs) :resolved))) + (is (= '[webCrypto Crypto prototype subtle] + (-> (ana/resolve-extern '[crypto subtle] externs) :resolved))))) + +(comment + (clojure.test/test-vars [#'test-resolve-extern]) + + (def externs (externs/externs-map)) + ;; succeeds + (ana/resolve-extern '[console] externs) + (ana/resolve-extern '[console log] externs) + (ana/resolve-extern '[undefined] externs) + (ana/resolve-extern '[Number] externs) + (ana/resolve-extern '[Number isNaN] externs) + (ana/resolve-extern '[document] externs) + + ) + (deftest test-has-extern?-defaults (let [externs (externs/externs-map)] (is (true? (ana/has-extern? '[console] externs))) @@ -47,9 +105,16 @@ {:externs ["src/test/externs/test.js"]}))] (is (= 'js/Console (ana/js-tag '[console] :tag externs))) (is (= 'js/Function (ana/js-tag '[console log] :tag externs))) - (is (= 'js/Boolean (ana/js-tag '[Number isNaN] :ret-tag externs))) + (is (= 'js/undefined (ana/js-tag '[console log] :ret-tag externs))) + (is (= 'boolean (ana/js-tag '[Number isNaN] :ret-tag externs))) (is (= 'js/Foo (ana/js-tag '[baz] :ret-tag externs))))) +(comment + + (clojure.test/test-vars [#'test-js-tag]) + + ) + (defn infer-test-helper [{:keys [forms externs warnings warn js-dependency-index node-module-index with-core? opts]}] (let [test-cenv (atom @@ -82,6 +147,54 @@ (map (comp :externs second) (get @test-cenv ::ana/namespaces)))))))))))) +(deftest test-externs-type-infer + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(.isNaN js/Number 1)))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(js/Number.isNaN 1)))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(let [x js/Number] + (.isNaN x 1))))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(js/isNaN 1)))) + :tag))) + (is (= 'js/Promise + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(.generateKey js/crypto.subtle)))) + :tag))) + (is (= 'string + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(.toUpperCase "foo")))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(.isArray js/Array (array))))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(.isSafeInteger js/Number 1)))) + :tag))) + (is (= 'boolean + (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] + (env/with-compiler-env (env/default-compiler-env) + (analyze (ana/empty-env) '(js/isFinite 1)))) + :tag)))) + (deftest test-externs-infer (is (= 'js/Foo (-> (binding [ana/*cljs-ns* ana/*cljs-ns*] @@ -158,9 +271,9 @@ :warnings ws})] (is (= (unsplit-lines ["Foo.Boo.prototype.wozz;"]) res)) (is (= 1 (count @ws))) - (is (string/starts-with? - (first @ws) - "Cannot resolve property wozz for inferred type js/Foo.Boo")))) + (is (some-> @ws first + (string/starts-with? + "Cannot resolve property wozz for inferred type js/Foo.Boo"))))) (deftest test-type-hint-infer-unknown-property-in-chain (let [ws (atom []) @@ -172,9 +285,9 @@ :warnings ws})] (is (= (unsplit-lines ["Foo.Boo.prototype.wozz;"]) res)) (is (= 1 (count @ws))) - (is (string/starts-with? - (first @ws) - "Cannot resolve property wozz for inferred type js/Foo.Boo")))) + (is (some-> @ws first + (string/starts-with? + "Cannot resolve property wozz for inferred type js/Foo.Boo"))))) (deftest test-type-hint-infer-unknown-method (let [ws (atom []) @@ -185,9 +298,24 @@ :warnings ws})] (is (= (unsplit-lines ["Foo.prototype.gozMethod;"]) res)) (is (= 1 (count @ws))) - (is (string/starts-with? - (first @ws) - "Cannot resolve property gozMethod for inferred type js/Foo")))) + (is (some-> @ws first + (string/starts-with? + "Cannot resolve property gozMethod for inferred type js/Foo"))))) + +(comment + + (require '[clojure.java.io :as io] + '[cljs.closure :as cc]) + + (def externs + (-> (cc/js-source-file nil (io/file "src/test/externs/test.js")) + externs/parse-externs externs/index-externs)) + + (ana/resolve-extern '[Foo gozMethod] externs) + + (clojure.test/test-vars [#'test-type-hint-infer-unknown-method]) + + ) (deftest test-infer-unknown-method-from-externs (let [ws (atom []) @@ -197,9 +325,9 @@ :warnings ws})] (is (= (unsplit-lines ["Foo.prototype.gozMethod;"]) res)) (is (= 1 (count @ws))) - (is (string/starts-with? - (first @ws) - "Cannot resolve property gozMethod for inferred type js/Foo")))) + (is (some-> @ws first + (string/starts-with? + "Cannot resolve property gozMethod for inferred type js/Foo"))))) (deftest test-infer-js-require (let [ws (atom []) @@ -211,9 +339,9 @@ :warnings ws})] (is (= (unsplit-lines ["var require;" "Object.Component;"]) res)) (is (= 1 (count @ws))) - (is (string/starts-with? - (first @ws) - "Adding extern to Object for property Component")))) + (is (some-> @ws first + (string/starts-with? + "Adding extern to Object for property Component"))))) (deftest test-set-warn-on-infer (let [ws (atom []) @@ -227,7 +355,9 @@ :warn false :with-core? true})] (is (= 1 (count @ws))) - (is (string/starts-with? (first @ws) "Cannot infer target type")))) + (is (some-> @ws first + (string/starts-with? + "Cannot infer target type"))))) (deftest test-cljs-1970-infer-with-cljs-literals (let [ws (atom []) diff --git a/src/test/clojure/cljs/externs_parsing_tests.clj b/src/test/clojure/cljs/externs_parsing_tests.clj index ed0cfdb70..e5a399c84 100644 --- a/src/test/clojure/cljs/externs_parsing_tests.clj +++ b/src/test/clojure/cljs/externs_parsing_tests.clj @@ -37,6 +37,12 @@ (is (= 'any (get-in ns [:defs 'get :ret-tag]))) (is (= 'array (get-in ns [:defs 'getKeys :ret-tag]))))) +(comment + ;; works + (get-in (externs/analyze-goog-file "goog/object/object.js") + [:defs 'containsKey :ret-tag]) + ) + (deftest test-parse-super (let [info (-> (filter diff --git a/src/test/clojure/cljs/type_inference_tests.clj b/src/test/clojure/cljs/type_inference_tests.clj index c9c5f6343..5435cc90f 100644 --- a/src/test/clojure/cljs/type_inference_tests.clj +++ b/src/test/clojure/cljs/type_inference_tests.clj @@ -307,12 +307,32 @@ (is (= (env/with-compiler-env test-cenv (:tag (analyze test-env '(dissoc {:foo :bar} :foo)))) '#{clj clj-nil})) + (is (= (env/with-compiler-env test-cenv + (:tag (analyze test-env '(distinct? 1)))) + 'boolean)) + (is (= (env/with-compiler-env test-cenv + (:tag (analyze test-env '(special-symbol? 'foo)))) + 'boolean)) + ;; TODO: we can't infer isa?, we get 'any which is a bit surprising + ;(is (= (env/with-compiler-env test-cenv + ; (:tag (analyze test-env '(isa? ::foo :bar)))) + ; 'boolean)) ;; has changed, why does this return #{clj any} ? ;(is (= (env/with-compiler-env test-cenv ; (:tag (analyze test-env '(assoc nil :foo :bar)))) ; 'clj)) ) +(deftest lib-inference-extern-call + (testing "Test return type inference for core fns whose + internal implementation uses standard JS APIs" + (is (= 'boolean + (env/with-compiler-env test-cenv + (:tag (analyze test-env '(array? (array))))))) + (is (= 'array + (env/with-compiler-env test-cenv + (:tag (analyze test-env '(make-array js/String. 10)))))))) + (deftest test-always-true-if (is (= (env/with-compiler-env test-cenv (:tag (analyze test-env '(if 1 2 "foo")))) @@ -374,3 +394,23 @@ (:import [goog.history Html5History])) (Html5History.)] {} true)))))) + +(deftest test-goog-infer + (is (= 'boolean + (:tag (env/with-compiler-env (env/default-compiler-env) + (ana/analyze-form-seq + '[(ns test.foo + (:require [goog.string :as gstring])) + (gstring/contains "foobar" "foo")] + {} true))))) + ;; FIXME: infers any instead of boolean, nothing wrong w/ the externs parsing + ;; but this definitely does not work at the moment + #_(is (= 'boolean + (:tag + (env/with-compiler-env (env/default-compiler-env) + (ana/analyze-form-seq + '[(ns test.foo + (:require [goog.object :as gobject])) + (gobject/containsKey (js-object) "foo")] + {} true)))))) + From aa5e7516e5031f81857ded5e0d2a2a476d4cfaff Mon Sep 17 00:00:00 2001 From: David Nolen Date: Sun, 6 Jul 2025 13:38:14 -0400 Subject: [PATCH 16/19] CLJS-3439: REPL doc support for externs (#261) * break out ->pre * add cljs.analyzer.api/resolve-extern * new doc lookup path in repl for js/foo symbols --- src/main/clojure/cljs/analyzer.cljc | 5 ++++- src/main/clojure/cljs/analyzer/api.cljc | 9 +++++++++ src/main/clojure/cljs/repl.cljc | 5 +++++ 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/src/main/clojure/cljs/analyzer.cljc b/src/main/clojure/cljs/analyzer.cljc index 2a6364c8c..ac521fa78 100644 --- a/src/main/clojure/cljs/analyzer.cljc +++ b/src/main/clojure/cljs/analyzer.cljc @@ -977,10 +977,13 @@ (or (= 'js x) (= "js" (namespace x))))) +(defn ->pre [x] + (->> (string/split (name x) #"\.") (map symbol))) + (defn normalize-js-tag [x] ;; if not 'js, assume constructor (if-not (= 'js x) - (let [props (->> (string/split (name x) #"\.") (map symbol)) + (let [props (->pre x) [xs y] ((juxt butlast last) props)] (with-meta 'js {:prefix (vec (concat xs [(with-meta y {:ctor true})]))})) diff --git a/src/main/clojure/cljs/analyzer/api.cljc b/src/main/clojure/cljs/analyzer/api.cljc index 2d143a42b..2fa4f2a13 100644 --- a/src/main/clojure/cljs/analyzer/api.cljc +++ b/src/main/clojure/cljs/analyzer/api.cljc @@ -218,6 +218,15 @@ ([state] (keys (get @state ::ana/namespaces)))) +(defn resolve-extern + "Given a symbol attempt to look it up in the provided externs" + ([sym] + (resolve-extern env/*compiler* sym)) + ([state sym] + (let [pre (ana/->pre sym)] + (env/with-compiler-env state + (:info (ana/resolve-extern pre)))))) + (defn find-ns "Given a namespace return the corresponding namespace analysis map. Analagous to clojure.core/find-ns." diff --git a/src/main/clojure/cljs/repl.cljc b/src/main/clojure/cljs/repl.cljc index b5c53738a..b685a62e5 100644 --- a/src/main/clojure/cljs/repl.cljc +++ b/src/main/clojure/cljs/repl.cljc @@ -1447,6 +1447,11 @@ itself (not its value) is returned. The reader macro #'x expands to (var x)."}}) (keyword? name) `(cljs.repl/print-doc {:spec ~name :doc (cljs.spec.alpha/describe ~name)}) + (= "js" (namespace name)) + `(cljs.repl/print-doc + (quote ~(merge (select-keys (ana-api/resolve-extern name) [:doc :arglists]) + {:name name}))) + (ana-api/find-ns name) `(cljs.repl/print-doc (quote ~(select-keys (ana-api/find-ns name) [:name :doc]))) From 60c9055bb037a5111249ec6d846571bd6e57a9a3 Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 7 Jul 2025 14:03:04 -0400 Subject: [PATCH 17/19] CLJS-3438: Inference for `goog.object/containsKey` returns any, not boolean (#262) - fix cljs.analyzer/desugar-dotted-expr, generated malformed AST in the case of goog.module var - compiler test for goog.object/containsKey - fix parameter parsing in cljs.externs to properly handle var args and optional arguments - fix fn-arity warning so that we use unaliased names if available (goog.module names are aliases) - cljs.core: goog.object/containsKey hint no longer needed --- src/main/cljs/cljs/core.cljs | 2 +- src/main/clojure/cljs/analyzer.cljc | 23 ++++++++---- src/main/clojure/cljs/externs.clj | 37 ++++++++++++------- src/test/clojure/cljs/compiler_tests.clj | 10 +++++ .../clojure/cljs/type_inference_tests.clj | 5 +-- 5 files changed, 52 insertions(+), 25 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index e1c7b067e..efbde48e3 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -12180,7 +12180,7 @@ reduces them without incurring seq initialization" (let [k (munge (str_ sym))] ;; FIXME: this shouldn't need ^boolean due to GCL library analysis, ;; but not currently working - (when ^boolean (gobject/containsKey obj k) + (when (gobject/containsKey obj k) (let [var-sym (symbol (str_ name) (str_ sym)) var-meta {:ns this}] (Var. (ns-lookup obj k) var-sym var-meta))))) diff --git a/src/main/clojure/cljs/analyzer.cljc b/src/main/clojure/cljs/analyzer.cljc index ac521fa78..709531e59 100644 --- a/src/main/clojure/cljs/analyzer.cljc +++ b/src/main/clojure/cljs/analyzer.cljc @@ -1214,9 +1214,12 @@ (defmethod resolve* :goog-module [env sym full-ns current-ns] - {:name (symbol (str current-ns) (str (munge-goog-module-lib full-ns) "." (name sym))) - :ns current-ns - :op :var}) + (let [sym-ast (gets @env/*compiler* ::namespaces full-ns :defs (symbol (name sym)))] + (merge sym-ast + {:name (symbol (str current-ns) (str (munge-goog-module-lib full-ns) "." (name sym))) + :ns current-ns + :op :var + :unaliased-name (symbol (str full-ns) (name sym))}))) (defmethod resolve* :global [env sym full-ns current-ns] @@ -3887,15 +3890,15 @@ bind-args? (and HO-invoke? (not (all-values? args)))] (when ^boolean fn-var? - (let [{^boolean variadic :variadic? :keys [max-fixed-arity method-params name ns macro]} (:info fexpr)] - ;; don't warn about invalid arity when when compiling a macros namespace + (let [{^boolean variadic :variadic? :keys [max-fixed-arity method-params name unaliased-name ns macro]} (:info fexpr)] + ;; don't warn about invalid arity when compiling a macros namespace ;; that requires itself, as that code is not meant to be executed in the ;; `$macros` ns - António Monteiro (when (and #?(:cljs (not (and (gstring/endsWith (str cur-ns) "$macros") (symbol-identical? cur-ns ns) (true? macro)))) (invalid-arity? argc method-params variadic max-fixed-arity)) - (warning :fn-arity env {:name name :argc argc})))) + (warning :fn-arity env {:name (or unaliased-name name) :argc argc})))) (when (and kw? (not (or (== 1 argc) (== 2 argc)))) (warning :fn-arity env {:name (first form) :argc argc})) (let [deprecated? (-> fexpr :info :deprecated) @@ -3946,7 +3949,10 @@ {:op :host-field :env (:env expr) :form (list '. prefix field) - :target (desugar-dotted-expr (-> expr + ;; goog.module vars get converted to the form of + ;; current.ns/goog$module.theDef, we need to dissoc + ;; actual extern var info so we get something well-formed + :target (desugar-dotted-expr (-> (dissoc expr :info) (assoc :name prefix :form prefix) (dissoc :tag) @@ -3954,6 +3960,9 @@ (assoc-in [:env :context] :expr))) :field field :tag (:tag expr) + ;; in the case of goog.module var if there is :info, + ;; we need to adopt it now as this is where :ret-tag info lives + :info (:info expr) :children [:target]}) expr) ;:var diff --git a/src/main/clojure/cljs/externs.clj b/src/main/clojure/cljs/externs.clj index d25987cde..e7bf3014b 100644 --- a/src/main/clojure/cljs/externs.clj +++ b/src/main/clojure/cljs/externs.clj @@ -13,9 +13,9 @@ [clojure.string :as string]) (:import [com.google.javascript.jscomp CompilerOptions CompilerOptions$Environment SourceFile CompilerInput CommandLineRunner] - [com.google.javascript.jscomp.parsing Config$JsDocParsing] + [com.google.javascript.jscomp.parsing Config$JsDocParsing JsDocInfoParser$ExtendedTypeInfo] [com.google.javascript.rhino - Node Token JSTypeExpression JSDocInfo$Visibility] + Node Token JSTypeExpression JSDocInfo JSDocInfo$Visibility] [java.util.logging Level] [java.net URL])) @@ -88,14 +88,13 @@ (some-> (.getRoot texpr) parse-texpr simplify-texpr)) (defn params->method-params [xs] - (letfn [(not-opt? [x] - (not (string/starts-with? (name x) "opt_")))] - (let [required (into [] (take-while not-opt? xs)) - opts (drop-while not-opt? xs)] - (loop [ret [required] opts opts] - (if-let [opt (first opts)] - (recur (conj ret (conj (last ret) opt)) (drop 1 opts)) - (seq ret)))))) + (let [not-opt? (complement :optional?) + required (into [] (map :name (take-while not-opt? xs))) + opts (map :name (drop-while not-opt? xs))] + (loop [ret [required] opts opts] + (if-let [opt (first opts)] + (recur (conj ret (conj (last ret) opt)) (drop 1 opts)) + (seq ret))))) (defn generic? [t] (let [s (name t)] @@ -108,6 +107,18 @@ (= t 'Array) 'array :else t))) +(defn get-params + "Return param information in JSDoc appearance order. GCL is relatively + civilized, so this isn't really a problem." + [^JSDocInfo info] + (map + (fn [n] + (let [t (.getParameterType info n)] + {:name (symbol n) + :optional? (.isOptionalArg t) + :var-args? (.isVarArgs t)})) + (.getParameterNames info))) + (defn get-var-info [^Node node] (when node (let [info (.getJSDocInfo node)] @@ -124,15 +135,15 @@ (if (or (.hasReturnType info) (as-> (.getParameterCount info) c (and c (pos? c)))) - (let [arglist (into [] (map symbol (.getParameterNames info))) + (let [arglist (get-params info) arglists (params->method-params arglist)] {:tag 'Function :js-fn-var true :ret-tag (or (some-> (.getReturnType info) get-tag gtype->cljs-type) 'clj-nil) - :variadic? (boolean (some '#{var_args} arglist)) - :max-fixed-arity (count (take-while #(not= 'var_args %) arglist)) + :variadic? (boolean (some :var-args? arglist)) + :max-fixed-arity (count (take-while (complement :var-args?) arglist)) :method-params arglists :arglists arglists})))) {:file *source-file* diff --git a/src/test/clojure/cljs/compiler_tests.clj b/src/test/clojure/cljs/compiler_tests.clj index 95204e650..f6f7b560b 100644 --- a/src/test/clojure/cljs/compiler_tests.clj +++ b/src/test/clojure/cljs/compiler_tests.clj @@ -391,6 +391,16 @@ (if (gstring/contains "foobar" "foo") true false)]))] (is (nil? (re-find #"truth_" code)))))) +(deftest test-goog-module-infer-cljs-3438 + (testing "goog.object/containKey requires correct handling of vars from + goog.module namespace" + (let [code (env/with-compiler-env (env/default-compiler-env) + (compile-form-seq + '[(ns test.foo + (:require [goog.object :as gobject])) + (if (gobject/containsKey nil nil) true false)]))] + (is (nil? (re-find #"truth_" code)))))) + ;; CLJS-1225 (comment diff --git a/src/test/clojure/cljs/type_inference_tests.clj b/src/test/clojure/cljs/type_inference_tests.clj index 5435cc90f..2bd0855c3 100644 --- a/src/test/clojure/cljs/type_inference_tests.clj +++ b/src/test/clojure/cljs/type_inference_tests.clj @@ -403,9 +403,7 @@ (:require [goog.string :as gstring])) (gstring/contains "foobar" "foo")] {} true))))) - ;; FIXME: infers any instead of boolean, nothing wrong w/ the externs parsing - ;; but this definitely does not work at the moment - #_(is (= 'boolean + (is (= 'boolean (:tag (env/with-compiler-env (env/default-compiler-env) (ana/analyze-form-seq @@ -413,4 +411,3 @@ (:require [goog.object :as gobject])) (gobject/containsKey (js-object) "foo")] {} true)))))) - From e1328b7b99d376335bde3e5a0d59c6fab85cebeb Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 7 Jul 2025 14:07:08 -0400 Subject: [PATCH 18/19] - remove unused import from last commit --- src/main/clojure/cljs/externs.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/clojure/cljs/externs.clj b/src/main/clojure/cljs/externs.clj index e7bf3014b..e354aac74 100644 --- a/src/main/clojure/cljs/externs.clj +++ b/src/main/clojure/cljs/externs.clj @@ -13,7 +13,7 @@ [clojure.string :as string]) (:import [com.google.javascript.jscomp CompilerOptions CompilerOptions$Environment SourceFile CompilerInput CommandLineRunner] - [com.google.javascript.jscomp.parsing Config$JsDocParsing JsDocInfoParser$ExtendedTypeInfo] + [com.google.javascript.jscomp.parsing Config$JsDocParsing] [com.google.javascript.rhino Node Token JSTypeExpression JSDocInfo JSDocInfo$Visibility] [java.util.logging Level] From 5027991ea61a2018f008d1f6a81cef025019ee8d Mon Sep 17 00:00:00 2001 From: David Nolen Date: Mon, 7 Jul 2025 15:45:30 -0400 Subject: [PATCH 19/19] remove FIXME comment for gobj/containsKey usage in cljs.core --- src/main/cljs/cljs/core.cljs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs index efbde48e3..f70e544f8 100644 --- a/src/main/cljs/cljs/core.cljs +++ b/src/main/cljs/cljs/core.cljs @@ -12178,8 +12178,6 @@ reduces them without incurring seq initialization" Object (findInternedVar [this sym] (let [k (munge (str_ sym))] - ;; FIXME: this shouldn't need ^boolean due to GCL library analysis, - ;; but not currently working (when (gobject/containsKey obj k) (let [var-sym (symbol (str_ name) (str_ sym)) var-meta {:ns this}]