Remove redundant Platform arguments in cmm/PprC.hs
authorIan Lynagh <igloo@earth.li>
Wed, 18 Jul 2012 23:28:32 +0000 (00:28 +0100)
committerIan Lynagh <igloo@earth.li>
Wed, 18 Jul 2012 23:28:32 +0000 (00:28 +0100)
compiler/cmm/PprC.hs

index bd7b353..6260cfe 100644 (file)
@@ -63,7 +63,7 @@ import Data.Array.ST
 
 pprCs :: DynFlags -> [RawCmmGroup] -> SDoc
 pprCs dflags cmms
- = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC (targetPlatform dflags) c) cmms)
+ = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
  where
    split_marker
      | dopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER")
@@ -79,57 +79,57 @@ writeCs dflags handle cmms
 -- for fun, we could call cmmToCmm over the tops...
 --
 
-pprC :: Platform -> RawCmmGroup -> SDoc
-pprC platform tops = vcat $ intersperse blankLine $ map (pprTop platform) tops
+pprC :: RawCmmGroup -> SDoc
+pprC tops = vcat $ intersperse blankLine $ map pprTop tops
 
 --
 -- top level procs
 --
-pprTop :: Platform -> RawCmmDecl -> SDoc
-pprTop platform (CmmProc mb_info clbl (ListGraph blocks)) =
+pprTop :: RawCmmDecl -> SDoc
+pprTop (CmmProc mb_info clbl (ListGraph blocks)) =
     (case mb_info of
        Nothing -> empty
-       Just (Statics info_clbl info_dat) -> pprDataExterns platform info_dat $$
-                                            pprWordArray platform info_clbl info_dat) $$
+       Just (Statics info_clbl info_dat) -> pprDataExterns info_dat $$
+                                            pprWordArray info_clbl info_dat) $$
     (vcat [
            blankLine,
            extern_decls,
            (if (externallyVisibleCLabel clbl)
-                    then mkFN_ else mkIF_) (pprCLabel platform clbl) <+> lbrace,
+                    then mkFN_ else mkIF_) (ppr clbl) <+> lbrace,
            nest 8 temp_decls,
            nest 8 mkFB_,
            case blocks of
                [] -> empty
                -- the first block doesn't get a label:
                (BasicBlock _ stmts : rest) ->
-                    nest 8 (vcat (map (pprStmt platform) stmts)) $$
-                       vcat (map (pprBBlock platform) rest),
+                    nest 8 (vcat (map pprStmt stmts)) $$
+                       vcat (map pprBBlock rest),
            nest 8 mkFE_,
            rbrace ]
     )
   where
-        (temp_decls, extern_decls) = pprTempAndExternDecls platform blocks
+        (temp_decls, extern_decls) = pprTempAndExternDecls blocks
 
 
 -- Chunks of static data.
 
 -- We only handle (a) arrays of word-sized things and (b) strings.
 
-pprTop platform (CmmData _section (Statics lbl [CmmString str])) =
+pprTop (CmmData _section (Statics lbl [CmmString str])) =
   hcat [
-    pprLocalness lbl, ptext (sLit "char "), pprCLabel platform lbl,
+    pprLocalness lbl, ptext (sLit "char "), ppr lbl,
     ptext (sLit "[] = "), pprStringInCStyle str, semi
   ]
 
-pprTop platform (CmmData _section (Statics lbl [CmmUninitialised size])) =
+pprTop (CmmData _section (Statics lbl [CmmUninitialised size])) =
   hcat [
-    pprLocalness lbl, ptext (sLit "char "), pprCLabel platform lbl,
+    pprLocalness lbl, ptext (sLit "char "), ppr lbl,
     brackets (int size), semi
   ]
 
-pprTop platform (CmmData _section (Statics lbl lits)) =
-  pprDataExterns platform lits $$
-  pprWordArray platform lbl lits
+pprTop (CmmData _section (Statics lbl lits)) =
+  pprDataExterns lits $$
+  pprWordArray lbl lits
 
 -- --------------------------------------------------------------------------
 -- BasicBlocks are self-contained entities: they always end in a jump.
