Stamp out space leaks from demand analysis

This reduces peak memory usage by ~30% on my test case (DynFlags),
and (probably as a result of reduced GC work) decreases compilation
time by a few percent as well.

Also fix a bug in seqStrDmd so that demeand info is fully evaluated.

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: dfeuer, thomie

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

3 files changed, 25 insertions, 4 deletions

diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 377fc3d6ea..95c7b79b4f 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -332,7 +332,7 @@ bothStr (SProd _) (SCall _)    = HyperStr
 -- utility functions to deal with memory leaks
 seqStrDmd :: StrDmd -> ()
 seqStrDmd (SProd ds)   = seqStrDmdList ds
-seqStrDmd (SCall s)     = s `seq` ()
+seqStrDmd (SCall s)    = seqStrDmd s
 seqStrDmd _            = ()
 
 seqStrDmdList :: [ArgStr] -> ()
diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs
index 25a4f8b912..2fc33a48b8 100644
--- a/compiler/stranal/DmdAnal.hs
+++ b/compiler/stranal/DmdAnal.hs
@@ -17,6 +17,7 @@ import DynFlags
 import WwLib            ( findTypeShape, deepSplitProductType_maybe )
 import Demand   -- All of it
 import CoreSyn
+import CoreSeq          ( seqBinds )
 import Outputable
 import VarEnv
 import BasicTypes
@@ -52,7 +53,8 @@ dmdAnalProgram dflags fam_envs binds
         dumpIfSet_dyn dflags Opt_D_dump_str_signatures
                       "Strictness signatures" $
             dumpStrSig binds_plus_dmds ;
-        return binds_plus_dmds
+        -- See Note [Stamp out space leaks in demand analysis]
+        seqBinds binds_plus_dmds `seq` return binds_plus_dmds
     }
   where
     do_prog :: CoreProgram -> CoreProgram
@@ -79,6 +81,24 @@ dmdAnalTopBind sigs (Rec pairs)
                 -- We get two iterations automatically
                 -- c.f. the NonRec case above
 
+{- Note [Stamp out space leaks in demand analysis]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The demand analysis pass outputs a new copy of the Core program in
+which binders have been annotated with demand and strictness
+information. It's tiresome to ensure that this information is fully
+evaluated everywhere that we produce it, so we just run a single
+seqBinds over the output before returning it, to ensure that there are
+no references holding on to the input Core program.
+
+This is particularly important when we are doing late demand analysis,
+since we don't do a seqBinds at any point thereafter. Hence code
+generation would hold on to an extra copy of the Core program, via
+unforced thunks in demand or strictness information; and it is the
+most memory-intensive part of the compilation process, so this added
+seqBinds makes a big difference in peak memory usage.
+-}
+
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index e1d4552b50..aa7b811ed7 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -736,7 +736,7 @@ test('T9020',
 test('T9675',
      [ only_ways(['optasm']),
        compiler_stats_num_field('max_bytes_used', # Note [residency]
-          [(wordsize(64), 38776008, 15),
+          [(wordsize(64), 29871032, 15),
           # 2014-10-13    29596552
           # 2014-10-13    26570896   seq the DmdEnv in seqDmdType as well
           # 2014-10-13    18582472   different machines giving different results..
@@ -744,7 +744,8 @@ test('T9675',
           # 2015-06-21    28056344   switch to `+RTS -G1`, tighten bound to 15%
           # 2015-10-28    23776640   emit Typeable at definition site
           # 2015-12-11    30837312   TypeInType (see #11196)
-          # 2016-04-14    38776008   Final demand analyzer run
+          # 2016-03-14    38776008   Final demand analyzer run
+          # 2016-04-01    29871032   Fix leaks in demand analysis
            (wordsize(32), 18043224, 15)
           # 2015-07-11    15341228   (x86/Linux, 64-bit machine) use +RTS -G1
           # 2016-04-06    18043224   (x86/Linux, 64-bit machine)