[project @ 2005-10-14 11:22:41 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / IdInfo.lhs

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 88d0f3d..d53bf56 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -63,7 +63,8 @@ module IdInfo (
        occInfo, setOccInfo, 
 
        -- Specialisation
-       specInfo, setSpecInfo,
+       SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, 
+       specInfoFreeVars, specInfoRules, seqSpecInfo,
 
        -- CAF info
        CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
@@ -79,6 +80,7 @@ import CoreSyn
 import Class           ( Class )
 import PrimOp          ( PrimOp )
 import Var              ( Id )
+import VarSet          ( VarSet, emptyVarSet, seqVarSet )
 import BasicTypes      ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
                          InsideLam, insideLam, notInsideLam, 
                          OneBranch, oneBranch, notOneBranch,
@@ -229,14 +231,19 @@ an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
 data GlobalIdDetails
   = VanillaGlobal              -- Imported from elsewhere, a default method Id.
 
-  | RecordSelId TyCon FieldLabel  -- The Id for a record selector
+  | RecordSelId                 -- The Id for a record selector
+    { sel_tycon   :: TyCon
+    , sel_label   :: FieldLabel
+    , sel_naughty :: Bool       -- True <=> naughty
+    }                          -- See Note [Naughty record selectors]
+                               -- with MkId.mkRecordSelectorId
 
   | DataConWorkId DataCon      -- The Id for a data constructor *worker*
   | DataConWrapId DataCon      -- The Id for a data constructor *wrapper*
                                -- [the only reasons we need to know is so that
-                               --  a) we can  suppress printing a definition in the interface file
-                               --  b) when typechecking a pattern we can get from the
-                               --     Id back to the data con]
+                               --  a) to support isImplicitId
+                               --  b) when desugaring a RecordCon we can get 
+                               --     from the Id back to the data con]
 
   | ClassOpId Class            -- An operation of a class
 
@@ -255,7 +262,7 @@ instance Outputable GlobalIdDetails where
     ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
-    ppr (RecordSelId _ _) = ptext SLIT("[RecSel]")
+    ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
 \end{code}
 
 
@@ -282,13 +289,20 @@ case.  KSW 1999-04).
 data IdInfo
   = IdInfo {
        arityInfo       :: !ArityInfo,          -- Its arity
-       specInfo        :: CoreRules,           -- Specialisations of this function which exist
+       specInfo        :: SpecInfo,            -- Specialisations of this function which exist
 #ifdef OLD_STRICTNESS
        cprInfo         :: CprInfo,             -- Function always constructs a product result
        demandInfo      :: Demand.Demand,       -- Whether or not it is definitely demanded
        strictnessInfo  :: StrictnessInfo,      -- 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
+                                               -- 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,           -- Its unfolding
        cafInfo         :: CafInfo,             -- CAF info
         lbvarInfo      :: LBVarInfo,           -- Info about a lambda-bound variable
@@ -310,7 +324,7 @@ seqIdInfo (IdInfo {}) = ()
 
 megaSeqIdInfo :: IdInfo -> ()
 megaSeqIdInfo info
-  = seqRules (specInfo info)                   `seq`
+  = seqSpecInfo (specInfo info)                        `seq`
     seqWorker (workerInfo info)                        `seq`
 
 -- Omitting this improves runtimes a little, presumably because
@@ -378,7 +392,7 @@ vanillaIdInfo
            demandInfo          = wwLazy,
            strictnessInfo      = NoStrictnessInfo,
 #endif
-           specInfo            = emptyCoreRules,
+           specInfo            = emptySpecInfo,
            workerInfo          = NoWorker,
            unfoldingInfo       = noUnfolding,
            lbvarInfo           = NoLBVarInfo,
@@ -433,6 +447,36 @@ type InlinePragInfo = Activation
        --
        -- If there was an INLINE pragma, then as a separate matter, the
        -- RHS will have been made to look small with a CoreSyn Inline Note
+
+       -- The default InlinePragInfo is AlwaysActive, so the info serves
+       -- entirely as a way to inhibit inlining until we want it
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+       SpecInfo
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+-- CoreRules is used only in an idSpecialisation (move to IdInfo?)
+data SpecInfo 
+  = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs
+
+emptySpecInfo :: SpecInfo
+emptySpecInfo = SpecInfo [] emptyVarSet
+
+isEmptySpecInfo :: SpecInfo -> Bool
+isEmptySpecInfo (SpecInfo rs _) = null rs
+
+specInfoFreeVars :: SpecInfo -> VarSet
+specInfoFreeVars (SpecInfo _ fvs) = fvs
+
+specInfoRules :: SpecInfo -> [CoreRule]
+specInfoRules (SpecInfo rules _) = rules
+
+seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 \end{code}
 
 
@@ -635,12 +679,12 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
   where
        -- The "unsafe" occ info is the ones that say I'm not in a lambda
        -- because that might not be true for an unsaturated lambda
-    is_safe_occ (OneOcc in_lam once) = in_lam
-    is_safe_occ other               = True
+    is_safe_occ (OneOcc in_lam _ _) = in_lam
+    is_safe_occ other              = True
 
     safe_occ = case occ of
-                OneOcc _ once -> OneOcc insideLam once
-                other         -> occ
+                OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
+                other                 -> occ
 
     is_safe_dmd Nothing    = True
     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)