X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=8274661be61b55e05aee3cee1e9d1fce704ebbfe;hb=4fc2ca8222ca4625132ad5acf3afeb8293e42a46;hp=e7afbeb55a700d97f8a91b7e42aee6ccdaa849d6;hpb=2d6b7ac600c277aa65a972d7767e2254bd2397ed;p=ghc-hetmet.git diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs index e7afbeb..8274661 100644 --- a/compiler/basicTypes/VarEnv.lhs +++ b/compiler/basicTypes/VarEnv.lhs @@ -34,18 +34,17 @@ module VarEnv ( TidyEnv, emptyTidyEnv ) where -#include "HsVersions.h" - import OccName import Var import VarSet -import UniqFM +import UniqFM import Unique import Util import Maybes -import StaticFlags import Outputable import FastTypes +import StaticFlags +import FastString \end{code} @@ -62,19 +61,19 @@ 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 1# +emptyInScopeSet = InScope emptyVarSet (_ILIT(1)) getInScopeVars :: InScopeSet -> VarEnv Var getInScopeVars (InScope vs _) = vs mkInScopeSet :: VarEnv Var -> InScopeSet -mkInScopeSet in_scope = InScope in_scope 1# +mkInScopeSet in_scope = InScope in_scope (_ILIT(1)) extendInScopeSet :: InScopeSet -> Var -> InScopeSet -extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#) +extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# _ILIT(1)) extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet extendInScopeSetList (InScope in_scope n) vs @@ -88,7 +87,7 @@ extendInScopeSetSet (InScope in_scope n) 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 -modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#) +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 @@ -97,7 +96,7 @@ 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 @@ -105,7 +104,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 @@ -127,20 +126,16 @@ uniqAway in_scope var uniqAway' :: InScopeSet -> Var -> Var -- This one *always* makes up a new variable uniqAway' (InScope set n) var - = try 1# + = try (_ILIT(1)) where orig_unique = getUnique var try k -#ifdef DEBUG - | k ># 1000# + | debugIsOn && (k ># _ILIT(1000)) = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) -#endif - | uniq `elemVarSetByKey` set = try (k +# 1#) -#ifdef DEBUG - | opt_PprStyle_Debug && k ># 3# + | uniq `elemVarSetByKey` set = try (k +# _ILIT(1)) + | 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)) @@ -356,7 +351,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, @@ -368,6 +365,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