[Git][ghc/ghc][wip/outputable-cleanup] Minor refactor around Outputable

Krzysztof Gogolewski (@monoidal) gitlab at gitlab.haskell.org
Wed Sep 21 21:05:50 UTC 2022



Krzysztof Gogolewski pushed to branch wip/outputable-cleanup at Glasgow Haskell Compiler / GHC


Commits:
eb1e236f by Krzysztof Gogolewski at 2022-09-21T23:05:30+02:00
Minor refactor around Outputable

* Replace 'text . show' and 'ppr' with 'int'.
* Remove Outputable.hs-boot, no longer needed
* Use pprWithCommas
* Factor out instructions in AArch64 codegen

- - - - -


12 changed files:

- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Types/Avail.hs
- compiler/GHC/Unit/Types.hs-boot
- compiler/GHC/Utils/Outputable.hs
- − compiler/GHC/Utils/Outputable.hs-boot


Changes:

=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1481,28 +1481,28 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
       -> maybe_underscore $ ftext str <> text "_fast"
 
    RtsLabel (RtsSelectorInfoTable upd_reqd offset)
-      -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
+      -> maybe_underscore $ hcat [ text "stg_sel_", int offset
                                  , if upd_reqd
                                     then text "_upd_info"
                                     else text "_noupd_info"
                                  ]
 
    RtsLabel (RtsSelectorEntry upd_reqd offset)
-      -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
+      -> maybe_underscore $ hcat [ text "stg_sel_", int offset
                                  , if upd_reqd
                                     then text "_upd_entry"
                                     else text "_noupd_entry"
                                  ]
 
    RtsLabel (RtsApInfoTable upd_reqd arity)
-      -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
+      -> maybe_underscore $ hcat [ text "stg_ap_", int arity
                                  , if upd_reqd
                                     then text "_upd_info"
                                     else text "_noupd_info"
                                  ]
 
    RtsLabel (RtsApEntry upd_reqd arity)
-      -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
+      -> maybe_underscore $ hcat [ text "stg_ap_", int arity
                                  , if upd_reqd
                                     then text "_upd_entry"
                                     else text "_noupd_entry"


=====================================
compiler/GHC/Cmm/DebugBlock.hs
=====================================
@@ -524,7 +524,7 @@ instance OutputableP Platform UnwindExpr where
 
 pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc
 pprUnwindExpr p env = \case
-  UwConst i     -> ppr i
+  UwConst i     -> int i
   UwReg g 0     -> ppr g
   UwReg g x     -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x))
   UwDeref e     -> char '*' <> pprUnwindExpr 3 env e


=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -386,7 +386,7 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
         let newFileIds = sortBy (comparing snd) $
                          nonDetEltsUFM $ fileIds' `minusUFM` fileIds
             -- See Note [Unique Determinism and code generation]
-            pprDecl (f,n) = text "\t.file " <> ppr n <+>
+            pprDecl (f,n) = text "\t.file " <> int n <+>
                             pprFilePathString (unpackFS f)
 
         emitNativeCode logger config h $ vcat $


=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -373,60 +373,60 @@ pprInstr platform instr = case instr of
   -- AArch64 Instruction Set
   -- 1. Arithmetic Instructions ------------------------------------------------
   ADD  o1 o2 o3
-    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfadd"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-    | otherwise -> text "\tadd"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  CMN  o1 o2    -> text "\tcmn"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3
+    | otherwise -> op3 (text "\tadd") o1 o2 o3
+  CMN  o1 o2    -> op2 (text "\tcmn") o1 o2
   CMP  o1 o2
-    | isFloatOp o1 && isFloatOp o2 -> text "\tfcmp"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
-    | otherwise -> text "\tcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  MSUB o1 o2 o3 o4 -> text "\tmsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
+    | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2
+    | otherwise -> op2 (text "\tcmp") o1 o2
+  MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4
   MUL  o1 o2 o3
