diff options
author | Benjamin Maurer <maurer.benjamin@gmail.com> | 2021-09-21 20:25:34 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-09-29 09:42:41 -0400 |
commit | 5cc4bd574720fd97d877d702cbafa453434f035e (patch) | |
tree | 737560ef4b45170a7e48ad03867f5588ad2b8525 | |
parent | 361da88a29af9005135d33e00fc61ba92c592970 (diff) | |
download | haskell-5cc4bd574720fd97d877d702cbafa453434f035e.tar.gz |
Rectifying COMMENT and `mkComment` across platforms to work with SDoc
and exhibit similar behaviors. Issue 20400
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/CodeGen.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/Instr.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/Ppr.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC/CodeGen.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC/Instr.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC/Ppr.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/Instr.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/Ppr.hs | 2 |
12 files changed, 27 insertions, 25 deletions
diff --git a/compiler/GHC/CmmToAsm/PPC.hs b/compiler/GHC/CmmToAsm/PPC.hs index d38eb84c64..01d479d1c5 100644 --- a/compiler/GHC/CmmToAsm/PPC.hs +++ b/compiler/GHC/CmmToAsm/PPC.hs @@ -57,4 +57,4 @@ instance Instruction PPC.Instr where mkStackAllocInstr = PPC.mkStackAllocInstr mkStackDeallocInstr = PPC.mkStackDeallocInstr pprInstr = PPC.pprInstr - mkComment = const [] + mkComment = pure . PPC.COMMENT diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs index 1c3b244980..2184c0fc29 100644 --- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs @@ -162,7 +162,7 @@ stmtToInstrs stmt = do config <- getConfig platform <- getPlatform case stmt of - CmmComment s -> return (unitOL (COMMENT s)) + CmmComment s -> return (unitOL (COMMENT $ ftext s)) CmmTick {} -> return nilOL CmmUnwind {} -> return nilOL diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs index 54a73f24a9..2f99528498 100644 --- a/compiler/GHC/CmmToAsm/PPC/Instr.hs +++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs @@ -51,8 +51,8 @@ import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label import GHC.Cmm import GHC.Cmm.Info -import GHC.Data.FastString import GHC.Cmm.CLabel +import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform import GHC.Types.Unique.FM (listToUFM, lookupUFM) @@ -61,6 +61,7 @@ import GHC.Types.Unique.Supply import Control.Monad (replicateM) import Data.Maybe (fromMaybe) + -------------------------------------------------------------------------------- -- Format of a PPC memory address. -- @@ -177,7 +178,7 @@ data RI data Instr -- comment pseudo-op - = COMMENT FastString + = COMMENT SDoc -- location pseudo-op (file, line, col, name) | LOCATION Int Int Int String diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs index 336e0d1804..05217768fc 100644 --- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs +++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs @@ -38,7 +38,6 @@ import GHC.Cmm.Ppr.Expr () -- For Outputable instances import GHC.Types.Unique ( pprUniqueAlways, getUnique ) import GHC.Platform -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic @@ -335,22 +334,21 @@ pprDataItem platform lit = panic "PPC.Ppr.pprDataItem: no match" +asmComment :: SDoc -> SDoc +asmComment c = whenPprDebug $ text "#" <+> c + + pprInstr :: Platform -> Instr -> SDoc pprInstr platform instr = case instr of - COMMENT _ - -> empty -- nuke 'em - - -- COMMENT s - -- -> if platformOS platform == OSLinux - -- then text "# " <> ftext s - -- else text "; " <> ftext s + COMMENT s + -> asmComment s LOCATION file line col _name -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col DELTA d - -> pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d))) + -> asmComment $ text ("\tdelta = " ++ show d) NEWBLOCK _ -> panic "PprMach.pprInstr: NEWBLOCK" diff --git a/compiler/GHC/CmmToAsm/SPARC.hs b/compiler/GHC/CmmToAsm/SPARC.hs index cac72de6d3..7d8379371e 100644 --- a/compiler/GHC/CmmToAsm/SPARC.hs +++ b/compiler/GHC/CmmToAsm/SPARC.hs @@ -69,6 +69,6 @@ instance Instruction SPARC.Instr where takeRegRegMoveInstr = SPARC.takeRegRegMoveInstr mkJumpInstr = SPARC.mkJumpInstr pprInstr = SPARC.pprInstr - mkComment = const [] + mkComment = pure . SPARC.COMMENT mkStackAllocInstr = panic "no sparc_mkStackAllocInstr" mkStackDeallocInstr = panic "no sparc_mkStackDeallocInstr" diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs index aeaaf1c9d3..ae8ee37cf9 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs @@ -53,6 +53,7 @@ import GHC.CmmToAsm.CPrim import GHC.Types.Basic import GHC.Data.FastString import GHC.Data.OrdList +import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -125,7 +126,7 @@ stmtToInstrs stmt = do platform <- getPlatform config <- getConfig case stmt of - CmmComment s -> return (unitOL (COMMENT s)) + CmmComment s -> return (unitOL (COMMENT $ ftext s)) CmmTick {} -> return nilOL CmmUnwind {} -> return nilOL diff --git a/compiler/GHC/CmmToAsm/SPARC/Instr.hs b/compiler/GHC/CmmToAsm/SPARC/Instr.hs index a5c9e46936..6881b06de0 100644 --- a/compiler/GHC/CmmToAsm/SPARC/Instr.hs +++ b/compiler/GHC/CmmToAsm/SPARC/Instr.hs @@ -51,7 +51,7 @@ import GHC.Platform.Regs import GHC.Cmm.CLabel import GHC.Cmm.BlockId import GHC.Cmm -import GHC.Data.FastString +import GHC.Utils.Outputable import GHC.Utils.Panic @@ -102,7 +102,7 @@ data Instr -- meta ops -------------------------------------------------- -- comment pseudo-op - = COMMENT FastString + = COMMENT SDoc -- some static data spat out during code generation. -- Will be extracted before pretty-printing. diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs index b4028fe3b4..2b0d9675fd 100644 --- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs +++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs @@ -56,7 +56,6 @@ import GHC.Types.Unique ( pprUniqueAlways ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform -import GHC.Data.FastString -- ----------------------------------------------------------------------------- -- Printing this stuff out @@ -388,11 +387,15 @@ castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8) castFloatToWord8Array = U.castSTUArray +asmComment :: SDoc -> SDoc +asmComment c = whenPprDebug $ text "#" <+> c + + -- | Pretty print an instruction. pprInstr :: Platform -> Instr -> SDoc pprInstr platform = \case - COMMENT _ -> empty -- nuke comments. - DELTA d -> pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d))) + COMMENT s -> asmComment s + DELTA d -> asmComment $ text ("\tdelta = " ++ show d) -- Newblocks and LData should have been slurped out before producing the .s file. NEWBLOCK _ -> panic "X86.Ppr.pprInstr: NEWBLOCK" diff --git a/compiler/GHC/CmmToAsm/X86.hs b/compiler/GHC/CmmToAsm/X86.hs index 3d9780a99c..4b2f4dfaf2 100644 --- a/compiler/GHC/CmmToAsm/X86.hs +++ b/compiler/GHC/CmmToAsm/X86.hs @@ -62,4 +62,4 @@ instance Instruction X86.Instr where mkStackAllocInstr = X86.mkStackAllocInstr mkStackDeallocInstr = X86.mkStackDeallocInstr pprInstr = X86.pprInstr - mkComment = const [] + mkComment = pure . X86.COMMENT diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs index 8357662a9c..9d7e1b9e7f 100644 --- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs @@ -321,7 +321,7 @@ stmtToInstrs bid stmt = do -> genCCall is32Bit target result_regs args bid _ -> (,Nothing) <$> case stmt of - CmmComment s -> return (unitOL (COMMENT s)) + CmmComment s -> return (unitOL (COMMENT $ ftext s)) CmmTick {} -> return nilOL CmmUnwind regs -> do diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs index 1a9226ec41..6418144bb8 100644 --- a/compiler/GHC/CmmToAsm/X86/Instr.hs +++ b/compiler/GHC/CmmToAsm/X86/Instr.hs @@ -55,7 +55,6 @@ import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label import GHC.Platform.Regs import GHC.Cmm -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform @@ -172,7 +171,7 @@ bit precision. data Instr -- comment pseudo-op - = COMMENT FastString + = COMMENT SDoc -- location pseudo-op (file, line, col, name) | LOCATION Int Int Int String diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs index e284e618da..b06e7f0596 100644 --- a/compiler/GHC/CmmToAsm/X86/Ppr.hs +++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs @@ -572,7 +572,7 @@ asmComment c = whenPprDebug $ text "# " <> c pprInstr :: Platform -> Instr -> SDoc pprInstr platform i = case i of COMMENT s - -> asmComment (ftext s) + -> asmComment s LOCATION file line col _name -> text "\t.loc " <> ppr file <+> ppr line <+> ppr col |