From ae2278a0eefcc77f43cd132da28a601b43fea00d Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 21 Jul 2021 09:32:37 +0100 Subject: 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. --- compiler/GHC/Rename/Names.hs | 5 ++++- compiler/GHC/Tc/TyCl/Instance.hs | 3 ++- compiler/GHC/Tc/Utils/Instantiate.hs | 14 ++++++++++++-- 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' } -- cgit v1.2.1