Merge branch 'master' of github.com:clojure/clojurescript

Author: swannodette

src/main/cljs/cljs/spec/alpha.cljc

@@ -551,7 +551,7 @@ value of 'cljs.spec.alpha/*runtime-asserts*', or false if not set. You can
 toggle check-asserts? with (check-asserts bool)."
   [spec x]
   `(if *compile-asserts*
-     (if *runtime-asserts*
+     (if @#'*runtime-asserts*
        (assert* ~spec ~x)
        ~x)
     ~x))

src/main/cljs/cljs/spec/test/alpha.cljc

@@ -38,7 +38,7 @@
     (when (and (nil? (:const v))
                #?(:cljs (nil? (:macro v))))
       (swap! instrumented-vars conj (:name v))
-      `(let [checked# (instrument-1* '~s (var ~s) ~opts)]
+      `(let [checked# (#'instrument-1* '~s (var ~s) ~opts)]
          (when checked# (set! ~s checked#))
          '~(:name v)))))
 
@@ -47,7 +47,7 @@
   (when-let [v (ana-api/resolve &env s)]
     (when (@instrumented-vars (:name v))
       (swap! instrumented-vars disj (:name v))
-      `(let [raw# (unstrument-1* ~s (var ~s))]
+      `(let [raw# (#'unstrument-1* '~s (var ~s))]
          (when raw# (set! ~s raw#))
          '~(:name v)))))
 
@@ -165,8 +165,8 @@ Returns a collection of syms naming the vars unstrumented."
             :sym     s# :spec spec#}
 
            (:args spec#)
-           (let [tcret# (quick-check f# spec# opts#)]
-             (make-check-result s# spec# tcret#))
+           (let [tcret# (#'quick-check f# spec# opts#)]
+             (#'make-check-result s# spec# tcret#))
 
            :default
            {:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
@@ -189,7 +189,7 @@ Returns a collection of syms naming the vars unstrumented."
     (checkable-syms* nil))
   ([opts]
    (reduce into #{}
-     [(filter fn-spec-name? (keys @s/registry-ref))
+     [(filter fn-spec-name? (keys @@#'s/registry-ref))
       (keys (:spec opts))])))
 
 (defmacro checkable-syms
@@ -201,7 +201,7 @@ can be checked."
    `(let [opts# ~opts]
       (validate-check-opts opts#)
       (reduce conj #{}
-        '[~@(filter fn-spec-name? (keys @s/registry-ref))
+        '[~@(filter fn-spec-name? (keys @@#'s/registry-ref))
           ~@(keys (:spec opts))]))))
 
 (defmacro check

src/main/cljs/clojure/core/reducers.cljs

@@ -40,7 +40,7 @@
        (-kv-reduce coll f init)
        (cond
          (nil? coll) init
-         (array? coll) (array-reduce coll f init)
+         (array? coll) (#'array-reduce coll f init)
          :else (-reduce coll f init)))))
 
 (defprotocol CollFold

src/main/clojure/cljs/analyzer.cljc

@@ -62,6 +62,7 @@
 (def ^:dynamic *macro-infer* true)
 (def ^:dynamic *passes* nil)
 (def ^:dynamic *file-defs* nil)
+(def ^:dynamic *private-var-access-nowarn* false)
 
 (def constants-ns-sym
   "The namespace of the constants table as a symbol."
@@ -123,6 +124,7 @@
   {:preamble-missing true
    :unprovided true
    :undeclared-var true
+   :private-var-access true
    :undeclared-ns true
    :undeclared-ns-form true
    :redef true
@@ -305,6 +307,10 @@
          "Use of undeclared Var ")
     (:prefix info) "/" (:suffix info)))
 
+(defmethod error-message :private-var-access
+  [warning-type info]
+  (str "var: " (:sym info) " is not public"))
+
 (defmethod error-message :undeclared-ns
   [warning-type {:keys [ns-sym js-provide] :as info}]
   (str "No such namespace: " ns-sym
@@ -969,20 +975,20 @@
     (node-module-dep? ns) :node
     (dep-has-global-exports? ns) :global))
 
