X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=26fe4531ae44ed3a50aa26a79c2c3b96f7dbf635;hp=fca1abd1cfac962b49d07fef1f55f561bfc462d3;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=d95ce839533391e7118257537044f01cbb1d6694

diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index fca1abd..26fe453 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -49,6 +49,11 @@ module IdInfo (
         cprInfoFromNewStrictness,
 #endif
 
+        -- ** The WorkerInfo type
+        WorkerInfo(..),
+        workerExists, wrapperArity, workerId,
+        workerInfo, setWorkerInfo, ppWorkerInfo,
+
 	-- ** Unfolding Info
 	unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
 
@@ -89,6 +94,7 @@ import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
 import Class
 import PrimOp
 import Name
+import Var
 import VarSet
 import BasicTypes
 import DataCon
@@ -113,6 +119,7 @@ infixl 	1 `setSpecInfo`,
 	  `setArityInfo`,
 	  `setInlinePragInfo`,
 	  `setUnfoldingInfo`,
+	  `setWorkerInfo`,
 	  `setLBVarInfo`,
 	  `setOccInfo`,
 	  `setCafInfo`,
@@ -314,6 +321,15 @@ data IdInfo
 	demandInfo 	:: Demand.Demand,	-- ^ Whether or not the 'Id' is definitely demanded
 	strictnessInfo	:: StrictnessInfo,	-- ^ 'Id' strictness properties
 #endif
+        workerInfo      :: WorkerInfo,          -- ^ Pointer to worker function.
+						-- Within one module this is irrelevant; the 
+						-- inlining of a worker is handled via the 'Unfolding'.
+						-- However, when the module is imported by others, the
+						-- 'WorkerInfo' is used /only/ to indicate the form of
+						-- the RHS, so that interface files don't actually 
+						-- need to contain the RHS; it can be derived from
+						-- the strictness info
+
 	unfoldingInfo	:: Unfolding,		-- ^ The 'Id's unfolding
 	cafInfo		:: CafInfo,		-- ^ 'Id' CAF info
         lbvarInfo	:: LBVarInfo,		-- ^ Info about a lambda-bound variable, if the 'Id' is one
@@ -339,6 +355,7 @@ seqIdInfo (IdInfo {}) = ()
 megaSeqIdInfo :: IdInfo -> ()
 megaSeqIdInfo info
   = seqSpecInfo (specInfo info)			`seq`
+    seqWorker (workerInfo info)			`seq`
 
 -- Omitting this improves runtimes a little, presumably because
 -- some unfoldings are not calculated at all
@@ -361,6 +378,8 @@ megaSeqIdInfo info
 Setters
 
 \begin{code}
+setWorkerInfo :: IdInfo -> WorkerInfo -> IdInfo
+setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
 setSpecInfo 	  info sp = sp `seq` info { specInfo = sp }
 setInlinePragInfo :: IdInfo -> InlinePragInfo -> IdInfo
@@ -416,6 +435,7 @@ vanillaIdInfo
 	    strictnessInfo	= NoStrictnessInfo,
 #endif
 	    specInfo		= emptySpecInfo,
+	    workerInfo		= NoWorker,
 	    unfoldingInfo	= noUnfolding,
 	    lbvarInfo		= NoLBVarInfo,
 	    inlinePragInfo 	= AlwaysActive,
@@ -524,6 +544,67 @@ seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 
 %************************************************************************
 %*									*
+\subsection[worker-IdInfo]{Worker info about an @Id@}
+%*									*
+%************************************************************************
+
+There might not be a worker, even for a strict function, because:
+(a) the function might be small enough to inline, so no need 
+    for w/w split
+(b) the strictness info might be "SSS" or something, so no w/w split.
+
+Sometimes the arity of a wrapper changes from the original arity from
+which it was generated, so we always emit the "original" arity into
+the interface file, as part of the worker info.
+
+How can this happen?  Sometimes we get
+	f = coerce t (\x y -> $wf x y)
+at the moment of w/w split; but the eta reducer turns it into
+	f = coerce t $wf
+which is perfectly fine except that the exposed arity so far as
+the code generator is concerned (zero) differs from the arity
+when we did the split (2).  
+
+All this arises because we use 'arity' to mean "exactly how many
+top level lambdas are there" in interface files; but during the
+compilation of this module it means "how many things can I apply
+this to".
+
+\begin{code}
+
+-- | If this Id has a worker then we store a reference to it. Worker
+-- functions are generated by the worker\/wrapper pass, using information
+-- information from strictness analysis.
+data WorkerInfo = NoWorker              -- ^ No known worker function
+		| HasWorker Id Arity    -- ^ The 'Arity' is the arity of the /wrapper/ at the moment of the
+	                                -- worker\/wrapper split, which may be different from the current 'Id' 'Aritiy'
+
+seqWorker :: WorkerInfo -> ()
+seqWorker (HasWorker id a) = id `seq` a `seq` ()
+seqWorker NoWorker	   = ()
+
+ppWorkerInfo :: WorkerInfo -> SDoc
+ppWorkerInfo NoWorker            = empty
+ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id
+
+workerExists :: WorkerInfo -> Bool
+workerExists NoWorker        = False
+workerExists (HasWorker _ _) = True
+
+-- | The 'Id' of the worker function if it exists, or a panic otherwise
+workerId :: WorkerInfo -> Id
+workerId (HasWorker id _) = id
+workerId NoWorker = panic "workerId: NoWorker"
+
+-- | The 'Arity' of the worker function at the time of the split if it exists, or a panic otherwise
+wrapperArity :: WorkerInfo -> Arity
+wrapperArity (HasWorker _ a) = a
+wrapperArity NoWorker = panic "wrapperArity: NoWorker"
+\end{code}
+
+
+%************************************************************************
+%*									*
 \subsection[CG-IdInfo]{Code generator-related information}
 %*									*
 %************************************************************************
@@ -698,6 +779,7 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo
 -- ^ Zap info that depends on free variables
 zapFragileInfo info 
   = Just (info `setSpecInfo` emptySpecInfo
+	       `setWorkerInfo` NoWorker
                `setUnfoldingInfo` noUnfolding
 	       `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
   where