2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 Taken quite directly from the Peyton Jones/Lester paper.
8 {-# OPTIONS -fno-warn-incomplete-patterns #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and fix
11 -- any warnings in the module. See
12 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
17 exprsFreeVars, -- [CoreExpr] -> VarSet
18 bindFreeVars, -- CoreBind -> VarSet
20 exprSomeFreeVars, exprsSomeFreeVars,
21 exprFreeNames, exprsFreeNames,
23 idRuleVars, idFreeVars, varTypeTyVars,
24 ruleRhsFreeVars, rulesFreeVars,
25 ruleLhsFreeNames, ruleLhsFreeIds,
27 CoreExprWithFVs, -- = AnnExpr Id VarSet
28 CoreBindWithFVs, -- = AnnBind Id VarSet
29 freeVars, -- CoreExpr -> CoreExprWithFVs
30 freeVarsOf -- CoreExprWithFVs -> IdSet
33 -- XXX This define is a bit of a hack, and should be done more nicely
34 #define FAST_STRING_NOT_NEEDED 1
35 #include "HsVersions.h"
51 %************************************************************************
53 \section{Finding the free variables of an expression}
55 %************************************************************************
57 This function simply finds the free variables of an expression.
58 So far as type variables are concerned, it only finds tyvars that are
60 * free in type arguments,
61 * free in the type of a binder,
63 but not those that are free in the type of variable occurrence.
66 exprFreeVars :: CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
67 exprFreeVars = exprSomeFreeVars isLocalVar
69 exprsFreeVars :: [CoreExpr] -> VarSet
70 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
72 bindFreeVars :: CoreBind -> VarSet
73 bindFreeVars (NonRec _ r) = exprFreeVars r
74 bindFreeVars (Rec prs) = addBndrs (map fst prs)
75 (foldr (union . rhs_fvs) noVars prs)
76 isLocalVar emptyVarSet
78 exprSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
81 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
83 exprsSomeFreeVars :: InterestingVarFun -- Says which Vars are interesting
86 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
88 type InterestingVarFun = Var -> Bool -- True <=> interesting
93 type FV = InterestingVarFun
95 -> VarSet -- Free vars
97 union :: FV -> FV -> FV
98 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
101 noVars _ _ = emptyVarSet
103 -- Comment about obselete code
104 -- We used to gather the free variables the RULES at a variable occurrence
105 -- with the following cryptic comment:
106 -- "At a variable occurrence, add in any free variables of its rule rhss
107 -- Curiously, we gather the Id's free *type* variables from its binding
108 -- site, but its free *rule-rhs* variables from its usage sites. This
109 -- is a little weird. The reason is that the former is more efficient,
110 -- but the latter is more fine grained, and a makes a difference when
111 -- a variable mentions itself one of its own rule RHSs"
112 -- Not only is this "weird", but it's also pretty bad because it can make
113 -- a function seem more recursive than it is. Suppose
116 -- RULE g x = ...f...
117 -- Then f is not mentioned in its own RHS, and needn't be a loop breaker
118 -- (though g may be). But if we collect the rule fvs from g's occurrence,
119 -- it looks as if f mentions itself. (This bites in the eftInt/eftIntFB
120 -- code in GHC.Enum.)
122 -- Anyway, it seems plain wrong. The RULE is like an extra RHS for the
123 -- function, so its free variables belong at the definition site.
125 -- Deleted code looked like
126 -- foldVarSet add_rule_var var_itself_set (idRuleVars var)
127 -- add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
132 oneVar var fv_cand in_scope
134 if keep_it fv_cand in_scope var
138 someVars :: VarSet -> FV
139 someVars vars fv_cand in_scope
140 = filterVarSet (keep_it fv_cand in_scope) vars
142 keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
143 keep_it fv_cand in_scope var
144 | var `elemVarSet` in_scope = False
149 addBndr :: CoreBndr -> FV -> FV
150 addBndr bndr fv fv_cand in_scope
151 = someVars (varTypeTyVars bndr) fv_cand in_scope
152 -- Include type varibles in the binder's type
153 -- (not just Ids; coercion variables too!)
154 `unionVarSet` fv fv_cand (in_scope `extendVarSet` bndr)
156 addBndrs :: [CoreBndr] -> FV -> FV
157 addBndrs bndrs fv = foldr addBndr fv bndrs
162 expr_fvs :: CoreExpr -> FV
164 expr_fvs (Type ty) = someVars (tyVarsOfType ty)
165 expr_fvs (Var var) = oneVar var
166 expr_fvs (Lit _) = noVars
167 expr_fvs (Note _ expr) = expr_fvs expr
168 expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
169 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
170 expr_fvs (Cast expr co) = expr_fvs expr `union` someVars (tyVarsOfType co)
172 expr_fvs (Case scrut bndr ty alts)
173 = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
174 (foldr (union . alt_fvs) noVars alts)
176 alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
178 expr_fvs (Let (NonRec bndr rhs) body)
179 = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
181 expr_fvs (Let (Rec pairs) body)
182 = addBndrs (map fst pairs)
183 (foldr (union . rhs_fvs) (expr_fvs body) pairs)
186 rhs_fvs :: (Id,CoreExpr) -> FV
187 rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (idRuleVars bndr)
188 -- Treat any RULES as extra RHSs of the binding
191 exprs_fvs :: [CoreExpr] -> FV
192 exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
196 %************************************************************************
200 %************************************************************************
202 exprFreeNames finds the free *external* *names* of an expression, notably
203 including the names of type constructors (which of course do not show
204 up in exprFreeVars). Similarly ruleLhsFreeNames. The latter is used
205 when deciding whether a rule is an orphan. In particular, suppose that
206 T is defined in this module; we want to avoid declaring that a rule like
207 fromIntegral T = fromIntegral_T
208 is an orphan. Of course it isn't, an declaring it an orphan would
209 make the whole module an orphan module, which is bad.
211 There's no need to delete local binders, because they will all
215 ruleLhsFreeNames :: CoreRule -> NameSet
216 ruleLhsFreeNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
217 ruleLhsFreeNames (Rule { ru_fn = fn, ru_args = tpl_args })
218 = addOneToNameSet (exprsFreeNames tpl_args) fn
220 exprFreeNames :: CoreExpr -> NameSet
221 -- Find the free *external* names of an expression
226 | isExternalName n = unitNameSet n
227 | otherwise = emptyNameSet
229 go (Lit _) = emptyNameSet
230 go (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
231 go (App e1 e2) = go e1 `unionNameSets` go e2
232 go (Lam v e) = go e `delFromNameSet` idName v
234 go (Cast e co) = go e `unionNameSets` tyClsNamesOfType co
235 go (Let (NonRec _ r) e) = go e `unionNameSets` go r
236 go (Let (Rec prs) e) = exprsFreeNames (map snd prs) `unionNameSets` go e
237 go (Case e _ ty as) = go e `unionNameSets` tyClsNamesOfType ty
238 `unionNameSets` unionManyNameSets (map go_alt as)
240 go_alt (_,_,r) = go r
242 exprsFreeNames :: [CoreExpr] -> NameSet
243 exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
246 %************************************************************************
248 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
250 %************************************************************************
254 ruleRhsFreeVars :: CoreRule -> VarSet
255 ruleRhsFreeVars (BuiltinRule {}) = noFVs
256 ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
257 = delFromUFM fvs fn -- Note [Rule free var hack]
259 fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
261 ruleFreeVars :: CoreRule -> VarSet -- All free variables, both left and right
262 ruleFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args })
263 = delFromUFM fvs fn -- Note [Rule free var hack]
265 fvs = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet
267 rulesFreeVars :: [CoreRule] -> VarSet
268 rulesFreeVars rules = foldr (unionVarSet . ruleFreeVars) emptyVarSet rules
270 ruleLhsFreeIds :: CoreRule -> VarSet
271 -- This finds all locally-defined free Ids on the LHS of the rule
272 ruleLhsFreeIds (BuiltinRule {}) = noFVs
273 ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
274 = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
277 Note [Rule free var hack]
278 ~~~~~~~~~~~~~~~~~~~~~~~~~
279 Don't include the Id in its own rhs free-var set.
280 Otherwise the occurrence analyser makes bindings recursive
281 that shoudn't be. E.g.
282 RULE: f (f x y) z ==> f x (f y z)
284 Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM.
286 %************************************************************************
288 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
290 %************************************************************************
292 The free variable pass annotates every node in the expression with its
293 NON-GLOBAL free variables and type variables.
296 type CoreBindWithFVs = AnnBind Id VarSet
297 type CoreExprWithFVs = AnnExpr Id VarSet
298 -- Every node annotated with its free variables,
299 -- both Ids and TyVars
301 freeVarsOf :: CoreExprWithFVs -> IdSet
302 freeVarsOf (free_vars, _) = free_vars
307 aFreeVar :: Var -> VarSet
308 aFreeVar = unitVarSet
310 unionFVs :: VarSet -> VarSet -> VarSet
311 unionFVs = unionVarSet
313 delBindersFV :: [Var] -> VarSet -> VarSet
314 delBindersFV bs fvs = foldr delBinderFV fvs bs
316 delBinderFV :: Var -> VarSet -> VarSet
317 -- This way round, so we can do it multiple times using foldr
319 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
321 -- (a) the free variables of b's type
322 -- (b) the idSpecVars of b
324 -- This is really important for some lambdas:
325 -- In (\x::a -> x) the only mention of "a" is in the binder.
328 -- let x::a = b in ...
329 -- we should really note that "a" is free in this expression.
330 -- It'll be pinned inside the /\a by the binding for b, but
331 -- it seems cleaner to make sure that a is in the free-var set
332 -- when it is mentioned.
334 -- This also shows up in recursive bindings. Consider:
335 -- /\a -> letrec x::a = x in E
336 -- Now, there are no explicit free type variables in the RHS of x,
337 -- but nevertheless "a" is free in its definition. So we add in
338 -- the free tyvars of the types of the binders, and include these in the
339 -- free vars of the group, attached to the top level of each RHS.
341 -- This actually happened in the defn of errorIO in IOBase.lhs:
342 -- errorIO (ST io) = case (errorIO# io) of
345 -- bottom = bottom -- Never evaluated
347 delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
348 -- Include coercion variables too!
350 varTypeTyVars :: Var -> TyVarSet
351 -- Find the type variables free in the type of the variable
352 -- Remember, coercion variables can mention type variables...
354 | isLocalId var || isCoVar var = tyVarsOfType (idType var)
355 | otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
357 idFreeVars :: Id -> VarSet
358 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` varTypeTyVars id
360 idRuleVars ::Id -> VarSet
361 idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
365 %************************************************************************
367 \subsection{Free variables (and types)}
369 %************************************************************************
372 freeVars :: CoreExpr -> CoreExprWithFVs
377 -- ToDo: insert motivating example for why we *need*
378 -- to include the idSpecVars in the FV list.
379 -- Actually [June 98] I don't think it's necessary
380 -- fvs = fvs_v `unionVarSet` idSpecVars v
382 fvs | isLocalVar v = aFreeVar v
385 freeVars (Lit lit) = (noFVs, AnnLit lit)
386 freeVars (Lam b body)
387 = (b `delBinderFV` freeVarsOf body', AnnLam b body')
389 body' = freeVars body
391 freeVars (App fun arg)
392 = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
397 freeVars (Case scrut bndr ty alts)
398 = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
399 AnnCase scrut2 bndr ty alts2)
401 scrut2 = freeVars scrut
403 (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
404 alts_fvs = foldr1 unionFVs alts_fvs_s
406 fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
411 freeVars (Let (NonRec binder rhs) body)
412 = (freeVarsOf rhs2 `unionFVs` body_fvs `unionFVs` idRuleVars binder,
413 -- Remember any rules; cf rhs_fvs above
414 AnnLet (AnnNonRec binder rhs2) body2)
417 body2 = freeVars body
418 body_fvs = binder `delBinderFV` freeVarsOf body2
420 freeVars (Let (Rec binds) body)
421 = (delBindersFV binders all_fvs,
422 AnnLet (AnnRec (binders `zip` rhss2)) body2)
424 (binders, rhss) = unzip binds
426 rhss2 = map freeVars rhss
427 rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
428 all_fvs = foldr (unionFVs . idRuleVars) rhs_body_fvs binders
429 -- The "delBinderFV" happens after adding the idSpecVars,
430 -- since the latter may add some of the binders as fvs
432 body2 = freeVars body
433 body_fvs = freeVarsOf body2
436 freeVars (Cast expr co)
437 = (freeVarsOf expr2 `unionFVs` cfvs, AnnCast expr2 co)
439 expr2 = freeVars expr
440 cfvs = tyVarsOfType co
442 freeVars (Note other_note expr)
443 = (freeVarsOf expr2, AnnNote other_note expr2)
445 expr2 = freeVars expr
447 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)