Commit d06edb8e authored by Ian Lynagh's avatar Ian Lynagh

Remove PlatformOutputable

We can now get the Platform from the DynFlags inside an SDoc, so we
no longer need to pass the Platform in.
parent 2901e3ff
......@@ -253,22 +253,21 @@ data ForeignLabelSource
-- The regular Outputable instance only shows the label name, and not its other info.
--
pprDebugCLabel :: Platform -> CLabel -> SDoc
pprDebugCLabel platform lbl
pprDebugCLabel _ lbl
= case lbl of
IdLabel{} -> pprPlatform platform lbl <> (parens $ text "IdLabel")
IdLabel{} -> ppr lbl <> (parens $ text "IdLabel")
CmmLabel pkg _name _info
-> pprPlatform platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
-> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
RtsLabel{} -> pprPlatform platform lbl <> (parens $ text "RtsLabel")
RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
ForeignLabel _name mSuffix src funOrData
-> pprPlatform platform lbl <> (parens
$ text "ForeignLabel"
-> ppr lbl <> (parens $ text "ForeignLabel"
<+> ppr mSuffix
<+> ppr src
<+> ppr funOrData)
_ -> pprPlatform platform lbl <> (parens $ text "other CLabel)")
_ -> ppr lbl <> (parens $ text "other CLabel)")
data IdLabelInfo
......@@ -922,8 +921,8 @@ Not exporting these Just_info labels reduces the number of symbols
somewhat.
-}
instance PlatformOutputable CLabel where
pprPlatform = pprCLabel
instance Outputable CLabel where
ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
pprCLabel :: Platform -> CLabel -> SDoc
......
......@@ -228,12 +228,12 @@ data TopSRT = TopSRT { lbl :: CLabel
, rev_elts :: [CLabel]
, elt_map :: Map CLabel Int }
-- map: CLabel -> its last entry in the table
instance PlatformOutputable TopSRT where
pprPlatform platform (TopSRT lbl next elts eltmap) =
text "TopSRT:" <+> pprPlatform platform lbl
instance Outputable TopSRT where
ppr (TopSRT lbl next elts eltmap) =
text "TopSRT:" <+> ppr lbl
<+> ppr next
<+> pprPlatform platform elts
<+> pprPlatform platform eltmap
<+> ppr elts
<+> ppr eltmap
emptySRT :: MonadUnique m => m TopSRT
emptySRT =
......
......@@ -31,22 +31,22 @@ import Data.Maybe
-- -----------------------------------------------------------------------------
-- Exported entry points:
cmmLint :: (PlatformOutputable d, PlatformOutputable h)
cmmLint :: (Outputable d, Outputable h)
=> Platform -> GenCmmGroup d h (ListGraph CmmStmt) -> Maybe SDoc
cmmLint platform tops = runCmmLint platform (mapM_ (lintCmmDecl platform)) tops
cmmLintTop :: (PlatformOutputable d, PlatformOutputable h)
cmmLintTop :: (Outputable d, Outputable h)
=> Platform -> GenCmmDecl d h (ListGraph CmmStmt) -> Maybe SDoc
cmmLintTop platform top = runCmmLint platform (lintCmmDecl platform) top
runCmmLint :: PlatformOutputable a
runCmmLint :: Outputable a
=> Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
runCmmLint platform l p =
runCmmLint _ l p =
case unCL (l p) of
Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
nest 2 err,
ptext $ sLit ("Program was:"),
nest 2 (pprPlatform platform p)])
nest 2 (ppr p)])
Right _ -> Nothing
lintCmmDecl :: Platform -> (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
......@@ -81,7 +81,7 @@ lintCmmExpr platform expr@(CmmMachOp op args) = do
tys <- mapM (lintCmmExpr platform) args
if map (typeWidth . cmmExprType) args == machOpArgReps op
then cmmCheckMachOp op args tys
else cmmLintMachOpErr platform expr (map cmmExprType args) (machOpArgReps op)
else cmmLintMachOpErr expr (map cmmExprType args) (machOpArgReps op)
lintCmmExpr platform (CmmRegOff reg offset)
= lintCmmExpr platform (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
......@@ -103,14 +103,14 @@ isOffsetOp _ = False
-- This expression should be an address from which a word can be loaded:
-- check for funny-looking sub-word offsets.
_cmmCheckWordAddress :: Platform -> CmmExpr -> CmmLint ()
_cmmCheckWordAddress platform e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
= cmmLintDubiousWordOffset platform e
_cmmCheckWordAddress platform e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
| isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
= cmmLintDubiousWordOffset platform e
_cmmCheckWordAddress _ _
= cmmLintDubiousWordOffset e
_cmmCheckWordAddress _
= return ()
-- No warnings for unaligned arithmetic with the node register,
......@@ -128,7 +128,7 @@ lintCmmStmt platform labels = lint
let reg_ty = cmmRegType reg
if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
then return ()
else cmmLintAssignErr platform stmt erep reg_ty
else cmmLintAssignErr stmt erep reg_ty
lint (CmmStore l r) = do
_ <- lintCmmExpr platform l
_ <- lintCmmExpr platform r
......@@ -136,13 +136,13 @@ lintCmmStmt platform labels = lint
lint (CmmCall target _res args _) =
do lintTarget platform labels target
mapM_ (lintCmmExpr platform . hintlessCmm) args
lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond platform e
lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond e
lint (CmmSwitch e branches) = do
mapM_ checkTarget $ catMaybes branches
erep <- lintCmmExpr platform e
if (erep `cmmEqType_ignoring_ptrhood` bWord)
then return ()
else cmmLintErr (text "switch scrutinee is not a word: " <> pprPlatform platform e <>
else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e <>
text " :: " <> ppr erep)
lint (CmmJump e _) = lintCmmExpr platform e >> return ()
lint (CmmReturn) = return ()
......@@ -158,12 +158,12 @@ lintTarget platform labels (CmmPrim _ (Just stmts))
= mapM_ (lintCmmStmt platform labels) stmts
checkCond :: Platform -> CmmExpr -> CmmLint ()
checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
checkCond _ (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
checkCond platform expr
checkCond :: CmmExpr -> CmmLint ()
checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
checkCond expr
= cmmLintErr (hang (text "expression is not a conditional:") 2
(pprPlatform platform expr))
(ppr expr))
-- -----------------------------------------------------------------------------
-- CmmLint monad
......@@ -187,23 +187,23 @@ addLintInfo info thing = CmmLint $
Left err -> Left (hang info 2 err)
Right a -> Right a
cmmLintMachOpErr :: Platform -> CmmExpr -> [CmmType] -> [Width] -> CmmLint a
cmmLintMachOpErr platform expr argsRep opExpectsRep
cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
cmmLintMachOpErr expr argsRep opExpectsRep
= cmmLintErr (text "in MachOp application: " $$
nest 2 (pprPlatform platform expr) $$
nest 2 (ppr expr) $$
(text "op is expecting: " <+> ppr opExpectsRep) $$
(text "arguments provide: " <+> ppr argsRep))
cmmLintAssignErr :: Platform -> CmmStmt -> CmmType -> CmmType -> CmmLint a
cmmLintAssignErr platform stmt e_ty r_ty
cmmLintAssignErr :: CmmStmt -> CmmType -> CmmType -> CmmLint a
cmmLintAssignErr stmt e_ty r_ty
= cmmLintErr (text "in assignment: " $$
nest 2 (vcat [pprPlatform platform stmt,
nest 2 (vcat [ppr stmt,
text "Reg ty:" <+> ppr r_ty,
text "Rhs ty:" <+> ppr e_ty]))
cmmLintDubiousWordOffset :: Platform -> CmmExpr -> CmmLint a
cmmLintDubiousWordOffset platform expr
cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
cmmLintDubiousWordOffset expr
= cmmLintErr (text "offset is not a multiple of words: " $$
nest 2 (pprPlatform platform expr))
nest 2 (ppr expr))
......@@ -1078,7 +1078,7 @@ parseCmmFile dflags filename = do
if (errorsFound dflags ms)
then return (ms, Nothing)
else do
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprPlatform (targetPlatform dflags) cmm)
dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
return (ms, Just cmm)
where
no_module = panic "parseCmmFile: no module"
......
......@@ -73,7 +73,7 @@ cmmPipeline hsc_env (topSRT, rst) prog =
let cmms :: CmmGroup
cmms = reverse (concat tops)
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
-- SRT is not affected by control flow optimization pass
let prog' = runCmmContFlowOpts cmms
......@@ -100,33 +100,33 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
----------- Eliminate common blocks -------------------
g <- return $ elimCommonBlocks g
dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
dump Opt_D_dump_cmmz_cbe "Post common block elimination" g
-- Any work storing block Labels must be performed _after_ elimCommonBlocks
----------- Proc points -------------------
let callPPs = callProcPoints g
procPoints <- run $ minimalProcPointSet (targetPlatform dflags) callPPs g
g <- run $ addProcPointProtocols callPPs procPoints g
dumpPlatform platform Opt_D_dump_cmmz_proc "Post Proc Points Added" g
dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
----------- Spills and reloads -------------------
g <- run $ dualLivenessWithInsertion procPoints g
dumpPlatform platform Opt_D_dump_cmmz_spills "Post spills and reloads" g
dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
----------- Sink and inline assignments -------------------
g <- runOptimization $ rewriteAssignments platform g
dumpPlatform platform Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
----------- Eliminate dead assignments -------------------
g <- runOptimization $ removeDeadAssignments g
dumpPlatform platform Opt_D_dump_cmmz_dead "Post remove dead assignments" g
dump Opt_D_dump_cmmz_dead "Post remove dead assignments" g
----------- Zero dead stack slots (Debug only) ---------------
-- Debugging: stubbing slots on death can cause crashes early
g <- if opt_StubDeadValues
then run $ stubSlotsOnDeath g
else return g
dumpPlatform platform Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
--------------- Stack layout ----------------
slotEnv <- run $ liveSlotAnal g
......@@ -137,7 +137,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
------------ Manifest the stack pointer --------
g <- run $ manifestSP spEntryMap areaMap entry_off g
dumpPlatform platform Opt_D_dump_cmmz_sp "Post manifestSP" g
dump Opt_D_dump_cmmz_sp "Post manifestSP" g
-- UGH... manifestSP can require updates to the procPointMap.
-- We can probably do something quicker here for the update...
......@@ -146,21 +146,21 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
(CmmProc h l g)
mapM_ (dumpPlatform platform Opt_D_dump_cmmz_split "Post splitting") gs
mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
------------- More CAFs and foreign calls ------------
cafEnv <- run $ cafAnal platform g
let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs
mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return ()
mbpprTrace "localCAFs" (ppr localCAFs) $ return ()
gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
mapM_ (dumpPlatform platform Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
-- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
mapM_ (dumpPlatform platform Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
gs <- return $ map (bundleCAFs cafEnv) gs
mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
return (localCAFs, gs)
-- gs :: [ (CAFSet, CmmDecl) ]
......@@ -170,7 +170,6 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
platform = targetPlatform dflags
mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
dump f = dumpWith ppr f
dumpPlatform platform = dumpWith (pprPlatform platform)
dumpWith pprFun f txt g = do
-- ToDo: No easy way of say "dump all the cmmz, *and* split
-- them into files." Also, -ddump-cmmz doesn't play nicely
......
......@@ -163,7 +163,7 @@ extendPPSet platform g blocks procPoints =
newPoint = listToMaybe newPoints
ppSuccessor b =
let nreached id = case mapLookup id env `orElse`
pprPanic "no ppt" (ppr id <+> pprPlatform platform b) of
pprPanic "no ppt" (ppr id <+> ppr b) of
ProcPoint -> 1
ReachedBy ps -> setSize ps
block_procpoints = nreached (entryLabel b)
......
......@@ -55,24 +55,24 @@ import Data.List
-----------------------------------------------------------------------------
instance PlatformOutputable instr => PlatformOutputable (ListGraph instr) where
pprPlatform platform (ListGraph blocks) = vcat (map (pprPlatform platform) blocks)
instance Outputable instr => Outputable (ListGraph instr) where
ppr (ListGraph blocks) = vcat (map ppr blocks)
instance PlatformOutputable instr => PlatformOutputable (GenBasicBlock instr) where
pprPlatform platform b = pprBBlock platform b
instance Outputable instr => Outputable (GenBasicBlock instr) where
ppr = pprBBlock
instance PlatformOutputable CmmStmt where
pprPlatform = pprStmt
instance Outputable CmmStmt where
ppr s = sdocWithPlatform $ \platform -> pprStmt platform s
instance PlatformOutputable CmmInfo where
pprPlatform = pprInfo
instance Outputable CmmInfo where
ppr i = sdocWithPlatform $ \platform -> pprInfo platform i
-- --------------------------------------------------------------------------
instance PlatformOutputable CmmSafety where
pprPlatform _ CmmUnsafe = ptext (sLit "_unsafe_call_")
pprPlatform _ CmmInterruptible = ptext (sLit "_interruptible_call_")
pprPlatform platform (CmmSafe srt) = pprPlatform platform srt
instance Outputable CmmSafety where
ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
ppr CmmInterruptible = ptext (sLit "_interruptible_call_")
ppr (CmmSafe srt) = ppr srt
-- --------------------------------------------------------------------------
-- Info tables. The current pretty printer needs refinement
......@@ -89,14 +89,14 @@ pprInfo platform (CmmInfo _gc_target update_frame info_table) =
maybe (ptext (sLit "<none>"))
(pprUpdateFrame platform)
update_frame,
pprPlatform platform info_table]
ppr info_table]
-- --------------------------------------------------------------------------
-- Basic blocks look like assembly blocks.
-- lbl: stmt ; stmt ; ..
pprBBlock :: PlatformOutputable stmt => Platform -> GenBasicBlock stmt -> SDoc
pprBBlock platform (BasicBlock ident stmts) =
hang (ppr ident <> colon) 4 (vcat (map (pprPlatform platform) stmts))
pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock (BasicBlock ident stmts) =
hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
......@@ -111,10 +111,10 @@ pprStmt platform stmt = case stmt of
CmmComment s -> text "//" <+> ftext s
-- reg = expr;
CmmAssign reg expr -> ppr reg <+> equals <+> pprPlatform platform expr <> semi
CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
-- rep[lv] = expr;
CmmStore lv expr -> rep <> brackets(pprPlatform platform lv) <+> equals <+> pprPlatform platform expr <> semi
CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
where
rep = ppr ( cmmExprType expr )
......@@ -132,8 +132,8 @@ pprStmt platform stmt = case stmt of
| otherwise = commafy (map ppr_ar results) <+> equals
-- Don't print the hints on a native C-- call
ppr_ar (CmmHinted ar k) = case cconv of
CmmCallConv -> pprPlatform platform ar
_ -> pprPlatform platform (ar,k)
CmmCallConv -> ppr ar
_ -> ppr (ar,k)
pp_conv = case cconv of
CmmCallConv -> empty
_ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
......@@ -150,7 +150,7 @@ pprStmt platform stmt = case stmt of
Nothing ForeignLabelInThisPackage IsFunction)
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch platform expr ident
CmmCondBranch expr ident -> genCondBranch expr ident
CmmJump expr live -> genJump platform expr live
CmmReturn -> genReturn platform
CmmSwitch arg ids -> genSwitch platform arg ids
......@@ -159,8 +159,6 @@ pprStmt platform stmt = case stmt of
-- ... is that a good idea? --Isaac Dupree
instance (Outputable a) => Outputable (CmmHinted a) where
ppr (CmmHinted a k) = ppr (a, k)
instance (PlatformOutputable a) => PlatformOutputable (CmmHinted a) where
pprPlatform platform (CmmHinted a k) = pprPlatform platform (a, k)
pprUpdateFrame :: Platform -> UpdateFrame -> SDoc
pprUpdateFrame platform (UpdateFrame expr args) =
......@@ -172,7 +170,7 @@ pprUpdateFrame platform (UpdateFrame expr args) =
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
, space
, parens ( commafy $ map (pprPlatform platform) args ) ]
, parens ( commafy $ map ppr args ) ]
-- --------------------------------------------------------------------------
-- goto local label. [1], section 6.6
......@@ -188,10 +186,10 @@ genBranch ident =
--
-- if (expr) { goto lbl; }
--
genCondBranch :: Platform -> CmmExpr -> BlockId -> SDoc
genCondBranch platform expr ident =
genCondBranch :: CmmExpr -> BlockId -> SDoc
genCondBranch expr ident =
hsep [ ptext (sLit "if")
, parens(pprPlatform platform expr)
, parens (ppr expr)
, ptext (sLit "goto")
, ppr ident <> semi ]
......
......@@ -59,12 +59,12 @@ import Prelude hiding (succ)
instance Outputable CmmStackInfo where
ppr = pprStackInfo
instance PlatformOutputable CmmTopInfo where
pprPlatform = pprTopInfo
instance Outputable CmmTopInfo where
ppr x = sdocWithPlatform $ \platform -> pprTopInfo platform x
instance PlatformOutputable (CmmNode e x) where
pprPlatform = pprNode
instance Outputable (CmmNode e x) where
ppr x = sdocWithPlatform $ \platform -> pprNode platform x
instance Outputable Convention where
ppr = pprConvention
......@@ -72,24 +72,24 @@ instance Outputable Convention where
instance Outputable ForeignConvention where
ppr = pprForeignConvention
instance PlatformOutputable ForeignTarget where
pprPlatform = pprForeignTarget
instance Outputable ForeignTarget where
ppr x = sdocWithPlatform $ \platform -> pprForeignTarget platform x
instance PlatformOutputable (Block CmmNode C C) where
pprPlatform = pprBlock
instance PlatformOutputable (Block CmmNode C O) where
pprPlatform = pprBlock
instance PlatformOutputable (Block CmmNode O C) where
pprPlatform = pprBlock
instance PlatformOutputable (Block CmmNode O O) where
pprPlatform = pprBlock
instance Outputable (Block CmmNode C C) where
ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
instance Outputable (Block CmmNode C O) where
ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
instance Outputable (Block CmmNode O C) where
ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
instance Outputable (Block CmmNode O O) where
ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
instance PlatformOutputable (Graph CmmNode e x) where
pprPlatform = pprGraph
instance Outputable (Graph CmmNode e x) where
ppr x = sdocWithPlatform $ \platform -> pprGraph platform x
instance PlatformOutputable CmmGraph where
pprPlatform platform = pprCmmGraph platform
instance Outputable CmmGraph where
ppr g = sdocWithPlatform $ \platform -> pprCmmGraph platform g
----------------------------------------------------------
-- Outputting types Cmm contains
......@@ -100,8 +100,8 @@ pprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =
ptext (sLit "updfr_space: ") <> ppr updfr_space
pprTopInfo :: Platform -> CmmTopInfo -> SDoc
pprTopInfo platform (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
vcat [ptext (sLit "info_tbl: ") <> pprPlatform platform info_tbl,
pprTopInfo _ (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
vcat [ptext (sLit "info_tbl: ") <> ppr info_tbl,
ptext (sLit "stack_info: ") <> ppr stack_info]
----------------------------------------------------------
......@@ -109,30 +109,30 @@ pprTopInfo platform (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
=> Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock platform block
= foldBlockNodesB3 ( ($$) . pprPlatform platform
, ($$) . (nest 4) . pprPlatform platform
, ($$) . (nest 4) . pprPlatform platform
pprBlock _ block
= foldBlockNodesB3 ( ($$) . ppr
, ($$) . (nest 4) . ppr
, ($$) . (nest 4) . ppr
)
block
empty
pprGraph :: Platform -> Graph CmmNode e x -> SDoc
pprGraph _ GNil = empty
pprGraph platform (GUnit block) = pprPlatform platform block
pprGraph platform (GMany entry body exit)
pprGraph _ (GUnit block) = ppr block
pprGraph _ (GMany entry body exit)
= text "{"
$$ nest 2 (pprMaybeO entry $$ (vcat $ map (pprPlatform platform) $ bodyToBlockList body) $$ pprMaybeO exit)
$$ nest 2 (pprMaybeO entry $$ (vcat $ map ppr $ bodyToBlockList body) $$ pprMaybeO exit)
$$ text "}"
where pprMaybeO :: PlatformOutputable (Block CmmNode e x)
where pprMaybeO :: Outputable (Block CmmNode e x)
=> MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO NothingO = empty
pprMaybeO (JustO block) = pprPlatform platform block
pprMaybeO (JustO block) = ppr block
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph platform g
pprCmmGraph _ g
= text "{" <> text "offset"
$$ nest 2 (vcat $ map (pprPlatform platform) blocks)
$$ nest 2 (vcat $ map ppr blocks)
$$ text "}"
where blocks = postorderDfs g
......@@ -154,24 +154,24 @@ pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
pprForeignTarget :: Platform -> ForeignTarget -> SDoc
pprForeignTarget platform (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
pprForeignTarget _ (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
where ppr_fc :: ForeignConvention -> SDoc
ppr_fc (ForeignConvention c args res) =
doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res
ppr_target :: CmmExpr -> SDoc
ppr_target t@(CmmLit _) = pprPlatform platform t
ppr_target fn' = parens (pprPlatform platform fn')
ppr_target t@(CmmLit _) = ppr t
ppr_target fn' = parens (ppr fn')
pprForeignTarget platform (PrimTarget op)
pprForeignTarget _ (PrimTarget op)
-- HACK: We're just using a ForeignLabel to get this printed, the label
-- might not really be foreign.
= pprPlatform platform
= ppr
(CmmLabel (mkForeignLabel
(mkFastString (show op))
Nothing ForeignLabelInThisPackage IsFunction))
pprNode :: Platform -> CmmNode e x -> SDoc
pprNode platform node = pp_node <+> pp_debug
pprNode _ node = pp_node <+> pp_debug
where
pp_node :: SDoc
pp_node = case node of
......@@ -182,10 +182,10 @@ pprNode platform node = pp_node <+> pp_debug
CmmComment s -> text "//" <+> ftext s
-- reg = expr;
CmmAssign reg expr -> ppr reg <+> equals <+> pprPlatform platform expr <> semi
CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
-- rep[lv] = expr;
CmmStore lv expr -> rep <> brackets(pprPlatform platform lv) <+> equals <+> pprPlatform platform expr <> semi
CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
where
rep = ppr ( cmmExprType expr )
......@@ -195,7 +195,7 @@ pprNode platform node = pp_node <+> pp_debug
hsep [ ppUnless (null results) $
parens (commafy $ map ppr results) <+> equals,
ptext $ sLit "call",
pprPlatform platform target <> parens (commafy $ map (pprPlatform platform) args) <> semi]
ppr target <> parens (commafy $ map ppr args) <> semi]
-- goto label;
CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
......@@ -203,7 +203,7 @@ pprNode platform node = pp_node <+> pp_debug
-- if (expr) goto t; else goto f;
CmmCondBranch expr t f ->
hsep [ ptext (sLit "if")
, parens(pprPlatform platform expr)
, parens(ppr expr)
, ptext (sLit "goto")
, ppr t <> semi
, ptext (sLit "else goto")
......@@ -215,8 +215,8 @@ pprNode platform node = pp_node <+> pp_debug
, int (length maybe_ids - 1)
, ptext (sLit "] ")
, if isTrivialCmmExpr expr
then pprPlatform platform expr
else parens (pprPlatform platform expr)
then ppr expr
else parens (ppr expr)
, ptext (sLit " {")
])
4 (vcat ( map caseify pairs )) $$ rbrace
......@@ -237,15 +237,15 @@ pprNode platform node = pp_node <+> pp_debug
<+> parens (ppr res)
, ptext (sLit " with update frame") <+> ppr updfr_off
, semi ]
where pprFun f@(CmmLit _) = pprPlatform platform f
pprFun f = parens (pprPlatform platform f)
where pprFun f@(CmmLit _) = ppr f
pprFun f = parens (ppr f)