Skip to content

Commit ddaa0f1

Browse files
swannodetteswannodette
committed
CLJS-937: local fn name should be lexically munged
Introduce :fn-scope vector to analysis environment. If a function is supplied with a local name extend :fn-scope in env by conj'ing the local name var. Introduce `cljs.compiler/fn-self-name` munging case. Use :fn-scope to construct the name. The returned symbol starts with munged namespace, separated from scope name by "_SLASH_". fn scope names are separated by "_$_". Simplifies fn name demunging when source mapping stack traces. Invoke optimizations rewrite the fn :name to a direct string. Disable :fn-self-name munging in these cases. Respect :static-fns false even if compiling core. Remove bogus analyzer tests for local name. Add better compiler tests for local name.
1 parent b0ec424 commit ddaa0f1

File tree

4 files changed

+100
-48
lines changed

4 files changed

+100
-48
lines changed

‎src/clj/cljs/analyzer.clj‎

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -290,6 +290,7 @@
290290
{:ns (get-namespace *cljs-ns*)
291291
:context :statement
292292
:locals {}
293+
:fn-scope []
293294
:js-globals (into {}
294295
(map #(vector % {:name %})
295296
'(alert window document console escape unescape
@@ -844,12 +845,17 @@
844845
locals (:locals env)
845846
name-var (if name
846847
(merge
847-
{:name name
848-
:info {:shadow (or (locals name)
849-
(get-in env [:js-globals name]))}}
848+
{:name name
849+
:info {:fn-self-name true
850+
:fn-scope (:fn-scope env)
851+
:ns (-> env :ns :name)
852+
:shadow (or (locals name)
853+
(get-in env [:js-globals name]))}}
850854
(when-let [tag (-> name meta :tag)]
851855
{:ret-tag tag})))
852-
env (update-in env [:fn-scope] (fnil conj []) name-var)
856+
env (if name
857+
(update-in env [:fn-scope] conj name-var)
858+
env)
853859
locals (if (and locals name) (assoc locals name name-var) locals)
854860
type (-> form meta ::type)
855861
protocol-impl (-> form meta ::protocol-impl)

‎src/clj/cljs/compiler.clj‎

Lines changed: 53 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -55,29 +55,45 @@
5555
(some #{(str name)} (ns-first-segments)) (inc d)
5656
:else d))))
5757

