Avoid excessive space usage from unfoldings in CoreTidywip/rwbarton-D3516

Test Plan: validate

Reviewers: austin, bgamari

Subscribers: thomie

GHC Trac Issues: #13564

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

2 files changed, 11 insertions, 2 deletions

diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs
index 7f82bece17..89ce692422 100644
--- a/compiler/coreSyn/CoreTidy.hs
+++ b/compiler/coreSyn/CoreTidy.hs
@@ -15,6 +15,7 @@ module CoreTidy (
 #include "HsVersions.h"
 
 import CoreSyn
+import CoreSeq ( seqUnfolding )
 import CoreArity
 import Id
 import IdInfo
@@ -223,9 +224,14 @@ tidyUnfolding tidy_env
               unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
               unf_from_rhs
   | isStableSource src
-  = unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
+  = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
+    -- This seqIt avoids a space leak: otherwise the uf_is_value,
+    -- uf_is_conlike, ... fields may retain a reference to the
+    -- pre-tidied expression forever (ToIface doesn't look at them)
+
   | otherwise
   = unf_from_rhs
+  where seqIt unf = seqUnfolding unf `seq` unf
 tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
 
 {-
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index 21d0208a07..4b9fbae599 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -22,6 +22,7 @@ import CoreMonad
 import CorePrep
 import CoreUtils        (rhsIsStatic)
 import CoreStats        (coreBindsStats, CoreStats(..))
+import CoreSeq          (seqBinds)
 import CoreLint
 import Literal
 import Rules
@@ -1134,7 +1135,9 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds
   = do mkIntegerId <- lookupMkIntegerName dflags hsc_env
        integerSDataCon <- lookupIntegerSDataConName dflags hsc_env
        let cvt_integer = cvtLitInteger dflags mkIntegerId integerSDataCon
-       return $ tidy cvt_integer init_env binds
+           result      = tidy cvt_integer init_env binds
+       seqBinds (snd result) `seq` return result
+       -- This seqBinds avoids a spike in space usage (see #13564)
   where
     dflags = hsc_dflags hsc_env