module VarEnv (
VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,
emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
elemVarEnv, varEnvElts, varEnvKeys, varEnvToList,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
extendVarEnvList,
plusVarEnv, plusVarEnv_C, plusVarEnv_CD, alterVarEnv,
delVarEnvList, delVarEnv, delVarEnv_Directly,
minusVarEnv, intersectsVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
mapVarEnv, zipVarEnv,
modifyVarEnv, modifyVarEnv_Directly,
isEmptyVarEnv, foldVarEnv, foldVarEnv_Directly,
elemVarEnvByKey, lookupVarEnv_Directly,
filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
partitionVarEnv,
DVarEnv, DIdEnv, DTyVarEnv,
emptyDVarEnv,
dVarEnvElts,
extendDVarEnv, extendDVarEnv_C,
lookupDVarEnv,
isEmptyDVarEnv, foldDVarEnv,
mapDVarEnv,
modifyDVarEnv,
alterDVarEnv,
plusDVarEnv_C,
unitDVarEnv,
delDVarEnv,
delDVarEnvList,
partitionDVarEnv,
anyDVarEnv,
InScopeSet,
emptyInScopeSet, mkInScopeSet, delInScopeSet,
extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
getInScopeVars, lookupInScope, lookupInScope_Directly,
unionInScope, elemInScopeSet, uniqAway,
varSetInScope,
RnEnv2,
mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,
rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,
delBndrL, delBndrR, delBndrsL, delBndrsR,
addRnInScopeSet,
rnEtaL, rnEtaR,
rnInScope, rnInScopeSet, lookupRnInScope,
rnEnvL, rnEnvR,
TidyEnv,
emptyTidyEnv
) where
import OccName
import Var
import VarSet
import UniqFM
import UniqDFM
import Unique
import Util
import Maybes
import Outputable
import StaticFlags
data InScopeSet = InScope (VarEnv Var) !Int
instance Outputable InScopeSet where
ppr (InScope s _) = text "InScope" <+> ppr s
emptyInScopeSet :: InScopeSet
emptyInScopeSet = InScope emptyVarSet 1
getInScopeVars :: InScopeSet -> VarEnv Var
getInScopeVars (InScope vs _) = vs
mkInScopeSet :: VarEnv Var -> InScopeSet
mkInScopeSet in_scope = InScope in_scope 1
extendInScopeSet :: InScopeSet -> Var -> InScopeSet
extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n + 1)
extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
extendInScopeSetList (InScope in_scope n) vs
= InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
(n + length vs)
extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
extendInScopeSetSet (InScope in_scope n) vs
= InScope (in_scope `plusVarEnv` vs) (n + sizeUFM vs)
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
lookupInScope :: InScopeSet -> Var -> Maybe Var
lookupInScope (InScope in_scope _) v = lookupVarEnv in_scope v
lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
lookupInScope_Directly (InScope in_scope _) uniq
= lookupVarEnv_Directly in_scope uniq
unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
unionInScope (InScope s1 _) (InScope s2 n2)
= InScope (s1 `plusVarEnv` s2) n2
varSetInScope :: VarSet -> InScopeSet -> Bool
varSetInScope vars (InScope s1 _) = vars `subVarSet` s1
uniqAway :: InScopeSet -> Var -> Var
uniqAway in_scope var
| var `elemInScopeSet` in_scope = uniqAway' in_scope var
| otherwise = var
uniqAway' :: InScopeSet -> Var -> Var
uniqAway' (InScope set n) var
= try 1
where
orig_unique = getUnique var
try k
| debugIsOn && (k > 1000)
= pprPanic "uniqAway loop:" (ppr k <+> text "tries" <+> ppr var <+> int n)
| uniq `elemVarSetByKey` set = try (k + 1)
| debugIsOn && opt_PprStyle_Debug && (k > 3)
= pprTrace "uniqAway:" (ppr k <+> text "tries" <+> ppr var <+> int n)
setVarUnique var uniq
| otherwise = setVarUnique var uniq
where
uniq = deriveUnique orig_unique (n * k)
data RnEnv2
= RV2 { envL :: VarEnv Var
, envR :: VarEnv Var
, in_scope :: InScopeSet }
mkRnEnv2 :: InScopeSet -> RnEnv2
mkRnEnv2 vars = RV2 { envL = emptyVarEnv
, envR = emptyVarEnv
, in_scope = vars }
addRnInScopeSet :: RnEnv2 -> VarEnv Var -> RnEnv2
addRnInScopeSet env vs
| isEmptyVarEnv vs = env
| otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }
rnInScope :: Var -> RnEnv2 -> Bool
rnInScope x env = x `elemInScopeSet` in_scope env
rnInScopeSet :: RnEnv2 -> InScopeSet
rnInScopeSet = in_scope
rnEnvL :: RnEnv2 -> VarEnv Var
rnEnvL = envL
rnEnvR :: RnEnv2 -> VarEnv Var
rnEnvR = envR
rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR
rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)
rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
= (RV2 { envL = extendVarEnv envL bL new_b
, envR = extendVarEnv envR bR new_b
, in_scope = extendInScopeSet in_scope new_b }, new_b)
where
new_b | not (bL `elemInScopeSet` in_scope) = bL
| not (bR `elemInScopeSet` in_scope) = bR
| otherwise = uniqAway' in_scope bL
rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
= (RV2 { envL = extendVarEnv envL bL new_b
, envR = envR
, in_scope = extendInScopeSet in_scope new_b }, new_b)
where
new_b = uniqAway in_scope bL
rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
= (RV2 { envR = extendVarEnv envR bR new_b
, envL = envL
, in_scope = extendInScopeSet in_scope new_b }, new_b)
where
new_b = uniqAway in_scope bR
rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
= (RV2 { envL = extendVarEnv envL bL new_b
, envR = extendVarEnv envR new_b new_b
, in_scope = extendInScopeSet in_scope new_b }, new_b)
where
new_b = uniqAway in_scope bL
rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
= (RV2 { envL = extendVarEnv envL new_b new_b
, envR = extendVarEnv envR bR new_b
, in_scope = extendInScopeSet in_scope new_b }, new_b)
where
new_b = uniqAway in_scope bR
delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
= rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
= rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
= rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
= rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
rnOccL, rnOccR :: RnEnv2 -> Var -> Var
rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
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 }
rnSwap :: RnEnv2 -> RnEnv2
rnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })
= RV2 { envL = envR, envR = envL, in_scope = in_scope }
type TidyEnv = (TidyOccEnv, VarEnv Var)
emptyTidyEnv :: TidyEnv
emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
type VarEnv elt = UniqFM elt
type IdEnv elt = VarEnv elt
type TyVarEnv elt = VarEnv elt
type TyCoVarEnv elt = VarEnv elt
type CoVarEnv elt = VarEnv elt
emptyVarEnv :: VarEnv a
mkVarEnv :: [(Var, a)] -> VarEnv a
mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a
zipVarEnv :: [Var] -> [a] -> VarEnv a
unitVarEnv :: Var -> a -> VarEnv a
alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> 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
extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a
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
delVarEnv_Directly :: VarEnv a -> Unique -> VarEnv a
partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
delVarEnv :: VarEnv a -> Var -> VarEnv a
minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a
intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
varEnvElts :: VarEnv a -> [a]
varEnvKeys :: VarEnv a -> [Unique]
varEnvToList :: VarEnv a -> [(Unique, a)]
isEmptyVarEnv :: VarEnv a -> Bool
lookupVarEnv :: VarEnv a -> Var -> Maybe a
filterVarEnv :: (a -> Bool) -> VarEnv a -> VarEnv a
lookupVarEnv_NF :: VarEnv a -> Var -> a
lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
elemVarEnv :: Var -> VarEnv a -> Bool
elemVarEnvByKey :: Unique -> VarEnv a -> Bool
foldVarEnv :: (a -> b -> b) -> b -> VarEnv a -> b
foldVarEnv_Directly :: (Unique -> a -> b -> b) -> b -> VarEnv a -> b
elemVarEnv = elemUFM
elemVarEnvByKey = elemUFM_Directly
alterVarEnv = alterUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnv_Acc = addToUFM_Acc
extendVarEnv_Directly = addToUFM_Directly
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
plusVarEnv_CD = plusUFM_CD
delVarEnvList = delListFromUFM
delVarEnv = delFromUFM
minusVarEnv = minusUFM
intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
plusVarEnv = plusUFM
lookupVarEnv = lookupUFM
filterVarEnv = filterUFM
lookupWithDefaultVarEnv = lookupWithDefaultUFM
mapVarEnv = mapUFM
mkVarEnv = listToUFM
mkVarEnv_Directly= listToUFM_Directly
emptyVarEnv = emptyUFM
varEnvElts = eltsUFM
varEnvKeys = keysUFM
varEnvToList = ufmToList
unitVarEnv = unitUFM
isEmptyVarEnv = isNullUFM
foldVarEnv = foldUFM
foldVarEnv_Directly = foldUFM_Directly
lookupVarEnv_Directly = lookupUFM_Directly
filterVarEnv_Directly = filterUFM_Directly
delVarEnv_Directly = delFromUFM_Directly
partitionVarEnv = partitionUFM
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
Nothing -> panic "lookupVarEnv_NF: Nothing"
modifyVarEnv mangle_fn env key
= case (lookupVarEnv env key) of
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
Just xx -> addToUFM_Directly env key (mangle_fn xx)
type DVarEnv elt = UniqDFM elt
type DIdEnv elt = DVarEnv elt
type DTyVarEnv elt = DVarEnv elt
emptyDVarEnv :: DVarEnv a
emptyDVarEnv = emptyUDFM
dVarEnvElts :: DVarEnv a -> [a]
dVarEnvElts = eltsUDFM
extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
extendDVarEnv = addToUDFM
lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
lookupDVarEnv = lookupUDFM
foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
foldDVarEnv = foldUDFM
mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
mapDVarEnv = mapUDFM
alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
alterDVarEnv = alterUDFM
plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a
plusDVarEnv_C = plusUDFM_C
unitDVarEnv :: Var -> a -> DVarEnv a
unitDVarEnv = unitUDFM
delDVarEnv :: DVarEnv a -> Var -> DVarEnv a
delDVarEnv = delFromUDFM
delDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a
delDVarEnvList = delListFromUDFM
isEmptyDVarEnv :: DVarEnv a -> Bool
isEmptyDVarEnv = isNullUDFM
extendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a
extendDVarEnv_C = addToUDFM_C
modifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a
modifyDVarEnv mangle_fn env key
= case (lookupDVarEnv env key) of
Nothing -> env
Just xx -> extendDVarEnv env key (mangle_fn xx)
partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)
partitionDVarEnv = partitionUDFM
anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
anyDVarEnv = anyUDFM