X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=2ee5ea5622bfaa220c9a7fda0520b2d552734046;hp=4bb00cf2c9071e9a5a411896320fa50665d1d82b;hb=65277a1c9ff86c28c656849d6f6cbb392f1eb3e7;hpb=0c090fc451916dc3f2edb4b2f0053a6fdcea5554

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index 4bb00cf..2ee5ea5 100644
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -11,7 +11,7 @@ module VarEnv (
 	-- ** Manipulating these environments
 	emptyVarEnv, unitVarEnv, mkVarEnv,
 	elemVarEnv, varEnvElts, varEnvKeys,
-	extendVarEnv, extendVarEnv_C, extendVarEnvList,
+	extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
 	plusVarEnv, plusVarEnv_C,
 	delVarEnvList, delVarEnv,
 	lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
@@ -19,7 +19,7 @@ module VarEnv (
 	modifyVarEnv, modifyVarEnv_Directly,
 	isEmptyVarEnv, foldVarEnv, 
 	elemVarEnvByKey, lookupVarEnv_Directly,
-	filterVarEnv_Directly,
+	filterVarEnv_Directly, restrictVarEnv,
 
 	-- * The InScopeSet type
 	InScopeSet, 
@@ -27,7 +27,6 @@ module VarEnv (
 	-- ** Operations on InScopeSets
 	emptyInScopeSet, mkInScopeSet, delInScopeSet,
 	extendInScopeSet, extendInScopeSetList, extendInScopeSetSet, 
-	modifyInScopeSet,
 	getInScopeVars, lookupInScope, elemInScopeSet, uniqAway, 
 
 	-- * The RnEnv2 type
@@ -66,7 +65,18 @@ import FastString
 \begin{code}
 -- | A set of variables that are in scope at some point
 data InScopeSet = InScope (VarEnv Var) FastInt
-	-- The Int# is a kind of hash-value used by uniqAway
+	-- The (VarEnv Var) is just a VarSet.  But we write it like
+	-- this to remind ourselves that you can look up a Var in 
+	-- the InScopeSet. Typically the InScopeSet contains the
+	-- canonical version of the variable (e.g. with an informative
+	-- unfolding), so this lookup is useful.
+	--
+	-- INVARIANT: the VarEnv maps (the Unique of) a variable to 
+	--	      a variable with the same Uniqua.  (This was not
+	--	      the case in the past, when we had a grevious hack
+	--	      mapping var1 to var2.	
+	-- 
+	-- The FastInt is a kind of hash-value used by uniqAway
 	-- For example, it might be the size of the set
 	-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
 
@@ -94,37 +104,16 @@ extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
 extendInScopeSetSet (InScope in_scope n) vs
    = InScope (in_scope `plusVarEnv` vs) (n +# iUnbox (sizeUFM vs))
 
--- | Replace the first 'Var' with the second in the set of in-scope variables
-modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
--- Exploit the fact that the in-scope "set" is really a map
--- 	Make old_v map to new_v
--- QUESTION: shouldn't we add a mapping from new_v to new_v as it is presumably now in scope? - MB 08
-modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# _ILIT(1))
-
 delInScopeSet :: InScopeSet -> Var -> InScopeSet
 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
 
 elemInScopeSet :: Var -> InScopeSet -> Bool
 elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
 
--- | If the given variable was even added to the 'InScopeSet', or if it was the \"from\" argument
--- of any 'modifyInScopeSet' operation, returns that variable with all appropriate modifications
--- applied to it. Otherwise, return @Nothing@
+-- | Look up a variable the 'InScopeSet'.  This lets you map from 
+-- the variable's identity (unique) to its full value.
 lookupInScope :: InScopeSet -> Var -> Maybe Var
--- It's important to look for a fixed point
--- When we see (case x of y { I# v -> ... })
--- we add  [x -> y] to the in-scope set (Simplify.simplCaseBinder and
--- modifyInScopeSet).
---
--- When we lookup up an occurrence of x, we map to y, but then
--- we want to look up y in case it has acquired more evaluation information by now.
-lookupInScope (InScope in_scope _) v 
-  = go v
-  where
-    go v = case lookupVarEnv in_scope v of
-		Just v' | v == v'   -> Just v'	-- Reached a fixed point
-			| otherwise -> go v'
-		Nothing		    -> Nothing
+lookupInScope (InScope in_scope _) v  = lookupVarEnv in_scope v
 \end{code}
 
 \begin{code}
@@ -327,11 +316,13 @@ zipVarEnv	  :: [Var] -> [a] -> VarEnv a
 unitVarEnv	  :: Var -> a -> VarEnv a
 extendVarEnv	  :: VarEnv a -> Var -> a -> VarEnv a
 extendVarEnv_C	  :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
+extendVarEnv_Acc  :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
 plusVarEnv	  :: VarEnv a -> VarEnv a -> VarEnv a
 extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 		  
 lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
 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
 plusVarEnv_C	  :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
@@ -354,6 +345,7 @@ elemVarEnv       = elemUFM
 elemVarEnvByKey  = elemUFM_Directly
 extendVarEnv	 = addToUFM
 extendVarEnv_C	 = addToUFM_C
+extendVarEnv_Acc = addToUFM_Acc
 extendVarEnvList = addListToUFM
 plusVarEnv_C	 = plusUFM_C
 delVarEnvList	 = delListFromUFM
@@ -372,6 +364,10 @@ foldVarEnv	 = foldUFM
 lookupVarEnv_Directly = lookupUFM_Directly
 filterVarEnv_Directly = filterUFM_Directly
 
+restrictVarEnv env vs = filterVarEnv_Directly keep env
+  where
+    keep u _ = u `elemVarSetByKey` vs
+    
 zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
 lookupVarEnv_NF env id = case lookupVarEnv env id of
                          Just xx -> xx