The Big INLINE Patch: totally reorganise way that INLINE pragmas work
[ghc-hetmet.git] / compiler / basicTypes / IdInfo.lhs
index aa989b9..9446f7d 100644 (file)
@@ -9,8 +9,8 @@ Haskell. [WDP 94/11])
 
 \begin{code}
 module IdInfo (
-        -- * The GlobalIdDetails type
-       GlobalIdDetails(..), notGlobalId,       -- Not abstract
+        -- * The IdDetails type
+       IdDetails(..), pprIdDetails,
 
         -- * The IdInfo type
        IdInfo,         -- Abstract
@@ -49,11 +49,6 @@ module IdInfo (
         cprInfoFromNewStrictness,
 #endif
 
-        -- ** The WorkerInfo type
-        WorkerInfo(..),
-        workerExists, wrapperArity, workerId,
-        workerInfo, setWorkerInfo, ppWorkerInfo,
-
        -- ** Unfolding Info
        unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
 
@@ -89,12 +84,11 @@ module IdInfo (
         TickBoxOp(..), TickBoxId,
     ) where
 
-import {-# SOURCE #-} CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
+import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
 
 import Class
 import PrimOp
 import Name
-import Var
 import VarSet
 import BasicTypes
 import DataCon
@@ -119,7 +113,6 @@ infixl      1 `setSpecInfo`,
          `setArityInfo`,
          `setInlinePragInfo`,
          `setUnfoldingInfo`,
-         `setWorkerInfo`,
          `setLBVarInfo`,
          `setOccInfo`,
          `setCafInfo`,
@@ -165,8 +158,8 @@ seqNewStrictnessInfo Nothing = ()
 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 
 pprNewStrictness :: Maybe StrictSig -> SDoc
-pprNewStrictness Nothing = empty
-pprNewStrictness (Just sig) = ftext (fsLit "Str:") <+> ppr sig
+pprNewStrictness Nothing    = empty
+pprNewStrictness (Just sig) = ppr sig
 
 #ifdef OLD_STRICTNESS
 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
@@ -234,31 +227,23 @@ seqNewDemandInfo (Just dmd) = seqDemand dmd
 
 %************************************************************************
 %*                                                                     *
-\subsection{GlobalIdDetails}
+                     IdDetails
 %*                                                                     *
 %************************************************************************
 
-This type is here (rather than in Id.lhs) mainly because there's 
-an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
-(recursively) by Var.lhs.
-
 \begin{code}
--- | Information pertaining to global 'Id's. See "Var#globalvslocal" for the distinction 
--- between global and local in this context
-data GlobalIdDetails
-  = VanillaGlobal              -- ^ The 'Id' is imported from elsewhere or is a default method 'Id'
+-- | The 'IdDetails' of an 'Id' give stable, and necessary, 
+-- information about the Id. 
+data IdDetails
+  = VanillaId  
 
   -- | The 'Id' for a record selector
-  | RecordSelId                 
+  | RecSelId                 
     { sel_tycon   :: TyCon     -- ^ For a data type family, this is the /instance/ 'TyCon'
                                --   not the family 'TyCon'
-    , sel_label   :: FieldLabel
     , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
-                                -- 
-                                -- > data T = forall a. MkT { x :: a }
-    }                          
-                               -- See Note [Naughty record selectors]
-                               -- with MkId.mkRecordSelectorId
+                                --    data T = forall a. MkT { x :: a }
+    }                          -- See Note [Naughty record selectors] in TcTyClsDecls
 
   | DataConWorkId DataCon      -- ^ The 'Id' is for a data constructor /worker/
   | DataConWrapId DataCon      -- ^ The 'Id' is for a data constructor /wrapper/
@@ -268,29 +253,38 @@ data GlobalIdDetails
                                --  b) when desugaring a RecordCon we can get 
                                --     from the Id back to the data con]
 
-  | ClassOpId Class            -- ^ The 'Id' is an operation of a class
+  | ClassOpId Class            -- ^ The 'Id' is an superclass selector or class operation of a class
 
   | PrimOpId PrimOp            -- ^ The 'Id' is for a primitive operator
   | FCallId ForeignCall                -- ^ The 'Id' is for a foreign call
 
   | TickBoxOpId TickBoxOp      -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
 
