2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 Taken quite directly from the Peyton Jones/Lester paper.
8 isLocalVar, mustHaveLocalBinding,
10 exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
11 exprsFreeVars, -- [CoreExpr] -> VarSet
13 exprSomeFreeVars, exprsSomeFreeVars,
15 idRuleVars, idFreeVars, idFreeTyVars,
16 ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
18 CoreExprWithFVs, -- = AnnExpr Id VarSet
19 CoreBindWithFVs, -- = AnnBind Id VarSet
20 freeVars, -- CoreExpr -> CoreExprWithFVs
21 freeVarsOf -- CoreExprWithFVs -> IdSet
24 #include "HsVersions.h"
27 import Id ( Id, idType, isLocalId, hasNoBinding, idSpecialisation )
29 import Var ( Var, isId )
30 import Type ( tyVarsOfType )
31 import Util ( mapAndUnzip )
36 %************************************************************************
38 \subsection{isLocalVar}
40 %************************************************************************
42 @isLocalVar@ returns True of all TyVars, and of Ids that are defined in
43 this module and are not constants like data constructors and record selectors.
44 These are the variables that we need to pay attention to when finding free
45 variables, or doing dependency analysis.
48 isLocalVar :: Var -> Bool
49 isLocalVar v = isTyVar v || isLocalId v
53 mustHaveLocalBinding :: Var -> Bool
54 -- True <=> the variable must have a binding in this module
55 mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
59 %************************************************************************
61 \section{Finding the free variables of an expression}
63 %************************************************************************
65 This function simply finds the free variables of an expression.
66 So far as type variables are concerned, it only finds tyvars that are
68 * free in type arguments,
69 * free in the type of a binder,
71 but not those that are free in the type of variable occurrence.
74 exprFreeVars :: CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
75 exprFreeVars = exprSomeFreeVars isLocalVar
77 exprsFreeVars :: [CoreExpr] -> VarSet
78 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
80 exprSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
83 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
85 exprsSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
88 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
90 type InterestingVarFun = Var -> Bool -- True <=> interesting
95 type FV = InterestingVarFun
97 -> VarSet -- Free vars
99 union :: FV -> FV -> FV
100 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
103 noVars fv_cand in_scope = emptyVarSet
105 -- At a variable occurrence, add in any free variables of its rule rhss
106 -- Curiously, we gather the Id's free *type* variables from its binding
107 -- site, but its free *rule-rhs* variables from its usage sites. This
108 -- is a little weird. The reason is that the former is more efficient,
109 -- but the latter is more fine grained, and a makes a difference when
110 -- a variable mentions itself one of its own rule RHSs
112 oneVar var fv_cand in_scope
114 foldVarSet add_rule_var var_itself_set (idRuleVars var)
116 var_itself_set | keep_it fv_cand in_scope var = unitVarSet var
117 | otherwise = emptyVarSet
118 add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
121 someVars :: VarSet -> FV
122 someVars vars fv_cand in_scope
123 = filterVarSet (keep_it fv_cand in_scope) vars
125 keep_it fv_cand in_scope var
126 | var `elemVarSet` in_scope = False
131 addBndr :: CoreBndr -> FV -> FV
132 addBndr bndr fv fv_cand in_scope
133 | isId bndr = inside_fvs `unionVarSet` someVars (idFreeTyVars bndr) fv_cand in_scope
134 | otherwise = inside_fvs
136 inside_fvs = fv fv_cand (in_scope `extendVarSet` bndr)
138 addBndrs :: [CoreBndr] -> FV -> FV
139 addBndrs bndrs fv = foldr addBndr fv bndrs
144 expr_fvs :: CoreExpr -> FV
146 expr_fvs (Type ty) = someVars (tyVarsOfType ty)
147 expr_fvs (Var var) = oneVar var
148 expr_fvs (Lit lit) = noVars
149 expr_fvs (Note _ expr) = expr_fvs expr
150 expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
151 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
153 expr_fvs (Case scrut bndr alts)
154 = expr_fvs scrut `union` addBndr bndr (foldr (union . alt_fvs) noVars alts)
156 alt_fvs (con, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
158 expr_fvs (Let (NonRec bndr rhs) body)
159 = expr_fvs rhs `union` addBndr bndr (expr_fvs body)
161 expr_fvs (Let (Rec pairs) body)
162 = addBndrs bndrs (foldr (union . expr_fvs) (expr_fvs body) rhss)
164 (bndrs,rhss) = unzip pairs
170 idFreeVars :: Id -> VarSet
171 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
173 idFreeTyVars :: Id -> TyVarSet
174 -- Only local Ids conjured up locally, can have free type variables.
175 -- (During type checking top-level Ids can have free tyvars)
176 idFreeTyVars id = tyVarsOfType (idType id)
177 -- | isLocalId id = tyVarsOfType (idType id)
178 -- | otherwise = emptyVarSet
180 idRuleVars ::Id -> VarSet
181 idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
183 rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
184 rulesSomeFreeVars interesting (Rules rules _)
185 = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
187 ruleRhsFreeVars :: CoreRule -> VarSet
188 ruleRhsFreeVars (BuiltinRule _) = noFVs
189 ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
190 = rule_fvs isLocalVar emptyVarSet
192 rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
194 ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> VarSet
195 ruleSomeFreeVars interesting (BuiltinRule _) = noFVs
196 ruleSomeFreeVars interesting (Rule _ tpl_vars tpl_args rhs)
197 = rule_fvs interesting emptyVarSet
199 rule_fvs = addBndrs tpl_vars $
200 foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
202 ruleSomeLhsFreeVars :: InterestingVarFun -> CoreRule -> VarSet
203 ruleSomeLhsFreeVars fn (BuiltinRule _) = noFVs
204 ruleSomeLhsFreeVars fn (Rule _ tpl_vars tpl_args rhs)
205 = foldl delVarSet (exprsSomeFreeVars fn tpl_args) tpl_vars
209 %************************************************************************
211 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
213 %************************************************************************
215 The free variable pass annotates every node in the expression with its
216 NON-GLOBAL free variables and type variables.
219 type CoreBindWithFVs = AnnBind Id VarSet
220 type CoreExprWithFVs = AnnExpr Id VarSet
221 -- Every node annotated with its free variables,
222 -- both Ids and TyVars
224 freeVarsOf :: CoreExprWithFVs -> IdSet
225 freeVarsOf (free_vars, _) = free_vars
228 aFreeVar = unitVarSet
229 unionFVs = unionVarSet
231 filters :: Var -> VarSet -> VarSet
233 -- (b `filters` s) removes the binder b from the free variable set s,
235 -- (a) the free variables of b's type
236 -- (b) the idSpecVars of b
238 -- This is really important for some lambdas:
239 -- In (\x::a -> x) the only mention of "a" is in the binder.
242 -- let x::a = b in ...
243 -- we should really note that "a" is free in this expression.
244 -- It'll be pinned inside the /\a by the binding for b, but
245 -- it seems cleaner to make sure that a is in the free-var set
246 -- when it is mentioned.
248 -- This also shows up in recursive bindings. Consider:
249 -- /\a -> letrec x::a = x in E
250 -- Now, there are no explicit free type variables in the RHS of x,
251 -- but nevertheless "a" is free in its definition. So we add in
252 -- the free tyvars of the types of the binders, and include these in the
253 -- free vars of the group, attached to the top level of each RHS.
255 -- This actually happened in the defn of errorIO in IOBase.lhs:
256 -- errorIO (ST io) = case (errorIO# io) of
259 -- bottom = bottom -- Never evaluated
261 filters b s | isId b = (s `delVarSet` b) `unionFVs` idFreeVars b
262 | otherwise = s `delVarSet` b
266 %************************************************************************
268 \subsection{Free variables (and types)}
270 %************************************************************************
273 freeVars :: CoreExpr -> CoreExprWithFVs
278 -- ToDo: insert motivating example for why we *need*
279 -- to include the idSpecVars in the FV list.
280 -- Actually [June 98] I don't think it's necessary
281 -- fvs = fvs_v `unionVarSet` idSpecVars v
283 fvs | isLocalVar v = aFreeVar v
286 freeVars (Lit lit) = (noFVs, AnnLit lit)
287 freeVars (Lam b body)
288 = (b `filters` freeVarsOf body', AnnLam b body')
290 body' = freeVars body
292 freeVars (App fun arg)
293 = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
298 freeVars (Case scrut bndr alts)
299 = ((bndr `filters` alts_fvs) `unionFVs` freeVarsOf scrut2,
300 AnnCase scrut2 bndr alts2)
302 scrut2 = freeVars scrut
304 (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
305 alts_fvs = foldr1 unionFVs alts_fvs_s
307 fv_alt (con,args,rhs) = (foldr filters (freeVarsOf rhs2) args,
312 freeVars (Let (NonRec binder rhs) body)
313 = (freeVarsOf rhs2 `unionFVs` body_fvs,
314 AnnLet (AnnNonRec binder rhs2) body2)
317 body2 = freeVars body
318 body_fvs = binder `filters` freeVarsOf body2
320 freeVars (Let (Rec binds) body)
321 = (foldl delVarSet group_fvs binders,
322 -- The "filters" part may have added one of the binders
323 -- via the idSpecVars part, so we must delete it again
324 AnnLet (AnnRec (binders `zip` rhss2)) body2)
326 (binders, rhss) = unzip binds
328 rhss2 = map freeVars rhss
329 all_fvs = foldr (unionFVs . fst) body_fvs rhss2
330 group_fvs = foldr filters all_fvs binders
332 body2 = freeVars body
333 body_fvs = freeVarsOf body2
335 freeVars (Note (Coerce to_ty from_ty) expr)
336 = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
337 AnnNote (Coerce to_ty from_ty) expr2)
339 expr2 = freeVars expr
340 tfvs1 = tyVarsOfType from_ty
341 tfvs2 = tyVarsOfType to_ty
343 freeVars (Note other_note expr)
344 = (freeVarsOf expr2, AnnNote other_note expr2)
346 expr2 = freeVars expr
348 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)