Print some extra debugging info when doing --show-iface

[ghc-hetmet.git] / compiler / utils / Outputable.lhs

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 85b32e4..8380c76 100644 (file)
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -12,12 +12,14 @@ module Outputable (
 
        BindingSite(..),
 
-       PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, QualifyName(..),
+       PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
+        QualifyName(..),
        getPprStyle, withPprStyle, withPprStyleDoc, 
        pprDeeper, pprDeeperList, pprSetDepth,
        codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
        ifPprDebug, qualName, qualModule,
        mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
+        mkUserStyle,
 
        SDoc,           -- Abstract
        docToSDoc,
@@ -36,16 +38,16 @@ module Outputable (
        speakNth, speakNTimes, speakN, speakNOf, plural,
 
        printSDoc, printErrs, hPrintDump, printDump,
-       printForC, printForAsm, printForUser,
+       printForC, printForAsm, printForUser, printForUserPartWay,
        pprCode, mkCodeStyle,
        showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
        showSDocUnqual, showsPrecSDoc,
        pprHsChar, pprHsString,
 
        -- error handling
-       pprPanic, assertPprPanic, pprPanic#, pprPgmError, 
+       pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, 
        pprTrace, warnPprTrace,
-       trace, pgmError, panic, panic#, assertPanic
+       trace, pgmError, panic, panicFastInt, assertPanic
     ) where
 
 #include "HsVersions.h"
@@ -57,7 +59,6 @@ import {-# SOURCE #-}         OccName( OccName )
 import StaticFlags     ( opt_PprStyle_Debug, opt_PprUserLength )
 import FastString
 import FastTypes
-import GHC.Ptr
 import qualified Pretty
 import Pretty          ( Doc, Mode(..) )
 import Panic
@@ -286,6 +287,10 @@ printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 
   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
 
+printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
+printForUserPartWay handle d unqual doc
+  = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
+
 -- printForC, printForAsm do what they sound like
 printForC :: Handle -> SDoc -> IO ()
 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
@@ -330,7 +335,7 @@ empty    :: SDoc
 text     :: String     -> SDoc
 char     :: Char       -> SDoc
 ftext    :: FastString -> SDoc
-ptext    :: Ptr t      -> SDoc
+ptext    :: LitString  -> SDoc
 int      :: Int        -> SDoc
 integer  :: Integer    -> SDoc
 float    :: Float      -> SDoc
@@ -440,6 +445,9 @@ instance Outputable Bool where
 instance Outputable Int where
    ppr n = int n
 
+instance Outputable Word32 where
+   ppr n = integer $ fromIntegral n
+
 instance Outputable () where
    ppr _ = text "()"
 
@@ -466,11 +474,20 @@ instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) wher
 
 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
         Outputable (a, b, c, d) where
-    ppr (x,y,z,w) =
-      parens (sep [ppr x <> comma,
-                  ppr y <> comma,
-                  ppr z <> comma,
-                  ppr w])
+    ppr (a,b,c,d) =
+      parens (sep [ppr a <> comma,
+                  ppr b <> comma,
+                  ppr c <> comma,
+                  ppr d])
+
+instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
+        Outputable (a, b, c, d, e) where
+    ppr (a,b,c,d,e) =
+      parens (sep [ppr a <> comma,
+                  ppr b <> comma,
+                  ppr c <> comma,
+                  ppr d <> comma,
+                  ppr e])
 
 instance Outputable FastString where
     ppr fs = ftext fs          -- Prints an unadorned string,
@@ -610,8 +627,8 @@ pprPgmError = pprAndThen pgmError   -- Throw an exn saying "bug in pgm being compi
                                        --      (used for unusual pgm errors)
 pprTrace    = pprAndThen trace
 
-pprPanic# :: String -> SDoc -> FastInt
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
+pprPanicFastInt :: String -> SDoc -> FastInt
+pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
                             where
                               doc = text heading <+> pretty_msg