Fix Trac #2529: derived read for prefix constructor operators

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

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index d6016b0..548dc2c 100644 (file)
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -3,70 +3,79 @@
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
 
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
 

-Outputable: defines classes for pretty-printing and forcing, both
-forms of ``output.''
-

 \begin{code}
 \begin{code}

+-- | This module defines classes and functions for pretty-printing. It also
+-- exports a number of helpful debugging and other utilities such as 'trace' and 'panic'.
+--
+-- The interface to this module is very similar to the standard Hughes-PJ pretty printing
+-- module, except that it exports a number of additional functions that are rarely used,
+-- and works over the 'SDoc' type.

 module Outputable (
 module Outputable (

-       Outputable(..), OutputableBndr(..),     -- Class
-
-       BindingSite(..),
-
-       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,
+       -- * Type classes
+       Outputable(..), OutputableBndr(..),

 
 

-       SDoc,           -- Abstract
+        -- * Pretty printing combinators
+       SDoc,

        docToSDoc,
        interppSP, interpp'SP, pprQuotedList, pprWithCommas,
        empty, nest,
        docToSDoc,
        interppSP, interpp'SP, pprQuotedList, pprWithCommas,
        empty, nest,

-       text, char, ftext, ptext,
+       char,
+       text, ftext, ptext,

        int, integer, float, double, rational,
        parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
        semi, comma, colon, dcolon, space, equals, dot, arrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
        (<>), (<+>), hcat, hsep, 
        int, integer, float, double, rational,
        parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
        semi, comma, colon, dcolon, space, equals, dot, arrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
        (<>), (<+>), hcat, hsep, 

-       ($$), ($+$), vcat, 
+       ($$), ($+$), vcat,

        sep, cat, 
        fsep, fcat, 
        hang, punctuate,
        speakNth, speakNTimes, speakN, speakNOf, plural,
 
        sep, cat, 
        fsep, fcat, 
        hang, punctuate,
        speakNth, speakNTimes, speakN, speakNOf, plural,
 

+        -- * Converting 'SDoc' into strings and outputing it

        printSDoc, printErrs, hPrintDump, printDump,
        printForC, printForAsm, printForUser, printForUserPartWay,
        pprCode, mkCodeStyle,
        showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
        showSDocUnqual, showsPrecSDoc,
        printSDoc, printErrs, hPrintDump, printDump,
        printForC, printForAsm, printForUser, printForUserPartWay,
        pprCode, mkCodeStyle,
        showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
        showSDocUnqual, showsPrecSDoc,

-       pprHsChar, pprHsString,

 
 

-       -- error handling
-       pprPanic, assertPprPanic, pprPanic#, pprPgmError, 
-       pprTrace, warnPprTrace,
-       trace, pgmError, panic, panic#, assertPanic
-    ) where
+       pprInfixVar, pprPrefixVar,
+       pprHsChar, pprHsString, pprHsInfix, pprHsVar,
+    pprFastFilePath,
+
+        -- * Controlling the style in which output is printed
+       BindingSite(..),

 
 

-#include "HsVersions.h"
+       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, Depth(..),

 
 

+       -- * Error handling and debugging utilities
+       pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, 
+       pprTrace, warnPprTrace,
+       trace, pgmError, panic, panicFastInt, assertPanic
+    ) where

 
 import {-# SOURCE #-}  Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}  OccName( OccName )
 
 
 import {-# SOURCE #-}  Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}  OccName( OccName )
 

-import StaticFlags     ( opt_PprStyle_Debug, opt_PprUserLength )
-import FastString
+import StaticFlags
+import FastString 

 import FastTypes
 import FastTypes

-import GHC.Ptr

 import qualified Pretty
 import Pretty          ( Doc, Mode(..) )
 import qualified Pretty
 import Pretty          ( Doc, Mode(..) )

+import Char            ( isAlpha )

 import Panic
 
 import Data.Word       ( Word32 )
 import System.IO       ( Handle, stderr, stdout, hFlush )
 import Data.Char        ( ord )
 import Panic
 
 import Data.Word       ( Word32 )
 import System.IO       ( Handle, stderr, stdout, hFlush )
 import Data.Char        ( ord )

+import System.FilePath

 \end{code}
 
 
 \end{code}
 
 

@@ -147,9 +156,7 @@ alwaysQualifyModules _ = True
 neverQualifyModules :: QueryQualifyModule
 neverQualifyModules _ = False
 
 neverQualifyModules :: QueryQualifyModule
 neverQualifyModules _ = False
 

-type QueryQualifies = (QueryQualifyName, QueryQualifyModule)
-
-alwaysQualify, neverQualify :: QueryQualifies
+alwaysQualify, neverQualify :: PrintUnqualified

 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
 neverQualify  = (neverQualifyNames,  neverQualifyModules)
 
 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
 neverQualify  = (neverQualifyNames,  neverQualifyModules)
 

@@ -172,7 +179,7 @@ defaultErrStyle
   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
 
   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
 

-mkUserStyle :: QueryQualifies -> Depth -> PprStyle
+mkUserStyle :: PrintUnqualified -> Depth -> PprStyle

 mkUserStyle unqual depth
    | opt_PprStyle_Debug = PprDebug
    | otherwise          = PprUser unqual depth
 mkUserStyle unqual depth
    | opt_PprStyle_Debug = PprDebug
    | otherwise          = PprUser unqual depth

@@ -315,7 +322,7 @@ showSDocForUser :: PrintUnqualified -> SDoc -> String
 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
 
 showSDocUnqual :: SDoc -> String
 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
 
 showSDocUnqual :: SDoc -> String

--- Only used in the gruesome HsExpr.isOperator
+-- Only used in the gruesome isOperator

 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 
 showsPrecSDoc :: Int -> SDoc -> ShowS
 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 
 showsPrecSDoc :: Int -> SDoc -> ShowS

@@ -333,10 +340,10 @@ docToSDoc :: Doc -> SDoc
 docToSDoc d = \_ -> d
 
 empty    :: SDoc
 docToSDoc d = \_ -> d
 
 empty    :: SDoc

-text     :: String     -> SDoc

 char     :: Char       -> SDoc
 char     :: Char       -> SDoc

+text     :: String     -> SDoc

 ftext    :: FastString -> SDoc
 ftext    :: FastString -> SDoc

-ptext    :: Ptr t      -> SDoc
+ptext    :: LitString  -> SDoc

 int      :: Int        -> SDoc
 integer  :: Integer    -> SDoc
 float    :: Float      -> SDoc
 int      :: Int        -> SDoc
 integer  :: Integer    -> SDoc
 float    :: Float      -> SDoc

@@ -344,8 +351,8 @@ double   :: Double     -> SDoc
 rational :: Rational   -> SDoc
 
 empty _sty      = Pretty.empty
 rational :: Rational   -> SDoc
 
 empty _sty      = Pretty.empty

-text s _sty     = Pretty.text s

 char c _sty     = Pretty.char c
 char c _sty     = Pretty.char c

+text s _sty     = Pretty.text s

 ftext s _sty    = Pretty.ftext s
 ptext s _sty    = Pretty.ptext s
 int n _sty      = Pretty.int n
 ftext s _sty    = Pretty.ftext s
 ptext s _sty    = Pretty.ptext s
 int n _sty      = Pretty.int n

@@ -383,8 +390,8 @@ comma _sty  = Pretty.comma
 colon _sty  = Pretty.colon
 equals _sty = Pretty.equals
 space _sty  = Pretty.space
 colon _sty  = Pretty.colon
 equals _sty = Pretty.equals
 space _sty  = Pretty.space

-dcolon _sty = Pretty.ptext SLIT("::")
-arrow  _sty = Pretty.ptext SLIT("->")
+dcolon _sty = Pretty.ptext (sLit "::")
+arrow  _sty = Pretty.ptext (sLit "->")

 underscore  = char '_'
 dot        = char '.'
 lparen _sty = Pretty.lparen
 underscore  = char '_'
 dot        = char '.'
 lparen _sty = Pretty.lparen

@@ -395,7 +402,16 @@ lbrace _sty = Pretty.lbrace
 rbrace _sty = Pretty.rbrace
 
 nest :: Int -> SDoc -> SDoc
 rbrace _sty = Pretty.rbrace
 
 nest :: Int -> SDoc -> SDoc

-(<>), (<+>), ($$), ($+$) :: SDoc -> SDoc -> SDoc
+-- ^ Indent 'SDoc' some specified amount
+(<>) :: SDoc -> SDoc -> SDoc
+-- ^ Join two 'SDoc' together horizontally without a gap
+(<+>) :: SDoc -> SDoc -> SDoc
+-- ^ Join two 'SDoc' together horizontally with a gap between them
+($$) :: SDoc -> SDoc -> SDoc
+-- ^ Join two 'SDoc' together vertically; if there is 
+-- no vertical overlap it "dovetails" the two onto one line
+($+$) :: SDoc -> SDoc -> SDoc
+-- ^ Join two 'SDoc' together vertically

 
 nest n d sty    = Pretty.nest n (d sty)
 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
 
 nest n d sty    = Pretty.nest n (d sty)
 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)

@@ -403,7 +419,21 @@ nest n d sty    = Pretty.nest n (d sty)
 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
 
 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
 

-hcat, hsep, vcat, sep, cat, fsep, fcat :: [SDoc] -> SDoc
+hcat :: [SDoc] -> SDoc
+-- ^ Concatenate 'SDoc' horizontally
+hsep :: [SDoc] -> SDoc
+-- ^ Concatenate 'SDoc' horizontally with a space between each one
+vcat :: [SDoc] -> SDoc
+-- ^ Concatenate 'SDoc' vertically with dovetailing
+sep :: [SDoc] -> SDoc
+-- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
+cat :: [SDoc] -> SDoc
+-- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits
+fsep :: [SDoc] -> SDoc
+-- ^ A paragraph-fill combinator. It's much like sep, only it
+-- keeps fitting things on one line until it can't fit any more.
+fcat :: [SDoc] -> SDoc
+-- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'

 
 
 hcat ds sty = Pretty.hcat [d sty | d <- ds]
 
 
 hcat ds sty = Pretty.hcat [d sty | d <- ds]

@@ -414,11 +444,15 @@ cat ds sty  = Pretty.cat  [d sty | d <- ds]
 fsep ds sty = Pretty.fsep [d sty | d <- ds]
 fcat ds sty = Pretty.fcat [d sty | d <- ds]
 
 fsep ds sty = Pretty.fsep [d sty | d <- ds]
 fcat ds sty = Pretty.fcat [d sty | d <- ds]
 

-hang :: SDoc -> Int -> SDoc -> SDoc
-
+hang :: SDoc  -- ^ The header
+      -> Int  -- ^ Amount to indent the hung body
+      -> SDoc -- ^ The hung body, indented and placed below the header
+      -> SDoc

 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
 
 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
 

-punctuate :: SDoc -> [SDoc] -> [SDoc]
+punctuate :: SDoc   -- ^ The punctuation
+          -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
+          -> [SDoc] -- ^ Punctuated list

 punctuate _ []     = []
 punctuate p (d:ds) = go d ds
                   where
 punctuate _ []     = []
 punctuate p (d:ds) = go d ds
                   where

@@ -434,18 +468,22 @@ punctuate p (d:ds) = go d ds
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

+-- | Class designating that some type has an 'SDoc' representation

 class Outputable a where
        ppr :: a -> SDoc
 \end{code}
 
 \begin{code}
 instance Outputable Bool where
 class Outputable a where
        ppr :: a -> SDoc
 \end{code}
 
 \begin{code}
 instance Outputable Bool where

-    ppr True  = ptext SLIT("True")
-    ppr False = ptext SLIT("False")
+    ppr True  = ptext (sLit "True")
+    ppr False = ptext (sLit "False")

 
 instance Outputable Int where
    ppr n = int n
 
 
 instance Outputable Int where
    ppr n = int n
 

+instance Outputable Word32 where
+   ppr n = integer $ fromIntegral n
+

 instance Outputable () where
    ppr _ = text "()"
 
 instance Outputable () where
    ppr _ = text "()"
 

@@ -456,12 +494,12 @@ instance (Outputable a, Outputable b) => Outputable (a, b) where
     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
 
 instance Outputable a => Outputable (Maybe a) where
     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
 
 instance Outputable a => Outputable (Maybe a) where

-  ppr Nothing = ptext SLIT("Nothing")
-  ppr (Just x) = ptext SLIT("Just") <+> ppr x
+  ppr Nothing = ptext (sLit "Nothing")
+  ppr (Just x) = ptext (sLit "Just") <+> ppr x

 
 instance (Outputable a, Outputable b) => Outputable (Either a b) where
 
 instance (Outputable a, Outputable b) => Outputable (Either a b) where

-  ppr (Left x)  = ptext SLIT("Left")  <+> ppr x
-  ppr (Right y) = ptext SLIT("Right") <+> ppr y
+  ppr (Left x)  = ptext (sLit "Left")  <+> ppr x
+  ppr (Right y) = ptext (sLit "Right") <+> ppr y

 
 -- ToDo: may not be used
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
 
 -- ToDo: may not be used
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where

@@ -472,41 +510,45 @@ 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
 
 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,
                                -- no double quotes or anything
 \end{code}
 
 
 instance Outputable FastString where
     ppr fs = ftext fs          -- Prints an unadorned string,
                                -- no double quotes or anything
 \end{code}
 

-

 %************************************************************************
 %*                                                                     *
 \subsection{The @OutputableBndr@ class}
 %*                                                                     *
 %************************************************************************
 
 %************************************************************************
 %*                                                                     *
 \subsection{The @OutputableBndr@ class}
 %*                                                                     *
 %************************************************************************
 

-When we print a binder, we often want to print its type too.
-The @OutputableBndr@ class encapsulates this idea.
-
-@BindingSite@ is used to tell the thing that prints binder what
-language construct is binding the identifier.  This can be used
-to decide how much info to print.
-

 \begin{code}
 \begin{code}

+-- | 'BindingSite' is used to tell the thing that prints binder what
+-- language construct is binding the identifier.  This can be used
+-- to decide how much info to print.

 data BindingSite = LambdaBind | CaseBind | LetBind
 
 data BindingSite = LambdaBind | CaseBind | LetBind
 

+-- | When we print a binder, we often want to print its type too.
+-- The @OutputableBndr@ class encapsulates this idea.

 class Outputable a => OutputableBndr a where
    pprBndr :: BindingSite -> a -> SDoc
    pprBndr _b x = ppr x
 \end{code}
 
 class Outputable a => OutputableBndr a where
    pprBndr :: BindingSite -> a -> SDoc
    pprBndr _b x = ppr x
 \end{code}
 

-
-

 %************************************************************************
 %*                                                                     *
 \subsection{Random printing helpers}
 %************************************************************************
 %*                                                                     *
 \subsection{Random printing helpers}

@@ -514,17 +556,55 @@ class Outputable a => OutputableBndr a where
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

--- We have 31-bit Chars and will simply use Show instances
--- of Char and String.
+-- We have 31-bit Chars and will simply use Show instances of Char and String.

 
 

+-- | Special combinator for showing character literals.

 pprHsChar :: Char -> SDoc
 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
             | otherwise      = text (show c)
 
 pprHsChar :: Char -> SDoc
 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
             | otherwise      = text (show c)
 

+-- | Special combinator for showing string literals.

 pprHsString :: FastString -> SDoc
 pprHsString fs = text (show (unpackFS fs))
 pprHsString :: FastString -> SDoc
 pprHsString fs = text (show (unpackFS fs))

-\end{code}

 
 

+---------------------
+-- Put a name in parens if it's an operator
+pprPrefixVar :: Bool -> SDoc -> SDoc
+pprPrefixVar is_operator pp_v
+  | is_operator = parens pp_v
+  | otherwise  = pp_v
+
+-- Put a name in backquotes if it's not an operator
+pprInfixVar :: Bool -> SDoc -> SDoc
+pprInfixVar is_operator pp_v 
+  | is_operator = pp_v
+  | otherwise   = char '`' <> pp_v <> char '`'
+
+---------------------
+-- pprHsVar and pprHsInfix use the gruesome isOperator, which
+-- in turn uses (showSDoc (ppr v)), rather than isSymOcc (getOccName v).
+-- Reason: it means that pprHsVar doesn't need a NamedThing context,
+--         which none of the HsSyn printing functions do
+pprHsVar, pprHsInfix :: Outputable name => name -> SDoc
+pprHsVar   v = pprPrefixVar (isOperator pp_v) pp_v  
+            where pp_v = ppr v
+pprHsInfix v = pprInfixVar  (isOperator pp_v) pp_v
+            where pp_v = ppr v
+
+isOperator :: SDoc -> Bool
+isOperator ppr_v 
+  = case showSDocUnqual ppr_v of
+        ('(':_)   -> False              -- (), (,) etc
+        ('[':_)   -> False              -- []
+        ('$':c:_) -> not (isAlpha c)    -- Don't treat $d as an operator
+        (':':c:_) -> not (isAlpha c)    -- Don't treat :T as an operator
+        ('_':_)   -> False              -- Not an operator
+        (c:_)     -> not (isAlpha c)    -- Starts with non-alpha
+        _         -> False
+
+pprFastFilePath :: FastString -> SDoc
+pprFastFilePath path = text $ normalise $ unpackFS path
+\end{code}

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -533,17 +613,24 @@ pprHsString fs = text (show (unpackFS fs))
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
+pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use
+              -> [a]         -- ^ The things to be pretty printed
+              -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,
+                             -- comma-separated and finally packed into a paragraph.

 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
 
 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
 

+-- | Returns the seperated concatenation of the pretty printed things.

 interppSP  :: Outputable a => [a] -> SDoc
 interppSP  xs = sep (map ppr xs)
 
 interppSP  :: Outputable a => [a] -> SDoc
 interppSP  xs = sep (map ppr xs)
 

+-- | Returns the comma-seperated concatenation of the pretty printed things.

 interpp'SP :: Outputable a => [a] -> SDoc
 interpp'SP xs = sep (punctuate comma (map ppr xs))
 
 interpp'SP :: Outputable a => [a] -> SDoc
 interpp'SP xs = sep (punctuate comma (map ppr xs))
 

+-- | Returns the comma-seperated concatenation of the quoted pretty printed things.
+--
+-- > [x,y,z]  ==>  `x', `y', `z'

 pprQuotedList :: Outputable a => [a] -> SDoc
 pprQuotedList :: Outputable a => [a] -> SDoc

--- [x,y,z]  ==>  `x', `y', `z'

 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
 \end{code}
 
 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
 \end{code}
 

@@ -554,17 +641,19 @@ pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-@speakNth@ converts an integer to a verbal index; eg 1 maps to
-``first'' etc.
-

 \begin{code}
 \begin{code}

+-- | Converts an integer to a verbal index:
+--
+-- > speakNth 1 = text "first"
+-- > speakNth 5 = text "fifth"
+-- > speakNth 21 = text "21st"

 speakNth :: Int -> SDoc
 speakNth :: Int -> SDoc

-speakNth 1 = ptext SLIT("first")
-speakNth 2 = ptext SLIT("second")
-speakNth 3 = ptext SLIT("third")
-speakNth 4 = ptext SLIT("fourth")
-speakNth 5 = ptext SLIT("fifth")
-speakNth 6 = ptext SLIT("sixth")
+speakNth 1 = ptext (sLit "first")
+speakNth 2 = ptext (sLit "second")
+speakNth 3 = ptext (sLit "third")
+speakNth 4 = ptext (sLit "fourth")
+speakNth 5 = ptext (sLit "fifth")
+speakNth 6 = ptext (sLit "sixth")

 speakNth n = hcat [ int n, text suffix ]
   where
     suffix | n <= 20       = "th"      -- 11,12,13 are non-std
 speakNth n = hcat [ int n, text suffix ]
   where
     suffix | n <= 20       = "th"      -- 11,12,13 are non-std

@@ -575,26 +664,47 @@ speakNth n = hcat [ int n, text suffix ]
 
     last_dig = n `rem` 10
 
 
     last_dig = n `rem` 10
 

+-- | Converts an integer to a verbal multiplicity:
+-- 
+-- > speakN 0 = text "none"
+-- > speakN 5 = text "five"
+-- > speakN 10 = text "10"

 speakN :: Int -> SDoc
 speakN :: Int -> SDoc

-speakN 0 = ptext SLIT("none")  -- E.g.  "he has none"
-speakN 1 = ptext SLIT("one")   -- E.g.  "he has one"
-speakN 2 = ptext SLIT("two")
-speakN 3 = ptext SLIT("three")
-speakN 4 = ptext SLIT("four")
-speakN 5 = ptext SLIT("five")
-speakN 6 = ptext SLIT("six")
+speakN 0 = ptext (sLit "none") -- E.g.  "he has none"
+speakN 1 = ptext (sLit "one")  -- E.g.  "he has one"
+speakN 2 = ptext (sLit "two")
+speakN 3 = ptext (sLit "three")
+speakN 4 = ptext (sLit "four")
+speakN 5 = ptext (sLit "five")
+speakN 6 = ptext (sLit "six")

 speakN n = int n
 
 speakN n = int n
 

+-- | Converts an integer and object description to a statement about the
+-- multiplicity of those objects:
+--
+-- > speakNOf 0 (text "melon") = text "no melons"
+-- > speakNOf 1 (text "melon") = text "one melon"
+-- > speakNOf 3 (text "melon") = text "three melons"

 speakNOf :: Int -> SDoc -> SDoc
 speakNOf :: Int -> SDoc -> SDoc

-speakNOf 0 d = ptext SLIT("no") <+> d <> char 's'      -- E.g. "no arguments"
-speakNOf 1 d = ptext SLIT("one") <+> d                 -- E.g. "one argument"
+speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'
+speakNOf 1 d = ptext (sLit "one") <+> d                        -- E.g. "one argument"

 speakNOf n d = speakN n <+> d <> char 's'              -- E.g. "three arguments"
 
 speakNOf n d = speakN n <+> d <> char 's'              -- E.g. "three arguments"
 

+-- | Converts a strictly positive integer into a number of times:
+--
+-- > speakNTimes 1 = text "once"
+-- > speakNTimes 2 = text "twice"
+-- > speakNTimes 4 = text "4 times"

 speakNTimes :: Int {- >=1 -} -> SDoc
 speakNTimes :: Int {- >=1 -} -> SDoc

-speakNTimes t | t == 1            = ptext SLIT("once")
-              | t == 2            = ptext SLIT("twice")
-              | otherwise  = speakN t <+> ptext SLIT("times")
-
+speakNTimes t | t == 1            = ptext (sLit "once")
+              | t == 2            = ptext (sLit "twice")
+              | otherwise  = speakN t <+> ptext (sLit "times")
+
+-- | Determines the pluralisation suffix appropriate for the length of a list:
+--
+-- > plural [] = char 's'
+-- > plural ["Hello"] = empty
+-- > plural ["Hello", "World"] = char 's'

 plural :: [a] -> SDoc
 plural [_] = empty  -- a bit frightening, but there you are
 plural _   = char 's'
 plural :: [a] -> SDoc
 plural [_] = empty  -- a bit frightening, but there you are
 plural _   = char 's'

@@ -608,16 +718,24 @@ plural _   = char 's'
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-pprPanic, pprPgmError :: String -> SDoc -> a
+pprPanic :: String -> SDoc -> a
+-- ^ Throw an exception saying "bug in GHC"
+pprPgmError :: String -> SDoc -> a
+-- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)

 pprTrace :: String -> SDoc -> a -> a
 pprTrace :: String -> SDoc -> a -> a

-pprPanic    = pprAndThen panic         -- Throw an exn saying "bug in GHC"
+-- ^ If debug output is on, show some 'SDoc' on the screen
+
+pprPanic    = pprAndThen panic
+
+pprPgmError = pprAndThen pgmError

 
 

-pprPgmError = pprAndThen pgmError      -- Throw an exn saying "bug in pgm being compiled"
-                                       --      (used for unusual pgm errors)
-pprTrace    = pprAndThen trace
+pprTrace str doc x
+   | opt_NoDebugOutput = x
+   | otherwise         = pprAndThen trace str doc x

 
 

-pprPanic# :: String -> SDoc -> FastInt
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
+pprPanicFastInt :: String -> SDoc -> FastInt
+-- ^ Specialization of pprPanic that can be safely used with 'FastInt'
+pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))

                             where
                               doc = text heading <+> pretty_msg
 
                             where
                               doc = text heading <+> pretty_msg
 

@@ -627,6 +745,8 @@ pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
      doc = sep [text heading, nest 4 pretty_msg]
 
 assertPprPanic :: String -> Int -> SDoc -> a
      doc = sep [text heading, nest 4 pretty_msg]
 
 assertPprPanic :: String -> Int -> SDoc -> a

+-- ^ Panic with an assertation failure, recording the given file and line number.
+-- Should typically be accessed with the ASSERT family of macros

 assertPprPanic file line msg
   = panic (show (doc PprDebug))
   where
 assertPprPanic file line msg
   = panic (show (doc PprDebug))
   where

@@ -636,6 +756,9 @@ assertPprPanic file line msg
                    msg]
 
 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
                    msg]
 
 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a

+-- ^ Just warn about an assertion failure, recording the given file and line number.
+-- Should typically be accessed with the WARN macros
+warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x

 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
   = trace (show (doc PprDebug)) x
 warnPprTrace False _file _line _msg x = x
 warnPprTrace True   file  line  msg x
   = trace (show (doc PprDebug)) x