X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=3c9f53ae04a9c7f29a8fa9bfe9e125c8f8f5037f;hp=da2f96088bbdceef5bfbcd9638cf2c64a5cca7c6;hb=49c98d143c382a1341e1046f5ca00819a25691ba;hpb=7656f8c4bd8d786bf83c1ab2dca0cdd1a903e5bf

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index da2f960..3c9f53a 100644
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -1,7 +1,7 @@
-
+%
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section{@VarEnvs@: Variable environments}
 
 \begin{code}
 module VarEnv (
@@ -20,14 +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, extendRnInScopeList,
-		rnInScope,
+		rnInScope, lookupRnInScope,
 
 	-- TidyEnvs
 	TidyEnv, emptyTidyEnv
@@ -35,14 +36,14 @@ module VarEnv (
 
 #include "HsVersions.h"
 
-import OccName	  ( TidyOccEnv, emptyTidyOccEnv )
-import Var	  ( Var, setVarUnique )
+import OccName
+import Var
 import VarSet
 import UniqFM  
-import Unique	  ( Unique, deriveUnique, getUnique )
-import Util	  ( zipEqual, foldl2 )
-import Maybes	  ( orElse )
-import StaticFlags( opt_PprStyle_Debug )
+import Unique
+import Util
+import Maybes
+import StaticFlags
 import Outputable
 import FastTypes
 \end{code}
@@ -80,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
@@ -247,6 +252,9 @@ inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
 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 }
 nukeRnEnvR env = env { envR = emptyVarEnv }