Fix scoped type variables for expression type signatures

[ghc-hetmet.git] / compiler / basicTypes / VarEnv.lhs

diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs
index da2f960..e59c800 100644 (file)
--- a/compiler/basicTypes/VarEnv.lhs
+++ b/compiler/basicTypes/VarEnv.lhs
@@ -20,14 +20,15 @@ module VarEnv (
 
        -- InScopeSet
        InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
-       extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
+       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,
+               rnInScope, lookupRnInScope,
 
        -- TidyEnvs
        TidyEnv, emptyTidyEnv
@@ -80,6 +81,10 @@ extendInScopeSetList (InScope in_scope n) vs
    = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
                    (n +# iUnbox (length vs))
 
+extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
+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
@@ -247,6 +252,9 @@ 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 }