[commit: ghc] wip/rwbarton-D3516: Avoid excessive space usage from unfoldings in CoreTidy (888a606)
git at git.haskell.org
git at git.haskell.org
Sun Apr 30 23:45:26 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/rwbarton-D3516
Link : http://ghc.haskell.org/trac/ghc/changeset/888a606978740cf9d5069f3dcddfc48929e32eac/ghc
>---------------------------------------------------------------
commit 888a606978740cf9d5069f3dcddfc48929e32eac
Author: Reid Barton <rwbarton at gmail.com>
Date: Sun Apr 30 19:43:03 2017 -0400
Avoid excessive space usage from unfoldings in CoreTidy
Test Plan: validate
Reviewers: austin, bgamari
Subscribers: thomie
GHC Trac Issues: #13564
Differential Revision: https://phabricator.haskell.org/D3516
>---------------------------------------------------------------
888a606978740cf9d5069f3dcddfc48929e32eac
compiler/coreSyn/CoreTidy.hs | 8 +++++++-
compiler/main/TidyPgm.hs | 5 ++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs
index 7f82bec..89ce692 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 21d0208..4b9fbae 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
More information about the ghc-commits
mailing list