CoreTidy: Don't seq unfoldings
authorBen Gamari <ben@smart-cactus.org>
Tue, 2 May 2017 15:36:47 +0000 (11:36 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 4 May 2017 22:21:54 +0000 (18:21 -0400)
Previously we would force uf_is_value and friends to ensure that we didn't
retain a reference to the pre-tidying template, resulting in a space leak.
Instead, we now just reinitialize these fields (despite the fact that they
should not have changed). This may result in a bit more computation, but most of
the time we won't ever evaluate them anyways, so the damage shouldn't be so bad.

See #13564.

compiler/coreSyn/CoreTidy.hs

index 89ce692..3578b0b 100644 (file)
@@ -15,7 +15,7 @@ module CoreTidy (
 #include "HsVersions.h"
 
 import CoreSyn
-import CoreSeq ( seqUnfolding )
+import CoreUnfold ( mkCoreUnfolding )
 import CoreArity
 import Id
 import IdInfo
@@ -221,17 +221,21 @@ tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
     (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
 
 tidyUnfolding tidy_env
-              unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
+              (CoreUnfolding { uf_tmpl = unf_rhs, uf_is_top = top_lvl
+                             , uf_src = src, uf_guidance = guidance })
               unf_from_rhs
   | isStableSource src
-  = 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)
+  = mkCoreUnfolding src top_lvl (tidyExpr tidy_env unf_rhs) guidance
+    -- Preserves OccInfo
+
+    -- Note that uf_is_value and friends may be a thunk containing a reference
+    -- to the old template. Consequently it is important that we rebuild them,
+    -- despite the fact that they won't change, to avoid a space leak (since,
+    -- e.g., ToIface doesn't look at them; see #13564). This is the same
+    -- approach we use in Simplify.simplUnfolding and TcIface.tcUnfolding.
 
   | otherwise
   = unf_from_rhs
-  where seqIt unf = seqUnfolding unf `seq` unf
 tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
 
 {-