[project @ 2002-03-15 13:57:27 by simonmar]

Take the old strictness analyser out of #ifdef DEBUG and put it
instead in #ifdef OLD_STRICTNESS.  DEBUG was getting a bit slow.

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 1e4097d..9fa37b1 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -52,7 +52,7 @@ module Id (
        setIdCgInfo,
        setIdOccInfo,
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        idDemandInfo, 
        idStrictness, 
        idCprInfo,
@@ -73,7 +73,7 @@ module Id (
        idLBVarInfo,
        idOccInfo,
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        newStrictnessFromOld    -- Temporary
 #endif
 
@@ -123,7 +123,7 @@ infixl      1 `setIdUnfolding`,
          `setIdSpecialisation`,
          `setInlinePragma`,
          `idCafInfo`
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
          ,`idCprInfo`
          ,`setIdStrictness`
          ,`setIdDemandInfo`
@@ -323,7 +323,7 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        ---------------------------------
        -- (OLD) STRICTNESS 
 idStrictness :: Id -> StrictnessInfo
@@ -373,7 +373,7 @@ idUnfolding id = unfoldingInfo (idInfo id)
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        ---------------------------------
        -- (OLD) DEMAND
 idDemandInfo :: Id -> Demand.Demand
@@ -400,7 +400,7 @@ setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
        ---------------------------------
        -- CG INFO
 idCgInfo :: Id -> CgInfo
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCgInfo id = case cgInfo (idInfo id) of
                  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
                  info     -> info
@@ -414,7 +414,7 @@ setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
        ---------------------------------
        -- CAF INFO
 idCafInfo :: Id -> CafInfo
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCafInfo id = case cgInfo (idInfo id) of
                  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
                  info     -> cgCafInfo info
@@ -423,7 +423,7 @@ idCafInfo id = cgCafInfo (idCgInfo id)
 #endif
        ---------------------------------
        -- CPR INFO
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCprInfo :: Id -> CprInfo
 idCprInfo id = cprInfo (idInfo id)
 

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index b39b60c..9910d1f 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -45,7 +45,7 @@ module IdInfo (
        -- Unfolding
        unfoldingInfo, setUnfoldingInfo, 
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        -- Old DemandInfo and StrictnessInfo
        demandInfo, setDemandInfo, 
        strictnessInfo, setStrictnessInfo,
@@ -121,7 +121,7 @@ infixl      1 `setTyGenInfo`,
          `setNewStrictnessInfo`,
          `setAllStrictnessInfo`,
          `setNewDemandInfo`
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
          , `setCprInfo`
          , `setDemandInfo`
          , `setStrictnessInfo`
@@ -141,7 +141,7 @@ To be removed later
 -- Set old and new strictness info
 setAllStrictnessInfo info Nothing
   = info { newStrictnessInfo = Nothing
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
          , strictnessInfo = NoStrictnessInfo
          , cprInfo = NoCPRInfo
 #endif
@@ -149,7 +149,7 @@ setAllStrictnessInfo info Nothing
 
 setAllStrictnessInfo info (Just sig)
   = info { newStrictnessInfo = Just sig
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
          , strictnessInfo = oldStrictnessFromNew sig
          , cprInfo = cprInfoFromNewStrictness sig
 #endif
@@ -158,7 +158,7 @@ setAllStrictnessInfo info (Just sig)
 seqNewStrictnessInfo Nothing = ()
 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
                         where
@@ -211,7 +211,7 @@ oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
 oldDemand (Eval (Poly _))  = WwStrict
 oldDemand (Call _)         = WwStrict
 
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
 \end{code}
 
 
@@ -280,7 +280,7 @@ data IdInfo
        arityInfo       :: !ArityInfo,          -- Its arity
        specInfo        :: CoreRules,           -- Specialisations of this function which exist
         tyGenInfo       :: TyGenInfo,           -- Restrictions on usage-generalisation of this Id
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        cprInfo         :: CprInfo,             -- Function always constructs a product result
        demandInfo      :: Demand.Demand,       -- Whether or not it is definitely demanded
        strictnessInfo  :: StrictnessInfo,      -- Strictness properties
@@ -315,7 +315,7 @@ megaSeqIdInfo info
     seqDemand (newDemandInfo info)             `seq`
     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
     Demand.seqDemand (demandInfo info)         `seq`
     seqStrictnessInfo (strictnessInfo info)    `seq`
     seqCpr (cprInfo info)                      `seq`
@@ -336,7 +336,7 @@ 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 }
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 #endif
        -- Try to avoid spack leaks by seq'ing
@@ -359,7 +359,7 @@ setUnfoldingInfo  info uf
        -- actually increases residency significantly. 
   = info { unfoldingInfo = uf }
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 setDemandInfo    info dd = info { demandInfo = dd }
 setCprInfo        info cp = info { cprInfo = cp }
 #endif
@@ -380,7 +380,7 @@ vanillaIdInfo
   = IdInfo {
            cgInfo              = noCgInfo,
            arityInfo           = unknownArity,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
            cprInfo             = NoCPRInfo,
            demandInfo          = wwLazy,
            strictnessInfo      = NoStrictnessInfo,
@@ -592,7 +592,7 @@ but only as a thunk --- the information is only actually produced further
 downstream, by the code generator.
 
 \begin{code}
-#ifndef DEBUG
+#ifndef OLD_STRICTNESS
 newtype CgInfo = CgInfo CafInfo        -- We are back to only having CafRefs in CgInfo
 noCgInfo = panic "NoCgInfo!"
 #else
@@ -671,7 +671,7 @@ function has the CPR property and which components of the result are
 also CPRs.   
 
 \begin{code}
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 data CprInfo
   = NoCPRInfo
   | ReturnsCPR -- Yes, this function returns a constructed product
@@ -849,7 +849,7 @@ copyIdInfo :: IdInfo        -- f_local
           -> IdInfo    -- f (the exported one)
           -> IdInfo    -- New info for f
 copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
                           strictnessInfo = strictnessInfo f_local,
                           cprInfo        = cprInfo        f_local,
 #endif

diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index b04c186..e77cac8 100644 (file)
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -21,7 +21,7 @@ import CoreSyn
 import CostCentre      ( pprCostCentreCore )
 import Id              ( Id, idType, isDataConId_maybe, idLBVarInfo, idArity,
                          idInfo, idInlinePragma, idOccInfo,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
                          idDemandInfo, 
 #endif
                          globalIdDetails, isGlobalId, isExportedId, 
@@ -34,7 +34,7 @@ import IdInfo         ( IdInfo, megaSeqIdInfo,
                          workerInfo, ppWorkerInfo,
                           tyGenInfo, ppTyGenInfo,
                          newStrictnessInfo,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
                          cprInfo, ppCprInfo, 
                          strictnessInfo,
 #endif
@@ -336,7 +336,7 @@ pprIdBndr id = ppr id <+>
               (megaSeqIdInfo (idInfo id) `seq`
                        -- Useful for poking on black holes
                ifPprDebug (ppr (idInlinePragma id) <+> ppr (idOccInfo id) <+> 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
                            ppr (idDemandInfo id) <+>
 #endif
                            ppr (idNewDemandInfo id) <+>
@@ -356,7 +356,7 @@ ppIdInfo b info
   = hsep [  ppArityInfo a,
             ppTyGenInfo g,
            ppWorkerInfo (workerInfo info),
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
            ppStrictnessInfo s,
             ppCprInfo m,
 #endif
@@ -369,7 +369,7 @@ ppIdInfo b info
   where
     a = arityInfo info
     g = tyGenInfo info
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
     s = strictnessInfo info
     m = cprInfo info
 #endif

diff --git a/ghc/compiler/cprAnalysis/CprAnalyse.lhs b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
index 17c4f58..cbc2844 100644 (file)
--- a/ghc/compiler/cprAnalysis/CprAnalyse.lhs
+++ b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
@@ -2,7 +2,7 @@
 constructed product result}
 
 \begin{code}
-#ifndef DEBUG
+#ifndef OLD_STRICTNESS
 module CprAnalyse ( ) where
 
 #else
@@ -311,5 +311,5 @@ getCprAbsVal v = case idCprInfo v of
                 arity = idArity v
        -- Imported (non-nullary) constructors will have the CPR property
        -- in their IdInfo, so no need to look at their unfolding
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
 \end{code}

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 6084d6f..12c399d 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.88 2002/03/05 14:18:55 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.89 2002/03/15 13:57:31 simonmar Exp $
 --
 -- Driver flags
 --
@@ -322,7 +322,7 @@ static_flags =
        -- -fno-* pattern below doesn't work.  We therefore allow
        -- certain optimisation passes to be turned off explicitly:
   ,  ( "fno-strictness"           , NoArg (writeIORef v_Strictness False) )
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
   ,  ( "fno-cpr"          , NoArg (writeIORef v_CPR False) )
 #endif
   ,  ( "fno-cse"          , NoArg (writeIORef v_CSE False) )

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 6ff0da9..109146f 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.71 2002/03/13 13:51:35 simonmar Exp $
+-- $Id: DriverState.hs,v 1.72 2002/03/15 13:57:31 simonmar Exp $
 --
 -- Settings for the driver
 --
@@ -161,7 +161,7 @@ GLOBAL_VAR(v_MaxSimplifierIterations,   4,     Int)
 GLOBAL_VAR(v_StgStats,                  False, Bool)
 GLOBAL_VAR(v_UsageSPInf,               False, Bool)  -- Off by default
 GLOBAL_VAR(v_Strictness,               True,  Bool)
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 GLOBAL_VAR(v_CPR,                      True,  Bool)
 #endif
 GLOBAL_VAR(v_CSE,                      True,  Bool)
@@ -203,7 +203,7 @@ buildCoreToDo = do
    max_iter   <- readIORef v_MaxSimplifierIterations
    usageSP    <- readIORef v_UsageSPInf
    strictness <- readIORef v_Strictness
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
    cpr        <- readIORef v_CPR
 #endif
    cse        <- readIORef v_CSE
@@ -281,7 +281,7 @@ buildCoreToDo = do
        ],
        case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        if cpr        then CoreDoCPResult   else CoreDoNothing,
 #endif
        if strictness then CoreDoStrictness else CoreDoNothing,

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 598b985..facff06 100644 (file)
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -159,7 +159,7 @@ doCorePass dfs rb us binds CoreDoSpecialising
    = _scc_ "Specialise"    noStats dfs (specProgram dfs us binds)
 doCorePass dfs rb us binds CoreDoSpecConstr
    = _scc_ "SpecConstr"    noStats dfs (specConstrProgram dfs us binds)
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 doCorePass dfs rb us binds CoreDoCPResult              
    = _scc_ "CPResult"      noStats dfs (cprAnalyse dfs binds)
 #endif
@@ -175,7 +175,7 @@ doCorePass dfs rb us binds CoreDoNothing
    = noStats dfs (return binds)
 
 strictAnal dfs binds = do
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
      binds <- saBinds dfs binds
 #endif
      dmdAnalPgm dfs binds

diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index 3759fe7..9e7a31c 100644 (file)
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ b/ghc/compiler/stranal/DmdAnal.lhs
@@ -22,14 +22,14 @@ import DataCon              ( dataConTyCon )
 import TyCon           ( isProductTyCon, isRecursiveTyCon )
 import Id              ( Id, idType, idInlinePragma,
                          isDataConId, isGlobalId, idArity,
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
                          idDemandInfo,  idStrictness, idCprInfo,
 #endif
                          idNewStrictness, idNewStrictness_maybe,
                          setIdNewStrictness, idNewDemandInfo,
                          setIdNewDemandInfo, idName 
                        )
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 import IdInfo          ( newStrictnessFromOld, newDemand )
 #endif
 import Var             ( Var )
@@ -70,8 +70,8 @@ dmdAnalPgm dflags binds
        let { binds_plus_dmds = do_prog binds } ;
        endPass dflags "Demand analysis" 
                Opt_D_dump_stranal binds_plus_dmds ;
-#ifdef DEBUG
-       -- Only if DEBUG is on, because only then is the old
+#ifdef OLD_STRICTNESS
+       -- Only if OLD_STRICTNESS is on, because only then is the old
        -- strictness analyser run
        let { dmd_changes = get_changes binds_plus_dmds } ;
        printDump (text "Changes in demands" $$ dmd_changes) ;
@@ -1004,7 +1004,7 @@ boths = zipWithDmds both
 
 
 \begin{code}
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 get_changes binds = vcat (map get_changes_bind binds)
 
 get_changes_bind (Rec pairs) = vcat (map get_changes_pr pairs)

diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index eabc35e..48bb957 100644 (file)
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ b/ghc/compiler/stranal/SaAbsInt.lhs
@@ -4,8 +4,8 @@
 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
 
 \begin{code}
-#ifndef DEBUG
--- If DEBUG is off, omit all exports 
+#ifndef OLD_STRICTNESS
+-- If OLD_STRICTNESS is off, omit all exports 
 module SaAbsInt () where
 
 #else
@@ -921,5 +921,5 @@ NB: despite only having a two-point domain, we may still have many
 iterations, because there are several variables involved at once.
 
 \begin{code}
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
 \end{code}

diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 85aec7c..13e1837 100644 (file)
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -7,7 +7,7 @@ The original version(s) of all strictness-analyser code (except the
 Semantique analyser) was written by Andy Gill.
 
 \begin{code}
-#ifndef DEBUG
+#ifndef OLD_STRICTNESS
 module StrictAnal ( ) where
 
 #else
@@ -490,5 +490,5 @@ sequenceSa (m:ms) = m                 `thenSa` \ r ->
                    sequenceSa ms `thenSa` \ rs ->
                    returnSa (r:rs)
 
-#endif /* DEBUG */
+#endif /* OLD_STRICTNESS */
 \end{code}