@@ -138,24 +138,24 @@ pprTop platform (CmmData _section (Statics lbl lits)) =
 -- as many jumps as possible into fall throughs.
 --
 
-pprBBlock :: Platform -> CmmBasicBlock -> SDoc
-pprBBlock platform (BasicBlock lbl stmts) =
+pprBBlock :: CmmBasicBlock -> SDoc
+pprBBlock (BasicBlock lbl stmts) =
     if null stmts then
         pprTrace "pprC.pprBBlock: curious empty code block for"
                         (pprBlockId lbl) empty
     else
         nest 4 (pprBlockId lbl <> colon) $$
-        nest 8 (vcat (map (pprStmt platform) stmts))
+        nest 8 (vcat (map pprStmt stmts))
 
 -- --------------------------------------------------------------------------
 -- Info tables. Just arrays of words.
 -- See codeGen/ClosureInfo, and nativeGen/PprMach
 
-pprWordArray :: Platform -> CLabel -> [CmmStatic] -> SDoc
-pprWordArray platform lbl ds
+pprWordArray :: CLabel -> [CmmStatic] -> SDoc
+pprWordArray lbl ds
   = hcat [ pprLocalness lbl, ptext (sLit "StgWord")
-         , space, pprCLabel platform lbl, ptext (sLit "[] = {") ]
-    $$ nest 8 (commafy (pprStatics platform ds))
+         , space, ppr lbl, ptext (sLit "[] = {") ]
+    $$ nest 8 (commafy (pprStatics ds))
     $$ ptext (sLit "};")
 
 --
@@ -169,9 +169,9 @@ pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext (sLit "static ")
 -- Statements.
 --
 
-pprStmt :: Platform -> CmmStmt -> SDoc
+pprStmt :: CmmStmt -> SDoc
 
-pprStmt platform stmt = case stmt of
+pprStmt stmt = case stmt of
     CmmReturn    -> panic "pprStmt: return statement should have been cps'd away"
     CmmNop       -> empty
     CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
@@ -180,16 +180,16 @@ pprStmt platform stmt = case stmt of
                           -- some debugging option is on.  They can get quite
                           -- large.
 
-    CmmAssign dest src -> pprAssign platform dest src
+    CmmAssign dest src -> pprAssign dest src
 
     CmmStore  dest src
         | typeWidth rep == W64 && wordWidth /= W64
         -> (if isFloatType rep then ptext (sLit "ASSIGN_DBL")
                                else ptext (sLit ("ASSIGN_Word64"))) <>
-           parens (mkP_ <> pprExpr1 platform dest <> comma <> pprExpr platform src) <> semi
+           parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
 
         | otherwise
-        -> hsep [ pprExpr platform (CmmLoad dest rep), equals, pprExpr platform src <> semi ]
+        -> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]
         where
           rep = cmmExprType src
 
@@ -197,10 +197,10 @@ pprStmt platform stmt = case stmt of
         maybe_proto $$
         fnCall
         where
-        cast_fn = parens (cCast platform (pprCFunType (char '*') cconv results args) fn)
+        cast_fn = parens (cCast (pprCFunType (char '*') cconv results args) fn)
 
         real_fun_proto lbl = char ';' <>
-                        pprCFunType (pprCLabel platform lbl) cconv results args <>
+                        pprCFunType (ppr lbl) cconv results args <>
                         noreturn_attr <> semi
 
         noreturn_attr = case ret of
@@ -212,7 +212,7 @@ pprStmt platform stmt = case stmt of
             case fn of
               CmmLit (CmmLabel lbl)
                 | StdCallConv <- cconv ->
-                    let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
+                    let myCall = pprCall (ppr lbl) cconv results args
                     in (real_fun_proto lbl, myCall)
                         -- stdcall functions must be declared with
                         -- a function type, otherwise the C compiler
@@ -220,17 +220,17 @@ pprStmt platform stmt = case stmt of
                         -- can't add the @n suffix ourselves, because
                         -- it isn't valid C.
                 | CmmNeverReturns <- ret ->
