[project @ 2000-12-20 10:36:23 by simonmar]

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

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 1fdf18e..79073fa 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -10,14 +10,14 @@ Haskell. [WDP 94/11])
 module IdInfo (
        IdInfo,         -- Abstract
 
-       vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo,
+       vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo,
 
        -- Zapping
        zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo,
 
        -- Flavour
        IdFlavour(..), flavourInfo, 
-       setNoDiscardInfo,
+       setNoDiscardInfo, setFlavourInfo,
        ppFlavourInfo,
 
        -- Arity
@@ -60,7 +60,7 @@ module IdInfo (
        specInfo, setSpecInfo,
 
        -- CAF info
-       CafInfo(..), cafInfo, setCafInfo, ppCafInfo,
+       CafInfo(..), cafInfo, setCafInfo, mayHaveCafRefs, ppCafInfo,
 
         -- Constructed Product Result Info
         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
@@ -131,7 +131,7 @@ data IdInfo
        strictnessInfo  :: StrictnessInfo,      -- Strictness properties
         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
        unfoldingInfo   :: Unfolding,           -- Its unfolding
-       cafInfo         :: CafInfo,
+       cafInfo         :: CafInfo,             -- whether it refers (indirectly) to any CAFs
        cprInfo         :: CprInfo,             -- Function always constructs a product result
         lbvarInfo      :: LBVarInfo,           -- Info about a lambda-bound variable
        inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
@@ -164,6 +164,7 @@ megaSeqIdInfo info
 Setters
 
 \begin{code}
+setFlavourInfo    info fl = fl `seq` info { flavourInfo = fl }
 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 setSpecInfo      info sp = PSEQ sp (info { specInfo = sp })
 setTyGenInfo      info tg = tg `seq` info { tyGenInfo = tg }
@@ -197,7 +198,7 @@ setCprInfo        info cp = info { cprInfo = cp }
 setLBVarInfo      info lb = info { lbvarInfo = lb }
 
 setNoDiscardInfo  info = case flavourInfo info of
-                               VanillaId -> info { flavourInfo = NoDiscardId }
+                               VanillaId -> info { flavourInfo = ExportedId }
                                other     -> info
 zapSpecPragInfo   info = case flavourInfo info of
                                SpecPragmaId -> info { flavourInfo = VanillaId }
@@ -207,23 +208,33 @@ zapSpecPragInfo   info = case flavourInfo info of
 
 \begin{code}
 vanillaIdInfo :: IdInfo
-vanillaIdInfo = mkIdInfo VanillaId
-
-mkIdInfo :: IdFlavour -> IdInfo
-mkIdInfo flv = IdInfo {
-                   flavourInfo         = flv,
-                   arityInfo           = UnknownArity,
-                   demandInfo          = wwLazy,
-                   specInfo            = emptyCoreRules,
-                    tyGenInfo          = noTyGenInfo,
-                   workerInfo          = NoWorker,
-                   strictnessInfo      = NoStrictnessInfo,
-                   unfoldingInfo       = noUnfolding,
-                   cafInfo             = MayHaveCafRefs,
-                   cprInfo             = NoCPRInfo,
-                   lbvarInfo           = NoLBVarInfo,
-                   inlinePragInfo      = NoInlinePragInfo,
-                   occInfo             = NoOccInfo
+       -- Used for locally-defined Ids
+       -- We are going to calculate correct CAF information at the end
+vanillaIdInfo = mkIdInfo VanillaId NoCafRefs
+
+constantIdInfo :: IdInfo
+       -- Used for imported Ids
+       -- The default is that they *do* have CAFs; an interface-file pragma
+       -- may say "oh no it doesn't", but in the absence of such a pragma
+       -- we'd better assume it does
+constantIdInfo = mkIdInfo ConstantId MayHaveCafRefs
+
+mkIdInfo :: IdFlavour -> CafInfo -> IdInfo
+mkIdInfo flv caf 
+  = IdInfo {
+           flavourInfo         = flv,
+           cafInfo             = caf,
+           arityInfo           = UnknownArity,
+           demandInfo          = wwLazy,
+           specInfo            = emptyCoreRules,
+            tyGenInfo          = noTyGenInfo,
+           workerInfo          = NoWorker,
+           strictnessInfo      = NoStrictnessInfo,
+           unfoldingInfo       = noUnfolding,
+           cprInfo             = NoCPRInfo,
+           lbvarInfo           = NoLBVarInfo,
+           inlinePragInfo      = NoInlinePragInfo,
+           occInfo             = NoOccInfo
           }
 \end{code}
 
@@ -236,7 +247,16 @@ mkIdInfo flv = IdInfo {
 
 \begin{code}
 data IdFlavour
-  = VanillaId                  -- Most Ids are like this
+  = VanillaId                  -- Locally defined, not exported
+  | ExportedId                 -- Locally defined, exported
+  | SpecPragmaId               -- Locally defined, RHS holds specialised call
+
+  | ConstantId                         -- Imported from elsewhere, or a default method Id.
+
+  | DictFunId                  -- We flag dictionary functions so that we can
+                               -- conveniently extract the DictFuns from a set of
+                               -- bindings when building a module's interface
+
   | DataConId 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
@@ -245,17 +265,18 @@ data IdFlavour
                                --     Id back to the data con]
   | PrimOpId PrimOp            -- The Id for a primitive operator
   | RecordSelId FieldLabel     -- The Id for a record selector
-  | SpecPragmaId               -- Don't discard these
-  | NoDiscardId                        -- Don't discard these either
+
 
 ppFlavourInfo :: IdFlavour -> SDoc
 ppFlavourInfo VanillaId         = empty
+ppFlavourInfo ExportedId        = ptext SLIT("[Exported]")
+ppFlavourInfo SpecPragmaId     = ptext SLIT("[SpecPrag]")
+ppFlavourInfo ConstantId        = ptext SLIT("[Constant]")
+ppFlavourInfo DictFunId         = ptext SLIT("[DictFun]")
 ppFlavourInfo (DataConId _)     = ptext SLIT("[DataCon]")
 ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
 ppFlavourInfo (PrimOpId _)     = ptext SLIT("[PrimOp]")
 ppFlavourInfo (RecordSelId _)  = ptext SLIT("[RecSel]")
-ppFlavourInfo SpecPragmaId     = ptext SLIT("[SpecPrag]")
-ppFlavourInfo NoDiscardId      = ptext SLIT("[NoDiscard]")
 
 seqFlavour :: IdFlavour -> ()
 seqFlavour f = f `seq` ()
@@ -504,6 +525,9 @@ data CafInfo
 --      | OneCafRef Id
 
 
+mayHaveCafRefs MayHaveCafRefs = True
+mayHaveCafRefs _             = False
+
 seqCaf c = c `seq` ()
 
 ppCafInfo NoCafRefs = ptext SLIT("__C")