Fix GHCi space leaks (#15111)

Summary:
There were a number of leaks causing previously loaded modules to be
retained after a new `:load`.  This fixes enough leaks to get the
tests to pass from D4658.

Test Plan: See new tests in D4658

Reviewers: niteria, bgamari, simonpj, erikd

Subscribers: thomie, carter

GHC Trac Issues: #15111

Differential Revision: https://phabricator.haskell.org/D4659

6 files changed, 76 insertions, 12 deletions

diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index a380ccf008..8f0e958b48 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -6,7 +6,7 @@
 Loading interface files
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module LoadIface (
         -- Importing one thing
@@ -443,6 +443,8 @@ loadInterface doc_str mod from
         in
         initIfaceLcl (mi_semantic_module iface) loc_doc (mi_boot iface) $ do
 
+        dontLeakTheHPT $ do
+
         --      Load the new ModIface into the External Package State
         -- Even home-package interfaces loaded by loadInterface
         --      (which only happens in OneShot mode; in Batch/Interactive
@@ -514,6 +516,54 @@ loadInterface doc_str mod from
         ; return (Succeeded final_iface)
     }}}}
 
+
+
+-- Note [HPT space leak] (#15111)
+--
+-- In IfL, we defer some work until it is demanded using forkM, such
+-- as building TyThings from IfaceDecls. These thunks are stored in
+-- the ExternalPackageState, and they might never be poked.  If we're
+-- not careful, these thunks will capture the state of the loaded
+-- program when we read an interface file, and retain all that data
+-- for ever.
+--
+-- Therefore, when loading a package interface file , we use a "clean"
+-- version of the HscEnv with all the data about the currently loaded
+-- program stripped out. Most of the fields can be panics because
+-- we'll never read them, but hsc_HPT needs to be empty because this
+-- interface will cause other interfaces to be loaded recursively, and
+-- when looking up those interfaces we use the HPT in loadInterface.
+-- We know that none of the interfaces below here can refer to
+-- home-package modules however, so it's safe for the HPT to be empty.
+--
+dontLeakTheHPT :: IfL a -> IfL a
+dontLeakTheHPT thing_inside = do
+  let
+    cleanTopEnv HscEnv{..} =
+       let
+         -- wrinkle: when we're typechecking in --backpack mode, the
+         -- instantiation of a signature might reside in the HPT, so
+         -- this case breaks the assumption that EPS interfaces only
+         -- refer to other EPS interfaces. We can detect when we're in
+         -- typechecking-only mode by using hscTarget==HscNothing, and
+         -- in that case we don't empty the HPT.  (admittedly this is
+         -- a bit of a hack, better suggestions welcome). A number of
+         -- tests in testsuite/tests/backpack break without this
+         -- tweak.
+         !hpt | hscTarget hsc_dflags == HscNothing = hsc_HPT
+              | otherwise = emptyHomePackageTable
+       in
+       HscEnv {  hsc_targets      = panic "cleanTopEnv: hsc_targets"
+              ,  hsc_mod_graph    = panic "cleanTopEnv: hsc_mod_graph"
+              ,  hsc_IC           = panic "cleanTopEnv: hsc_IC"
+              ,  hsc_HPT          = hpt
+              , .. }
+
+  updTopEnv cleanTopEnv $ do
+  !_ <- getTopEnv        -- force the updTopEnv
+  thing_inside
+
+
 -- | Returns @True@ if a 'ModIface' comes from an external package.
 -- In this case, we should NOT load it into the EPS; the entities
 -- should instead come from the local merged signature interface.
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 720aaf8b9b..d62b5929d7 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1244,7 +1244,8 @@ data ImportedModsVal
         imv_span :: SrcSpan,             -- ^ the source span of the whole import
         imv_is_safe :: IsSafeImport,     -- ^ whether this is a safe import
         imv_is_hiding :: Bool,           -- ^ whether this is an "hiding" import
-        imv_all_exports :: GlobalRdrEnv, -- ^ all the things the module could provide
+        imv_all_exports :: !GlobalRdrEnv, -- ^ all the things the module could provide
+          -- NB. BangPattern here: otherwise this leaks. (#15111)
         imv_qualified :: Bool            -- ^ whether this is a qualified import
         }
 
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 81cba29040..63fe36d2c8 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -8,6 +8,7 @@ https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -132,6 +133,7 @@ import Data.Data ( Data )
 import HsDumpAst
 import qualified Data.Set as S
 
+import Control.DeepSeq
 import Control.Monad
 
 #include "HsVersions.h"
@@ -1788,8 +1790,8 @@ runTcInteractive hsc_env thing_inside
                                  (loadSrcInterface (text "runTcInteractive") m
                                                    False mb_pkg)
 
-       ; orphs <- fmap concat . forM (ic_imports icxt) $ \i ->
-            case i of
+       ; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \i ->
+            case i of                   -- force above: see #15111
                 IIModule n -> getOrphans n Nothing
                 IIDecl i ->
                   let mb_pkg = sl_fs <$> ideclPkgQual i in
@@ -1798,6 +1800,7 @@ runTcInteractive hsc_env thing_inside
        ; let imports = emptyImportAvails {
                             imp_orphs = orphs
                         }
