[project @ 2003-09-08 11:52:24 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / IdInfo.lhs
index 18980bc..9e1a3f0 100644 (file)
@@ -25,20 +25,22 @@ module IdInfo (
 
        -- New demand and strictness info
        newStrictnessInfo, setNewStrictnessInfo, 
-       newDemandInfo, setNewDemandInfo,
+       newDemandInfo, setNewDemandInfo, pprNewStrictness,
+       setAllStrictnessInfo,
 
+#ifdef OLD_STRICTNESS
        -- Strictness; imported from Demand
        StrictnessInfo(..),
        mkStrictnessInfo, noStrictnessInfo,
        ppStrictnessInfo,isBottomingStrictness, 
-       setAllStrictnessInfo,
+#endif
 
         -- Worker
         WorkerInfo(..), workerExists, wrapperArity, workerId,
         workerInfo, setWorkerInfo, ppWorkerInfo,
 
        -- Unfolding
-       unfoldingInfo, setUnfoldingInfo, 
+       unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
 
 #ifdef OLD_STRICTNESS
        -- Old DemandInfo and StrictnessInfo
@@ -64,13 +66,8 @@ module IdInfo (
        -- Specialisation
        specInfo, setSpecInfo,
 
-       -- CG info
-       CgInfo(..), cgInfo, setCgInfo,  pprCgInfo,
-       cgCafInfo, vanillaCgInfo,
-       CgInfoEnv, lookupCgInfo,
-
        -- CAF info
-       CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
+       CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
 
         -- Lambda-bound variable info
         LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
@@ -80,10 +77,9 @@ module IdInfo (
 
 
 import CoreSyn
-import Type            ( Type, usOnce, eqUsage )
+import TyCon           ( TyCon )
+import Class           ( Class )
 import PrimOp          ( PrimOp )
-import NameEnv         ( NameEnv, lookupNameEnv )
-import Name            ( Name )
 import Var              ( Id )
 import BasicTypes      ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
                          InsideLam, insideLam, notInsideLam, 
@@ -94,14 +90,17 @@ import BasicTypes   ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBrea
 import DataCon         ( DataCon )
 import ForeignCall     ( ForeignCall )
 import FieldLabel      ( FieldLabel )
-import Type            ( usOnce, usMany )
-import Demand          hiding( Demand, seqDemand )
-import qualified Demand
 import NewDemand
 import Outputable      
-import Util            ( seqList, listLengthCmp )
 import Maybe           ( isJust )
+
+#ifdef OLD_STRICTNESS
+import Name            ( Name )
+import Demand          hiding( Demand, seqDemand )
+import qualified Demand
+import Util            ( listLengthCmp )
 import List            ( replicate )
+#endif
 
 -- infixl so you can say (id `set` a `set` b)
 infixl         1 `setSpecInfo`,
@@ -111,7 +110,6 @@ infixl      1 `setSpecInfo`,
          `setWorkerInfo`,
          `setLBVarInfo`,
          `setOccInfo`,
-         `setCgInfo`,
          `setCafInfo`,
          `setNewStrictnessInfo`,
          `setAllStrictnessInfo`,
@@ -153,6 +151,9 @@ setAllStrictnessInfo info (Just sig)
 seqNewStrictnessInfo Nothing = ()
 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 
+pprNewStrictness Nothing = empty
+pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
+
 #ifdef OLD_STRICTNESS
 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
@@ -230,14 +231,17 @@ an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
 data GlobalIdDetails
   = VanillaGlobal              -- Imported from elsewhere, a default method Id.
 
+  | GenericOpId TyCon          -- The to/from operations of a 
   | RecordSelId FieldLabel     -- The Id for a record selector
-  | DataConId DataCon          -- The Id for a data constructor *worker*
+  | 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]
 
+  | ClassOpId Class            -- An operation of a class
+
   | PrimOpId PrimOp            -- The Id for a primitive operator
   | FCallId ForeignCall                -- The Id for a foreign call
 
@@ -248,8 +252,10 @@ notGlobalId = NotGlobalId
 instance Outputable GlobalIdDetails where
     ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
     ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
-    ppr (DataConId _)     = ptext SLIT("[DataCon]")
+    ppr (GenericOpId _)   = ptext SLIT("[GenericOp]")
+    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 (RecordSelId _)   = ptext SLIT("[RecSel]")
@@ -287,7 +293,7 @@ data IdInfo
 #endif
         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
        unfoldingInfo   :: Unfolding,           -- Its unfolding
-       cgInfo          :: CgInfo,              -- Code generator info (arity, CAF info)
+       cafInfo         :: CafInfo,             -- CAF info
         lbvarInfo      :: LBVarInfo,           -- Info about a lambda-bound variable
        inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
        occInfo         :: OccInfo,             -- How it occurs
@@ -323,10 +329,8 @@ megaSeqIdInfo info
     seqCpr (cprInfo info)                      `seq`
 #endif
 
--- CgInfo is involved in a loop, so we have to be careful not to seq it
--- too early.
---    seqCg (cgInfo info)                      `seq`
-    seqLBVar (lbvarInfo info)          `seq`
+    seqCaf (cafInfo info)                      `seq`
+    seqLBVar (lbvarInfo info)                  `seq`
     seqOccInfo (occInfo info) 
 \end{code}
 
@@ -342,7 +346,11 @@ setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 #endif
        -- Try to avoid spack leaks by seq'ing
 
-setUnfoldingInfo  info uf 
+setUnfoldingInfoLazily info uf         -- Lazy variant to avoid looking at the
+  =                            -- unfolding of an imported Id unless necessary
+    info { unfoldingInfo = uf }        -- (In this case the demand-zapping is redundant.)
+
+setUnfoldingInfo info uf 
   | isEvaldUnfolding uf
        -- If the unfolding is a value, the demand info may
        -- go pear-shaped, so we nuke it.  Example:
@@ -365,8 +373,8 @@ setDemandInfo         info dd = info { demandInfo = dd }
 setCprInfo        info cp = info { cprInfo = cp }
 #endif
 
-setArityInfo     info ar = info { arityInfo = ar  }
-setCgInfo         info cg = info { cgInfo = cg }
+setArityInfo     info ar  = info { arityInfo = ar  }
+setCafInfo        info caf = info { cafInfo = caf }
 
 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 
@@ -379,7 +387,7 @@ setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 vanillaIdInfo :: IdInfo
 vanillaIdInfo 
   = IdInfo {
-           cgInfo              = noCgInfo,
+           cafInfo             = vanillaCafInfo,
            arityInfo           = unknownArity,
 #ifdef OLD_STRICTNESS
            cprInfo             = NoCPRInfo,
@@ -396,10 +404,8 @@ vanillaIdInfo
            newStrictnessInfo   = Nothing
           }
 
-noCafIdInfo = vanillaIdInfo `setCgInfo`    CgInfo NoCafRefs
+noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
        -- Used for built-in type Ids in MkId.
-       -- Many built-in things have fixed types, so we shouldn't
-       -- run around generalising them
 \end{code}
 
 
@@ -510,31 +516,7 @@ wrapperArity (HasWorker _ a) = a
 %*                                                                     *
 %************************************************************************
 
-CgInfo encapsulates calling-convention information produced by the code 
-generator.  It is pasted into the IdInfo of each emitted Id by CoreTidy,
-but only as a thunk --- the information is only actually produced further
-downstream, by the code generator.
-
 \begin{code}
-#ifndef OLD_STRICTNESS
-newtype CgInfo = CgInfo CafInfo        -- We are back to only having CafRefs in CgInfo
-noCgInfo = panic "NoCgInfo!"
-#else
-data CgInfo = CgInfo CafInfo
-           | NoCgInfo          -- In debug mode we don't want a black hole here
-                               -- See Id.idCgInfo
-       -- noCgInfo is used for local Ids, which shouldn't need any CgInfo
-noCgInfo = NoCgInfo
-#endif
-
-cgCafInfo (CgInfo caf_info) = caf_info
-
-setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info 
-
-seqCg c = c `seq` ()  -- fields are strict anyhow
-
-vanillaCgInfo = CgInfo MayHaveCafRefs          -- Definitely safe
-
 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 
 data CafInfo 
@@ -546,30 +528,17 @@ data CafInfo
        | NoCafRefs                     -- A function or static constructor
                                        -- that refers to no CAFs.
 
+vanillaCafInfo = MayHaveCafRefs                -- Definitely safe
+
 mayHaveCafRefs  MayHaveCafRefs = True
 mayHaveCafRefs _              = False
 
 seqCaf c = c `seq` ()
 
-pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info
-
-ppArity 0 = empty
-ppArity n = hsep [ptext SLIT("__A"), int n]
-
-ppCafInfo NoCafRefs = ptext SLIT("__C")
+ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 ppCafInfo MayHaveCafRefs = empty
 \end{code}
 
-\begin{code}
-type CgInfoEnv = NameEnv CgInfo
-
-lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo
-lookupCgInfo env n = case lookupNameEnv env n of
-                       Just info -> info
-                       Nothing   -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
@@ -632,42 +601,28 @@ instance Show CprInfo where
 %************************************************************************
 
 If the @Id@ is a lambda-bound variable then it may have lambda-bound
-var info.  The usage analysis (UsageSP) detects whether the lambda
-binding this var is a ``one-shot'' lambda; that is, whether it is
-applied at most once.
+var info.  Sometimes we know whether the lambda binding this var is a
+``one-shot'' lambda; that is, whether it is applied at most once.
 
 This information may be useful in optimisation, as computations may
 safely be floated inside such a lambda without risk of duplicating
 work.
 
 \begin{code}
-data LBVarInfo
-  = NoLBVarInfo
-
-  | LBVarInfo Type             -- The lambda that binds this Id has this usage
-                               --   annotation (i.e., if ==usOnce, then the
-                               --   lambda is applied at most once).
-                               -- The annotation's kind must be `$'
-                               -- HACK ALERT! placing this info here is a short-term hack,
-                               --   but it minimises changes to the rest of the compiler.
-                               --   Hack agreed by SLPJ/KSW 1999-04.
+data LBVarInfo = NoLBVarInfo 
+              | IsOneShotLambda        -- The lambda is applied at most once).
 
 seqLBVar l = l `seq` ()
 \end{code}
 
 \begin{code}
-hasNoLBVarInfo NoLBVarInfo = True
-hasNoLBVarInfo other       = False
+hasNoLBVarInfo NoLBVarInfo     = True
+hasNoLBVarInfo IsOneShotLambda = False
 
 noLBVarInfo = NoLBVarInfo
 
--- not safe to print or parse LBVarInfo because it is not really a
--- property of the definition, but a property of the context.
 pprLBVarInfo NoLBVarInfo     = empty
-pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
-                             = ptext SLIT("OneShot")
-                             | otherwise
-                             = empty
+pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 
 instance Outputable LBVarInfo where
     ppr = pprLBVarInfo