Commit 0f1c5b1e authored by Ian Lynagh's avatar Ian Lynagh

Remove some more redundant Platform arguments

parent 5045cfbc
......@@ -163,7 +163,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
-- used (literal): try to inline at all the use sites
| Just n <- lookupUFM uses u, isLit expr
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
case lookForInlineLit u expr stmts of
(m, stmts')
| n == m -> cmmMiniInlineStmts dflags (delFromUFM uses u) stmts'
......@@ -174,7 +174,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
| Just n <- lookupUFM uses u,
e@(CmmLit _) <- wrapRecExp foldExp expr
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
case lookForInlineLit u e stmts of
(m, stmts')
| n == m -> cmmMiniInlineStmts dflags (delFromUFM uses u) stmts'
......@@ -185,7 +185,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
| Just 1 <- lookupUFM uses u,
Just stmts' <- lookForInline u expr stmts
=
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt platform stmt)) $
ncgDebugTrace ("nativeGen: inlining " ++ showSDoc dflags (pprStmt stmt)) $
cmmMiniInlineStmts dflags uses stmts'
where
platform = targetPlatform dflags
......
......@@ -48,7 +48,6 @@ import PprCmmExpr
import BasicTypes
import ForeignCall
import Outputable
import Platform
import FastString
import Data.List
......@@ -62,10 +61,10 @@ instance Outputable instr => Outputable (GenBasicBlock instr) where
ppr = pprBBlock
instance Outputable CmmStmt where
ppr s = sdocWithPlatform $ \platform -> pprStmt platform s
ppr s = pprStmt s
instance Outputable CmmInfo where
ppr i = sdocWithPlatform $ \platform -> pprInfo platform i
ppr i = pprInfo i
-- --------------------------------------------------------------------------
......@@ -81,14 +80,12 @@ 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 :: Platform -> CmmInfo -> SDoc
pprInfo platform (CmmInfo _gc_target update_frame info_table) =
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame info_table) =
vcat [{-ptext (sLit "gc_target: ") <>
maybe (ptext (sLit "<none>")) ppr gc_target,-}
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>"))
(pprUpdateFrame platform)
update_frame,
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
ppr info_table]
-- --------------------------------------------------------------------------
......@@ -101,8 +98,8 @@ pprBBlock (BasicBlock ident stmts) =
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
--
pprStmt :: Platform -> CmmStmt -> SDoc
pprStmt platform stmt = case stmt of
pprStmt :: CmmStmt -> SDoc
pprStmt stmt = case stmt of
-- ;
CmmNop -> semi
......@@ -122,7 +119,7 @@ pprStmt platform stmt = case stmt of
-- ToDo ppr volatile
CmmCall (CmmCallee fn cconv) results args ret ->
sep [ pp_lhs <+> pp_conv
, nest 2 (pprExpr9 platform fn <>
, nest 2 (pprExpr9 fn <>
parens (commafy (map ppr_ar args)))
, case ret of CmmMayReturn -> empty
CmmNeverReturns -> ptext $ sLit (" never returns")
......@@ -140,8 +137,7 @@ pprStmt platform stmt = case stmt of
-- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
CmmCall (CmmPrim op _) results args ret ->
pprStmt platform (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
results args ret)
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv) results args ret)
where
-- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
-- use one to get the label printed.
......@@ -151,24 +147,24 @@ pprStmt platform stmt = case stmt of
CmmBranch ident -> genBranch ident
CmmCondBranch expr ident -> genCondBranch expr ident
CmmJump expr live -> genJump platform expr live
CmmReturn -> genReturn platform
CmmSwitch arg ids -> genSwitch platform arg ids
CmmJump expr live -> genJump expr live
CmmReturn -> genReturn
CmmSwitch arg ids -> genSwitch arg ids
-- Just look like a tuple, since it was a tuple before
-- ... is that a good idea? --Isaac Dupree
instance (Outputable a) => Outputable (CmmHinted a) where
ppr (CmmHinted a k) = ppr (a, k)
pprUpdateFrame :: Platform -> UpdateFrame -> SDoc
pprUpdateFrame platform (UpdateFrame expr args) =
pprUpdateFrame :: UpdateFrame -> SDoc
pprUpdateFrame (UpdateFrame expr args) =
hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
then pprExpr platform expr
then pprExpr expr
else case expr of
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
CmmLoad (CmmReg _) _ -> pprExpr expr
_ -> parens (pprExpr expr)
, space
, parens ( commafy $ map ppr args ) ]
......@@ -198,15 +194,15 @@ genCondBranch expr ident =
--
-- jump foo(a, b, c);
--
genJump :: Platform -> CmmExpr -> Maybe [GlobalReg] -> SDoc
genJump platform expr live =
genJump :: CmmExpr -> Maybe [GlobalReg] -> SDoc
genJump expr live =
hcat [ ptext (sLit "jump")
, space
, if isTrivialCmmExpr expr
then pprExpr platform expr
then pprExpr expr
else case expr of
CmmLoad (CmmReg _) _ -> pprExpr platform expr
_ -> parens (pprExpr platform expr)
CmmLoad (CmmReg _) _ -> pprExpr expr
_ -> parens (pprExpr expr)
, semi <+> ptext (sLit "// ")
, maybe empty ppr live]
......@@ -215,9 +211,8 @@ genJump platform expr live =
--
-- return (a, b, c);
--
genReturn :: Platform -> SDoc
genReturn _ =
hcat [ ptext (sLit "return") , semi ]
genReturn :: SDoc
genReturn = hcat [ ptext (sLit "return") , semi ]
-- --------------------------------------------------------------------------
-- Tabled jump to local label
......@@ -226,8 +221,8 @@ genReturn _ =
--
-- switch [0 .. n] (expr) { case ... ; }
--
genSwitch :: Platform -> CmmExpr -> [Maybe BlockId] -> SDoc
genSwitch platform expr maybe_ids
genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
genSwitch expr maybe_ids
= let pairs = groupBy snds (zip [0 .. ] maybe_ids )
......@@ -235,8 +230,8 @@ genSwitch platform expr maybe_ids
, int (length maybe_ids - 1)
, ptext (sLit "] ")
, if isTrivialCmmExpr expr
then pprExpr platform expr
else parens (pprExpr platform expr)
then pprExpr expr
else parens (pprExpr expr)
, ptext (sLit " {")
])
4 (vcat ( map caseify pairs )) $$ rbrace
......
......@@ -41,7 +41,6 @@ where
import CmmExpr
import Outputable
import Platform
import FastString
import Data.Maybe
......@@ -50,7 +49,7 @@ import Numeric ( fromRat )
-----------------------------------------------------------------------------
instance Outputable CmmExpr where
ppr e = sdocWithPlatform $ \platform -> pprExpr platform e
ppr e = pprExpr e
instance Outputable CmmReg where
ppr e = pprReg e
......@@ -71,15 +70,15 @@ instance Outputable GlobalReg where
-- Expressions
--
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr platform e
pprExpr :: CmmExpr -> SDoc
pprExpr e
= case e of
CmmRegOff reg i ->
pprExpr platform (CmmMachOp (MO_Add rep)
pprExpr (CmmMachOp (MO_Add rep)
[CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
where rep = typeWidth (cmmRegType reg)
CmmLit lit -> pprLit lit
_other -> pprExpr1 platform e
_other -> pprExpr1 e
-- Here's the precedence table from CmmParse.y:
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
......@@ -95,10 +94,10 @@ pprExpr platform e
-- a default conservative behaviour.
-- %nonassoc '>=' '>' '<=' '<' '!=' '=='
pprExpr1, pprExpr7, pprExpr8 :: Platform -> CmmExpr -> SDoc
pprExpr1 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
= pprExpr7 platform x <+> doc <+> pprExpr7 platform y
pprExpr1 platform e = pprExpr7 platform e
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
......@@ -113,55 +112,55 @@ infixMachOp1 (MO_U_Lt _) = Just (char '<')
infixMachOp1 _ = Nothing
-- %left '-' '+'
pprExpr7 platform (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
= pprExpr7 platform (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
pprExpr7 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
= pprExpr7 platform x <+> doc <+> pprExpr8 platform y
pprExpr7 platform e = pprExpr8 platform e
pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
= pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
= pprExpr7 x <+> doc <+> pprExpr8 y
pprExpr7 e = pprExpr8 e
infixMachOp7 (MO_Add _) = Just (char '+')
infixMachOp7 (MO_Sub _) = Just (char '-')
infixMachOp7 _ = Nothing
-- %left '/' '*' '%'
pprExpr8 platform (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
= pprExpr8 platform x <+> doc <+> pprExpr9 platform y
pprExpr8 platform e = pprExpr9 platform e
pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
= pprExpr8 x <+> doc <+> pprExpr9 y
pprExpr8 e = pprExpr9 e
infixMachOp8 (MO_U_Quot _) = Just (char '/')
infixMachOp8 (MO_Mul _) = Just (char '*')
infixMachOp8 (MO_U_Rem _) = Just (char '%')
infixMachOp8 _ = Nothing
pprExpr9 :: Platform -> CmmExpr -> SDoc
pprExpr9 platform e =
pprExpr9 :: CmmExpr -> SDoc
pprExpr9 e =
case e of
CmmLit lit -> pprLit1 lit
CmmLoad expr rep -> ppr rep <> brackets (ppr expr)
CmmReg reg -> ppr reg
CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
CmmMachOp mop args -> genMachOp platform mop args
CmmMachOp mop args -> genMachOp mop args
genMachOp :: Platform -> MachOp -> [CmmExpr] -> SDoc
genMachOp platform mop args
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp mop args
| Just doc <- infixMachOp mop = case args of
-- dyadic
[x,y] -> pprExpr9 platform x <+> doc <+> pprExpr9 platform y
[x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
-- unary
[x] -> doc <> pprExpr9 platform x
[x] -> doc <> pprExpr9 x
_ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
(pprMachOp mop <+>
parens (hcat $ punctuate comma (map (pprExpr platform) args)))
parens (hcat $ punctuate comma (map pprExpr args)))
empty
| isJust (infixMachOp1 mop)
|| isJust (infixMachOp7 mop)
|| isJust (infixMachOp8 mop) = parens (pprExpr platform (CmmMachOp mop args))
|| isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
| otherwise = char '%' <> ppr_op <> parens (commafy (map (pprExpr platform) args))
| otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
(show mop))
-- replace spaces in (show mop) with underscores,
......
......@@ -635,7 +635,7 @@ genStore_slow env addr val meta = do
other ->
pprPanic "genStore: ptr not right type!"
(PprCmm.pprExpr (getLlvmPlatform env) addr <+> text (
(PprCmm.pprExpr addr <+> text (
"Size of Ptr: " ++ show llvmPtrBits ++
", Size of var: " ++ show (llvmWidthInBits other) ++
", Var: " ++ show vaddr))
......@@ -953,7 +953,7 @@ genMachOp_slow env opt op [x, y] = case op of
let dflags = getDflags env
style = mkCodeStyle CStyle
toString doc = renderWithStyle dflags doc style
cmmToStr = (lines . toString . PprCmm.pprExpr (getLlvmPlatform env))
cmmToStr = (lines . toString . PprCmm.pprExpr)
let dx = Comment $ map fsLit $ cmmToStr x
let dy = Comment $ map fsLit $ cmmToStr y
(v1, s1) <- doExpr (ty vx) $ binOp vx vy
......@@ -1112,7 +1112,7 @@ genLoad_slow env e ty meta = do
return (env', dvar, stmts `snocOL` cast `snocOL` load, tops)
other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
(PprCmm.pprExpr (getLlvmPlatform env) e <+> text (
(PprCmm.pprExpr e <+> text (
"Size of Ptr: " ++ show llvmPtrBits ++
", Size of var: " ++ show (llvmWidthInBits other) ++
", Var: " ++ show iptr))
......
......@@ -891,11 +891,10 @@ cmmStmtConFold stmt
CmmCondBranch test dest
-> do test' <- cmmExprConFold DataReference test
dflags <- getDynFlags
let platform = targetPlatform dflags
return $ case test' of
CmmLit (CmmInt 0 _) ->
CmmComment (mkFastString ("deleted: " ++
showSDoc dflags (pprStmt platform stmt)))
showSDoc dflags (pprStmt stmt)))
CmmLit (CmmInt _ _) -> CmmBranch dest
_other -> CmmCondBranch test' dest
......
......@@ -353,8 +353,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
iselExpr64 expr
= do dflags <- getDynFlags
pprPanic "iselExpr64(powerpc)" (pprExpr (targetPlatform dflags) expr)
= pprPanic "iselExpr64(powerpc)" (pprExpr expr)
......@@ -570,7 +569,7 @@ getRegister' _ (CmmLit lit)
]
in return (Any (cmmTypeSize rep) code)
getRegister' dflags other = pprPanic "getRegister(ppc)" (pprExpr (targetPlatform dflags) other)
getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other)
-- extend?Rep: wrap integer expression of type rep
-- in a conversion to II32
......
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