exprSomeFreeVars, exprsSomeFreeVars,
idRuleVars, idFreeVars, idFreeTyVars,
- ruleSomeFreeVars, ruleRhsFreeVars,
- ruleLhsFreeNames, ruleLhsFreeIds,
+ ruleRhsFreeVars, ruleLhsFreeNames, ruleLhsFreeIds,
CoreExprWithFVs, -- = AnnExpr Id VarSet
CoreBindWithFVs, -- = AnnBind Id VarSet
import VarSet
import Var ( Var, isId, isLocalVar, varName )
import Type ( tyVarsOfType )
-import TcType ( namesOfType )
+import TcType ( tyClsNamesOfType )
import Util ( mapAndUnzip )
import Outputable
\end{code}
expr_fvs (App fun arg) = expr_fvs fun `union` expr_fvs arg
expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
-expr_fvs (Case scrut bndr alts)
- = expr_fvs scrut `union` addBndr bndr (foldr (union . alt_fvs) noVars alts)
+-- gaw 2004
+expr_fvs (Case scrut bndr ty alts)
+ = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
+ (foldr (union . alt_fvs) noVars alts)
where
alt_fvs (con, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
exprFreeNames finds the free *names* of an expression, notably
including the names of type constructors (which of course do not show
up in exprFreeVars). Similarly ruleLhsFreeNames. The latter is used
-when deciding whethera rule is an orphan. In particular, suppose that
+when deciding whether a rule is an orphan. In particular, suppose that
T is defined in this module; we want to avoid declaring that a rule like
fromIntegral T = fromIntegral_T
is an orphan. Of course it isn't, an declaring it an orphan would
\begin{code}
ruleLhsFreeNames :: IdCoreRule -> NameSet
-ruleLhsFreeNames (fn, BuiltinRule _ _) = unitNameSet (varName fn)
-ruleLhsFreeNames (fn, Rule _ _ tpl_vars tpl_args rhs)
+ruleLhsFreeNames (IdCoreRule fn _ (BuiltinRule _ _)) = unitNameSet (varName fn)
+ruleLhsFreeNames (IdCoreRule fn _ (Rule _ _ tpl_vars tpl_args rhs))
= addOneToNameSet (exprsFreeNames tpl_args `del_binders` tpl_vars) (varName fn)
exprFreeNames :: CoreExpr -> NameSet
-exprFreeNames (Var v) = unitNameSet (varName v)
-exprFreeNames (Lit _) = emptyNameSet
-exprFreeNames (Type ty) = namesOfType ty
+exprFreeNames (Var v) = unitNameSet (varName v)
+exprFreeNames (Lit _) = emptyNameSet
+exprFreeNames (Type ty) = tyClsNamesOfType ty -- Don't need free tyvars
exprFreeNames (App e1 e2) = exprFreeNames e1 `unionNameSets` exprFreeNames e2
exprFreeNames (Lam v e) = exprFreeNames e `delFromNameSet` varName v
exprFreeNames (Note n e) = exprFreeNames e
where
(bs, rs) = unzip prs
-exprFreeNames (Case e b as) = exprFreeNames e `unionNameSets`
- (unionManyNameSets (map altFreeNames as) `delFromNameSet` varName b)
+-- gaw 2004
+exprFreeNames (Case e b ty as) = exprFreeNames e `unionNameSets` tyClsNamesOfType ty
+ `unionNameSets`
+ (unionManyNameSets (map altFreeNames as) `delFromNameSet` varName b)
-- Helpers
altFreeNames (_,bs,r) = exprFreeNames r `del_binders` bs
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
- where
- rule_fvs = addBndrs tpl_vars $
- foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
-
ruleLhsFreeIds :: CoreRule -> VarSet
--- This finds all the free Ids on the LHS of the rule
--- *including* imported ids
+-- This finds all locally-defined free Ids on the LHS of the rule
ruleLhsFreeIds (BuiltinRule _ _) = noFVs
ruleLhsFreeIds (Rule _ _ tpl_vars tpl_args rhs)
- = foldl delVarSet (exprsSomeFreeVars isId tpl_args) tpl_vars
+ = foldl delVarSet (exprsFreeVars tpl_args) tpl_vars
\end{code}
fun2 = freeVars fun
arg2 = freeVars arg
-freeVars (Case scrut bndr alts)
- = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2,
- AnnCase scrut2 bndr alts2)
+freeVars (Case scrut bndr ty alts)
+-- gaw 2004
+ = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
+ AnnCase scrut2 bndr ty alts2)
where
scrut2 = freeVars scrut