module Language.PureScript.CoreImp.Optimizer (optimize) where
import Prelude
import Data.Text (Text)
import Control.Monad.Supply.Class (MonadSupply)
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Blocks
import Language.PureScript.CoreImp.Optimizer.Common
import Language.PureScript.CoreImp.Optimizer.Inliner
import Language.PureScript.CoreImp.Optimizer.MagicDo
import Language.PureScript.CoreImp.Optimizer.TCO
import Language.PureScript.CoreImp.Optimizer.Unused
optimize :: forall m. MonadSupply m => [Text] -> [[AST]] -> m [[AST]]
optimize :: forall (m :: * -> *).
MonadSupply m =>
[Text] -> [[AST]] -> m [[AST]]
optimize [Text]
exps [[AST]]
jsDecls = [Text] -> [[AST]] -> [[AST]]
removeUnusedEffectFreeVars [Text]
exps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AST -> m AST
go) [[AST]]
jsDecls
where
go :: AST -> m AST
go :: AST -> m AST
go AST
js = do
AST
js' <- forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint (forall (m :: * -> *). MonadSupply m => (AST -> AST) -> AST -> m AST
inlineFnComposition AST -> AST
expander forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AST -> AST) -> AST -> AST
inlineFnIdentity AST -> AST
expander forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
inlineUnsafeCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
inlineUnsafePartial forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
tidyUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a -> a] -> a -> a
applyAll
[ (AST -> AST) -> AST -> AST
inlineCommonValues AST -> AST
expander
, (AST -> AST) -> AST -> AST
inlineCommonOperators AST -> AST
expander
]) AST
js
forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
tidyUp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
tco forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
inlineST
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AST -> AST) -> AST -> AST
magicDoST AST -> AST
expander)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AST -> AST) -> AST -> AST
magicDoEff AST -> AST
expander)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AST -> AST) -> AST -> AST
magicDoEffect AST -> AST
expander) AST
js'
tidyUp :: AST -> AST
tidyUp :: AST -> AST
tidyUp = forall a. [a -> a] -> a -> a
applyAll
[ AST -> AST
collapseNestedBlocks
, AST -> AST
collapseNestedIfs
, AST -> AST
removeCodeAfterReturnStatements
, AST -> AST
removeUndefinedApp
, AST -> AST
unThunk
, AST -> AST
etaConvert
, AST -> AST
evaluateIifes
, AST -> AST
inlineVariables
]
expander :: AST -> AST
expander = [AST] -> AST -> AST
buildExpander (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AST]]
jsDecls)
untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint :: forall (m :: * -> *) a. (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint a -> m a
f = a -> m a
go
where
go :: a -> m a
go a
a = do
a
a' <- a -> m a
f a
a
if a
a' forall a. Eq a => a -> a -> Bool
== a
a then forall (m :: * -> *) a. Monad m => a -> m a
return a
a' else a -> m a
go a
a'
buildExpander :: [AST] -> AST -> AST
buildExpander :: [AST] -> AST -> AST
buildExpander = [(Text, AST)] -> AST -> AST
replaceIdents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AST -> [(Text, AST)] -> [(Text, AST)]
go []
where
go :: AST -> [(Text, AST)] -> [(Text, AST)]
go = \case
VariableIntroduction Maybe SourceSpan
_ Text
name (Just (InitializerEffects
NoEffects, AST
e)) -> ((Text
name, AST
e) forall a. a -> [a] -> [a]
:)
AST
_ -> forall a. a -> a
id