Signed-off-by: Edward Z. Yang <[email protected]>
---
compiler/cmm/CmmCPS.hs | 24 ++++++++++++++----------
compiler/cmm/OptimizationFuel.hs | 17 +++++++++++++++--
2 files changed, 29 insertions(+), 12 deletions(-)
diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index 372562c..b9f6db3 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -71,10 +71,10 @@ cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)])
cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo
{arg_space=entry_off}}) l g) =
do
-- Why bother doing it this early?
- -- g <- dual_rewrite Opt_D_dump_cmmz "spills and reloads"
+ -- g <- dual_rewrite run Opt_D_dump_cmmz "spills and reloads"
-- (dualLivenessWithInsertion callPPs) g
-- g <- run $ insertLateReloads g -- Duplicate reloads just before uses
- -- g <- dual_rewrite Opt_D_dump_cmmz "Dead Assignment Elimination"
+ -- g <- dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment
Elimination"
-- (removeDeadAssignmentsAndReloads callPPs) g
dump Opt_D_dump_cmmz "Pre common block elimination" g
g <- return $ elimCommonBlocks g
@@ -91,16 +91,16 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo
{arg_space=entry_off}})
----------- Spills and reloads -------------------
g <-
-- pprTrace "pre Spills" (ppr g) $
- dual_rewrite Opt_D_dump_cmmz "spills and reloads"
+ dual_rewrite run Opt_D_dump_cmmz "spills and reloads"
(dualLivenessWithInsertion procPoints) g
-- Insert spills at defns; reloads at return points
g <-
-- pprTrace "pre insertLateReloads" (ppr g) $
- run $ insertLateReloads g -- Duplicate reloads just before uses
+ runOptimization $ insertLateReloads g -- Duplicate reloads
just before uses
dump Opt_D_dump_cmmz "Post late reloads" g
g <-
-- pprTrace "post insertLateReloads" (ppr g) $
- dual_rewrite Opt_D_dump_cmmz "Dead Assignment Elimination"
+ dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment
Elimination"
(removeDeadAssignmentsAndReloads
procPoints) g
-- Remove redundant reloads (and any other redundant asst)
@@ -146,12 +146,16 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo
{arg_space=entry_off}})
where dflags = hsc_dflags hsc_env
mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z
else z
dump f txt g = dumpIfSet_dyn dflags f txt (ppr g)
-
- run = runFuelIO (hsc_OptFuel hsc_env)
-
- dual_rewrite flag txt pass g =
+ -- Runs a required transformation/analysis
+ run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
+ -- Runs an optional transformation/analysis (and should
+ -- thus be subject to optimization fuel)
+ runOptimization = runFuelIO (hsc_OptFuel hsc_env)
+
+ -- pass 'run' or 'runOptimization' for 'r'
+ dual_rewrite r flag txt pass g =
do dump flag ("Pre " ++ txt) g
- g <- run $ pass g
+ g <- r $ pass g
dump flag ("Post " ++ txt) $ g
return g
diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index 057a965..8d3a06b 100644
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -6,12 +6,12 @@
-- the optimiser with varying amount of fuel to find out the exact number of
-- steps where a bug is introduced in the output.
module OptimizationFuel
- ( OptimizationFuel, amountOfFuel, tankFilledTo, anyFuelLeft, oneLessFuel
+ ( OptimizationFuel, amountOfFuel, tankFilledTo, unlimitedFuel,
anyFuelLeft, oneLessFuel
, OptFuelState, initOptFuelState
, FuelConsumer, FuelUsingMonad, FuelState
, fuelGet, fuelSet, lastFuelPass, setFuelPass
, fuelExhausted, fuelDec1, tryWithFuel
- , runFuelIO, fuelConsumingPass
+ , runFuelIO, runInfiniteFuelIO, fuelConsumingPass
, FuelUniqSM
, liftUniq
)
@@ -51,6 +51,7 @@ amountOfFuel :: OptimizationFuel -> Int
anyFuelLeft :: OptimizationFuel -> Bool
oneLessFuel :: OptimizationFuel -> OptimizationFuel
+unlimitedFuel :: OptimizationFuel
#ifdef DEBUG
newtype OptimizationFuel = OptimizationFuel Int
@@ -61,6 +62,7 @@ amountOfFuel (OptimizationFuel f) = f
anyFuelLeft (OptimizationFuel f) = f > 0
oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
+unlimitedFuel = OptimizationFuel infiniteFuel
#else
-- type OptimizationFuel = State# () -- would like this, but it won't work
data OptimizationFuel = OptimizationFuel
@@ -70,6 +72,7 @@ amountOfFuel _ = maxBound
anyFuelLeft _ = True
oneLessFuel _ = OptimizationFuel
+unlimitedFuel = OptimizationFuel
#endif
data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass ::
String }
@@ -92,6 +95,16 @@ runFuelIO fs (FUSM f) =
writeIORef (fuel_ref fs) fuel'
return a
+-- ToDo: Do we need the pass_ref when we are doing infinite fueld
+-- transformations?
+runInfiniteFuelIO :: OptFuelState -> FuelUniqSM a -> IO a
+runInfiniteFuelIO fs (FUSM f) =
+ do pass <- readIORef (pass_ref fs)
+ u <- mkSplitUniqSupply 'u'
+ let (a, FuelState _ pass') = initUs_ u $ f (FuelState unlimitedFuel
pass)
+ writeIORef (pass_ref fs) pass'
+ return a
+
instance Monad FuelUniqSM where
FUSM f >>= k = FUSM (\s -> f s >>= \(a, s') -> unFUSM (k a) s')
return a = FUSM (\s -> return (a, s))
--
1.7.4.2
_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc
