1-- | Common functions used by the various optimizer phases
2module Language.PureScript.CoreImp.Optimizer.Common where
3
4import Prelude.Compat
5
6import Data.Text (Text)
7import Data.List (foldl')
8import Data.Maybe (fromMaybe)
9
10import Language.PureScript.Crash
11import Language.PureScript.CoreImp.AST
12import Language.PureScript.PSString (PSString)
13
14applyAll :: [a -> a] -> a -> a
15applyAll = foldl' (.) id
16
17replaceIdent :: Text -> AST -> AST -> AST
18replaceIdent var1 js = everywhere replace
19  where
20  replace (Var _ var2) | var1 == var2 = js
21  replace other = other
22
23replaceIdents :: [(Text, AST)] -> AST -> AST
24replaceIdents vars = everywhere replace
25  where
26  replace v@(Var _ var) = fromMaybe v $ lookup var vars
27  replace other = other
28
29isReassigned :: Text -> AST -> Bool
30isReassigned var1 = everything (||) check
31  where
32  check :: AST -> Bool
33  check (Function _ _ args _) | var1 `elem` args = True
34  check (VariableIntroduction _ arg _) | var1 == arg = True
35  check (Assignment _ (Var _ arg) _) | var1 == arg = True
36  check (For _ arg _ _ _) | var1 == arg = True
37  check (ForIn _ arg _ _) | var1 == arg = True
38  check _ = False
39
40isRebound :: AST -> AST -> Bool
41isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everything (++) variablesOf js)
42  where
43  variablesOf (Var _ var) = [var]
44  variablesOf _ = []
45
46targetVariable :: AST -> Text
47targetVariable (Var _ var) = var
48targetVariable (Indexer _ _ tgt) = targetVariable tgt
49targetVariable _ = internalError "Invalid argument to targetVariable"
50
51isUpdated :: Text -> AST -> Bool
52isUpdated var1 = everything (||) check
53  where
54  check :: AST -> Bool
55  check (Assignment _ target _) | var1 == targetVariable target = True
56  check _ = False
57
58removeFromBlock :: ([AST] -> [AST]) -> AST -> AST
59removeFromBlock go (Block ss sts) = Block ss (go sts)
60removeFromBlock _  js = js
61
62isDict :: (Text, PSString) -> AST -> Bool
63isDict (moduleName, dictName) (Indexer _ (StringLiteral _ x) (Var _ y)) =
64  x == dictName && y == moduleName
65isDict _ _ = False
66
67isDict' :: [(Text, PSString)] -> AST -> Bool
68isDict' xs js = any (`isDict` js) xs
69