\begin{code}
module CoreFVs (
- isLocalVar, mustHaveLocalBinding,
+ exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
+ exprsFreeVars, -- [CoreExpr] -> VarSet
- exprFreeVars, exprsFreeVars,
exprSomeFreeVars, exprsSomeFreeVars,
+
idRuleVars, idFreeVars, idFreeTyVars,
- ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
+ ruleRhsFreeVars, ruleLhsFreeNames, ruleLhsFreeIds,
- CoreExprWithFVs, CoreBindWithFVs, freeVars, freeVarsOf,
+ CoreExprWithFVs, -- = AnnExpr Id VarSet
+ CoreBindWithFVs, -- = AnnBind Id VarSet
+ freeVars, -- CoreExpr -> CoreExprWithFVs
+ freeVarsOf -- CoreExprWithFVs -> IdSet
) where
#include "HsVersions.h"
import CoreSyn
-import Id ( Id, idType, isLocalId, hasNoBinding, idSpecialisation )
+import Id ( Id, idType, idSpecialisation )
+import NameSet
import VarSet
-import Var ( Var, isId )
+import Var ( Var, isId, isLocalVar, varName )
import Type ( tyVarsOfType )
+import TcType ( tyClsNamesOfType )
import Util ( mapAndUnzip )
import Outputable
\end{code}
%************************************************************************
%* *
-\subsection{isLocalVar}
-%* *
-%************************************************************************
-
-@isLocalVar@ returns True of all TyVars, and of Ids that are defined in
-this module and are not constants like data constructors and record selectors.
-These are the variables that we need to pay attention to when finding free
-variables, or doing dependency analysis.
-
-\begin{code}
-isLocalVar :: Var -> Bool
-isLocalVar v = isTyVar v || isLocalId v
-\end{code}
-
-\begin{code}
-mustHaveLocalBinding :: Var -> Bool
--- True <=> the variable must have a binding in this module
-mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
-\end{code}
-
-
-%************************************************************************
-%* *
\section{Finding the free variables of an expression}
%* *
%************************************************************************
\end{code}
+%************************************************************************
+%* *
+\section{Free names}
+%* *
+%************************************************************************
+
+exprFreeNames finds the free *names* of an expression, notably
+including the names of type constructors (which of course do not show
+up in exprFreeVars). Similarly ruleLhsFreeNames. The latter is used
+when deciding whether a rule is an orphan. In particular, suppose that
+T is defined in this module; we want to avoid declaring that a rule like
+ fromIntegral T = fromIntegral_T
+is an orphan. Of course it isn't, an declaring it an orphan would
+make the whole module an orphan module, which is bad.
\begin{code}
-idFreeVars :: Id -> VarSet
-idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
+ruleLhsFreeNames :: IdCoreRule -> NameSet
+ruleLhsFreeNames (fn, BuiltinRule _ _) = unitNameSet (varName fn)
+ruleLhsFreeNames (fn, Rule _ _ tpl_vars tpl_args rhs)
+ = addOneToNameSet (exprsFreeNames tpl_args `del_binders` tpl_vars) (varName fn)
-idFreeTyVars :: Id -> TyVarSet
--- Only local Ids conjured up locally, can have free type variables.
--- (During type checking top-level Ids can have free tyvars)
-idFreeTyVars id = tyVarsOfType (idType id)
--- | isLocalId id = tyVarsOfType (idType id)
--- | otherwise = emptyVarSet
+exprFreeNames :: CoreExpr -> NameSet
+exprFreeNames (Var v) = unitNameSet (varName v)
+exprFreeNames (Lit _) = emptyNameSet
+exprFreeNames (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
+exprFreeNames (App e1 e2) = exprFreeNames e1 `unionNameSets` exprFreeNames e2
+exprFreeNames (Lam v e) = exprFreeNames e `delFromNameSet` varName v
+exprFreeNames (Note n e) = exprFreeNames e
-idRuleVars ::Id -> VarSet
-idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
+exprFreeNames (Let (NonRec b r) e) = (exprFreeNames e `delFromNameSet` varName b)
+ `unionNameSets` exprFreeNames r
-rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
-rulesSomeFreeVars interesting (Rules rules _)
- = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
+exprFreeNames (Let (Rec prs) e) = (exprsFreeNames rs `unionNameSets` exprFreeNames e)
+ `del_binders` bs
+ where
+ (bs, rs) = unzip prs
+exprFreeNames (Case e b as) = exprFreeNames e `unionNameSets`
+ (unionManyNameSets (map altFreeNames as) `delFromNameSet` varName b)
+
+-- Helpers
+altFreeNames (_,bs,r) = exprFreeNames r `del_binders` bs
+
+exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
+
+del_binders :: NameSet -> [Var] -> NameSet
+del_binders names bndrs = foldl (\s b -> delFromNameSet s (varName b)) names bndrs
+\end{code}
+
+%************************************************************************
+%* *
+\section[freevars-everywhere]{Attaching free variables to every sub-expression}
+%* *
+%************************************************************************
+
+
+\begin{code}
ruleRhsFreeVars :: CoreRule -> VarSet
-ruleRhsFreeVars (BuiltinRule _) = noFVs
-ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
+ruleRhsFreeVars (BuiltinRule _ _) = noFVs
+ruleRhsFreeVars (Rule str _ tpl_vars tpl_args rhs)
= rule_fvs isLocalVar emptyVarSet
where
rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
-ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> VarSet
-ruleSomeFreeVars interesting (BuiltinRule _) = noFVs
-ruleSomeFreeVars interesting (Rule _ tpl_vars tpl_args rhs)
- = rule_fvs interesting emptyVarSet
- where
- rule_fvs = addBndrs tpl_vars $
- foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
-
-ruleSomeLhsFreeVars :: InterestingVarFun -> CoreRule -> VarSet
-ruleSomeLhsFreeVars fn (BuiltinRule _) = noFVs
-ruleSomeLhsFreeVars fn (Rule _ tpl_vars tpl_args rhs)
- = foldl delVarSet (exprsSomeFreeVars fn tpl_args) tpl_vars
+ruleLhsFreeIds :: CoreRule -> VarSet
+-- This finds all the free Ids on the LHS of the rule
+-- *including* imported ids
+ruleLhsFreeIds (BuiltinRule _ _) = noFVs
+ruleLhsFreeIds (Rule _ _ tpl_vars tpl_args rhs)
+ = foldl delVarSet (exprsSomeFreeVars isId tpl_args) tpl_vars
\end{code}
aFreeVar = unitVarSet
unionFVs = unionVarSet
-filters :: Var -> VarSet -> VarSet
+delBindersFV :: [Var] -> VarSet -> VarSet
+delBindersFV bs fvs = foldr delBinderFV fvs bs
+
+delBinderFV :: Var -> VarSet -> VarSet
+-- This way round, so we can do it multiple times using foldr
--- (b `filters` s) removes the binder b from the free variable set s,
+-- (b `delBinderFV` s) removes the binder b from the free variable set s,
-- but *adds* to s
-- (a) the free variables of b's type
-- (b) the idSpecVars of b
-- where
-- bottom = bottom -- Never evaluated
-filters b s | isId b = (s `delVarSet` b) `unionFVs` idFreeVars b
- | otherwise = s `delVarSet` b
+delBinderFV b s | isId b = (s `delVarSet` b) `unionFVs` idFreeVars b
+ | otherwise = s `delVarSet` b
+
+idFreeVars :: Id -> VarSet
+idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
+
+idFreeTyVars :: Id -> TyVarSet
+-- Only local Ids conjured up locally, can have free type variables.
+-- (During type checking top-level Ids can have free tyvars)
+idFreeTyVars id = tyVarsOfType (idType id)
+-- | isLocalId id = tyVarsOfType (idType id)
+-- | otherwise = emptyVarSet
+
+idRuleVars ::Id -> VarSet
+idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
\end{code}
freeVars (Lit lit) = (noFVs, AnnLit lit)
freeVars (Lam b body)
- = (b `filters` freeVarsOf body', AnnLam b body')
+ = (b `delBinderFV` freeVarsOf body', AnnLam b body')
where
body' = freeVars body
arg2 = freeVars arg
freeVars (Case scrut bndr alts)
- = ((bndr `filters` alts_fvs) `unionFVs` freeVarsOf scrut2,
+ = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2,
AnnCase scrut2 bndr alts2)
where
scrut2 = freeVars scrut
(alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
alts_fvs = foldr1 unionFVs alts_fvs_s
- fv_alt (con,args,rhs) = (foldr filters (freeVarsOf rhs2) args,
+ fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
(con, args, rhs2))
where
rhs2 = freeVars rhs
where
rhs2 = freeVars rhs
body2 = freeVars body
- body_fvs = binder `filters` freeVarsOf body2
+ body_fvs = binder `delBinderFV` freeVarsOf body2
freeVars (Let (Rec binds) body)
= (foldl delVarSet group_fvs binders,
- -- The "filters" part may have added one of the binders
+ -- The "delBinderFV" part may have added one of the binders
-- via the idSpecVars part, so we must delete it again
AnnLet (AnnRec (binders `zip` rhss2)) body2)
where
rhss2 = map freeVars rhss
all_fvs = foldr (unionFVs . fst) body_fvs rhss2
- group_fvs = foldr filters all_fvs binders
+ group_fvs = delBindersFV binders all_fvs
body2 = freeVars body
body_fvs = freeVarsOf body2
projects / ghc-hetmet.git / blobdiff