Squash space leaks in the result of byteCodeGen

When loading a large number of modules into GHCi, we collect
CompiledByteCode for every module and then link it all at the end.
Space leaks in the CompiledByteCode linger until we traverse it all for
linking, and possibly longer, if there are bits we don't look at.

This is the nuke-it-from-orbit approach: we deepseq the whole thing
after code generation. It's the only way to be sure.

Test Plan:
Heap profile of GHCi while loading nofib/real/anna into GHCi, this patch
reduces the peak heap usage from ~100M to ~50M.

Reviewers: hvr, austin, bgamari, erikd

Subscribers: thomie

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

1 files changed, 14 insertions, 1 deletions

diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 9c7d25a5ec..90e2174228 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, RecordWildCards #-}
+{-# OPTIONS_GHC -fprof-auto-top #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -57,6 +58,7 @@ import UniqSupply
 import Module
 import Control.Arrow ( second )
 
+import Control.Exception
 import Data.Array
 import Data.Map (Map)
 import Data.IntMap (IntMap)
@@ -93,10 +95,21 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
         dumpIfSet_dyn dflags Opt_D_dump_BCOs
            "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos)))
 
-        assembleBCOs hsc_env proto_bcos tycs
+        cbc <- assembleBCOs hsc_env proto_bcos tycs
           (case modBreaks of
              Nothing -> Nothing
              Just mb -> Just mb{ modBreaks_breakInfo = breakInfo })
+
+        -- Squash space leaks in the CompiledByteCode.  This is really
+        -- important, because when loading a set of modules into GHCi
+        -- we don't touch the CompiledByteCode until the end when we
+        -- do linking.  Forcing out the thunks here reduces space
+        -- usage by more than 50% when loading a large number of
+        -- modules.
+        evaluate (seqCompiledByteCode cbc)
+
+        return cbc
+
   where dflags = hsc_dflags hsc_env
 
 -- -----------------------------------------------------------------------------