-    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfmul"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-    | otherwise -> text "\tmul"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  SMULH o1 o2 o3 -> text "\tsmulh"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  SMULL o1 o2 o3 -> text "\tsmull"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3
+    | otherwise -> op3 (text "\tmul") o1 o2 o3
+  SMULH o1 o2 o3 -> op3 (text "\tsmulh") o1 o2 o3
+  SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3
   NEG  o1 o2
-    | isFloatOp o1 && isFloatOp o2 -> text "\tfneg"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
-    | otherwise -> text "\tneg"  <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2
+    | otherwise -> op2 (text "\tneg") o1 o2
   SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
-    -> text "\tfdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  SDIV o1 o2 o3 -> text "\tsdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+    -> op3 (text "\tfdiv") o1 o2 o3
+  SDIV o1 o2 o3 -> op3 (text "\tsdiv") o1 o2 o3
 
   SUB  o1 o2 o3
-    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfsub"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-    | otherwise -> text "\tsub"  <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  UDIV o1 o2 o3 -> text "\tudiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3
+    | otherwise -> op3 (text "\tsub")  o1 o2 o3
+  UDIV o1 o2 o3 -> op3 (text "\tudiv") o1 o2 o3
 
   -- 2. Bit Manipulation Instructions ------------------------------------------
-  SBFM o1 o2 o3 o4 -> text "\tsbfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
-  UBFM o1 o2 o3 o4 -> text "\tubfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
+  SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4
+  UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4
   -- signed and unsigned bitfield extract
-  SBFX o1 o2 o3 o4 -> text "\tsbfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
-  UBFX o1 o2 o3 o4 -> text "\tubfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
-  SXTB o1 o2       -> text "\tsxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  UXTB o1 o2       -> text "\tuxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  SXTH o1 o2       -> text "\tsxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  UXTH o1 o2       -> text "\tuxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+  SBFX o1 o2 o3 o4 -> op4 (text "\tsbfx") o1 o2 o3 o4
+  UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4
+  SXTB o1 o2       -> op2 (text "\tsxtb") o1 o2
+  UXTB o1 o2       -> op2 (text "\tuxtb") o1 o2
+  SXTH o1 o2       -> op2 (text "\tsxth") o1 o2
+  UXTH o1 o2       -> op2 (text "\tuxth") o1 o2
 
   -- 3. Logical and Move Instructions ------------------------------------------
-  AND o1 o2 o3  -> text "\tand" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  ANDS o1 o2 o3 -> text "\tands" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  ASR o1 o2 o3  -> text "\tasr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  BIC o1 o2 o3  -> text "\tbic" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  BICS o1 o2 o3 -> text "\tbics" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  EON o1 o2 o3  -> text "\teon" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  EOR o1 o2 o3  -> text "\teor" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  LSL o1 o2 o3  -> text "\tlsl" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  LSR o1 o2 o3  -> text "\tlsr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+  AND o1 o2 o3  -> op3 (text "\tand") o1 o2 o3
+  ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3
+  ASR o1 o2 o3  -> op3 (text "\tasr") o1 o2 o3
+  BIC o1 o2 o3  -> op3 (text "\tbic") o1 o2 o3
+  BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3
+  EON o1 o2 o3  -> op3 (text "\teon") o1 o2 o3
+  EOR o1 o2 o3  -> op3 (text "\teor") o1 o2 o3
+  LSL o1 o2 o3  -> op3 (text "\tlsl") o1 o2 o3
+  LSR o1 o2 o3  -> op3 (text "\tlsr") o1 o2 o3
   MOV o1 o2
