git.iko.soy/rowtype-yoga/purescript-native
on 7e6eb3e help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Optimize.hs
103 lines 3.2 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.Maybe (fromMaybe)
21import Data.Generics
23import Language.PureScript.Names
24import Language.PureScript.CodeGen.JS.AST
26optimize :: JS -> JS
27optimize = removeUnusedVariables . unThunk . etaConvert . inlineVariables
29replaceIdent :: (Data d) => Ident -> JS -> d -> d
30replaceIdent var1 js = everywhere (mkT replace)
31 where
32 replace (JSVar var2) | var1 == var2 = js
33 replace other = other
35replaceIdents :: (Data d) => [(Ident, JS)] -> d -> d
36replaceIdents vars = everywhere (mkT replace)
37 where
38 replace v@(JSVar var) = fromMaybe v $ lookup var vars
39 replace other = other
41isReassigned :: (Data d) => Ident -> d -> Bool
42isReassigned var1 = everything (||) (mkQ False check)
43 where
44 check :: JS -> Bool
45 check (JSAssignment (JSAssignVariable var2) _) | var1 == var2 = True
46 check _ = False
48isUsed :: (Data d) => Ident -> d -> Bool
49isUsed var1 = everything (||) (mkQ False check)
50 where
51 check :: JS -> Bool
52 check (JSVar var2) | var1 == var2 = True
53 check (JSAssignment target _) | var1 == targetVariable target = True
54 check _ = False
55 targetVariable :: JSAssignment -> Ident
56 targetVariable (JSAssignVariable var) = var
57 targetVariable (JSAssignProperty _ tgt) = targetVariable tgt
59shouldInline :: JS -> Bool
60shouldInline (JSVar _) = True
61shouldInline (JSNumericLiteral _) = True
62shouldInline (JSStringLiteral _) = True
63shouldInline (JSBooleanLiteral _) = True
64shouldInline (JSAccessor _ val) = shouldInline val
65shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
66shouldInline _ = False
68inlineVariables :: JS -> JS
69inlineVariables = everywhere (mkT removeFromBlock)
70 where
71 removeFromBlock :: JS -> JS
72 removeFromBlock (JSBlock sts) = JSBlock (go sts)
73 removeFromBlock js = js
74 go :: [JS] -> [JS]
75 go [] = []
76 go (JSVariableIntroduction var (Just js) : sts) | shouldInline js && not (isReassigned var sts) = go (replaceIdent var js sts)
77 go (s:sts) = s : go sts
79removeUnusedVariables :: JS -> JS
80removeUnusedVariables = everywhere (mkT removeFromBlock)
81 where
82 removeFromBlock :: JS -> JS
83 removeFromBlock (JSBlock sts) = JSBlock (go sts)
84 removeFromBlock js = js
85 go :: [JS] -> [JS]
86 go [] = []
87 go (JSVariableIntroduction var _ : sts) | not (isUsed var sts) = go sts
88 go (s:sts) = s : go sts
90etaConvert :: JS -> JS
91etaConvert = everywhere (mkT convert)
92 where
93 convert :: JS -> JS
94 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents (JSBlock body)) args)])
95 | all shouldInline args = JSBlock (replaceIdents (zip idents args) body)
96 convert js = js
98unThunk :: JS -> JS
99unThunk = everywhere (mkT convert)
100 where
101 convert :: JS -> JS
102 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body
103 convert js = js