Use SDoc rather than Doc in the native gens
authorIan Lynagh <igloo@earth.li>
Tue, 12 Jun 2012 20:55:09 +0000 (21:55 +0100)
committerIan Lynagh <igloo@earth.li>
Tue, 12 Jun 2012 20:55:09 +0000 (21:55 +0100)
This avoid lots of converting back and forth between the two types.

compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/PPC/Regs.hs
compiler/nativeGen/PprBase.hs
compiler/nativeGen/SPARC/Imm.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/Ppr.hs
compiler/nativeGen/X86/Regs.hs

index ddd8775..12382dd 100644 (file)
@@ -64,7 +64,6 @@ import Util
 
 import BasicTypes       ( Alignment )
 import Digraph
-import Pretty (Doc)
 import qualified Pretty
 import BufWrite
 import Outputable
@@ -114,7 +113,7 @@ The machine-dependent bits break down as follows:
     machine instructions.
 
   * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
-    a 'Doc').
+    a 'SDoc').
 
   * ["RegAllocInfo"] In the register allocator, we manipulate
     'MRegsState's, which are 'BitSet's, one bit per machine register.
@@ -139,7 +138,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 -> Doc,
+    pprNatCmmDecl              :: Platform -> NatCmmDecl statics instr -> SDoc,
     maxSpillSlots             :: Int,
     allocatableRegs           :: [RealReg],
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
@@ -228,7 +227,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
         -- dump native code
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm "Asm code"
-                (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) $ concat native)
+                (vcat $ map (pprNatCmmDecl ncgImpl platform) $ concat native)
 
         -- dump global NCG stats for graph coloring allocator
         (case concat $ catMaybes colorStats of
@@ -261,6 +260,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
 
         -- write out the imports
         Pretty.printDoc Pretty.LeftMode h
+                $ withPprStyleDoc (mkCodeStyle AsmStyle)
                 $ makeImportsDoc dflags (concat imports)
 
         return  ()
@@ -301,7 +301,8 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
                 <- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags ncgImpl us cmm count
 
         {-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
-                $ Pretty.vcat $ map (pprNatCmmDecl ncgImpl platform) native
+                $ withPprStyleDoc (mkCodeStyle AsmStyle)
+                $ vcat $ map (pprNatCmmDecl ncgImpl platform) native
 
            -- carefully evaluate this strictly.  Binding it with 'let'
            -- and then using 'seq' doesn't work, because the let
@@ -368,7 +369,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_native "Native code"
-                (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) native)
+                (vcat $ map (pprNatCmmDecl ncgImpl platform) native)
 
         -- tag instructions with register liveness information
         let (withLiveness, usLive) =
@@ -406,7 +407,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 (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced)
+                        (vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
 
                 dumpIfSet_dyn dflags
                         Opt_D_dump_asm_regalloc_stages "Build/spill stages"
@@ -437,7 +438,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
                 dumpIfSet_dyn dflags
                         Opt_D_dump_asm_regalloc "Registers allocated"
-                        (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced)
+                        (vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
 
                 let mPprStats =
                         if dopt Opt_D_dump_asm_stats dflags
@@ -481,7 +482,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_expanded "Synthetic instructions expanded"
-                (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) expanded)
+                (vcat $ map (pprNatCmmDecl ncgImpl platform) expanded)
 
         return  ( usAlloc
                 , expanded
@@ -498,17 +499,17 @@ x86fp_kludge (CmmProc info lbl (ListGraph code)) =
 
 -- | Build a doc for all the imports.
 --
-makeImportsDoc :: DynFlags -> [CLabel] -> Pretty.Doc
+makeImportsDoc :: DynFlags -> [CLabel] -> SDoc
 makeImportsDoc dflags imports
  = dyld_stubs imports
-            Pretty.$$
+            $$
             -- On recent versions of Darwin, the linker supports
             -- dead-stripping of code and data on a per-symbol basis.
             -- There's a hack to make this work in PprMach.pprNatCmmDecl.
             (if platformHasSubsectionsViaSymbols (targetPlatform dflags)
-             then Pretty.text ".subsections_via_symbols"
-             else Pretty.empty)
-            Pretty.$$
+             then text ".subsections_via_symbols"
+             else empty)
+            $$
                 -- On recent GNU ELF systems one can mark an object file
                 -- as not requiring an executable stack. If all objects
                 -- linked into a program have this note then the program
@@ -516,23 +517,21 @@ makeImportsDoc dflags imports
                 -- security. GHC generated code does not need an executable
                 -- stack so add the note in:
             (if platformHasGnuNonexecStack (targetPlatform dflags)
-             then Pretty.text ".section .note.GNU-stack,\"\",@progbits"
-             else Pretty.empty)
-            Pretty.$$
+             then text ".section .note.GNU-stack,\"\",@progbits"
+             else empty)
+            $$
                 -- And just because every other compiler does, lets stick in
                 -- an identifier directive: .ident "GHC x.y.z"
             (if platformHasIdentDirective (targetPlatform dflags)
-             then let compilerIdent = Pretty.text "GHC" Pretty.<+>
-                                      Pretty.text cProjectVersion
-                   in Pretty.text ".ident" Pretty.<+>
-                      Pretty.doubleQuotes compilerIdent
-             else Pretty.empty)
+             then let compilerIdent = text "GHC" <+> text cProjectVersion
+                   in text ".ident" <+> doubleQuotes compilerIdent
+             else empty)
 
  where
         -- Generate "symbol stubs" for all external symbols that might
         -- come from a dynamic library.
-        dyld_stubs :: [CLabel] -> Pretty.Doc
-{-      dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
+        dyld_stubs :: [CLabel] -> SDoc
+{-      dyld_stubs imps = vcat $ map pprDyldSymbolStub $
                                     map head $ group $ sort imps-}
 
         platform = targetPlatform dflags
@@ -543,7 +542,7 @@ makeImportsDoc dflags imports
         -- different uniques; so we compare their text versions...
         dyld_stubs imps
                 | needImportedSymbols arch os
-                = Pretty.vcat $
+                = vcat $
                         (pprGotDeclaration arch os :) $
                         map ( pprImportedSymbol platform . fst . head) $
                         groupBy (\(_,a) (_,b) -> a == b) $
@@ -551,7 +550,7 @@ makeImportsDoc dflags imports
                         map doPpr $
                         imps
                 | otherwise
-                = Pretty.empty
+                = empty
 
         doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)
         astyle = mkCodeStyle AsmStyle
index e81ebfb..64e37d0 100644 (file)
@@ -77,10 +77,8 @@ import CLabel           ( mkForeignLabel )
 import StaticFlags     ( opt_PIC, opt_Static )
 import BasicTypes
 
-import Pretty
-import qualified Outputable
+import Outputable
 
-import Panic            ( panic )
 import DynFlags
 import FastString
 
@@ -421,19 +419,6 @@ picRelative _ _ _
 
 --------------------------------------------------------------------------------
 
--- utility function for pretty-printing asm-labels,
--- copied from PprMach
---
-asmSDoc :: Outputable.SDoc -> Doc
-asmSDoc d 
-       = Outputable.withPprStyleDoc 
-               (Outputable.mkCodeStyle Outputable.AsmStyle) d
-
-pprCLabel_asm :: Platform -> CLabel -> Doc
-pprCLabel_asm platform l
-       = asmSDoc (pprCLabel platform l)
-
-
 needImportedSymbols :: Arch -> OS -> Bool
 needImportedSymbols arch os
        | os    == OSDarwin
