Skip to content

Commit 19afb31

Browse files
David NolenDavid Nolen
David Nolen
authored and
David Nolen
committed
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.
1 parent 62aca8f commit 19afb31

File tree

3 files changed

+99
-95
lines changed

3 files changed

+99
-95
lines changed

‎src/clj/cljs/analyzer.clj

Lines changed: 52 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,6 @@
3131
(defonce namespaces (atom '{cljs.core {:name cljs.core}
3232
cljs.user {:name cljs.user}}))
3333

34-
(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
35-
3634
(defn reset-namespaces! []
3735
(reset! namespaces
3836
'{cljs.core {:name cljs.core}
@@ -360,31 +358,24 @@
360358
(when export-as {:export export-as})
361359
(when init-expr {:children [init-expr]})))))
362360

363-
(defn- analyze-fn-method [env locals meth gthis]
364-
(letfn [(uniqify [[p & r]]
365-
(when p
366-
(cons (if (some #{p} r) (gensym (str p)) p)
367-
(uniqify r))))
368-
(prevent-ns-shadow [p]
369-
(if (@ns-first-segments (str p))
370-
(symbol (str p "$"))
371-
p))]
372-
(let [params (first meth)
373-
variadic (boolean (some '#{&} params))
374-
params (vec (uniqify (remove '#{&} params)))
375-
fixed-arity (count (if variadic (butlast params) params))
376-
body (next meth)
377-
locals (reduce (fn [m name]
378-
(assoc m name {:name (prevent-ns-shadow name)
379-
:tag (-> name meta :tag)}))
380-
locals params)
381-
params (vec (map prevent-ns-shadow params))
382-
recur-frame {:names params :flag (atom nil)}
383-
block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
384-
(analyze-block (assoc env :context :return :locals locals) body))]
385-
(merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
386-
:gthis gthis :recurs @(:flag recur-frame)}
387-
block))))
361+
(defn- analyze-fn-method [env locals meth type]
362+
(let [param-names (first meth)
363+
variadic (boolean (some '#{&} param-names))
364+
param-names (vec (remove '#{&} param-names))
365+
body (next meth)
366+
[locals params] (reduce (fn [[locals params] name]
367+
(let [param {:name name
368+
:tag (-> name meta :tag)
369+
:shadow (locals name)}]
370+
[(assoc locals name param) (conj params param)]))
371+
[locals []] param-names)
372+
fixed-arity (count (if variadic (butlast params) params))
373+
recur-frame {:params params :flag (atom nil)}
374+
block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
375+
(analyze-block (assoc env :context :return :locals locals) body))]
376+
(merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
377+
:type type :recurs @(:flag recur-frame)}
378+
block)))
388379

389380
(defmethod parse 'fn*
390381
[op env [_ & args :as form] name]
@@ -394,34 +385,38 @@
394385
;;turn (fn [] ...) into (fn ([]...))
395386
meths (if (vector? (first meths)) (list meths) meths)
396387
locals (:locals env)
397-
locals (if name (assoc locals name {:name name}) locals)
388+
locals (if name (assoc locals name {:name name :shadow (locals name)}) locals)
389+
type (-> form meta ::type)
398390
fields (-> form meta ::fields)
399391
protocol-impl (-> form meta :protocol-impl)
400392
protocol-inline (-> form meta :protocol-inline)
401-
gthis (and fields (gensym "this__"))
402393
locals (reduce (fn [m fld]
403394
(assoc m fld
404-
{:name (symbol (str gthis "." fld))
395+
{:name fld
405396
:field true
406397
:mutable (-> fld meta :mutable)
407-
:tag (-> fld meta :tag)}))
398+
:tag (-> fld meta :tag)
399+
:shadow (m fld)}))
408400
locals fields)
409401

410402
menv (if (> (count meths) 1) (assoc env :context :expr) env)
411403
menv (merge menv
412404
{:protocol-impl protocol-impl
413405
:protocol-inline protocol-inline})
414-
methods (map #(analyze-fn-method menv locals % gthis) meths)
406+
methods (map #(analyze-fn-method menv locals % type) meths)
415407
max-fixed-arity (apply max (map :max-fixed-arity methods))
416408
variadic (boolean (some :variadic methods))
417-
locals (if name (assoc locals name {:name name :fn-var true
418-
:variadic variadic
419-
:max-fixed-arity max-fixed-arity
420-
:method-params (map :params methods)}))
409+
locals (if name
410+
(update-in locals [name] assoc
411+
:fn-var true
412+
:variadic variadic
413+
:max-fixed-arity max-fixed-arity
414+
:method-params (map :params methods))
415+
locals)
421416
methods (if name
422417
;; a second pass with knowledge of our function-ness/arity
423418
;; lets us optimize self calls
424-
(map #(analyze-fn-method menv locals % gthis) meths)
419+
(map #(analyze-fn-method menv locals % type) meths)
425420
methods)]
426421
;;todo - validate unique arities, at most one variadic, variadic takes max required args
427422
{:env env :op :fn :form form :name name :methods methods :variadic variadic
@@ -438,33 +433,23 @@
438433
(assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
439434
(let [n->fexpr (into {} (map (juxt first second) (partition 2 bindings)))
440435
names (keys n->fexpr)
441-
n->gsym (into {} (map (juxt identity #(gensym (str % "__"))) names))
442-
gsym->n (into {} (map (juxt n->gsym identity) names))
443436
context (:context env)
444-
bes (reduce (fn [bes n]
445-
(let [g (n->gsym n)]
446-
(conj bes {:name g
447-
:tag (-> n meta :tag)
448-
:local true})))
449-
[]
450-
names)
451-
meth-env (reduce (fn [env be]
452-
(let [n (gsym->n (be :name))]
453-
(assoc-in env [:locals n] be)))
454-
(assoc env :context :expr)
455-
bes)
456-
[meth-env finits]
457-
(reduce (fn [[env finits] n]
458-
(let [finit (analyze meth-env (n->fexpr n))
459-
be (-> (get-in env [:locals n])
460-
(assoc :init finit))]
437+
[meth-env bes]
438+
(reduce (fn [[{:keys [locals] :as env} bes] n]
439+
(let [be {:name n
440+
:tag (-> n meta :tag)
441+
:local true
442+
:shadow (locals n)}]
461443
[(assoc-in env [:locals n] be)
462-
(conj finits finit)]))
463-
[meth-env []]
464-
names)
444+
(conj bes be)]))
445+
[env []] names)
446+
meth-env (assoc meth-env :context :expr)
447+
bes (vec (map (fn [{:keys [name shadow] :as be}]
448+
(let [env (assoc-in meth-env [:locals name] shadow)]
449+
(assoc be :init (analyze env (n->fexpr name)))))
450+
bes))
465451
{:keys [statements ret]}
466-
(analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)
467-
bes (vec (map #(get-in meth-env [:locals %]) names))]
452+
(analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)]
468453
{:env env :op :letfn :bindings bes :statements statements :ret ret :form form
469454
:children (into (vec (map :init bes))
470455
(conj (vec statements) ret))}))
@@ -487,12 +472,13 @@
487472
(do
488473
(assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name))
489474
(let [init-expr (analyze env init)
490-
be {:name (gensym (str name "__"))
475+
be {:name name
491476
:init init-expr
492477
:tag (or (-> name meta :tag)
493478
(-> init-expr :tag)
494479
(-> init-expr :info :tag))
495-
:local true}
480+
:local true
481+
:shadow (-> env :locals name)}
496482
be (if (= (:op init-expr) :fn)
497483
(merge be
498484
{:fn-var true
@@ -504,12 +490,12 @@
504490
(assoc-in env [:locals name] be)
505491
(next bindings))))
506492
[bes env])))
507-
recur-frame (when is-loop {:names (vec (map :name bes)) :flag (atom nil)})
493+
recur-frame (when is-loop {:params bes :flag (atom nil)})
508494
{:keys [statements ret]}
509495
(binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)
510496
*loop-lets* (cond
511497
is-loop (or *loop-lets* ())
512-
*loop-lets* (cons {:names (vec (map :name bes))} *loop-lets*))]
498+
*loop-lets* (cons {:params bes} *loop-lets*))]
513499
(analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
514500
{:env encl-env :op :let :loop is-loop
515501
:bindings bes :statements statements :ret ret :form form
@@ -530,7 +516,7 @@
530516
frame (first *recur-frames*)
531517
exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs)))]
532518
(assert frame "Can't recur here")
533-
(assert (= (count exprs) (count (:names frame))) "recur argument count mismatch")
519+
(assert (= (count exprs) (count (:params frame))) "recur argument count mismatch")
534520
(reset! (:flag frame) true)
535521
(assoc {:env env :op :recur :form form}
536522
:frame frame
@@ -682,7 +668,6 @@
682668
(load-core)
683669
(doseq [nsym (concat (vals requires-macros) (vals uses-macros))]
684670
(clojure.core/require nsym))
685-
(swap! ns-first-segments conj (first (string/split (str name) #"\.")))
686671
(swap! namespaces #(-> %
687672
(assoc-in [name :name] name)
688673
(assoc-in [name :excludes] excludes)

‎src/clj/cljs/compiler.clj

Lines changed: 41 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -36,16 +36,33 @@
3636
(def ^:dynamic *emitted-provides* nil)
3737
(def cljs-reserved-file-names #{"deps.cljs"})
3838

39+
(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
40+
3941
(defn munge
4042
([s] (munge s js-reserved))
4143
([s reserved]
42-
(let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
43-
ss (apply str (map #(if (reserved %) (str % "$") %)
44-
(string/split ss #"(?<=\.)|(?=\.)")))
45-
ms (clojure.lang.Compiler/munge ss)]
46-
(if (symbol? s)
47-
(symbol ms)
48-
ms))))
44+
(if (map? s)
45+
; Unshadowing
46+
(let [{:keys [name field] :as info} s
47+
depth (loop [d 0, {:keys [shadow]} info]
48+
(cond
49+
shadow (recur (inc d) shadow)
50+
(@ns-first-segments (str name)) (inc d)
51+
:else d))
52+
name (if field
53+
(str "self__." name)
54+
name)]
55+
(if (zero? depth)
56+
(munge name reserved)
57+
(symbol (str (munge name reserved) "__$" depth))))
58+
; String munging
59+
(let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
60+
ss (apply str (map #(if (reserved %) (str % "$") %)
61+
(string/split ss #"(?<=\.)|(?=\.)")))
62+
ms (clojure.lang.Compiler/munge ss)]
63+
(if (symbol? s)
64+
(symbol ms)
65+
ms)))))
4966

5067
(defn- comma-sep [xs]
5168
(interpose "," xs))
@@ -197,7 +214,7 @@
197214
(let [n (:name info)
198215
n (if (= (namespace n) "js")
199216
(name n)
200-
n)]
217+
info)]
201218
(emit-wrap env (emits (munge n)))))
202219

203220
(defmethod emit :meta
@@ -359,11 +376,11 @@
359376
(emits "})")))
360377

361378
(defn emit-fn-method
362-
[{:keys [gthis name variadic params statements ret env recurs max-fixed-arity]}]
379+
[{:keys [type name variadic params statements ret env recurs max-fixed-arity]}]
363380
(emit-wrap env
364381
(emitln "(function " (munge name) "(" (comma-sep (map munge params)) "){")
365-
(when gthis
366-
(emitln "var " gthis " = this;"))
382+
(when type
383+
(emitln "var self__ = this;"))
367384
(when recurs (emitln "while(true){"))
368385
(emit-block :return statements ret)
369386
(when recurs
@@ -372,7 +389,7 @@
372389
(emits "})")))
373390

374391
(defn emit-variadic-fn-method
375-
[{:keys [gthis name variadic params statements ret env recurs max-fixed-arity] :as f}]
392+
[{:keys [type name variadic params statements ret env recurs max-fixed-arity] :as f}]
376393
(emit-wrap env
377394
(let [name (or name (gensym))
378395
mname (munge name)
@@ -391,8 +408,8 @@
391408
(if variadic
392409
(concat (butlast params) ['var_args])
393410
params)) "){")
394-
(when gthis
395-
(emitln "var " gthis " = this;"))
411+
(when type
412+
(emitln "var self__ = this;"))
396413
(when variadic
397414
(emitln "var " (last params) " = null;")
398415
(emitln "if (goog.isDef(var_args)) {")
@@ -413,14 +430,14 @@
413430
[{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
414431
;;fn statements get erased, serve no purpose and can pollute scope if named
415432
(when-not (= :statement (:context env))
416-
(let [loop-locals (->> (concat (mapcat :names (filter #(and % @(:flag %)) recur-frames))
417-
(mapcat :names loop-lets))
433+
(let [loop-locals (->> (concat (mapcat :params (filter #(and % @(:flag %)) recur-frames))
434+
(mapcat :params loop-lets))
418435
(map munge)
419436
seq)]
420437
(when loop-locals
421438
(when (= :return (:context env))
422439
(emits "return "))
423-
(emitln "((function (" (comma-sep loop-locals) "){")
440+
(emitln "((function (" (comma-sep (map munge loop-locals)) "){")
424441
(when-not (= :return (:context env))
425442
(emits "return ")))
426443
(if (= 1 (count methods))
@@ -523,8 +540,8 @@
523540
[{:keys [bindings statements ret env loop]}]
524541
(let [context (:context env)]
525542
(when (= :expr context) (emits "(function (){"))
526-
(doseq [{:keys [name init]} bindings]
527-
(emitln "var " (munge name) " = " init ";"))
543+
(doseq [{:keys [init] :as binding} bindings]
544+
(emitln "var " (munge binding) " = " init ";"))
528545
(when loop (emitln "while(true){"))
529546
(emit-block (if (= :expr context) :return context) statements ret)
530547
(when loop
@@ -536,21 +553,21 @@
536553
(defmethod emit :recur
537554
[{:keys [frame exprs env]}]
538555
(let [temps (vec (take (count exprs) (repeatedly gensym)))
539-
names (:names frame)]
556+
params (:params frame)]
540557
(emitln "{")
541558
(dotimes [i (count exprs)]
542559
(emitln "var " (temps i) " = " (exprs i) ";"))
543560
(dotimes [i (count exprs)]
544-
(emitln (munge (names i)) " = " (temps i) ";"))
561+
(emitln (munge (params i)) " = " (temps i) ";"))
545562
(emitln "continue;")
546563
(emitln "}")))
547564

548565
(defmethod emit :letfn
549566
[{:keys [bindings statements ret env]}]
550567
(let [context (:context env)]
551568
(when (= :expr context) (emits "(function (){"))
552-
(doseq [{:keys [name init]} bindings]
553-
(emitln "var " (munge name) " = " init ";"))
569+
(doseq [{:keys [init] :as binding} bindings]
570+
(emitln "var " (munge binding) " = " init ";"))
554571
(emit-block (if (= :expr context) :return context) statements ret)
555572
(when (= :expr context) (emits "})()"))))
556573

@@ -648,6 +665,7 @@
648665

649666
(defmethod emit :ns
650667
[{:keys [name requires uses requires-macros env]}]
668+
(swap! ns-first-segments conj (first (string/split (str name) #"\.")))
651669
(emitln "goog.provide('" (munge name) "');")
652670
(when-not (= name 'cljs.core)
653671
(emitln "goog.require('cljs.core');"))

‎src/clj/cljs/core.clj

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -545,16 +545,17 @@
545545
(range fast-path-protocol-partitions-count))]))))
546546

547547
(defn dt->et
548-
([specs fields] (dt->et specs fields false))
549-
([specs fields inline]
548+
([t specs fields] (dt->et t specs fields false))
549+
([t specs fields inline]
550550
(loop [ret [] s specs]
551551
(if (seq s)
552552
(recur (-> ret
553553
(conj (first s))
554554
(into
555555
(reduce (fn [v [f sigs]]
556556
(conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
557-
assoc :cljs.analyzer/fields fields
557+
assoc :cljs.analyzer/type t
558+
:cljs.analyzer/fields fields
558559
:protocol-impl true
559560
:protocol-inline inline)))
560561
[]
@@ -581,7 +582,7 @@
581582
(set! (.-cljs$lang$type ~t) true)
582583
(set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
583584
(set! (.-cljs$lang$ctorPrWriter ~t) (fn [this# writer#] (-write writer# ~(core/str r))))
584-
(extend-type ~t ~@(dt->et impls fields true))
585+
(extend-type ~t ~@(dt->et t impls fields true))
585586
~t)
586587
`(do
587588
(deftype* ~t ~fields ~pmasks)
@@ -663,7 +664,7 @@
663664
:skip-protocol-flag fpps)]
664665
`(do
665666
(~'defrecord* ~tagname ~hinted-fields ~pmasks)
666-
(extend-type ~tagname ~@(dt->et impls fields true))))))
667+
(extend-type ~tagname ~@(dt->et tagname impls fields true))))))
667668

668669
(defn- build-positional-factory
669670
[rsym rname fields]

0 commit comments

Comments
 (0)