\begin{code}
module VarEnv (
-- * Var, Id and TyVar environments (maps)
- VarEnv, IdEnv, TyVarEnv,
+ VarEnv, IdEnv, TyVarEnv, CoVarEnv,
-- ** Manipulating these environments
emptyVarEnv, unitVarEnv, mkVarEnv,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
plusVarEnv, plusVarEnv_C,
delVarEnvList, delVarEnv,
+ minusVarEnv, intersectsVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
mapVarEnv, zipVarEnv,
modifyVarEnv, modifyVarEnv_Directly,
-- ** Operations on InScopeSets
emptyInScopeSet, mkInScopeSet, delInScopeSet,
extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
- getInScopeVars, lookupInScope, elemInScopeSet, uniqAway,
+ getInScopeVars, lookupInScope, lookupInScope_Directly,
+ unionInScope, elemInScopeSet, uniqAway,
-- * The RnEnv2 type
RnEnv2,
-- ** Operations on RnEnv2s
mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
- rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList,
+ rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
+ addRnInScopeSet,
+ rnEtaL, rnEtaR,
rnInScope, rnInScopeSet, lookupRnInScope,
-- * TidyEnv and its operation
-- the variable's identity (unique) to its full value.
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
\end{code}
\begin{code}
, envR = emptyVarEnv
, in_scope = vars }
-extendRnInScopeList :: RnEnv2 -> [Var] -> RnEnv2
-extendRnInScopeList env vs
- = env { in_scope = extendInScopeSetList (in_scope env) vs }
+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
rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
-- ^ Similar to 'rnBndr2' but used when there's a binder on the left
--- side only. Useful when eta-expanding
+-- side only.
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]
+ , envR = envR
, in_scope = extendInScopeSet in_scope new_b }, new_b)
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
+-- side only.
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
+ = (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
--- Note [rnBndrLR]
--- ~~~~~~~~~~~~~~~
--- Notice that in rnBndrL, rnBndrR, we extend envR, envL respectively
--- with a binding [new_b -> new_b], where new_b is the new binder.
--- This is important when doing eta expansion; e.g. matching (\x.M) ~ N
--- In effect we switch to (\x'.M) ~ (\x'.N x'), where x' is new_b
--- So we must add x' to the env of both L and R. (x' is fresh, so it
--- can't capture anything in N.)
---
--- If we don't do this, we can get silly matches like
--- forall a. \y.a ~ v
--- succeeding with [x -> v y], which is bogus of course
+rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndrL' but used for eta expansion
+-- See Note [Eta expansion]
+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 -- Note [Eta expansion]
+ , in_scope = extendInScopeSet in_scope new_b }, new_b)
+ where
+ new_b = uniqAway in_scope bL
+
+rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used for eta expansion
+-- See Note [Eta expansion]
+rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
+ = (RV2 { envL = extendVarEnv envL new_b new_b -- Note [Eta expansion]
+ , envR = extendVarEnv envR bR new_b
+ , in_scope = extendInScopeSet in_scope new_b }, new_b)
+ where
+ new_b = uniqAway in_scope bR
rnOccL, rnOccR :: RnEnv2 -> Var -> Var
-- ^ Look up the renaming of an occurrence in the left or right term
nukeRnEnvR env = env { envR = emptyVarEnv }
\end{code}
+Note [Eta expansion]
+~~~~~~~~~~~~~~~~~~~~
+When matching
+ (\x.M) ~ N
+we rename x to x' with, where x' is not in scope in
+either term. Then we want to behave as if we'd seen
+ (\x'.M) ~ (\x'.N x')
+Since x' isn't in scope in N, the form (\x'. N x') doesn't
+capture any variables in N. But we must nevertheless extend
+the envR with a binding [x' -> x'], to support the occurs check.
+For example, if we don't do this, we can get silly matches like
+ forall a. (\y.a) ~ v
+succeeding with [a -> v y], which is bogus of course.
+
%************************************************************************
%* *
type VarEnv elt = UniqFM elt
type IdEnv elt = VarEnv elt
type TyVarEnv elt = VarEnv elt
+type CoVarEnv elt = VarEnv elt
emptyVarEnv :: VarEnv a
mkVarEnv :: [(Var, 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 a -> VarEnv a
+intersectsVarEnv :: VarEnv a -> VarEnv a -> Bool
plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b
modifyVarEnv :: (a -> a) -> VarEnv a -> Var -> VarEnv a
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
delVarEnv = delFromUFM
+minusVarEnv = minusUFM
+intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
plusVarEnv = plusUFM
lookupVarEnv = lookupUFM
lookupWithDefaultVarEnv = lookupWithDefaultUFM
projects / ghc-hetmet.git / blobdiff