-- | This module optimizes code in the simplified-JavaScript intermediate representation.
--
-- The following optimizations are supported:
--
--  * Collapsing nested blocks
--
--  * Tail call elimination
--
--  * Inlining of (>>=) and ret for the Eff monad
--
--  * Removal of unnecessary thunks
--
--  * Eta conversion
--
--  * Inlining variables
--
--  * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
--
--  * Inlining primitive JavaScript operators
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

-- | Apply a series of optimizer passes to simplified JavaScript code
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'

-- |
-- Take all top-level ASTs and return a function for expanding top-level
-- variables during the various inlining steps in `optimize`.
--
-- Everything that gets inlined as an optimization is of a form that would
-- have been lifted to a top-level binding during CSE, so for purposes of
-- inlining we can save some time by only expanding variables bound at that
-- level and not worrying about any inner scopes.
--
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