From: Ian Lynagh <igloo@earth.li>
Date: Wed, 20 Oct 2010 13:15:39 +0000 (+0000)
Subject: Avoid hanging on to old unfoldings; fixes #4367 (compiler space regression)
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=1bdb9062b5b8143b131bc533e4b47c67be3d458c

Avoid hanging on to old unfoldings; fixes #4367 (compiler space regression)
---

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 2e1110f..179af4f 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -721,7 +721,10 @@ simplUnfolding env top_lvl id _ _
              is_top_lvl = isTopLevel top_lvl
        ; case guide of
            UnfIfGoodArgs{} ->
-              return (mkUnfolding src' is_top_lvl (isBottomingId id) expr')
+              -- We need to force bottoming, or the new unfolding holds
+              -- on to the old unfolding (which is part of the id).
+              let bottoming = isBottomingId id
+              in bottoming `seq` return (mkUnfolding src' is_top_lvl bottoming expr')
                 -- If the guidance is UnfIfGoodArgs, this is an INLINABLE
                 -- unfolding, and we need to make sure the guidance is kept up
                 -- to date with respect to any changes in the unfolding.
@@ -735,7 +738,10 @@ simplUnfolding env top_lvl id _ _
        	       -- See Note [Simplifying inside InlineRules] in SimplUtils
 
 simplUnfolding _ top_lvl id _occ_info new_rhs _
-  = return (mkUnfolding InlineRhs (isTopLevel top_lvl) (isBottomingId id) new_rhs)
+  = -- We need to force bottoming, or the new unfolding holds
+    -- on to the old unfolding (which is part of the id).
+    let bottoming = isBottomingId id
+    in bottoming `seq` return (mkUnfolding InlineRhs (isTopLevel top_lvl) bottoming new_rhs)
   -- We make an  unfolding *even for loop-breakers*.
   -- Reason: (a) It might be useful to know that they are WHNF
   -- 	     (b) In TidyPgm we currently assume that, if we want to