@@ -468,7 +453,7 @@ gotLabel
 --------------------------------------------------------------------------------
 -- We don't need to declare any offset tables.
 -- However, for PIC on x86, we need a small helper function.
-pprGotDeclaration :: Arch -> OS -> Doc
+pprGotDeclaration :: Arch -> OS -> SDoc
 pprGotDeclaration ArchX86 OSDarwin
        | opt_PIC
        = vcat [
@@ -480,7 +465,7 @@ pprGotDeclaration ArchX86 OSDarwin
                ptext (sLit "\tret") ]
 
 pprGotDeclaration _ OSDarwin
-       = Pretty.empty
+       = empty
                
 -- pprGotDeclaration
 -- Output whatever needs to be output once per .s file.
@@ -491,7 +476,7 @@ pprGotDeclaration arch os
        | osElfTarget os
        , arch  /= ArchPPC_64
        , not opt_PIC 
-       = Pretty.empty
+       = empty
 
        | osElfTarget os
        , arch  /= ArchPPC_64
@@ -511,21 +496,21 @@ pprGotDeclaration _ _
 -- Whenever you change something in this assembler output, make sure
 -- the splitter in driver/split/ghc-split.lprl recognizes the new output
 
-pprImportedSymbol :: Platform -> CLabel -> Doc
+pprImportedSymbol :: Platform -> CLabel -> SDoc
 pprImportedSymbol platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
        | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
        = case opt_PIC of
            False ->
             vcat [
                 ptext (sLit ".symbol_stub"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
-                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
-                    ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm platform lbl
+                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
+                    ptext (sLit "\tlis r11,ha16(L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr)"),
-                    ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr)(r11)"),
                     ptext (sLit "\tmtctr r12"),
-                    ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr)"),
                     ptext (sLit "\tbctr")
             ]
