git.iko.soy/rowtype-yoga/purescript-native
on a890733 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Optimize.hs
95 lines 3.0 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Optimize
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.Optimize (
16 optimize
17) where
19import Data.Data
20import Data.Generics
22import Language.PureScript.Names
23import Language.PureScript.CodeGen.JS.AST
25optimize :: JS -> JS
26optimize = removeUnusedVariables . unThunk . etaConvert . inlineVariables
28replaceIdent :: (Data d) => Ident -> JS -> d -> d
29replaceIdent var1 js = everywhere (mkT replace)
30 where
31 replace (JSVar var2) | var1 == var2 = js
32 replace other = other
34isReassigned :: (Data d) => Ident -> d -> Bool
35isReassigned var1 = everything (||) (mkQ False check)
36 where
37 check :: JS -> Bool
38 check (JSAssignment (JSAssignVariable var2) _) | var1 == var2 = True
39 check _ = False
41isUsed :: (Data d) => Ident -> d -> Bool
42isUsed var1 = everything (||) (mkQ False check)
43 where
44 check :: JS -> Bool
45 check (JSVar var2) | var1 == var2 = True
46 check (JSAssignment target _) | var1 == targetVariable target = True
47 check _ = False
48 targetVariable :: JSAssignment -> Ident
49 targetVariable (JSAssignVariable var) = var
50 targetVariable (JSAssignProperty _ tgt) = targetVariable tgt
52shouldInline :: JS -> Bool
53shouldInline (JSVar _) = True
54shouldInline (JSNumericLiteral _) = True
55shouldInline (JSStringLiteral _) = True
56shouldInline (JSBooleanLiteral _) = True
57shouldInline (JSAccessor _ val) = shouldInline val
58shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
59shouldInline _ = False
61inlineVariables :: JS -> JS
62inlineVariables = everywhere (mkT removeFromBlock)
63 where
64 removeFromBlock :: JS -> JS
65 removeFromBlock (JSBlock sts) = JSBlock (go sts)
66 removeFromBlock js = js
67 go :: [JS] -> [JS]
68 go [] = []
69 go (JSVariableIntroduction var (Just js) : sts) | shouldInline js && not (isReassigned var sts) = go (replaceIdent var js sts)
70 go (s:sts) = s : go sts
72removeUnusedVariables :: JS -> JS
73removeUnusedVariables = everywhere (mkT removeFromBlock)
74 where
75 removeFromBlock :: JS -> JS
76 removeFromBlock (JSBlock sts) = JSBlock (go sts)
77 removeFromBlock js = js
78 go :: [JS] -> [JS]
79 go [] = []
80 go (JSVariableIntroduction var _ : sts) | not (isUsed var sts) = go sts
81 go (s:sts) = s : go sts
83etaConvert :: JS -> JS
84etaConvert = everywhere (mkT convert)
85 where
86 convert :: JS -> JS
87 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
88 convert js = js
90unThunk :: JS -> JS
91unThunk = everywhere (mkT convert)
92 where
93 convert :: JS -> JS
94 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body
95 convert js = js