\begin{code}
module VarEnv (
+ -- * Var, Id and TyVar environments (maps)
VarEnv, IdEnv, TyVarEnv,
+
+ -- ** 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,
modifyVarEnv, modifyVarEnv_Directly,
isEmptyVarEnv, foldVarEnv,
elemVarEnvByKey, lookupVarEnv_Directly,
- filterVarEnv_Directly,
+ filterVarEnv_Directly, restrictVarEnv,
- -- InScopeSet
- InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
+ -- * The InScopeSet type
+ InScopeSet,
+
+ -- ** Operations on InScopeSets
+ emptyInScopeSet, mkInScopeSet, delInScopeSet,
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, rnInScopeSet, lookupRnInScope,
-
- -- TidyEnvs
- TidyEnv, emptyTidyEnv
+ -- * The RnEnv2 type
+ RnEnv2,
+
+ -- ** Operations on RnEnv2s
+ mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
+ rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
+ rnInScope, rnInScopeSet, lookupRnInScope,
+
+ -- * TidyEnv and its operation
+ 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}
%************************************************************************
\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
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
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
-modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
-
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
+-- | 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).
--- 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
- = 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}
+-- | @uniqAway in_scope v@ finds a unique that is not used in the
+-- in-scope set, and gives that to v.
uniqAway :: InScopeSet -> Var -> Var
--- (uniqAway in_scope v) finds a unique that is not used in the
--- in-scope set, and gives that to v. It starts with v's current unique, of course,
--- in the hope that it won't have to change it, and thereafter uses a combination
--- of that and the hash-code found in the in-scope set
+-- It starts with v's current unique, of course, in the hope that it won't
+-- have to change, and thereafter uses a combination of that and the hash-code
+-- found in the in-scope set
uniqAway in_scope var
| var `elemInScopeSet` in_scope = uniqAway' in_scope var -- Make a new one
| otherwise = var -- Nothing to do
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))
\end{code}
-
%************************************************************************
%* *
Dual renaming
%* *
%************************************************************************
-When we are comparing (or matching) types or terms, we are faced with
-"going under" corresponding binders. E.g. when comparing
- \x. e1 ~ \y. e2
-
-Basically we want to rename [x->y] or [y->x], but there are lots of
-things we must be careful of. In particular, x might be free in e2, or
-y in e1. So the idea is that we come up with a fresh binder that is free
-in neither, and rename x and y respectively. That means we must maintain
- a) a renaming for the left-hand expression
- b) a renaming for the right-hand expressions
- c) an in-scope set
-
-Furthermore, when matching, we want to be able to have an 'occurs check',
-to prevent
- \x. f ~ \y. y
-matching with f->y. So for each expression we want to know that set of
-locally-bound variables. That is precisely the domain of the mappings (a)
-and (b), but we must ensure that we always extend the mappings as we go in.
-
-
\begin{code}
-data RnEnv2
+-- | When we are comparing (or matching) types or terms, we are faced with
+-- \"going under\" corresponding binders. E.g. when comparing:
+--
+-- > \x. e1 ~ \y. e2
+--
+-- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
+-- things we must be careful of. In particular, @x@ might be free in @e2@, or
+-- y in @e1@. So the idea is that we come up with a fresh binder that is free
+-- in neither, and rename @x@ and @y@ respectively. That means we must maintain:
+--
+-- 1. A renaming for the left-hand expression
+--
+-- 2. A renaming for the right-hand expressions
+--
+-- 3. An in-scope set
+--
+-- Furthermore, when matching, we want to be able to have an 'occurs check',
+-- to prevent:
+--
+-- > \x. f ~ \y. y
+--
+-- matching with [@f@ -> @y@]. So for each expression we want to know that set of
+-- locally-bound variables. That is precisely the domain of the mappings 1.
+-- and 2., but we must ensure that we always extend the mappings as we go in.
+--
+-- All of this information is bundled up in the 'RnEnv2'
+data RnEnv2
= RV2 { envL :: VarEnv Var -- Renaming for Left term
, envR :: VarEnv Var -- Renaming for Right term
, in_scope :: InScopeSet } -- In scope in left or right terms
rnInScopeSet = in_scope
rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
--- Arg lists must be of equal length
+-- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
--- (rnBndr2 env bL bR) go under a binder bL in the Left term 1,
--- and binder bR in the Right term
--- It finds a new binder, new_b,
--- and returns an environment mapping bL->new_b and bR->new_b resp.
+-- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
+-- and binder @bR@ in the Right term.
+-- It finds a new binder, @new_b@,
+-- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
= RV2 { envL = extendVarEnv envL bL new_b -- See Note
, envR = extendVarEnv envR bR new_b -- [Rebinding]
-- Inside \x \y { [x->y], [y->y], {y} }
-- \x \z { [x->x], [y->y, z->x], {y,x} }
-rnBndrL, rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
--- Used when there's a binder on one side or the other only
--- Useful when eta-expanding
---
+rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used when there's a binder on the left
+-- side only. Useful when eta-expanding
rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
= (RV2 { envL = extendVarEnv envL bL new_b
, envR = extendVarEnv envR new_b new_b -- Note [rnBndrLR]
where
new_b = uniqAway in_scope bL
+rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used when there's a binder on the right
+-- side only. Useful when eta-expanding
rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
= (RV2 { envL = extendVarEnv envL new_b new_b -- Note [rnBndrLR]
, envR = extendVarEnv envR bR new_b
-- succeeding with [x -> v y], which is bogus of course
rnOccL, rnOccR :: RnEnv2 -> Var -> Var
--- Look up the renaming of an occurrence in the left or right term
+-- ^ Look up the renaming of an occurrence in the left or right term
rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
--- Tells whether a variable is locally bound
+-- ^ Tells whether a variable is locally bound
inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
+-- ^ Wipe the left or right side renaming
nukeRnEnvL env = env { envL = emptyVarEnv }
nukeRnEnvR env = env { envR = emptyVarEnv }
\end{code}
%* *
%************************************************************************
-When tidying up print names, we keep a mapping of in-scope occ-names
-(the TidyOccEnv) and a Var-to-Var of the current renamings.
-
\begin{code}
+-- | When tidying up print names, we keep a mapping of in-scope occ-names
+-- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
type TidyEnv = (TidyOccEnv, VarEnv Var)
emptyTidyEnv :: TidyEnv
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
elemVarEnvByKey = elemUFM_Directly
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
+extendVarEnv_Acc = addToUFM_Acc
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
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 }
+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,
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
projects / ghc-hetmet.git / blobdiff