-                    let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
+                    let myCall = pprCall (ppr lbl) cconv results args
                     in (real_fun_proto lbl, myCall)
                 | not (isMathFun lbl) ->
-                    pprForeignCall platform (pprCLabel platform lbl) cconv results args
+                    pprForeignCall (ppr lbl) cconv results args
               _ ->
                    (empty {- no proto -},
-                    pprCall platform cast_fn cconv results args <> semi)
+                    pprCall cast_fn cconv results args <> semi)
                         -- for a dynamic call, no declaration is necessary.
 
     CmmCall (CmmPrim _ (Just stmts)) _ _ _ ->
-        vcat $ map (pprStmt platform) stmts
+        vcat $ map pprStmt stmts
 
     CmmCall (CmmPrim op _) results args _ret ->
         proto $$ fn_call
@@ -243,22 +243,23 @@ pprStmt platform stmt = case stmt of
           -- We also need to cast mem primops to prevent conflicts with GCC
           -- builtins (see bug #5967).
           | op `elem` [MO_Memcpy, MO_Memset, MO_Memmove]
-          = pprForeignCall platform fn cconv results (init args)
+          = pprForeignCall fn cconv results (init args)
           | otherwise
-          = (empty, pprCall platform fn cconv results args)
+          = (empty, pprCall fn cconv results args)
 
     CmmBranch ident          -> pprBranch ident
-    CmmCondBranch expr ident -> pprCondBranch platform expr ident
-    CmmJump lbl _            -> mkJMP_(pprExpr platform lbl) <> semi
-    CmmSwitch arg ids        -> pprSwitch platform arg ids
+    CmmCondBranch expr ident -> pprCondBranch expr ident
+    CmmJump lbl _            -> mkJMP_(pprExpr lbl) <> semi
+    CmmSwitch arg ids        -> pprSwitch arg ids
 
-pprForeignCall :: Platform -> SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> (SDoc, SDoc)
-pprForeignCall platform fn cconv results args = (proto, fn_call)
+pprForeignCall :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual]
+               -> (SDoc, SDoc)
+pprForeignCall fn cconv results args = (proto, fn_call)
   where
     fn_call = braces (
                  pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
               $$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
-              $$ pprCall platform (text "ghcFunPtr") cconv results args <> semi
+              $$ pprCall (text "ghcFunPtr") cconv results args <> semi
              )
     cast_fn = parens (parens (pprCFunType (char '*') cconv results args) <> fn)
     proto = ptext (sLit ";EF_(") <> fn <> char ')' <> semi
@@ -283,9 +284,9 @@ pprBranch ident = ptext (sLit "goto") <+> pprBlockId ident <> semi
 
 -- ---------------------------------------------------------------------
 -- conditional branches to local labels
