-- | 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 (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)

-- | 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