Commit b43da53d authored by simonmar's avatar simonmar

[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.
parent c228a724
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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}
{-# 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) )
......
-----------------------------------------------------------------------------
-- $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,
......
......@@ -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
......
......@@ -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)
......
......@@ -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}
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment