X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FVarEnv.lhs;h=dba4ec0f5a47d9098cb10643f1157d95c14aeaca;hb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;hp=bfeecdc923d41925ff3e2d69d12a03f558339913;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs index bfeecdc..dba4ec0 100644 --- a/compiler/basicTypes/VarEnv.lhs +++ b/compiler/basicTypes/VarEnv.lhs @@ -26,7 +26,8 @@ module VarEnv ( -- RnEnv2 and its operations RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR, - rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, + rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, extendRnInScopeList, + rnInScope, lookupRnInScope, -- TidyEnvs TidyEnv, emptyTidyEnv @@ -40,7 +41,7 @@ import VarSet import UniqFM import Unique ( Unique, deriveUnique, getUnique ) import Util ( zipEqual, foldl2 ) -import Maybes ( orElse, isJust ) +import Maybes ( orElse ) import StaticFlags( opt_PprStyle_Debug ) import Outputable import FastTypes @@ -183,6 +184,13 @@ mkRnEnv2 vars = RV2 { envL = emptyVarEnv , envR = emptyVarEnv , in_scope = vars } +extendRnInScopeList :: RnEnv2 -> [Var] -> RnEnv2 +extendRnInScopeList env vs + = env { in_scope = extendInScopeSetList (in_scope env) vs } + +rnInScope :: Var -> RnEnv2 -> Bool +rnInScope x env = x `elemInScopeSet` in_scope env + rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2 -- Arg lists must be of equal length rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR @@ -236,8 +244,11 @@ rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool -- Tells whether a variable is locally bound -inRnEnvL (RV2 { envL = env }) v = isJust (lookupVarEnv env v) -inRnEnvR (RV2 { envR = env }) v = isJust (lookupVarEnv env v) +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 }