-    | isFloatOp o1 || isFloatOp o2 -> text "\tfmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-    | otherwise -> text "\tmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  MOVK o1 o2    -> text "\tmovk" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  MVN o1 o2     -> text "\tmvn" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  ORN o1 o2 o3  -> text "\torn" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  ORR o1 o2 o3  -> text "\torr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  ROR o1 o2 o3  -> text "\tror" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  TST o1 o2     -> text "\ttst" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2
+    | otherwise                    -> op2 (text "\tmov") o1 o2
+  MOVK o1 o2    -> op2 (text "\tmovk") o1 o2
+  MVN o1 o2     -> op2 (text "\tmvn") o1 o2
+  ORN o1 o2 o3  -> op3 (text "\torn") o1 o2 o3
+  ORR o1 o2 o3  -> op3 (text "\torr") o1 o2 o3
+  ROR o1 o2 o3  -> op3 (text "\tror") o1 o2 o3
+  TST o1 o2     -> op2 (text "\ttst") o1 o2
 
   -- 4. Branch Instructions ----------------------------------------------------
   J t            -> pprInstr platform (B t)
@@ -459,83 +459,91 @@ pprInstr platform instr = case instr of
   --       address. Not observing the correct size when loading will lead
   --       inevitably to crashes.
   STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    text "\tstrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    op2 (text "\tstrb") o1 o2
   STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    text "\tstrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  STR _f o1 o2 -> text "\tstr" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    op2 (text "\tstrh") o1 o2
+  STR _f o1 o2 -> op2 (text "\tstr") o1 o2
 
 #if defined(darwin_HOST_OS)
   LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$
+    op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$
+    op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmIndex lbl off)) ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$
+    op_add o1 (pprAsmLabel platform lbl <> text "@pageoff") $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$
+    op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff")
 
   LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$
+    op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff")
 
   LDR _f o1 (OpImm (ImmCLbl lbl)) ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff"
+    op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$
+    op_add o1 (pprAsmLabel platform lbl <> text "@pageoff")
+
 #else
   LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmIndex lbl off)) ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) $$
+    op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits.
 
   LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"
+    op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl)
 
   LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
-    text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"
+    op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$
+    op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl)
 
   LDR _f o1 (OpImm (ImmCLbl lbl)) ->
-    text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$
-    text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl
+    op_adrp o1 (pprAsmLabel platform lbl) $$
+    op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl)
+
 #endif
 
   LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    text "\tldrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    op2 (text "\tldrb") o1 o2
   LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
-    text "\tldrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  LDR _f o1 o2 -> text "\tldr" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+    op2 (text "\tldrh") o1 o2
+  LDR _f o1 o2 -> op2 (text "\tldr") o1 o2
 
-  STP _f o1 o2 o3 -> text "\tstp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-  LDP _f o1 o2 o3 -> text "\tldp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+  STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3
+  LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
 
   -- 8. Synchronization Instructions -------------------------------------------
   DMBSY -> text "\tdmb sy"
   -- 9. Floating Point Instructions --------------------------------------------
-  FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
-  FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
+  FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2
+  SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2
+  FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2
+  FABS o1 o2 -> op2 (text "\tfabs") o1 o2
+ where op2 op o1 o2 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2
+       op3 op o1 o2 o3 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+       op4 op o1 o2 o3 o4 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
+       op_ldr o1 rest = text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> rest <> text "]"
+       op_adrp o1 rest = text "\tadrp" <+> pprOp platform o1 <> comma <+> rest
+       op_add o1 rest = text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest
 
 pprBcond :: Cond -> SDoc
 pprBcond c = text "b." <> pprCond c


=====================================
compiler/GHC/Core/Coercion/Axiom.hs
=====================================
@@ -485,7 +485,7 @@ instance Outputable CoAxBranch where
                   , cab_lhs = lhs
                   , cab_rhs = rhs }) =
     text "CoAxBranch" <+> parens (ppr loc) <> colon
