Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

CLJS-369: Capture variable shadows in analyzer; avoid

 gensyms.

AST Changes

* Anywhere a binding was introduced for a local used to be a symbol,
  now it is a map with a :name key and potentially a :shadow key.

* Bindings vectors are no longer alternating symbols, then init maps.
  Instead, the are a vector of maps of the shape described for locals
  plus an :init key.

* The :gthis key for functions has been replaced with :type, which
  is the symbol describing the type name of the enclosing deftype form.

* recur frames now expose :params as binding maps, instead of :names

Benefits:

* Shadowed variables are now visible to downstream AST transforms.

* :tag, :mutable, and other metadata are now uniform across ops

* Eliminates usages of gensym inside the analyzer, which was a source
  of state that made the analyzer impossible to use for some
  transformations of let, letfn, etc which require re-analyzing forms.

* Removes JavaScript shadowing semantics from the analyze phase.
  • Loading branch information...
commit 19afb31a52504293ba2182c584b1867917316662 1 parent 62aca8f
David Nolen authored
119 src/clj/cljs/analyzer.clj
View
@@ -31,8 +31,6 @@
(defonce namespaces (atom '{cljs.core {:name cljs.core}
cljs.user {:name cljs.user}}))
-(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
-
(defn reset-namespaces! []
(reset! namespaces
'{cljs.core {:name cljs.core}
@@ -360,31 +358,24 @@
(when export-as {:export export-as})
(when init-expr {:children [init-expr]})))))
-(defn- analyze-fn-method [env locals meth gthis]
- (letfn [(uniqify [[p & r]]
- (when p
- (cons (if (some #{p} r) (gensym (str p)) p)
- (uniqify r))))
- (prevent-ns-shadow [p]
- (if (@ns-first-segments (str p))
- (symbol (str p "$"))
- p))]
- (let [params (first meth)
- variadic (boolean (some '#{&} params))
- params (vec (uniqify (remove '#{&} params)))
- fixed-arity (count (if variadic (butlast params) params))
- body (next meth)
- locals (reduce (fn [m name]
- (assoc m name {:name (prevent-ns-shadow name)
- :tag (-> name meta :tag)}))
- locals params)
- params (vec (map prevent-ns-shadow params))
- recur-frame {:names params :flag (atom nil)}
- block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
- (analyze-block (assoc env :context :return :locals locals) body))]
- (merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
- :gthis gthis :recurs @(:flag recur-frame)}
- block))))
+(defn- analyze-fn-method [env locals meth type]
+ (let [param-names (first meth)
+ variadic (boolean (some '#{&} param-names))
+ param-names (vec (remove '#{&} param-names))
+ body (next meth)
+ [locals params] (reduce (fn [[locals params] name]
+ (let [param {:name name
+ :tag (-> name meta :tag)
+ :shadow (locals name)}]
+ [(assoc locals name param) (conj params param)]))
+ [locals []] param-names)
+ fixed-arity (count (if variadic (butlast params) params))
+ recur-frame {:params params :flag (atom nil)}
+ block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
+ (analyze-block (assoc env :context :return :locals locals) body))]
+ (merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
+ :type type :recurs @(:flag recur-frame)}
+ block)))
(defmethod parse 'fn*
[op env [_ & args :as form] name]
@@ -394,34 +385,38 @@
;;turn (fn [] ...) into (fn ([]...))
meths (if (vector? (first meths)) (list meths) meths)
locals (:locals env)
- locals (if name (assoc locals name {:name name}) locals)
+ locals (if name (assoc locals name {:name name :shadow (locals name)}) locals)
+ type (-> form meta ::type)
fields (-> form meta ::fields)
protocol-impl (-> form meta :protocol-impl)
protocol-inline (-> form meta :protocol-inline)
- gthis (and fields (gensym "this__"))
locals (reduce (fn [m fld]
(assoc m fld
- {:name (symbol (str gthis "." fld))
+ {:name fld
:field true
:mutable (-> fld meta :mutable)
- :tag (-> fld meta :tag)}))
+ :tag (-> fld meta :tag)
+ :shadow (m fld)}))
locals fields)
menv (if (> (count meths) 1) (assoc env :context :expr) env)
menv (merge menv
{:protocol-impl protocol-impl
:protocol-inline protocol-inline})
- methods (map #(analyze-fn-method menv locals % gthis) meths)
+ methods (map #(analyze-fn-method menv locals % type) meths)
max-fixed-arity (apply max (map :max-fixed-arity methods))
variadic (boolean (some :variadic methods))
- locals (if name (assoc locals name {:name name :fn-var true
- :variadic variadic
- :max-fixed-arity max-fixed-arity
- :method-params (map :params methods)}))
+ locals (if name
+ (update-in locals [name] assoc
+ :fn-var true
+ :variadic variadic
+ :max-fixed-arity max-fixed-arity
+ :method-params (map :params methods))
+ locals)
methods (if name
;; a second pass with knowledge of our function-ness/arity
;; lets us optimize self calls
- (map #(analyze-fn-method menv locals % gthis) meths)
+ (map #(analyze-fn-method menv locals % type) meths)
methods)]
;;todo - validate unique arities, at most one variadic, variadic takes max required args
{:env env :op :fn :form form :name name :methods methods :variadic variadic
@@ -438,33 +433,23 @@
(assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
(let [n->fexpr (into {} (map (juxt first second) (partition 2 bindings)))
names (keys n->fexpr)
- n->gsym (into {} (map (juxt identity #(gensym (str % "__"))) names))
- gsym->n (into {} (map (juxt n->gsym identity) names))
context (:context env)
- bes (reduce (fn [bes n]
- (let [g (n->gsym n)]
- (conj bes {:name g
- :tag (-> n meta :tag)
- :local true})))
- []
- names)
- meth-env (reduce (fn [env be]
- (let [n (gsym->n (be :name))]
- (assoc-in env [:locals n] be)))
- (assoc env :context :expr)
- bes)
- [meth-env finits]
- (reduce (fn [[env finits] n]
- (let [finit (analyze meth-env (n->fexpr n))
- be (-> (get-in env [:locals n])
- (assoc :init finit))]
+ [meth-env bes]
+ (reduce (fn [[{:keys [locals] :as env} bes] n]
+ (let [be {:name n
+ :tag (-> n meta :tag)
+ :local true
+ :shadow (locals n)}]
[(assoc-in env [:locals n] be)
- (conj finits finit)]))
- [meth-env []]
- names)
+ (conj bes be)]))
+ [env []] names)
+ meth-env (assoc meth-env :context :expr)
+ bes (vec (map (fn [{:keys [name shadow] :as be}]
+ (let [env (assoc-in meth-env [:locals name] shadow)]
+ (assoc be :init (analyze env (n->fexpr name)))))
+ bes))
{:keys [statements ret]}
- (analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)
- bes (vec (map #(get-in meth-env [:locals %]) names))]
+ (analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)]
{:env env :op :letfn :bindings bes :statements statements :ret ret :form form
:children (into (vec (map :init bes))
(conj (vec statements) ret))}))
@@ -487,12 +472,13 @@
(do
(assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name))
(let [init-expr (analyze env init)
- be {:name (gensym (str name "__"))
+ be {:name name
:init init-expr
:tag (or (-> name meta :tag)
(-> init-expr :tag)
(-> init-expr :info :tag))
- :local true}
+ :local true
+ :shadow (-> env :locals name)}
be (if (= (:op init-expr) :fn)
(merge be
{:fn-var true
@@ -504,12 +490,12 @@
(assoc-in env [:locals name] be)
(next bindings))))
[bes env])))
- recur-frame (when is-loop {:names (vec (map :name bes)) :flag (atom nil)})
+ recur-frame (when is-loop {:params bes :flag (atom nil)})
{:keys [statements ret]}
(binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)
*loop-lets* (cond
is-loop (or *loop-lets* ())
- *loop-lets* (cons {:names (vec (map :name bes))} *loop-lets*))]
+ *loop-lets* (cons {:params bes} *loop-lets*))]
(analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
{:env encl-env :op :let :loop is-loop
:bindings bes :statements statements :ret ret :form form
@@ -530,7 +516,7 @@
frame (first *recur-frames*)
exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs)))]
(assert frame "Can't recur here")
- (assert (= (count exprs) (count (:names frame))) "recur argument count mismatch")
+ (assert (= (count exprs) (count (:params frame))) "recur argument count mismatch")
(reset! (:flag frame) true)
(assoc {:env env :op :recur :form form}
:frame frame
@@ -682,7 +668,6 @@
(load-core)
(doseq [nsym (concat (vals requires-macros) (vals uses-macros))]
(clojure.core/require nsym))
- (swap! ns-first-segments conj (first (string/split (str name) #"\.")))
(swap! namespaces #(-> %
(assoc-in [name :name] name)
(assoc-in [name :excludes] excludes)
64 src/clj/cljs/compiler.clj
View
@@ -36,16 +36,33 @@
(def ^:dynamic *emitted-provides* nil)
(def cljs-reserved-file-names #{"deps.cljs"})
+(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
+
(defn munge
([s] (munge s js-reserved))
([s reserved]
- (let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
- ss (apply str (map #(if (reserved %) (str % "$") %)
- (string/split ss #"(?<=\.)|(?=\.)")))
- ms (clojure.lang.Compiler/munge ss)]
- (if (symbol? s)
- (symbol ms)
- ms))))
+ (if (map? s)
+ ; Unshadowing
+ (let [{:keys [name field] :as info} s
+ depth (loop [d 0, {:keys [shadow]} info]
+ (cond
+ shadow (recur (inc d) shadow)
+ (@ns-first-segments (str name)) (inc d)
+ :else d))
+ name (if field
+ (str "self__." name)
+ name)]
+ (if (zero? depth)
+ (munge name reserved)
+ (symbol (str (munge name reserved) "__$" depth))))
+ ; String munging
+ (let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
+ ss (apply str (map #(if (reserved %) (str % "$") %)
+ (string/split ss #"(?<=\.)|(?=\.)")))
+ ms (clojure.lang.Compiler/munge ss)]
+ (if (symbol? s)
+ (symbol ms)
+ ms)))))
(defn- comma-sep [xs]
(interpose "," xs))
@@ -197,7 +214,7 @@
(let [n (:name info)
n (if (= (namespace n) "js")
(name n)
- n)]
+ info)]
(emit-wrap env (emits (munge n)))))
(defmethod emit :meta
@@ -359,11 +376,11 @@
(emits "})")))
(defn emit-fn-method
- [{:keys [gthis name variadic params statements ret env recurs max-fixed-arity]}]
+ [{:keys [type name variadic params statements ret env recurs max-fixed-arity]}]
(emit-wrap env
(emitln "(function " (munge name) "(" (comma-sep (map munge params)) "){")
- (when gthis
- (emitln "var " gthis " = this;"))
+ (when type
+ (emitln "var self__ = this;"))
(when recurs (emitln "while(true){"))
(emit-block :return statements ret)
(when recurs
@@ -372,7 +389,7 @@
(emits "})")))
(defn emit-variadic-fn-method
- [{:keys [gthis name variadic params statements ret env recurs max-fixed-arity] :as f}]
+ [{:keys [type name variadic params statements ret env recurs max-fixed-arity] :as f}]
(emit-wrap env
(let [name (or name (gensym))
mname (munge name)
@@ -391,8 +408,8 @@
(if variadic
(concat (butlast params) ['var_args])
params)) "){")
- (when gthis
- (emitln "var " gthis " = this;"))
+ (when type
+ (emitln "var self__ = this;"))
(when variadic
(emitln "var " (last params) " = null;")
(emitln "if (goog.isDef(var_args)) {")
@@ -413,14 +430,14 @@
[{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
;;fn statements get erased, serve no purpose and can pollute scope if named
(when-not (= :statement (:context env))
- (let [loop-locals (->> (concat (mapcat :names (filter #(and % @(:flag %)) recur-frames))
- (mapcat :names loop-lets))
+ (let [loop-locals (->> (concat (mapcat :params (filter #(and % @(:flag %)) recur-frames))
+ (mapcat :params loop-lets))
(map munge)
seq)]
(when loop-locals
(when (= :return (:context env))
(emits "return "))
- (emitln "((function (" (comma-sep loop-locals) "){")
+ (emitln "((function (" (comma-sep (map munge loop-locals)) "){")
(when-not (= :return (:context env))
(emits "return ")))
(if (= 1 (count methods))
@@ -523,8 +540,8 @@
[{:keys [bindings statements ret env loop]}]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
- (doseq [{:keys [name init]} bindings]
- (emitln "var " (munge name) " = " init ";"))
+ (doseq [{:keys [init] :as binding} bindings]
+ (emitln "var " (munge binding) " = " init ";"))
(when loop (emitln "while(true){"))
(emit-block (if (= :expr context) :return context) statements ret)
(when loop
@@ -536,12 +553,12 @@
(defmethod emit :recur
[{:keys [frame exprs env]}]
(let [temps (vec (take (count exprs) (repeatedly gensym)))
- names (:names frame)]
+ params (:params frame)]
(emitln "{")
(dotimes [i (count exprs)]
(emitln "var " (temps i) " = " (exprs i) ";"))
(dotimes [i (count exprs)]
- (emitln (munge (names i)) " = " (temps i) ";"))
+ (emitln (munge (params i)) " = " (temps i) ";"))
(emitln "continue;")
(emitln "}")))
@@ -549,8 +566,8 @@
[{:keys [bindings statements ret env]}]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
- (doseq [{:keys [name init]} bindings]
- (emitln "var " (munge name) " = " init ";"))
+ (doseq [{:keys [init] :as binding} bindings]
+ (emitln "var " (munge binding) " = " init ";"))
(emit-block (if (= :expr context) :return context) statements ret)
(when (= :expr context) (emits "})()"))))
@@ -648,6 +665,7 @@
(defmethod emit :ns
[{:keys [name requires uses requires-macros env]}]
+ (swap! ns-first-segments conj (first (string/split (str name) #"\.")))
(emitln "goog.provide('" (munge name) "');")
(when-not (= name 'cljs.core)
(emitln "goog.require('cljs.core');"))
11 src/clj/cljs/core.clj
View
@@ -545,8 +545,8 @@
(range fast-path-protocol-partitions-count))]))))
(defn dt->et
- ([specs fields] (dt->et specs fields false))
- ([specs fields inline]
+ ([t specs fields] (dt->et t specs fields false))
+ ([t specs fields inline]
(loop [ret [] s specs]
(if (seq s)
(recur (-> ret
@@ -554,7 +554,8 @@
(into
(reduce (fn [v [f sigs]]
(conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
- assoc :cljs.analyzer/fields fields
+ assoc :cljs.analyzer/type t
+ :cljs.analyzer/fields fields
:protocol-impl true
:protocol-inline inline)))
[]
@@ -581,7 +582,7 @@
(set! (.-cljs$lang$type ~t) true)
(set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
(set! (.-cljs$lang$ctorPrWriter ~t) (fn [this# writer#] (-write writer# ~(core/str r))))
- (extend-type ~t ~@(dt->et impls fields true))
+ (extend-type ~t ~@(dt->et t impls fields true))
~t)
`(do
(deftype* ~t ~fields ~pmasks)
@@ -663,7 +664,7 @@
:skip-protocol-flag fpps)]
`(do
(~'defrecord* ~tagname ~hinted-fields ~pmasks)
- (extend-type ~tagname ~@(dt->et impls fields true))))))
+ (extend-type ~tagname ~@(dt->et tagname impls fields true))))))
(defn- build-positional-factory
[rsym rname fields]
Please sign in to comment.
Something went wrong with that request. Please try again.