-pprCondBranch :: Platform -> CmmExpr -> BlockId -> SDoc
-pprCondBranch platform expr ident
-        = hsep [ ptext (sLit "if") , parens(pprExpr platform expr) ,
+pprCondBranch :: CmmExpr -> BlockId -> SDoc
+pprCondBranch expr ident
+        = hsep [ ptext (sLit "if") , parens(pprExpr expr) ,
                         ptext (sLit "goto") , (pprBlockId ident) <> semi ]
 
 
@@ -298,12 +299,12 @@ pprCondBranch platform expr ident
 -- 'undefined'. However, they may be defined one day, so we better
 -- document this behaviour.
 --
-pprSwitch :: Platform -> CmmExpr -> [ Maybe BlockId ] -> SDoc
-pprSwitch platform e maybe_ids
+pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
+pprSwitch e maybe_ids
   = let pairs  = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
         pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
     in
-        (hang (ptext (sLit "switch") <+> parens ( pprExpr platform e ) <+> lbrace)
+        (hang (ptext (sLit "switch") <+> parens ( pprExpr e ) <+> lbrace)
                 4 (vcat ( map caseify pairs2 )))
         $$ rbrace
 
@@ -337,12 +338,12 @@ pprSwitch platform e maybe_ids
 --
 -- (similar invariants apply to the rest of the pretty printer).
 
-pprExpr :: Platform -> CmmExpr -> SDoc
-pprExpr platform e = case e of
-    CmmLit lit -> pprLit platform lit
+pprExpr :: CmmExpr -> SDoc
+pprExpr e = case e of
+    CmmLit lit -> pprLit lit
 
 
-    CmmLoad e ty -> pprLoad platform e ty
+    CmmLoad e ty -> pprLoad e ty
     CmmReg reg      -> pprCastReg reg
     CmmRegOff reg 0 -> pprCastReg reg
 
@@ -352,17 +353,17 @@ pprExpr platform e = case e of
       where
         pprRegOff op i' = pprCastReg reg <> op <> int i'
 
-    CmmMachOp mop args -> pprMachOpApp platform mop args
+    CmmMachOp mop args -> pprMachOpApp mop args
 
     CmmStackSlot _ _   -> panic "pprExpr: CmmStackSlot not supported!"
 
 
-pprLoad :: Platform -> CmmExpr -> CmmType -> SDoc
-pprLoad platform e ty
+pprLoad :: CmmExpr -> CmmType -> SDoc
+pprLoad e ty
   | width == W64, wordWidth /= W64
   = (if isFloatType ty then ptext (sLit "PK_DBL")
                        else ptext (sLit "PK_Word64"))
-    <> parens (mkP_ <> pprExpr1 platform e)
+    <> parens (mkP_ <> pprExpr1 e)
 
   | otherwise
   = case e of
@@ -378,32 +379,32 @@ pprLoad platform e ty
         --       (For tagging to work, I had to avoid unaligned loads. --ARY)
                         -> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift))
 
-        _other -> cLoad platform e ty
+        _other -> cLoad e ty
   where
     width = typeWidth ty
 
-pprExpr1 :: Platform -> CmmExpr -> SDoc
-pprExpr1 platform (CmmLit lit)     = pprLit1 platform lit
-pprExpr1 platform e@(CmmReg _reg)  = pprExpr platform e
-pprExpr1 platform other            = parens (pprExpr platform other)
+pprExpr1 :: CmmExpr -> SDoc
+pprExpr1 (CmmLit lit)     = pprLit1 lit
+pprExpr1 e@(CmmReg _reg)  = pprExpr e
+pprExpr1 other            = parens (pprExpr other)
 
 -- --------------------------------------------------------------------------
 -- MachOp applications
 
-pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc
+pprMachOpApp :: MachOp -> [CmmExpr] -> SDoc
 
-pprMachOpApp platform op args
+pprMachOpApp op args
   | isMulMayOfloOp op
-  = ptext (sLit "mulIntMayOflo") <> parens (commafy (map (pprExpr platform) args))
+  = ptext (sLit "mulIntMayOflo") <> parens (commafy (map pprExpr args))
   where isMulMayOfloOp (MO_U_MulMayOflo _) = True
         isMulMayOfloOp (MO_S_MulMayOflo _) = True
         isMulMayOfloOp _ = False
 
-pprMachOpApp platform mop args
+pprMachOpApp mop args
   | Just ty <- machOpNeedsCast mop
