X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=e59c800c1ea710aeb780ae2a2b3f85c0b88e8528;hp=bfeecdc923d41925ff3e2d69d12a03f558339913;hb=9da4639011348fb6c318e3cba4b08622f811d9c4;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index bfeecdc..e59c800 100644
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -20,13 +20,15 @@ module VarEnv (
 
 	-- InScopeSet
 	InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
-	extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
+	extendInScopeSet, extendInScopeSetList, extendInScopeSetSet, 
+	modifyInScopeSet,
 	getInScopeVars, lookupInScope, elemInScopeSet, uniqAway, 
 	mapInScopeSet,
 
 	-- RnEnv2 and its operations
 	RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
-		rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
+		rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
+		rnInScope, lookupRnInScope,
 
 	-- TidyEnvs
 	TidyEnv, emptyTidyEnv
@@ -40,7 +42,7 @@ import VarSet
 import UniqFM  
 import Unique	  ( Unique, deriveUnique, getUnique )
 import Util	  ( zipEqual, foldl2 )
-import Maybes	  ( orElse, isJust )
+import Maybes	  ( orElse )
 import StaticFlags( opt_PprStyle_Debug )
 import Outputable
 import FastTypes
@@ -79,6 +81,10 @@ extendInScopeSetList (InScope in_scope n) vs
    = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
 		    (n +# iUnbox (length vs))
 
+extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
+extendInScopeSetSet (InScope in_scope n) vs
+   = InScope (in_scope `plusVarEnv` vs) (n +# iUnbox (sizeUFM vs))
+
 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
 -- Exploit the fact that the in-scope "set" is really a map
 -- 	Make old_v map to new_v
@@ -183,6 +189,13 @@ 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 }
+
+rnInScope :: Var -> RnEnv2 -> Bool
+rnInScope x env = x `elemInScopeSet` in_scope env
+
 rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
 -- Arg lists must be of equal length
 rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR 
@@ -236,8 +249,11 @@ rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
 
 inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
 -- Tells whether a variable is locally bound
-inRnEnvL (RV2 { envL = env }) v = isJust (lookupVarEnv env v)
-inRnEnvR (RV2 { envR = env }) v = isJust (lookupVarEnv env v)
+inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
+inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
+
+lookupRnInScope :: RnEnv2 -> Var -> Var
+lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
 
 nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
 nukeRnEnvL env = env { envL = emptyVarEnv }