[project @ 1996-07-25 20:43:49 by partain]

[ghc-hetmet.git] / ghc / compiler / coreSyn / FreeVars.lhs

diff --git a/ghc/compiler/coreSyn/FreeVars.lhs b/ghc/compiler/coreSyn/FreeVars.lhs
index 8879ffe..979fd67 100644 (file)
--- 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}