module Language.PureScript.CoreImp.Optimizer (optimize) where
import Prelude
import Data.Text (Text)
import Control.Monad.Supply.Class (MonadSupply)
import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..))
import Language.PureScript.CoreImp.Optimizer.Blocks (collapseNestedBlocks, collapseNestedIfs)
import Language.PureScript.CoreImp.Optimizer.Common (applyAll, replaceIdents)
import Language.PureScript.CoreImp.Optimizer.Inliner (etaConvert, evaluateIifes, inlineCommonOperators, inlineCommonValues, inlineFnComposition, inlineFnIdentity, inlineUnsafeCoerce, inlineUnsafePartial, inlineVariables, unThunk)
import Language.PureScript.CoreImp.Optimizer.MagicDo (inlineST, magicDoEff, magicDoEffect, magicDoST)
import Language.PureScript.CoreImp.Optimizer.TCO (tco)
import Language.PureScript.CoreImp.Optimizer.Unused (removeCodeAfterReturnStatements, removeUndefinedApp, removeUnusedEffectFreeVars)
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