Commit ba60dc74 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu

minor changes to Cmm left over from September 2007

Nothing too deep here; primarily tinking with prettyprinting
and names.  Also eliminated some warnings.  This patch covers
most (but not all) of the code NR changed at the very end
of September 2007, just before ICFP hit...
parent ad5299d9
module CmmCPSZ (
-- | Converts C-- with full proceedures and parameters
-- to a CPS transformed C-- with the stack made manifest.
......@@ -31,6 +30,9 @@ protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
-> CmmZ -- ^ Input C-- with Proceedures
-> IO CmmZ -- ^ Output CPS transformed C--
protoCmmCPSZ dflags (Cmm tops)
| not (dopt Opt_RunCPSZ dflags)
= return (Cmm tops) -- Only if -frun-cps
| otherwise
= do { showPass dflags "CPSZ"
; u <- mkSplitUniqSupply 'p'
; pass_ref <- newIORef "unoptimized program" -- XXX see [Note global fuel]
......@@ -58,13 +60,17 @@ cpsTop (CmmProc h l args g) =
let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
g' = addProcPointProtocols procPoints args g
g'' = map_nodes id NotSpillOrReload id g'
-- Change types of middle nodes to allow spill/reload
in do { u1 <- getUs; u2 <- getUs; u3 <- getUs
; entry <- getUniqueUs >>= return . BlockId
; return $
do { g <- return g''
; g <- dual_rewrite u1 dualLivenessWithInsertion g
-- Insert spills at defns; reloads at return points
; g <- insertLateReloads' u2 (extend g)
-- Duplicate reloads just before uses
; g <- dual_rewrite u3 removeDeadAssignmentsAndReloads (trim entry g)
-- Remove redundant reloads (and any other redundant asst)
; return $ CmmProc h l args $ map_nodes id spillAndReloadComments id g
}
}
......
......@@ -41,7 +41,7 @@ type BlockEntryLiveness = BlockEnv CmmLive
-----------------------------------------------------------------------------
cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
cmmLivenessZ g = env
where env = runDFA liveLattice $ do { run_b_anal transfer g; allFacts }
where env = runDFA liveLattice $ do { run_b_anal transfer g; getAllFacts }
transfer = BComp "liveness analysis" exit last middle first
exit = emptyUniqSet
first live _ = live
......
......@@ -132,7 +132,7 @@ extendPPSet g blocks procPoints =
Nothing -> procPoints'
where env = runDFA lattice $
do refine_f_anal forward g set_init_points
allFacts
getAllFacts
set_init_points = mapM_ (\id -> setFact id ProcPoint)
(uniqSetToList procPoints)
procPoints' = fold_blocks add emptyBlockSet g
......
......@@ -205,7 +205,8 @@ data AvailRegs = UniverseMinus RegSet
availRegsLattice :: DataflowLattice AvailRegs
availRegsLattice = DataflowLattice "register gotten from reloads" empty add True
availRegsLattice = DataflowLattice "register gotten from reloads" empty add False
-- last True <==> debugging on
where empty = UniverseMinus emptyRegSet
-- | compute in the Tx monad to track whether anything has changed
add new old =
......@@ -241,7 +242,7 @@ cmmAvailableReloads :: LGraph M Last -> BlockEnv AvailRegs
cmmAvailableReloads g = env
where env = runDFA availRegsLattice $
do run_f_anal avail_reloads_transfer (fact_bot availRegsLattice) g
allFacts
getAllFacts
avail_reloads_transfer :: FAnalysis M Last AvailRegs
avail_reloads_transfer = FComp "available-reloads analysis" first middle last exit
......
......@@ -128,6 +128,7 @@ cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]
-- a later optimisation step on Cmm).
--
cmmOffset :: CmmExpr -> Int -> CmmExpr
cmmOffset e 0 = e
cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
......
......@@ -3,13 +3,13 @@ module DFMonad
( DataflowLattice(..)
, DataflowAnalysis
, markFactsUnchanged, factsStatus, getFact, setFact, getExitFact, setExitFact
, forgetFact, botFact, allFacts, factsEnv, checkFactMatch
, forgetFact, botFact, setAllFacts, getAllFacts, factsEnv, checkFactMatch
, addLastOutFact, bareLastOutFacts, forgetLastOutFacts
, subAnalysis
, DFA, runDFA
, DFM, runDFM, liftAnal
, markGraphRewritten
, markGraphRewritten, graphWasRewritten
, freshBlockId
, liftUSM
, module OptimizationFuel
......@@ -123,11 +123,12 @@ class DataflowAnalysis m where
addLastOutFact :: (BlockId, f) -> m f ()
bareLastOutFacts :: m f [(BlockId, f)]
forgetLastOutFacts :: m f ()
allFacts :: m f (BlockEnv f)
getAllFacts :: m f (BlockEnv f)
setAllFacts :: BlockEnv f -> m f ()
factsEnv :: Monad (m f) => m f (BlockId -> f)
lattice :: m f (DataflowLattice f)
factsEnv = do { map <- allFacts
factsEnv = do { map <- getAllFacts
; bot <- botFact
; return $ \id -> lookupBlockEnv map id `orElse` bot }
......@@ -163,6 +164,10 @@ instance DataflowAnalysis DFA where
let debug = if log then pprTrace else \_ _ a -> a
in debug name (pprSetFact "exit" old a join) $
((), s { df_exit_fact = join, df_facts_change = SomeChange })
getAllFacts = DFA f
where f _ s = (df_facts s, s)
setAllFacts env = DFA f
where f _ s = ((), s { df_facts = env})
botFact = DFA f
where f lattice s = (fact_bot lattice, s)
forgetFact id = DFA f
......@@ -173,15 +178,13 @@ instance DataflowAnalysis DFA where
where f _ s = (df_last_outs s, s)
forgetLastOutFacts = DFA f
where f _ s = ((), s { df_last_outs = [] })
allFacts = DFA f
where f _ s = (df_facts s, s)
checkFactMatch id a =
do { fact <- lattice
; old_a <- getFact id
; case fact_add_to fact a old_a of
TxRes NoChange _ -> return ()
TxRes SomeChange new ->
do { facts <- allFacts
do { facts <- getAllFacts
; pprPanic "checkFactMatch"
(f4sep [text (fact_name fact), text "at id" <+> ppr id,
text "changed from", nest 4 (ppr old_a), text "to",
......@@ -213,7 +216,8 @@ instance DataflowAnalysis DFM where
addLastOutFact p = liftAnal $ addLastOutFact p
bareLastOutFacts = liftAnal $ bareLastOutFacts
forgetLastOutFacts = liftAnal $ forgetLastOutFacts
allFacts = liftAnal $ allFacts
getAllFacts = liftAnal $ getAllFacts
setAllFacts env = liftAnal $ setAllFacts env
checkFactMatch id a = liftAnal $ checkFactMatch id a
lattice = liftAnal $ lattice
......@@ -229,6 +233,10 @@ markGraphRewritten :: DFM f ()
markGraphRewritten = DFM f
where f _ s = ((), s {df_rewritten = SomeChange})
graphWasRewritten :: DFM f ChangeFlag
graphWasRewritten = DFM f
where f _ s = (df_rewritten s, s)
freshBlockId :: String -> DFM f BlockId
freshBlockId _s = liftUSM $ getUniqueUs >>= return . BlockId
......
......@@ -7,6 +7,7 @@ module OptimizationFuel
, lastFuelPassInState, fuelExhaustedInState, fuelRemainingInState
, fuelDecrementState
, runFuel, runFuelIO, runFuelWithLastPass, fuelConsumingPass
, runWithInfiniteFuel
, FuelMonad(..)
)
where
......@@ -59,6 +60,8 @@ fuelConsumingPass name f = do fuel <- fuelRemaining
runFuel :: FuelMonad a -> FuelConsumer a
runFuelWithLastPass :: FuelMonad a -> FuelConsumer (a, String)
runWithInfiniteFuel :: FuelMonad a -> a
runFuelIO :: IORef String -> IORef OptimizationFuel -> FuelMonad a -> IO a
runFuelIO pass_ref fuel_ref (FuelMonad f) =
......@@ -78,6 +81,8 @@ runFuel (FuelMonad f) fuel = let (a, s) = f $ initialFuelState fuel
runFuelWithLastPass (FuelMonad f) fuel = let (a, s) = f $ initialFuelState fuel
in ((a, fs_lastpass s), fs_fuellimit s)
runWithInfiniteFuel (FuelMonad f) = fst $ f $ initialFuelState $ tankFilledTo maxBound
lastFuelPassInState :: FuelState -> String
lastFuelPassInState = fs_lastpass
......
......@@ -34,6 +34,7 @@ module PprC (
-- Cmm stuff
import Cmm
import PprCmm () -- Instances only
import CLabel
import MachOp
import ForeignCall
......
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
----------------------------------------------------------------------------
--
-- Pretty-printing of Cmm as (a superset of) C--
......@@ -92,6 +85,9 @@ instance Outputable CmmExpr where
instance Outputable CmmReg where
ppr e = pprReg e
instance Outputable CmmLit where
ppr l = pprLit l
instance Outputable LocalReg where
ppr e = pprLocalReg e
......@@ -145,12 +141,13 @@ instance Outputable CmmSafety where
-- For ideas on how to refine it, they used to be printed in the
-- style of C--'s 'stackdata' declaration, just inside the proc body,
-- and were labelled with the procedure name ++ "_info".
pprInfo (CmmInfo gc_target update_frame CmmNonInfoTable) =
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
vcat [{-ptext (sLit "gc_target: ") <>
maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
pprInfo (CmmInfo gc_target update_frame
pprInfo (CmmInfo _gc_target update_frame
(CmmInfoTable (ProfilingInfo closure_type closure_desc) tag info)) =
vcat [{-ptext (sLit "gc_target: ") <>
maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
......@@ -161,12 +158,13 @@ pprInfo (CmmInfo gc_target update_frame
ptext (sLit "tag: ") <> integer (toInteger tag),
pprTypeInfo info]
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (ConstrInfo layout constr descr) =
vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
ptext (sLit "constructor: ") <> integer (toInteger constr),
pprLit descr]
pprTypeInfo (FunInfo layout srt fun_type arity args slow_entry) =
pprTypeInfo (FunInfo layout srt fun_type arity _args slow_entry) =
vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
ptext (sLit "srt: ") <> ppr srt,
......@@ -241,8 +239,22 @@ pprStmt stmt = case stmt of
CmmNeverReturns -> ptext (sLit " never returns"),
semi ]
where
target (CmmLit lit) = pprLit lit
target fn' = parens (ppr fn')
---- With the following three functions, I was going somewhere
---- useful, but I don't remember where. Probably making
---- emitted Cmm output look better. ---NR, 2 May 2008
_pp_lhs | null results = empty
| otherwise = commafy (map ppr_ar results) <+> equals
-- Don't print the hints on a native C-- call
ppr_ar arg = case cconv of
CmmCallConv -> ppr (hintlessCmm arg)
_ -> doubleQuotes (ppr $ cmmHint arg) <+>
ppr (hintlessCmm arg)
_pp_conv = case cconv of
CmmCallConv -> empty
_ -> ptext (sLit "foreign") <+> doubleQuotes (ppr cconv)
target (CmmLit lit) = pprLit lit
target fn' = parens (ppr fn')
CmmCall (CmmPrim op) results args safety ret ->
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
......@@ -341,7 +353,7 @@ genSwitch expr maybe_ids
snds a b = (snd a) == (snd b)
caseify :: [(Int,Maybe BlockId)] -> SDoc
caseify ixs@((i,Nothing):_)
caseify ixs@((_,Nothing):_)
= ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
<> ptext (sLit " */")
caseify as
......@@ -379,10 +391,13 @@ pprExpr e
-- a default conservative behaviour.
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
= pprExpr7 x <+> doc <+> pprExpr7 y
pprExpr1 e = pprExpr7 e
infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
......@@ -479,8 +494,9 @@ pprLit lit = case lit of
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
pprLit1 lit = pprLit lit
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
pprLit1 lit = pprLit lit
ppr_offset :: Int -> SDoc
ppr_offset i
......@@ -569,4 +585,4 @@ pprBlockId b = ppr $ getUnique b
-----------------------------------------------------------------------------
commafy :: [SDoc] -> SDoc
commafy xs = hsep $ punctuate comma xs
commafy xs = fsep $ punctuate comma xs
......@@ -23,7 +23,7 @@ type M = ExtendWithSpills Middle
foldConflicts :: (RegSet -> a -> a) -> a -> LGraph M Last -> a
foldConflicts f z g =
let env = runDFA dualLiveLattice (run_b_anal dualLiveness g >> allFacts)
let env = runDFA dualLiveLattice (run_b_anal dualLiveness g >> getAllFacts)
lookup id = lookupBlockEnv env id `orElse` fact_bot dualLiveLattice
f' dual z = f (on_stack dual) z
in fold_edge_facts_b f' dualLiveness g lookup z
......
......@@ -691,10 +691,16 @@ instance (Outputable m, Outputable l) => Outputable (ZTail m l) where
instance (Outputable m, Outputable l, LastNode l) => Outputable (LGraph m l) where
ppr = pprLgraph
instance (Outputable l) => Outputable (ZLast l) where
ppr = pprLast
pprTail :: (Outputable m, Outputable l) => ZTail m l -> SDoc
pprTail (ZTail m t) = ppr m $$ ppr t
pprTail (ZLast LastExit) = text "<exit>"
pprTail (ZLast (LastOther l)) = ppr l
pprTail (ZLast l) = ppr l
pprLast :: (Outputable l) => ZLast l -> SDoc
pprLast LastExit = text "<exit>"
pprLast (LastOther l) = ppr l
pprLgraph :: (Outputable m, Outputable l, LastNode l) => LGraph m l -> SDoc
pprLgraph g = text "{" $$ nest 2 (vcat $ map pprBlock blocks) $$ text "}"
......
......@@ -8,26 +8,33 @@
module ZipCfgCmmRep
( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle(..), Last(..), Convention(..)
, ValueDirection(..)
, pprCmmGraphLikeCmm
)
where
import CmmExpr
import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
, CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..)
, CmmStmt(CmmSwitch) -- imported in order to call ppr
, CmmStmt(..) -- imported in order to call ppr on Switch and to
-- implement pprCmmGraphLikeCmm
, CmmSafety(CmmSafe) -- for pprCmmGraphLikeCmm
, CmmReturnInfo(CmmMayReturn) -- for pprCmmGraphLikeCmm
)
import PprCmm()
import CLabel
import CmmZipUtil
import ClosureInfo
import FastString
import ForeignCall
import MachOp
import qualified ZipCfg as Z
import qualified ZipDataflow0 as DF
import ZipCfg
import MkZipCfg
import Util
import UniqSet
import Maybes
import Outputable
import Prelude hiding (zip, unzip, last)
......@@ -200,7 +207,9 @@ debugPpr :: Bool
debugPpr = debugIsOn
pprMiddle :: Middle -> SDoc
pprMiddle stmt = (case stmt of
pprMiddle stmt = pp_stmt <+> pp_debug
where
pp_stmt = case stmt of
CopyIn conv args _ ->
if null args then ptext (sLit "empty CopyIn")
......@@ -243,17 +252,17 @@ pprMiddle stmt = (case stmt of
hcat [ ptext (sLit "return via ")
, ppr_target ra, parens (commafy $ map ppr args), semi ]
) <>
if debugPpr then empty
else text " //" <+>
case stmt of
CopyIn {} -> text "CopyIn"
CopyOut {} -> text "CopyOut"
MidComment {} -> text "MidComment"
MidAssign {} -> text "MidAssign"
MidStore {} -> text "MidStore"
MidUnsafeCall {} -> text "MidUnsafeCall"
MidAddToContext {} -> text "MidAddToContext"
pp_debug =
if not debugPpr then empty
else text " //" <+>
case stmt of
CopyIn {} -> text "CopyIn"
CopyOut {} -> text "CopyOut"
MidComment {} -> text "MidComment"
MidAssign {} -> text "MidAssign"
MidStore {} -> text "MidStore"
MidUnsafeCall {} -> text "MidUnsafeCall"
MidAddToContext {} -> text "MidAddToContext"
ppr_target :: CmmExpr -> SDoc
......@@ -317,3 +326,114 @@ pprConvention (ConventionPrivate {} ) = text "<private-convention>"
commafy :: [SDoc] -> SDoc
commafy xs = hsep $ punctuate comma xs
----------------------------------------------------------------
-- | The purpose of this function is to print a Cmm zipper graph "as if it were"
-- a Cmm program. The objective is dodgy, so it's unsurprising parts of the
-- code are dodgy as well.
pprCmmGraphLikeCmm :: CmmGraph -> SDoc
pprCmmGraphLikeCmm g = vcat (swallow blocks)
where blocks = Z.postorder_dfs g
swallow :: [CmmBlock] -> [SDoc]
swallow [] = []
swallow (Z.Block id t : rest) = tail id [] Nothing t rest
tail id prev' out (Z.ZTail (CopyOut conv args) t) rest =
if isJust out then panic "multiple CopyOut nodes in one basic block"
else
tail id (prev') (Just (conv, args)) t rest
tail id prev' out (Z.ZTail m t) rest = tail id (mid m : prev') out t rest
tail id prev' out (Z.ZLast Z.LastExit) rest = exit id prev' out rest
tail id prev' out (Z.ZLast (Z.LastOther l)) rest = last id prev' out l rest
mid (CopyIn _ [] _) = text "// proc point (no parameters)"
mid m@(CopyIn {}) = ppr m <+> text "(proc point)"
mid m = ppr m
block' id prev'
| id == Z.lg_entry g, entry_has_no_pred =
vcat (text "<entry>" : reverse prev')
| otherwise = hang (ppr id <> colon) 4 (vcat (reverse prev'))
last id prev' out l n =
let endblock stmt = block' id (stmt : prev') : swallow n in
case l of
LastBranch tgt ->
case n of
Z.Block id' t : bs
| tgt == id', unique_pred id'
-> tail id prev' out t bs -- optimize out redundant labels
_ -> endblock (ppr $ CmmBranch tgt)
l@(LastCondBranch expr tid fid) ->
let ft id = text "// fall through to " <> ppr id in
case n of
Z.Block id' t : bs
| id' == fid, isNothing out ->
tail id (ft fid : ppr (CmmCondBranch expr tid) : prev') Nothing t bs
| id' == tid, Just e' <- maybeInvertCmmExpr expr, isNothing out->
tail id (ft tid : ppr (CmmCondBranch e' fid) : prev') Nothing t bs
_ -> endblock $ with_out out l
l@(LastJump {}) -> endblock $ with_out out l
l@(LastReturn {}) -> endblock $ with_out out l
l@(LastSwitch {}) -> endblock $ with_out out l
l@(LastCall _ Nothing) -> endblock $ with_out out l
l@(LastCall tgt (Just k))
| Z.Block id' (Z.ZTail (CopyIn _ ress srt) t) : bs <- n,
Just (conv, args) <- out,
id' == k ->
let call = CmmCall tgt' ress args (CmmSafe srt) CmmMayReturn
tgt' = CmmCallee tgt (cconv_of_conv conv)
ppcall = ppr call <+> parens (text "ret to" <+> ppr k)
in if unique_pred k then
tail id (ppcall : prev') Nothing t bs
else
endblock (ppcall)
| Z.Block id' t : bs <- n, id' == k, unique_pred k,
Just (conv, args) <- out,
Just (ress, srt) <- findCopyIn t ->
let call = CmmCall tgt' ress args (CmmSafe srt) CmmMayReturn
tgt' = CmmCallee tgt (cconv_of_conv conv)
delayed =
ptext (sLit "// delayed CopyIn follows previous call")
in tail id (delayed : ppr call : prev') Nothing t bs
| otherwise -> endblock $ with_out out l
findCopyIn (Z.ZTail (CopyIn _ ress srt) _) = Just (ress, srt)
findCopyIn (Z.ZTail _ t) = findCopyIn t
findCopyIn (Z.ZLast _) = Nothing
exit id prev' out n = -- highly irregular (assertion violation?)
let endblock stmt = block' id (stmt : prev') : swallow n in
case out of Nothing -> endblock (text "// <exit>")
Just (conv, args) -> endblock (ppr (CopyOut conv args) $$
text "// <exit>")
preds = zipPreds g
entry_has_no_pred = case Z.lookupBlockEnv preds (Z.lg_entry g) of
Nothing -> True
Just s -> isEmptyUniqSet s
single_preds =
let add b single =
let id = Z.blockId b
in case Z.lookupBlockEnv preds id of
Nothing -> single
Just s -> if sizeUniqSet s == 1 then
Z.extendBlockSet single id
else single
in Z.fold_blocks add Z.emptyBlockSet g
unique_pred id = Z.elemBlockSet id single_preds
cconv_of_conv (ConventionStandard conv _) = conv
cconv_of_conv (ConventionPrivate {}) = CmmCallConv -- XXX totally bogus
with_out :: Maybe (Convention, CmmActuals) -> Last -> SDoc
with_out Nothing l = ptext (sLit "??no-arguments??") <+> ppr l
with_out (Just (conv, args)) l = last l
where last (LastCall e k) =
hcat [ptext (sLit "... = foreign "),
doubleQuotes(ppr conv), space,
ppr_target e, parens ( commafy $ map ppr args ),
ptext (sLit " \"safe\""),
case k of Nothing -> ptext (sLit " never returns")
Just _ -> empty,
semi ]
last (LastReturn) = ppr (CmmReturn args)
last (LastJump e) = ppr (CmmJump e args)
last l = ppr (CopyOut conv args) $$ ppr l
ppr_target (CmmLit lit) = ppr lit
ppr_target fn' = parens (ppr fn')
commafy xs = hsep $ punctuate comma xs
......@@ -299,7 +299,7 @@ run dir name set_entry do_block b blocks =
do { markFactsUnchanged
; b <- foldM trace_block b blocks
; changed <- factsStatus
; facts <- allFacts
; facts <- getAllFacts
; let depth = 0 -- was nesting depth
; ppIter depth n $
case changed of
......@@ -442,7 +442,7 @@ solve_graph_b comp fuel graph exit_fact =
in do { fuel <-
run "backward" (bc_name comp) (return ()) set_block_fact fuel blocks
; a <- getFact (G.lg_entry graph)
; facts <- allFacts
; facts <- getAllFacts
; my_trace "Solution to graph after pass 1 is" (pprFacts graph facts a) $
return (fuel, a) }
......@@ -496,11 +496,11 @@ solve_and_rewrite_b_graph ::
solve_and_rewrite_b comp fuel graph exit_fact =
do { (_, a) <- solve_graph_b comp fuel graph exit_fact -- pass 1
; facts <- allFacts
; facts <- getAllFacts
; (fuel, g) <- -- pass 2
my_trace "Solution to graph after pass 1 is" (pprFacts graph facts) $
backward_rewrite (comp_with_exit_b comp exit_fact) fuel graph
; facts <- allFacts
; facts <- getAllFacts
; my_trace "Rewritten graph after pass 2 is" (pprFacts g facts) $
return (fuel, a, g) }
where
......@@ -1079,10 +1079,10 @@ subAnalysis' :: (Monad (m f), DataflowAnalysis m, Outputable f) =>
m f a -> m f a
subAnalysis' m =
do { a <- subAnalysis $
do { a <- m; facts <- allFacts
do { a <- m; facts <- getAllFacts
; my_trace "after sub-analysis facts are" (pprFacts facts) $
return a }
; facts <- allFacts
; facts <- getAllFacts
; my_trace "in parent analysis facts are" (pprFacts facts) $
return a }
where pprFacts env = nest 2 $ vcat $ map pprFact $ ufmToList env
......
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