summaryrefslogtreecommitdiff
path: root/ghc/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler')
-rw-r--r--ghc/compiler/basicTypes/Id.lhs16
-rw-r--r--ghc/compiler/basicTypes/IdInfo.lhs28
-rw-r--r--ghc/compiler/coreSyn/PprCore.lhs10
-rw-r--r--ghc/compiler/cprAnalysis/CprAnalyse.lhs4
-rw-r--r--ghc/compiler/main/DriverFlags.hs4
-rw-r--r--ghc/compiler/main/DriverState.hs8
-rw-r--r--ghc/compiler/simplCore/SimplCore.lhs4
-rw-r--r--ghc/compiler/stranal/DmdAnal.lhs10
-rw-r--r--ghc/compiler/stranal/SaAbsInt.lhs6
-rw-r--r--ghc/compiler/stranal/StrictAnal.lhs4
10 files changed, 47 insertions, 47 deletions
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 1e4097d39f..9fa37b1fa2 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 b39b60c256..9910d1fed7 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 b04c186d0a..e77cac841f 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 17c4f58f1e..cbc28442ea 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 6084d6ffc0..12c399d7a7 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 6ff0da9685..109146ff4b 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 598b985cc3..facff06579 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 3759fe7ef9..9e7a31c6b3 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 eabc35eab5..48bb957395 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 85aec7c7da..13e18373b9 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}
View Lorry Controller Status