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
15 -- | A module concerned with finding the free variables of an expression.
17 -- * Free variables of expressions and binding groups
18 exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
19 exprFreeIds, -- CoreExpr -> IdSet -- Find all locally-defined free Ids
20 exprsFreeVars, -- [CoreExpr] -> VarSet
21 bindFreeVars, -- CoreBind -> VarSet
23 -- * Selective free variables of expressions
25 exprSomeFreeVars, exprsSomeFreeVars,
26 exprFreeNames, exprsFreeNames,
28 -- * Free variables of Rules, Vars and Ids
29 idRuleVars, idRuleRhsVars, idFreeVars, idInlineFreeVars,
31 ruleRhsFreeVars, rulesFreeVars,
32 ruleLhsFreeNames, ruleLhsFreeIds,
34 -- * Core syntax tree annotation with free variables
35 CoreExprWithFVs, -- = AnnExpr Id VarSet
36 CoreBindWithFVs, -- = AnnBind Id VarSet
37 freeVars, -- CoreExpr -> CoreExprWithFVs
38 freeVarsOf -- CoreExprWithFVs -> IdSet
41 #include "HsVersions.h"
57 %************************************************************************
59 \section{Finding the free variables of an expression}
61 %************************************************************************
63 This function simply finds the free variables of an expression.
64 So far as type variables are concerned, it only finds tyvars that are
66 * free in type arguments,
67 * free in the type of a binder,
69 but not those that are free in the type of variable occurrence.
72 -- | Find all locally-defined free Ids or type variables in an expression
73 exprFreeVars :: CoreExpr -> VarSet
74 exprFreeVars = exprSomeFreeVars isLocalVar
76 -- | Find all locally-defined free Ids in an expression
77 exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids
78 exprFreeIds = exprSomeFreeVars isLocalId
80 -- | Find all locally-defined free Ids or type variables in several expressions
81 exprsFreeVars :: [CoreExpr] -> VarSet
82 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
84 -- | Find all locally defined free Ids in a binding group
85 bindFreeVars :: CoreBind -> VarSet
86 bindFreeVars (NonRec _ r) = exprFreeVars r
87 bindFreeVars (Rec prs) = addBndrs (map fst prs)
88 (foldr (union . rhs_fvs) noVars prs)
89 isLocalVar emptyVarSet
91 -- | Finds free variables in an expression selected by a predicate
92 exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting
95 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
97 -- | Finds free variables in several expressions selected by a predicate
98 exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting
101 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
103 -- | Predicate on possible free variables: returns @True@ iff the variable is interesting
104 type InterestingVarFun = Var -> Bool
109 type FV = InterestingVarFun
110 -> VarSet -- In scope
111 -> VarSet -- Free vars
113 union :: FV -> FV -> FV
114 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
117 noVars _ _ = emptyVarSet
119 -- Comment about obselete code
120 -- We used to gather the free variables the RULES at a variable occurrence
121 -- with the following cryptic comment:
122 -- "At a variable occurrence, add in any free variables of its rule rhss
123 -- Curiously, we gather the Id's free *type* variables from its binding
124 -- site, but its free *rule-rhs* variables from its usage sites. This
125 -- is a little weird. The reason is that the former is more efficient,
126 -- but the latter is more fine grained, and a makes a difference when
127 -- a variable mentions itself one of its own rule RHSs"
128 -- Not only is this "weird", but it's also pretty bad because it can make
129 -- a function seem more recursive than it is. Suppose
132 -- RULE g x = ...f...
133 -- Then f is not mentioned in its own RHS, and needn't be a loop breaker
134 -- (though g may be). But if we collect the rule fvs from g's occurrence,
135 -- it looks as if f mentions itself. (This bites in the eftInt/eftIntFB
136 -- code in GHC.Enum.)
138 -- Anyway, it seems plain wrong. The RULE is like an extra RHS for the
139 -- function, so its free variables belong at the definition site.
141 -- Deleted code looked like
142 -- foldVarSet add_rule_var var_itself_set (idRuleVars var)
143 -- add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
148 oneVar var fv_cand in_scope
150 if keep_it fv_cand in_scope var
154 someVars :: VarSet -> FV
155 someVars vars fv_cand in_scope
156 = filterVarSet (keep_it fv_cand in_scope) vars
158 keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
159 keep_it fv_cand in_scope var
160 | var `elemVarSet` in_scope = False
165 addBndr :: CoreBndr -> FV -> FV
166 addBndr bndr fv fv_cand in_scope
167 = someVars (varTypeTyVars bndr) fv_cand in_scope
168 -- Include type varibles in the binder's type
169 -- (not just Ids; coercion variables too!)
170 `unionVarSet` fv fv_cand (in_scope `extendVarSet` bndr)
172 addBndrs :: [CoreBndr] -> FV -> FV
173 addBndrs bndrs fv = foldr addBndr fv bndrs
178 expr_fvs :: CoreExpr -> FV
180 expr_fvs (Type ty) = someVars (tyVarsOfType ty)
181 expr_fvs (Var var) = oneVar var
182 expr_fvs (Lit _) = noVars
183 expr_fvs (Note _ expr) = expr_fvs expr
184 expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
185 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
186 expr_fvs (Cast expr co) = expr_fvs expr `union` someVars (tyVarsOfType co)
188 expr_fvs (Case scrut bndr ty alts)
189 = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
190 (foldr (union . alt_fvs) noVars alts)
192 alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
194 expr_fvs (Let (NonRec bndr rhs) body)
195 = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
197 expr_fvs (Let (Rec pairs) body)
198 = addBndrs (map fst pairs)
199 (foldr (union . rhs_fvs) (expr_fvs body) pairs)
202 rhs_fvs :: (Id,CoreExpr) -> FV
203 rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (bndrRuleVars bndr)
204 -- Treat any RULES as extra RHSs of the binding
207 exprs_fvs :: [CoreExpr] -> FV
208 exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
212 %************************************************************************
216 %************************************************************************
219 -- | Similar to 'exprFreeNames'. However, this is used when deciding whether
220 -- a rule is an orphan. In particular, suppose that T is defined in this
221 -- module; we want to avoid declaring that a rule like:
223 -- > fromIntegral T = fromIntegral_T
225 -- is an orphan. Of course it isn't, and declaring it an orphan would
226 -- make the whole module an orphan module, which is bad.
227 ruleLhsFreeNames :: CoreRule -> NameSet
228 ruleLhsFreeNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
229 ruleLhsFreeNames (Rule { ru_fn = fn, ru_args = tpl_args })
230 = addOneToNameSet (exprsFreeNames tpl_args) fn
232 -- | Finds the free /external/ names of an expression, notably
233 -- including the names of type constructors (which of course do not show
234 -- up in 'exprFreeVars').
235 exprFreeNames :: CoreExpr -> NameSet
236 -- There's no need to delete local binders, because they will all
237 -- be /internal/ names.
242 | isExternalName n = unitNameSet n
243 | otherwise = emptyNameSet
245 go (Lit _) = emptyNameSet
246 go (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
247 go (App e1 e2) = go e1 `unionNameSets` go e2
248 go (Lam v e) = go e `delFromNameSet` idName v
250 go (Cast e co) = go e `unionNameSets` tyClsNamesOfType co
251 go (Let (NonRec _ r) e) = go e `unionNameSets` go r
252 go (Let (Rec prs) e) = exprsFreeNames (map snd prs) `unionNameSets` go e
253 go (Case e _ ty as) = go e `unionNameSets` tyClsNamesOfType ty
254 `unionNameSets` unionManyNameSets (map go_alt as)
256 go_alt (_,_,r) = go r
258 -- | Finds the free /external/ names of several expressions: see 'exprFreeNames' for details
259 exprsFreeNames :: [CoreExpr] -> NameSet
260 exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
263 %************************************************************************
265 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
267 %************************************************************************
270 -- | Those variables free in the right hand side of a rule
271 ruleRhsFreeVars :: CoreRule -> VarSet
272 ruleRhsFreeVars (BuiltinRule {}) = noFVs
273 ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
274 = delFromUFM fvs fn -- Note [Rule free var hack]
276 fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
278 -- | Those variables free in the both the left right hand sides of a rule
279 ruleFreeVars :: CoreRule -> VarSet
280 ruleFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args })
281 = delFromUFM fvs fn -- Note [Rule free var hack]
283 fvs = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet
285 -- | Those variables free in the right hand side of several rules
286 rulesFreeVars :: [CoreRule] -> VarSet
287 rulesFreeVars rules = foldr (unionVarSet . ruleFreeVars) emptyVarSet rules
289 ruleLhsFreeIds :: CoreRule -> VarSet
290 -- ^ This finds all locally-defined free Ids on the left hand side of a rule
291 ruleLhsFreeIds (BuiltinRule {}) = noFVs
292 ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
293 = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
296 Note [Rule free var hack]
297 ~~~~~~~~~~~~~~~~~~~~~~~~~
298 Don't include the Id in its own rhs free-var set.
299 Otherwise the occurrence analyser makes bindings recursive
300 that shoudn't be. E.g.
301 RULE: f (f x y) z ==> f x (f y z)
303 Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM.
305 %************************************************************************
307 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
309 %************************************************************************
311 The free variable pass annotates every node in the expression with its
312 NON-GLOBAL free variables and type variables.
315 -- | Every node in a binding group annotated with its
316 -- (non-global) free variables, both Ids and TyVars
317 type CoreBindWithFVs = AnnBind Id VarSet
318 -- | Every node in an expression annotated with its
319 -- (non-global) free variables, both Ids and TyVars
320 type CoreExprWithFVs = AnnExpr Id VarSet
322 freeVarsOf :: CoreExprWithFVs -> IdSet
323 -- ^ Inverse function to 'freeVars'
324 freeVarsOf (free_vars, _) = free_vars
329 aFreeVar :: Var -> VarSet
330 aFreeVar = unitVarSet
332 unionFVs :: VarSet -> VarSet -> VarSet
333 unionFVs = unionVarSet
335 delBindersFV :: [Var] -> VarSet -> VarSet
336 delBindersFV bs fvs = foldr delBinderFV fvs bs
338 delBinderFV :: Var -> VarSet -> VarSet
339 -- This way round, so we can do it multiple times using foldr
341 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
343 -- (a) the free variables of b's type
344 -- (b) the idSpecVars of b
346 -- This is really important for some lambdas:
347 -- In (\x::a -> x) the only mention of "a" is in the binder.
350 -- let x::a = b in ...
351 -- we should really note that "a" is free in this expression.
352 -- It'll be pinned inside the /\a by the binding for b, but
353 -- it seems cleaner to make sure that a is in the free-var set
354 -- when it is mentioned.
356 -- This also shows up in recursive bindings. Consider:
357 -- /\a -> letrec x::a = x in E
358 -- Now, there are no explicit free type variables in the RHS of x,
359 -- but nevertheless "a" is free in its definition. So we add in
360 -- the free tyvars of the types of the binders, and include these in the
361 -- free vars of the group, attached to the top level of each RHS.
363 -- This actually happened in the defn of errorIO in IOBase.lhs:
364 -- errorIO (ST io) = case (errorIO# io) of
367 -- bottom = bottom -- Never evaluated
369 delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
370 -- Include coercion variables too!
372 varTypeTyVars :: Var -> TyVarSet
373 -- Find the type variables free in the type of the variable
374 -- Remember, coercion variables can mention type variables...
376 | isLocalId var || isCoVar var = tyVarsOfType (idType var)
377 | otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
379 idFreeVars :: Id -> VarSet
380 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` varTypeTyVars id
382 bndrRuleVars ::Var -> VarSet
383 bndrRuleVars v | isTyVar v = emptyVarSet
384 | otherwise = idRuleVars v
386 idRuleVars ::Id -> VarSet
387 idRuleVars id = ASSERT( isId id)
388 specInfoFreeVars (idSpecialisation id) `unionVarSet`
389 idInlineFreeVars id -- And the variables in an INLINE rule
391 idRuleRhsVars :: Id -> VarSet
392 -- Just the variables free on the *rhs* of a rule
393 -- See Note [Choosing loop breakers] in Simplify.lhs
394 idRuleRhsVars id = foldr (unionVarSet . ruleRhsFreeVars)
395 (idInlineFreeVars id)
398 idInlineFreeVars :: Id -> VarSet
399 -- Produce free vars for an InlineRule, BUT NOT for an ordinary unfolding
400 -- An InlineRule behaves *very like* a RULE, and that is what we are after here
402 = case idUnfolding id of
403 InlineRule { uf_tmpl = tmpl } -> exprFreeVars tmpl
408 %************************************************************************
410 \subsection{Free variables (and types)}
412 %************************************************************************
415 freeVars :: CoreExpr -> CoreExprWithFVs
416 -- ^ Annotate a 'CoreExpr' with its (non-global) free type and value variables at every tree node
420 -- ToDo: insert motivating example for why we *need*
421 -- to include the idSpecVars in the FV list.
422 -- Actually [June 98] I don't think it's necessary
423 -- fvs = fvs_v `unionVarSet` idSpecVars v
425 fvs | isLocalVar v = aFreeVar v
428 freeVars (Lit lit) = (noFVs, AnnLit lit)
429 freeVars (Lam b body)
430 = (b `delBinderFV` freeVarsOf body', AnnLam b body')
432 body' = freeVars body
434 freeVars (App fun arg)
435 = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
440 freeVars (Case scrut bndr ty alts)
441 = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
442 AnnCase scrut2 bndr ty alts2)
444 scrut2 = freeVars scrut
446 (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
447 alts_fvs = foldr1 unionFVs alts_fvs_s
449 fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
454 freeVars (Let (NonRec binder rhs) body)
455 = (freeVarsOf rhs2 `unionFVs` body_fvs `unionFVs` bndrRuleVars binder,
456 -- Remember any rules; cf rhs_fvs above
457 AnnLet (AnnNonRec binder rhs2) body2)
460 body2 = freeVars body
461 body_fvs = binder `delBinderFV` freeVarsOf body2
463 freeVars (Let (Rec binds) body)
464 = (delBindersFV binders all_fvs,
465 AnnLet (AnnRec (binders `zip` rhss2)) body2)
467 (binders, rhss) = unzip binds
469 rhss2 = map freeVars rhss
470 rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
471 all_fvs = foldr (unionFVs . idRuleVars) rhs_body_fvs binders
472 -- The "delBinderFV" happens after adding the idSpecVars,
473 -- since the latter may add some of the binders as fvs
475 body2 = freeVars body
476 body_fvs = freeVarsOf body2
479 freeVars (Cast expr co)
480 = (freeVarsOf expr2 `unionFVs` cfvs, AnnCast expr2 co)
482 expr2 = freeVars expr
483 cfvs = tyVarsOfType co
485 freeVars (Note other_note expr)
486 = (freeVarsOf expr2, AnnNote other_note expr2)
488 expr2 = freeVars expr
490 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)