[project @ 2001-10-23 22:25:46 by sof]

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

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 045d765..1aecb54 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -20,8 +20,8 @@ module IdInfo (
 
        -- Arity
        ArityInfo,
-       exactArity, unknownArity, hasArity,
-       arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
+       unknownArity, 
+       arityInfo, setArityInfo, ppArityInfo, 
 
        -- New demand and strictness info
        newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo,
@@ -49,7 +49,7 @@ module IdInfo (
        demandInfo, setDemandInfo, 
 
        -- Inline prags
-       InlinePragInfo(..), 
+       InlinePragInfo, 
        inlinePragInfo, setInlinePragInfo, 
 
        -- Occurrence info
@@ -62,9 +62,8 @@ module IdInfo (
 
        -- CG info
        CgInfo(..), cgInfo, setCgInfo,  pprCgInfo,
-       cgArity, cgCafInfo, vanillaCgInfo,
+       cgCafInfo, vanillaCgInfo,
        CgInfoEnv, lookupCgInfo,
-       setCgArity,
 
        -- CAF info
        CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
@@ -118,7 +117,6 @@ infixl      1 `setDemandInfo`,
          `setOccInfo`,
          `setCgInfo`,
          `setCafInfo`,
-         `setCgArity`,
          `setNewStrictnessInfo`,
          `setNewDemandInfo`
        -- infixl so you can say (id `set` a `set` b)
@@ -249,7 +247,10 @@ data IdInfo
        inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
        occInfo         :: OccInfo,             -- How it occurs
 
-       newStrictnessInfo :: Maybe StrictSig,
+       newStrictnessInfo :: Maybe StrictSig,   -- Reason for Maybe: the DmdAnal phase needs to
+                                               -- know whether whether this is the first visit,
+                                               -- so it can assign botSig.  Other customers want
+                                               -- topSig.  So Nothing is good.
        newDemandInfo     :: Demand
     }
 
@@ -281,7 +282,7 @@ Setters
 
 \begin{code}
 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
-setSpecInfo      info sp = PSEQ sp (info { specInfo = sp })
+setSpecInfo      info sp = sp `seq` info { specInfo = sp }
 setTyGenInfo      info tg = tg `seq` info { tyGenInfo = tg }
 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setOccInfo       info oc = oc `seq` info { occInfo = oc }
@@ -307,7 +308,7 @@ setUnfoldingInfo  info uf
   = info { unfoldingInfo = uf }
 
 setDemandInfo    info dd = info { demandInfo = dd }
-setArityInfo     info ar = info { arityInfo = Just ar  }
+setArityInfo     info ar = info { arityInfo = ar  }
 setCgInfo         info cg = info { cgInfo = cg }
 setCprInfo        info cp = info { cprInfo = cp }
 setLBVarInfo      info lb = info { lbvarInfo = lb }
@@ -338,7 +339,7 @@ vanillaIdInfo
           }
 
 noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever
-                                  `setCgInfo`    (CgInfo 0 NoCafRefs)
+                                  `setCgInfo`    CgInfo NoCafRefs
        -- Used for built-in type Ids in MkId.
        -- Many built-in things have fixed types, so we shouldn't
        -- run around generalising them
@@ -356,7 +357,7 @@ of their arities; so it should not be asking...      (but other things
 besides the code-generator need arity info!)
 
 \begin{code}
-type ArityInfo = Maybe Arity
+type ArityInfo = Arity
        -- A partial application of this Id to up to n-1 value arguments
        -- does essentially no work.  That is not necessarily the
        -- same as saying that it has n leading lambdas, because coerces
@@ -366,21 +367,12 @@ type ArityInfo = Maybe Arity
        -- an extra lambda floats up to the binding site.
 
 seqArity :: ArityInfo -> ()
-seqArity a = arityLowerBound a `seq` ()
+seqArity a = a `seq` ()
 
-exactArity   = Just
-unknownArity = Nothing
+unknownArity = 0 :: Arity
 
-arityLowerBound :: ArityInfo -> Arity
-arityLowerBound Nothing  = 0
-arityLowerBound (Just n) = n
-
-hasArity :: ArityInfo -> Bool
-hasArity Nothing = False
-hasArity other   = True
-
-ppArityInfo Nothing     = empty
-ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity]
+ppArityInfo 0 = empty
+ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
 \end{code}
 
 %************************************************************************
@@ -545,33 +537,24 @@ but only as a thunk --- the information is only actually produced further
 downstream, by the code generator.
 
 \begin{code}
-data CgInfo = CgInfo 
-               !Arity          -- Exact arity for calling purposes
-               !CafInfo
-#ifdef DEBUG
+#ifndef DEBUG
+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
-#else
-noCgInfo = panic "NoCgInfo!"
 #endif
 
-cgArity   (CgInfo arity _)    = arity
-cgCafInfo (CgInfo _ caf_info) = caf_info
-
-setCafInfo info caf_info = 
-  case cgInfo info of { CgInfo arity _  -> 
-       info `setCgInfo` CgInfo arity caf_info }
+cgCafInfo (CgInfo caf_info) = caf_info
 
-setCgArity info arity = 
-  case cgInfo info of { CgInfo _ caf_info  -> 
-       info `setCgInfo` CgInfo arity caf_info }
+setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info 
 
 seqCg c = c `seq` ()  -- fields are strict anyhow
 
-vanillaCgInfo = CgInfo 0 MayHaveCafRefs                -- Definitely safe
+vanillaCgInfo = CgInfo MayHaveCafRefs          -- Definitely safe
 
 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 
@@ -589,7 +572,7 @@ mayHaveCafRefs _           = False
 
 seqCaf c = c `seq` ()
 
-pprCgInfo (CgInfo arity caf_info) = ppArity arity <+> ppCafInfo caf_info
+pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info
 
 ppArity 0 = empty
 ppArity n = hsep [ptext SLIT("__A"), int n]