Define and use restoreLclEnv

This fixes #20981.  See Note [restoreLclEnv vs setLclEnv]
in GHC.Tc.Utils.Monad.

I also use updLclEnv rather than get/set when I can, because it's
then much clearer that it's an update rather than an entirely new
TcLclEnv coming from who-knows-where.

9 files changed, 152 insertions, 123 deletions

diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 05c5f6e192..9edc0edd32 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -203,11 +203,11 @@ tcIfaceLclId occ
         }
 
 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
-extendIfaceIdEnv ids thing_inside
-  = do  { env <- getLclEnv
-        ; 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 }
+extendIfaceIdEnv ids
+  = updLclEnv $ \env ->
+    let { id_env' = extendFsEnvList (if_id_env env) pairs
+        ; pairs   = [(occNameFS (getOccName id), id) | id <- ids] }
+    in env { if_id_env = id_env' }
 
 
 tcIfaceTyVar :: FastString -> IfL TyVar
@@ -232,11 +232,11 @@ lookupIfaceVar (IfaceTvBndr (occ, _))
         ; return (lookupFsEnv (if_tv_env lcl) occ) }
 
 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
-extendIfaceTyVarEnv tyvars thing_inside
-  = do  { env <- getLclEnv
-        ; 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 }
+extendIfaceTyVarEnv tyvars
+  = updLclEnv $ \env ->
+    let { tv_env' = extendFsEnvList (if_tv_env env) pairs
+        ; pairs   = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
+    in env { if_tv_env = tv_env' }
 
 extendIfaceEnvs :: [TyCoVar] -> IfL a -> IfL a
 extendIfaceEnvs tcvs thing_inside
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 5884747609..85f7467565 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -126,7 +126,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    (tc_envs, tc_bndrs) <- getLocalNonValBinders local_fix_env group ;
 
 
-   setEnvs tc_envs $ do {
+   restoreEnvs tc_envs $ do {
 
    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
 
@@ -154,7 +154,7 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
                     -- They are already in scope
    traceRn "rnSrcDecls" (ppr id_bndrs) ;
    tc_envs <- extendGlobalRdrEnvRn (map avail id_bndrs) local_fix_env ;
-   setEnvs tc_envs $ do {
+   restoreEnvs tc_envs $ do {
 
    --  Now everything is in scope, as the remaining renaming assumes.
 
@@ -2440,7 +2440,7 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do {
 
    ; let field_env' = extendNameEnvList (tcg_field_env gbl_env) names_with_fls
          final_gbl_env = gbl_env { tcg_field_env = field_env' }
-   ; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
+   ; restoreEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
   where
     new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])]
     new_ps (ValBinds _ binds _) = foldrM new_ps' [] binds
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index c0d704728a..dbf1f88cba 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -891,7 +891,7 @@ getLocalNonValBinders fixity_env
                                  (tyClGroupTyClDecls tycl_decls)
         ; traceRn "getLocalNonValBinders 1" (ppr tc_avails)
         ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
-        ; setEnvs envs $ do {
+        ; restoreEnvs envs $ do {
             -- Bring these things into scope first
             -- See Note [Looking up family names in family instances]
 
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 0c2d426450..6497a51c02 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -93,15 +93,14 @@ newLocalBndrsRn :: [LocatedN RdrName] -> RnM [Name]
 newLocalBndrsRn = mapM newLocalBndrRn
 
 bindLocalNames :: [Name] -> RnM a -> RnM a
-bindLocalNames names enclosed_scope
-  = do { lcl_env <- getLclEnv
-       ; let th_level  = thLevel (tcl_th_ctxt lcl_env)
-             th_bndrs' = extendNameEnvList (tcl_th_bndrs lcl_env)
-                           [ (n, (NotTopLevel, th_level)) | n <- names ]
-             rdr_env'  = extendLocalRdrEnvList (tcl_rdr lcl_env) names
-       ; setLclEnv (lcl_env { tcl_th_bndrs = th_bndrs'
-                            , tcl_rdr      = rdr_env' })
-                    enclosed_scope }
+bindLocalNames names
+  = updLclEnv $ \ lcl_env ->
+    let th_level  = thLevel (tcl_th_ctxt lcl_env)
+        th_bndrs' = extendNameEnvList (tcl_th_bndrs lcl_env)
+                    [ (n, (NotTopLevel, th_level)) | n <- names ]
+        rdr_env'  = extendLocalRdrEnvList (tcl_rdr lcl_env) names
+    in lcl_env { tcl_th_bndrs = th_bndrs'
+               , tcl_rdr      = rdr_env' }
 
 bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
 bindLocalNamesFV names enclosed_scope
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 052a2ed2fa..0d2ba18503 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -179,13 +179,10 @@ tcTopBinds :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]
 -- The TcLclEnv has an extended type envt for the new bindings
 tcTopBinds binds sigs
   = do  { -- Pattern synonym bindings populate the global environment
-          (binds', (tcg_env, tcl_env)) <- tcValBinds TopLevel binds sigs $
-            do { gbl <- getGblEnv
-               ; lcl <- getLclEnv
-               ; return (gbl, lcl) }
+          (binds', (tcg_env, tcl_env)) <- tcValBinds TopLevel binds sigs getEnvs
         ; specs <- tcImpPrags sigs   -- SPECIALISE prags for imported Ids
 
-        ; complete_matches <- setEnvs (tcg_env, tcl_env) $ tcCompleteSigs sigs
+        ; complete_matches <- restoreEnvs (tcg_env, tcl_env) $ tcCompleteSigs sigs
         ; traceTc "complete_matches" (ppr binds $$ ppr sigs)
         ; traceTc "complete_matches" (ppr complete_matches)
 
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index a38d6d436f..006da15def 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -618,7 +618,6 @@ tcSpliceExpr splice _
 
 {- Note [Collecting modFinalizers in typed splices]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 'qAddModFinalizer' of the @Quasi TcM@ instance adds finalizers in the local
 environment (see Note [Delaying modFinalizers in untyped splices] in
 GHC.Rename.Splice). Thus after executing the splice, we move the finalizers to the
@@ -679,12 +678,8 @@ tcTopSplice expr res_ty
 -- See Note [Running typed splices in the zonker]
 runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc)
 runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr)
-  = do
-      errs_var <- getErrsVar
-      setLclEnv lcl_env $ setErrsVar errs_var $ do {
-         -- Set the errs_var to the errs_var from the current context,
-         -- otherwise error messages can go missing in GHCi (#19470)
-         zonked_ty <- zonkTcType res_ty
+  = restoreLclEnv lcl_env $
+    do { zonked_ty <- zonkTcType res_ty
        ; zonked_q_expr <- zonkTopLExpr q_expr
         -- See Note [Collecting modFinalizers in typed splices].
        ; modfinalizers_ref <- newTcRef []
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 66f7406745..1d77f1b593 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -465,7 +465,7 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
       --  * the local env exposes the local Ids to simplifyTop,
       --    so that we get better error messages (monomorphism restriction)
       ; new_ev_binds <- {-# SCC "simplifyTop" #-}
-                        setEnvs (tcg_env, tcl_env) $
+                        restoreEnvs (tcg_env, tcl_env) $
                         do { lie_main <- checkMainType tcg_env
                            ; simplifyTop (lie `andWC` lie_main) }
 
@@ -474,6 +474,9 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
                    mkTypeableBinds
 
       ; traceTc "Tc9" empty
+      ; failIfErrsM    -- Stop now if if there have been errors
+                       -- Continuing is a waste of time; and we may get debug
+                       -- warnings when zonking about strangely-typed TyCons!
 
         -- Zonk the final code.  This must be done last.
         -- Even simplifyTop may do some unification.
@@ -506,19 +509,23 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls
       --------- Deal with the exports ----------
       -- Can't be done earlier, because the export list must "see"
       -- the declarations created by the finalizers
-      ; tcg_env <- setEnvs (tcg_env, tcl_env) $
+      ; tcg_env <- restoreEnvs (tcg_env, tcl_env) $
                    rnExports explicit_mod_hdr export_ies
 
       --------- Emit the ':Main.main = runMainIO main' declaration ----------
       -- Do this /after/ rnExports, so that it can consult
       -- the tcg_exports created by rnExports
       ; (tcg_env, main_ev_binds)
-           <- setEnvs (tcg_env, tcl_env) $
+           <- restoreEnvs (tcg_env, tcl_env) $
               do { (tcg_env, lie) <- captureTopConstraints $
                                      checkMain explicit_mod_hdr export_ies
                  ; ev_binds <- simplifyTop lie
                  ; return (tcg_env, ev_binds) }
 
+      ; failIfErrsM    -- Stop now if if there have been errors
+                       -- Continuing is a waste of time; and we may get debug
+                       -- warnings when zonking about strangely-typed TyCons!
+
       ---------- Final zonking ---------------
       -- Zonk the new bindings arising from running the finalisers,
       -- and main. This won't give rise to any more finalisers as you
@@ -553,10 +560,7 @@ zonkTcGblEnv ev_binds tcg_env@(TcGblEnv { tcg_binds     = binds
   = {-# SCC "zonkTopDecls" #-}
     setGblEnv tcg_env $ -- This sets the GlobalRdrEnv which is used when rendering
                         --   error messages during zonking (notably levity errors)
-    do { failIfErrsM    -- Don't zonk if there have been errors
-                        -- It's a waste of time; and we may get debug warnings
-                        -- about strangely-typed TyCons!
-       ; let all_ev_binds = cur_ev_binds `unionBags` ev_binds
+    do { let all_ev_binds = cur_ev_binds `unionBags` ev_binds
        ; zonkTopDecls all_ev_binds binds rules imp_specs fords }
 
 -- | Runs TH finalizers and renames and typechecks the top-level declarations
@@ -570,7 +574,7 @@ run_th_modfinalizers = do
   else do
     writeTcRef th_modfinalizers_var []
     let run_finalizer (lcl_env, f) =
-            setLclEnv lcl_env (runRemoteModFinalizers f)
+            restoreLclEnv lcl_env (runRemoteModFinalizers f)
 
     (_, lie_th) <- captureTopConstraints $
                    mapM_ run_finalizer th_modfinalizers
@@ -579,7 +583,7 @@ run_th_modfinalizers = do
       -- we have to run tc_rn_src_decls to get them
     (tcg_env, tcl_env, lie_top_decls) <- tc_rn_src_decls []
 
-    setEnvs (tcg_env, tcl_env) $ do
+    restoreEnvs (tcg_env, tcl_env) $ do
       -- Subsequent rounds of finalizers run after any new constraints are
       -- simplified, or some types might not be complete when using reify
       -- (see #12777).
@@ -646,7 +650,7 @@ tc_rn_src_decls ds
                                       tcTopSrcDecls rn_decls
 
         -- If there is no splice, we're nearly done
-      ; setEnvs (tcg_env, tcl_env) $
+      ; restoreEnvs (tcg_env, tcl_env) $
         case group_tail of
           { Nothing -> return (tcg_env, tcl_env, lie1)
 
@@ -1498,14 +1502,14 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
                 -- the bindings produced in a Data instance.)
         traceTc "Tc5" empty ;
         tc_envs <- tcTopBinds val_binds val_sigs;
-        setEnvs tc_envs $ do {
+        restoreEnvs tc_envs $ do {
 
                 -- Now GHC-generated derived bindings, generics, and selectors
                 -- Do not generate warnings from compiler-generated code;
                 -- hence the use of discardWarnings
         tc_envs@(tcg_env, tcl_env)
             <- discardWarnings (tcTopBinds deriv_binds deriv_sigs) ;
-        setEnvs tc_envs $ do {  -- Environment doesn't change now
+        restoreEnvs tc_envs $ do {  -- Environment doesn't change now
 
                 -- Second pass over class and instance declarations,
                 -- now using the kind-checked decls
@@ -2058,34 +2062,31 @@ runTcInteractive hsc_env thing_inside
                 IIDecl i   -> getOrphans (unLoc (ideclName i))
                                          (renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i))
 
-       ; let imports = emptyImportAvails {
-                            imp_orphs = orphs
-                        }
-
-       ; (gbl_env, lcl_env) <- getEnvs
-       ; let gbl_env' = gbl_env {
-                           tcg_rdr_env      = icReaderEnv icxt
-                         , tcg_type_env     = type_env
-                         , tcg_inst_env     = extendInstEnvList
-                                               (extendInstEnvList (tcg_inst_env gbl_env) ic_insts)
-                                               home_insts
-                         , tcg_fam_inst_env = extendFamInstEnvList
-                                               (extendFamInstEnvList (tcg_fam_inst_env gbl_env)
-                                                                     ic_finsts)
-                                               home_fam_insts
-                         , tcg_field_env    = mkNameEnv con_fields
-                              -- setting tcg_field_env is necessary
-                              -- to make RecordWildCards work (test: ghci049)
-                         , tcg_fix_env      = ic_fix_env icxt
-                         , tcg_default      = ic_default icxt
-                              -- must calculate imp_orphs of the ImportAvails
-                              -- so that instance visibility is done correctly
-                         , tcg_imports      = imports
-                         }
-
-             lcl_env' = tcExtendLocalTypeEnv lcl_env lcl_ids
-
-       ; setEnvs (gbl_env', lcl_env') thing_inside }
+       ; let imports = emptyImportAvails { imp_orphs = orphs }
+
+             upd_envs (gbl_env, lcl_env) = (gbl_env', lcl_env')
+               where
+                 gbl_env' = gbl_env { tcg_rdr_env      = icReaderEnv icxt
+                                    , tcg_type_env     = type_env
+                                    , tcg_inst_env     = extendInstEnvList
+                                                          (extendInstEnvList (tcg_inst_env gbl_env) ic_insts)
+                                                          home_insts
+                                    , tcg_fam_inst_env = extendFamInstEnvList
+                                                          (extendFamInstEnvList (tcg_fam_inst_env gbl_env)
+                                                                                ic_finsts)
+                                                          home_fam_insts
+                                    , tcg_field_env    = mkNameEnv con_fields
+                                         -- setting tcg_field_env is necessary
+                                         -- to make RecordWildCards work (test: ghci049)
+                                    , tcg_fix_env      = ic_fix_env icxt
+                                    , tcg_default      = ic_default icxt
+                                         -- must calculate imp_orphs of the ImportAvails
+                                         -- so that instance visibility is done correctly
+                                    , tcg_imports      = imports }
+
+                 lcl_env' = tcExtendLocalTypeEnv lcl_env lcl_ids
+
+       ; updEnvs upd_envs thing_inside }
   where
     (home_insts, home_fam_insts) = hptAllInstances hsc_env
 
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index be4facc922..90c8b9b529 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -638,29 +638,28 @@ tc_extend_local_env top_lvl extra_env thing_inside
 -- that are bound together with extra_env and should not be regarded
 -- as free in the types of extra_env.
   = do  { traceTc "tc_extend_local_env" (ppr extra_env)
-        ; stage <- getStage
-        ; env0@(TcLclEnv { tcl_rdr      = rdr_env
-                         , tcl_th_bndrs = th_bndrs
-                         , tcl_env      = lcl_type_env }) <- getLclEnv
-
-        ; let thlvl = (top_lvl, thLevel stage)
-
-              env1 = env0 { tcl_rdr = extendLocalRdrEnvList rdr_env
-                                      [ n | (n, _) <- extra_env, isInternalName n ]
-                                      -- The LocalRdrEnv contains only non-top-level names
-                                      -- (GlobalRdrEnv handles the top level)
-
-                         , tcl_th_bndrs = extendNameEnvList th_bndrs
-                                          [(n, thlvl) | (n, ATcId {}) <- extra_env]
-                                          -- We only track Ids in tcl_th_bndrs
-
-                         , tcl_env = extendNameEnvList lcl_type_env extra_env }
-
+        ; updLclEnv upd_lcl_env thing_inside }
+  where
+    upd_lcl_env env0@(TcLclEnv { tcl_th_ctxt  = stage
+                               , tcl_rdr      = rdr_env
+                               , tcl_th_bndrs = th_bndrs
+                               , tcl_env      = lcl_type_env })
+       = env0 { tcl_rdr = extendLocalRdrEnvList rdr_env
+                          [ n | (n, _) <- extra_env, isInternalName n ]
+                          -- The LocalRdrEnv contains only non-top-level names
+                          -- (GlobalRdrEnv handles the top level)
+
+              , tcl_th_bndrs = extendNameEnvList th_bndrs
+                               [(n, thlvl) | (n, ATcId {}) <- extra_env]
+                               -- We only track Ids in tcl_th_bndrs
+
+              , tcl_env = extendNameEnvList lcl_type_env extra_env }
               -- tcl_rdr and tcl_th_bndrs: extend the local LocalRdrEnv and
               -- Template Haskell staging env simultaneously. Reason for extending
               -- LocalRdrEnv: after running a TH splice we need to do renaming.
+      where
+        thlvl = (top_lvl, thLevel stage)
 
-        ; setLclEnv env1 thing_inside }
 
 tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcLclEnv
 tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 5cf866072e..ea3b50fa3c 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -20,9 +20,9 @@ module GHC.Tc.Utils.Monad(
   -- * Simple accessors
   discardResult,
   getTopEnv, updTopEnv, getGblEnv, updGblEnv,
-  setGblEnv, getLclEnv, updLclEnv, setLclEnv,
+  setGblEnv, getLclEnv, updLclEnv, setLclEnv, restoreLclEnv,
   updTopFlags,
-  getEnvs, setEnvs,
+  getEnvs, setEnvs, updEnvs, restoreEnvs,
   xoptM, doptM, goptM, woptM,
   setXOptM, unsetXOptM, unsetGOptM, unsetWOptM,
   whenDOptM, whenGOptM, whenWOptM,
@@ -109,7 +109,7 @@ module GHC.Tc.Utils.Monad(
   emitHole, emitHoles,
   discardConstraints, captureConstraints, tryCaptureConstraints,
   pushLevelAndCaptureConstraints,
-  pushTcLevelM_, pushTcLevelM, pushTcLevelsM,
+  pushTcLevelM_, pushTcLevelM,
   getTcLevel, setTcLevel, isTouchableTcM,
   getLclTypeEnv, setLclTypeEnv,
   traceTcConstraints,
@@ -189,7 +189,6 @@ import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Error
 import GHC.Utils.Panic
 import GHC.Utils.Constants (debugIsOn)
-import GHC.Utils.Misc
 import GHC.Utils.Logger
 import qualified GHC.Data.Strict as Strict
 
@@ -483,7 +482,7 @@ updGblEnv :: (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
 updGblEnv upd = updEnv (\ env@(Env { env_gbl = gbl }) ->
                           env { env_gbl = upd gbl })
 
-setGblEnv :: gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+setGblEnv :: gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
 setGblEnv gbl_env = updEnv (\ env -> env { env_gbl = gbl_env })
 
 getLclEnv :: TcRnIf gbl lcl lcl
@@ -493,14 +492,65 @@ updLclEnv :: (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
 updLclEnv upd = updEnv (\ env@(Env { env_lcl = lcl }) ->
                           env { env_lcl = upd lcl })
 
+
 setLclEnv :: lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
 setLclEnv lcl_env = updEnv (\ env -> env { env_lcl = lcl_env })
 
+restoreLclEnv :: TcLclEnv -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
+-- See Note [restoreLclEnv vs setLclEnv]
+restoreLclEnv new_lcl_env = updLclEnv upd
+  where
+    upd old_lcl_env =  new_lcl_env { tcl_errs  = tcl_errs  old_lcl_env
+                                   , tcl_lie   = tcl_lie   old_lcl_env
+                                   , tcl_usage = tcl_usage old_lcl_env }
+
 getEnvs :: TcRnIf gbl lcl (gbl, lcl)
 getEnvs = do { env <- getEnv; return (env_gbl env, env_lcl env) }
 
 setEnvs :: (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
-setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl = lcl_env })
+setEnvs (gbl_env, lcl_env) = setGblEnv gbl_env . setLclEnv lcl_env
+
+updEnvs :: ((gbl,lcl) -> (gbl, lcl)) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+updEnvs upd_envs = updEnv upd
+  where
+    upd env@(Env { env_gbl = gbl, env_lcl = lcl })
+      = env { env_gbl = gbl', env_lcl = lcl' }
+      where
+        !(gbl', lcl') = upd_envs (gbl, lcl)
+
+restoreEnvs :: (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
+-- See Note [restoreLclEnv vs setLclEnv]
+restoreEnvs (gbl, lcl) = setGblEnv gbl . restoreLclEnv lcl
+
+{- Note [restoreLclEnv vs setLclEnv]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In the typechecker we use this idiom quite a lot
+   do { (gbl_env, lcl_env) <- tcRnSrcDecls ...
+      ; setGblEnv gbl_env $ setLclEnv lcl_env $
+        more_stuff }
+
+The `tcRnSrcDecls` extends the environments in `gbl_env` and `lcl_env`
+which we then want to be in scope in `more stuff`.
+
+The problem is that `lcl_env :: TcLclEnv` has an IORef for error
+messages `tcl_errs`, and another for constraints (`tcl_lie`),a and
+another for Linear Haskell usage information (`tcl_usage`).  Now
+suppose we change it a tiny bit
+   do { (gbl_env, lcl_env) <- checkNoErrs $
+                              tcRnSrcDecls ...
+      ; setGblEnv gbl_env $ setLclEnv lcl_env $
+        more_stuff }
+
+That should be innocuous.  But *alas*, `checkNoErrs` gathers errors in
+a fresh IORef *which is then captured in the returned `lcl_env`.  When
+we do the `setLclEnv` we'll make that captured IORef into the place
+where we gather error messages -- but no one is going to look at that!!!
+This led to #19470 and #20981.
+
+Solution: instead of setLclEnv use restoreLclEnv, which preserves from
+the /parent/ context these mutable collection IORefs:
+      tcl_errs, tcl_lie, tcl_usage
+-}
 
 -- Command-line flags
 
@@ -1033,9 +1083,9 @@ checkErr ok msg = unless ok (addErr msg)
 
 addMessages :: Messages TcRnMessage -> TcRn ()
 addMessages msgs1
-  = do { errs_var <- getErrsVar ;
-         msgs0 <- readTcRef errs_var ;
-         writeTcRef errs_var (unionMessages msgs0 msgs1) }
+  = do { errs_var <- getErrsVar
+       ; msgs0    <- readTcRef errs_var
+       ; writeTcRef errs_var (msgs0 `unionMessages` msgs1) }
 
 discardWarnings :: TcRn a -> TcRn a
 -- Ignore warnings inside the thing inside;
@@ -1343,10 +1393,8 @@ captureConstraints thing_inside
 -- returned usage information into the larger context appropriately.
 tcCollectingUsage :: TcM a -> TcM (UsageEnv,a)
 tcCollectingUsage thing_inside
-  = do { env0 <- getLclEnv
-       ; local_usage_ref <- newTcRef zeroUE
-       ; let env1 = env0 { tcl_usage = local_usage_ref }
-       ; result <- setLclEnv env1 thing_inside
+  = do { local_usage_ref <- newTcRef zeroUE
+       ; result <- updLclEnv (\env -> env { tcl_usage = local_usage_ref }) thing_inside
        ; local_usage <- readTcRef local_usage_ref
        ; return (local_usage,result) }
 
@@ -1789,10 +1837,10 @@ discardConstraints thing_inside = fst <$> captureConstraints thing_inside
 -- | The name says it all. The returned TcLevel is the *inner* TcLevel.
 pushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a)
 pushLevelAndCaptureConstraints thing_inside
-  = do { env <- getLclEnv
-       ; let tclvl' = pushTcLevel (tcl_tclvl env)
+  = do { tclvl <- getTcLevel
+       ; let tclvl' = pushTcLevel tclvl
        ; traceTc "pushLevelAndCaptureConstraints {" (ppr tclvl')
-       ; (res, lie) <- setLclEnv (env { tcl_tclvl = tclvl' }) $
+       ; (res, lie) <- updLclEnv (\env -> env { tcl_tclvl = tclvl' }) $
                        captureConstraints thing_inside
        ; traceTc "pushLevelAndCaptureConstraints }" (ppr tclvl')
        ; return (tclvl', lie, res) }
@@ -1803,21 +1851,11 @@ pushTcLevelM_ x = updLclEnv (\ env -> env { tcl_tclvl = pushTcLevel (tcl_tclvl e
 pushTcLevelM :: TcM a -> TcM (TcLevel, a)
 -- See Note [TcLevel assignment] in GHC.Tc.Utils.TcType
 pushTcLevelM thing_inside
-  = do { env <- getLclEnv
-       ; let tclvl' = pushTcLevel (tcl_tclvl env)
-       ; res <- setLclEnv (env { tcl_tclvl = tclvl' })
-                          thing_inside
+  = do { tclvl <- getTcLevel
+       ; let tclvl' = pushTcLevel tclvl
+       ; res <- updLclEnv (\env -> env { tcl_tclvl = tclvl' }) thing_inside
        ; return (tclvl', res) }
 
--- Returns pushed TcLevel
-pushTcLevelsM :: Int -> TcM a -> TcM (a, TcLevel)
-pushTcLevelsM num_levels thing_inside
-  = do { env <- getLclEnv
-       ; let tclvl' = nTimes num_levels pushTcLevel (tcl_tclvl env)
-       ; res <- setLclEnv (env { tcl_tclvl = tclvl' }) $
-                thing_inside
-       ; return (res, tclvl') }
-
 getTcLevel :: TcM TcLevel
 getTcLevel = do { env <- getLclEnv
                 ; return (tcl_tclvl env) }