-      <+> brackets (fsep (punctuate comma (map pprType lhs)))
+      <+> brackets (pprWithCommas pprType lhs)
       <+> text "=>" <+> pprType rhs
 
 {-


=====================================
compiler/GHC/Hs.hs
=====================================
@@ -124,7 +124,7 @@ instance Outputable (HsModule GhcPs) where
               Nothing -> pp_header (text "where")
               Just es -> vcat [
                            pp_header lparen,
-                           nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),
+                           nest 8 (pprWithCommas ppr (unLoc es)),
                            nest 4 (text ") where")
                           ],
             pp_nonnull imports,


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1691,7 +1691,7 @@ instance DisambECP (HsCmd GhcPs) where
   mkHsWildCardPV l = cmdFail l (text "_")
   mkHsTySigPV l a sig _ = cmdFail (locA l) (ppr a <+> text "::" <+> ppr sig)
   mkHsExplicitListPV l xs _ = cmdFail l $
-    brackets (fsep (punctuate comma (map ppr xs)))
+    brackets (pprWithCommas ppr xs)
   mkHsSplicePV (L l sp) = cmdFail l (pprUntypedSplice True Nothing sp)
   mkHsRecordPV _ l _ a (fbinds, ddLoc) _ = do
     let (fs, ps) = partitionEithers fbinds


=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -489,8 +489,7 @@ addHoleFitDocs fits =
      { let warning =
              text "WARNING: Couldn't find any documentation for the following modules:" $+$
              nest 2
-                  (fsep (punctuate comma
-                                   (either text ppr <$> Set.toList mods)) $+$
+                  (pprWithCommas (either text ppr) (Set.toList mods) $+$
                    text "Make sure the modules are compiled with '-haddock'.")
      ; warnPprTrace (not $ Set.null mods)"addHoleFitDocs" warning (pure ())
      }


=====================================
compiler/GHC/Types/Avail.hs
=====================================
@@ -366,7 +366,7 @@ pprAvail :: AvailInfo -> SDoc
 pprAvail (Avail n)
   = ppr n
 pprAvail (AvailTC n ns)
-  = ppr n <> braces (fsep (punctuate comma (map ppr ns)))
+  = ppr n <> braces (pprWithCommas ppr ns)
 
 instance Binary AvailInfo where
     put_ bh (Avail aa) = do


=====================================
compiler/GHC/Unit/Types.hs-boot
=====================================
@@ -2,7 +2,6 @@
 module GHC.Unit.Types where
 
 import GHC.Prelude ()
-import {-# SOURCE #-} GHC.Utils.Outputable
 import Language.Haskell.Syntax.Module.Name (ModuleName)
 import Data.Kind (Type)
 
@@ -15,4 +14,3 @@ type Unit        = GenUnit    UnitId
 
 moduleName :: GenModule a -> ModuleName
 moduleUnit :: GenModule a -> a
-pprModule :: Module -> SDoc


=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -944,16 +944,16 @@ instance Outputable UTCTime where
     ppr = text . formatShow iso8601Format
 
 instance (Outputable a) => Outputable [a] where
-    ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
+    ppr xs = brackets (pprWithCommas ppr xs)
 
 instance (Outputable a) => Outputable (NonEmpty a) where
     ppr = ppr . NEL.toList
 
 instance (Outputable a) => Outputable (Set a) where
-    ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))
+    ppr s = braces (pprWithCommas ppr (Set.toList s))
 
 instance Outputable IntSet.IntSet where
-    ppr s = braces (fsep (punctuate comma (map ppr (IntSet.toList s))))
+    ppr s = braces (pprWithCommas ppr (IntSet.toList s))
 
 instance (Outputable a, Outputable b) => Outputable (a, b) where
     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])


=====================================
compiler/GHC/Utils/Outputable.hs-boot deleted
=====================================
@@ -1,9 +0,0 @@
-module GHC.Utils.Outputable where
-
-import GHC.Prelude
-
-data SDoc
-data PprStyle
-data SDocContext
-
-text :: String -> SDoc



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb1e236fc6ff37c28cee4cf9a2966ee4a0c4c375

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb1e236fc6ff37c28cee4cf9a2966ee4a0c4c375
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220921/1910bf66/attachment-0001.html>


More information about the ghc-commits mailing list