Fix initialisation of strictness in the demand analyser

[ghc-hetmet.git] / compiler / simplCore / Simplify.lhs

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 9e73359..179af4f 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -718,15 +718,30 @@ simplUnfolding env top_lvl id _ _
   | isStableSource src
   = do { expr' <- simplExpr rule_env expr
        ; let src' = CoreSubst.substUnfoldingSource (mkCoreSubst (text "inline-unf") env) src
-       ; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
+             is_top_lvl = isTopLevel top_lvl
+       ; case guide of
+           UnfIfGoodArgs{} ->
+              -- 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.
+           _other -> 
+              return (mkCoreUnfolding src' is_top_lvl expr' arity guide)
                -- See Note [Top-level flag on inline rules] in CoreUnfold
+       }
   where
     act      = idInlineActivation id
     rule_env = updMode (updModeForInlineRules act) env
                       -- 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