Remove pprNatCmmDecl's Platform argument

4 files changed, 64 insertions, 56 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 142f467f32..7c314ae84b 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -139,7 +139,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     canShortcut               :: instr -> Maybe jumpDest,
     shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
-    pprNatCmmDecl              :: Platform -> NatCmmDecl statics instr -> SDoc,
+    pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
     maxSpillSlots             :: Int,
     allocatableRegs           :: [RealReg],
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
@@ -228,7 +228,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
         -- dump native code
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm "Asm code"
-                (vcat $ map (pprNatCmmDecl ncgImpl platform) $ concat native)
+                (vcat $ map (pprNatCmmDecl ncgImpl) $ concat native)
 
         -- dump global NCG stats for graph coloring allocator
         (case concat $ catMaybes colorStats of
@@ -325,14 +325,12 @@ cmmNativeGens _ _ _ us [] impAcc profAcc _
 
 cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
  = do
-        let platform = targetPlatform dflags
-
         (us', native, imports, colorStats, linearStats)
                 <- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags ncgImpl us cmm count
 
         {-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
                 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
-                $ vcat $ map (pprNatCmmDecl ncgImpl platform) native
+                $ vcat $ map (pprNatCmmDecl ncgImpl) native
 
            -- carefully evaluate this strictly.  Binding it with 'let'
            -- and then using 'seq' doesn't work, because the let
@@ -399,7 +397,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_native "Native code"
-                (vcat $ map (pprNatCmmDecl ncgImpl platform) native)
+                (vcat $ map (pprNatCmmDecl ncgImpl) native)
 
         -- tag instructions with register liveness information
         let (withLiveness, usLive) =
@@ -437,7 +435,7 @@ cmmNativeGen dflags ncgImpl us cmm count
                 -- dump out what happened during register allocation
                 dumpIfSet_dyn dflags
                         Opt_D_dump_asm_regalloc "Registers allocated"
-                        (vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
+                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
 
                 dumpIfSet_dyn dflags
                         Opt_D_dump_asm_regalloc_stages "Build/spill stages"
@@ -468,7 +466,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
                 dumpIfSet_dyn dflags
                         Opt_D_dump_asm_regalloc "Registers allocated"
-                        (vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
+                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
 
                 let mPprStats =
                         if dopt Opt_D_dump_asm_stats dflags
@@ -512,7 +510,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_expanded "Synthetic instructions expanded"
-                (vcat $ map (pprNatCmmDecl ncgImpl platform) expanded)
+                (vcat $ map (pprNatCmmDecl ncgImpl) expanded)
 
         return  ( usAlloc
                 , expanded
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index c32468628e..1b49a495f5 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -46,21 +46,22 @@ import Data.Bits
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> SDoc
-pprNatCmmDecl _ (CmmData section dats) =
+pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
+pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
  -- special case for split markers:
-pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph []))
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph []))
     = pprLabel lbl
 
  -- special case for code without an info table:
-pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph blocks)) =
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph blocks)) =
   pprSectionHeader Text $$
   pprLabel lbl $$ -- blocks guaranteed not null, so label needed
   vcat (map pprBasicBlock blocks)
 
-pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+pprNatCmmDecl (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+  sdocWithPlatform $ \platform ->
   pprSectionHeader Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index f4945718c3..91a2b894c5 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -48,20 +48,21 @@ import Data.Word
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> SDoc
-pprNatCmmDecl _ (CmmData section dats) =
+pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
+pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
  -- special case for split markers:
-pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
 
  -- special case for code without info table:
-pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph blocks)) =
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph blocks)) =
   pprSectionHeader Text $$
   pprLabel lbl $$ -- blocks guaranteed not null, so label needed
   vcat (map pprBasicBlock blocks)
 
-pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+pprNatCmmDecl (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+  sdocWithPlatform $ \platform ->
   pprSectionHeader Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 1821baf54e..e844376806 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -47,27 +47,28 @@ import Data.Bits
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
-pprNatCmmDecl platform (CmmData section dats) =
-  pprSectionHeader platform section $$ pprDatas platform dats
+pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
+pprNatCmmDecl (CmmData section dats) =
+  pprSectionHeader section $$ pprDatas dats
 
  -- special case for split markers:
-pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
 
  -- special case for code without info table:
-pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) =
-  pprSectionHeader platform Text $$
+pprNatCmmDecl (CmmProc Nothing lbl (ListGraph blocks)) =
+  pprSectionHeader Text $$
   pprLabel lbl $$ -- blocks guaranteed not null, so label needed
   vcat (map pprBasicBlock blocks) $$
-  pprSizeDecl platform lbl
+  pprSizeDecl lbl
 
-pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
-  pprSectionHeader platform Text $$
+pprNatCmmDecl (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+  sdocWithPlatform $ \platform ->
+  pprSectionHeader Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
         then ppr (mkDeadStripPreventer info_lbl) <> char ':'
         else empty) $$
-       vcat (map (pprData platform) info) $$
+       vcat (map pprData info) $$
        pprLabel info_lbl
   ) $$
   vcat (map pprBasicBlock blocks) $$
@@ -86,15 +87,16 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
               <+> char '-'
               <+> ppr (mkDeadStripPreventer info_lbl)
          else empty) $$
-  pprSizeDecl platform info_lbl
+  pprSizeDecl info_lbl
 
 -- | Output the ELF .size directive.
-pprSizeDecl :: Platform -> CLabel -> SDoc
-pprSizeDecl platform lbl
- | osElfTarget (platformOS platform) =
-    ptext (sLit "\t.size") <+> ppr lbl
-    <> ptext (sLit ", .-") <> ppr lbl
- | otherwise = empty
+pprSizeDecl :: CLabel -> SDoc
+pprSizeDecl lbl
+ = sdocWithPlatform $ \platform ->
+   if osElfTarget (platformOS platform)
+   then ptext (sLit "\t.size") <+> ppr lbl
+     <> ptext (sLit ", .-") <> ppr lbl
+   else empty
 
 pprBasicBlock :: NatBasicBlock Instr -> SDoc
 pprBasicBlock (BasicBlock blockid instrs) =
@@ -102,19 +104,20 @@ pprBasicBlock (BasicBlock blockid instrs) =
   vcat (map pprInstr instrs)
 
 
-pprDatas :: Platform -> (Alignment, CmmStatics) -> SDoc
-pprDatas platform (align, (Statics lbl dats))
- = vcat (pprAlign platform align : pprLabel lbl : map (pprData platform) dats)
+pprDatas :: (Alignment, CmmStatics) -> SDoc
+pprDatas (align, (Statics lbl dats))
+ = vcat (pprAlign align : pprLabel lbl : map pprData dats)
  -- TODO: could remove if align == 1
 
-pprData :: Platform -> CmmStatic -> SDoc
-pprData _ (CmmString str)          = pprASCII str
+pprData :: CmmStatic -> SDoc
+pprData (CmmString str) = pprASCII str
 
-pprData platform (CmmUninitialised bytes)
- | platformOS platform == OSDarwin = ptext (sLit ".space ") <> int bytes
- | otherwise                       = ptext (sLit ".skip ")  <> int bytes
+pprData (CmmUninitialised bytes)
+ = sdocWithPlatform $ \platform ->
+   if platformOS platform == OSDarwin then ptext (sLit ".space ") <> int bytes
+                                      else ptext (sLit ".skip ")  <> int bytes
 
-pprData platform (CmmStaticLit lit) = pprDataItem platform lit
+pprData (CmmStaticLit lit) = pprDataItem lit
 
 pprGloblDecl :: CLabel -> SDoc
 pprGloblDecl lbl
@@ -141,13 +144,14 @@ pprASCII str
        do1 :: Word8 -> SDoc
        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 
-pprAlign :: Platform -> Int -> SDoc
-pprAlign platform bytes
-        = ptext (sLit ".align ") <> int alignment
+pprAlign :: Int -> SDoc
+pprAlign bytes
+        = sdocWithPlatform $ \platform ->
+          ptext (sLit ".align ") <> int (alignment platform)
   where
-        alignment = if platformOS platform == OSDarwin
-                    then log2 bytes
-                    else      bytes
+        alignment platform = if platformOS platform == OSDarwin
+                             then log2 bytes
+                             else      bytes
 
         log2 :: Int -> Int  -- cache the common ones
         log2 1 = 0
@@ -362,9 +366,10 @@ pprAddr (AddrBaseIndex base index displacement)
     ppr_disp imm        = pprImm imm
 
 
-pprSectionHeader :: Platform -> Section -> SDoc
-pprSectionHeader platform seg
- = case platformOS platform of
+pprSectionHeader :: Section -> SDoc
+pprSectionHeader seg
+ = sdocWithPlatform $ \platform ->
+   case platformOS platform of
    OSDarwin
     | target32Bit platform ->
        case seg of
@@ -407,8 +412,11 @@ pprSectionHeader platform seg
 
 
 
-pprDataItem :: Platform -> CmmLit -> SDoc
-pprDataItem platform lit
+pprDataItem :: CmmLit -> SDoc
+pprDataItem lit = sdocWithPlatform $ \platform -> pprDataItem' platform lit
+
+pprDataItem' :: Platform -> CmmLit -> SDoc
+pprDataItem' platform lit
   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
     where
         imm = litToImm lit