[project @ 2005-03-04 14:24:51 by simonmar]

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

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 339a3bc..5592b55 100644 (file)
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -42,18 +42,20 @@ module Outputable (
        showSDocUnqual, showsPrecSDoc,
        pprHsChar, pprHsString,
 
-
        -- error handling
-       pprPanic, pprPanic#, pprError, pprTrace, assertPprPanic, warnPprTrace,
-       trace, panic, panic#, assertPanic
+       pprPanic, assertPprPanic, pprPanic#, pprPgmError, 
+       pprTrace, warnPprTrace,
+       trace, pgmError, panic, panic#, assertPanic
     ) where
 
 #include "HsVersions.h"
 
 
-import {-# SOURCE #-}  Name( Name )
+import {-# SOURCE #-}  Module( Module )
+import {-# SOURCE #-}  OccName( OccName )
 
 import CmdLineOpts     ( opt_PprStyle_Debug, opt_PprUserLength )
+import PackageConfig   ( PackageId, packageIdString )
 import FastString
 import qualified Pretty
 import Pretty          ( Doc, Mode(..) )
@@ -90,13 +92,13 @@ data Depth = AllTheWay
            | PartWay Int       -- 0 => stop
 
 
-type PrintUnqualified = Name -> Bool
+type PrintUnqualified = Module -> 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
 
@@ -149,9 +151,9 @@ getPprStyle df sty = df sty sty
 \end{code}
 
 \begin{code}
-unqualStyle :: PprStyle -> Name -> Bool
-unqualStyle (PprUser    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
@@ -355,6 +357,9 @@ instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
 instance Outputable FastString where
     ppr fs = text (unpackFS fs)                -- Prints an unadorned string,
                                        -- no double quotes or anything
+
+instance Outputable PackageId where
+   ppr pid = text (packageIdString pid)
 \end{code}
 
 
@@ -414,10 +419,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'
@@ -469,12 +474,13 @@ speakNTimes t | t == 1       = ptext SLIT("once")
 %************************************************************************
 
 \begin{code}
-pprPanic :: String -> SDoc -> a
-pprError :: String -> SDoc -> a
+pprPanic, pprPgmError :: String -> SDoc -> a
 pprTrace :: String -> SDoc -> a -> a
-pprPanic  = pprAndThen panic
-pprError  = pprAndThen error
-pprTrace  = pprAndThen trace
+pprPanic    = pprAndThen panic         -- Throw an exn saying "bug in GHC"
+
+pprPgmError = pprAndThen pgmError      -- Throw an exn saying "bug in pgm being compiled"
+                                       --      (used for unusual pgm errors)
+pprTrace    = pprAndThen trace
 
 pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
                             where