compiler/utils/Outputable.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP Project, Glasgow University, 1992-1998
   4 %
   5
   6 Outputable: defines classes for pretty-printing and forcing, both
   7 forms of ``output.''
   8
   9 \begin{code}
  10 module Outputable (
  11         Outputable(..), OutputableBndr(..),     -- Class
  12
  13         BindingSite(..),
  14
  15         PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
  16         QualifyName(..),
  17         getPprStyle, withPprStyle, withPprStyleDoc,
  18         pprDeeper, pprDeeperList, pprSetDepth,
  19         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
  20         ifPprDebug, qualName, qualModule,
  21         mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
  22         mkUserStyle,
  23
  24         SDoc,           -- Abstract
  25         docToSDoc,
  26         interppSP, interpp'SP, pprQuotedList, pprWithCommas,
  27         empty, nest,
  28         text, char, ftext, ptext,
  29         int, integer, float, double, rational,
  30         parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
  31         semi, comma, colon, dcolon, space, equals, dot, arrow,
  32         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
  33         (<>), (<+>), hcat, hsep,
  34         ($$), ($+$), vcat,
  35         sep, cat,
  36         fsep, fcat,
  37         hang, punctuate,
  38         speakNth, speakNTimes, speakN, speakNOf, plural,
  39
  40         printSDoc, printErrs, hPrintDump, printDump,
  41         printForC, printForAsm, printForUser, printForUserPartWay,
  42         pprCode, mkCodeStyle,
  43         showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
  44         showSDocUnqual, showsPrecSDoc,
  45         pprHsChar, pprHsString,
  46
  47         -- error handling
  48         pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError,
  49         pprTrace, warnPprTrace,
  50         trace, pgmError, panic, panicFastInt, assertPanic
  51     ) where
  52
  53 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
  54 import {-# SOURCE #-}   OccName( OccName )
  55
  56 import StaticFlags
  57 import FastString
  58 import FastTypes
  59 import qualified Pretty
  60 import Pretty           ( Doc, Mode(..) )
  61 import Panic
  62
  63 import Data.Word        ( Word32 )
  64 import System.IO        ( Handle, stderr, stdout, hFlush )
  65 import Data.Char        ( ord )
  66 \end{code}
  67
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection{The @PprStyle@ data type}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76
  77 data PprStyle
  78   = PprUser PrintUnqualified Depth
  79                 -- Pretty-print in a way that will make sense to the
  80                 -- ordinary user; must be very close to Haskell
  81                 -- syntax, etc.
  82                 -- Assumes printing tidied code: non-system names are
  83                 -- printed without uniques.
  84
  85   | PprCode CodeStyle
  86                 -- Print code; either C or assembler
  87
  88   | PprDump     -- For -ddump-foo; less verbose than PprDebug.
  89                 -- Does not assume tidied code: non-external names
  90                 -- are printed with uniques.
  91
  92   | PprDebug    -- Full debugging output
  93
  94 data CodeStyle = CStyle         -- The format of labels differs for C and assembler
  95                | AsmStyle
  96
  97 data Depth = AllTheWay
  98            | PartWay Int        -- 0 => stop
  99
 100
 101 -- -----------------------------------------------------------------------------
 102 -- Printing original names
 103
 104 -- When printing code that contains original names, we need to map the
 105 -- original names back to something the user understands.  This is the
 106 -- purpose of the pair of functions that gets passed around
 107 -- when rendering 'SDoc'.
 108
 109 -- | given an /original/ name, this function tells you which module
 110 -- name it should be qualified with when printing for the user, if
 111 -- any.  For example, given @Control.Exception.catch@, which is in scope
 112 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
 113 -- Note that the return value is a ModuleName, not a Module, because
 114 -- in source code, names are qualified by ModuleNames.
 115 type QueryQualifyName = Module -> OccName -> QualifyName
 116
 117 data QualifyName                        -- given P:M.T
 118         = NameUnqual                    -- refer to it as "T"
 119         | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
 120         | NameNotInScope1
 121                 -- it is not in scope at all, but M.T is not bound in the current
 122                 -- scope, so we can refer to it as "M.T"
 123         | NameNotInScope2
 124                 -- it is not in scope at all, and M.T is already bound in the
 125                 -- current scope, so we must refer to it as "P:M.T"
 126
 127
 128 -- | For a given module, we need to know whether to print it with
 129 -- a package name to disambiguate it.
 130 type QueryQualifyModule = Module -> Bool
 131
 132 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
 133
 134 alwaysQualifyNames :: QueryQualifyName
 135 alwaysQualifyNames m _ = NameQual (moduleName m)
 136
 137 neverQualifyNames :: QueryQualifyName
 138 neverQualifyNames _ _ = NameUnqual
 139
 140 alwaysQualifyModules :: QueryQualifyModule
 141 alwaysQualifyModules _ = True
 142
 143 neverQualifyModules :: QueryQualifyModule
 144 neverQualifyModules _ = False
 145
 146 type QueryQualifies = (QueryQualifyName, QueryQualifyModule)
 147
 148 alwaysQualify, neverQualify :: QueryQualifies
 149 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
 150 neverQualify  = (neverQualifyNames,  neverQualifyModules)
 151
 152 defaultUserStyle, defaultDumpStyle :: PprStyle
 153
 154 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
 155
 156 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
 157                  |  otherwise          = PprDump
 158
 159 -- | Style for printing error messages
 160 mkErrStyle :: PrintUnqualified -> PprStyle
 161 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
 162
 163 defaultErrStyle :: PprStyle
 164 -- Default style for error messages
 165 -- It's a bit of a hack because it doesn't take into account what's in scope
 166 -- Only used for desugarer warnings, and typechecker errors in interface sigs
 167 defaultErrStyle
 168   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
 169   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
 170
 171 mkUserStyle :: QueryQualifies -> Depth -> PprStyle
 172 mkUserStyle unqual depth
 173    | opt_PprStyle_Debug = PprDebug
 174    | otherwise          = PprUser unqual depth
 175 \end{code}
 176
 177 Orthogonal to the above printing styles are (possibly) some
 178 command-line flags that affect printing (often carried with the
 179 style).  The most likely ones are variations on how much type info is
 180 shown.
 181
 182 The following test decides whether or not we are actually generating
 183 code (either C or assembly), or generating interface files.
 184
 185 %************************************************************************
 186 %*                                                                      *
 187 \subsection{The @SDoc@ data type}
 188 %*                                                                      *
 189 %************************************************************************
 190
 191 \begin{code}
 192 type SDoc = PprStyle -> Doc
 193
 194 withPprStyle :: PprStyle -> SDoc -> SDoc
 195 withPprStyle sty d _sty' = d sty
 196
 197 withPprStyleDoc :: PprStyle -> SDoc -> Doc
 198 withPprStyleDoc sty d = d sty
 199
 200 pprDeeper :: SDoc -> SDoc
 201 pprDeeper _ (PprUser _ (PartWay 0)) = Pretty.text "..."
 202 pprDeeper d (PprUser q (PartWay n)) = d (PprUser q (PartWay (n-1)))
 203 pprDeeper d other_sty               = d other_sty
 204
 205 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
 206 -- Truncate a list that list that is longer than the current depth
 207 pprDeeperList f ds (PprUser q (PartWay n))
 208   | n==0      = Pretty.text "..."
 209   | otherwise = f (go 0 ds) (PprUser q (PartWay (n-1)))
 210   where
 211     go _ [] = []
 212     go i (d:ds) | i >= n    = [text "...."]
 213                 | otherwise = d : go (i+1) ds
 214
 215 pprDeeperList f ds other_sty
 216   = f ds other_sty
 217
 218 pprSetDepth :: Int -> SDoc -> SDoc
 219 pprSetDepth  n d (PprUser q _) = d (PprUser q (PartWay n))
 220 pprSetDepth _n d other_sty     = d other_sty
 221
 222 getPprStyle :: (PprStyle -> SDoc) -> SDoc
 223 getPprStyle df sty = df sty sty
 224 \end{code}
 225
 226 \begin{code}
 227 qualName :: PprStyle -> QueryQualifyName
 228 qualName (PprUser (qual_name,_) _) m  n = qual_name m n
 229 qualName _other                    m _n = NameQual (moduleName m)
 230
 231 qualModule :: PprStyle -> QueryQualifyModule
 232 qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
 233 qualModule _other                   _m = True
 234
 235 codeStyle :: PprStyle -> Bool
 236 codeStyle (PprCode _)     = True
 237 codeStyle _               = False
 238
 239 asmStyle :: PprStyle -> Bool
 240 asmStyle (PprCode AsmStyle)  = True
 241 asmStyle _other              = False
 242
 243 dumpStyle :: PprStyle -> Bool
 244 dumpStyle PprDump = True
 245 dumpStyle _other  = False
 246
 247 debugStyle :: PprStyle -> Bool
 248 debugStyle PprDebug       = True
 249 debugStyle _other         = False
 250
 251 userStyle ::  PprStyle -> Bool
 252 userStyle (PprUser _ _) = True
 253 userStyle _other        = False
 254
 255 ifPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
 256 ifPprDebug d sty@PprDebug = d sty
 257 ifPprDebug _ _            = Pretty.empty
 258 \end{code}
 259
 260 \begin{code}
 261 -- Unused [7/02 sof]
 262 printSDoc :: SDoc -> PprStyle -> IO ()
 263 printSDoc d sty = do
 264   Pretty.printDoc PageMode stdout (d sty)
 265   hFlush stdout
 266
 267 -- I'm not sure whether the direct-IO approach of Pretty.printDoc
 268 -- above is better or worse than the put-big-string approach here
 269 printErrs :: Doc -> IO ()
 270 printErrs doc = do Pretty.printDoc PageMode stderr doc
 271                    hFlush stderr
 272
 273 printDump :: SDoc -> IO ()
 274 printDump doc = hPrintDump stdout doc
 275
 276 hPrintDump :: Handle -> SDoc -> IO ()
 277 hPrintDump h doc = do
 278    Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
 279    hFlush h
 280  where
 281    better_doc = doc $$ text ""
 282
 283 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 284 printForUser handle unqual doc
 285   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
 286
 287 printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
 288 printForUserPartWay handle d unqual doc
 289   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
 290
 291 -- printForC, printForAsm do what they sound like
 292 printForC :: Handle -> SDoc -> IO ()
 293 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
 294
 295 printForAsm :: Handle -> SDoc -> IO ()
 296 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
 297
 298 pprCode :: CodeStyle -> SDoc -> SDoc
 299 pprCode cs d = withPprStyle (PprCode cs) d
 300
 301 mkCodeStyle :: CodeStyle -> PprStyle
 302 mkCodeStyle = PprCode
 303
 304 -- Can't make SDoc an instance of Show because SDoc is just a function type
 305 -- However, Doc *is* an instance of Show
 306 -- showSDoc just blasts it out as a string
 307 showSDoc :: SDoc -> String
 308 showSDoc d = show (d defaultUserStyle)
 309
 310 showSDocForUser :: PrintUnqualified -> SDoc -> String
 311 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
 312
 313 showSDocUnqual :: SDoc -> String
 314 -- Only used in the gruesome HsExpr.isOperator
 315 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 316
 317 showsPrecSDoc :: Int -> SDoc -> ShowS
 318 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
 319
 320 showSDocDump :: SDoc -> String
 321 showSDocDump d = show (d PprDump)
 322
 323 showSDocDebug :: SDoc -> String
 324 showSDocDebug d = show (d PprDebug)
 325 \end{code}
 326
 327 \begin{code}
 328 docToSDoc :: Doc -> SDoc
 329 docToSDoc d = \_ -> d
 330
 331 empty    :: SDoc
 332 text     :: String     -> SDoc
 333 char     :: Char       -> SDoc
 334 ftext    :: FastString -> SDoc
 335 ptext    :: LitString  -> SDoc
 336 int      :: Int        -> SDoc
 337 integer  :: Integer    -> SDoc
 338 float    :: Float      -> SDoc
 339 double   :: Double     -> SDoc
 340 rational :: Rational   -> SDoc
 341
 342 empty _sty      = Pretty.empty
 343 text s _sty     = Pretty.text s
 344 char c _sty     = Pretty.char c
 345 ftext s _sty    = Pretty.ftext s
 346 ptext s _sty    = Pretty.ptext s
 347 int n _sty      = Pretty.int n
 348 integer n _sty  = Pretty.integer n
 349 float n _sty    = Pretty.float n
 350 double n _sty   = Pretty.double n
 351 rational n _sty = Pretty.rational n
 352
 353 parens, braces, brackets, quotes, doubleQuotes, angleBrackets :: SDoc -> SDoc
 354
 355 parens d sty       = Pretty.parens (d sty)
 356 braces d sty       = Pretty.braces (d sty)
 357 brackets d sty     = Pretty.brackets (d sty)
 358 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
 359 angleBrackets d    = char '<' <> d <> char '>'
 360
 361 cparen :: Bool -> SDoc -> SDoc
 362
 363 cparen b d sty       = Pretty.cparen b (d sty)
 364
 365 -- quotes encloses something in single quotes...
 366 -- but it omits them if the thing ends in a single quote
 367 -- so that we don't get `foo''.  Instead we just have foo'.
 368 quotes d sty = case show pp_d of
 369                  ('\'' : _) -> pp_d
 370                  _other     -> Pretty.quotes pp_d
 371              where
 372                pp_d = d sty
 373
 374 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
 375 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
 376
 377 semi _sty   = Pretty.semi
 378 comma _sty  = Pretty.comma
 379 colon _sty  = Pretty.colon
 380 equals _sty = Pretty.equals
 381 space _sty  = Pretty.space
 382 dcolon _sty = Pretty.ptext (sLit "::")
 383 arrow  _sty = Pretty.ptext (sLit "->")
 384 underscore  = char '_'
 385 dot         = char '.'
 386 lparen _sty = Pretty.lparen
 387 rparen _sty = Pretty.rparen
 388 lbrack _sty = Pretty.lbrack
 389 rbrack _sty = Pretty.rbrack
 390 lbrace _sty = Pretty.lbrace
 391 rbrace _sty = Pretty.rbrace
 392
 393 nest :: Int -> SDoc -> SDoc
 394 (<>), (<+>), ($$), ($+$) :: SDoc -> SDoc -> SDoc
 395
 396 nest n d sty    = Pretty.nest n (d sty)
 397 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
 398 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
 399 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
 400 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
 401
 402 hcat, hsep, vcat, sep, cat, fsep, fcat :: [SDoc] -> SDoc
 403
 404
 405 hcat ds sty = Pretty.hcat [d sty | d <- ds]
 406 hsep ds sty = Pretty.hsep [d sty | d <- ds]
 407 vcat ds sty = Pretty.vcat [d sty | d <- ds]
 408 sep ds sty  = Pretty.sep  [d sty | d <- ds]
 409 cat ds sty  = Pretty.cat  [d sty | d <- ds]
 410 fsep ds sty = Pretty.fsep [d sty | d <- ds]
 411 fcat ds sty = Pretty.fcat [d sty | d <- ds]
 412
 413 hang :: SDoc -> Int -> SDoc -> SDoc
 414
 415 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
 416
 417 punctuate :: SDoc -> [SDoc] -> [SDoc]
 418 punctuate _ []     = []
 419 punctuate p (d:ds) = go d ds
 420                    where
 421                      go d [] = [d]
 422                      go d (e:es) = (d <> p) : go e es
 423 \end{code}
 424
 425
 426 %************************************************************************
 427 %*                                                                      *
 428 \subsection[Outputable-class]{The @Outputable@ class}
 429 %*                                                                      *
 430 %************************************************************************
 431
 432 \begin{code}
 433 class Outputable a where
 434         ppr :: a -> SDoc
 435 \end{code}
 436
 437 \begin{code}
 438 instance Outputable Bool where
 439     ppr True  = ptext (sLit "True")
 440     ppr False = ptext (sLit "False")
 441
 442 instance Outputable Int where
 443    ppr n = int n
 444
 445 instance Outputable Word32 where
 446    ppr n = integer $ fromIntegral n
 447
 448 instance Outputable () where
 449    ppr _ = text "()"
 450
 451 instance (Outputable a) => Outputable [a] where
 452     ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
 453
 454 instance (Outputable a, Outputable b) => Outputable (a, b) where
 455     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
 456
 457 instance Outputable a => Outputable (Maybe a) where
 458   ppr Nothing = ptext (sLit "Nothing")
 459   ppr (Just x) = ptext (sLit "Just") <+> ppr x
 460
 461 instance (Outputable a, Outputable b) => Outputable (Either a b) where
 462   ppr (Left x)  = ptext (sLit "Left")  <+> ppr x
 463   ppr (Right y) = ptext (sLit "Right") <+> ppr y
 464
 465 -- ToDo: may not be used
 466 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
 467     ppr (x,y,z) =
 468       parens (sep [ppr x <> comma,
 469                    ppr y <> comma,
 470                    ppr z ])
 471
 472 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
 473          Outputable (a, b, c, d) where
 474     ppr (a,b,c,d) =
 475       parens (sep [ppr a <> comma,
 476                    ppr b <> comma,
 477                    ppr c <> comma,
 478                    ppr d])
 479
 480 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
 481          Outputable (a, b, c, d, e) where
 482     ppr (a,b,c,d,e) =
 483       parens (sep [ppr a <> comma,
 484                    ppr b <> comma,
 485                    ppr c <> comma,
 486                    ppr d <> comma,
 487                    ppr e])
 488
 489 instance Outputable FastString where
 490     ppr fs = ftext fs           -- Prints an unadorned string,
 491                                 -- no double quotes or anything
 492 \end{code}
 493
 494
 495 %************************************************************************
 496 %*                                                                      *
 497 \subsection{The @OutputableBndr@ class}
 498 %*                                                                      *
 499 %************************************************************************
 500
 501 When we print a binder, we often want to print its type too.
 502 The @OutputableBndr@ class encapsulates this idea.
 503
 504 @BindingSite@ is used to tell the thing that prints binder what
 505 language construct is binding the identifier.  This can be used
 506 to decide how much info to print.
 507
 508 \begin{code}
 509 data BindingSite = LambdaBind | CaseBind | LetBind
 510
 511 class Outputable a => OutputableBndr a where
 512    pprBndr :: BindingSite -> a -> SDoc
 513    pprBndr _b x = ppr x
 514 \end{code}
 515
 516
 517
 518 %************************************************************************
 519 %*                                                                      *
 520 \subsection{Random printing helpers}
 521 %*                                                                      *
 522 %************************************************************************
 523
 524 \begin{code}
 525 -- We have 31-bit Chars and will simply use Show instances
 526 -- of Char and String.
 527
 528 pprHsChar :: Char -> SDoc
 529 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
 530             | otherwise      = text (show c)
 531
 532 pprHsString :: FastString -> SDoc
 533 pprHsString fs = text (show (unpackFS fs))
 534 \end{code}
 535
 536
 537 %************************************************************************
 538 %*                                                                      *
 539 \subsection{Other helper functions}
 540 %*                                                                      *
 541 %************************************************************************
 542
 543 \begin{code}
 544 pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
 545 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
 546
 547 interppSP  :: Outputable a => [a] -> SDoc
 548 interppSP  xs = sep (map ppr xs)
 549
 550 interpp'SP :: Outputable a => [a] -> SDoc
 551 interpp'SP xs = sep (punctuate comma (map ppr xs))
 552
 553 pprQuotedList :: Outputable a => [a] -> SDoc
 554 -- [x,y,z]  ==>  `x', `y', `z'
 555 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
 556 \end{code}
 557
 558
 559 %************************************************************************
 560 %*                                                                      *
 561 \subsection{Printing numbers verbally}
 562 %*                                                                      *
 563 %************************************************************************
 564
 565 @speakNth@ converts an integer to a verbal index; eg 1 maps to
 566 ``first'' etc.
 567
 568 \begin{code}
 569 speakNth :: Int -> SDoc
 570 speakNth 1 = ptext (sLit "first")
 571 speakNth 2 = ptext (sLit "second")
 572 speakNth 3 = ptext (sLit "third")
 573 speakNth 4 = ptext (sLit "fourth")
 574 speakNth 5 = ptext (sLit "fifth")
 575 speakNth 6 = ptext (sLit "sixth")
 576 speakNth n = hcat [ int n, text suffix ]
 577   where
 578     suffix | n <= 20       = "th"       -- 11,12,13 are non-std
 579            | last_dig == 1 = "st"
 580            | last_dig == 2 = "nd"
 581            | last_dig == 3 = "rd"
 582            | otherwise     = "th"
 583
 584     last_dig = n `rem` 10
 585
 586 speakN :: Int -> SDoc
 587 speakN 0 = ptext (sLit "none")  -- E.g.  "he has none"
 588 speakN 1 = ptext (sLit "one")   -- E.g.  "he has one"
 589 speakN 2 = ptext (sLit "two")
 590 speakN 3 = ptext (sLit "three")
 591 speakN 4 = ptext (sLit "four")
 592 speakN 5 = ptext (sLit "five")
 593 speakN 6 = ptext (sLit "six")
 594 speakN n = int n
 595
 596 speakNOf :: Int -> SDoc -> SDoc
 597 speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'      -- E.g. "no arguments"
 598 speakNOf 1 d = ptext (sLit "one") <+> d                 -- E.g. "one argument"
 599 speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments"
 600
 601 speakNTimes :: Int {- >=1 -} -> SDoc
 602 speakNTimes t | t == 1     = ptext (sLit "once")
 603               | t == 2     = ptext (sLit "twice")
 604               | otherwise  = speakN t <+> ptext (sLit "times")
 605
 606 plural :: [a] -> SDoc
 607 plural [_] = empty  -- a bit frightening, but there you are
 608 plural _   = char 's'
 609 \end{code}
 610
 611
 612 %************************************************************************
 613 %*                                                                      *
 614 \subsection{Error handling}
 615 %*                                                                      *
 616 %************************************************************************
 617
 618 \begin{code}
 619 pprPanic, pprPgmError :: String -> SDoc -> a
 620 pprTrace :: String -> SDoc -> a -> a
 621 pprPanic    = pprAndThen panic          -- Throw an exn saying "bug in GHC"
 622
 623 pprPgmError = pprAndThen pgmError       -- Throw an exn saying "bug in pgm being compiled"
 624                                         --      (used for unusual pgm errors)
 625 pprTrace str doc x
 626    | opt_NoDebugOutput = x
 627    | otherwise         = pprAndThen trace str doc x
 628
 629 pprPanicFastInt :: String -> SDoc -> FastInt
 630 pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
 631                              where
 632                                doc = text heading <+> pretty_msg
 633
 634 pprAndThen :: (String -> a) -> String -> SDoc -> a
 635 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
 636     where
 637      doc = sep [text heading, nest 4 pretty_msg]
 638
 639 assertPprPanic :: String -> Int -> SDoc -> a
 640 assertPprPanic file line msg
 641   = panic (show (doc PprDebug))
 642   where
 643     doc = sep [hsep[text "ASSERT failed! file",
 644                            text file,
 645                            text "line", int line],
 646                     msg]
 647
 648 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 649 warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x
 650 warnPprTrace False _file _line _msg x = x
 651 warnPprTrace True   file  line  msg x
 652   = trace (show (doc PprDebug)) x
 653   where
 654     doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
 655                msg]
 656 \end{code}