[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.

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)
 

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

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

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}

ghc/compiler/main/DriverFlags.hs

 {-# 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) )

ghc/compiler/main/DriverState.hs

 -----------------------------------------------------------------------------
--- $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,

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

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)

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}

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}