[project @ 2005-03-08 17:12:51 by simonmar]

Fix something that's been bugging me for a while: by default, -ddump-*
output doesn't include uniques when it outputs internal names, but in
most cases you need them because the output hasn't been tidied, so you
end up doing -dppr-debug which is overkill.

Now, -ddump-* prints uniques for internal names by default.  This
shouldn't affect anything else.

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 4ea51b6..a508c74 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -329,6 +329,9 @@ pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), 
                                                       pprUnique uniq])
+  | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique uniq
+                       -- For debug dumps, we're not necessarily dumping
+                       -- tidied code, so we need to print the uniques.
   | otherwise      = ppr_occ_name occ  -- User style
 
 -- Like Internal, except that we only omit the unique in Iface style

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 5592b55..5a4368c 100644 (file)
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -15,7 +15,7 @@ module Outputable (
 
        PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify,
        getPprStyle, withPprStyle, withPprStyleDoc, pprDeeper,
-       codeStyle, userStyle, debugStyle, asmStyle,
+       codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
        ifPprDebug, unqualStyle, 
        mkErrStyle, defaultErrStyle,
 
@@ -76,14 +76,21 @@ import Char             ( ord )
 
 \begin{code}
 data PprStyle
-  = PprUser PrintUnqualified Depth     -- Pretty-print in a way that will
-                                       -- make sense to the ordinary user;
-                                       -- must be very close to Haskell
-                                       -- syntax, etc.
+  = PprUser PrintUnqualified Depth
+               -- Pretty-print in a way that will make sense to the
+               -- ordinary user; must be very close to Haskell
+               -- syntax, etc.
+               -- Assumes printing tidied code: non-system names are
+               -- printed without uniques.
 
-  | PprCode CodeStyle          -- Print code; either C or assembler
+  | PprCode CodeStyle
+               -- Print code; either C or assembler
 
-  | PprDebug                   -- Standard debugging output
+  | PprDump    -- For -ddump-foo; less verbose than PprDebug.
+               -- Does not assume tidied code: non-external names
+               -- are printed with uniques.
+
+  | PprDebug   -- Full debugging output
 
 data CodeStyle = CStyle                -- The format of labels differs for C and assembler
               | AsmStyle
@@ -102,6 +109,9 @@ neverQualify  m n = True
 
 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
 
+defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
+                |  otherwise          = PprDump
+
 mkErrStyle :: PrintUnqualified -> PprStyle
 -- Style for printing error messages
 mkErrStyle print_unqual = mkUserStyle print_unqual (PartWay opt_PprUserLength)
@@ -163,6 +173,10 @@ asmStyle :: PprStyle -> Bool
 asmStyle (PprCode AsmStyle)  = True
 asmStyle other               = False
 
+dumpStyle :: PprStyle -> Bool
+dumpStyle PprDump = True
+dumpStyle other   = False
+
 debugStyle :: PprStyle -> Bool
 debugStyle PprDebug      = True
 debugStyle other         = False
@@ -191,7 +205,7 @@ printErrs doc = do Pretty.printDoc PageMode stderr doc
 
 printDump :: SDoc -> IO ()
 printDump doc = do
-   Pretty.printDoc PageMode stdout (better_doc defaultUserStyle)
+   Pretty.printDoc PageMode stdout (better_doc defaultDumpStyle)
    hFlush stdout
  where
    better_doc = doc $$ text ""