git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
More optimizations
fbbc197Phil Freeman
src/Language/PureScript/Optimize.hs+39−2
@@ -23,7 +23,7 @@ import Language.PureScript.Names
23import Language.PureScript.CodeGen.JS.AST
23import Language.PureScript.CodeGen.JS.AST
24
24
25optimize :: JS -> JS
25optimize :: JS -> JS
26−optimize = etaConvert . inlineVariables
26+optimize = removeUnusedVariables . unThunk . etaConvert . inlineVariables
27
27
28replaceIdent :: (Data d) => Ident -> JS -> d -> d
28replaceIdent :: (Data d) => Ident -> JS -> d -> d
29replaceIdent var1 js = everywhere (mkT replace)
29replaceIdent var1 js = everywhere (mkT replace)
@@ -31,9 +31,28 @@ replaceIdent var1 js = everywhere (mkT replace)
31 replace (JSVar var2) | var1 == var2 = js
31 replace (JSVar var2) | var1 == var2 = js
32 replace js = js
32 replace js = js
33
33
34+isReassigned :: (Data d) => Ident -> d -> Bool
35+isReassigned var1 = everything (||) (mkQ False check)
36+ where
37+ check :: JS -> Bool
38+ check (JSAssignment var2 _) | var1 == var2 = True
39+ check _ = False
40+
41+isUsed :: (Data d) => Ident -> d -> Bool
42+isUsed var1 = everything (||) (mkQ False check)
43+ where
44+ check :: JS -> Bool
45+ check (JSVar var2) | var1 == var2 = True
46+ check (JSAssignment var2 _) | var1 == var2 = True
47+ check _ = False
48+
34shouldInline :: JS -> Bool
49shouldInline :: JS -> Bool
35shouldInline (JSVar _) = True
50shouldInline (JSVar _) = True
51+shouldInline (JSNumericLiteral _) = True
52+shouldInline (JSStringLiteral _) = True
53+shouldInline (JSBooleanLiteral _) = True
36shouldInline (JSAccessor _ val) = shouldInline val
54shouldInline (JSAccessor _ val) = shouldInline val
55+shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
37shouldInline _ = False
56shouldInline _ = False
38
57
39inlineVariables :: JS -> JS
58inlineVariables :: JS -> JS
@@ -44,7 +63,18 @@ inlineVariables = everywhere (mkT removeFromBlock)
44 removeFromBlock js = js
63 removeFromBlock js = js
45 go :: [JS] -> [JS]
64 go :: [JS] -> [JS]
46 go [] = []
65 go [] = []
47− go (JSVariableIntroduction var js : sts) | shouldInline js = go (replaceIdent var js sts)
66+ go (JSVariableIntroduction var js : sts) | shouldInline js && not (isReassigned var sts) = go (replaceIdent var js sts)
67+ go (s:sts) = s : go sts
68+
69+removeUnusedVariables :: JS -> JS
70+removeUnusedVariables = everywhere (mkT removeFromBlock)
71+ where
72+ removeFromBlock :: JS -> JS
73+ removeFromBlock (JSBlock sts) = JSBlock (go sts)
74+ removeFromBlock js = js
75+ go :: [JS] -> [JS]
76+ go [] = []
77+ go (JSVariableIntroduction var _ : sts) | not (isUsed var sts) = go sts
48 go (s:sts) = s : go sts
78 go (s:sts) = s : go sts
49
79
50etaConvert :: JS -> JS
80etaConvert :: JS -> JS
@@ -53,3 +83,10 @@ etaConvert = everywhere (mkT convert)
53 convert :: JS -> JS
83 convert :: JS -> JS
54 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
84 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
55 convert js = js
85 convert js = js
86+
87+unThunk :: JS -> JS
88+unThunk = everywhere (mkT convert)
89+ where
90+ convert :: JS -> JS
91+ convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body
92+ convert js = js