From: simonmar Date: Fri, 15 Mar 2002 13:57:32 +0000 (+0000) Subject: [project @ 2002-03-15 13:57:27 by simonmar] X-Git-Tag: Approx_11550_changesets_converted~2258 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=b43da53d447a328d5be4f175dbbebad9abf690de;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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}