-- | Removes unused variables
module Language.PureScript.CoreImp.Optimizer.Unused
  ( removeCodeAfterReturnStatements
  , removeUndefinedApp
  , removeUnusedEffectFreeVars
  ) where

import Prelude

import Control.Monad (filterM)
import Data.Monoid (Any(..))
import qualified Data.Set as S
import Data.Text (Text)

import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
import qualified Language.PureScript.Constants.Prim as C

removeCodeAfterReturnStatements :: AST -> AST
removeCodeAfterReturnStatements :: AST -> AST
removeCodeAfterReturnStatements = (AST -> AST) -> AST -> AST
everywhere (([AST] -> [AST]) -> AST -> AST
removeFromBlock [AST] -> [AST]
go)
  where
  go :: [AST] -> [AST]
  go :: [AST] -> [AST]
go [AST]
jss =
    case forall a. (a -> Bool) -> [a] -> ([a], [a])
break AST -> Bool
isReturn [AST]
jss of
      ([AST]
_, []) -> [AST]
jss
      ([AST]
body, AST
ret : [AST]
_ ) -> [AST]
body forall a. [a] -> [a] -> [a]
++ [AST
ret]

  isReturn :: AST -> Bool
isReturn (Return Maybe SourceSpan
_ AST
_) = Bool
True
  isReturn (ReturnNoResult Maybe SourceSpan
_) = Bool
True
  isReturn AST
_ = Bool
False

removeUndefinedApp :: AST -> AST
removeUndefinedApp :: AST -> AST
removeUndefinedApp = (AST -> AST) -> AST -> AST
everywhere AST -> AST
convert
  where
  convert :: AST -> AST
convert (App Maybe SourceSpan
ss AST
fn [Var Maybe SourceSpan
_ Text
arg]) | Text
arg forall a. Eq a => a -> a -> Bool
== forall a. IsString a => a
C.undefined = Maybe SourceSpan -> AST -> [AST] -> AST
App Maybe SourceSpan
ss AST
fn []
  convert AST
js = AST
js

removeUnusedEffectFreeVars :: [Text] -> [[AST]] -> [[AST]]
removeUnusedEffectFreeVars :: [Text] -> [[AST]] -> [[AST]]
removeUnusedEffectFreeVars [Text]
exps = [[AST]] -> [[AST]]
loop
  where
  expsSet :: Set Text
expsSet = forall a. Ord a => [a] -> Set a
S.fromList [Text]
exps

  loop :: [[AST]] -> [[AST]]
  loop :: [[AST]] -> [[AST]]
loop [[AST]]
asts = if Bool
changed then [[AST]] -> [[AST]]
loop (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[AST]]
asts') else [[AST]]
asts
    where
    used :: Set Text
used = Set Text
expsSet forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall r. (r -> r -> r) -> (AST -> r) -> AST -> r
everything forall a. Semigroup a => a -> a -> a
(<>) (\case Var Maybe SourceSpan
_ Text
x -> forall a. a -> Set a
S.singleton Text
x; AST
_ -> forall a. Set a
S.empty))) [[AST]]
asts
    (Any Bool
changed, [[AST]]
asts') = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Bool -> (Any, Bool)
anyFalses forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> AST -> Bool
isInUsedSet Set Text
used)) [[AST]]
asts

  isInUsedSet :: S.Set Text -> AST -> Bool
  isInUsedSet :: Set Text -> AST -> Bool
isInUsedSet Set Text
used = \case
    VariableIntroduction Maybe SourceSpan
_ Text
var (Just (InitializerEffects
NoEffects, AST
_)) -> Text
var forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
used
    AST
_ -> Bool
True

  anyFalses :: Bool -> (Any, Bool)
  anyFalses :: Bool -> (Any, Bool)
anyFalses Bool
x = (Bool -> Any
Any (Bool -> Bool
not Bool
x), Bool
x)