[project @ 2000-11-07 13:12:21 by simonpj]

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

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 5dd86b7..9cb9fa8 100644 (file)
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -34,11 +34,11 @@ module Outputable (
        hang, punctuate,
        speakNth, speakNTimes,
 
-       printSDoc, printErrs, printDump, 
+       printSDoc, printErrs, printDump,
        printForC, printForAsm, printForIface, printForUser,
        pprCode, pprCols,
-       showSDoc, showSDocDebug, showSDocIface, showsPrecSDoc, 
-       pprFSAsString,
+       showSDoc, showSDocDebug, showSDocIface, showsPrecSDoc,
+       pprHsChar, pprHsString,
 
 
        -- error handling
@@ -55,8 +55,7 @@ import FastString
 import qualified Pretty
 import Pretty          ( Doc, Mode(..), TextDetails(..), fullRender )
 import Panic
-import ST              ( runST )
-import Foreign
+import Char             ( chr, ord, isDigit )
 \end{code}
 
 
@@ -161,7 +160,7 @@ printErrs doc = printDoc PageMode stderr (final_doc user_style)
                user_style = mkUserStyle (PartWay opt_PprUserLength)
 
 printDump :: SDoc -> IO ()
-printDump doc = printForUser stderr (doc $$ text "")
+printDump doc = printForUser stdout (doc $$ text "")
                -- We used to always print in debug style, but I want
                -- to try the effect of a more user-ish style (unless you
                -- say -dppr-debug
@@ -179,7 +178,7 @@ printForAsm handle doc = printDoc LeftMode handle (doc (PprCode AsmStyle))
 -- printForIface prints all on one line for interface files.
 -- It's called repeatedly for successive lines
 printForIface :: Handle -> SDoc -> IO ()
-printForIface handle doc = printDoc OneLineMode handle (doc PprInterface)
+printForIface handle doc = printDoc LeftMode handle (doc PprInterface)
 
 pprCode :: CodeStyle -> SDoc -> SDoc
 pprCode cs d = withPprStyle (PprCode cs) d
@@ -305,12 +304,55 @@ instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) wher
                   ppr y <> comma,
                   ppr z ])
 
+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])
+
 instance Outputable FastString where
     ppr fs = text (unpackFS fs)                -- Prints an unadorned string,
                                        -- no double quotes or anything
 
-pprFSAsString :: FastString -> SDoc                    -- The Char instance of Show prints
-pprFSAsString fs = text (showList (unpackFS fs) "")    -- strings with double quotes and escapes
+#if __GLASGOW_HASKELL__ < 410
+-- Assume we have only 8-bit Chars.
+
+pprHsChar :: Int -> SDoc
+pprHsChar c = char '\'' <> text (showCharLit c "") <> char '\''
+
+pprHsString :: FAST_STRING -> SDoc
+pprHsString fs = doubleQuotes (text (foldr showCharLit "" (_UNPK_INT_ fs)))
+
+showCharLit :: Int -> String -> String
+showCharLit c rest
+    | c == ord '\"' = "\\\"" ++ rest
+    | c == ord '\'' = "\\\'" ++ rest
+    | c == ord '\\' = "\\\\" ++ rest
+    | c >= 0x20 && c <= 0x7E = chr c : rest
+    | c == ord '\a' = "\\a" ++ rest
+    | c == ord '\b' = "\\b" ++ rest
+    | c == ord '\f' = "\\f" ++ rest
+    | c == ord '\n' = "\\n" ++ rest
+    | c == ord '\r' = "\\r" ++ rest
+    | c == ord '\t' = "\\t" ++ rest
+    | c == ord '\v' = "\\v" ++ rest
+    | otherwise     = ('\\':) $ shows c $ case rest of
+        d:_ | isDigit d -> "\\&" ++ rest
+        _               -> rest
+
+#else
+-- We have 31-bit Chars and will simply use Show instances
+-- of Char and String.
+
+pprHsChar :: Int -> SDoc
+pprHsChar c = text (show (chr c))
+
+pprHsString :: FastString -> SDoc
+pprHsString fs = text (show (unpackFS fs))
+
+#endif
 
 instance Show FastString  where
     showsPrec p fs = showsPrecSDoc p (ppr fs)
@@ -338,7 +380,7 @@ printDoc mode hdl doc
 
 showDocWith :: Mode -> Doc -> String
 showDocWith mode doc
-  = fullRender PageMode 100 1.5 put "" doc
+  = fullRender mode 100 1.5 put "" doc
   where
     put (Chr c)   s  = c:s
     put (Str s1)  s2 = s1 ++ s2