module GHC.Types.Var.Env (
VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,
emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
elemVarEnv, disjointVarEnv,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc,
extendVarEnvList,
plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
plusVarEnvList, alterVarEnv,
delVarEnvList, delVarEnv,
minusVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
mapVarEnv, zipVarEnv,
modifyVarEnv, modifyVarEnv_Directly,
isEmptyVarEnv,
elemVarEnvByKey,
filterVarEnv, restrictVarEnv,
partitionVarEnv,
DVarEnv, DIdEnv, DTyVarEnv,
emptyDVarEnv, mkDVarEnv,
dVarEnvElts,
extendDVarEnv, extendDVarEnv_C,
extendDVarEnvList,
lookupDVarEnv, elemDVarEnv,
isEmptyDVarEnv, foldDVarEnv, nonDetStrictFoldDVarEnv,
mapDVarEnv, filterDVarEnv,
modifyDVarEnv,
alterDVarEnv,
plusDVarEnv, plusDVarEnv_C,
unitDVarEnv,
delDVarEnv,
delDVarEnvList,
minusDVarEnv,
partitionDVarEnv,
anyDVarEnv,
InScopeSet,
emptyInScopeSet, mkInScopeSet, delInScopeSet,
extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
getInScopeVars, lookupInScope, lookupInScope_Directly,
unionInScope, elemInScopeSet, uniqAway,
varSetInScope,
unsafeGetFreshLocalUnique,
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, mkEmptyTidyEnv, delTidyEnvList
) where
import GHC.Prelude
import qualified Data.IntMap.Strict as IntMap
import GHC.Types.Name.Occurrence
import GHC.Types.Name
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Data.Maybe
import GHC.Utils.Outputable
newtype InScopeSet = InScope VarSet
instance Outputable InScopeSet where
ppr (InScope s) =
text "InScope" <+>
braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))
emptyInScopeSet :: InScopeSet
emptyInScopeSet = InScope emptyVarSet
getInScopeVars :: InScopeSet -> VarSet
getInScopeVars (InScope vs) = vs
mkInScopeSet :: VarSet -> InScopeSet
mkInScopeSet in_scope = InScope in_scope
extendInScopeSet :: InScopeSet -> Var -> InScopeSet
extendInScopeSet (InScope in_scope) v
= InScope (extendVarSet in_scope v)
extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
extendInScopeSetList (InScope in_scope) vs
= InScope $ foldl' extendVarSet in_scope vs
extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet
extendInScopeSetSet (InScope in_scope) vs
= InScope (in_scope `unionVarSet` vs)
delInScopeSet :: InScopeSet -> Var -> InScopeSet
delInScopeSet (InScope in_scope) v = InScope (in_scope `delVarSet` v)
elemInScopeSet :: Var -> InScopeSet -> Bool
elemInScopeSet v (InScope in_scope) = v `elemVarSet` in_scope
lookupInScope :: InScopeSet -> Var -> Maybe Var
lookupInScope (InScope in_scope) v = lookupVarSet in_scope v
lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
lookupInScope_Directly (InScope in_scope) uniq
= lookupVarSet_Directly in_scope uniq
unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
unionInScope (InScope s1) (InScope s2)
= InScope (s1 `unionVarSet` s2)
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' in_scope var
= setVarUnique var (unsafeGetFreshLocalUnique in_scope)
unsafeGetFreshLocalUnique :: InScopeSet -> Unique
unsafeGetFreshLocalUnique (InScope set)
| Just (uniq,_) <- IntMap.lookupLT (getKey maxLocalUnique) (ufmToIntMap $ getUniqSet set)
, let uniq' = mkLocalUnique uniq
, not $ uniq' `ltUnique` minLocalUnique
= incrUnique uniq'
| otherwise
= minLocalUnique
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 -> VarSet -> RnEnv2
addRnInScopeSet env vs
| isEmptyVarSet 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)
mkEmptyTidyEnv :: TidyOccEnv -> TidyEnv
mkEmptyTidyEnv occ_env = (occ_env, emptyVarEnv)
delTidyEnvList :: TidyEnv -> [Var] -> TidyEnv
delTidyEnvList (occ_env, var_env) vs = (occ_env', var_env')
where
occ_env' = occ_env `delTidyOccEnvList` map (occNameFS . getOccName) vs
var_env' = var_env `delVarEnvList` vs
type VarEnv elt = UniqFM Var elt
type IdEnv elt = UniqFM Id elt
type TyVarEnv elt = UniqFM Var elt
type TyCoVarEnv elt = UniqFM TyCoVar elt
type CoVarEnv elt = UniqFM CoVar 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
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
plusVarEnvList :: [VarEnv a] -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> 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
plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a
mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv 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
disjointVarEnv :: VarEnv a -> VarEnv a -> Bool
elemVarEnv = elemUFM
elemVarEnvByKey = elemUFM_Directly
disjointVarEnv = disjointUFM
alterVarEnv = alterUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnv_Acc = addToUFM_Acc
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
plusVarEnv_CD = plusUFM_CD
plusMaybeVarEnv_C = plusMaybeUFM_C
delVarEnvList = delListFromUFM
delVarEnv = delFromUFM
minusVarEnv = minusUFM
plusVarEnv = plusUFM
plusVarEnvList = plusUFMList
lookupVarEnv = lookupUFM
filterVarEnv = filterUFM
lookupWithDefaultVarEnv = lookupWithDefaultUFM
mapVarEnv = mapUFM
mkVarEnv = listToUFM
mkVarEnv_Directly= listToUFM_Directly
emptyVarEnv = emptyUFM
unitVarEnv = unitUFM
isEmptyVarEnv = isNullUFM
partitionVarEnv = partitionUFM
restrictVarEnv env vs = filterUFM_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 key a -> Unique -> UniqFM key 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 Var elt
type DIdEnv elt = UniqDFM Var elt
type DTyVarEnv elt = UniqDFM TyVar elt
emptyDVarEnv :: DVarEnv a
emptyDVarEnv = emptyUDFM
dVarEnvElts :: DVarEnv a -> [a]
dVarEnvElts = eltsUDFM
mkDVarEnv :: [(Var, a)] -> DVarEnv a
mkDVarEnv = listToUDFM
extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
extendDVarEnv = addToUDFM
minusDVarEnv :: DVarEnv a -> DVarEnv a' -> DVarEnv a
minusDVarEnv = minusUDFM
lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
lookupDVarEnv = lookupUDFM
foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
foldDVarEnv = foldUDFM
nonDetStrictFoldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
nonDetStrictFoldDVarEnv = nonDetStrictFoldUDFM
mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
mapDVarEnv = mapUDFM
filterDVarEnv :: (a -> Bool) -> DVarEnv a -> DVarEnv a
filterDVarEnv = filterUDFM
alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
alterDVarEnv = alterUDFM
plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
plusDVarEnv = plusUDFM
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
elemDVarEnv :: Var -> DVarEnv a -> Bool
elemDVarEnv = elemUDFM
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
extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a
extendDVarEnvList = addListToUDFM
anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
anyDVarEnv = anyUDFM