From 94df10136b6e879bb55ce04796942da9d0367a5a Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 31 Jan 2005 13:21:10 +0000
Subject: [PATCH] [project @ 2005-01-31 13:21:01 by simonpj] Name
 evaldUnfolding = OtherCon [], and use it

---
 ghc/compiler/basicTypes/MkId.lhs    |    6 ++++--
 ghc/compiler/coreSyn/CoreSyn.lhs    |    8 +++++---
 ghc/compiler/coreSyn/CoreUnfold.lhs |    2 +-
 ghc/compiler/stranal/WwLib.lhs      |    2 +-
 4 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 4275132..46e957f 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -214,6 +214,8 @@ mkDataConIds wrap_name wkr_name data_con
     wkr_info  = noCafIdInfo
 	        `setArityInfo`		wkr_arity
 	        `setAllStrictnessInfo`	Just wkr_sig
+		`setUnfoldingInfo`      evaldUnfolding	-- Record that it's evaluated,
+							-- even if arity = 0
 
     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
 	-- Notice that we do *not* say the worker is strict
@@ -891,8 +893,8 @@ This comes up in strictness analysis
 \begin{code}
 realWorldPrimId	-- :: State# RealWorld
   = pcMiscPrelId realWorldName realWorldStatePrimTy
-		 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
-	-- The mkOtherCon makes it look that realWorld# is evaluated
+		 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
+	-- The evaldUnfolding makes it look that realWorld# is evaluated
 	-- which in turn makes Simplify.interestingArg return True,
 	-- which in turn makes INLINE things applied to realWorld# likely
 	-- to be inlined
diff --git a/ghc/compiler/coreSyn/CoreSyn.lhs b/ghc/compiler/coreSyn/CoreSyn.lhs
index 3e91276..0a2bd0d 100644
--- a/ghc/compiler/coreSyn/CoreSyn.lhs
+++ b/ghc/compiler/coreSyn/CoreSyn.lhs
@@ -26,7 +26,7 @@ module CoreSyn (
 
 	-- Unfoldings
 	Unfolding(..),	UnfoldingGuidance(..), 	-- Both abstract everywhere but in CoreUnfold.lhs
-	noUnfolding, mkOtherCon,
+	noUnfolding, evaldUnfolding, mkOtherCon,
 	unfoldingTemplate, maybeUnfoldingTemplate, otherCons, 
 	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
 	hasUnfolding, hasSomeUnfolding, neverUnfold,
@@ -268,8 +268,10 @@ data UnfoldingGuidance
 				-- a context (case (thing args) of ...),
 				-- (where there are the right number of arguments.)
 
-noUnfolding = NoUnfolding
-mkOtherCon  = OtherCon
+noUnfolding    = NoUnfolding
+evaldUnfolding = OtherCon []
+
+mkOtherCon = OtherCon
 
 seqUnfolding :: Unfolding -> ()
 seqUnfolding (CoreUnfolding e top b1 b2 g)
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index cc664f1..3327e8b 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -17,7 +17,7 @@ module CoreUnfold (
 	Unfolding, UnfoldingGuidance,	-- Abstract types
 
 	noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding,
-	mkOtherCon, otherCons,
+	evaldUnfolding, mkOtherCon, otherCons,
 	unfoldingTemplate, maybeUnfoldingTemplate,
 	isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
 	hasUnfolding, hasSomeUnfolding, neverUnfold,
diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs
index 3d59539..54a167d 100644
--- a/ghc/compiler/stranal/WwLib.lhs
+++ b/ghc/compiler/stranal/WwLib.lhs
@@ -358,7 +358,7 @@ mkWWstr_one arg
 	-- of dropping seqs in the worker
       Eval (Poly Abs)
 	-> let
-		arg_w_unf = arg `setIdUnfolding` mkOtherCon []
+		arg_w_unf = arg `setIdUnfolding` evaldUnfolding
 		-- Tell the worker arg that it's sure to be evaluated
 		-- so that internal seqs can be dropped
 	   in
-- 
1.7.10.4