Fix a few retainer leaks of TcGblEnv

Methodology: Create a -hi profile and then search for TcGblEnv
then use ghc-debug to work out why they are being retained and remove
the reason.

Retaining TcGblEnv is dangerous because it contains pointers to things
such as a TypeEnv which is updated throughout compilation. I found two
places which were retaining a TcGblEnv unecessarily.

Also fix a few places where an OccName was retaining an Id.

3 files changed, 18 insertions, 4 deletions

diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index a79048272b..a66430d7ba 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -860,9 +860,12 @@ getLocalNonValBinders fixity_env
         ; traceRn "getLocalNonValBinders 2" (ppr avails)
         ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env
 
+        -- Force the field access so that tcg_env is not retained. The
+        -- selector thunk optimisation doesn't kick-in, see #20139
+        ; let !old_field_env = tcg_field_env tcg_env
         -- Extend tcg_field_env with new fields (this used to be the
         -- work of extendRecordFieldEnv)
-        ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds
+              field_env = extendNameEnvList old_field_env flds
               envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)
 
         ; traceRn "getLocalNonValBinders 3" (vcat [ppr flds, ppr field_env])
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 760c8c6438..5f56c3c830 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1981,7 +1981,8 @@ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id
         ; return (poly_meth_id, local_meth_id) }
   where
     sel_name      = idName sel_id
-    sel_occ       = nameOccName sel_name
+    -- Force so that a thunk doesn't end up in a Name (#19619)
+    !sel_occ      = nameOccName sel_name
     local_meth_ty = instantiateMethod clas sel_id inst_tys
     poly_meth_ty  = mkSpecSigmaTy tyvars theta local_meth_ty
     theta         = map idType dfun_ev_vars
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 42d2aafe30..a80dfb71a5 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -588,7 +588,10 @@ freshenTyCoVarX mk_tcv subst tycovar
   = do { loc  <- getSrcSpanM
        ; uniq <- newUnique
        ; let old_name = tyVarName tycovar
-             new_name = mkInternalName uniq (getOccName old_name) loc
+             -- Force so we don't retain reference to the old name and id
+             -- See (#19619) for more discussion
+             !old_occ_name = getOccName old_name
+             new_name = mkInternalName uniq old_occ_name loc
              new_kind = substTyUnchecked subst (tyVarKind tycovar)
              new_tcv  = mk_tcv new_name new_kind
              subst1   = extendTCvSubstWithClone subst tycovar new_tcv
@@ -844,8 +847,15 @@ tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
 tcExtendLocalInstEnv dfuns thing_inside
  = do { traceDFuns dfuns
       ; env <- getGblEnv
+      -- Force the access to the TcgEnv so it isn't retained.
+      -- During auditing it is much easier to observe in -hi profiles if
+      -- there are a very small number of TcGblEnv. Keeping a TcGblEnv
+      -- alive is quite dangerous because it contains reference to many
+      -- large data structures.
+      ; let !init_inst_env = tcg_inst_env env
+            !init_insts = tcg_insts env
       ; (inst_env', cls_insts') <- foldlM addLocalInst
-                                          (tcg_inst_env env, tcg_insts env)
+                                          (init_inst_env, init_insts)
                                           dfuns
       ; let env' = env { tcg_insts    = cls_insts'
                        , tcg_inst_env = inst_env' }