[project @ 2001-03-01 17:10:06 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / IdInfo.lhs
index 32b3441..91ecbe2 100644 (file)
@@ -13,10 +13,11 @@ module IdInfo (
        vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo,
 
        -- Zapping
-       zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo,
+       zapLamInfo, zapDemandInfo,
+       zapSpecPragInfo, shortableIdInfo, copyIdInfo,
 
        -- Flavour
-       IdFlavour(..), flavourInfo, 
+       IdFlavour(..), flavourInfo,  makeConstantFlavour,
        setNoDiscardInfo, setFlavourInfo,
        ppFlavourInfo,
 
@@ -60,13 +61,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"
@@ -219,10 +220,11 @@ constantIdInfo :: IdInfo
        -- we'd better assume it does
 constantIdInfo = mkIdInfo ConstantId MayHaveCafRefs
 
-mkIdInfo :: IdFlavour -> IdInfo
+mkIdInfo :: IdFlavour -> CafInfo -> IdInfo
 mkIdInfo flv caf 
   = IdInfo {
            flavourInfo         = flv,
+           cafInfo             = caf,
            arityInfo           = UnknownArity,
            demandInfo          = wwLazy,
            specInfo            = emptyCoreRules,
@@ -230,7 +232,6 @@ mkIdInfo flv caf
            workerInfo          = NoWorker,
            strictnessInfo      = NoStrictnessInfo,
            unfoldingInfo       = noUnfolding,
-           cafInfo             = caf
            cprInfo             = NoCPRInfo,
            lbvarInfo           = NoLBVarInfo,
            inlinePragInfo      = NoInlinePragInfo,
@@ -267,6 +268,18 @@ data IdFlavour
   | RecordSelId FieldLabel     -- The Id for a record selector
 
 
+makeConstantFlavour :: IdFlavour -> IdFlavour
+makeConstantFlavour flavour = new_flavour
+  where new_flavour = case flavour of
+                       VanillaId  -> ConstantId
+                       ExportedId -> ConstantId
+                       ConstantId -> ConstantId        -- e.g. Default methods
+                       DictFunId  -> DictFunId
+                       flavour    -> pprTrace "makeConstantFlavour" 
+                                       (ppFlavourInfo flavour)
+                                       flavour
+
+
 ppFlavourInfo :: IdFlavour -> SDoc
 ppFlavourInfo VanillaId         = empty
 ppFlavourInfo ExportedId        = ptext SLIT("[Exported]")
@@ -525,6 +538,9 @@ data CafInfo
 --      | OneCafRef Id
 
 
+mayHaveCafRefs MayHaveCafRefs = True
+mayHaveCafRefs _             = False
+
 seqCaf c = c `seq` ()
 
 ppCafInfo NoCafRefs = ptext SLIT("__C")
@@ -618,6 +634,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 +664,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 +687,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