-  = ty <> parens (pprMachOpApp' platform mop args)
+  = ty <> parens (pprMachOpApp' mop args)
   | otherwise
-  = pprMachOpApp' platform mop args
+  = pprMachOpApp' mop args
 
 -- Comparisons in C have type 'int', but we want type W_ (this is what
 -- resultRepOfMachOp says).  The other C operations inherit their type
@@ -413,8 +414,8 @@ machOpNeedsCast mop
   | isComparisonMachOp mop = Just mkW_
   | otherwise              = Nothing
 
-pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
-pprMachOpApp' platform mop args
+pprMachOpApp' :: MachOp -> [CmmExpr] -> SDoc
+pprMachOpApp' mop args
  = case args of
     -- dyadic
     [x,y] -> pprArg x <+> pprMachOp_for_C mop <+> pprArg y
@@ -426,9 +427,9 @@ pprMachOpApp' platform mop args
 
   where
         -- Cast needed for signed integer ops
-    pprArg e | signedOp    mop = cCast platform (machRep_S_CType (typeWidth (cmmExprType e))) e
-             | needsFCasts mop = cCast platform (machRep_F_CType (typeWidth (cmmExprType e))) e
-             | otherwise    = pprExpr1 platform e
+    pprArg e | signedOp    mop = cCast (machRep_S_CType (typeWidth (cmmExprType e))) e
+             | needsFCasts mop = cCast (machRep_F_CType (typeWidth (cmmExprType e))) e
+             | otherwise    = pprExpr1 e
     needsFCasts (MO_F_Eq _)   = False
     needsFCasts (MO_F_Ne _)   = False
     needsFCasts (MO_F_Neg _)  = True
@@ -438,8 +439,8 @@ pprMachOpApp' platform mop args
 -- --------------------------------------------------------------------------
 -- Literals
 
-pprLit :: Platform -> CmmLit -> SDoc
-pprLit platform lit = case lit of
+pprLit :: CmmLit -> SDoc
+pprLit lit = case lit of
     CmmInt i rep      -> pprHexVal i rep
 
     CmmFloat f w       -> parens (machRep_F_CType w) <> str
@@ -462,54 +463,54 @@ pprLit platform lit = case lit of
         -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
 
     where
-        pprCLabelAddr lbl = char '&' <> pprCLabel platform lbl
+        pprCLabelAddr lbl = char '&' <> ppr lbl
 
-pprLit1 :: Platform -> CmmLit -> SDoc
-pprLit1 platform lit@(CmmLabelOff _ _) = parens (pprLit platform lit)
-pprLit1 platform lit@(CmmLabelDiffOff _ _ _) = parens (pprLit platform lit)
-pprLit1 platform lit@(CmmFloat _ _)    = parens (pprLit platform lit)
-pprLit1 platform other = pprLit platform other
+pprLit1 :: CmmLit -> SDoc
+pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
+pprLit1 lit@(CmmLabelDiffOff _ _ _) = parens (pprLit lit)
+pprLit1 lit@(CmmFloat _ _)    = parens (pprLit lit)
+pprLit1 other = pprLit other
 
 -- ---------------------------------------------------------------------------
 -- Static data
 
-pprStatics :: Platform -> [CmmStatic] -> [SDoc]
-pprStatics [] = []
-pprStatics platform (CmmStaticLit (CmmFloat f W32) : rest)
+pprStatics :: [CmmStatic] -> [SDoc]
+pprStatics [] = []
+pprStatics (CmmStaticLit (CmmFloat f W32) : rest)
   -- floats are padded to a word, see #1852
   | wORD_SIZE == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
-  = pprLit1 platform (floatToWord f) : pprStatics platform rest'
+  = pprLit1 (floatToWord f) : pprStatics rest'
   | wORD_SIZE == 4
-  = pprLit1 platform (floatToWord f) : pprStatics platform rest
+  = pprLit1 (floatToWord f) : pprStatics rest
   | otherwise
   = pprPanic "pprStatics: float" (vcat (map ppr' rest))
     where ppr' (CmmStaticLit l) = ppr (cmmLitType l)
           ppr' _other           = ptext (sLit "bad static!")
-pprStatics platform (CmmStaticLit (CmmFloat f W64) : rest)
-  = map (pprLit1 platform) (doubleToWords f) ++ pprStatics platform rest
-pprStatics platform (CmmStaticLit (CmmInt i W64) : rest)
+pprStatics (CmmStaticLit (CmmFloat f W64) : rest)
+  = map pprLit1 (doubleToWords f) ++ pprStatics rest
+pprStatics (CmmStaticLit (CmmInt i W64) : rest)
   | wordWidth == W32
 #ifdef WORDS_BIGENDIAN
-  = pprStatics platform (CmmStaticLit (CmmInt q W32) :
+  = pprStatics (CmmStaticLit (CmmInt q W32) :
                 CmmStaticLit (CmmInt r W32) : rest)
 #else
-  = pprStatics platform (CmmStaticLit (CmmInt r W32) :
+  = pprStatics (CmmStaticLit (CmmInt r W32) :
                 CmmStaticLit (CmmInt q W32) : rest)
 #endif
   where r = i .&. 0xffffffff
         q = i `shiftR` 32
-pprStatics (CmmStaticLit (CmmInt _ w) : _)
+pprStatics (CmmStaticLit (CmmInt _ w) : _)
   | w /= wordWidth
   = panic "pprStatics: cannot emit a non-word-sized static literal"
-pprStatics platform (CmmStaticLit lit : rest)
-  = pprLit1 platform lit : pprStatics platform rest
-pprStatics platform (other : _)
-  = pprPanic "pprWord" (pprStatic platform other)
+pprStatics (CmmStaticLit lit : rest)
+  = pprLit1 lit : pprStatics rest
+pprStatics (other : _)
+  = pprPanic "pprWord" (pprStatic other)
 
-pprStatic :: Platform -> CmmStatic -> SDoc
-pprStatic platform s = case s of
+pprStatic :: CmmStatic -> SDoc
+pprStatic s = case s of
 
-    CmmStaticLit lit   -> nest 4 (pprLit platform lit)
+    CmmStaticLit lit   -> nest 4 (pprLit lit)
     CmmUninitialised i -> nest 4 (mkC_ <> brackets (int i))
 
     -- these should be inlined, like the old .hc
@@ -708,15 +709,15 @@ mkP_  = ptext (sLit "(P_)")        -- StgWord*
 --
 -- Generating assignments is what we're all about, here
 --
-pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc
+pprAssign :: CmmReg -> CmmExpr -> SDoc
 
 -- dest is a reg, rhs is a reg
-pprAssign r1 (CmmReg r2)
+pprAssign r1 (CmmReg r2)
    | isPtrReg r1 && isPtrReg r2
    = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, semi ]
 
 -- dest is a reg, rhs is a CmmRegOff
-pprAssign r1 (CmmRegOff r2 off)
+pprAssign r1 (CmmRegOff r2 off)
    | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE == 0)
    = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]
   where
@@ -728,10 +729,10 @@ pprAssign _ r1 (CmmRegOff r2 off)
 -- dest is a reg, rhs is anything.
 -- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
 -- the lvalue elicits a warning from new GCC versions (3.4+).
-pprAssign platform r1 r2
-  | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 platform r2)
-  | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 platform r2)
-  | otherwise                    = mkAssign (pprExpr platform r2)
+pprAssign r1 r2
+  | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 r2)
+  | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)
+  | otherwise                    = mkAssign (pprExpr r2)
     where mkAssign x = if r1 == CmmGlobal BaseReg
                        then ptext (sLit "ASSIGN_BaseReg") <> parens x <> semi
                        else pprReg r1 <> ptext (sLit " = ") <> x <> semi
