X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FFreeVars.lhs;h=979fd670f3f25ba1b2323e140e0a294b636039c7;hb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;hp=8879ffeaf19bcee3d5d51fd68e4e595e788f26a1;hpb=0596517a9b4b2b32e5d375a986351102ac4540fc;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/FreeVars.lhs b/ghc/compiler/coreSyn/FreeVars.lhs
index 8879ffe..979fd67 100644
--- a/ghc/compiler/coreSyn/FreeVars.lhs
+++ b/ghc/compiler/coreSyn/FreeVars.lhs
@@ -13,32 +13,32 @@ module FreeVars (
 	addTopBindsFVs,
 
 	freeVarsOf, freeTyVarsOf,
-	FVCoreExpr(..), FVCoreBinding(..),
+	SYN_IE(FVCoreExpr), SYN_IE(FVCoreBinding),
 
-	CoreExprWithFVs(..),		-- For the above functions
-	AnnCoreExpr(..),		-- Dito
+	SYN_IE(CoreExprWithFVs),		-- For the above functions
+	SYN_IE(AnnCoreExpr),		-- Dito
 	FVInfo(..), LeakInfo(..)
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import AnnCoreSyn	-- output
 
 import CoreSyn
 import Id		( idType, getIdArity, isBottomingId,
-			  emptyIdSet, singletonIdSet, mkIdSet,
+			  emptyIdSet, unitIdSet, mkIdSet,
 			  elementOfIdSet, minusIdSet, unionManyIdSets,
-			  IdSet(..)
+			  SYN_IE(IdSet)
 			)
 import IdInfo		( arityMaybe )
 import PrimOp		( PrimOp(..) )
 import Type		( tyVarsOfType )
-import TyVar		( emptyTyVarSet, singletonTyVarSet, minusTyVarSet,
+import TyVar		( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
 			  intersectTyVarSets,
-			  TyVarSet(..)
+			  SYN_IE(TyVarSet)
 			)
 import UniqSet		( unionUniqSets )
-import Usage		( UVar(..) )
+import Usage		( SYN_IE(UVar) )
 import Util		( panic, assertPanic )
 \end{code}
 
@@ -74,8 +74,8 @@ data FVInfo
 noFreeIds      = emptyIdSet
 noFreeTyVars   = emptyTyVarSet
 noFreeAnything = (noFreeIds, noFreeTyVars)
-aFreeId i      = singletonIdSet i
-aFreeTyVar t   = singletonTyVarSet t
+aFreeId i      = unitIdSet i
+aFreeTyVar t   = unitTyVarSet t
 is_among       = elementOfIdSet
 munge_id_ty  i = tyVarsOfType (idType i)
 combine	       = unionUniqSets -- used both for {Id,TyVar}Sets
@@ -171,13 +171,13 @@ fvExpr id_cands tyvar_cands (Lam (UsageBinder uvar) body)
   = panic "fvExpr:Lam UsageBinder"
 
 fvExpr id_cands tyvar_cands (Lam b@(ValBinder binder) body)
-  = (FVInfo (freeVarsOf body2   `minusIdSet` singletonIdSet binder)
+  = (FVInfo (freeVarsOf body2   `minusIdSet` unitIdSet binder)
 	    (freeTyVarsOf body2 `combine`    munge_id_ty binder)
 	    leakiness,
      AnnLam b body2)
   where
 	-- We need to collect free tyvars from the binders
-    body2 = fvExpr (singletonIdSet binder `combine` id_cands) tyvar_cands body
+    body2 = fvExpr (unitIdSet binder `combine` id_cands) tyvar_cands body
 
     leakiness = case leakinessOf body2 of
 		  MightLeak  -> LeakFree 1
@@ -295,6 +295,15 @@ fvExpr id_cands tyvar_cands (SCC label expr)
   = (fvinfo, AnnSCC label expr2)
   where
     expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
+
+fvExpr id_cands tyvar_cands (Coerce c ty expr)
+  = (FVInfo (freeVarsOf   expr2)
+	    (freeTyVarsOf expr2 `combine` tfvs)
+	    (leakinessOf  expr2),
+     AnnCoerce c ty expr2)
+  where
+    expr2 = fvExpr id_cands tyvar_cands expr
+    tfvs  = freeTy tyvar_cands ty
 \end{code}
 
 \begin{code}
@@ -412,7 +421,7 @@ addExprFVs fv_cand in_scope (Lam binder body)
 	  TyBinder    t -> (TyBinder t, emptyIdSet)
 	  UsageBinder u -> (UsageBinder u, emptyIdSet)
           ValBinder   b -> (ValBinder (b, lam_fvs),
-			    singletonIdSet b)
+			    unitIdSet b)
 
     new_in_scope	 = in_scope `combine` binder_set
     (new_body, body_fvs) = addExprFVs fv_cand new_in_scope body
@@ -477,6 +486,11 @@ addExprFVs fv_cand in_scope (SCC label expr)
   = (SCC label expr2, expr_fvs)
   where
     (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
+
+addExprFVs fv_cand in_scope (Coerce c ty expr)
+  = (Coerce c ty expr2, expr_fvs)
+  where
+    (expr2, expr_fvs) = addExprFVs fv_cand in_scope expr
 \end{code}
 
 \begin{code}