Rollback INLINE patches
[ghc-hetmet.git] / compiler / basicTypes / IdInfo.lhs
index fca1abd..26fe453 100644 (file)
@@ -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