Fully remove PprDebug

PprDebug was a pain to deal with consistently as it is implied by
`-dppr-debug` but it isn't really a PprStyle. We remove it completely
and query the appropriate SDoc flag instead (`sdocPprDebug`) via
helpers (`getPprDebug` and its friends).

1 files changed, 16 insertions, 21 deletions

diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index b103d3494b..ba843cef30 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -76,7 +76,7 @@ module GHC.Utils.Outputable (
         SDocContext (..), sdocWithContext,
         getPprStyle, withPprStyle, setStyleColoured,
         pprDeeper, pprDeeperList, pprSetDepth,
-        codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
+        codeStyle, userStyle, dumpStyle, asmStyle,
         qualName, qualModule, qualPackage,
         mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
         mkUserStyle, cmdlineParserStyle, Depth(..),
@@ -155,12 +155,10 @@ data PprStyle
                 -- printed without uniques.
 
   | PprDump PrintUnqualified
-                -- For -ddump-foo; less verbose than PprDebug, but more than PprUser
+                -- For -ddump-foo; less verbose than in ppr-debug mode, but more than PprUser
                 -- Does not assume tidied code: non-external names
                 -- are printed with uniques.
 
-  | PprDebug    -- Full debugging output
-
   | PprCode CodeStyle
                 -- Print code; either C or assembler
 
@@ -262,11 +260,10 @@ defaultDumpStyle = PprDump neverQualify
 mkDumpStyle :: PrintUnqualified -> PprStyle
 mkDumpStyle print_unqual = PprDump print_unqual
 
-defaultErrStyle :: DynFlags -> PprStyle
--- Default style for error messages, when we don't know PrintUnqualified
+-- | Default style for error messages, when we don't know PrintUnqualified
 -- It's a bit of a hack because it doesn't take into account what's in scope
 -- Only used for desugarer warnings, and typechecker errors in interface sigs
--- NB that -dppr-debug will still get into PprDebug style
+defaultErrStyle :: DynFlags -> PprStyle
 defaultErrStyle dflags = mkErrStyle dflags neverQualify
 
 -- | Style for printing error messages
@@ -281,9 +278,7 @@ mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
 mkUserStyle unqual depth = PprUser unqual depth Uncoloured
 
 withUserStyle :: PrintUnqualified -> Depth -> SDoc -> SDoc
-withUserStyle unqual depth doc = sdocOption sdocPprDebug $ \case
-   True  -> withPprStyle PprDebug doc
-   False -> withPprStyle (PprUser unqual depth Uncoloured) doc
+withUserStyle unqual depth doc = withPprStyle (PprUser unqual depth Uncoloured) doc
 
 withErrStyle :: PrintUnqualified -> SDoc -> SDoc
 withErrStyle unqual doc =
@@ -303,7 +298,6 @@ instance Outputable PprStyle where
   ppr (PprUser {})  = text "user-style"
   ppr (PprCode {})  = text "code-style"
   ppr (PprDump {})  = text "dump-style"
-  ppr (PprDebug {}) = text "debug-style"
 
 {-
 Orthogonal to the above printing styles are (possibly) some
@@ -457,23 +451,20 @@ dumpStyle :: PprStyle -> Bool
 dumpStyle (PprDump {}) = True
 dumpStyle _other       = False
 
-debugStyle :: PprStyle -> Bool
-debugStyle PprDebug = True
-debugStyle _other   = False
-
 userStyle ::  PprStyle -> Bool
 userStyle (PprUser {}) = True
 userStyle _other       = False
 
+-- | Indicate if -dppr-debug mode is enabled
 getPprDebug :: (Bool -> SDoc) -> SDoc
-getPprDebug d = getPprStyle $ \ sty -> d (debugStyle sty)
+getPprDebug d = sdocWithContext $ \ctx -> d (sdocPprDebug ctx)
 
+-- | Says what to do with and without -dppr-debug
 ifPprDebug :: SDoc -> SDoc -> SDoc
--- ^ Says what to do with and without -dppr-debug
-ifPprDebug yes no = getPprDebug $ \ dbg -> if dbg then yes else no
+ifPprDebug yes no = getPprDebug $ \dbg -> if dbg then yes else no
 
+-- | Says what to do with -dppr-debug; without, return empty
 whenPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
--- ^ Says what to do with -dppr-debug; without, return empty
 whenPprDebug d = ifPprDebug d empty
 
 -- | The analog of 'Pretty.printDoc_' for 'SDoc', which tries to make sure the
@@ -550,7 +541,11 @@ showSDocDump :: DynFlags -> SDoc -> String
 showSDocDump dflags d = renderWithStyle (initSDocContext dflags defaultDumpStyle) d
 
 showSDocDebug :: DynFlags -> SDoc -> String
-showSDocDebug dflags d = renderWithStyle (initSDocContext dflags PprDebug) d
+showSDocDebug dflags d = renderWithStyle ctx d
+   where
+      ctx = (initSDocContext dflags defaultDumpStyle)
+               { sdocPprDebug = True
+               }
 
 renderWithStyle :: SDocContext -> SDoc -> String
 renderWithStyle ctx sdoc
@@ -580,7 +575,7 @@ irrelevantNCols :: Int
 irrelevantNCols = 1
 
 isEmpty :: SDocContext -> SDoc -> Bool
-isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocStyle = PprDebug})
+isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocPprDebug = True})
 
 docToSDoc :: Doc -> SDoc
 docToSDoc d = SDoc (\_ -> d)