git.iko.soy/rowtype-yoga/purescript-native
on 184e9e4 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Optimize.hs
92 lines 2.8 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 js = js
34isReassigned :: (Data d) => Ident -> d -> Bool
35isReassigned var1 = everything (||) (mkQ False check)
36 where
37 check :: JS -> Bool
38 check (JSAssignment 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 var2 _) | var1 == var2 = True
47 check _ = False
49shouldInline :: JS -> Bool
50shouldInline (JSVar _) = True
51shouldInline (JSNumericLiteral _) = True
52shouldInline (JSStringLiteral _) = True
53shouldInline (JSBooleanLiteral _) = True
54shouldInline (JSAccessor _ val) = shouldInline val
55shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
56shouldInline _ = False
58inlineVariables :: JS -> JS
59inlineVariables = everywhere (mkT removeFromBlock)
60 where
61 removeFromBlock :: JS -> JS
62 removeFromBlock (JSBlock sts) = JSBlock (go sts)
63 removeFromBlock js = js
64 go :: [JS] -> [JS]
65 go [] = []
66 go (JSVariableIntroduction var js : sts) | shouldInline js && not (isReassigned var sts) = go (replaceIdent var js sts)
67 go (s:sts) = s : go sts
69removeUnusedVariables :: JS -> JS
70removeUnusedVariables = 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
78 go (s:sts) = s : go sts
80etaConvert :: JS -> JS
81etaConvert = everywhere (mkT convert)
82 where
83 convert :: JS -> JS
84 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [ident] (JSBlock body)) [arg])]) | shouldInline arg = JSBlock (replaceIdent ident arg body)
85 convert js = js
87unThunk :: JS -> JS
88unThunk = everywhere (mkT convert)
89 where
90 convert :: JS -> JS
91 convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body
92 convert js = js