Commit e8b6200f authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu
Browse files

default ppr method for CmmGraph now tells more about the representation

(Previously, ppr had tried to make the zipper representation look as
much like the ListGraph representation as possible.  This decision was
unhelpful for debugging, so although the old code has been retained,
the new default is to tell it like it is.  It may be possible to
retire PprCmmZ one day, although it may be desirable to retain it as
the internal form becomes less readable.
parent 75879a1e
module PprCmmZ
( pprCmmGraph
( pprCmmGraphLikeCmm
)
where
......@@ -12,21 +12,14 @@ import PprCmm()
import Outputable
import qualified ZipCfgCmm as G
import qualified ZipCfg as Z
import qualified ZipDataflow as DF
import CmmZipUtil
import UniqSet
import FastString
----------------------------------------------------------------
instance DF.DebugNodes G.Middle G.Last
instance Outputable G.CmmGraph where
ppr = pprCmmGraph
pprCmmGraph :: G.CmmGraph -> SDoc
pprCmmGraph g = vcat (swallow blocks)
pprCmmGraphLikeCmm :: G.CmmGraph -> SDoc
pprCmmGraphLikeCmm g = vcat (swallow blocks)
where blocks = Z.postorder_dfs g
swallow :: [G.CmmBlock] -> [SDoc]
swallow [] = []
......@@ -109,3 +102,4 @@ pprCmmGraph g = vcat (swallow blocks)
in Z.fold_blocks add Z.emptyBlockSet g
unique_pred id = Z.elemBlockSet id single_preds
......@@ -207,8 +207,18 @@ instance Outputable Last where
instance Outputable Convention where
ppr = pprConvention
instance DF.DebugNodes Middle Last
instance Outputable CmmGraph where
ppr = pprCmmGraphAsRep
pprCmmGraphAsRep :: CmmGraph -> SDoc
pprCmmGraphAsRep g = vcat (map ppr_block blocks)
where blocks = postorder_dfs g
ppr_block (Block id tail) = hang (ppr id <> colon) 4 (ppr tail)
pprMiddle :: Middle -> SDoc
pprMiddle stmt = case stmt of
pprMiddle stmt = (case stmt of
MidNop -> semi
......@@ -252,6 +262,15 @@ pprMiddle stmt = case stmt of
pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
where
lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
) <+> text "//" <+>
case stmt of
MidNop {} -> text "MidNop"
CopyIn {} -> text "CopyIn"
CopyOut {} -> text "CopyOut"
MidComment {} -> text "MidComment"
MidAssign {} -> text "MidAssign"
MidStore {} -> text "MidStore"
MidUnsafeCall {} -> text "MidUnsafeCall"
pprHinted :: Outputable a => (a, MachHint) -> SDoc
......@@ -260,12 +279,25 @@ pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a
pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a
pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a
pprLast :: Last -> SDoc
pprLast stmt = (case stmt of
LastBranch ident args -> genBranchWithArgs ident args
LastCondBranch expr t f -> genFullCondBranch expr t f
LastJump expr params -> ppr $ CmmJump expr params
LastReturn params -> ppr $ CmmReturn params
LastReturn results -> hcat [ ptext SLIT("return"), space
, parens ( commafy $ map pprHinted results )
, semi ]
LastSwitch arg ids -> ppr $ CmmSwitch arg ids
LastCall tgt params k -> genCall tgt params k
) <+> text "//" <+>
case stmt of
LastBranch {} -> text "LastBranch"
LastCondBranch {} -> text "LastCondBranch"
LastJump {} -> text "LastJump"
LastReturn {} -> text "LastReturn"
LastSwitch {} -> text "LastSwitch"
LastCall {} -> text "LastCall"
genCall :: CmmCallTarget -> CmmActuals -> Maybe BlockId -> SDoc
genCall (CmmCallee fn cconv) args k =
......
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