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 {-# OPTIONS -w #-}
  11 -- The above warning supression flag is a temporary kludge.
  12 -- While working on this module you are encouraged to remove it and fix
  13 -- any warnings in the module. See
  14 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  15 -- for details
  16
  17 module Outputable (
  18         Outputable(..), OutputableBndr(..),     -- Class
  19
  20         BindingSite(..),
  21
  22         PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, QualifyName(..),
  23         getPprStyle, withPprStyle, withPprStyleDoc,
  24         pprDeeper, pprDeeperList, pprSetDepth,
  25         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
  26         ifPprDebug, qualName, qualModule,
  27         mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
  28
  29         SDoc,           -- Abstract
  30         docToSDoc,
  31         interppSP, interpp'SP, pprQuotedList, pprWithCommas,
  32         empty, nest,
  33         text, char, ftext, ptext,
  34         int, integer, float, double, rational,
  35         parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
  36         semi, comma, colon, dcolon, space, equals, dot, arrow,
  37         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
  38         (<>), (<+>), hcat, hsep,
  39         ($$), ($+$), vcat,
  40         sep, cat,
  41         fsep, fcat,
  42         hang, punctuate,
  43         speakNth, speakNTimes, speakN, speakNOf, plural,
  44
  45         printSDoc, printErrs, hPrintDump, printDump,
  46         printForC, printForAsm, printForUser,
  47         pprCode, mkCodeStyle,
  48         showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
  49         showSDocUnqual, showsPrecSDoc,
  50         pprHsChar, pprHsString,
  51
  52         -- error handling
  53         pprPanic, assertPprPanic, pprPanic#, pprPgmError,
  54         pprTrace, warnPprTrace,
  55         trace, pgmError, panic, panic#, assertPanic
  56     ) where
  57
  58 #include "HsVersions.h"
  59
  60
  61 import {-# SOURCE #-}   Module( Module, modulePackageId,
  62                                 ModuleName, moduleName )
  63 import {-# SOURCE #-}   OccName( OccName )
  64
  65 import StaticFlags      ( opt_PprStyle_Debug, opt_PprUserLength )
  66 import PackageConfig    ( PackageId, packageIdString )
  67 import FastString
  68 import qualified Pretty
  69 import Pretty           ( Doc, Mode(..) )
  70 import Panic
  71
  72 import Data.Word        ( Word32 )
  73 import System.IO        ( Handle, stderr, stdout, hFlush )
  74 import Data.Char        ( ord )
  75 \end{code}
  76
  77
  78 %************************************************************************
  79 %*                                                                      *
  80 \subsection{The @PprStyle@ data type}
  81 %*                                                                      *
  82 %************************************************************************
  83
  84 \begin{code}
  85
  86 data PprStyle
  87   = PprUser PrintUnqualified Depth
  88                 -- Pretty-print in a way that will make sense to the
  89                 -- ordinary user; must be very close to Haskell
  90                 -- syntax, etc.
  91                 -- Assumes printing tidied code: non-system names are
  92                 -- printed without uniques.
  93
  94   | PprCode CodeStyle
  95                 -- Print code; either C or assembler
  96
  97   | PprDump     -- For -ddump-foo; less verbose than PprDebug.
  98                 -- Does not assume tidied code: non-external names
  99                 -- are printed with uniques.
 100
 101   | PprDebug    -- Full debugging output
 102
 103 data CodeStyle = CStyle         -- The format of labels differs for C and assembler
 104                | AsmStyle
 105
 106 data Depth = AllTheWay
 107            | PartWay Int        -- 0 => stop
 108
 109
 110 -- -----------------------------------------------------------------------------
 111 -- Printing original names
 112
 113 -- When printing code that contains original names, we need to map the
 114 -- original names back to something the user understands.  This is the
 115 -- purpose of the pair of functions that gets passed around
 116 -- when rendering 'SDoc'.
 117
 118 -- | given an /original/ name, this function tells you which module
 119 -- name it should be qualified with when printing for the user, if
 120 -- any.  For example, given @Control.Exception.catch@, which is in scope
 121 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
 122 -- Note that the return value is a ModuleName, not a Module, because
 123 -- in source code, names are qualified by ModuleNames.
 124 type QueryQualifyName = Module -> OccName -> QualifyName
 125
 126 data QualifyName                        -- given P:M.T
 127         = NameUnqual                    -- refer to it as "T"
 128         | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
 129         | NameNotInScope1
 130                 -- it is not in scope at all, but M.T is not bound in the current
 131                 -- scope, so we can refer to it as "M.T"
 132         | NameNotInScope2
 133                 -- it is not in scope at all, and M.T is already bound in the
 134                 -- current scope, so we must refer to it as "P:M.T"
 135
 136
 137 -- | For a given module, we need to know whether to print it with
 138 -- a package name to disambiguate it.
 139 type QueryQualifyModule = Module -> Bool
 140
 141 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
 142
 143 alwaysQualifyNames :: QueryQualifyName
 144 alwaysQualifyNames m n = NameQual (moduleName m)
 145
 146 neverQualifyNames :: QueryQualifyName
 147 neverQualifyNames m n = NameUnqual
 148
 149 alwaysQualifyModules :: QueryQualifyModule
 150 alwaysQualifyModules m = True
 151
 152 neverQualifyModules :: QueryQualifyModule
 153 neverQualifyModules m = False
 154
 155 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
 156 neverQualify  = (neverQualifyNames,  neverQualifyModules)
 157
 158 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
 159
 160 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
 161                  |  otherwise          = PprDump
 162
 163 -- | Style for printing error messages
 164 mkErrStyle :: PrintUnqualified -> PprStyle
 165 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
 166
 167 defaultErrStyle :: PprStyle
 168 -- Default style for error messages
 169 -- It's a bit of a hack because it doesn't take into account what's in scope
 170 -- Only used for desugarer warnings, and typechecker errors in interface sigs
 171 defaultErrStyle
 172   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
 173   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
 174
 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 d (PprUser q (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 i [] = []
 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 d sty          = 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 -- printForC, printForAsm do what they sound like
 291 printForC :: Handle -> SDoc -> IO ()
 292 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
 293
 294 printForAsm :: Handle -> SDoc -> IO ()
 295 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
 296
 297 pprCode :: CodeStyle -> SDoc -> SDoc
 298 pprCode cs d = withPprStyle (PprCode cs) d
 299
 300 mkCodeStyle :: CodeStyle -> PprStyle
 301 mkCodeStyle = PprCode
 302
 303 -- Can't make SDoc an instance of Show because SDoc is just a function type
 304 -- However, Doc *is* an instance of Show
 305 -- showSDoc just blasts it out as a string
 306 showSDoc :: SDoc -> String
 307 showSDoc d = show (d defaultUserStyle)
 308
 309 showSDocForUser :: PrintUnqualified -> SDoc -> String
 310 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
 311
 312 showSDocUnqual :: SDoc -> String
 313 -- Only used in the gruesome HsExpr.isOperator
 314 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 315
 316 showsPrecSDoc :: Int -> SDoc -> ShowS
 317 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
 318
 319 showSDocDump :: SDoc -> String
 320 showSDocDump d = show (d PprDump)
 321
 322 showSDocDebug :: SDoc -> String
 323 showSDocDebug d = show (d PprDebug)
 324 \end{code}
 325
 326 \begin{code}
 327 docToSDoc :: Doc -> SDoc
 328 docToSDoc d = \_ -> d
 329
 330 empty sty      = Pretty.empty
 331 text s sty     = Pretty.text s
 332 char c sty     = Pretty.char c
 333 ftext s sty    = Pretty.ftext s
 334 ptext s sty    = Pretty.ptext s
 335 int n sty      = Pretty.int n
 336 integer n sty  = Pretty.integer n
 337 float n sty    = Pretty.float n
 338 double n sty   = Pretty.double n
 339 rational n sty = Pretty.rational n
 340
 341 parens d sty       = Pretty.parens (d sty)
 342 braces d sty       = Pretty.braces (d sty)
 343 brackets d sty     = Pretty.brackets (d sty)
 344 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
 345 angleBrackets d    = char '<' <> d <> char '>'
 346
 347 cparen b d sty       = Pretty.cparen b (d sty)
 348
 349 -- quotes encloses something in single quotes...
 350 -- but it omits them if the thing ends in a single quote
 351 -- so that we don't get `foo''.  Instead we just have foo'.
 352 quotes d sty = case show pp_d of
 353                  ('\'' : _) -> pp_d
 354                  other      -> Pretty.quotes pp_d
 355              where
 356                pp_d = d sty
 357
 358 semi sty   = Pretty.semi
 359 comma sty  = Pretty.comma
 360 colon sty  = Pretty.colon
 361 equals sty = Pretty.equals
 362 space sty  = Pretty.space
 363 lparen sty = Pretty.lparen
 364 rparen sty = Pretty.rparen
 365 lbrack sty = Pretty.lbrack
 366 rbrack sty = Pretty.rbrack
 367 lbrace sty = Pretty.lbrace
 368 rbrace sty = Pretty.rbrace
 369 dcolon sty = Pretty.ptext SLIT("::")
 370 arrow  sty = Pretty.ptext SLIT("->")
 371 underscore = char '_'
 372 dot        = char '.'
 373
 374 nest n d sty    = Pretty.nest n (d sty)
 375 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
 376 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
 377 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
 378 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
 379
 380 hcat ds sty = Pretty.hcat [d sty | d <- ds]
 381 hsep ds sty = Pretty.hsep [d sty | d <- ds]
 382 vcat ds sty = Pretty.vcat [d sty | d <- ds]
 383 sep ds sty  = Pretty.sep  [d sty | d <- ds]
 384 cat ds sty  = Pretty.cat  [d sty | d <- ds]
 385 fsep ds sty = Pretty.fsep [d sty | d <- ds]
 386 fcat ds sty = Pretty.fcat [d sty | d <- ds]
 387
 388 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
 389
 390 punctuate :: SDoc -> [SDoc] -> [SDoc]
 391 punctuate p []     = []
 392 punctuate p (d:ds) = go d ds
 393                    where
 394                      go d [] = [d]
 395                      go d (e:es) = (d <> p) : go e es
 396 \end{code}
 397
 398
 399 %************************************************************************
 400 %*                                                                      *
 401 \subsection[Outputable-class]{The @Outputable@ class}
 402 %*                                                                      *
 403 %************************************************************************
 404
 405 \begin{code}
 406 class Outputable a where
 407         ppr :: a -> SDoc
 408 \end{code}
 409
 410 \begin{code}
 411 instance Outputable Bool where
 412     ppr True  = ptext SLIT("True")
 413     ppr False = ptext SLIT("False")
 414
 415 instance Outputable Int where
 416    ppr n = int n
 417
 418 instance Outputable () where
 419    ppr _ = text "()"
 420
 421 instance (Outputable a) => Outputable [a] where
 422     ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
 423
 424 instance (Outputable a, Outputable b) => Outputable (a, b) where
 425     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
 426
 427 instance Outputable a => Outputable (Maybe a) where
 428   ppr Nothing = ptext SLIT("Nothing")
 429   ppr (Just x) = ptext SLIT("Just") <+> ppr x
 430
 431 instance (Outputable a, Outputable b) => Outputable (Either a b) where
 432   ppr (Left x)  = ptext SLIT("Left")  <+> ppr x
 433   ppr (Right y) = ptext SLIT("Right") <+> ppr y
 434
 435 -- ToDo: may not be used
 436 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
 437     ppr (x,y,z) =
 438       parens (sep [ppr x <> comma,
 439                    ppr y <> comma,
 440                    ppr z ])
 441
 442 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
 443          Outputable (a, b, c, d) where
 444     ppr (x,y,z,w) =
 445       parens (sep [ppr x <> comma,
 446                    ppr y <> comma,
 447                    ppr z <> comma,
 448                    ppr w])
 449
 450 instance Outputable FastString where
 451     ppr fs = ftext fs           -- Prints an unadorned string,
 452                                 -- no double quotes or anything
 453
 454 instance Outputable PackageId where
 455    ppr pid = text (packageIdString pid)
 456 \end{code}
 457
 458
 459 %************************************************************************
 460 %*                                                                      *
 461 \subsection{The @OutputableBndr@ class}
 462 %*                                                                      *
 463 %************************************************************************
 464
 465 When we print a binder, we often want to print its type too.
 466 The @OutputableBndr@ class encapsulates this idea.
 467
 468 @BindingSite@ is used to tell the thing that prints binder what
 469 language construct is binding the identifier.  This can be used
 470 to decide how much info to print.
 471
 472 \begin{code}
 473 data BindingSite = LambdaBind | CaseBind | LetBind
 474
 475 class Outputable a => OutputableBndr a where
 476    pprBndr :: BindingSite -> a -> SDoc
 477    pprBndr b x = ppr x
 478 \end{code}
 479
 480
 481
 482 %************************************************************************
 483 %*                                                                      *
 484 \subsection{Random printing helpers}
 485 %*                                                                      *
 486 %************************************************************************
 487
 488 \begin{code}
 489 -- We have 31-bit Chars and will simply use Show instances
 490 -- of Char and String.
 491
 492 pprHsChar :: Char -> SDoc
 493 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
 494             | otherwise      = text (show c)
 495
 496 pprHsString :: FastString -> SDoc
 497 pprHsString fs = text (show (unpackFS fs))
 498 \end{code}
 499
 500
 501 %************************************************************************
 502 %*                                                                      *
 503 \subsection{Other helper functions}
 504 %*                                                                      *
 505 %************************************************************************
 506
 507 \begin{code}
 508 pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
 509 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
 510
 511 interppSP  :: Outputable a => [a] -> SDoc
 512 interppSP  xs = sep (map ppr xs)
 513
 514 interpp'SP :: Outputable a => [a] -> SDoc
 515 interpp'SP xs = sep (punctuate comma (map ppr xs))
 516
 517 pprQuotedList :: Outputable a => [a] -> SDoc
 518 -- [x,y,z]  ==>  `x', `y', `z'
 519 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
 520 \end{code}
 521
 522
 523 %************************************************************************
 524 %*                                                                      *
 525 \subsection{Printing numbers verbally}
 526 %*                                                                      *
 527 %************************************************************************
 528
 529 @speakNth@ converts an integer to a verbal index; eg 1 maps to
 530 ``first'' etc.
 531
 532 \begin{code}
 533 speakNth :: Int -> SDoc
 534 speakNth 1 = ptext SLIT("first")
 535 speakNth 2 = ptext SLIT("second")
 536 speakNth 3 = ptext SLIT("third")
 537 speakNth 4 = ptext SLIT("fourth")
 538 speakNth 5 = ptext SLIT("fifth")
 539 speakNth 6 = ptext SLIT("sixth")
 540 speakNth n = hcat [ int n, text suffix ]
 541   where
 542     suffix | n <= 20       = "th"       -- 11,12,13 are non-std
 543            | last_dig == 1 = "st"
 544            | last_dig == 2 = "nd"
 545            | last_dig == 3 = "rd"
 546            | otherwise     = "th"
 547
 548     last_dig = n `rem` 10
 549
 550 speakN :: Int -> SDoc
 551 speakN 0 = ptext SLIT("none")   -- E.g.  "he has none"
 552 speakN 1 = ptext SLIT("one")    -- E.g.  "he has one"
 553 speakN 2 = ptext SLIT("two")
 554 speakN 3 = ptext SLIT("three")
 555 speakN 4 = ptext SLIT("four")
 556 speakN 5 = ptext SLIT("five")
 557 speakN 6 = ptext SLIT("six")
 558 speakN n = int n
 559
 560 speakNOf :: Int -> SDoc -> SDoc
 561 speakNOf 0 d = ptext SLIT("no") <+> d <> char 's'       -- E.g. "no arguments"
 562 speakNOf 1 d = ptext SLIT("one") <+> d                  -- E.g. "one argument"
 563 speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments"
 564
 565 speakNTimes :: Int {- >=1 -} -> SDoc
 566 speakNTimes t | t == 1     = ptext SLIT("once")
 567               | t == 2     = ptext SLIT("twice")
 568               | otherwise  = speakN t <+> ptext SLIT("times")
 569
 570 plural [x] = empty
 571 plural xs  = char 's'
 572 \end{code}
 573
 574
 575 %************************************************************************
 576 %*                                                                      *
 577 \subsection{Error handling}
 578 %*                                                                      *
 579 %************************************************************************
 580
 581 \begin{code}
 582 pprPanic, pprPgmError :: String -> SDoc -> a
 583 pprTrace :: String -> SDoc -> a -> a
 584 pprPanic    = pprAndThen panic          -- Throw an exn saying "bug in GHC"
 585
 586 pprPgmError = pprAndThen pgmError       -- Throw an exn saying "bug in pgm being compiled"
 587                                         --      (used for unusual pgm errors)
 588 pprTrace    = pprAndThen trace
 589
 590 pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
 591                              where
 592                                doc = text heading <+> pretty_msg
 593
 594 pprAndThen :: (String -> a) -> String -> SDoc -> a
 595 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
 596     where
 597      doc = sep [text heading, nest 4 pretty_msg]
 598
 599 assertPprPanic :: String -> Int -> SDoc -> a
 600 assertPprPanic file line msg
 601   = panic (show (doc PprDebug))
 602   where
 603     doc = sep [hsep[text "ASSERT failed! file",
 604                            text file,
 605                            text "line", int line],
 606                     msg]
 607
 608 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
 609 warnPprTrace False file line msg x = x
 610 warnPprTrace True  file line msg x
 611   = trace (show (doc PprDebug)) x
 612   where
 613     doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
 614                msg]
 615 \end{code}