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 #include "HsVersions.h"
  54
  55
  56 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
  57 import {-# SOURCE #-}   OccName( OccName )
  58
  59 import StaticFlags      ( opt_PprStyle_Debug, opt_PprUserLength )
  60 import FastString
  61 import FastTypes
  62 import qualified Pretty
  63 import Pretty           ( Doc, Mode(..) )
  64 import Panic
  65
  66 import Data.Word        ( Word32 )
  67 import System.IO        ( Handle, stderr, stdout, hFlush )
  68 import Data.Char        ( ord )
  69 \end{code}
  70
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 \subsection{The @PprStyle@ data type}
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 \begin{code}
  79
  80 data PprStyle
  81   = PprUser PrintUnqualified Depth
  82                 -- Pretty-print in a way that will make sense to the
  83                 -- ordinary user; must be very close to Haskell
  84                 -- syntax, etc.
  85                 -- Assumes printing tidied code: non-system names are
  86                 -- printed without uniques.
  87
  88   | PprCode CodeStyle
  89                 -- Print code; either C or assembler
  90
  91   | PprDump     -- For -ddump-foo; less verbose than PprDebug.
  92                 -- Does not assume tidied code: non-external names
  93                 -- are printed with uniques.
  94
  95   | PprDebug    -- Full debugging output
  96
  97 data CodeStyle = CStyle         -- The format of labels differs for C and assembler
  98                | AsmStyle
  99
 100 data Depth = AllTheWay
 101            | PartWay Int        -- 0 => stop
 102
 103
 104 -- -----------------------------------------------------------------------------
 105 -- Printing original names
 106
 107 -- When printing code that contains original names, we need to map the
 108 -- original names back to something the user understands.  This is the
 109 -- purpose of the pair of functions that gets passed around
 110 -- when rendering 'SDoc'.
 111
 112 -- | given an /original/ name, this function tells you which module
 113 -- name it should be qualified with when printing for the user, if
 114 -- any.  For example, given @Control.Exception.catch@, which is in scope
 115 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
 116 -- Note that the return value is a ModuleName, not a Module, because
 117 -- in source code, names are qualified by ModuleNames.
 118 type QueryQualifyName = Module -> OccName -> QualifyName
 119
 120 data QualifyName                        -- given P:M.T
 121         = NameUnqual                    -- refer to it as "T"
 122         | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
 123         | NameNotInScope1
 124                 -- it is not in scope at all, but M.T is not bound in the current
 125                 -- scope, so we can refer to it as "M.T"
 126         | NameNotInScope2
 127                 -- it is not in scope at all, and M.T is already bound in the
 128                 -- current scope, so we must refer to it as "P:M.T"
 129
 130
 131 -- | For a given module, we need to know whether to print it with
 132 -- a package name to disambiguate it.
 133 type QueryQualifyModule = Module -> Bool
 134
 135 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
 136
 137 alwaysQualifyNames :: QueryQualifyName
 138 alwaysQualifyNames m _ = NameQual (moduleName m)
 139
 140 neverQualifyNames :: QueryQualifyName
 141 neverQualifyNames _ _ = NameUnqual
 142
 143 alwaysQualifyModules :: QueryQualifyModule
 144 alwaysQualifyModules _ = True
 145
 146 neverQualifyModules :: QueryQualifyModule
 147 neverQualifyModules _ = False
 148
 149 type QueryQualifies = (QueryQualifyName, QueryQualifyModule)
 150
 151 alwaysQualify, neverQualify :: QueryQualifies
 152 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
 153 neverQualify  = (neverQualifyNames,  neverQualifyModules)
 154
 155 defaultUserStyle, defaultDumpStyle :: PprStyle
 156
 157 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
 158
 159 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
 160                  |  otherwise          = PprDump
 161
 162 -- | Style for printing error messages
 163 mkErrStyle :: PrintUnqualified -> PprStyle
 164 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
 165
 166 defaultErrStyle :: PprStyle
 167 -- Default style for error messages
 168 -- It's a bit of a hack because it doesn't take into account what's in scope
 169 -- Only used for desugarer warnings, and typechecker errors in interface sigs
 170 defaultErrStyle
 171   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
 172   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
 173
 174 mkUserStyle :: QueryQualifies -> Depth -> PprStyle
 175 mkUserStyle unqual depth
 176    | opt_PprStyle_Debug = PprDebug
 177    | otherwise          = PprUser unqual depth
 178 \end{code}
 179
 180 Orthogonal to the above printing styles are (possibly) some
 181 command-line flags that affect printing (often carried with the
 182 style).  The most likely ones are variations on how much type info is
 183 shown.
 184
 185 The following test decides whether or not we are actually generating
 186 code (either C or assembly), or generating interface files.
 187
 188 %************************************************************************
 189 %*                                                                      *
 190 \subsection{The @SDoc@ data type}
 191 %*                                                                      *
 192 %************************************************************************
 193
 194 \begin{code}
 195 type SDoc = PprStyle -> Doc
 196
 197 withPprStyle :: PprStyle -> SDoc -> SDoc
 198 withPprStyle sty d _sty' = d sty
 199
 200 withPprStyleDoc :: PprStyle -> SDoc -> Doc
 201 withPprStyleDoc sty d = d sty
 202
 203 pprDeeper :: SDoc -> SDoc
 204 pprDeeper _ (PprUser _ (PartWay 0)) = Pretty.text "..."
 205 pprDeeper d (PprUser q (PartWay n)) = d (PprUser q (PartWay (n-1)))
 206 pprDeeper d other_sty               = d other_sty
 207
 208 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
 209 -- Truncate a list that list that is longer than the current depth
 210 pprDeeperList f ds (PprUser q (PartWay n))
 211   | n==0      = Pretty.text "..."
 212   | otherwise = f (go 0 ds) (PprUser q (PartWay (n-1)))
 213   where
 214     go _ [] = []
 215     go i (d:ds) | i >= n    = [text "...."]
 216                 | otherwise = d : go (i+1) ds
 217
 218 pprDeeperList f ds other_sty
 219   = f ds other_sty
 220
 221 pprSetDepth :: Int -> SDoc -> SDoc
 222 pprSetDepth  n d (PprUser q _) = d (PprUser q (PartWay n))
 223 pprSetDepth _n d other_sty     = d other_sty
 224
 225 getPprStyle :: (PprStyle -> SDoc) -> SDoc
 226 getPprStyle df sty = df sty sty
 227 \end{code}
 228
 229 \begin{code}
 230 qualName :: PprStyle -> QueryQualifyName
 231 qualName (PprUser (qual_name,_) _) m  n = qual_name m n
 232 qualName _other                    m _n = NameQual (moduleName m)
 233
 234 qualModule :: PprStyle -> QueryQualifyModule
 235 qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
 236 qualModule _other                   _m = True
 237
 238 codeStyle :: PprStyle -> Bool
 239 codeStyle (PprCode _)     = True
 240 codeStyle _               = False
 241
 242 asmStyle :: PprStyle -> Bool
 243 asmStyle (PprCode AsmStyle)  = True
 244 asmStyle _other              = False
 245
 246 dumpStyle :: PprStyle -> Bool
 247 dumpStyle PprDump = True
 248 dumpStyle _other  = False
 249
 250 debugStyle :: PprStyle -> Bool
 251 debugStyle PprDebug       = True
 252 debugStyle _other         = False
 253
 254 userStyle ::  PprStyle -> Bool
 255 userStyle (PprUser _ _) = True
 256 userStyle _other        = False
 257
 258 ifPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
 259 ifPprDebug d sty@PprDebug = d sty
 260 ifPprDebug _ _            = Pretty.empty
 261 \end{code}
 262
 263 \begin{code}
 264 -- Unused [7/02 sof]
 265 printSDoc :: SDoc -> PprStyle -> IO ()
 266 printSDoc d sty = do
 267   Pretty.printDoc PageMode stdout (d sty)
 268   hFlush stdout
 269
 270 -- I'm not sure whether the direct-IO approach of Pretty.printDoc
 271 -- above is better or worse than the put-big-string approach here
 272 printErrs :: Doc -> IO ()
 273 printErrs doc = do Pretty.printDoc PageMode stderr doc
 274                    hFlush stderr
 275
 276 printDump :: SDoc -> IO ()
 277 printDump doc = hPrintDump stdout doc
 278
 279 hPrintDump :: Handle -> SDoc -> IO ()
 280 hPrintDump h doc = do
 281    Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
 282    hFlush h
 283  where
 284    better_doc = doc $$ text ""
 285
 286 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 287 printForUser handle unqual doc
 288   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
 289
 290 printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
 291 printForUserPartWay handle d unqual doc
 292   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
 293
 294 -- printForC, printForAsm do what they sound like
 295 printForC :: Handle -> SDoc -> IO ()
 296 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
 297
 298 printForAsm :: Handle -> SDoc -> IO ()
 299 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
 300
 301 pprCode :: CodeStyle -> SDoc -> SDoc
 302 pprCode cs d = withPprStyle (PprCode cs) d
 303
 304 mkCodeStyle :: CodeStyle -> PprStyle
 305 mkCodeStyle = PprCode
 306
 307 -- Can't make SDoc an instance of Show because SDoc is just a function type
 308 -- However, Doc *is* an instance of Show
 309 -- showSDoc just blasts it out as a string
 310 showSDoc :: SDoc -> String
 311 showSDoc d = show (d defaultUserStyle)
 312
 313 showSDocForUser :: PrintUnqualified -> SDoc -> String
 314 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
 315
 316 showSDocUnqual :: SDoc -> String
 317 -- Only used in the gruesome HsExpr.isOperator
 318 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 319
 320 showsPrecSDoc :: Int -> SDoc -> ShowS
 321 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
 322
 323 showSDocDump :: SDoc -> String
 324 showSDocDump d = show (d PprDump)
 325
 326 showSDocDebug :: SDoc -> String
 327 showSDocDebug d = show (d PprDebug)
 328 \end{code}
 329
 330 \begin{code}
 331 docToSDoc :: Doc -> SDoc
 332 docToSDoc d = \_ -> d
 333
 334 empty    :: SDoc
 335 text     :: String     -> SDoc
 336 char     :: Char       -> SDoc
 337 ftext    :: FastString -> SDoc
 338 ptext    :: LitString  -> SDoc
 339 int      :: Int        -> SDoc
 340 integer  :: Integer    -> SDoc
 341 float    :: Float      -> SDoc
 342 double   :: Double     -> SDoc
 343 rational :: Rational   -> SDoc
 344
 345 empty _sty      = Pretty.empty
 346 text s _sty     = Pretty.text s
 347 char c _sty     = Pretty.char c
 348 ftext s _sty    = Pretty.ftext s
 349 ptext s _sty    = Pretty.ptext s
 350 int n _sty      = Pretty.int n
 351 integer n _sty  = Pretty.integer n
 352 float n _sty    = Pretty.float n
 353 double n _sty   = Pretty.double n
 354 rational n _sty = Pretty.rational n
 355
 356 parens, braces, brackets, quotes, doubleQuotes, angleBrackets :: SDoc -> SDoc
 357
 358 parens d sty       = Pretty.parens (d sty)
 359 braces d sty       = Pretty.braces (d sty)
 360 brackets d sty     = Pretty.brackets (d sty)
 361 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
 362 angleBrackets d    = char '<' <> d <> char '>'
 363
 364 cparen :: Bool -> SDoc -> SDoc
 365
 366 cparen b d sty       = Pretty.cparen b (d sty)
 367
 368 -- quotes encloses something in single quotes...
 369 -- but it omits them if the thing ends in a single quote
 370 -- so that we don't get `foo''.  Instead we just have foo'.
 371 quotes d sty = case show pp_d of
 372                  ('\'' : _) -> pp_d
 373                  _other     -> Pretty.quotes pp_d
 374              where
 375                pp_d = d sty
 376
 377 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
 378 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
 379
 380 semi _sty   = Pretty.semi
 381 comma _sty  = Pretty.comma
 382 colon _sty  = Pretty.colon
 383 equals _sty = Pretty.equals
 384 space _sty  = Pretty.space
 385 dcolon _sty = Pretty.ptext SLIT("::")
 386 arrow  _sty = Pretty.ptext SLIT("->")
 387 underscore  = char '_'
 388 dot         = char '.'
 389 lparen _sty = Pretty.lparen
 390 rparen _sty = Pretty.rparen
 391 lbrack _sty = Pretty.lbrack
 392 rbrack _sty = Pretty.rbrack
 393 lbrace _sty = Pretty.lbrace
 394 rbrace _sty = Pretty.rbrace
 395
 396 nest :: Int -> SDoc -> SDoc
 397 (<>), (<+>), ($$), ($+$) :: SDoc -> SDoc -> SDoc
 398
 399 nest n d sty    = Pretty.nest n (d sty)
 400 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
 401 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
 402 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
 403 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
 404
 405 hcat, hsep, vcat, sep, cat, fsep, fcat :: [SDoc] -> SDoc
 406
 407
 408 hcat ds sty = Pretty.hcat [d sty | d <- ds]
 409 hsep ds sty = Pretty.hsep [d sty | d <- ds]
 410 vcat ds sty = Pretty.vcat [d sty | d <- ds]
 411 sep ds sty  = Pretty.sep  [d sty | d <- ds]
 412 cat ds sty  = Pretty.cat  [d sty | d <- ds]
 413 fsep ds sty = Pretty.fsep [d sty | d <- ds]
 414 fcat ds sty = Pretty.fcat [d sty | d <- ds]
 415
 416 hang :: SDoc -> Int -> SDoc -> SDoc
 417
 418 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
 419
 420 punctuate :: SDoc -> [SDoc] -> [SDoc]
 421 punctuate _ []     = []
 422 punctuate p (d:ds) = go d ds
 423                    where
 424                      go d [] = [d]
 425                      go d (e:es) = (d <> p) : go e es
 426 \end{code}
 427
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 \subsection[Outputable-class]{The @Outputable@ class}
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 \begin{code}
 436 class Outputable a where
 437         ppr :: a -> SDoc
 438 \end{code}
 439
 440 \begin{code}
 441 instance Outputable Bool where
 442     ppr True  = ptext SLIT("True")
 443     ppr False = ptext SLIT("False")
 444
 445 instance Outputable Int where
 446    ppr n = int 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    = pprAndThen trace
 626
 627 pprPanicFastInt :: String -> SDoc -> FastInt
 628 pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
 629                              where
 630                                doc = text heading <+> pretty_msg
 631
 632 pprAndThen :: (String -> a) -> String -> SDoc -> a
 633 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
 634     where
 635      doc = sep [text heading, nest 4 pretty_msg]
 636
 637 assertPprPanic :: String -> Int -> SDoc -> a
 638 assertPprPanic file line msg
 639   = panic (show (doc PprDebug))
 640   where
 641     doc = sep [hsep[text "ASSERT failed! file",
 642                            text file,
 643                            text "line", int line],
 644                     msg]
 645
 646 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 647 warnPprTrace False _file _line _msg x = x
 648 warnPprTrace True   file  line  msg x
 649   = trace (show (doc PprDebug)) x
 650   where
 651     doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
 652                msg]
 653 \end{code}