[project @ 2004-08-16 09:53:47 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 2ef0adf..22856f1 100644 (file)
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -26,7 +26,7 @@ module Outputable (
        text, char, ftext, ptext,
        int, integer, float, double, rational,
        parens, brackets, braces, quotes, doubleQuotes, angleBrackets,
-       semi, comma, colon, dcolon, space, equals, dot,
+       semi, comma, colon, dcolon, space, equals, dot, arrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
        (<>), (<+>), hcat, hsep, 
        ($$), ($+$), vcat, 
@@ -51,7 +51,8 @@ module Outputable (
 #include "HsVersions.h"
 
 
-import {-# SOURCE #-}  Name( Name )
+import {-# SOURCE #-}  Module( ModuleName )
+import {-# SOURCE #-}  OccName( OccName )
 
 import CmdLineOpts     ( opt_PprStyle_Debug, opt_PprUserLength )
 import FastString
@@ -62,10 +63,7 @@ import Panic
 import DATA_WORD       ( Word32 )
 
 import IO              ( Handle, stderr, stdout, hFlush )
-import Char             ( chr )
-#if __GLASGOW_HASKELL__ < 410
-import Char            ( ord, isDigit )
-#endif
+import Char             ( ord )
 \end{code}
 
 
@@ -82,8 +80,6 @@ data PprStyle
                                        -- must be very close to Haskell
                                        -- syntax, etc.
 
-  | PprInterface PrintUnqualified      -- Interface generation
-
   | PprCode CodeStyle          -- Print code; either C or assembler
 
   | PprDebug                   -- Standard debugging output
@@ -95,13 +91,13 @@ data Depth = AllTheWay
            | PartWay Int       -- 0 => stop
 
 
-type PrintUnqualified = Name -> Bool
+type PrintUnqualified = ModuleName -> OccName -> Bool
        -- This function tells when it's ok to print 
        -- a (Global) name unqualified
 
 alwaysQualify,neverQualify :: PrintUnqualified
-alwaysQualify n = False
-neverQualify  n = True
+alwaysQualify m n = False
+neverQualify  m n = True
 
 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
 
@@ -115,7 +111,7 @@ defaultErrStyle :: PprStyle
 -- Only used for desugarer warnings, and typechecker errors in interface sigs
 defaultErrStyle 
   | opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay
-  | otherwise         = mkUserStyle neverQualify  (PartWay opt_PprUserLength)
+  | otherwise         = mkUserStyle alwaysQualify  (PartWay opt_PprUserLength)
 
 mkUserStyle unqual depth |  opt_PprStyle_Debug = PprDebug
                         |  otherwise          = PprUser unqual depth
@@ -154,10 +150,9 @@ getPprStyle df sty = df sty sty
 \end{code}
 
 \begin{code}
-unqualStyle :: PprStyle -> Name -> Bool
-unqualStyle (PprUser    unqual _) n = unqual n
-unqualStyle (PprInterface unqual) n = unqual n
-unqualStyle other                n = False
+unqualStyle :: PprStyle -> PrintUnqualified
+unqualStyle (PprUser    unqual _) m n = unqual m n
+unqualStyle other                m n = False
 
 codeStyle :: PprStyle -> Bool
 codeStyle (PprCode _)    = True
@@ -201,7 +196,7 @@ printDump doc = do
    better_doc = 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
+    -- say -dppr-debug)
 
 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 
@@ -282,6 +277,7 @@ rbrack sty = Pretty.rbrack
 lbrace sty = Pretty.lbrace
 rbrace sty = Pretty.rbrace
 dcolon sty = Pretty.ptext SLIT("::")
+arrow  sty = Pretty.ptext SLIT("->")
 underscore = char '_'
 dot       = char '.'
 
@@ -393,45 +389,16 @@ class Outputable a => OutputableBndr a where
 %************************************************************************
 
 \begin{code}
-#if __GLASGOW_HASKELL__ < 410
--- Assume we have only 8-bit Chars.
-
-pprHsChar :: Int -> SDoc
-pprHsChar c = char '\'' <> text (showCharLit c "") <> char '\''
-
-pprHsString :: FastString -> SDoc
-pprHsString fs = doubleQuotes (text (foldr showCharLit "" (unpackIntFS 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 (fromIntegral c :: Word32) $ 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 | c > 0x10ffff = char '\\' <> text (show (fromIntegral c :: Word32))
-            | otherwise    = text (show (chr c))
+pprHsChar :: Char -> SDoc
+pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
+            | otherwise      = text (show c)
 
 pprHsString :: FastString -> SDoc
 pprHsString fs = text (show (unpackFS fs))
 
-#endif
-
 instance Show FastString  where
     showsPrec p fs = showsPrecSDoc p (ppr fs)
 \end{code}
@@ -448,10 +415,10 @@ pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
 
 interppSP  :: Outputable a => [a] -> SDoc
-interppSP  xs = hsep (map ppr xs)
+interppSP  xs = sep (map ppr xs)
 
 interpp'SP :: Outputable a => [a] -> SDoc
-interpp'SP xs = hsep (punctuate comma (map ppr xs))
+interpp'SP xs = sep (punctuate comma (map ppr xs))
 
 pprQuotedList :: Outputable a => [a] -> SDoc
 -- [x,y,z]  ==>  `x', `y', `z'