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

5 files changed, 29 insertions, 19 deletions

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 2a2284b09d..0261f7ecbd 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -428,7 +428,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
 
@@ -438,7 +438,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
@@ -1778,6 +1778,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 20b497bee3..0c8d8e9767 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/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 9a4a5c7a1d..8bc0dd1110 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -1277,7 +1277,7 @@ tcPragExpr name expr
   where
     doc = text "Unfolding of" <+> ppr name
 
-    get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
+    get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting
     get_in_scope
         = do { (gbl_env, lcl_env) <- getEnvs
              ; rec_ids <- case if_rec_types gbl_env of
@@ -1285,9 +1285,14 @@ tcPragExpr name expr
                             Just (_, get_env) -> do
                                { type_env <- setLclEnv () get_env
                                ; return (typeEnvIds type_env) }
-             ; return (varEnvElts (if_tv_env lcl_env) ++
-                       varEnvElts (if_id_env lcl_env) ++
-                       rec_ids) }
+             ; return (bindingsVars (if_tv_env lcl_env) `unionVarSet`
+                       bindingsVars (if_id_env lcl_env) `unionVarSet`
+                       mkVarSet rec_ids) }
+
+    bindingsVars :: FastStringEnv Var -> VarSet
+    bindingsVars ufm = mkVarSet $ nonDetEltsUFM ufm
+      -- It's OK to use nonDetEltsUFM here because we immediately forget
+      -- the ordering by creating a set
 
 {-
 ************************************************************************
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index c4e66a0216..88c63f9162 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
@@ -1465,8 +1464,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 3fd2a83a7f..dede93233e 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -279,8 +279,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
     }
 
 {-