[project @ 2005-01-31 13:21:01 by simonpj]

Name evaldUnfolding = OtherCon [], and use it

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 4275132..46e957f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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