@@ -830,11 +831,8 @@ pprLocalReg (LocalReg uniq _) = char '_' <> ppr uniq
 -- -----------------------------------------------------------------------------
 -- Foreign Calls
 
-pprCall :: Platform -> SDoc -> CCallConv
-        -> [HintedCmmFormal] -> [HintedCmmActual]
-        -> SDoc
-
-pprCall platform ppr_fn cconv results args
+pprCall :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc
+pprCall ppr_fn cconv results args
   | not (is_cishCC cconv)
   = panic $ "pprCall: unknown calling convention"
 
@@ -849,12 +847,12 @@ pprCall platform ppr_fn cconv results args
      ppr_assign _other _rhs = panic "pprCall: multiple results"
 
      pprArg (CmmHinted expr AddrHint)
-        = cCast platform (ptext (sLit "void *")) expr
+        = cCast (ptext (sLit "void *")) expr
         -- see comment by machRepHintCType below
      pprArg (CmmHinted expr SignedHint)
-        = cCast platform (machRep_S_CType $ typeWidth $ cmmExprType expr) expr
+        = cCast (machRep_S_CType $ typeWidth $ cmmExprType expr) expr
      pprArg (CmmHinted expr _other)
-        = pprExpr platform expr
+        = pprExpr expr
 
      pprUnHint AddrHint   rep = parens (machRepCType rep)
      pprUnHint SignedHint rep = parens (machRepCType rep)