@@ -534,32 +519,32 @@ pprImportedSymbol platform@(Platform { platformArch = ArchPPC, platformOS = OSDa
                 ptext (sLit ".section __TEXT,__picsymbolstub1,")
                   <> ptext (sLit "symbol_stubs,pure_instructions,32"),
                 ptext (sLit "\t.align 2"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
-                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
+                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                     ptext (sLit "\tmflr r0"),
-                    ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm platform lbl,
-                ptext (sLit "L0$") <> pprCLabel_asm platform lbl <> char ':',
+                    ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel platform lbl,
+                ptext (sLit "L0$") <> pprCLabel platform lbl <> char ':',
                     ptext (sLit "\tmflr r11"),
-                    ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm platform lbl
-                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl <> char ')',
+                    ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel platform lbl
+                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl <> char ')',
                     ptext (sLit "\tmtlr r0"),
-                    ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm platform lbl
-                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel platform lbl
+                        <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl
                         <> ptext (sLit ")(r11)"),
                     ptext (sLit "\tmtctr r12"),
                     ptext (sLit "\tbctr")
             ]
          $+$ vcat [
                ptext (sLit ".lazy_symbol_pointer"),
-               ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
-               ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
+               ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
+               ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long dyld_stub_binding_helper")]
 
        | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
        = vcat [
                ptext (sLit ".non_lazy_symbol_pointer"),
-               char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
-               ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
+               char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
+               ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long\t0")]
 
        | otherwise 
@@ -572,13 +557,13 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
            False ->
             vcat [
                 ptext (sLit ".symbol_stub"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
-                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
-                    ptext (sLit "\tjmp *L") <> pprCLabel_asm platform lbl
+                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
+                    ptext (sLit "\tjmp *L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl
+                ptext (sLit "L") <> pprCLabel platform lbl
                     <> ptext (sLit "$stub_binder:"),
-                    ptext (sLit "\tpushl $L") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\tpushl $L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr"),
                     ptext (sLit "\tjmp dyld_stub_binding_helper")
             ]
@@ -586,16 +571,16 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
             vcat [
                 ptext (sLit ".section __TEXT,__picsymbolstub2,")
                     <> ptext (sLit "symbol_stubs,pure_instructions,25"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
-                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
+                ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
+                    ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                     ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
                 ptext (sLit "1:"),
-                    ptext (sLit "\tmovl L") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\tmovl L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
                     ptext (sLit "\tjmp *%edx"),
-                ptext (sLit "L") <> pprCLabel_asm platform lbl
+                ptext (sLit "L") <> pprCLabel platform lbl
                     <> ptext (sLit "$stub_binder:"),
-                    ptext (sLit "\tlea L") <> pprCLabel_asm platform lbl
+                    ptext (sLit "\tlea L") <> pprCLabel platform lbl
                         <> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
                     ptext (sLit "\tpushl %eax"),
                     ptext (sLit "\tjmp dyld_stub_binding_helper")
@@ -603,16 +588,16 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
          $+$ vcat [        ptext (sLit ".section __DATA, __la_sym_ptr")
                     <> (if opt_PIC then int 2 else int 3)
                     <> ptext (sLit ",lazy_symbol_pointers"),
-               ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
-                   ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
-                   ptext (sLit "\t.long L") <> pprCLabel_asm platform lbl
+               ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
+                   ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
+                   ptext (sLit "\t.long L") <> pprCLabel platform lbl
                     <> ptext (sLit "$stub_binder")]
 
        | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
        = vcat [
                ptext (sLit ".non_lazy_symbol_pointer"),
-               char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
-               ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
+               char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
+               ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
                ptext (sLit "\t.long\t0")]
 
        | otherwise 
@@ -667,8 +652,8 @@ pprImportedSymbol platform importedLbl
 
                 in vcat [
                      ptext (sLit ".section \".got2\", \"aw\""),
-                     ptext (sLit ".LC_") <> pprCLabel_asm platform lbl <> char ':',
-                     ptext symbolSize <+> pprCLabel_asm platform lbl ]
+                     ptext (sLit ".LC_") <> pprCLabel platform lbl <> char ':',
+                     ptext symbolSize <+> pprCLabel platform lbl ]
 
            -- PLT code stubs are generated automatically by the dynamic linker.
            _ -> empty
index 155df3c..6026abc 100644 (file)
@@ -35,10 +35,8 @@ import CLabel
 
 import Unique                ( pprUnique, Uniquable(..) )
 import Platform
-import Pretty
 import FastString
-import qualified Outputable
-import Outputable ( PlatformOutputable, panic )
+import Outputable
 
 import Data.Word
 import Data.Bits
@@ -47,7 +45,7 @@ import Data.Bits
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> Doc
+pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl platform (CmmData section dats) =
   pprSectionHeader platform section $$ pprDatas platform dats
 
@@ -65,7 +63,7 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
   pprSectionHeader platform Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
-        then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
+        then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
         else empty) $$
        vcat (map (pprData platform) info) $$
        pprLabel platform info_lbl
@@ -82,23 +80,23 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
          -- so that the linker will not think it is unreferenced and dead-strip
          -- it. That's why the label is called a DeadStripPreventer (_dsp).
                   text "\t.long "
-              <+> pprCLabel_asm platform info_lbl
+              <+> pprCLabel platform info_lbl
               <+> char '-'
-              <+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
+              <+> pprCLabel platform (mkDeadStripPreventer info_lbl)
          else empty)
 
 
-pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
+pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc
 pprBasicBlock platform (BasicBlock blockid instrs) =
   pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
   vcat (map (pprInstr platform) instrs)
 
 
 
-pprDatas :: Platform -> CmmStatics -> Doc
+pprDatas :: Platform -> CmmStatics -> SDoc
 pprDatas platform (Statics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
 
-pprData :: Platform -> CmmStatic -> Doc
+pprData :: Platform -> CmmStatic -> SDoc
 pprData _ (CmmString str)          = pprASCII str
 pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes
     where keyword = case platformOS platform of
@@ -106,30 +104,30 @@ pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes
                     _        -> ".skip "
 pprData platform (CmmStaticLit lit)       = pprDataItem platform lit
 
-pprGloblDecl :: Platform -> CLabel -> Doc
+pprGloblDecl :: Platform -> CLabel -> SDoc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl
+  | otherwise = ptext (sLit ".globl ") <> pprCLabel platform lbl
 
-pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
+pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
 pprTypeAndSizeDecl platform lbl
   | platformOS platform == OSLinux && externallyVisibleCLabel lbl
     = ptext (sLit ".type ") <>
-      pprCLabel_asm platform lbl <> ptext (sLit ", @object")
+      pprCLabel platform lbl <> ptext (sLit ", @object")
 pprTypeAndSizeDecl _ _
   = empty
 
-pprLabel :: Platform -> CLabel -> Doc
+pprLabel :: Platform -> CLabel -> SDoc
 pprLabel platform lbl = pprGloblDecl platform lbl
                      $$ pprTypeAndSizeDecl platform lbl
-                     $$ (pprCLabel_asm platform lbl <> char ':')
+                     $$ (pprCLabel platform lbl <> char ':')
 
 
-pprASCII :: [Word8] -> Doc
+pprASCII :: [Word8] -> SDoc
 pprASCII str
   = vcat (map do1 str) $$ do1 0
     where
-       do1 :: Word8 -> Doc
+       do1 :: Word8 -> SDoc
        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 
 
@@ -137,22 +135,22 @@ pprASCII str
 -- pprInstr: print an 'Instr'
 
 instance PlatformOutputable Instr where
-    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
+    pprPlatform platform instr = pprInstr platform instr
 
 
-pprReg :: Platform -> Reg -> Doc
+pprReg :: Platform -> Reg -> SDoc
 
 pprReg platform r
   = case r of
       RegReal    (RealRegSingle i) -> ppr_reg_no i
       RegReal    (RealRegPair{})   -> panic "PPC.pprReg: no reg pairs on this arch"
-      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
+      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> pprUnique u
+      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> pprUnique u
+      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> pprUnique u
+      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> pprUnique u
+      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> pprUnique u
   where
-    ppr_reg_no :: Int -> Doc
+    ppr_reg_no :: Int -> SDoc
     ppr_reg_no i =
         case platformOS platform of
         OSDarwin ->
@@ -199,7 +197,7 @@ pprReg platform r
 
 
 
-pprSize :: Size -> Doc
+pprSize :: Size -> SDoc
 pprSize x 
  = ptext (case x of
                 II8        -> sLit "b"
@@ -210,7 +208,7 @@ pprSize x
                 _        -> panic "PPC.Ppr.pprSize: no match")
                 
                 
-pprCond :: Cond -> Doc
+pprCond :: Cond -> SDoc
 pprCond c 
  = ptext (case c of {
                 ALWAYS  -> sLit "";
@@ -221,12 +219,12 @@ pprCond c
                 GU      -> sLit "gt";  LEU   -> sLit "le"; })
 
 
-pprImm :: Platform -> Imm -> Doc
+pprImm :: Platform -> Imm -> SDoc
 
 pprImm _        (ImmInt i)     = int i
 pprImm _        (ImmInteger i) = integer i
-pprImm platform (ImmCLbl l)    = pprCLabel_asm platform l
-pprImm platform (ImmIndex l i) = pprCLabel_asm platform l <> char '+' <> int i
+pprImm platform (ImmCLbl l)    = pprCLabel platform l
+pprImm platform (ImmIndex l i) = pprCLabel platform l <> char '+' <> int i
 pprImm _        (ImmLit s)     = s
 
 pprImm _        (ImmFloat _)  = ptext (sLit "naughty float immediate")
@@ -252,7 +250,7 @@ pprImm platform (HA i)
     else pprImm platform i <> text "@ha"
 
 
-pprAddr :: Platform -> AddrMode -> Doc
+pprAddr :: Platform -> AddrMode -> SDoc
 pprAddr platform (AddrRegReg r1 r2)
   = pprReg platform r1 <+> ptext (sLit ", ") <+> pprReg platform r2
 
@@ -261,7 +259,7 @@ pprAddr platform (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pp
 pprAddr platform (AddrRegImm r1 imm) = hcat [ pprImm platform imm, char '(', pprReg platform r1, char ')' ]
 
 
-pprSectionHeader :: Platform -> Section -> Doc
+pprSectionHeader :: Platform -> Section -> SDoc
 pprSectionHeader platform seg
  = case seg of
         Text                    -> ptext (sLit ".text\n.align 2")
@@ -283,7 +281,7 @@ pprSectionHeader platform seg
     where osDarwin = platformOS platform == OSDarwin
 
 
-pprDataItem :: Platform -> CmmLit -> Doc
+pprDataItem :: Platform -> CmmLit -> SDoc
 pprDataItem platform lit
   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
     where
@@ -314,7 +312,7 @@ pprDataItem platform lit
                 = panic "PPC.Ppr.pprDataItem: no match"
 
 
-pprInstr :: Platform -> Instr -> Doc
+pprInstr :: Platform -> Instr -> SDoc
 
 pprInstr _ (COMMENT _) = empty -- nuke 'em
 {-
@@ -473,7 +471,7 @@ pprInstr platform (BCC cond blockid) = hcat [
         ptext (sLit "b"),
         pprCond cond,
         char '\t',
-        pprCLabel_asm platform lbl
+        pprCLabel platform lbl
     ]
     where lbl = mkAsmTempLabel (getUnique blockid)
 
@@ -485,7 +483,7 @@ pprInstr platform (BCCFAR cond blockid) = vcat [
         ],
         hcat [
             ptext (sLit "\tb\t"),
-            pprCLabel_asm platform lbl
+            pprCLabel platform lbl
         ]
     ]
     where lbl = mkAsmTempLabel (getUnique blockid)
@@ -494,7 +492,7 @@ pprInstr platform (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
         char '\t',
         ptext (sLit "b"),
         char '\t',
-        pprCLabel_asm platform lbl
+        pprCLabel platform lbl
     ]
 
 pprInstr platform (MTCTR reg) = hcat [
@@ -509,7 +507,7 @@ pprInstr _ (BCTR _ _) = hcat [
     ]
 pprInstr platform (BL lbl _) = hcat [
         ptext (sLit "\tbl\t"),
-        pprCLabel_asm platform lbl
+        pprCLabel platform lbl
     ]
 pprInstr _ (BCTRL _) = hcat [
         char '\t',
@@ -663,7 +661,7 @@ pprInstr _ LWSYNC = ptext (sLit "\tlwsync")
 -- pprInstr _ _ = panic "pprInstr (ppc)"
 
 
-pprLogic :: Platform -> LitString -> Reg -> Reg -> RI -> Doc
+pprLogic :: Platform -> LitString -> Reg -> Reg -> RI -> SDoc
 pprLogic platform op reg1 reg2 ri = hcat [
         char '\t',
         ptext op,
@@ -679,7 +677,7 @@ pprLogic platform op reg1 reg2 ri = hcat [
     ]
 
 
-pprUnary :: Platform -> LitString -> Reg -> Reg -> Doc
+pprUnary :: Platform -> LitString -> Reg -> Reg -> SDoc
 pprUnary platform op reg1 reg2 = hcat [
         char '\t',
         ptext op,
@@ -690,7 +688,7 @@ pprUnary platform op reg1 reg2 = hcat [
     ]
     
     
-pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> Doc
+pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> SDoc
 pprBinaryF platform op sz reg1 reg2 reg3 = hcat [
         char '\t',
         ptext op,
@@ -703,12 +701,12 @@ pprBinaryF platform op sz reg1 reg2 reg3 = hcat [
         pprReg platform reg3
     ]
     
-pprRI :: Platform -> RI -> Doc
+pprRI :: Platform -> RI -> SDoc
 pprRI platform (RIReg r) = pprReg platform r
 pprRI platform (RIImm r) = pprImm platform r
 
 
-pprFSize :: Size -> Doc
+pprFSize :: Size -> SDoc
 pprFSize FF64     = empty
 pprFSize FF32     = char 's'
 pprFSize _        = panic "PPC.Ppr.pprFSize: no match"
index 203709e..fe4e06f 100644 (file)
@@ -66,9 +66,7 @@ import OldCmm
 import CLabel           ( CLabel )
 import Unique
 
-import Pretty
-import Outputable       ( panic, SDoc )        
-import qualified Outputable
+import Outputable
 import Constants
 import FastBool
 import FastTypes
@@ -136,10 +134,10 @@ mkVirtualReg u size
 regDotColor :: RealReg -> SDoc
 regDotColor reg
  = case classOfRealReg reg of
-        RcInteger       -> Outputable.text "blue"
-        RcFloat         -> Outputable.text "red"
-        RcDouble        -> Outputable.text "green"
-        RcDoubleSSE     -> Outputable.text "yellow"
+        RcInteger       -> text "blue"
+        RcFloat         -> text "red"
+        RcDouble        -> text "green"
+        RcDoubleSSE     -> text "yellow"
 
 
 -- immediates ------------------------------------------------------------------
@@ -147,7 +145,7 @@ data Imm
        = ImmInt        Int
        | ImmInteger    Integer     -- Sigh.
        | ImmCLbl       CLabel      -- AbstractC Label (with baggage)
-       | ImmLit        Doc         -- Simple string
+       | ImmLit        SDoc        -- Simple string
        | ImmIndex    CLabel Int
        | ImmFloat      Rational
        | ImmDouble     Rational
index b05d6be..34a954b 100644 (file)
@@ -14,8 +14,6 @@
 -- for details
 
 module PprBase (
-       asmSDoc,
-       pprCLabel_asm,
        castFloatToWord8Array,
        castDoubleToWord8Array,
        floatToBytes,
@@ -24,11 +22,6 @@ module PprBase (
 
 where
 
-import qualified Outputable
-import Platform
-import CLabel
-import Pretty
-
 -- castSTUArray has moved to Data.Array.Unsafe
 #if __GLASGOW_HASKELL__ >= 703
 import Data.Array.Unsafe( castSTUArray )
@@ -43,16 +36,6 @@ import Data.Word
 
 
 
-asmSDoc :: Outputable.SDoc -> Doc
-asmSDoc d 
-       = Outputable.withPprStyleDoc (Outputable.mkCodeStyle Outputable.AsmStyle) d
-
-
-pprCLabel_asm :: Platform -> CLabel -> Doc
-pprCLabel_asm platform l
-    = asmSDoc (pprCLabel platform l)
-
-
 -- -----------------------------------------------------------------------------
 -- Converting floating-point literals to integrals for printing
 
index 74dc8e0..eacc905 100644 (file)
@@ -19,8 +19,7 @@ import OldCmm
 import CLabel
 import BlockId
 
-import Pretty
-import Panic
+import Outputable
 
 -- | An immediate value.
 --     Not all of these are directly representable by the machine. 
@@ -36,7 +35,7 @@ data Imm
        | ImmCLbl       CLabel      
 
        -- Simple string
-       | ImmLit        Doc         
+       | ImmLit        SDoc
        | ImmIndex      CLabel Int
        | ImmFloat      Rational
        | ImmDouble     Rational
index 5c811c5..4d01b1f 100644 (file)
@@ -45,17 +45,15 @@ import OldPprCmm()
 import CLabel
 
 import Unique          ( Uniquable(..), pprUnique )
-import qualified Outputable
-import Outputable (PlatformOutputable, panic)
+import Outputable
 import Platform
-import Pretty
 import FastString
 import Data.Word
 
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> Doc
+pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl platform (CmmData section dats) =
   pprSectionHeader section $$ pprDatas platform dats
 
@@ -72,7 +70,7 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
   pprSectionHeader Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
-        then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
+        then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
         else empty) $$
        vcat (map (pprData platform) info) $$
        pprLabel platform info_lbl
@@ -89,49 +87,49 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
          -- so that the linker will not think it is unreferenced and dead-strip
          -- it. That's why the label is called a DeadStripPreventer (_dsp).
                   text "\t.long "
-              <+> pprCLabel_asm platform info_lbl
+              <+> pprCLabel platform info_lbl
               <+> char '-'
-              <+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
+              <+> pprCLabel platform (mkDeadStripPreventer info_lbl)
          else empty)
 
 
-pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
+pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc
 pprBasicBlock platform (BasicBlock blockid instrs) =
   pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
   vcat (map (pprInstr platform) instrs)
 
 
-pprDatas :: Platform -> CmmStatics -> Doc
+pprDatas :: Platform -> CmmStatics -> SDoc
 pprDatas platform (Statics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
 
-pprData :: Platform -> CmmStatic -> Doc
+pprData :: Platform -> CmmStatic -> SDoc
 pprData _        (CmmString str)          = pprASCII str
 pprData _        (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
 pprData platform (CmmStaticLit lit)       = pprDataItem platform lit
 
-pprGloblDecl :: Platform -> CLabel -> Doc
+pprGloblDecl :: Platform -> CLabel -> SDoc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = ptext (sLit ".global ") <> pprCLabel_asm platform lbl
+  | otherwise = ptext (sLit ".global ") <> pprCLabel platform lbl
 
-pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
+pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
 pprTypeAndSizeDecl platform lbl
  | platformOS platform == OSLinux && externallyVisibleCLabel lbl
     = ptext (sLit ".type ") <>
-      pprCLabel_asm platform lbl <> ptext (sLit ", @object")
+      pprCLabel platform lbl <> ptext (sLit ", @object")
  | otherwise = empty
 
-pprLabel :: Platform -> CLabel -> Doc
+pprLabel :: Platform -> CLabel -> SDoc
 pprLabel platform lbl = pprGloblDecl platform lbl
                      $$ pprTypeAndSizeDecl platform lbl
-                     $$ (pprCLabel_asm platform lbl <> char ':')
+                     $$ (pprCLabel platform lbl <> char ':')
 
 
-pprASCII :: [Word8] -> Doc
+pprASCII :: [Word8] -> SDoc
 pprASCII str
   = vcat (map do1 str) $$ do1 0
     where
-       do1 :: Word8 -> Doc
+       do1 :: Word8 -> SDoc
        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 
 
@@ -139,20 +137,20 @@ pprASCII str
 -- pprInstr: print an 'Instr'
 
 instance PlatformOutputable Instr where
-    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
+    pprPlatform platform instr = pprInstr platform instr
 
 
 -- | Pretty print a register.
-pprReg :: Reg -> Doc
+pprReg :: Reg -> SDoc
 pprReg reg
  = case reg of
        RegVirtual vr
         -> case vr of
-               VirtualRegI  u  -> text "%vI_"  <> asmSDoc (pprUnique u)
-               VirtualRegHi u  -> text "%vHi_" <> asmSDoc (pprUnique u)
-               VirtualRegF  u  -> text "%vF_"  <> asmSDoc (pprUnique u)
-               VirtualRegD  u  -> text "%vD_"  <> asmSDoc (pprUnique u)
-                VirtualRegSSE u -> text "%vSSE_" <> asmSDoc (pprUnique u)
+                VirtualRegI   u -> text "%vI_"  <> pprUnique u
+                VirtualRegHi  u -> text "%vHi_" <> pprUnique u
+                VirtualRegF   u -> text "%vF_"  <> pprUnique u
+                VirtualRegD   u -> text "%vD_"  <> pprUnique u
+                VirtualRegSSE u -> text "%vSSE_" <> pprUnique u
 
        RegReal rr
         -> case rr of
@@ -170,7 +168,7 @@ pprReg reg
 --     The definition has been unfolded so we get a jump-table in the
 --     object code. This function is called quite a lot when emitting the asm file..
 --
-pprReg_ofRegNo :: Int -> Doc
+pprReg_ofRegNo :: Int -> SDoc
 pprReg_ofRegNo i
  = ptext
     (case i of {
@@ -210,7 +208,7 @@ pprReg_ofRegNo i
 
 
 -- | Pretty print a size for an instruction suffix.
-pprSize :: Size -> Doc
+pprSize :: Size -> SDoc
 pprSize x 
  = ptext 
     (case x of
@@ -225,7 +223,7 @@ pprSize x
 
 -- | Pretty print a size for an instruction suffix.
 --     eg LD is 32bit on sparc, but LDD is 64 bit.
-pprStSize :: Size -> Doc
+pprStSize :: Size -> SDoc
 pprStSize x 
  = ptext 
     (case x of
@@ -239,7 +237,7 @@ pprStSize x
 
                
 -- | Pretty print a condition code.
-pprCond :: Cond -> Doc
+pprCond :: Cond -> SDoc
 pprCond c 
  = ptext 
     (case c of 
@@ -262,7 +260,7 @@ pprCond c
 
 
 -- | Pretty print an address mode.
-pprAddr :: Platform -> AddrMode -> Doc
+pprAddr :: Platform -> AddrMode -> SDoc
 pprAddr platform am
  = case am of
        AddrRegReg r1 (RegReal (RealRegSingle 0))
@@ -290,13 +288,13 @@ pprAddr platform am
 
 
 -- | Pretty print an immediate value.
-pprImm :: Platform -> Imm -> Doc
+pprImm :: Platform -> Imm -> SDoc
 pprImm platform imm
  = case imm of
        ImmInt i        -> int i
        ImmInteger i    -> integer i
-       ImmCLbl l       -> pprCLabel_asm platform l
-       ImmIndex l i    -> pprCLabel_asm platform l <> char '+' <> int i
+       ImmCLbl l       -> pprCLabel platform l
+       ImmIndex l i    -> pprCLabel platform l <> char '+' <> int i
        ImmLit s        -> s
 
        ImmConstantSum a b      
@@ -321,7 +319,7 @@ pprImm platform imm
 --     On SPARC all the data sections must be at least 8 byte aligned
 --     incase we store doubles in them.
 --
-pprSectionHeader :: Section -> Doc
+pprSectionHeader :: Section -> SDoc
 pprSectionHeader seg
  = case seg of
        Text                    -> ptext (sLit ".text\n\t.align 4")
@@ -334,7 +332,7 @@ pprSectionHeader seg
 
 
 -- | Pretty print a data item.
-pprDataItem :: Platform -> CmmLit -> Doc
+pprDataItem :: Platform -> CmmLit -> SDoc
 pprDataItem platform lit
   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
     where
@@ -357,7 +355,7 @@ pprDataItem platform lit
 
 
 -- | Pretty print an instruction.
-pprInstr :: Platform -> Instr -> Doc
+pprInstr :: Platform -> Instr -> SDoc
 
 -- nuke comments.
 pprInstr _        (COMMENT _) 
@@ -527,7 +525,7 @@ pprInstr platform (BI cond b blockid)
        ptext (sLit "\tb"), pprCond cond,
        if b then pp_comma_a else empty,
        char '\t',
-       pprCLabel_asm platform (mkAsmTempLabel (getUnique blockid))
+       pprCLabel platform (mkAsmTempLabel (getUnique blockid))
     ]
 
 pprInstr platform (BF cond b blockid)
@@ -535,7 +533,7 @@ pprInstr platform (BF cond b blockid)
        ptext (sLit "\tfb"), pprCond cond,
        if b then pp_comma_a else empty,
        char '\t',
-       pprCLabel_asm platform (mkAsmTempLabel (getUnique blockid))
+       pprCLabel platform (mkAsmTempLabel (getUnique blockid))
     ]
 
 pprInstr platform (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr platform addr)
@@ -549,13 +547,13 @@ pprInstr _        (CALL (Right reg) n _)
 
 
 -- | Pretty print a RI
-pprRI :: Platform -> RI -> Doc
+pprRI :: Platform -> RI -> SDoc
 pprRI _        (RIReg r) = pprReg r
 pprRI platform (RIImm r) = pprImm platform r
 
 
 -- | Pretty print a two reg instruction.
-pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc
 pprSizeRegReg name size reg1 reg2
   = hcat [
        char '\t',
@@ -572,7 +570,7 @@ pprSizeRegReg name size reg1 reg2
 
 
 -- | Pretty print a three reg instruction.
-pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc
 pprSizeRegRegReg name size reg1 reg2 reg3
   = hcat [
        char '\t',
@@ -590,7 +588,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3
 
 
 -- | Pretty print an instruction of two regs and a ri.
-pprRegRIReg :: Platform -> LitString -> Bool -> Reg -> RI -> Reg -> Doc
+pprRegRIReg :: Platform -> LitString -> Bool -> Reg -> RI -> Reg -> SDoc
 pprRegRIReg platform name b reg1 ri reg2
   = hcat [
        char '\t',
@@ -604,7 +602,7 @@ pprRegRIReg platform name b reg1 ri reg2
     ]
 
 {-
-pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
+pprRIReg :: LitString -> Bool -> RI -> Reg -> SDoc
 pprRIReg name b ri reg1
   = hcat [
        char '\t',
@@ -617,18 +615,18 @@ pprRIReg name b ri reg1
 -}
 
 {-
-pp_ld_lbracket :: Doc
+pp_ld_lbracket :: SDoc
 pp_ld_lbracket    = ptext (sLit "\tld\t[")
 -}
 
-pp_rbracket_comma :: Doc
+pp_rbracket_comma :: SDoc
 pp_rbracket_comma = text "],"
 
 
-pp_comma_lbracket :: Doc
+pp_comma_lbracket :: SDoc
 pp_comma_lbracket = text ",["
 
 
-pp_comma_a :: Doc
+pp_comma_a :: SDoc
 pp_comma_a       = text ",a"
 
index ffed2ec..36593b3 100644 (file)
@@ -36,10 +36,8 @@ import OldCmm
 import CLabel
 import Unique           ( pprUnique, Uniquable(..) )
 import Platform
-import Pretty
 import FastString
-import qualified Outputable
-import Outputable       (panic, PlatformOutputable)
+import Outputable
 
 import Data.Word
 
@@ -48,7 +46,7 @@ import Data.Bits
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: Platform -> NatCmmDecl (Alignment, CmmStatics) Instr -> Doc
+pprNatCmmDecl :: Platform -> NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
 pprNatCmmDecl platform (CmmData section dats) =
   pprSectionHeader platform section $$ pprDatas platform dats
 
@@ -66,7 +64,7 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
   pprSectionHeader platform Text $$
   (
        (if platformHasSubsectionsViaSymbols platform
-        then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
+        then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
         else empty) $$
        vcat (map (pprData platform) info) $$
        pprLabel platform info_lbl
@@ -83,32 +81,32 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
          -- so that the linker will not think it is unreferenced and dead-strip
          -- it. That's why the label is called a DeadStripPreventer (_dsp).
                   text "\t.long "
-              <+> pprCLabel_asm platform info_lbl
+              <+> pprCLabel platform info_lbl
               <+> char '-'
-              <+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
+              <+> pprCLabel platform (mkDeadStripPreventer info_lbl)
          else empty) $$
   pprSizeDecl platform info_lbl
 
 -- | Output the ELF .size directive.
-pprSizeDecl :: Platform -> CLabel -> Doc
+pprSizeDecl :: Platform -> CLabel -> SDoc
 pprSizeDecl platform lbl
  | osElfTarget (platformOS platform) =
-    ptext (sLit "\t.size") <+> pprCLabel_asm platform lbl
-    <> ptext (sLit ", .-") <> pprCLabel_asm platform lbl
+    ptext (sLit "\t.size") <+> pprCLabel platform lbl
+    <> ptext (sLit ", .-") <> pprCLabel platform lbl
  | otherwise = empty
 
-pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
+pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc
 pprBasicBlock platform (BasicBlock blockid instrs) =
   pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
   vcat (map (pprInstr platform) instrs)
 
 
-pprDatas :: Platform -> (Alignment, CmmStatics) -> Doc
+pprDatas :: Platform -> (Alignment, CmmStatics) -> SDoc
 pprDatas platform (align, (Statics lbl dats))
  = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData platform) dats)
  -- TODO: could remove if align == 1
 
-pprData :: Platform -> CmmStatic -> Doc
+pprData :: Platform -> CmmStatic -> SDoc
 pprData _ (CmmString str)          = pprASCII str
 
 pprData platform (CmmUninitialised bytes)
@@ -117,32 +115,32 @@ pprData platform (CmmUninitialised bytes)
 
 pprData platform (CmmStaticLit lit) = pprDataItem platform lit
 
-pprGloblDecl :: Platform -> CLabel -> Doc
+pprGloblDecl :: Platform -> CLabel -> SDoc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl
+  | otherwise = ptext (sLit ".globl ") <> pprCLabel platform lbl
 
-pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
+pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
 pprTypeAndSizeDecl platform lbl
  | osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
     = ptext (sLit ".type ") <>
-      pprCLabel_asm platform lbl <> ptext (sLit ", @object")
+      pprCLabel platform lbl <> ptext (sLit ", @object")
  | otherwise = empty
 
-pprLabel :: Platform -> CLabel -> Doc
+pprLabel :: Platform -> CLabel -> SDoc
 pprLabel platform lbl = pprGloblDecl platform lbl
                      $$ pprTypeAndSizeDecl platform lbl
-                     $$ (pprCLabel_asm platform lbl <> char ':')
+                     $$ (pprCLabel platform lbl <> char ':')
 
 
-pprASCII :: [Word8] -> Doc
+pprASCII :: [Word8] -> SDoc
 pprASCII str
   = vcat (map do1 str) $$ do1 0
     where
-       do1 :: Word8 -> Doc
+       do1 :: Word8 -> SDoc
        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 
-pprAlign :: Platform -> Int -> Doc
+pprAlign :: Platform -> Int -> SDoc
 pprAlign platform bytes
         = ptext (sLit ".align ") <> int alignment
   where
@@ -161,23 +159,23 @@ pprAlign platform bytes
 -- pprInstr: print an 'Instr'
 
 instance PlatformOutputable Instr where
-    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
+    pprPlatform platform instr = pprInstr platform instr
 
 
-pprReg :: Platform -> Size -> Reg -> Doc
+pprReg :: Platform -> Size -> Reg -> SDoc
 pprReg platform s r
   = case r of
       RegReal    (RealRegSingle i) ->
           if target32Bit platform then ppr32_reg_no s i
                                   else ppr64_reg_no s i
       RegReal    (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
-      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
-      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
+      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> pprUnique u
+      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> pprUnique u
+      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> pprUnique u
+      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> pprUnique u
+      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> pprUnique u
   where
-    ppr32_reg_no :: Size -> Int -> Doc
+    ppr32_reg_no :: Size -> Int -> SDoc
     ppr32_reg_no II8   = ppr32_reg_byte
     ppr32_reg_no II16  = ppr32_reg_word
     ppr32_reg_no _     = ppr32_reg_long
@@ -207,7 +205,7 @@ pprReg platform s r
          _  -> ppr_reg_float i
       })
 
-    ppr64_reg_no :: Size -> Int -> Doc
+    ppr64_reg_no :: Size -> Int -> SDoc
     ppr64_reg_no II8   = ppr64_reg_byte
     ppr64_reg_no II16  = ppr64_reg_word
     ppr64_reg_no II32  = ppr64_reg_long
@@ -280,7 +278,7 @@ ppr_reg_float i = case i of
         38 -> sLit "%xmm14";  39 -> sLit "%xmm15"
         _  -> sLit "very naughty x86 register"
 
-pprSize :: Size -> Doc
+pprSize :: Size -> SDoc
 pprSize x
  = ptext (case x of
                 II8   -> sLit "b"
@@ -292,7 +290,7 @@ pprSize x
                 FF80  -> sLit "t"
                 )
 
-pprSize_x87 :: Size -> Doc
+pprSize_x87 :: Size -> SDoc
 pprSize_x87 x
   = ptext $ case x of
                 FF32  -> sLit "s"
@@ -300,7 +298,7 @@ pprSize_x87 x
                 FF80  -> sLit "t"
                 _     -> panic "X86.Ppr.pprSize_x87"
 
-pprCond :: Cond -> Doc
+pprCond :: Cond -> SDoc
 pprCond c
  = ptext (case c of {
                 GEU     -> sLit "ae";   LU    -> sLit "b";
@@ -314,11 +312,11 @@ pprCond c
                 ALWAYS  -> sLit "mp"})
 
 
-pprImm :: Platform -> Imm -> Doc
+pprImm :: Platform -> Imm -> SDoc
 pprImm _        (ImmInt i)     = int i
 pprImm _        (ImmInteger i) = integer i
-pprImm platform (ImmCLbl l)    = pprCLabel_asm platform l
-pprImm platform (ImmIndex l i) = pprCLabel_asm platform l <> char '+' <> int i
+pprImm platform (ImmCLbl l)    = pprCLabel platform l
+pprImm platform (ImmIndex l i) = pprCLabel platform l <> char '+' <> int i
 pprImm _        (ImmLit s)     = s
 
 pprImm _        (ImmFloat _)  = ptext (sLit "naughty float immediate")
@@ -330,7 +328,7 @@ pprImm platform (ImmConstantDiff a b) = pprImm platform a <> char '-'
 
 
 
-pprAddr :: Platform -> AddrMode -> Doc
+pprAddr :: Platform -> AddrMode -> SDoc
 pprAddr platform (ImmAddr imm off)
   = let pp_imm = pprImm platform imm
     in
@@ -361,7 +359,7 @@ pprAddr platform (AddrBaseIndex base index displacement)
     ppr_disp imm        = pprImm platform imm
 
 
-pprSectionHeader :: Platform -> Section -> Doc
+pprSectionHeader :: Platform -> Section -> SDoc
 pprSectionHeader platform seg
  = case platformOS platform of
    OSDarwin
@@ -406,7 +404,7 @@ pprSectionHeader platform seg
 
 
 
-pprDataItem :: Platform -> CmmLit -> Doc
+pprDataItem :: Platform -> CmmLit -> SDoc
 pprDataItem platform lit
   = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
     where
@@ -466,7 +464,7 @@ pprDataItem platform lit
 
 
 
-pprInstr :: Platform -> Instr -> Doc
+pprInstr :: Platform -> Instr -> SDoc
 
 pprInstr _ (COMMENT _) = empty -- nuke 'em
 {-
@@ -592,7 +590,7 @@ pprInstr _ (CLTD II64) = ptext (sLit "\tcqto")
 pprInstr platform (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand platform II8 op)
 
 pprInstr platform (JXX cond blockid)
-  = pprCondInstr (sLit "j") cond (pprCLabel_asm platform lab)
+  = pprCondInstr (sLit "j") cond (pprCLabel platform lab)
   where lab = mkAsmTempLabel (getUnique blockid)
 
 pprInstr platform (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm platform imm)
@@ -862,7 +860,7 @@ pprInstr _ _
 
 
 pprTrigOp :: Platform -> String -> Bool -> CLabel -> CLabel
-          -> Reg -> Reg -> Size -> Doc
+          -> Reg -> Reg -> Size -> SDoc
 pprTrigOp platform
           op -- fsin, fcos or fptan
           isTan -- we need a couple of extra steps if we're doing tan
@@ -878,7 +876,7 @@ pprTrigOp platform
       hcat [gtab, text "fnstsw %ax"] $$
       hcat [gtab, text "test   $0x400,%eax"] $$
       -- If we were in bounds then jump to the end
-      hcat [gtab, text "je     " <> pprCLabel_asm platform l1] $$
+      hcat [gtab, text "je     " <> pprCLabel platform l1] $$
       -- Otherwise we need to shrink the value. Start by
       -- loading pi, doubleing it (by adding it to itself),
       -- and then swapping pi with the value, so the value we
@@ -888,16 +886,16 @@ pprTrigOp platform
       hcat [gtab, text "fxch   %st(1)"] $$
       -- Now we have a loop in which we make the value smaller,
       -- see if it's small enough, and loop if not
-      (pprCLabel_asm platform l2 <> char ':') $$
+      (pprCLabel platform l2 <> char ':') $$
       hcat [gtab, text "fprem1"] $$
       -- My Debian libc uses fstsw here for the tan code, but I can't
       -- see any reason why it should need to be different for tan.
       hcat [gtab, text "fnstsw %ax"] $$
       hcat [gtab, text "test   $0x400,%eax"] $$
-      hcat [gtab, text "jne    " <> pprCLabel_asm platform l2] $$
+      hcat [gtab, text "jne    " <> pprCLabel platform l2] $$
       hcat [gtab, text "fstp   %st(1)"] $$
       hcat [gtab, text op] $$
-      (pprCLabel_asm platform l1 <> char ':') $$
+      (pprCLabel platform l1 <> char ':') $$
       -- Pop the 1.0 tan gave us
       (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
       -- Restore %eax
@@ -908,29 +906,29 @@ pprTrigOp platform
 --------------------------
 
 -- coerce %st(0) to the specified size
-gcoerceto :: Size -> Doc
+gcoerceto :: Size -> SDoc
 gcoerceto FF64 = empty
 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
 gcoerceto _    = panic "X86.Ppr.gcoerceto: no match"
 
-gpush :: Reg -> RegNo -> Doc
+gpush :: Reg -> RegNo -> SDoc
 gpush reg offset
    = hcat [text "fld ", greg reg offset]
 
-gpop :: Reg -> RegNo -> Doc
+gpop :: Reg -> RegNo -> SDoc
 gpop reg offset
    = hcat [text "fstp ", greg reg offset]
 
-greg :: Reg -> RegNo -> Doc
+greg :: Reg -> RegNo -> SDoc
 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
 
-gsemi :: Doc
+gsemi :: SDoc
 gsemi = text " ; "
 
-gtab :: Doc
+gtab :: SDoc
 gtab  = char '\t'
 
-gsp :: Doc
+gsp :: SDoc
 gsp   = char ' '
 
 gregno :: Reg -> RegNo
@@ -938,12 +936,12 @@ gregno (RegReal (RealRegSingle i)) = i
 gregno _           = --pprPanic "gregno" (ppr other)
                      999   -- bogus; only needed for debug printing
 
-pprG :: Platform -> Instr -> Doc -> Doc
+pprG :: Platform -> Instr -> SDoc -> SDoc
 pprG platform fake actual
    = (char '#' <> pprGInstr platform fake) $$ actual
 
 
-pprGInstr :: Platform -> Instr -> Doc
+pprGInstr :: Platform -> Instr -> SDoc
 pprGInstr platform (GMOV src dst)   = pprSizeRegReg platform (sLit "gmov") FF64 src dst
 pprGInstr platform (GLD sz src dst) = pprSizeAddrReg platform (sLit "gld") sz src dst
 pprGInstr platform (GST sz src dst) = pprSizeRegAddr platform (sLit "gst") sz src dst
@@ -973,27 +971,27 @@ pprGInstr platform (GDIV sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gd
 
 pprGInstr _ _ = panic "X86.Ppr.pprGInstr: no match"
 
-pprDollImm :: Platform -> Imm -> Doc
+pprDollImm :: Platform -> Imm -> SDoc
 pprDollImm platform i = ptext (sLit "$") <> pprImm platform i
 
 
-pprOperand :: Platform -> Size -> Operand -> Doc
+pprOperand :: Platform -> Size -> Operand -> SDoc
 pprOperand platform s (OpReg r)   = pprReg platform s r
 pprOperand platform _ (OpImm i)   = pprDollImm platform i
 pprOperand platform _ (OpAddr ea) = pprAddr platform ea
 
 
-pprMnemonic_  :: LitString -> Doc
+pprMnemonic_  :: LitString -> SDoc
 pprMnemonic_ name =
    char '\t' <> ptext name <> space
 
 
-pprMnemonic  :: LitString -> Size -> Doc
+pprMnemonic  :: LitString -> Size -> SDoc
 pprMnemonic name size =
    char '\t' <> ptext name <> pprSize size <> space
 
 
-pprSizeImmOp :: Platform -> LitString -> Size -> Imm -> Operand -> Doc
+pprSizeImmOp :: Platform -> LitString -> Size -> Imm -> Operand -> SDoc
 pprSizeImmOp platform name size imm op1
   = hcat [
         pprMnemonic name size,
@@ -1004,7 +1002,7 @@ pprSizeImmOp platform name size imm op1
     ]
 
 
-pprSizeOp :: Platform -> LitString -> Size -> Operand -> Doc
+pprSizeOp :: Platform -> LitString -> Size -> Operand -> SDoc
 pprSizeOp platform name size op1
   = hcat [
         pprMnemonic name size,
@@ -1012,7 +1010,7 @@ pprSizeOp platform name size op1
     ]
 
 
-pprSizeOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> Doc
+pprSizeOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
 pprSizeOpOp platform name size op1 op2
   = hcat [
         pprMnemonic name size,
@@ -1022,7 +1020,7 @@ pprSizeOpOp platform name size op1 op2
     ]
 
 
-pprOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> Doc
+pprOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
 pprOpOp platform name size op1 op2
   = hcat [
         pprMnemonic_ name,
@@ -1032,7 +1030,7 @@ pprOpOp platform name size op1 op2
     ]
 
 
-pprSizeReg :: Platform -> LitString -> Size -> Reg -> Doc
+pprSizeReg :: Platform -> LitString -> Size -> Reg -> SDoc
 pprSizeReg platform name size reg1
   = hcat [
         pprMnemonic name size,
@@ -1040,7 +1038,7 @@ pprSizeReg platform name size reg1
     ]
 
 
-pprSizeRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> Doc
+pprSizeRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> SDoc
 pprSizeRegReg platform name size reg1 reg2
   = hcat [
         pprMnemonic name size,
@@ -1050,7 +1048,7 @@ pprSizeRegReg platform name size reg1 reg2
     ]
 
 
-pprRegReg :: Platform -> LitString -> Reg -> Reg -> Doc
+pprRegReg :: Platform -> LitString -> Reg -> Reg -> SDoc
 pprRegReg platform name reg1 reg2
   = hcat [
         pprMnemonic_ name,
@@ -1060,7 +1058,7 @@ pprRegReg platform name reg1 reg2
     ]
 
 
-pprSizeOpReg :: Platform -> LitString -> Size -> Operand -> Reg -> Doc
+pprSizeOpReg :: Platform -> LitString -> Size -> Operand -> Reg -> SDoc
 pprSizeOpReg platform name size op1 reg2
   = hcat [
         pprMnemonic name size,
@@ -1069,7 +1067,7 @@ pprSizeOpReg platform name size op1 reg2
         pprReg platform (archWordSize (target32Bit platform)) reg2
     ]
 
-pprCondRegReg :: Platform -> LitString -> Size -> Cond -> Reg -> Reg -> Doc
+pprCondRegReg :: Platform -> LitString -> Size -> Cond -> Reg -> Reg -> SDoc
 pprCondRegReg platform name size cond reg1 reg2
   = hcat [
         char '\t',
@@ -1081,7 +1079,7 @@ pprCondRegReg platform name size cond reg1 reg2
         pprReg platform size reg2
     ]
 
-pprSizeSizeRegReg :: Platform -> LitString -> Size -> Size -> Reg -> Reg -> Doc
+pprSizeSizeRegReg :: Platform -> LitString -> Size -> Size -> Reg -> Reg -> SDoc
 pprSizeSizeRegReg platform name size1 size2 reg1 reg2
   = hcat [
         char '\t',
@@ -1094,7 +1092,7 @@ pprSizeSizeRegReg platform name size1 size2 reg1 reg2
         pprReg platform size2 reg2
     ]
 
-pprSizeSizeOpReg :: Platform -> LitString -> Size -> Size -> Operand -> Reg -> Doc
+pprSizeSizeOpReg :: Platform -> LitString -> Size -> Size -> Operand -> Reg -> SDoc
 pprSizeSizeOpReg platform name size1 size2 op1 reg2
   = hcat [
         pprMnemonic name size2,
@@ -1103,7 +1101,7 @@ pprSizeSizeOpReg platform name size1 size2 op1 reg2
         pprReg platform size2 reg2
     ]
 
-pprSizeRegRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> SDoc
 pprSizeRegRegReg platform name size reg1 reg2 reg3
   = hcat [
         pprMnemonic name size,
@@ -1115,7 +1113,7 @@ pprSizeRegRegReg platform name size reg1 reg2 reg3
     ]
 
 
-pprSizeAddrReg :: Platform -> LitString -> Size -> AddrMode -> Reg -> Doc
+pprSizeAddrReg :: Platform -> LitString -> Size -> AddrMode -> Reg -> SDoc
 pprSizeAddrReg platform name size op dst
   = hcat [
         pprMnemonic name size,
@@ -1125,7 +1123,7 @@ pprSizeAddrReg platform name size op dst
     ]
 
 
-pprSizeRegAddr :: Platform -> LitString -> Size -> Reg -> AddrMode -> Doc
+pprSizeRegAddr :: Platform -> LitString -> Size -> Reg -> AddrMode -> SDoc
 pprSizeRegAddr platform name size src op
   = hcat [
         pprMnemonic name size,
@@ -1135,7 +1133,7 @@ pprSizeRegAddr platform name size src op
     ]
 
 
-pprShift :: Platform -> LitString -> Size -> Operand -> Operand -> Doc
+pprShift :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
 pprShift platform name size src dest
   = hcat [
         pprMnemonic name size,
@@ -1145,7 +1143,7 @@ pprShift platform name size src dest
     ]
 
 
-pprSizeOpOpCoerce :: Platform -> LitString -> Size -> Size -> Operand -> Operand -> Doc
+pprSizeOpOpCoerce :: Platform -> LitString -> Size -> Size -> Operand -> Operand -> SDoc
 pprSizeOpOpCoerce platform name size1 size2 op1 op2
   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
         pprOperand platform size1 op1,
@@ -1154,7 +1152,7 @@ pprSizeOpOpCoerce platform name size1 size2 op1 op2
     ]
 
 
-pprCondInstr :: LitString -> Cond -> Doc -> Doc
+pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
 
index 997caf5..395f914 100644 (file)
@@ -57,8 +57,7 @@ import RegClass
 import BlockId
 import OldCmm
 import CLabel           ( CLabel )
-import Pretty
-import Outputable       ( panic )
+import Outputable
 import Platform
 import FastTypes
 import FastBool
@@ -128,7 +127,7 @@ data Imm
   = ImmInt      Int
   | ImmInteger  Integer     -- Sigh.
   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
-  | ImmLit      Doc         -- Simple string
+  | ImmLit      SDoc        -- Simple string
   | ImmIndex    CLabel Int
   | ImmFloat    Rational
   | ImmDouble   Rational