-(defmulti resolve* (fn [sym full-ns current-ns] (ns->module-type full-ns)))
+(defmulti resolve* (fn [env sym full-ns current-ns] (ns->module-type full-ns)))
 
 (defmethod resolve* :js
-  [sym full-ns current-ns]
+  [env sym full-ns current-ns]
   {:name (symbol (str full-ns) (str (name sym)))
    :ns full-ns})
 
 (defmethod resolve* :node
-  [sym full-ns current-ns]
+  [env sym full-ns current-ns]
   {:name (symbol (str current-ns) (str (munge-node-lib full-ns) "." (name sym)))
    :ns current-ns})
 
 (defmethod resolve* :global
-  [sym full-ns current-ns]
+  [env sym full-ns current-ns]
   (let [pre (into '[Object] (->> (string/split (name sym) #"\.") (map symbol) vec))]
     (when-not (has-extern? pre)
       (swap! env/*compiler* update-in
@@ -991,11 +997,26 @@
      :ns current-ns
      :tag (with-meta 'js {:prefix pre})}))
 
+(def ^:private private-var-access-exceptions
+  "Specially-treated symbols for which we don't trigger :private-var-access warnings."
+  '#{cljs.core/checked-aget
+     cljs.core/checked-aset
+     cljs.core/checked-aget'
+     cljs.core/checked-aset'})
+
 (defmethod resolve* :default
-  [sym full-ns current-ns]
-  (merge (gets @env/*compiler* ::namespaces full-ns :defs (symbol (name sym)))
-    {:name (symbol (str full-ns) (str (name sym)))
-     :ns full-ns}))
+  [env sym full-ns current-ns]
+  (let [sym-ast (gets @env/*compiler* ::namespaces full-ns :defs (symbol (name sym)))
+        sym-name (symbol (str full-ns) (str (name sym)))]
+    (when (and (not= current-ns full-ns)
+               (:private sym-ast)
+               (not *private-var-access-nowarn*)
+               (not (contains? private-var-access-exceptions sym-name)))
+      (warning :private-var-access env
+        {:sym sym-name}))
+    (merge sym-ast
+      {:name sym-name
+       :ns   full-ns})))
 
 (defn required? [ns env]
   (or (contains? (set (vals (gets env :ns :requires))) ns)
@@ -1070,7 +1091,7 @@
                (when (not= current-ns full-ns)
                  (confirm-ns env full-ns))
                (confirm env full-ns (symbol (name sym))))
-             (resolve* sym full-ns current-ns))
+             (resolve* env sym full-ns current-ns))
 
            (dotted-symbol? sym)
            (let [idx    (.indexOf s ".")
@@ -1090,13 +1111,13 @@
 
            (some? (gets @env/*compiler* ::namespaces current-ns :uses sym))
            (let [full-ns (gets @env/*compiler* ::namespaces current-ns :uses sym)]
-             (resolve* sym full-ns current-ns))
+             (resolve* env sym full-ns current-ns))
 
            (some? (gets @env/*compiler* ::namespaces current-ns :renames sym))
            (let [qualified-symbol (gets @env/*compiler* ::namespaces current-ns :renames sym)
                  full-ns (symbol (namespace qualified-symbol))
                  sym     (symbol (name qualified-symbol))]
-             (resolve* sym full-ns current-ns))
+             (resolve* env sym full-ns current-ns))
 
            (some? (gets @env/*compiler* ::namespaces current-ns :imports sym))
            (recur env (gets @env/*compiler* ::namespaces current-ns :imports sym) confirm)
@@ -1359,13 +1380,14 @@
   [env sym]
   ;; we need to dissoc locals for the `(let [x 1] (def x x))` case, because we
   ;; want the var's AST and `resolve-var` will check locals first. - António Monteiro
-  (let [env (dissoc env :locals)
-        var (resolve-var env sym (confirm-var-exists-throw))
-        expr-env (assoc env :context :expr)]
-    (when-some [var-ns (:ns var)]
-      {:var (analyze expr-env sym)
-       :sym (analyze expr-env `(quote ~(symbol (name var-ns) (name (:name var)))))
-       :meta (var-meta var expr-env)})))
+  (binding [*private-var-access-nowarn* true]
+    (let [env      (dissoc env :locals)
+          var      (resolve-var env sym (confirm-var-exists-throw))
+          expr-env (assoc env :context :expr)]
+      (when-some [var-ns (:ns var)]
+        {:var  (analyze expr-env sym)
+         :sym  (analyze expr-env `(quote ~(symbol (name var-ns) (name (:name var)))))
+         :meta (var-meta var expr-env)}))))
 
 (defmethod parse 'var
   [op env [_ sym :as form] _ _]
@@ -1619,7 +1641,7 @@
                           (analyze (assoc env :context :expr) (:init args) sym))))
           fn-var? (and (some? init-expr) (= (:op init-expr) :fn))
           tag (if fn-var?
-                (or (:ret-tag init-expr) tag)
+                (or (:ret-tag init-expr) tag (:inferred-ret-tag init-expr))
                 (or tag (:tag init-expr)))
           export-as (when-let [export-val (-> sym meta :export)]
                       (if (= true export-val) var-name export-val))
@@ -1860,13 +1882,17 @@
         children     (if (some? name-var)
                        [:local :methods]
                        [:methods])
+        inferred-ret-tag (let [inferred-tags (map (partial infer-tag env) (map :body methods))]
+                           (when (apply = inferred-tags)
+                             (first inferred-tags)))
         ast   (merge {:op :fn
                       :env env
                       :form form
                       :name name-var
                       :methods methods
                       :variadic? variadic
                       :tag 'function
+                      :inferred-ret-tag inferred-ret-tag
                       :recur-frames *recur-frames*
                       :loop-lets *loop-lets*
                       :jsdoc [js-doc]
@@ -2135,49 +2161,50 @@
                        [`(. ~target ~val) alt]
                        [target val])]
     (disallowing-recur
-      (let [enve  (assoc env :context :expr)
-            texpr (cond
-                    (symbol? target)
-                    (do
-                      (cond
-                        (and (= target '*unchecked-if*) ;; TODO: proper resolve
-                             (or (true? val) (false? val)))
-                        (set! *unchecked-if* val)
-
-                        (and (= target '*unchecked-arrays*) ;; TODO: proper resolve
-                             (or (true? val) (false? val)))
-                        (set! *unchecked-arrays* val)
-
-                        (and (= target '*warn-on-infer*)
-                             (or (true? val) (false? val)))
-                        (set! *cljs-warnings* (assoc *cljs-warnings* :infer-warning val)))
-                      (when (some? (:const (resolve-var (dissoc env :locals) target)))
-                        (throw (error env "Can't set! a constant")))
-                      (let [local (-> env :locals target)]
-                        (when-not (or (nil? local)
-                                      (and (:field local)
-                                           (or (:mutable local)
-                                               (:unsynchronized-mutable local)
-                                               (:volatile-mutable local))))
-                          (throw (error env "Can't set! local var or non-mutable field"))))
-                      (analyze-symbol enve target))
-
-                    :else
-                    (when (seq? target)
-                      (let [texpr (analyze-seq enve target nil)]
-                        (when (:field texpr)
-                          texpr))))
-            vexpr (analyze enve val)]
-        (when-not texpr
-          (throw (error env "set! target must be a field or a symbol naming a var")))
-        (cond
-          (and (not (:def-emits-var env)) ;; non-REPL context
-               (some? ('#{*unchecked-if* *unchecked-array* *warn-on-infer*} target)))
-          {:env env :op :no-op}
-
-          :else
-          {:env env :op :set! :form form :target texpr :val vexpr
-           :children [:target :val]})))))
+      (binding [*private-var-access-nowarn* true]
+        (let [enve  (assoc env :context :expr)
+              texpr (cond
+                      (symbol? target)
+                      (do
+                        (cond
+                          (and (= target '*unchecked-if*)   ;; TODO: proper resolve
+                               (or (true? val) (false? val)))
+                          (set! *unchecked-if* val)
+
+                          (and (= target '*unchecked-arrays*) ;; TODO: proper resolve
+                               (or (true? val) (false? val)))
+                          (set! *unchecked-arrays* val)
+
+                          (and (= target '*warn-on-infer*)
+                               (or (true? val) (false? val)))
+                          (set! *cljs-warnings* (assoc *cljs-warnings* :infer-warning val)))
+                        (when (some? (:const (resolve-var (dissoc env :locals) target)))
+                          (throw (error env "Can't set! a constant")))
+                        (let [local (-> env :locals target)]
+                          (when-not (or (nil? local)
+                                        (and (:field local)
+                                             (or (:mutable local)
+                                                 (:unsynchronized-mutable local)
+                                                 (:volatile-mutable local))))
+                            (throw (error env "Can't set! local var or non-mutable field"))))
+                        (analyze-symbol enve target))
+
+                      :else
+                      (when (seq? target)
+                        (let [texpr (analyze-seq enve target nil)]
+                          (when (:field texpr)
+                            texpr))))
+              vexpr (analyze enve val)]
+          (when-not texpr
+            (throw (error env "set! target must be a field or a symbol naming a var")))
+          (cond
+            (and (not (:def-emits-var env))                 ;; non-REPL context
+                 (some? ('#{*unchecked-if* *unchecked-array* *warn-on-infer*} target)))
+            {:env env :op :no-op}
+
+            :else
+            {:env env :op :set! :form form :target texpr :val vexpr
+             :children [:target :val]}))))))
 
 #?(:clj (declare analyze-file))
 
@@ -3770,7 +3797,9 @@
   (if (and (not (namespace sym))
            (dotted-symbol? sym))
     sym
-    (:name (resolve-var (assoc @env/*compiler* :ns (get-namespace *cljs-ns*)) sym))))
+    (:name (binding [*private-var-access-nowarn* true]
+             (resolve-var (assoc @env/*compiler* :ns (get-namespace *cljs-ns*))
+               sym)))))
 
 #?(:clj
    (defn forms-seq*

src/main/clojure/cljs/analyzer/api.cljc

@@ -148,8 +148,9 @@
   [env sym]
   {:pre [(map? env) (symbol? sym)]}
   (try
-    (ana/resolve-var env sym
-      (ana/confirm-var-exists-throw))
+    (binding [ana/*private-var-access-nowarn* true]
+      (ana/resolve-var env sym
+        (ana/confirm-var-exists-throw)))
     (catch #?(:clj Exception :cljs :default) e
       (ana/resolve-macro-var env sym))))
 

src/main/clojure/cljs/compiler.cljc

@@ -136,7 +136,7 @@
            ss (map rf (string/split ss #"\."))
            ss (string/join "." ss)
            ms #?(:clj (clojure.lang.Compiler/munge ss)
-                 :cljs (cljs.core/munge-str ss))]
+                 :cljs (#'cljs.core/munge-str ss))]
        (if (symbol? s)
          (symbol ms)
          ms)))))

src/main/clojure/cljs/core.cljc

@@ -1864,7 +1864,7 @@
 
                         'IPrintWithWriter
                         `(~'-pr-writer [this# writer# opts#]
-                           (let [pr-pair# (fn [keyval#] (pr-sequential-writer writer# pr-writer "" " " "" opts# keyval#))]
+                           (let [pr-pair# (fn [keyval#] (pr-sequential-writer writer# @#'pr-writer "" " " "" opts# keyval#))]
                              (pr-sequential-writer
                                writer# pr-pair# ~pr-open ", " "}" opts#
                                (concat [~@(map #(core/list `vector (keyword %) %) base-fields)]
@@ -2689,7 +2689,7 @@
                prefer-table# (atom {})
                method-cache# (atom {})
                cached-hierarchy# (atom {})
-               hierarchy# (cljs.core/get ~options :hierarchy (cljs.core/get-global-hierarchy))]
+               hierarchy# (cljs.core/get ~options :hierarchy (#'cljs.core/get-global-hierarchy))]
            (cljs.core/MultiFn. (cljs.core/symbol ~mm-ns ~(name mm-name)) ~dispatch-fn ~default hierarchy#
              method-table# prefer-table# method-cache# cached-hierarchy#))))))
 

src/main/clojure/cljs/tagged_literals.cljc

@@ -56,7 +56,7 @@
      (when-not (string? form)
        (throw (js/Error. "Instance literal expects a string for its timestamp.")))
      (try
-       (reader/read-date form)
+       (#'reader/read-date form)
        (catch :default e
          (throw (js/Error. (. e -message)))))))
 

src/test/cljs/cljs/pprint_test.cljs

@@ -761,7 +761,7 @@ Usage: *hello*
       (doseq [row aseq]
         (doseq [col row]
           (cl-format *out* "~4D~7,vT" col column-width))
-        (prn)))
+        (#'prn)))
     (str sb)
     ;;TODO do we need to extend StringBufferWriter to allow access to underlying StringBuffer?
     #_(str (:base @@(:base @@stream)))))