diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml
index e6a4590d05..e98aa8818d 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/pom.template.xml b/pom.template.xml
index c99ccb8348..884a2d6280 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,39 @@
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
+
+
+ attach-sources
+ package
+
+ jar
+
+
+
+
+
org.codehaus.mojo
build-helper-maven-plugin
- 1.5
+ 3.0.0
add-clojure-source-dirs
@@ -286,7 +298,7 @@
maven-jar-plugin
- 2.4
+ 3.4.2
@@ -314,11 +326,24 @@
+
+ javadoc-jar
+ package
+
+ jar
+
+
+
+ **
+
+ javadoc
+
+
maven-assembly-plugin
- 2.4
+ 3.7.1
aot-jar
@@ -352,62 +377,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 755cebc9b8..b524959cc6 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,39 @@
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
+
+
+ attach-sources
+ package
+
+ jar
+
+
+
+
+
org.codehaus.mojo
build-helper-maven-plugin
- 1.5
+ 3.0.0
add-clojure-source-dirs
@@ -286,7 +298,7 @@
maven-jar-plugin
- 2.4
+ 3.4.2
@@ -314,11 +326,24 @@
+
+ javadoc-jar
+ package
+
+ jar
+
+
+
+ **
+
+ javadoc
+
+
maven-assembly-plugin
- 2.4
+ 3.7.1
aot-jar
@@ -352,62 +377,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/project.clj b/project.clj
index 647d5a664c..3977529e51 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"}
diff --git a/script/build b/script/build
index ebcd00558d..9ecd7f03e4 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"
diff --git a/src/main/cljs/cljs/core.cljs b/src/main/cljs/cljs/core.cljs
index 3e789b6dcf..f70e544f85 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")
@@ -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]
@@ -332,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]
@@ -419,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
@@ -907,9 +932,9 @@
[^not-native obj]
(let [sb (StringBuffer.)
writer (StringBufferWriter. sb)]
- (-pr-writer obj writer (pr-opts))
+ (-pr-writer obj writer nil)
(-flush writer)
- (str sb)))
+ (.toString sb)))
;;;;;;;;;;;;;;;;;;; Murmur3 ;;;;;;;;;;;;;;;
@@ -1030,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
@@ -1150,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))))
@@ -1159,7 +1184,7 @@
(isMacro [_]
(. (val) -cljs$lang$macro))
(toString [_]
- (str "#'" sym))
+ (str_ "#'" sym))
IDeref
(-deref [_] (val))
IMeta
@@ -1274,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
@@ -1423,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]))
@@ -1648,7 +1673,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))
@@ -1942,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
@@ -1975,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
@@ -2330,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))))
@@ -2407,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
@@ -2437,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)]
@@ -2470,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)
@@ -2479,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."
@@ -3047,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
@@ -3056,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
@@ -3206,8 +3254,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]
@@ -3395,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))
@@ -3419,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"
@@ -3449,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"
@@ -3501,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
@@ -4163,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
@@ -4175,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 {})
@@ -4189,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]
@@ -4350,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"
@@ -5525,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.
@@ -5754,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]
@@ -6080,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
@@ -6268,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]
@@ -7175,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)))))
@@ -8244,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))))))
@@ -8256,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))))
@@ -8304,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))
@@ -8325,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)))
@@ -9119,7 +9168,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))))
@@ -9131,7 +9180,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
@@ -9494,7 +9543,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)
@@ -9743,7 +9792,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."
@@ -10442,13 +10491,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)
@@ -10484,7 +10533,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)))
\"))
@@ -10492,10 +10541,18 @@ 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)))))
+(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
@@ -10507,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)
@@ -10516,30 +10574,33 @@ 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
(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)))
+ :else (str_ obj)))
(object? obj)
(do
(-write writer "#js ")
(print-map
- (map (fn [k]
- (MapEntry. (cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword) (unchecked-get obj k) nil))
- (js-keys obj))
+ (.map
+ (js-keys obj)
+ (fn [k]
+ (pr-map-entry
+ (cond-> k (some? (.match k #"^[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*$")) keyword)
+ (unchecked-get obj k))))
pr-writer writer opts))
(array? obj)
(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))
@@ -10550,15 +10611,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 \""
@@ -10586,7 +10647,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
@@ -10594,7 +10655,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]
@@ -10616,7 +10677,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)"
@@ -10625,7 +10686,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
@@ -10638,18 +10699,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
@@ -10657,38 +10718,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]
@@ -10697,20 +10762,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
@@ -10719,14 +10786,15 @@ 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]
- (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
@@ -10859,43 +10927,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 ;;;;;;;;;;;;;;;;
@@ -10956,7 +11024,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 ;;;;;;;;;;;;;;;;;;;;
@@ -11186,7 +11254,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)))
@@ -11210,7 +11278,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)
@@ -11385,9 +11453,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)})
@@ -11450,7 +11518,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)
@@ -11481,7 +11549,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]
@@ -11647,7 +11715,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]
@@ -11722,7 +11790,7 @@ reduces them without incurring seq initialization"
IPrintWithWriter
(-pr-writer [_ writer _]
- (-write writer (str "#uuid \"" uuid "\"")))
+ (-write writer (str_ "#uuid \"" uuid "\"")))
IHash
(-hash [this]
@@ -11734,7 +11802,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."
@@ -11748,14 +11816,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))))))
@@ -11877,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?
@@ -11929,7 +11997,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?
@@ -11982,11 +12050,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]
@@ -12002,10 +12070,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')
@@ -12020,17 +12088,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')))))
@@ -12109,14 +12177,14 @@ reduces them without incurring seq initialization"
(deftype Namespace [obj name]
Object
(findInternedVar [this sym]
- (let [k (munge (str sym))]
- (when ^boolean (gobject/containsKey obj k)
- (let [var-sym (symbol (str name) (str sym))
+ (let [k (munge (str_ sym))]
+ (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)))))
(getName [_] name)
(toString [_]
- (str name))
+ (str_ name))
IEquiv
(-equiv [_ other]
(if (instance? Namespace other)
@@ -12141,10 +12209,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
@@ -12159,7 +12227,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.
@@ -12171,7 +12239,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
@@ -12202,9 +12270,9 @@ reduces them without incurring seq initialization"
[ns]
(when (nil? NS_CACHE)
(set! NS_CACHE (atom {})))
- (let [ns-str (str ns)
- ns (if (not ^boolean (gstring/contains ns-str "$macros"))
- (symbol (str ns-str "$macros"))
+ (let [ns-str (str_ ns)
+ ns (if (not (gstring/contains ns-str "$macros"))
+ (symbol (str_ ns-str "$macros"))
ns)
the-ns (get @NS_CACHE ns)]
(if-not (nil? the-ns)
@@ -12227,7 +12295,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))
@@ -12235,7 +12303,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
@@ -12256,6 +12324,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 8c61c45867..709531e590 100644
--- a/src/main/clojure/cljs/analyzer.cljc
+++ b/src/main/clojure/cljs/analyzer.cljc
@@ -977,13 +977,16 @@
(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)
- (with-meta 'js
- {:prefix (conj (->> (string/split (name x) #"\.")
- (map symbol) vec)
- 'prototype)})
+ (let [props (->pre x)
+ [xs y] ((juxt butlast last) props)]
+ (with-meta 'js
+ {:prefix (vec (concat xs [(with-meta y {:ctor true})]))}))
x))
(defn ->type-set
@@ -1030,46 +1033,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 +1124,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)]
@@ -1167,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]
@@ -1274,8 +1324,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 +1335,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)]
@@ -1568,6 +1621,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))
@@ -2584,12 +2638,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"
@@ -3542,13 +3596,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)
@@ -3580,7 +3646,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
@@ -3823,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)
@@ -3882,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)
@@ -3890,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/analyzer/api.cljc b/src/main/clojure/cljs/analyzer/api.cljc
index 2d143a42b6..2fa4f2a134 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/compiler.cljc b/src/main/clojure/cljs/compiler.cljc
index b96c09b36b..fcc03ab965 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/core.cljc b/src/main/clojure/cljs/core.cljc
index 72f4654270..8393a1a671 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]
@@ -1365,7 +1383,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 +1400,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 +1811,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))))
@@ -3287,9 +3314,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/main/clojure/cljs/externs.clj b/src/main/clojure/cljs/externs.clj
index c5343e1b17..e354aac745 100644
--- a/src/main/clojure/cljs/externs.clj
+++ b/src/main/clojure/cljs/externs.clj
@@ -15,7 +15,7 @@
CompilerOptions CompilerOptions$Environment SourceFile CompilerInput CommandLineRunner]
[com.google.javascript.jscomp.parsing Config$JsDocParsing]
[com.google.javascript.rhino
- Node Token JSTypeExpression JSDocInfo$Visibility]
+ Node Token JSTypeExpression JSDocInfo JSDocInfo$Visibility]
[java.util.logging Level]
[java.net URL]))
@@ -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)
@@ -77,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)]
@@ -97,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)]
@@ -113,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/main/clojure/cljs/repl.cljc b/src/main/clojure/cljs/repl.cljc
index b5c53738a1..b685a62e5b 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])))
diff --git a/src/test/cljs/cljs/core_test.cljs b/src/test/cljs/cljs/core_test.cljs
index 9c4a625286..58720b5a16 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
diff --git a/src/test/cljs_build/trivial/core2.cljs b/src/test/cljs_build/trivial/core2.cljs
new file mode 100644
index 0000000000..a79e64e807
--- /dev/null
+++ b/src/test/cljs_build/trivial/core2.cljs
@@ -0,0 +1,3 @@
+(ns trivial.core2)
+
+(.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 0000000000..a66db571c3
--- /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 0000000000..f8f4c6d25b
--- /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/cljs_build/trivial/core5.cljs b/src/test/cljs_build/trivial/core5.cljs
new file mode 100644
index 0000000000..1e7f877568
--- /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 e788c1ace0..a1a2f38712 100644
--- a/src/test/clojure/cljs/build_api_tests.clj
+++ b/src/test/clojure/cljs/build_api_tests.clj
@@ -718,7 +718,59 @@
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"))
+ 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) 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 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"))
diff --git a/src/test/clojure/cljs/compiler_tests.clj b/src/test/clojure/cljs/compiler_tests.clj
index bb6a9bfc3b..f6f7b560b4 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,32 @@
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))))))
+
+(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/externs_infer_tests.clj b/src/test/clojure/cljs/externs_infer_tests.clj
index 8ca7ff9aaa..967164d1f2 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 ed0cfdb709..e5a399c84f 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 c9c5f63434..2bd0855c32 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,20 @@
(: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)))))
+ (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))))))