[commit: ghc] ghc-8.0: Kill varEnvElts in tcPragExpr (8cd76a4)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/8cd76a475822e35b903505b4dd1f2f95d847288b/ghc

>---------------------------------------------------------------

commit 8cd76a475822e35b903505b4dd1f2f95d847288b
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Wed May 18 16:47:29 2016 -0700

    Kill varEnvElts in tcPragExpr
    
    I had to refactor some things to take VarSet instead of [Var],
    but I think it's more precise this way.
    
    Test Plan: ./validate
    
    Reviewers: simonmar, simonpj, austin, bgamari, goldfire
    
    Reviewed By: simonpj
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2227
    
    GHC Trac Issues: #4012
    
    (cherry picked from commit 13e40f998e15a626a4212bde0987ddbc98b3f56f)


>---------------------------------------------------------------

8cd76a475822e35b903505b4dd1f2f95d847288b
 compiler/coreSyn/CoreLint.hs    | 10 ++++++++--
 compiler/iface/IfaceEnv.hs      | 16 ++++++++--------
 compiler/typecheck/TcRnMonad.hs |  5 ++---
 compiler/typecheck/TcRnTypes.hs |  4 ++--
 4 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 2106e2d..e1b106c 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -417,7 +417,7 @@ We use this to check all unfoldings that come in from interfaces
 
 lintUnfolding :: DynFlags
               -> SrcLoc
-              -> [Var]          -- Treat these as in scope
+              -> VarSet         -- Treat these as in scope
               -> CoreExpr
               -> Maybe MsgDoc   -- Nothing => OK
 
@@ -427,7 +427,7 @@ lintUnfolding dflags locn vars expr
   where
     (_warns, errs) = initL dflags defaultLintFlags linter
     linter = addLoc (ImportedUnfolding locn) $
-             addInScopeVars vars             $
+             addInScopeVarSet vars           $
              lintCoreExpr expr
 
 lintExpr :: DynFlags
@@ -1678,6 +1678,12 @@ addInScopeVars vars m
     unLintM m (env { le_subst = extendTCvInScopeList (le_subst env) vars })
               errs
 
+addInScopeVarSet :: VarSet -> LintM a -> LintM a
+addInScopeVarSet vars m
+  = LintM $ \ env errs ->
+    unLintM m (env { le_subst = extendTCvInScopeSet (le_subst env) vars })
+              errs
+
 addInScopeVar :: Var -> LintM a -> LintM a
 addInScopeVar var m
   = LintM $ \ env errs ->
diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 20b497b..0c8d8e9 100644
--- a/compiler/iface/IfaceEnv.hs
+++ b/compiler/iface/IfaceEnv.hs
@@ -30,8 +30,8 @@ import Var
 import Name
 import Avail
 import Module
-import UniqFM
 import FastString
+import FastStringEnv
 import IfaceType
 import UniqSupply
 import SrcLoc
@@ -259,7 +259,7 @@ initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
 tcIfaceLclId :: FastString -> IfL Id
 tcIfaceLclId occ
   = do  { lcl <- getLclEnv
-        ; case (lookupUFM (if_id_env lcl) occ) of
+        ; case (lookupFsEnv (if_id_env lcl) occ) of
             Just ty_var -> return ty_var
             Nothing     -> failIfM (text "Iface id out of scope: " <+> ppr occ)
         }
@@ -267,7 +267,7 @@ tcIfaceLclId occ
 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
 extendIfaceIdEnv ids thing_inside
   = do  { env <- getLclEnv
-        ; let { id_env' = addListToUFM (if_id_env env) pairs
+        ; let { id_env' = extendFsEnvList (if_id_env env) pairs
               ; pairs   = [(occNameFS (getOccName id), id) | id <- ids] }
         ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
 
@@ -275,7 +275,7 @@ extendIfaceIdEnv ids thing_inside
 tcIfaceTyVar :: FastString -> IfL TyVar
 tcIfaceTyVar occ
   = do  { lcl <- getLclEnv
-        ; case (lookupUFM (if_tv_env lcl) occ) of
+        ; case (lookupFsEnv (if_tv_env lcl) occ) of
             Just ty_var -> return ty_var
             Nothing     -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
         }
@@ -283,20 +283,20 @@ tcIfaceTyVar occ
 lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar)
 lookupIfaceTyVar (occ, _)
   = do  { lcl <- getLclEnv
-        ; return (lookupUFM (if_tv_env lcl) occ) }
+        ; return (lookupFsEnv (if_tv_env lcl) occ) }
 
 lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar)
 lookupIfaceVar (IfaceIdBndr (occ, _))
   = do  { lcl <- getLclEnv
-        ; return (lookupUFM (if_id_env lcl) occ) }
+        ; return (lookupFsEnv (if_id_env lcl) occ) }
 lookupIfaceVar (IfaceTvBndr (occ, _))
   = do  { lcl <- getLclEnv
-        ; return (lookupUFM (if_tv_env lcl) occ) }
+        ; return (lookupFsEnv (if_tv_env lcl) occ) }
 
 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
 extendIfaceTyVarEnv tyvars thing_inside
   = do  { env <- getLclEnv
-        ; let { tv_env' = addListToUFM (if_tv_env env) pairs
+        ; let { tv_env' = extendFsEnvList (if_tv_env env) pairs
               ; pairs   = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
         ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
 
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 6b01a87..c0d5d64 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -42,7 +42,6 @@ import NameSet
 import Bag
 import Outputable
 import UniqSupply
-import UniqFM
 import DynFlags
 import StaticFlags
 import FastString
@@ -1459,8 +1458,8 @@ setLocalRdrEnv rdr_env thing_inside
 mkIfLclEnv :: Module -> SDoc -> IfLclEnv
 mkIfLclEnv mod loc = IfLclEnv { if_mod     = mod,
                                 if_loc     = loc,
-                                if_tv_env  = emptyUFM,
-                                if_id_env  = emptyUFM }
+                                if_tv_env  = emptyFsEnv,
+                                if_id_env  = emptyFsEnv }
 
 -- | Run an 'IfG' (top-level interface monad) computation inside an existing
 -- 'TcRn' (typecheck-renaming monad) computation by initializing an 'IfGblEnv'
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 019bd08..f99f49f 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -283,8 +283,8 @@ data IfLclEnv
                 --      .hi file, or GHCi state, or ext core
                 -- plus which bit is currently being examined
 
-        if_tv_env  :: UniqFM TyVar,     -- Nested tyvar bindings
-        if_id_env  :: UniqFM Id         -- Nested id binding
+        if_tv_env  :: FastStringEnv TyVar,     -- Nested tyvar bindings
+        if_id_env  :: FastStringEnv Id         -- Nested id binding
     }
 
 {-