+
        ; (gbl_env, lcl_env) <- getEnvs
        ; let gbl_env' = gbl_env {
                            tcg_rdr_env      = ic_rn_gbl_env icxt
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 781c6bada4..968330da8b 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -270,8 +270,9 @@ type TcM  = TcRn
 -- the lcl type).
 data Env gbl lcl
   = Env {
-        env_top  :: HscEnv,  -- Top-level stuff that never changes
+        env_top  :: !HscEnv, -- Top-level stuff that never changes
                              -- Includes all info about imported things
+                             -- BangPattern is to fix leak, see #15111
 
         env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
                              -- Unique supply for local variables
@@ -526,10 +527,12 @@ data TcGblEnv
                 -- bound in this module when dealing with hi-boot recursions
                 -- Updated at intervals (e.g. after dealing with types and classes)
 
-        tcg_inst_env     :: InstEnv,
+        tcg_inst_env     :: !InstEnv,
           -- ^ Instance envt for all /home-package/ modules;
           -- Includes the dfuns in tcg_insts
-        tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
+          -- NB. BangPattern is to fix a leak, see #15111
+        tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances
+          -- NB. BangPattern is to fix a leak, see #15111
         tcg_ann_env      :: AnnEnv,     -- ^ And for annotations
 
                 -- Now a bunch of things about this module that are simply
@@ -679,8 +682,9 @@ data TcGblEnv
         tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms
 
         tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
-        tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
+        tcg_hpc       :: !AnyHpcUsage,       -- ^ @True@ if any part of the
                                              --  prog uses hpc instrumentation.
+           -- NB. BangPattern is to fix a leak, see #15111
 
         tcg_self_boot :: SelfBootInfo,       -- ^ Whether this module has a
                                              -- corresponding hi-boot file
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 5ef5a3df10..654f2d1700 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1205,12 +1205,15 @@ test('ManyAlternatives',
 test('T13701',
      [ compiler_stats_num_field('bytes allocated',
           [(platform('x86_64-apple-darwin'), 2217187888, 10),
-           (platform('x86_64-unknown-linux'), 2133380768, 10),
+           (platform('x86_64-unknown-linux'), 2413253392, 10),
            # initial:     2511285600
            # 2017-06-23:  2188045288    treat banged variable bindings as FunBinds
            # 2017-07-11:  2187920960
            # 2017-07-12:  2412223768    inconsistency between Ben's machine and Harbormaster?
            # 2017-07-17:  2133380768    Resolved the issue causing the inconsistencies in this test
+           # 2018-05-09:  2413253392    D4659 (Fix GHCi space leaks) added
+           #                            some strictness which causes some extra
+           #                            work to be done in this test.
           ]),
        pre_cmd('./genT13701'),
        extra_files(['genT13701']),
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index 146c2f3ca1..78fd3f8eb7 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -10,7 +10,7 @@ test('haddock.base',
             # 2017-02-19                        24286343184 (x64/Windows) - Generalize kind of (->)
             # 2017-12-24                        18733710728 (x64/Windows) - Unknown
 
-          ,(wordsize(64), 18971030224, 5)
+          ,(wordsize(64), 21123660336, 5)
             # 2012-08-14:  5920822352 (amd64/Linux)
             # 2012-09-20:  5829972376 (amd64/Linux)
             # 2012-10-08:  5902601224 (amd64/Linux)
@@ -50,6 +50,7 @@ test('haddock.base',
             # 2018-04-10: 18511324808 (x86_64/Linux) - TTG HsBinds and Data instances
             # 2018-04-11: 20727464616 (x86_64/Linux) - Collateral of simplCast improvement (#14737)
             # 2018-04-20: 18971030224 (x86_64/Linux) - Cache coercion roles
+            # 2018-05-14: 21123660336 (amd64/Linux) D4659: strictness to fix space leaks
 
           ,(platform('i386-unknown-mingw32'), 2885173512, 5)
             # 2013-02-10:                     3358693084 (x86/Windows)
@@ -76,7 +77,7 @@ test('haddock.Cabal',
      [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']),
       unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 23525241536, 5)
+          [(wordsize(64), 24519860272, 5)
             # 2012-08-14:  3255435248 (amd64/Linux)
             # 2012-08-29:  3324606664 (amd64/Linux, new codegen)
             # 2012-10-08:  3373401360 (amd64/Linux)
@@ -130,6 +131,7 @@ test('haddock.Cabal',
             # 2017-11-09: 20104611952 (amd64/Linux) - Bump Cabal
             # 2018-01-22: 25261834904 (amd64/Linux) - Bump Cabal
             # 2018-04-10: 23525241536 (amd64/Linux) - TTG HsBinds and Data instances
+            # 2018-05-14: 24519860272 (amd64/Linux) D4659: strictness to fix space leaks
 
           ,(platform('i386-unknown-mingw32'), 3293415576, 5)
             # 2012-10-30:                     1733638168 (x86/Windows)
@@ -155,7 +157,7 @@ test('haddock.compiler',
      ,stats_num_field('bytes allocated',
           [(platform('x86_64-unknown-mingw32'),   56775301896, 10),
             # 2017-12-24:                     56775301896 (x64/Windows)
-            (wordsize(64), 58410358720, 10)
+            (wordsize(64), 63038317672, 10)
             # 2012-08-14: 26070600504 (amd64/Linux)
             # 2012-08-29: 26353100288 (amd64/Linux, new CG)
             # 2012-09-18: 26882813032 (amd64/Linux)
@@ -179,6 +181,7 @@ test('haddock.compiler',
             # 2017-07-12: 51592019560 (amd64/Linux) Use getNameToInstancesIndex
             # 2018-04-08: 91115212032 (amd64/Linux) Trees that grow
             # 2018-04-10: 58410358720 (amd64/Linux) Trees that grow (HsBinds, Data instances)
+            # 2018-05-14: 63038317672 (amd64/Linux) D4659: strictness to fix space leaks
 
           ,(platform('i386-unknown-mingw32'),   367546388, 10)
             # 2012-10-30:                     13773051312 (x86/Windows)