git.iko.soy/rowtype-yoga/purescript-native
on cpp help sign in
rowtype-yoga/purescript-native/src/CodeGen/IL/Optimizer.hs
81 lines 3.0 kB history raw
1-- | This module optimizes code in the intermediate representation.
2module CodeGen.IL.Optimizer (optimize) where
4import Prelude.Compat
6import Control.Monad.Supply.Class (MonadSupply)
7import Data.Text (Text)
8import Language.PureScript.CoreImp.AST
9import Language.PureScript.CoreImp.Optimizer.Blocks
10import Language.PureScript.CoreImp.Optimizer.Common hiding (isDict)
11import Language.PureScript.CoreImp.Optimizer.Inliner (etaConvert, evaluateIifes, inlineVariables, unThunk)
12import Language.PureScript.CoreImp.Optimizer.Unused
14import CodeGen.IL.Common (unusedName)
15import CodeGen.IL.Optimizer.Inliner
16import CodeGen.IL.Optimizer.MagicDo
17import CodeGen.IL.Optimizer.TCO
19import qualified Language.PureScript.Constants as C
21-- | Apply a series of optimizer passes to simplified IL code
22optimize :: MonadSupply m => AST -> AST -> m AST
23optimize mn il = do
24 il' <- untilFixedPoint (inlineFnComposition . inlineUnsafeCoerce . inlineUnsafePartial . tidyUp) il
25 il'' <- untilFixedPoint (return . ignoreUnusedResults . inlineCommonValues . inlineCommonOperators . tidyUp) . tco mn . inlineST
26 =<< untilFixedPoint (return . magicDoST)
27 =<< untilFixedPoint (return . magicDoEff)
28 =<< untilFixedPoint (return . magicDoEffect) il'
29 untilFixedPoint (return . collapseVarDeclarations) il''
30 where
31 tidyUp :: AST -> AST
32 tidyUp = applyAll
33 [ collapseNestedBlocks
34 , collapseNestedIfs
35 , collapseIfChecks
36 , removeCodeAfterReturnStatements
37 , unThunk
38 , etaConvert
39 , evaluateIifes
40 , inlineVariables
41 ]
43untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
44untilFixedPoint f = go
45 where
46 go a = do
47 a' <- f a
48 if a' == a then return a' else go a'
50collapseIfChecks :: AST -> AST
51collapseIfChecks = everywhere collapse where
52 collapse :: AST -> AST
53 collapse (IfElse _ (Binary _ EqualTo (BooleanLiteral _ True) (BooleanLiteral _ True)) (Block _ [exprs]) _) = exprs
54 collapse (IfElse _ (Binary _ EqualTo (Indexer _ (Var _ prop) (Var _ val)) (BooleanLiteral _ True)) (Block _ [exprs]) _)
55 | prop == "otherwise" && val == "Data_Boolean" = exprs
56 collapse exprs = exprs
58collapseVarDeclarations :: AST -> AST
59collapseVarDeclarations = everywhere collapse where
60 collapse :: AST -> AST
61 collapse (Block ss sts) = Block ss (go Nothing sts)
62 collapse s = s
64 go :: Maybe Text -> [AST] -> [AST]
65 go _ [] = []
66 go Nothing (decl@(VariableIntroduction _ var (Just _)) : sts) = decl : go (Just var) (go Nothing sts)
67 go (Just var') ((VariableIntroduction ss var (Just val)) : sts)
68 | var == var' = (Assignment ss (Var Nothing var) val) : go (Just var') sts
69 go var' (s:sts) = s : go var' sts
71ignoreUnusedResults :: AST -> AST
72ignoreUnusedResults = everywhere $ removeFromBlock go
73 where
74 go :: [AST] -> [AST]
75 go [] = []
76 go (VariableIntroduction ss var (Just s) : sts)
77 | not $ any (everything (||) (isUsed var)) sts = sts'
78 where
79 sts' | App{} <- s = s : (go sts)
80 | otherwise = go sts
81 go (s:sts) = s : go sts