module Language.PureScript.CoreImp.Optimizer.Unused
( removeCodeAfterReturnStatements
, removeUndefinedApp
, removeUnusedEffectFreeVars
) where
import Prelude
import Control.Monad (filterM)
import Data.Monoid (Any(..))
import Data.Set qualified as S
import Data.Text (Text)
import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), everything, everywhere)
import Language.PureScript.CoreImp.Optimizer.Common (removeFromBlock)
import Language.PureScript.Constants.Prim qualified 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
C.S_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)