put coqPassCoreToCore on the CoreM monad, greatly simplify Desugar.lhs

[ghc-hetmet.git] / compiler / basicTypes / VarEnv.lhs

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index 5a08707..fca6256 100644 (file)
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module VarEnv (
         -- * Var, Id and TyVar environments (maps)
-       VarEnv, IdEnv, TyVarEnv,
+       VarEnv, IdEnv, TyVarEnv, CoVarEnv,
        
        -- ** Manipulating these environments
        emptyVarEnv, unitVarEnv, mkVarEnv,
@@ -14,6 +14,7 @@ module VarEnv (
        extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
        plusVarEnv, plusVarEnv_C,
        delVarEnvList, delVarEnv,
+        minusVarEnv, intersectsVarEnv,
        lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
        mapVarEnv, zipVarEnv,
        modifyVarEnv, modifyVarEnv_Directly,
@@ -28,14 +29,15 @@ module VarEnv (
        emptyInScopeSet, mkInScopeSet, delInScopeSet,
        extendInScopeSet, extendInScopeSetList, extendInScopeSetSet, 
        getInScopeVars, lookupInScope, lookupInScope_Directly, 
-        elemInScopeSet, uniqAway, 
+        unionInScope, elemInScopeSet, uniqAway,
 
        -- * The RnEnv2 type
        RnEnv2, 
        
        -- ** Operations on RnEnv2s
        mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
-       rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
+        rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
+        addRnInScopeSet,
         rnEtaL, rnEtaR,
        rnInScope, rnInScopeSet, lookupRnInScope,
 
@@ -120,6 +122,10 @@ lookupInScope (InScope in_scope _) v  = lookupVarEnv in_scope v
 lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
 lookupInScope_Directly (InScope in_scope _) uniq
   = lookupVarEnv_Directly in_scope uniq
+
+unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
+unionInScope (InScope s1 _) (InScope s2 n2)
+  = InScope (s1 `plusVarEnv` s2) n2
 \end{code}
 
 \begin{code}
@@ -199,9 +205,10 @@ mkRnEnv2 vars = RV2        { envL     = emptyVarEnv
                        , envR     = emptyVarEnv
                        , in_scope = vars }
 
-extendRnInScopeList :: RnEnv2 -> [Var] -> RnEnv2
-extendRnInScopeList env vs
-  = env { in_scope = extendInScopeSetList (in_scope env) vs }
+addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
+addRnInScopeSet env vs
+  | isEmptyVarEnv vs = env
+  | otherwise        = env { in_scope = extendInScopeSetSet (in_scope env) vs }
 
 rnInScope :: Var -> RnEnv2 -> Bool
 rnInScope x env = x `elemInScopeSet` in_scope env
@@ -336,6 +343,7 @@ emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
 type VarEnv elt   = UniqFM elt
 type IdEnv elt    = VarEnv elt
 type TyVarEnv elt = VarEnv elt
+type CoVarEnv elt = VarEnv elt
 
 emptyVarEnv      :: VarEnv a
 mkVarEnv         :: [(Var, a)] -> VarEnv a
@@ -352,6 +360,8 @@ filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
 restrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a
 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 delVarEnv        :: VarEnv a -> Var -> VarEnv a
+minusVarEnv       :: VarEnv a -> VarEnv a -> VarEnv a
+intersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool
 plusVarEnv_C     :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 mapVarEnv        :: (a -> b) -> VarEnv a -> VarEnv b
 modifyVarEnv     :: (a -> a) -> VarEnv a -> Var -> VarEnv a
@@ -377,6 +387,8 @@ extendVarEnvList = addListToUFM
 plusVarEnv_C    = plusUFM_C
 delVarEnvList   = delListFromUFM
 delVarEnv       = delFromUFM
+minusVarEnv      = minusUFM
+intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
 plusVarEnv      = plusUFM
 lookupVarEnv    = lookupUFM
 lookupWithDefaultVarEnv = lookupWithDefaultUFM