X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreFVs.lhs;h=9d66e5073d05d0c36971118863e2bfe71d7b72f7;hb=715184e20183fbdc71383cbc0b1e07598c91b165;hp=1f647009ef80fb78d4c7846429a22a47ddb07f5b;hpb=17d765ce13bf28d9b79672a567d7faf28c822c76;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreFVs.lhs b/ghc/compiler/coreSyn/CoreFVs.lhs
index 1f64700..9d66e50 100644
--- a/ghc/compiler/coreSyn/CoreFVs.lhs
+++ b/ghc/compiler/coreSyn/CoreFVs.lhs
@@ -11,8 +11,7 @@ module CoreFVs (
 	exprSomeFreeVars, exprsSomeFreeVars,
 
 	idRuleVars, idFreeVars, idFreeTyVars,
-	ruleSomeFreeVars, ruleRhsFreeVars,
-	ruleLhsFreeNames, ruleLhsFreeIds, 
+	ruleRhsFreeVars, ruleLhsFreeNames, ruleLhsFreeIds, 
 
 	CoreExprWithFVs,	-- = AnnExpr Id VarSet
 	CoreBindWithFVs,	-- = AnnBind Id VarSet
@@ -27,7 +26,8 @@ import Id		( Id, idType, idSpecialisation )
 import NameSet
 import VarSet
 import Var		( Var, isId, isLocalVar, varName )
-import Type		( tyVarsOfType, namesOfType )
+import Type		( tyVarsOfType )
+import TcType		( tyClsNamesOfType )
 import Util		( mapAndUnzip )
 import Outputable
 \end{code}
@@ -159,14 +159,14 @@ make the whole module an orphan module, which is bad.
 
 \begin{code}
 ruleLhsFreeNames :: IdCoreRule -> NameSet
-ruleLhsFreeNames (fn, BuiltinRule _) = unitNameSet (varName fn)
-ruleLhsFreeNames (fn, Rule _ tpl_vars tpl_args rhs)
+ruleLhsFreeNames (fn, BuiltinRule _ _) = unitNameSet (varName fn)
+ruleLhsFreeNames (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
@@ -199,30 +199,18 @@ del_binders names bndrs = foldl (\s b -> delFromNameSet s (varName b)) names bnd
 
 
 \begin{code}
-rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
-rulesSomeFreeVars interesting (Rules rules _)
-  = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
-
 ruleRhsFreeVars :: CoreRule -> VarSet
-ruleRhsFreeVars (BuiltinRule _) = noFVs
-ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
+ruleRhsFreeVars (BuiltinRule _ _) = noFVs
+ruleRhsFreeVars (Rule str _ tpl_vars tpl_args rhs)
   = rule_fvs isLocalVar emptyVarSet
   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
-ruleLhsFreeIds (BuiltinRule _) = noFVs
-ruleLhsFreeIds (Rule _ tpl_vars tpl_args rhs)
+ruleLhsFreeIds (BuiltinRule _ _) = noFVs
+ruleLhsFreeIds (Rule _ _ tpl_vars tpl_args rhs)
   = foldl delVarSet (exprsSomeFreeVars isId tpl_args) tpl_vars
 \end{code}