X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=f6e8569936c67c78da9938fbf739f13031897617;hp=37fa798965bd6bea2dc323313f0570aabcbfbc63;hb=b84ba676034763b3082bbd9405794a4fde499d14;hpb=015d3d46b6de2f95386a515a7d166d996a0416db

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 37fa798..f6e8569 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -662,7 +662,7 @@ addNonRecWithUnf env new_bndr new_rhs new_unfolding
 
 ------------------------------
 simplUnfolding :: SimplEnv-> TopLevelFlag
-	       -> Id	-- Debug output only
+	       -> Id
 	       -> OccInfo -> OutExpr
 	       -> Unfolding -> SimplM Unfolding
 -- Note [Setting the new unfolding]
@@ -681,8 +681,8 @@ simplUnfolding env top_lvl _ _ _
        ; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
 		-- See Note [Top-level flag on inline rules] in CoreUnfold
 
-simplUnfolding _ top_lvl _ _occ_info new_rhs _
-  = return (mkUnfolding (isTopLevel top_lvl) new_rhs)
+simplUnfolding _ top_lvl id _occ_info new_rhs _
+  = return (mkUnfolding (isTopLevel top_lvl) (isBottomingId id) 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
@@ -1724,7 +1724,7 @@ simplAlt env _ case_bndr' cont' (DataAlt con, vs, rhs)
 
 addBinderUnfolding :: SimplEnv -> Id -> CoreExpr -> SimplEnv
 addBinderUnfolding env bndr rhs
-  = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False rhs)
+  = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False False rhs)
 
 addBinderOtherCon :: SimplEnv -> Id -> [AltCon] -> SimplEnv
 addBinderOtherCon env bndr cons