\begin{code}
module CoreFVs (
+ isLocalVar, mustHaveLocalBinding,
+
exprFreeVars, exprsFreeVars,
exprSomeFreeVars, exprsSomeFreeVars,
- idRuleVars, idFreeVars, ruleSomeFreeVars, ruleSomeLhsFreeVars,
+ idRuleVars, idFreeVars, idFreeTyVars,
+ ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
CoreExprWithFVs, CoreBindWithFVs, freeVars, freeVarsOf,
) where
#include "HsVersions.h"
import CoreSyn
-import Id ( Id, idFreeTyVars, getIdSpecialisation )
+import Id ( Id, idName, idType, isLocalId, hasNoBinding, idSpecialisation )
import VarSet
-import Var ( IdOrTyVar, isId )
-import Name ( isLocallyDefined )
-import Type ( tyVarsOfType, Type )
+import Var ( Var, isId )
+import Type ( tyVarsOfType )
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}
but not those that are free in the type of variable occurrence.
\begin{code}
-exprFreeVars :: CoreExpr -> IdOrTyVarSet -- Find all locally-defined free Ids or tyvars
-exprFreeVars = exprSomeFreeVars isLocallyDefined
+exprFreeVars :: CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
+exprFreeVars = exprSomeFreeVars isLocalVar
-exprsFreeVars :: [CoreExpr] -> IdOrTyVarSet
+exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
exprSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
-> CoreExpr
- -> IdOrTyVarSet
+ -> VarSet
exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
exprsSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
-> [CoreExpr]
- -> IdOrTyVarSet
+ -> VarSet
exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
-type InterestingVarFun = IdOrTyVar -> Bool -- True <=> interesting
+type InterestingVarFun = Var -> Bool -- True <=> interesting
\end{code}
\begin{code}
type FV = InterestingVarFun
- -> IdOrTyVarSet -- In scope
- -> IdOrTyVarSet -- Free vars
+ -> VarSet -- In scope
+ -> VarSet -- Free vars
union :: FV -> FV -> FV
union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
-- is a little weird. The reason is that the former is more efficient,
-- but the latter is more fine grained, and a makes a difference when
-- a variable mentions itself one of its own rule RHSs
-oneVar :: IdOrTyVar -> FV
+oneVar :: Id -> FV
oneVar var fv_cand in_scope
- = foldVarSet add_rule_var var_itself_set (idRuleVars var)
+ = ASSERT( isId var )
+ foldVarSet add_rule_var var_itself_set (idRuleVars var)
where
var_itself_set | keep_it fv_cand in_scope var = unitVarSet var
| otherwise = emptyVarSet
add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
| otherwise = set
-someVars :: IdOrTyVarSet -> FV
+someVars :: VarSet -> FV
someVars vars fv_cand in_scope
= filterVarSet (keep_it fv_cand in_scope) vars
expr_fvs (Type ty) = someVars (tyVarsOfType ty)
expr_fvs (Var var) = oneVar var
-expr_fvs (Con con args) = foldr (union . expr_fvs) noVars args
+expr_fvs (Lit lit) = noVars
expr_fvs (Note _ expr) = expr_fvs expr
expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
\begin{code}
-idRuleVars ::Id -> IdOrTyVarSet
-idRuleVars id = rulesRhsFreeVars (getIdSpecialisation id)
+idFreeVars :: Id -> VarSet
+idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
-idFreeVars :: Id -> IdOrTyVarSet
-idFreeVars 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
-rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> IdOrTyVarSet
+idRuleVars ::Id -> VarSet
+idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
+
+rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
rulesSomeFreeVars interesting (Rules rules _)
= foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
-ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> IdOrTyVarSet
+ruleRhsFreeVars :: CoreRule -> VarSet
+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
rule_fvs = addBndrs tpl_vars $
foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
-ruleSomeLhsFreeVars :: InterestingVarFun -> CoreRule -> IdOrTyVarSet
+ruleSomeLhsFreeVars :: InterestingVarFun -> CoreRule -> VarSet
ruleSomeLhsFreeVars fn (BuiltinRule _) = noFVs
ruleSomeLhsFreeVars fn (Rule _ tpl_vars tpl_args rhs)
= foldl delVarSet (exprsSomeFreeVars fn tpl_args) tpl_vars
NON-GLOBAL free variables and type variables.
\begin{code}
-type CoreBindWithFVs = AnnBind Id IdOrTyVarSet
-type CoreExprWithFVs = AnnExpr Id IdOrTyVarSet
+type CoreBindWithFVs = AnnBind Id VarSet
+type CoreExprWithFVs = AnnExpr Id VarSet
-- Every node annotated with its free variables,
-- both Ids and TyVars
aFreeVar = unitVarSet
unionFVs = unionVarSet
-filters :: IdOrTyVar -> IdOrTyVarSet -> IdOrTyVarSet
+filters :: Var -> VarSet -> VarSet
-- (b `filters` s) removes the binder b from the free variable set s,
-- but *adds* to s
-- Actually [June 98] I don't think it's necessary
-- fvs = fvs_v `unionVarSet` idSpecVars v
- fvs | isLocallyDefined v = aFreeVar v
- | otherwise = noFVs
-
-freeVars (Con con args)
- = (foldr (unionFVs . freeVarsOf) noFVs args2, AnnCon con args2)
- where
- args2 = map freeVars args
+ fvs | isLocalVar v = aFreeVar v
+ | otherwise = noFVs
+freeVars (Lit lit) = (noFVs, AnnLit lit)
freeVars (Lam b body)
= (b `filters` freeVarsOf body', AnnLam b body')
where
projects / ghc-hetmet.git / blobdiff