X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=4c31b24f09218144418782fce9e2d83df30ba241;hb=7df9b88b9e0565f438f16d8005526ffda80a1dbe;hp=3b0be0bebf4ae922f2de87e7b5a17876f8955841;hpb=1370a4a360ec154b390c1da21d40e446739b24c8;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index 3b0be0b..4c31b24 100644
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -4,13 +4,6 @@
 %
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module VarEnv (
 	VarEnv, IdEnv, TyVarEnv,
 	emptyVarEnv, unitVarEnv, mkVarEnv,
@@ -30,7 +23,6 @@ module VarEnv (
 	extendInScopeSet, extendInScopeSetList, extendInScopeSetSet, 
 	modifyInScopeSet,
 	getInScopeVars, lookupInScope, elemInScopeSet, uniqAway, 
-	mapInScopeSet,
 
 	-- RnEnv2 and its operations
 	RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
@@ -41,8 +33,6 @@ module VarEnv (
 	TidyEnv, emptyTidyEnv
     ) where
 
-#include "HsVersions.h"
-
 import OccName
 import Var
 import VarSet
@@ -50,9 +40,10 @@ import UniqFM
 import Unique
 import Util
 import Maybes
-import StaticFlags
 import Outputable
 import FastTypes
+import StaticFlags
+import FastString
 \end{code}
 
 
@@ -69,7 +60,7 @@ data InScopeSet = InScope (VarEnv Var) FastInt
 	-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
 
 instance Outputable InScopeSet where
-  ppr (InScope s i) = ptext SLIT("InScope") <+> ppr s
+  ppr (InScope s _) = ptext (sLit "InScope") <+> ppr s
 
 emptyInScopeSet :: InScopeSet
 emptyInScopeSet = InScope emptyVarSet (_ILIT(1))
@@ -100,11 +91,8 @@ modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_sco
 delInScopeSet :: InScopeSet -> Var -> InScopeSet
 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
 
-mapInScopeSet :: (Var -> Var) -> InScopeSet -> InScopeSet
-mapInScopeSet f (InScope in_scope n) = InScope (mapVarEnv f in_scope) n
-
 elemInScopeSet :: Var -> InScopeSet -> Bool
-elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
+elemInScopeSet v (InScope in_scope _) = v `elemVarEnv` in_scope
 
 lookupInScope :: InScopeSet -> Var -> Maybe Var
 -- It's important to look for a fixed point
@@ -112,7 +100,7 @@ lookupInScope :: InScopeSet -> Var -> Maybe Var
 -- we add  [x -> y] to the in-scope set (Simplify.simplCaseBinder).
 -- 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 n) v 
+lookupInScope (InScope in_scope _) v 
   = go v
   where
     go v = case lookupVarEnv in_scope v of
@@ -138,16 +126,12 @@ uniqAway' (InScope set n) var
   where
     orig_unique = getUnique var
     try k 
-#ifdef DEBUG
-	  | k ># _ILIT(1000)
+	  | debugIsOn && (k ># _ILIT(1000))
 	  = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) 
-#endif			    
 	  | uniq `elemVarSetByKey` set = try (k +# _ILIT(1))
-#ifdef DEBUG
-	  | opt_PprStyle_Debug && k ># _ILIT(3)
+	  | debugIsOn && opt_PprStyle_Debug && (k ># _ILIT(3))
 	  = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) 
 	    setVarUnique var uniq
-#endif			    
 	  | otherwise = setVarUnique var uniq
 	  where
 	    uniq = deriveUnique orig_unique (iBox (n *# k))
@@ -363,7 +347,9 @@ lookupVarEnv_Directly = lookupUFM_Directly
 filterVarEnv_Directly = filterUFM_Directly
 
 zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
-lookupVarEnv_NF env id = case (lookupVarEnv env id) of { Just xx -> xx }
+lookupVarEnv_NF env id = case lookupVarEnv env id of
+                         Just xx -> xx
+                         Nothing -> panic "lookupVarEnv_NF: Nothing"
 \end{code}
 
 @modifyVarEnv@: Look up a thing in the VarEnv, 
@@ -375,6 +361,7 @@ modifyVarEnv mangle_fn env key
       Nothing -> env
       Just xx -> extendVarEnv env key (mangle_fn xx)
 
+modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
 modifyVarEnv_Directly mangle_fn env key
   = case (lookupUFM_Directly env key) of
       Nothing -> env