module Language.PureScript.CoreImp.Optimizer.Common where
import Prelude
import Data.Text (Text)
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Language.PureScript.Crash (internalError)
import Language.PureScript.CoreImp.AST (AST(..), everything, everywhere)
import Language.PureScript.Names (ModuleName)
import Language.PureScript.PSString (PSString)
applyAll :: [a -> a] -> a -> a
applyAll :: forall a. [a -> a] -> a -> a
applyAll = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
replaceIdent :: Text -> AST -> AST -> AST
replaceIdent :: Text -> AST -> AST -> AST
replaceIdent Text
var1 AST
js = (AST -> AST) -> AST -> AST
everywhere AST -> AST
replace
where
replace :: AST -> AST
replace (Var Maybe SourceSpan
_ Text
var2) | Text
var1 forall a. Eq a => a -> a -> Bool
== Text
var2 = AST
js
replace AST
other = AST
other
replaceIdents :: [(Text, AST)] -> AST -> AST
replaceIdents :: [(Text, AST)] -> AST -> AST
replaceIdents [(Text, AST)]
vars = (AST -> AST) -> AST -> AST
everywhere AST -> AST
replace
where
replace :: AST -> AST
replace v :: AST
v@(Var Maybe SourceSpan
_ Text
var) = forall a. a -> Maybe a -> a
fromMaybe AST
v forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
var [(Text, AST)]
vars
replace AST
other = AST
other
isReassigned :: Text -> AST -> Bool
isReassigned :: Text -> AST -> Bool
isReassigned Text
var1 = forall r. (r -> r -> r) -> (AST -> r) -> AST -> r
everything Bool -> Bool -> Bool
(||) AST -> Bool
check
where
check :: AST -> Bool
check :: AST -> Bool
check (Function Maybe SourceSpan
_ Maybe Text
_ [Text]
args AST
_) | Text
var1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
args = Bool
True
check (VariableIntroduction Maybe SourceSpan
_ Text
arg Maybe (InitializerEffects, AST)
_) | Text
var1 forall a. Eq a => a -> a -> Bool
== Text
arg = Bool
True
check (Assignment Maybe SourceSpan
_ (Var Maybe SourceSpan
_ Text
arg) AST
_) | Text
var1 forall a. Eq a => a -> a -> Bool
== Text
arg = Bool
True
check (For Maybe SourceSpan
_ Text
arg AST
_ AST
_ AST
_) | Text
var1 forall a. Eq a => a -> a -> Bool
== Text
arg = Bool
True
check (ForIn Maybe SourceSpan
_ Text
arg AST
_ AST
_) | Text
var1 forall a. Eq a => a -> a -> Bool
== Text
arg = Bool
True
check AST
_ = Bool
False
isRebound :: AST -> AST -> Bool
isRebound :: AST -> AST -> Bool
isRebound AST
js AST
d = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
v -> Text -> AST -> Bool
isReassigned Text
v AST
d Bool -> Bool -> Bool
|| Text -> AST -> Bool
isUpdated Text
v AST
d) (forall r. (r -> r -> r) -> (AST -> r) -> AST -> r
everything forall a. [a] -> [a] -> [a]
(++) AST -> [Text]
variablesOf AST
js)
where
variablesOf :: AST -> [Text]
variablesOf (Var Maybe SourceSpan
_ Text
var) = [Text
var]
variablesOf AST
_ = []
targetVariable :: AST -> Text
targetVariable :: AST -> Text
targetVariable (Var Maybe SourceSpan
_ Text
var) = Text
var
targetVariable (Indexer Maybe SourceSpan
_ AST
_ AST
tgt) = AST -> Text
targetVariable AST
tgt
targetVariable AST
_ = forall a. HasCallStack => String -> a
internalError String
"Invalid argument to targetVariable"
isUpdated :: Text -> AST -> Bool
isUpdated :: Text -> AST -> Bool
isUpdated Text
var1 = forall r. (r -> r -> r) -> (AST -> r) -> AST -> r
everything Bool -> Bool -> Bool
(||) AST -> Bool
check
where
check :: AST -> Bool
check :: AST -> Bool
check (Assignment Maybe SourceSpan
_ AST
target AST
_) | Text
var1 forall a. Eq a => a -> a -> Bool
== AST -> Text
targetVariable AST
target = Bool
True
check AST
_ = Bool
False
removeFromBlock :: ([AST] -> [AST]) -> AST -> AST
removeFromBlock :: ([AST] -> [AST]) -> AST -> AST
removeFromBlock [AST] -> [AST]
go (Block Maybe SourceSpan
ss [AST]
sts) = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss ([AST] -> [AST]
go [AST]
sts)
removeFromBlock [AST] -> [AST]
_ AST
js = AST
js
pattern Ref :: (ModuleName, PSString) -> AST
pattern $mRef :: forall {r}.
AST -> ((ModuleName, PSString) -> r) -> ((# #) -> r) -> r
Ref pair <- (refPatternHelper -> Just pair)
refPatternHelper :: AST -> Maybe (ModuleName, PSString)
refPatternHelper :: AST -> Maybe (ModuleName, PSString)
refPatternHelper = \case
ModuleAccessor Maybe SourceSpan
_ ModuleName
moduleName PSString
refName -> forall a. a -> Maybe a
Just (ModuleName
moduleName, PSString
refName)
AST
_ -> forall a. Maybe a
Nothing