[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 1f23e5e..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}
 
 
@@ -155,7 +154,7 @@ printSDoc d sty = printDoc PageMode stdout (d sty)
 -- I'm not sure whether the direct-IO approach of printDoc
 -- above is better or worse than the put-big-string approach here
 printErrs :: SDoc -> IO ()
-printErrs doc = printDoc PageMode stdout (final_doc user_style)
+printErrs doc = printDoc PageMode stderr (final_doc user_style)
              where
                final_doc = doc         -- $$ text ""
                user_style = mkUserStyle (PartWay opt_PprUserLength)
@@ -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
@@ -317,8 +316,43 @@ 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)