-  | NotGlobalId                        -- ^ Used as a convenient extra return value from 'globalIdDetails'
-
--- | An entirely unhelpful 'GlobalIdDetails'
-notGlobalId :: GlobalIdDetails
-notGlobalId = NotGlobalId
-
-instance Outputable GlobalIdDetails where
-    ppr NotGlobalId       = ptext (sLit "[***NotGlobalId***]")
-    ppr VanillaGlobal     = ptext (sLit "[GlobalId]")
-    ppr (DataConWorkId _) = ptext (sLit "[DataCon]")
-    ppr (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
-    ppr (ClassOpId _)     = ptext (sLit "[ClassOp]")
-    ppr (PrimOpId _)      = ptext (sLit "[PrimOp]")
-    ppr (FCallId _)       = ptext (sLit "[ForeignCall]")
-    ppr (TickBoxOpId _)   = ptext (sLit "[TickBoxOp]")
-    ppr (RecordSelId {})  = ptext (sLit "[RecSel]")
+  | DFunId Bool                        -- ^ A dictionary function.  
+                               --   True <=> the class has only one method, so may be 
+                               --            implemented with a newtype, so it might be bad 
+                               --            to be strict on this dictionary
+
+
+instance Outputable IdDetails where
+    ppr = pprIdDetails
+
+pprIdDetails :: IdDetails -> SDoc
+pprIdDetails VanillaId = empty
+pprIdDetails other     = brackets (pp other)
+ where
+   pp VanillaId         = panic "pprIdDetails"
+   pp (DataConWorkId _) = ptext (sLit "DataCon")
+   pp (DataConWrapId _) = ptext (sLit "DataConWrapper")
+   pp (ClassOpId {})    = ptext (sLit "ClassOp")
+   pp (PrimOpId _)      = ptext (sLit "PrimOp")
+   pp (FCallId _)       = ptext (sLit "ForeignCall")
+   pp (TickBoxOpId _)   = ptext (sLit "TickBoxOp")
+   pp (DFunId b)        = ptext (sLit "DFunId") <> 
+                            ppWhen b (ptext (sLit "(newtype)"))
+   pp (RecSelId { sel_naughty = is_naughty })
+                        = brackets $ ptext (sLit "RecSel") 
+                           <> ppWhen is_naughty (ptext (sLit "(naughty)"))
 \end{code}
 
 
@@ -316,24 +310,16 @@ data IdInfo
   = IdInfo {
        arityInfo       :: !ArityInfo,          -- ^ 'Id' arity
        specInfo        :: SpecInfo,            -- ^ Specialisations of the 'Id's function which exist
+                                               -- See Note [Specialisations and RULES in IdInfo]
 #ifdef OLD_STRICTNESS
        cprInfo         :: CprInfo,             -- ^ If the 'Id's function always constructs a product result
        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
-       inlinePragInfo  :: InlinePragInfo,      -- ^ Any inline pragma atached to the 'Id'
+       inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'
        occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program
 
        newStrictnessInfo :: Maybe StrictSig,   -- ^ Id strictness information. Reason for Maybe: 
@@ -355,7 +341,6 @@ 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
@@ -378,11 +363,9 @@ 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
+setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setOccInfo :: IdInfo -> OccInfo -> IdInfo
 setOccInfo       info oc = oc `seq` info { occInfo = oc }
@@ -435,10 +418,9 @@ vanillaIdInfo
            strictnessInfo      = NoStrictnessInfo,
 #endif
            specInfo            = emptySpecInfo,
-           workerInfo          = NoWorker,
            unfoldingInfo       = noUnfolding,
            lbvarInfo           = NoLBVarInfo,
-           inlinePragInfo      = AlwaysActive,
+           inlinePragInfo      = defaultInlinePragma,
            occInfo             = NoOccInfo,
            newDemandInfo       = Nothing,
            newStrictnessInfo   = Nothing
@@ -497,7 +479,7 @@ ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
 --
 -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
 -- entirely as a way to inhibit inlining until we want it
-type InlinePragInfo = Activation
+type InlinePragInfo = InlinePragma
 \end{code}
 
 
@@ -507,6 +489,25 @@ type InlinePragInfo = Activation
 %*                                                                     *
 %************************************************************************
 
+Note [Specialisations and RULES in IdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally speaking, a GlobalIdshas an *empty* SpecInfo.  All their
+RULES are contained in the globally-built rule-base.  In principle,
+one could attach the to M.f the RULES for M.f that are defined in M.
+But we don't do that for instance declarations and so we just treat
+them all uniformly.
+
+The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
+jsut for convenience really.
+
+However, LocalIds may have non-empty SpecInfo.  We treat them 
+differently because:
+  a) they might be nested, in which case a global table won't work
+  b) the RULE might mention free variables, which we use to keep things alive
+
+In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
+and put in the global list.
+
 \begin{code}
 -- | Records the specializations of this 'Id' that we know about
 -- in the form of rewrite 'CoreRule's that target them
@@ -544,67 +545,6 @@ 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}
 %*                                                                     *
 %************************************************************************
@@ -623,6 +563,7 @@ data CafInfo
 
        | NoCafRefs                     -- ^ A function or static constructor
                                        -- that refers to no CAFs.
+        deriving (Eq, Ord)
 
 -- | Assumes that the 'Id' has CAF references: definitely safe
 vanillaCafInfo :: CafInfo
@@ -635,6 +576,9 @@ mayHaveCafRefs _           = False
 seqCaf :: CafInfo -> ()
 seqCaf c = c `seq` ()
 
+instance Outputable CafInfo where
+   ppr = ppCafInfo
+
 ppCafInfo :: CafInfo -> SDoc
 ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
 ppCafInfo MayHaveCafRefs = empty
@@ -667,7 +611,7 @@ data CprInfo
   | ReturnsCPR -- ^ Yes, this function returns a constructed product
                
                -- Implicitly, this means "after the function has been applied
-               -- to all its arguments", so the worker/wrapper builder in 
+               -- to all its arguments", so the worker\/wrapper builder in 
                -- WwLib.mkWWcpr checks that that it is indeed saturated before
                -- making use of the CPR info
 
@@ -778,7 +722,6 @@ 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