@@ -873,30 +871,29 @@ is_cishCC PrimCallConv = False
 -- Find and print local and external declarations for a list of
 -- Cmm statements.
 --
-pprTempAndExternDecls :: Platform -> [CmmBasicBlock]
-                      -> (SDoc{-temps-}, SDoc{-externs-})
-pprTempAndExternDecls platform stmts
+pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
+pprTempAndExternDecls stmts
   = (vcat (map pprTempDecl (uniqSetToList temps)),
-     vcat (map (pprExternDecl platform False{-ToDo-}) (Map.keys lbls)))
+     vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
   where (temps, lbls) = runTE (mapM_ te_BB stmts)
 
-pprDataExterns :: Platform -> [CmmStatic] -> SDoc
-pprDataExterns platform statics
-  = vcat (map (pprExternDecl platform False{-ToDo-}) (Map.keys lbls))
+pprDataExterns :: [CmmStatic] -> SDoc
+pprDataExterns statics
+  = vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))
   where (_, lbls) = runTE (mapM_ te_Static statics)
 
 pprTempDecl :: LocalReg -> SDoc
 pprTempDecl l@(LocalReg _ rep)
   = hcat [ machRepCType rep, space, pprLocalReg l, semi ]
 
-pprExternDecl :: Platform -> Bool -> CLabel -> SDoc
-pprExternDecl platform _in_srt lbl
+pprExternDecl :: Bool -> CLabel -> SDoc
+pprExternDecl _in_srt lbl
   -- do not print anything for "known external" things
   | not (needsCDecl lbl) = empty
   | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz
   | otherwise =
         hcat [ visibility, label_type lbl,
-               lparen, pprCLabel platform lbl, text ");" ]
+               lparen, ppr lbl, text ");" ]
  where
   label_type lbl | isCFunctionLabel lbl = ptext (sLit "F_")
                  | otherwise            = ptext (sLit "I_")
@@ -909,7 +906,7 @@ pprExternDecl platform _in_srt lbl
   -- we must generate an appropriate prototype for it, so that the C compiler will
   -- add the @n suffix to the label (#2276)
   stdcall_decl sz =
-        ptext (sLit "extern __attribute__((stdcall)) void ") <> pprCLabel platform lbl
+        ptext (sLit "extern __attribute__((stdcall)) void ") <> ppr lbl
         <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
         <> semi
 
@@ -974,19 +971,19 @@ te_Reg _            = return ()
 -- ---------------------------------------------------------------------
 -- C types for MachReps
 
-cCast :: Platform -> SDoc -> CmmExpr -> SDoc
-cCast platform ty expr = parens ty <> pprExpr1 platform expr
-
-cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
-cLoad platform expr rep
- | bewareLoadStoreAlignment (platformArch platform)
-   = let decl = machRepCType rep <+> ptext (sLit "x") <> semi
-         struct = ptext (sLit "struct") <+> braces (decl)
-         packed_attr = ptext (sLit "__attribute__((packed))")
-         cast = parens (struct <+> packed_attr <> char '*')
-     in parens (cast <+> pprExpr1 platform expr) <> ptext (sLit "->x")
- | otherwise
-    = char '*' <> parens (cCast platform (machRepPtrCType rep) expr)
+cCast :: SDoc -> CmmExpr -> SDoc
+cCast ty expr = parens ty <> pprExpr1 expr
+
+cLoad :: CmmExpr -> CmmType -> SDoc
+cLoad expr rep
+    = sdocWithPlatform $ \platform ->
+      if bewareLoadStoreAlignment (platformArch platform)
+      then let decl = machRepCType rep <+> ptext (sLit "x") <> semi
+               struct = ptext (sLit "struct") <+> braces (decl)
+               packed_attr = ptext (sLit "__attribute__((packed))")
+               cast = parens (struct <+> packed_attr <> char '*')
+           in parens (cast <+> pprExpr1 expr) <> ptext (sLit "->x")
+      else char '*' <> parens (cCast (machRepPtrCType rep) expr)
     where -- On these platforms, unaligned loads are known to cause problems
           bewareLoadStoreAlignment (ArchARM {}) = True
           bewareLoadStoreAlignment _            = False