[project @ 2001-03-08 12:07:38 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / IdInfo.lhs
index 32b3441..cde3737 100644 (file)
@@ -8,17 +8,15 @@ Haskell. [WDP 94/11])
 
 \begin{code}
 module IdInfo (
-       IdInfo,         -- Abstract
+       GlobalIdDetails(..), notGlobalId,       -- Not abstract
 
-       vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo,
+       IdInfo,         -- Abstract
+       vanillaIdInfo, noTyGenIdInfo, noCafOrTyGenIdInfo, noCafIdInfo,
+       seqIdInfo, megaSeqIdInfo,
 
        -- Zapping
-       zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo,
-
-       -- Flavour
-       IdFlavour(..), flavourInfo, 
-       setNoDiscardInfo, setFlavourInfo,
-       ppFlavourInfo,
+       zapLamInfo, zapDemandInfo,
+       shortableIdInfo, copyIdInfo,
 
        -- Arity
        ArityInfo(..),
@@ -60,13 +58,13 @@ module IdInfo (
        specInfo, setSpecInfo,
 
        -- CAF info
-       CafInfo(..), cafInfo, setCafInfo, ppCafInfo,
+       CafInfo(..), cafInfo, setCafInfo, mayHaveCafRefs, ppCafInfo,
 
         -- Constructed Product Result Info
         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
 
         -- Lambda-bound variable info
-        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo
+        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
     ) where
 
 #include "HsVersions.h"
@@ -103,14 +101,54 @@ infixl    1 `setDemandInfo`,
        -- infixl so you can say (id `set` a `set` b)
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{GlobalIdDetails
+%*                                                                     *
+%************************************************************************
+
+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}
+data GlobalIdDetails
+  = VanillaGlobal              -- Imported from elsewhere, a default method Id.
+
+  | RecordSelId FieldLabel     -- The Id for a record selector
+  | 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
+                               --  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]
+
+  | PrimOpId PrimOp            -- The Id for a primitive operator
+
+  | NotGlobalId                        -- Used as a convenient extra return value from globalIdDetails
+    
+notGlobalId = NotGlobalId
+
+instance Outputable GlobalIdDetails where
+    ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
+    ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
+    ppr (DataConId _)     = ptext SLIT("[DataCon]")
+    ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
+    ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
+    ppr (RecordSelId _)   = ptext SLIT("[RecSel]")
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+\subsection{The main IdInfo type}
+%*                                                                     *
+%************************************************************************
+
 An @IdInfo@ gives {\em optional} information about an @Id@.  If
 present it never lies, but it may not be present, in which case there
 is always a conservative assumption which can be made.
 
-       There is one exception: the 'flavour' is *not* optional.
-       You must not discard it.
-       It used to be in Var.lhs, but that seems unclean.
-
 Two @Id@s may have different info even though they have the same
 @Unique@ (and are hence the same @Id@); for example, one might lack
 the properties attached to the other.
@@ -123,7 +161,6 @@ case.  KSW 1999-04).
 \begin{code}
 data IdInfo
   = IdInfo {
-       flavourInfo     :: IdFlavour,           -- NOT OPTIONAL
        arityInfo       :: ArityInfo,           -- Its arity
        demandInfo      :: Demand,              -- Whether or not it is definitely demanded
        specInfo        :: CoreRules,           -- Specialisations of this function which exist
@@ -143,8 +180,7 @@ seqIdInfo (IdInfo {}) = ()
 
 megaSeqIdInfo :: IdInfo -> ()
 megaSeqIdInfo info
-  = seqFlavour (flavourInfo info)              `seq`
-    seqArity (arityInfo info)                  `seq`
+  = seqArity (arityInfo info)                  `seq`
     seqDemand (demandInfo info)                        `seq`
     seqRules (specInfo info)                   `seq`
     seqTyGenInfo (tyGenInfo info)               `seq`
@@ -164,7 +200,6 @@ 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 }
@@ -196,33 +231,14 @@ setArityInfo        info ar = info { arityInfo = ar  }
 setCafInfo        info cf = info { cafInfo = cf }
 setCprInfo        info cp = info { cprInfo = cp }
 setLBVarInfo      info lb = info { lbvarInfo = lb }
-
-setNoDiscardInfo  info = case flavourInfo info of
-                               VanillaId -> info { flavourInfo = ExportedId }
-                               other     -> info
-zapSpecPragInfo   info = case flavourInfo info of
-                               SpecPragmaId -> info { flavourInfo = VanillaId }
-                               other        -> info
 \end{code}
 
 
 \begin{code}
 vanillaIdInfo :: IdInfo
-       -- 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 -> IdInfo
-mkIdInfo flv caf 
+vanillaIdInfo 
   = IdInfo {
-           flavourInfo         = flv,
+           cafInfo             = MayHaveCafRefs,       -- Safe!
            arityInfo           = UnknownArity,
            demandInfo          = wwLazy,
            specInfo            = emptyCoreRules,
@@ -230,68 +246,23 @@ mkIdInfo flv caf
            workerInfo          = NoWorker,
            strictnessInfo      = NoStrictnessInfo,
            unfoldingInfo       = noUnfolding,
-           cafInfo             = caf
            cprInfo             = NoCPRInfo,
            lbvarInfo           = NoLBVarInfo,
            inlinePragInfo      = NoInlinePragInfo,
            occInfo             = NoOccInfo
           }
