2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-1998
7 -- | This module defines classes and functions for pretty-printing. It also
8 -- exports a number of helpful debugging and other utilities such as 'trace' and 'panic'.
10 -- The interface to this module is very similar to the standard Hughes-PJ pretty printing
11 -- module, except that it exports a number of additional functions that are rarely used,
12 -- and works over the 'SDoc' type.
15 Outputable(..), OutputableBndr(..),
17 -- * Pretty printing combinators
20 interppSP, interpp'SP, pprQuotedList, pprWithCommas,
24 int, integer, float, double, rational,
25 parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
26 semi, comma, colon, dcolon, space, equals, dot, arrow,
27 lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
28 (<>), (<+>), hcat, hsep,
33 speakNth, speakNTimes, speakN, speakNOf, plural,
35 -- * Converting 'SDoc' into strings and outputing it
36 printSDoc, printErrs, hPrintDump, printDump,
37 printForC, printForAsm, printForUser, printForUserPartWay,
39 showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
40 showSDocUnqual, showsPrecSDoc,
42 pprInfixVar, pprPrefixVar,
43 pprHsChar, pprHsString, pprHsInfix, pprHsVar,
45 -- * Controlling the style in which output is printed
48 PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
50 getPprStyle, withPprStyle, withPprStyleDoc,
51 pprDeeper, pprDeeperList, pprSetDepth,
52 codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
53 ifPprDebug, qualName, qualModule,
54 mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
55 mkUserStyle, Depth(..),
57 -- * Error handling and debugging utilities
58 pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError,
59 pprTrace, warnPprTrace,
60 trace, pgmError, panic, panicFastInt, assertPanic
63 import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
64 import {-# SOURCE #-} OccName( OccName )
69 import qualified Pretty
70 import Pretty ( Doc, Mode(..) )
71 import Char ( isAlpha )
74 import Data.Word ( Word32 )
75 import System.IO ( Handle, stderr, stdout, hFlush )
76 import Data.Char ( ord )
80 %************************************************************************
82 \subsection{The @PprStyle@ data type}
84 %************************************************************************
89 = PprUser PrintUnqualified Depth
90 -- Pretty-print in a way that will make sense to the
91 -- ordinary user; must be very close to Haskell
93 -- Assumes printing tidied code: non-system names are
94 -- printed without uniques.
97 -- Print code; either C or assembler
99 | PprDump -- For -ddump-foo; less verbose than PprDebug.
100 -- Does not assume tidied code: non-external names
101 -- are printed with uniques.
103 | PprDebug -- Full debugging output
105 data CodeStyle = CStyle -- The format of labels differs for C and assembler
108 data Depth = AllTheWay
109 | PartWay Int -- 0 => stop
112 -- -----------------------------------------------------------------------------
113 -- Printing original names
115 -- When printing code that contains original names, we need to map the
116 -- original names back to something the user understands. This is the
117 -- purpose of the pair of functions that gets passed around
118 -- when rendering 'SDoc'.
120 -- | given an /original/ name, this function tells you which module
121 -- name it should be qualified with when printing for the user, if
122 -- any. For example, given @Control.Exception.catch@, which is in scope
123 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
124 -- Note that the return value is a ModuleName, not a Module, because
125 -- in source code, names are qualified by ModuleNames.
126 type QueryQualifyName = Module -> OccName -> QualifyName
128 data QualifyName -- given P:M.T
129 = NameUnqual -- refer to it as "T"
130 | NameQual ModuleName -- refer to it as "X.T" for the supplied X
132 -- it is not in scope at all, but M.T is not bound in the current
133 -- scope, so we can refer to it as "M.T"
135 -- it is not in scope at all, and M.T is already bound in the
136 -- current scope, so we must refer to it as "P:M.T"
139 -- | For a given module, we need to know whether to print it with
140 -- a package name to disambiguate it.
141 type QueryQualifyModule = Module -> Bool
143 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
145 alwaysQualifyNames :: QueryQualifyName
146 alwaysQualifyNames m _ = NameQual (moduleName m)
148 neverQualifyNames :: QueryQualifyName
149 neverQualifyNames _ _ = NameUnqual
151 alwaysQualifyModules :: QueryQualifyModule
152 alwaysQualifyModules _ = True
154 neverQualifyModules :: QueryQualifyModule
155 neverQualifyModules _ = False
157 alwaysQualify, neverQualify :: PrintUnqualified
158 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
159 neverQualify = (neverQualifyNames, neverQualifyModules)
161 defaultUserStyle, defaultDumpStyle :: PprStyle
163 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
165 defaultDumpStyle | opt_PprStyle_Debug = PprDebug
166 | otherwise = PprDump
168 -- | Style for printing error messages
169 mkErrStyle :: PrintUnqualified -> PprStyle
170 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
172 defaultErrStyle :: PprStyle
173 -- Default style for error messages
174 -- It's a bit of a hack because it doesn't take into account what's in scope
175 -- Only used for desugarer warnings, and typechecker errors in interface sigs
177 | opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay
178 | otherwise = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
180 mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
181 mkUserStyle unqual depth
182 | opt_PprStyle_Debug = PprDebug
183 | otherwise = PprUser unqual depth
186 Orthogonal to the above printing styles are (possibly) some
187 command-line flags that affect printing (often carried with the
188 style). The most likely ones are variations on how much type info is
191 The following test decides whether or not we are actually generating
192 code (either C or assembly), or generating interface files.
194 %************************************************************************
196 \subsection{The @SDoc@ data type}
198 %************************************************************************
201 type SDoc = PprStyle -> Doc
203 withPprStyle :: PprStyle -> SDoc -> SDoc
204 withPprStyle sty d _sty' = d sty
206 withPprStyleDoc :: PprStyle -> SDoc -> Doc
207 withPprStyleDoc sty d = d sty
209 pprDeeper :: SDoc -> SDoc
210 pprDeeper _ (PprUser _ (PartWay 0)) = Pretty.text "..."
211 pprDeeper d (PprUser q (PartWay n)) = d (PprUser q (PartWay (n-1)))
212 pprDeeper d other_sty = d other_sty
214 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
215 -- Truncate a list that list that is longer than the current depth
216 pprDeeperList f ds (PprUser q (PartWay n))
217 | n==0 = Pretty.text "..."
218 | otherwise = f (go 0 ds) (PprUser q (PartWay (n-1)))
221 go i (d:ds) | i >= n = [text "...."]
222 | otherwise = d : go (i+1) ds
224 pprDeeperList f ds other_sty
227 pprSetDepth :: Int -> SDoc -> SDoc
228 pprSetDepth n d (PprUser q _) = d (PprUser q (PartWay n))
229 pprSetDepth _n d other_sty = d other_sty
231 getPprStyle :: (PprStyle -> SDoc) -> SDoc
232 getPprStyle df sty = df sty sty
236 qualName :: PprStyle -> QueryQualifyName
237 qualName (PprUser (qual_name,_) _) m n = qual_name m n
238 qualName _other m _n = NameQual (moduleName m)
240 qualModule :: PprStyle -> QueryQualifyModule
241 qualModule (PprUser (_,qual_mod) _) m = qual_mod m
242 qualModule _other _m = True
244 codeStyle :: PprStyle -> Bool
245 codeStyle (PprCode _) = True
248 asmStyle :: PprStyle -> Bool
249 asmStyle (PprCode AsmStyle) = True
250 asmStyle _other = False
252 dumpStyle :: PprStyle -> Bool
253 dumpStyle PprDump = True
254 dumpStyle _other = False
256 debugStyle :: PprStyle -> Bool
257 debugStyle PprDebug = True
258 debugStyle _other = False
260 userStyle :: PprStyle -> Bool
261 userStyle (PprUser _ _) = True
262 userStyle _other = False
264 ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
265 ifPprDebug d sty@PprDebug = d sty
266 ifPprDebug _ _ = Pretty.empty
271 printSDoc :: SDoc -> PprStyle -> IO ()
273 Pretty.printDoc PageMode stdout (d sty)
276 -- I'm not sure whether the direct-IO approach of Pretty.printDoc
277 -- above is better or worse than the put-big-string approach here
278 printErrs :: Doc -> IO ()
279 printErrs doc = do Pretty.printDoc PageMode stderr doc
282 printDump :: SDoc -> IO ()
283 printDump doc = hPrintDump stdout doc
285 hPrintDump :: Handle -> SDoc -> IO ()
286 hPrintDump h doc = do
287 Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
290 better_doc = doc $$ text ""
292 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
293 printForUser handle unqual doc
294 = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
296 printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
297 printForUserPartWay handle d unqual doc
298 = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
300 -- printForC, printForAsm do what they sound like
301 printForC :: Handle -> SDoc -> IO ()
302 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
304 printForAsm :: Handle -> SDoc -> IO ()
305 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
307 pprCode :: CodeStyle -> SDoc -> SDoc
308 pprCode cs d = withPprStyle (PprCode cs) d
310 mkCodeStyle :: CodeStyle -> PprStyle
311 mkCodeStyle = PprCode
313 -- Can't make SDoc an instance of Show because SDoc is just a function type
314 -- However, Doc *is* an instance of Show
315 -- showSDoc just blasts it out as a string
316 showSDoc :: SDoc -> String
317 showSDoc d = show (d defaultUserStyle)
319 showSDocForUser :: PrintUnqualified -> SDoc -> String
320 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
322 showSDocUnqual :: SDoc -> String
323 -- Only used in the gruesome isOperator
324 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
326 showsPrecSDoc :: Int -> SDoc -> ShowS
327 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
329 showSDocDump :: SDoc -> String
330 showSDocDump d = show (d PprDump)
332 showSDocDebug :: SDoc -> String
333 showSDocDebug d = show (d PprDebug)
337 docToSDoc :: Doc -> SDoc
338 docToSDoc d = \_ -> d
342 text :: String -> SDoc
343 ftext :: FastString -> SDoc
344 ptext :: LitString -> SDoc
346 integer :: Integer -> SDoc
347 float :: Float -> SDoc
348 double :: Double -> SDoc
349 rational :: Rational -> SDoc
351 empty _sty = Pretty.empty
352 char c _sty = Pretty.char c
353 text s _sty = Pretty.text s
354 ftext s _sty = Pretty.ftext s
355 ptext s _sty = Pretty.ptext s
356 int n _sty = Pretty.int n
357 integer n _sty = Pretty.integer n
358 float n _sty = Pretty.float n
359 double n _sty = Pretty.double n
360 rational n _sty = Pretty.rational n
362 parens, braces, brackets, quotes, doubleQuotes, angleBrackets :: SDoc -> SDoc
364 parens d sty = Pretty.parens (d sty)
365 braces d sty = Pretty.braces (d sty)
366 brackets d sty = Pretty.brackets (d sty)
367 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
368 angleBrackets d = char '<' <> d <> char '>'
370 cparen :: Bool -> SDoc -> SDoc
372 cparen b d sty = Pretty.cparen b (d sty)
374 -- quotes encloses something in single quotes...
375 -- but it omits them if the thing ends in a single quote
376 -- so that we don't get `foo''. Instead we just have foo'.
377 quotes d sty = case show pp_d of
379 _other -> Pretty.quotes pp_d
383 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
384 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
386 semi _sty = Pretty.semi
387 comma _sty = Pretty.comma
388 colon _sty = Pretty.colon
389 equals _sty = Pretty.equals
390 space _sty = Pretty.space
391 dcolon _sty = Pretty.ptext (sLit "::")
392 arrow _sty = Pretty.ptext (sLit "->")
393 underscore = char '_'
395 lparen _sty = Pretty.lparen
396 rparen _sty = Pretty.rparen
397 lbrack _sty = Pretty.lbrack
398 rbrack _sty = Pretty.rbrack
399 lbrace _sty = Pretty.lbrace
400 rbrace _sty = Pretty.rbrace
402 nest :: Int -> SDoc -> SDoc
403 -- ^ Indent 'SDoc' some specified amount
404 (<>) :: SDoc -> SDoc -> SDoc
405 -- ^ Join two 'SDoc' together horizontally without a gap
406 (<+>) :: SDoc -> SDoc -> SDoc
407 -- ^ Join two 'SDoc' together horizontally with a gap between them
408 ($$) :: SDoc -> SDoc -> SDoc
409 -- ^ Join two 'SDoc' together vertically; if there is
410 -- no vertical overlap it "dovetails" the two onto one line
411 ($+$) :: SDoc -> SDoc -> SDoc
412 -- ^ Join two 'SDoc' together vertically
414 nest n d sty = Pretty.nest n (d sty)
415 (<>) d1 d2 sty = (Pretty.<>) (d1 sty) (d2 sty)
416 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
417 ($$) d1 d2 sty = (Pretty.$$) (d1 sty) (d2 sty)
418 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
420 hcat :: [SDoc] -> SDoc
421 -- ^ Concatenate 'SDoc' horizontally
422 hsep :: [SDoc] -> SDoc
423 -- ^ Concatenate 'SDoc' horizontally with a space between each one
424 vcat :: [SDoc] -> SDoc
425 -- ^ Concatenate 'SDoc' vertically with dovetailing
426 sep :: [SDoc] -> SDoc
427 -- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
428 cat :: [SDoc] -> SDoc
429 -- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits
430 fsep :: [SDoc] -> SDoc
431 -- ^ A paragraph-fill combinator. It's much like sep, only it
432 -- keeps fitting things on one line until it can't fit any more.
433 fcat :: [SDoc] -> SDoc
434 -- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'
437 hcat ds sty = Pretty.hcat [d sty | d <- ds]
438 hsep ds sty = Pretty.hsep [d sty | d <- ds]
439 vcat ds sty = Pretty.vcat [d sty | d <- ds]
440 sep ds sty = Pretty.sep [d sty | d <- ds]
441 cat ds sty = Pretty.cat [d sty | d <- ds]
442 fsep ds sty = Pretty.fsep [d sty | d <- ds]
443 fcat ds sty = Pretty.fcat [d sty | d <- ds]
445 hang :: SDoc -- ^ The header
446 -> Int -- ^ Amount to indent the hung body
447 -> SDoc -- ^ The hung body, indented and placed below the header
449 hang d1 n d2 sty = Pretty.hang (d1 sty) n (d2 sty)
451 punctuate :: SDoc -- ^ The punctuation
452 -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
453 -> [SDoc] -- ^ Punctuated list
455 punctuate p (d:ds) = go d ds
458 go d (e:es) = (d <> p) : go e es
462 %************************************************************************
464 \subsection[Outputable-class]{The @Outputable@ class}
466 %************************************************************************
469 -- | Class designating that some type has an 'SDoc' representation
470 class Outputable a where
475 instance Outputable Bool where
476 ppr True = ptext (sLit "True")
477 ppr False = ptext (sLit "False")
479 instance Outputable Int where
482 instance Outputable Word32 where
483 ppr n = integer $ fromIntegral n
485 instance Outputable () where
488 instance (Outputable a) => Outputable [a] where
489 ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
491 instance (Outputable a, Outputable b) => Outputable (a, b) where
492 ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
494 instance Outputable a => Outputable (Maybe a) where
495 ppr Nothing = ptext (sLit "Nothing")
496 ppr (Just x) = ptext (sLit "Just") <+> ppr x
498 instance (Outputable a, Outputable b) => Outputable (Either a b) where
499 ppr (Left x) = ptext (sLit "Left") <+> ppr x
500 ppr (Right y) = ptext (sLit "Right") <+> ppr y
502 -- ToDo: may not be used
503 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
505 parens (sep [ppr x <> comma,
509 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
510 Outputable (a, b, c, d) where
512 parens (sep [ppr a <> comma,
517 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
518 Outputable (a, b, c, d, e) where
520 parens (sep [ppr a <> comma,
526 instance Outputable FastString where
527 ppr fs = ftext fs -- Prints an unadorned string,
528 -- no double quotes or anything
531 %************************************************************************
533 \subsection{The @OutputableBndr@ class}
535 %************************************************************************
538 -- | 'BindingSite' is used to tell the thing that prints binder what
539 -- language construct is binding the identifier. This can be used
540 -- to decide how much info to print.
541 data BindingSite = LambdaBind | CaseBind | LetBind
543 -- | When we print a binder, we often want to print its type too.
544 -- The @OutputableBndr@ class encapsulates this idea.
545 class Outputable a => OutputableBndr a where
546 pprBndr :: BindingSite -> a -> SDoc
550 %************************************************************************
552 \subsection{Random printing helpers}
554 %************************************************************************
557 -- We have 31-bit Chars and will simply use Show instances of Char and String.
559 -- | Special combinator for showing character literals.
560 pprHsChar :: Char -> SDoc
561 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
562 | otherwise = text (show c)
564 -- | Special combinator for showing string literals.
565 pprHsString :: FastString -> SDoc
566 pprHsString fs = text (show (unpackFS fs))
568 ---------------------
569 -- Put a name in parens if it's an operator
570 pprPrefixVar :: Bool -> SDoc -> SDoc
571 pprPrefixVar is_operator pp_v
572 | is_operator = parens pp_v
575 -- Put a name in backquotes if it's not an operator
576 pprInfixVar :: Bool -> SDoc -> SDoc
577 pprInfixVar is_operator pp_v
579 | otherwise = char '`' <> pp_v <> char '`'
581 ---------------------
582 -- pprHsVar and pprHsInfix use the gruesome isOperator, which
583 -- in turn uses (showSDoc (ppr v)), rather than isSymOcc (getOccName v).
584 -- Reason: it means that pprHsVar doesn't need a NamedThing context,
585 -- which none of the HsSyn printing functions do
586 pprHsVar, pprHsInfix :: Outputable name => name -> SDoc
587 pprHsVar v = pprPrefixVar (isOperator pp_v) pp_v
589 pprHsInfix v = pprInfixVar (isOperator pp_v) pp_v
592 isOperator :: SDoc -> Bool
594 = case showSDocUnqual ppr_v of
595 ('(':_) -> False -- (), (,) etc
596 ('[':_) -> False -- []
597 ('$':c:_) -> not (isAlpha c) -- Don't treat $d as an operator
598 (':':c:_) -> not (isAlpha c) -- Don't treat :T as an operator
599 ('_':_) -> False -- Not an operator
600 (c:_) -> not (isAlpha c) -- Starts with non-alpha
604 %************************************************************************
606 \subsection{Other helper functions}
608 %************************************************************************
611 pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use
612 -> [a] -- ^ The things to be pretty printed
613 -> SDoc -- ^ 'SDoc' where the things have been pretty printed,
614 -- comma-separated and finally packed into a paragraph.
615 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
617 -- | Returns the seperated concatenation of the pretty printed things.
618 interppSP :: Outputable a => [a] -> SDoc
619 interppSP xs = sep (map ppr xs)
621 -- | Returns the comma-seperated concatenation of the pretty printed things.
622 interpp'SP :: Outputable a => [a] -> SDoc
623 interpp'SP xs = sep (punctuate comma (map ppr xs))
625 -- | Returns the comma-seperated concatenation of the quoted pretty printed things.
627 -- > [x,y,z] ==> `x', `y', `z'
628 pprQuotedList :: Outputable a => [a] -> SDoc
629 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
633 %************************************************************************
635 \subsection{Printing numbers verbally}
637 %************************************************************************
640 -- | Converts an integer to a verbal index:
642 -- > speakNth 1 = text "first"
643 -- > speakNth 5 = text "fifth"
644 -- > speakNth 21 = text "21st"
645 speakNth :: Int -> SDoc
646 speakNth 1 = ptext (sLit "first")
647 speakNth 2 = ptext (sLit "second")
648 speakNth 3 = ptext (sLit "third")
649 speakNth 4 = ptext (sLit "fourth")
650 speakNth 5 = ptext (sLit "fifth")
651 speakNth 6 = ptext (sLit "sixth")
652 speakNth n = hcat [ int n, text suffix ]
654 suffix | n <= 20 = "th" -- 11,12,13 are non-std
655 | last_dig == 1 = "st"
656 | last_dig == 2 = "nd"
657 | last_dig == 3 = "rd"
660 last_dig = n `rem` 10
662 -- | Converts an integer to a verbal multiplicity:
664 -- > speakN 0 = text "none"
665 -- > speakN 5 = text "five"
666 -- > speakN 10 = text "10"
667 speakN :: Int -> SDoc
668 speakN 0 = ptext (sLit "none") -- E.g. "he has none"
669 speakN 1 = ptext (sLit "one") -- E.g. "he has one"
670 speakN 2 = ptext (sLit "two")
671 speakN 3 = ptext (sLit "three")
672 speakN 4 = ptext (sLit "four")
673 speakN 5 = ptext (sLit "five")
674 speakN 6 = ptext (sLit "six")
677 -- | Converts an integer and object description to a statement about the
678 -- multiplicity of those objects:
680 -- > speakNOf 0 (text "melon") = text "no melons"
681 -- > speakNOf 1 (text "melon") = text "one melon"
682 -- > speakNOf 3 (text "melon") = text "three melons"
683 speakNOf :: Int -> SDoc -> SDoc
684 speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'
685 speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument"
686 speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
688 -- | Converts a strictly positive integer into a number of times:
690 -- > speakNTimes 1 = text "once"
691 -- > speakNTimes 2 = text "twice"
692 -- > speakNTimes 4 = text "4 times"
693 speakNTimes :: Int {- >=1 -} -> SDoc
694 speakNTimes t | t == 1 = ptext (sLit "once")
695 | t == 2 = ptext (sLit "twice")
696 | otherwise = speakN t <+> ptext (sLit "times")
698 -- | Determines the pluralisation suffix appropriate for the length of a list:
700 -- > plural [] = char 's'
701 -- > plural ["Hello"] = empty
702 -- > plural ["Hello", "World"] = char 's'
703 plural :: [a] -> SDoc
704 plural [_] = empty -- a bit frightening, but there you are
709 %************************************************************************
711 \subsection{Error handling}
713 %************************************************************************
716 pprPanic :: String -> SDoc -> a
717 -- ^ Throw an exception saying "bug in GHC"
718 pprPgmError :: String -> SDoc -> a
719 -- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
720 pprTrace :: String -> SDoc -> a -> a
721 -- ^ If debug output is on, show some 'SDoc' on the screen
723 pprPanic = pprAndThen panic
725 pprPgmError = pprAndThen pgmError
728 | opt_NoDebugOutput = x
729 | otherwise = pprAndThen trace str doc x
731 pprPanicFastInt :: String -> SDoc -> FastInt
732 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
733 pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
735 doc = text heading <+> pretty_msg
737 pprAndThen :: (String -> a) -> String -> SDoc -> a
738 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
740 doc = sep [text heading, nest 4 pretty_msg]
742 assertPprPanic :: String -> Int -> SDoc -> a
743 -- ^ Panic with an assertation failure, recording the given file and line number.
744 -- Should typically be accessed with the ASSERT family of macros
745 assertPprPanic file line msg
746 = panic (show (doc PprDebug))
748 doc = sep [hsep[text "ASSERT failed! file",
750 text "line", int line],
753 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
754 -- ^ Just warn about an assertion failure, recording the given file and line number.
755 -- Should typically be accessed with the WARN macros
756 warnPprTrace _ _file _line _msg x | opt_NoDebugOutput = x
757 warnPprTrace False _file _line _msg x = x
758 warnPprTrace True file line msg x
759 = trace (show (doc PprDebug)) x
761 doc = sep [hsep [text "WARNING: file", text file, text "line", int line],