58+
(declare munge)
59+
60+
(defn fn-self-name [{:keys [name info] :as name-var}]
61+
(let [{:keys [ns fn-scope]} info
62+
scoped-name (apply str
63+
(interpose "_$_"
64+
(concat (map (comp str :name) fn-scope) [name])))]
65+
(symbol
66+
(munge
67+
(str (string/replace (str ns) "." "$")
68+
"_SLASH_" scoped-name)))))
69+
5870
(defn munge
5971
([s] (munge s js-reserved))
6072
([s reserved]
61-
(if (map? s)
62-
; Unshadowing
63-
(let [{:keys [name field] :as info} s
64-
depth (shadow-depth s)
65-
renamed (*lexical-renames* (System/identityHashCode s))
66-
munged-name (munge (cond field (str "self__." name)
67-
renamed renamed
68-
:else name)
69-
reserved)]
70-
(if (or field (zero? depth))
71-
munged-name
72-
(symbol (str munged-name "__$" depth))))
73-
; String munging
74-
(let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
75-
ss (apply str (map #(if (reserved %) (str % "$") %)
76-
(string/split ss #"(?<=\.)|(?=\.)")))
77-
ms (clojure.lang.Compiler/munge ss)]
78-
(if (symbol? s)
79-
(symbol ms)
80-
ms)))))
73+
(if (map? s)
74+
(let [{:keys [name field info] :as name-var} s]
75+
(if (:fn-self-name info)
76+
(fn-self-name s)
77+
;; Unshadowing
78+
(let [depth (shadow-depth s)
79+
renamed (*lexical-renames* (System/identityHashCode s))
80+
munged-name (munge
81+
(cond field (str "self__." name)
82+
renamed renamed
83+
:else name)
84+
reserved)]
85+
(if (or field (zero? depth))
86+
munged-name
87+
(symbol (str munged-name "__$" depth))))))
88+
;; String munging
89+
(let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
90+
ss (apply str
91+
(map #(if (reserved %) (str % "$") %)
92+
(string/split ss #"(?<=\.)|(?=\.)")))
93+
ms (clojure.lang.Compiler/munge ss)]
94+
(if (symbol? s)
95+
(symbol ms)
96+
ms)))))
8197

8298
(defn- comma-sep [xs]
8399
(interpose "," xs))
@@ -772,16 +788,24 @@
772788

773789
;; direct dispatch to variadic case
774790
(and variadic? (> arity mfa))
775-
[(update-in f [:info :name]
776-
(fn [name] (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$variadic"))))
791+
[(update-in f [:info]
792+
(fn [info]
793+
(-> info
794+
(assoc :name (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$variadic")))
795+
;; bypass local fn-self-name munging, we're emitting direct
796+
(update-in [:info] dissoc :fn-self-name))))
777797
{:max-fixed-arity mfa}]
778798

779799
;; direct dispatch to specific arity case
780800
:else
781801
(let [arities (map count mps)]
782802
(if (some #{arity} arities)
783-
[(update-in f [:info :name]
784-
(fn [name] (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$" arity)))) nil]
803+
[(update-in f [:info]
804+
(fn [info]
805+
(-> info
806+
(assoc :name (symbol (str (munge info) ".cljs$core$IFn$_invoke$arity$" arity)))
807+
;; bypass local fn-self-name munging, we're emitting direct
808+
(update-in [:info] dissoc :fn-self-name)))) nil]
785809
[f nil]))))
786810
[f nil])]
787811
(emit-wrap env
@@ -808,6 +832,7 @@
808832

809833
:else
810834
(if (and ana/*cljs-static-fns* (= (:op f) :var))
835+
;; higher order case, static information missing
811836
(let [fprop (str ".cljs$core$IFn$_invoke$arity$" (count args))]
812837
(emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : " f ".call(" (comma-sep (cons "null" args)) "))"))
813838
(emits f ".call(" (comma-sep (cons "null" args)) ")"))))))
@@ -1072,7 +1097,10 @@
10721097
(if (.exists src-file)
10731098
(try
10741099
(let [{ns :ns :as ns-info} (ana/parse-ns src-file dest-file opts)
1075-
opts (if (= ns 'cljs.core) (assoc opts :static-fns true) opts)]
1100+
opts (if (and (= ns 'cljs.core)
1101+
(not (false? (:static-fns opts))))
1102+
(assoc opts :static-fns true)
1103+
opts)]
10761104
(if (requires-compilation? src-file dest-file opts)
10771105
(do
10781106
(util/mkdirs dest-file)

‎test/clj/cljs/analyzer_tests.clj‎

Lines changed: 1 addition & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
;; =============================================================================
3434
;; NS parsing
3535

36-
(def ns-env (assoc-in (a/empty-env) [:ns [:name]] 'cljs.user))
36+
(def ns-env (assoc-in (a/empty-env) [:ns :name] 'cljs.user))
3737

3838
(deftest spec-validation
3939
(is (.startsWith
@@ -324,20 +324,3 @@
324324
;; actual: (not (= #{file-reloading dev client} #{file-reloading dev client core}))
325325
(is (= (set (a/ns-dependents 'utils))
326326
#{'file-reloading 'dev 'client 'core}))))
327-
328-
;; =============================================================================
329-
;; Namespace metadata
330-
331-
(deftest test-fn-scope
332-
(is (= (get-in
333-
(a/analyze ns-env
334-
'(fn foo []
335-
(fn bar [])))
336-
[:children 0 :children 0 :env :fn-scope])
337-
'[{:name foo, :info {:shadow nil}} {:name bar, :info {:shadow nil}}]))
338-
(is (= (get-in
339-
(a/analyze ns-env
340-
'(defn foo []
341-
(fn bar [])))
342-
[:init :children 0 :children 0 :env :fn-scope])
343-
'[{:name foo, :info {:shadow nil}} {:name bar, :info {:shadow nil}}])))

‎test/clj/cljs/compiler_tests.clj‎

Lines changed: 36 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
11
(ns cljs.compiler-tests
22
(:use clojure.test)
3+
(:require [cljs.analyzer :as a])
34
(:require [cljs.compiler :as c])
45
(:require [cljs.env :as e])
5-
(:require [cljs.util :as util])
6+
(:require [cljs.util :as util]
7+
[cljs.compiler :as comp])
68
(:import (java.io File)))
79

10+
(def ns-env (assoc-in (a/empty-env) [:ns :name] 'cljs.user))
11+
812
(deftest should-recompile
913
(let [src (File. "test/hello.cljs")
1014
dst (File/createTempFile "compilertest" ".cljs")
@@ -20,3 +24,34 @@
2024
(c/compile-file src dst optmod)
2125
(is (not (c/requires-compilation? src dst optmod)))))))
2226

27+
(deftest fn-scope-munge
28+
(is (= (c/munge
29+
(get-in
30+
(a/analyze ns-env
31+
'(defn foo []
32+
(fn bar [])))
33+
[:init :name]))
34+
'cljs$user_SLASH_foo))
35+
(is (= (c/munge
36+
(get-in
37+
(a/analyze ns-env
38+
'(defn foo []
39+
(fn bar [])))
40+
[:init :children 0 :children 0 :name]))
41+
'cljs$user_SLASH_foo_$_bar))
42+
(is (= (c/munge
43+
(get-in
44+
(a/analyze ns-env
45+
'(fn []
46+
(fn console [])))
47+
[:children 0 :children 0 :name]))
48+
'cljs$user_SLASH_console)))
49+
50+
(comment
51+
(c/munge
52+
(get-in
53+
(a/analyze ns-env
54+
'(defn foo []
55+
(fn bar [])))
56+
[:init :children 0 :children 0 :name]))
57+
)

0 commit comments

Comments
 (0)