-\end{code}
 
+noTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever
+       -- Many built-in things have fixed types, so we shouldn't
+       -- run around generalising them
 
-%************************************************************************
-%*                                                                     *
-\subsection{Flavour}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-data IdFlavour
-  = 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
-                               --  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]
-  | PrimOpId PrimOp            -- The Id for a primitive operator
-  | RecordSelId FieldLabel     -- The Id for a record selector
-
+noCafIdInfo = vanillaIdInfo  `setCafInfo` NoCafRefs
+       -- Local things don't refer to Cafs
 
-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]")
-
-seqFlavour :: IdFlavour -> ()
-seqFlavour f = f `seq` ()
+noCafOrTyGenIdInfo = noTyGenIdInfo `setCafInfo` NoCafRefs
+       -- Most also guarantee not to refer to CAFs
 \end{code}
 
-The @SpecPragmaId@ exists only to make Ids that are
-on the *LHS* of bindings created by SPECIALISE pragmas; 
-eg:            s = f Int d
-The SpecPragmaId is never itself mentioned; it
-exists solely so that the specialiser will find
-the call to f, and make specialised version of it.
-The SpecPragmaId binding is discarded by the specialiser
-when it gathers up overloaded calls.
-Meanwhile, it is not discarded as dead code.
-
 
 %************************************************************************
 %*                                                                     *
@@ -488,8 +459,6 @@ seqWorker NoWorker     = ()
 ppWorkerInfo NoWorker            = empty
 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
 
-noWorkerInfo = NoWorker
-
 workerExists :: WorkerInfo -> Bool
 workerExists NoWorker        = False
 workerExists (HasWorker _ _) = True
@@ -525,6 +494,9 @@ data CafInfo
 --      | OneCafRef Id
 
 
+mayHaveCafRefs MayHaveCafRefs = True
+mayHaveCafRefs _             = False
+
 seqCaf c = c `seq` ()
 
 ppCafInfo NoCafRefs = ptext SLIT("__C")
@@ -618,6 +590,9 @@ seqLBVar l = l `seq` ()
 \end{code}
 
 \begin{code}
+hasNoLBVarInfo NoLBVarInfo = True
+hasNoLBVarInfo other       = False
+
 noLBVarInfo = NoLBVarInfo
 
 -- not safe to print or parse LBVarInfo because it is not really a
@@ -645,54 +620,6 @@ instance Show LBVarInfo where
 %*                                                                     *
 %************************************************************************
 
-zapFragileInfo is used when cloning binders, mainly in the
-simplifier.  We must forget about used-once information because that
-isn't necessarily correct in the transformed program.
-Also forget specialisations and unfoldings because they would need
-substitution to be correct.  (They get pinned back on separately.)
-
-\begin{code}
-zapFragileInfo :: IdInfo -> Maybe IdInfo
-zapFragileInfo info@(IdInfo {occInfo           = occ, 
-                            workerInfo         = wrkr,
-                            specInfo           = rules, 
-                            unfoldingInfo      = unfolding})
-  |  not (isFragileOcc occ)
-        -- We must forget about whether it was marked safe-to-inline,
-       -- because that isn't necessarily true in the simplified expression.
-       -- This is important because expressions may  be re-simplified
-       -- We don't zap deadness or loop-breaker-ness.
-       -- The latter is important because it tells MkIface not to 
-       -- spit out an inlining for the thing.  The former doesn't
-       -- seem so important, but there's no harm.
-
-  && isEmptyCoreRules rules
-       -- Specialisations would need substituting.  They get pinned
-       -- back on separately.
-
-  && not (workerExists wrkr)
-
-  && not (hasUnfolding unfolding)
-       -- This is very important; occasionally a let-bound binder is used
-       -- as a binder in some lambda, in which case its unfolding is utterly
-       -- bogus.  Also the unfolding uses old binders so if we left it we'd
-       -- have to substitute it. Much better simply to give the Id a new
-       -- unfolding each time, which is what the simplifier does.
-  = Nothing
-
-  | otherwise
-  = Just (info {occInfo                = robust_occ_info,
-               workerInfo      = noWorkerInfo,
-               specInfo        = emptyCoreRules,
-               unfoldingInfo   = noUnfolding})
-  where
-       -- It's important to keep the loop-breaker info,
-       -- because the substitution doesn't remember it.
-    robust_occ_info = case occ of
-                       OneOcc _ _ -> NoOccInfo
-                       other      -> occ
-\end{code}
-
 @zapLamInfo@ is used for lambda binders that turn out to to be
 part of an unsaturated lambda
 
@@ -716,6 +643,13 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
                 other         -> occ
 \end{code}
 
+\begin{code}
+zapDemandInfo :: IdInfo -> Maybe IdInfo
+zapDemandInfo info@(IdInfo {demandInfo = demand})
+  | not (isStrict demand) = Nothing
+  | otherwise            = Just (info {demandInfo = wwLazy})
+\end{code}
+
 
 copyIdInfo is used when shorting out a top-level binding
        f_local = BIG