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,
27 -- * Free variables of Rules, Vars and Ids
28 varTypeTyVars, varTypeTcTyVars,
29 idUnfoldingVars, idFreeVars, idRuleAndUnfoldingVars,
30 idRuleVars, idRuleRhsVars, stableUnfoldingVars,
31 ruleRhsFreeVars, rulesFreeVars,
32 ruleLhsOrphNames, ruleLhsFreeIds,
35 -- * Core syntax tree annotation with free variables
36 CoreExprWithFVs, -- = AnnExpr Id VarSet
37 CoreBindWithFVs, -- = AnnBind Id VarSet
38 freeVars, -- CoreExpr -> CoreExprWithFVs
39 freeVarsOf -- CoreExprWithFVs -> IdSet
42 #include "HsVersions.h"
55 import BasicTypes( Activation )
60 %************************************************************************
62 \section{Finding the free variables of an expression}
64 %************************************************************************
66 This function simply finds the free variables of an expression.
67 So far as type variables are concerned, it only finds tyvars that are
69 * free in type arguments,
70 * free in the type of a binder,
72 but not those that are free in the type of variable occurrence.
75 -- | Find all locally-defined free Ids or type variables in an expression
76 exprFreeVars :: CoreExpr -> VarSet
77 exprFreeVars = exprSomeFreeVars isLocalVar
79 -- | Find all locally-defined free Ids in an expression
80 exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids
81 exprFreeIds = exprSomeFreeVars isLocalId
83 -- | Find all locally-defined free Ids or type variables in several expressions
84 exprsFreeVars :: [CoreExpr] -> VarSet
85 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
87 -- | Find all locally defined free Ids in a binding group
88 bindFreeVars :: CoreBind -> VarSet
89 bindFreeVars (NonRec _ r) = exprFreeVars r
90 bindFreeVars (Rec prs) = addBndrs (map fst prs)
91 (foldr (union . rhs_fvs) noVars prs)
92 isLocalVar emptyVarSet
94 -- | Finds free variables in an expression selected by a predicate
95 exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting
98 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
100 -- | Finds free variables in several expressions selected by a predicate
101 exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting
104 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
106 -- | Predicate on possible free variables: returns @True@ iff the variable is interesting
107 type InterestingVarFun = Var -> Bool
112 type FV = InterestingVarFun
113 -> VarSet -- In scope
114 -> VarSet -- Free vars
116 union :: FV -> FV -> FV
117 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
120 noVars _ _ = emptyVarSet
122 -- Comment about obselete code
123 -- We used to gather the free variables the RULES at a variable occurrence
124 -- with the following cryptic comment:
125 -- "At a variable occurrence, add in any free variables of its rule rhss
126 -- Curiously, we gather the Id's free *type* variables from its binding
127 -- site, but its free *rule-rhs* variables from its usage sites. This
128 -- is a little weird. The reason is that the former is more efficient,
129 -- but the latter is more fine grained, and a makes a difference when
130 -- a variable mentions itself one of its own rule RHSs"
131 -- Not only is this "weird", but it's also pretty bad because it can make
132 -- a function seem more recursive than it is. Suppose
135 -- RULE g x = ...f...
136 -- Then f is not mentioned in its own RHS, and needn't be a loop breaker
137 -- (though g may be). But if we collect the rule fvs from g's occurrence,
138 -- it looks as if f mentions itself. (This bites in the eftInt/eftIntFB
139 -- code in GHC.Enum.)
141 -- Anyway, it seems plain wrong. The RULE is like an extra RHS for the
142 -- function, so its free variables belong at the definition site.
144 -- Deleted code looked like
145 -- foldVarSet add_rule_var var_itself_set (idRuleVars var)
146 -- add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
151 oneVar var fv_cand in_scope
153 if keep_it fv_cand in_scope var
157 someVars :: VarSet -> FV
158 someVars vars fv_cand in_scope
159 = filterVarSet (keep_it fv_cand in_scope) vars
161 keep_it :: InterestingVarFun -> VarSet -> Var -> Bool
162 keep_it fv_cand in_scope var
163 | var `elemVarSet` in_scope = False
168 addBndr :: CoreBndr -> FV -> FV
169 addBndr bndr fv fv_cand in_scope
170 = someVars (varTypeTyVars bndr) fv_cand in_scope
171 -- Include type varibles in the binder's type
172 -- (not just Ids; coercion variables too!)
173 `unionVarSet` fv fv_cand (in_scope `extendVarSet` bndr)
175 addBndrs :: [CoreBndr] -> FV -> FV
176 addBndrs bndrs fv = foldr addBndr fv bndrs
181 expr_fvs :: CoreExpr -> FV
183 expr_fvs (Type ty) = someVars (tyVarsOfType ty)
184 expr_fvs (Coercion co) = someVars (tyCoVarsOfCo co)
185 expr_fvs (Var var) = oneVar var
186 expr_fvs (Lit _) = noVars
187 expr_fvs (Note _ expr) = expr_fvs expr
188 expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
189 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
190 expr_fvs (Cast expr co) = expr_fvs expr `union` someVars (tyCoVarsOfCo co)
192 expr_fvs (Case scrut bndr ty alts)
193 = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
194 (foldr (union . alt_fvs) noVars alts)
196 alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
198 expr_fvs (Let (NonRec bndr rhs) body)
199 = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
201 expr_fvs (Let (Rec pairs) body)
202 = addBndrs (map fst pairs)
203 (foldr (union . rhs_fvs) (expr_fvs body) pairs)
206 rhs_fvs :: (Id,CoreExpr) -> FV
207 rhs_fvs (bndr, rhs) = expr_fvs rhs `union`
208 someVars (bndrRuleAndUnfoldingVars bndr)
209 -- Treat any RULES as extra RHSs of the binding
212 exprs_fvs :: [CoreExpr] -> FV
213 exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
217 %************************************************************************
221 %************************************************************************
224 -- | ruleLhsOrphNames is used when deciding whether
225 -- a rule is an orphan. In particular, suppose that T is defined in this
226 -- module; we want to avoid declaring that a rule like:
228 -- > fromIntegral T = fromIntegral_T
230 -- is an orphan. Of course it isn't, and declaring it an orphan would
231 -- make the whole module an orphan module, which is bad.
232 ruleLhsOrphNames :: CoreRule -> NameSet
233 ruleLhsOrphNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
234 ruleLhsOrphNames (Rule { ru_fn = fn, ru_args = tpl_args })
235 = addOneToNameSet (exprsOrphNames tpl_args) fn
236 -- No need to delete bndrs, because
237 -- exprsOrphNames finds only External names
239 -- | Finds the free /external/ names of an expression, notably
240 -- including the names of type constructors (which of course do not show
241 -- up in 'exprFreeVars').
242 exprOrphNames :: CoreExpr -> NameSet
243 -- There's no need to delete local binders, because they will all
244 -- be /internal/ names.
249 | isExternalName n = unitNameSet n
250 | otherwise = emptyNameSet
252 go (Lit _) = emptyNameSet
253 go (Type ty) = orphNamesOfType ty -- Don't need free tyvars
254 go (Coercion co) = orphNamesOfCo co
255 go (App e1 e2) = go e1 `unionNameSets` go e2
256 go (Lam v e) = go e `delFromNameSet` idName v
258 go (Cast e co) = go e `unionNameSets` orphNamesOfCo co
259 go (Let (NonRec _ r) e) = go e `unionNameSets` go r
260 go (Let (Rec prs) e) = exprsOrphNames (map snd prs) `unionNameSets` go e
261 go (Case e _ ty as) = go e `unionNameSets` orphNamesOfType ty
262 `unionNameSets` unionManyNameSets (map go_alt as)
264 go_alt (_,_,r) = go r
266 -- | Finds the free /external/ names of several expressions: see 'exprOrphNames' for details
267 exprsOrphNames :: [CoreExpr] -> NameSet
268 exprsOrphNames es = foldr (unionNameSets . exprOrphNames) emptyNameSet es
271 %************************************************************************
273 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
275 %************************************************************************
278 -- | Those variables free in the right hand side of a rule
279 ruleRhsFreeVars :: CoreRule -> VarSet
280 ruleRhsFreeVars (BuiltinRule {}) = noFVs
281 ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
282 = delFromUFM fvs fn -- Note [Rule free var hack]
284 fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
286 -- | Those variables free in the both the left right hand sides of a rule
287 ruleFreeVars :: CoreRule -> VarSet
288 ruleFreeVars (BuiltinRule {}) = noFVs
289 ruleFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args })
290 = delFromUFM fvs fn -- Note [Rule free var hack]
292 fvs = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet
294 idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
295 -- Just the variables free on the *rhs* of a rule
296 idRuleRhsVars is_active id
297 = foldr (unionVarSet . get_fvs) emptyVarSet (idCoreRules id)
299 get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs
300 , ru_rhs = rhs, ru_act = act })
302 -- See Note [Finding rule RHS free vars] in OccAnal.lhs
303 = delFromUFM fvs fn -- Note [Rule free var hack]
305 fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
308 -- | Those variables free in the right hand side of several rules
309 rulesFreeVars :: [CoreRule] -> VarSet
310 rulesFreeVars rules = foldr (unionVarSet . ruleFreeVars) emptyVarSet rules
312 ruleLhsFreeIds :: CoreRule -> VarSet
313 -- ^ This finds all locally-defined free Ids on the left hand side of a rule
314 ruleLhsFreeIds (BuiltinRule {}) = noFVs
315 ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
316 = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
320 Note [Rule free var hack]
321 ~~~~~~~~~~~~~~~~~~~~~~~~~
322 Don't include the Id in its own rhs free-var set.
323 Otherwise the occurrence analyser makes bindings recursive
324 that shoudn't be. E.g.
325 RULE: f (f x y) z ==> f x (f y z)
327 Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM.
331 -- |Free variables of a vectorisation declaration
332 vectsFreeVars :: [CoreVect] -> VarSet
333 vectsFreeVars = foldr (unionVarSet . vectFreeVars) emptyVarSet
335 vectFreeVars (Vect _ Nothing) = noFVs
336 vectFreeVars (Vect _ (Just rhs)) = expr_fvs rhs isLocalId emptyVarSet
340 %************************************************************************
342 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
344 %************************************************************************
346 The free variable pass annotates every node in the expression with its
347 NON-GLOBAL free variables and type variables.
350 -- | Every node in a binding group annotated with its
351 -- (non-global) free variables, both Ids and TyVars
352 type CoreBindWithFVs = AnnBind Id VarSet
353 -- | Every node in an expression annotated with its
354 -- (non-global) free variables, both Ids and TyVars
355 type CoreExprWithFVs = AnnExpr Id VarSet
357 freeVarsOf :: CoreExprWithFVs -> IdSet
358 -- ^ Inverse function to 'freeVars'
359 freeVarsOf (free_vars, _) = free_vars
364 aFreeVar :: Var -> VarSet
365 aFreeVar = unitVarSet
367 unionFVs :: VarSet -> VarSet -> VarSet
368 unionFVs = unionVarSet
370 delBindersFV :: [Var] -> VarSet -> VarSet
371 delBindersFV bs fvs = foldr delBinderFV fvs bs
373 delBinderFV :: Var -> VarSet -> VarSet
374 -- This way round, so we can do it multiple times using foldr
376 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
379 -- the free variables of b's type
381 -- This is really important for some lambdas:
382 -- In (\x::a -> x) the only mention of "a" is in the binder.
385 -- let x::a = b in ...
386 -- we should really note that "a" is free in this expression.
387 -- It'll be pinned inside the /\a by the binding for b, but
388 -- it seems cleaner to make sure that a is in the free-var set
389 -- when it is mentioned.
391 -- This also shows up in recursive bindings. Consider:
392 -- /\a -> letrec x::a = x in E
393 -- Now, there are no explicit free type variables in the RHS of x,
394 -- but nevertheless "a" is free in its definition. So we add in
395 -- the free tyvars of the types of the binders, and include these in the
396 -- free vars of the group, attached to the top level of each RHS.
398 -- This actually happened in the defn of errorIO in IOBase.lhs:
399 -- errorIO (ST io) = case (errorIO# io) of
402 -- bottom = bottom -- Never evaluated
404 delBinderFV b s = (s `delVarSet` b) `unionFVs` varTypeTyVars b
405 -- Include coercion variables too!
407 varTypeTyVars :: Var -> TyVarSet
408 -- Find the type variables free in the type of the variable
409 -- Remember, coercion variables can mention type variables...
411 | isLocalId var = tyVarsOfType (idType var)
412 | otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
414 varTypeTcTyVars :: Var -> TyVarSet
415 -- Find the type variables free in the type of the variable
416 -- Remember, coercion variables can mention type variables...
418 | isLocalId var = tcTyVarsOfType (idType var)
419 | otherwise = emptyVarSet -- Global Ids and non-coercion TyVars
421 idFreeVars :: Id -> VarSet
422 -- Type variables, rule variables, and inline variables
423 idFreeVars id = ASSERT( isId id)
424 varTypeTyVars id `unionVarSet`
425 idRuleAndUnfoldingVars id
427 bndrRuleAndUnfoldingVars ::Var -> VarSet
428 -- A 'let' can bind a type variable, and idRuleVars assumes
429 -- it's seeing an Id. This function tests first.
430 bndrRuleAndUnfoldingVars v | isTyVar v = emptyVarSet
431 | otherwise = idRuleAndUnfoldingVars v
433 idRuleAndUnfoldingVars :: Id -> VarSet
434 idRuleAndUnfoldingVars id = ASSERT( isId id)
435 idRuleVars id `unionVarSet`
438 idRuleVars ::Id -> VarSet -- Does *not* include CoreUnfolding vars
439 idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
441 idUnfoldingVars :: Id -> VarSet
442 -- Produce free vars for an unfolding, but NOT for an ordinary
443 -- (non-inline) unfolding, since it is a dup of the rhs
444 -- and we'll get exponential behaviour if we look at both unf and rhs!
445 -- But do look at the *real* unfolding, even for loop breakers, else
446 -- we might get out-of-scope variables
447 idUnfoldingVars id = stableUnfoldingVars (realIdUnfolding id)
449 stableUnfoldingVars :: Unfolding -> VarSet
450 stableUnfoldingVars (CoreUnfolding { uf_tmpl = rhs, uf_src = src })
451 | isStableSource src = exprFreeVars rhs
452 stableUnfoldingVars (DFunUnfolding _ _ args) = exprsFreeVars (dfunArgExprs args)
453 stableUnfoldingVars _ = emptyVarSet
457 %************************************************************************
459 \subsection{Free variables (and types)}
461 %************************************************************************
464 freeVars :: CoreExpr -> CoreExprWithFVs
465 -- ^ Annotate a 'CoreExpr' with its (non-global) free type and value variables at every tree node
469 -- ToDo: insert motivating example for why we *need*
470 -- to include the idSpecVars in the FV list.
471 -- Actually [June 98] I don't think it's necessary
472 -- fvs = fvs_v `unionVarSet` idSpecVars v
474 fvs | isLocalVar v = aFreeVar v
477 freeVars (Lit lit) = (noFVs, AnnLit lit)
478 freeVars (Lam b body)
479 = (b `delBinderFV` freeVarsOf body', AnnLam b body')
481 body' = freeVars body
483 freeVars (App fun arg)
484 = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
489 freeVars (Case scrut bndr ty alts)
490 = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
491 AnnCase scrut2 bndr ty alts2)
493 scrut2 = freeVars scrut
495 (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
496 alts_fvs = foldr1 unionFVs alts_fvs_s
498 fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
503 freeVars (Let (NonRec binder rhs) body)
506 `unionFVs` bndrRuleAndUnfoldingVars binder,
507 -- Remember any rules; cf rhs_fvs above
508 AnnLet (AnnNonRec binder rhs2) body2)
511 body2 = freeVars body
512 body_fvs = binder `delBinderFV` freeVarsOf body2
514 freeVars (Let (Rec binds) body)
515 = (delBindersFV binders all_fvs,
516 AnnLet (AnnRec (binders `zip` rhss2)) body2)
518 (binders, rhss) = unzip binds
520 rhss2 = map freeVars rhss
521 rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
522 all_fvs = foldr (unionFVs . idRuleAndUnfoldingVars) rhs_body_fvs binders
523 -- The "delBinderFV" happens after adding the idSpecVars,
524 -- since the latter may add some of the binders as fvs
526 body2 = freeVars body
527 body_fvs = freeVarsOf body2
529 freeVars (Cast expr co)
530 = (freeVarsOf expr2 `unionFVs` cfvs, AnnCast expr2 (cfvs, co))
532 expr2 = freeVars expr
533 cfvs = tyCoVarsOfCo co
535 freeVars (Note other_note expr)
536 = (freeVarsOf expr2, AnnNote other_note expr2)
538 expr2 = freeVars expr
540 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
542 freeVars (Coercion co) = (tyCoVarsOfCo co, AnnCoercion co)