-- | Common functions used by the various optimizer phases
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
import Language.PureScript.CoreImp.AST
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

isDict :: (ModuleName, PSString) -> AST -> Bool
isDict :: (ModuleName, PSString) -> AST -> Bool
isDict (ModuleName
moduleName, PSString
dictName) (ModuleAccessor Maybe SourceSpan
_ ModuleName
x PSString
y) =
  ModuleName
x forall a. Eq a => a -> a -> Bool
== ModuleName
moduleName Bool -> Bool -> Bool
&& PSString
y forall a. Eq a => a -> a -> Bool
== PSString
dictName
isDict (ModuleName, PSString)
_ AST
_ = Bool
False

isDict' :: [(ModuleName, PSString)] -> AST -> Bool
isDict' :: [(ModuleName, PSString)] -> AST -> Bool
isDict' [(ModuleName, PSString)]
xs AST
js = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ModuleName, PSString) -> AST -> Bool
`isDict` AST
js) [(ModuleName, PSString)]
xs