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