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, showPpr,
40 showSDocUnqual, showsPrecSDoc,
42 pprInfixVar, pprPrefixVar,
43 pprHsChar, pprHsString, pprHsInfix, pprHsVar,
46 -- * Controlling the style in which output is printed
49 PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
51 getPprStyle, withPprStyle, withPprStyleDoc,
52 pprDeeper, pprDeeperList, pprSetDepth,
53 codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
54 ifPprDebug, qualName, qualModule,
55 mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
56 mkUserStyle, Depth(..),
58 -- * Error handling and debugging utilities
59 pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError,
60 pprTrace, warnPprTrace,
61 trace, pgmError, panic, panicFastInt, assertPanic
64 import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
65 import {-# SOURCE #-} OccName( OccName )
70 import qualified Pretty
71 import Pretty ( Doc, Mode(..) )
72 import Char ( isAlpha )
75 import Data.Word ( Word32 )
76 import System.IO ( Handle, stderr, stdout, hFlush )
77 import Data.Char ( ord )
78 import System.FilePath
82 %************************************************************************
84 \subsection{The @PprStyle@ data type}
86 %************************************************************************
91 = PprUser PrintUnqualified Depth
92 -- Pretty-print in a way that will make sense to the
93 -- ordinary user; must be very close to Haskell
95 -- Assumes printing tidied code: non-system names are
96 -- printed without uniques.
99 -- Print code; either C or assembler
101 | PprDump -- For -ddump-foo; less verbose than PprDebug.
102 -- Does not assume tidied code: non-external names
103 -- are printed with uniques.
105 | PprDebug -- Full debugging output
107 data CodeStyle = CStyle -- The format of labels differs for C and assembler
110 data Depth = AllTheWay
111 | PartWay Int -- 0 => stop
114 -- -----------------------------------------------------------------------------
115 -- Printing original names
117 -- When printing code that contains original names, we need to map the
118 -- original names back to something the user understands. This is the
119 -- purpose of the pair of functions that gets passed around
120 -- when rendering 'SDoc'.
122 -- | given an /original/ name, this function tells you which module
123 -- name it should be qualified with when printing for the user, if
124 -- any. For example, given @Control.Exception.catch@, which is in scope
125 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
126 -- Note that the return value is a ModuleName, not a Module, because
127 -- in source code, names are qualified by ModuleNames.
128 type QueryQualifyName = Module -> OccName -> QualifyName
130 data QualifyName -- given P:M.T
131 = NameUnqual -- refer to it as "T"
132 | NameQual ModuleName -- refer to it as "X.T" for the supplied X
134 -- it is not in scope at all, but M.T is not bound in the current
135 -- scope, so we can refer to it as "M.T"
137 -- it is not in scope at all, and M.T is already bound in the
138 -- current scope, so we must refer to it as "P:M.T"
141 -- | For a given module, we need to know whether to print it with
142 -- a package name to disambiguate it.
143 type QueryQualifyModule = Module -> Bool
145 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
147 alwaysQualifyNames :: QueryQualifyName
148 alwaysQualifyNames m _ = NameQual (moduleName m)
150 neverQualifyNames :: QueryQualifyName
151 neverQualifyNames _ _ = NameUnqual
153 alwaysQualifyModules :: QueryQualifyModule
154 alwaysQualifyModules _ = True
156 neverQualifyModules :: QueryQualifyModule
157 neverQualifyModules _ = False
159 alwaysQualify, neverQualify :: PrintUnqualified
160 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
161 neverQualify = (neverQualifyNames, neverQualifyModules)
163 defaultUserStyle, defaultDumpStyle :: PprStyle
165 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
167 defaultDumpStyle | opt_PprStyle_Debug = PprDebug
168 | otherwise = PprDump
170 -- | Style for printing error messages
171 mkErrStyle :: PrintUnqualified -> PprStyle
172 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
174 defaultErrStyle :: PprStyle
175 -- Default style for error messages
176 -- It's a bit of a hack because it doesn't take into account what's in scope
177 -- Only used for desugarer warnings, and typechecker errors in interface sigs
179 | opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay
180 | otherwise = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
182 mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
183 mkUserStyle unqual depth
184 | opt_PprStyle_Debug = PprDebug
185 | otherwise = PprUser unqual depth
188 Orthogonal to the above printing styles are (possibly) some
189 command-line flags that affect printing (often carried with the
190 style). The most likely ones are variations on how much type info is
193 The following test decides whether or not we are actually generating
194 code (either C or assembly), or generating interface files.
196 %************************************************************************
198 \subsection{The @SDoc@ data type}
200 %************************************************************************
203 type SDoc = PprStyle -> Doc
205 withPprStyle :: PprStyle -> SDoc -> SDoc
206 withPprStyle sty d _sty' = d sty
208 withPprStyleDoc :: PprStyle -> SDoc -> Doc
209 withPprStyleDoc sty d = d sty
211 pprDeeper :: SDoc -> SDoc
212 pprDeeper _ (PprUser _ (PartWay 0)) = Pretty.text "..."
213 pprDeeper d (PprUser q (PartWay n)) = d (PprUser q (PartWay (n-1)))
214 pprDeeper d other_sty = d other_sty
216 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
217 -- Truncate a list that list that is longer than the current depth
218 pprDeeperList f ds (PprUser q (PartWay n))
219 | n==0 = Pretty.text "..."
220 | otherwise = f (go 0 ds) (PprUser q (PartWay (n-1)))
223 go i (d:ds) | i >= n = [text "...."]
224 | otherwise = d : go (i+1) ds
226 pprDeeperList f ds other_sty
229 pprSetDepth :: Int -> SDoc -> SDoc
230 pprSetDepth n d (PprUser q _) = d (PprUser q (PartWay n))
231 pprSetDepth _n d other_sty = d other_sty
233 getPprStyle :: (PprStyle -> SDoc) -> SDoc
234 getPprStyle df sty = df sty sty
238 qualName :: PprStyle -> QueryQualifyName
239 qualName (PprUser (qual_name,_) _) m n = qual_name m n
240 qualName _other m _n = NameQual (moduleName m)
242 qualModule :: PprStyle -> QueryQualifyModule
243 qualModule (PprUser (_,qual_mod) _) m = qual_mod m
244 qualModule _other _m = True
246 codeStyle :: PprStyle -> Bool
247 codeStyle (PprCode _) = True
250 asmStyle :: PprStyle -> Bool
251 asmStyle (PprCode AsmStyle) = True
252 asmStyle _other = False
254 dumpStyle :: PprStyle -> Bool
255 dumpStyle PprDump = True
256 dumpStyle _other = False
258 debugStyle :: PprStyle -> Bool
259 debugStyle PprDebug = True
260 debugStyle _other = False
262 userStyle :: PprStyle -> Bool
263 userStyle (PprUser _ _) = True
264 userStyle _other = False
266 ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
267 ifPprDebug d sty@PprDebug = d sty
268 ifPprDebug _ _ = Pretty.empty
273 printSDoc :: SDoc -> PprStyle -> IO ()
275 Pretty.printDoc PageMode stdout (d sty)
278 -- I'm not sure whether the direct-IO approach of Pretty.printDoc
279 -- above is better or worse than the put-big-string approach here
280 printErrs :: Doc -> IO ()
281 printErrs doc = do Pretty.printDoc PageMode stderr doc
284 printDump :: SDoc -> IO ()
285 printDump doc = hPrintDump stdout doc
287 hPrintDump :: Handle -> SDoc -> IO ()
288 hPrintDump h doc = do
289 Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
292 better_doc = doc $$ text ""
294 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
295 printForUser handle unqual doc
296 = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
298 printForUserPartWay :: Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
299 printForUserPartWay handle d unqual doc
300 = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual (PartWay d)))
302 -- printForC, printForAsm do what they sound like
303 printForC :: Handle -> SDoc -> IO ()
304 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
306 printForAsm :: Handle -> SDoc -> IO ()
307 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
309 pprCode :: CodeStyle -> SDoc -> SDoc
310 pprCode cs d = withPprStyle (PprCode cs) d
312 mkCodeStyle :: CodeStyle -> PprStyle
313 mkCodeStyle = PprCode
315 -- Can't make SDoc an instance of Show because SDoc is just a function type
316 -- However, Doc *is* an instance of Show
317 -- showSDoc just blasts it out as a string
318 showSDoc :: SDoc -> String
319 showSDoc d = show (d defaultUserStyle)
321 showSDocForUser :: PrintUnqualified -> SDoc -> String
322 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
324 showSDocUnqual :: SDoc -> String
325 -- Only used in the gruesome isOperator
326 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
328 showsPrecSDoc :: Int -> SDoc -> ShowS
329 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
331 showSDocDump :: SDoc -> String
332 showSDocDump d = show (d PprDump)
334 showSDocDebug :: SDoc -> String
335 showSDocDebug d = show (d PprDebug)
337 showPpr :: Outputable a => a -> String
338 showPpr = showSDoc . ppr
342 docToSDoc :: Doc -> SDoc
343 docToSDoc d = \_ -> d
347 text :: String -> SDoc
348 ftext :: FastString -> SDoc
349 ptext :: LitString -> SDoc
351 integer :: Integer -> SDoc
352 float :: Float -> SDoc
353 double :: Double -> SDoc
354 rational :: Rational -> SDoc
356 empty _sty = Pretty.empty
357 char c _sty = Pretty.char c
358 text s _sty = Pretty.text s
359 ftext s _sty = Pretty.ftext s
360 ptext s _sty = Pretty.ptext s
361 int n _sty = Pretty.int n
362 integer n _sty = Pretty.integer n
363 float n _sty = Pretty.float n
364 double n _sty = Pretty.double n
365 rational n _sty = Pretty.rational n
367 parens, braces, brackets, quotes, doubleQuotes, angleBrackets :: SDoc -> SDoc
369 parens d sty = Pretty.parens (d sty)
370 braces d sty = Pretty.braces (d sty)
371 brackets d sty = Pretty.brackets (d sty)
372 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
373 angleBrackets d = char '<' <> d <> char '>'
375 cparen :: Bool -> SDoc -> SDoc
377 cparen b d sty = Pretty.cparen b (d sty)
379 -- quotes encloses something in single quotes...
380 -- but it omits them if the thing ends in a single quote
381 -- so that we don't get `foo''. Instead we just have foo'.
382 quotes d sty = case show pp_d of
384 _other -> Pretty.quotes pp_d
388 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
389 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
391 semi _sty = Pretty.semi
392 comma _sty = Pretty.comma
393 colon _sty = Pretty.colon
394 equals _sty = Pretty.equals
395 space _sty = Pretty.space
396 dcolon _sty = Pretty.ptext (sLit "::")
397 arrow _sty = Pretty.ptext (sLit "->")
398 underscore = char '_'
400 lparen _sty = Pretty.lparen
401 rparen _sty = Pretty.rparen
402 lbrack _sty = Pretty.lbrack
403 rbrack _sty = Pretty.rbrack
404 lbrace _sty = Pretty.lbrace
405 rbrace _sty = Pretty.rbrace
407 nest :: Int -> SDoc -> SDoc
408 -- ^ Indent 'SDoc' some specified amount
409 (<>) :: SDoc -> SDoc -> SDoc
410 -- ^ Join two 'SDoc' together horizontally without a gap
411 (<+>) :: SDoc -> SDoc -> SDoc
412 -- ^ Join two 'SDoc' together horizontally with a gap between them
413 ($$) :: SDoc -> SDoc -> SDoc
414 -- ^ Join two 'SDoc' together vertically; if there is
415 -- no vertical overlap it "dovetails" the two onto one line
416 ($+$) :: SDoc -> SDoc -> SDoc
417 -- ^ Join two 'SDoc' together vertically
419 nest n d sty = Pretty.nest n (d sty)
420 (<>) d1 d2 sty = (Pretty.<>) (d1 sty) (d2 sty)
421 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
422 ($$) d1 d2 sty = (Pretty.$$) (d1 sty) (d2 sty)
423 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
425 hcat :: [SDoc] -> SDoc
426 -- ^ Concatenate 'SDoc' horizontally
427 hsep :: [SDoc] -> SDoc
428 -- ^ Concatenate 'SDoc' horizontally with a space between each one
429 vcat :: [SDoc] -> SDoc
430 -- ^ Concatenate 'SDoc' vertically with dovetailing
431 sep :: [SDoc] -> SDoc
432 -- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
433 cat :: [SDoc] -> SDoc
434 -- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits
435 fsep :: [SDoc] -> SDoc
436 -- ^ A paragraph-fill combinator. It's much like sep, only it
437 -- keeps fitting things on one line until it can't fit any more.
438 fcat :: [SDoc] -> SDoc
439 -- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'
442 hcat ds sty = Pretty.hcat [d sty | d <- ds]
443 hsep ds sty = Pretty.hsep [d sty | d <- ds]
444 vcat ds sty = Pretty.vcat [d sty | d <- ds]
445 sep ds sty = Pretty.sep [d sty | d <- ds]
446 cat ds sty = Pretty.cat [d sty | d <- ds]
447 fsep ds sty = Pretty.fsep [d sty | d <- ds]
448 fcat ds sty = Pretty.fcat [d sty | d <- ds]
450 hang :: SDoc -- ^ The header
451 -> Int -- ^ Amount to indent the hung body
452 -> SDoc -- ^ The hung body, indented and placed below the header
454 hang d1 n d2 sty = Pretty.hang (d1 sty) n (d2 sty)
456 punctuate :: SDoc -- ^ The punctuation
457 -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
458 -> [SDoc] -- ^ Punctuated list
460 punctuate p (d:ds) = go d ds
463 go d (e:es) = (d <> p) : go e es
467 %************************************************************************
469 \subsection[Outputable-class]{The @Outputable@ class}
471 %************************************************************************
474 -- | Class designating that some type has an 'SDoc' representation
475 class Outputable a where
480 instance Outputable Bool where
481 ppr True = ptext (sLit "True")
482 ppr False = ptext (sLit "False")
484 instance Outputable Int where
487 instance Outputable Word32 where
488 ppr n = integer $ fromIntegral n
490 instance Outputable () where
493 instance (Outputable a) => Outputable [a] where
494 ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
496 instance (Outputable a, Outputable b) => Outputable (a, b) where
497 ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
499 instance Outputable a => Outputable (Maybe a) where
500 ppr Nothing = ptext (sLit "Nothing")
501 ppr (Just x) = ptext (sLit "Just") <+> ppr x
503 instance (Outputable a, Outputable b) => Outputable (Either a b) where
504 ppr (Left x) = ptext (sLit "Left") <+> ppr x
505 ppr (Right y) = ptext (sLit "Right") <+> ppr y
507 -- ToDo: may not be used
508 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
510 parens (sep [ppr x <> comma,
514 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
515 Outputable (a, b, c, d) where
517 parens (sep [ppr a <> comma,
522 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
523 Outputable (a, b, c, d, e) where
525 parens (sep [ppr a <> comma,
531 instance Outputable FastString where
532 ppr fs = ftext fs -- Prints an unadorned string,
533 -- no double quotes or anything
536 %************************************************************************
538 \subsection{The @OutputableBndr@ class}
540 %************************************************************************
543 -- | 'BindingSite' is used to tell the thing that prints binder what
544 -- language construct is binding the identifier. This can be used
545 -- to decide how much info to print.
546 data BindingSite = LambdaBind | CaseBind | LetBind
548 -- | When we print a binder, we often want to print its type too.
549 -- The @OutputableBndr@ class encapsulates this idea.
550 class Outputable a => OutputableBndr a where
551 pprBndr :: BindingSite -> a -> SDoc
555 %************************************************************************
557 \subsection{Random printing helpers}
559 %************************************************************************
562 -- We have 31-bit Chars and will simply use Show instances of Char and String.
564 -- | Special combinator for showing character literals.
565 pprHsChar :: Char -> SDoc
566 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
567 | otherwise = text (show c)
569 -- | Special combinator for showing string literals.
570 pprHsString :: FastString -> SDoc
571 pprHsString fs = text (show (unpackFS fs))
573 ---------------------
574 -- Put a name in parens if it's an operator
575 pprPrefixVar :: Bool -> SDoc -> SDoc
576 pprPrefixVar is_operator pp_v
577 | is_operator = parens pp_v
580 -- Put a name in backquotes if it's not an operator
581 pprInfixVar :: Bool -> SDoc -> SDoc
582 pprInfixVar is_operator pp_v
584 | otherwise = char '`' <> pp_v <> char '`'
586 ---------------------
587 -- pprHsVar and pprHsInfix use the gruesome isOperator, which
588 -- in turn uses (showSDoc (ppr v)), rather than isSymOcc (getOccName v).
589 -- Reason: it means that pprHsVar doesn't need a NamedThing context,
590 -- which none of the HsSyn printing functions do
591 pprHsVar, pprHsInfix :: Outputable name => name -> SDoc
592 pprHsVar v = pprPrefixVar (isOperator pp_v) pp_v
594 pprHsInfix v = pprInfixVar (isOperator pp_v) pp_v
597 isOperator :: SDoc -> Bool
599 = case showSDocUnqual ppr_v of
600 ('(':_) -> False -- (), (,) etc
601 ('[':_) -> False -- []
602 ('$':c:_) -> not (isAlpha c) -- Don't treat $d as an operator
603 (':':c:_) -> not (isAlpha c) -- Don't treat :T as an operator
604 ('_':_) -> False -- Not an operator
605 (c:_) -> not (isAlpha c) -- Starts with non-alpha
608 pprFastFilePath :: FastString -> SDoc
609 pprFastFilePath path = text $ normalise $ unpackFS path
612 %************************************************************************
614 \subsection{Other helper functions}
616 %************************************************************************
619 pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use
620 -> [a] -- ^ The things to be pretty printed
621 -> SDoc -- ^ 'SDoc' where the things have been pretty printed,
622 -- comma-separated and finally packed into a paragraph.
623 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
625 -- | Returns the seperated concatenation of the pretty printed things.
626 interppSP :: Outputable a => [a] -> SDoc
627 interppSP xs = sep (map ppr xs)
629 -- | Returns the comma-seperated concatenation of the pretty printed things.
630 interpp'SP :: Outputable a => [a] -> SDoc
631 interpp'SP xs = sep (punctuate comma (map ppr xs))
633 -- | Returns the comma-seperated concatenation of the quoted pretty printed things.
635 -- > [x,y,z] ==> `x', `y', `z'
636 pprQuotedList :: Outputable a => [a] -> SDoc
637 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
641 %************************************************************************
643 \subsection{Printing numbers verbally}
645 %************************************************************************
648 -- | Converts an integer to a verbal index:
650 -- > speakNth 1 = text "first"
651 -- > speakNth 5 = text "fifth"
652 -- > speakNth 21 = text "21st"
653 speakNth :: Int -> SDoc
654 speakNth 1 = ptext (sLit "first")
655 speakNth 2 = ptext (sLit "second")
656 speakNth 3 = ptext (sLit "third")
657 speakNth 4 = ptext (sLit "fourth")
658 speakNth 5 = ptext (sLit "fifth")
659 speakNth 6 = ptext (sLit "sixth")
660 speakNth n = hcat [ int n, text suffix ]
662 suffix | n <= 20 = "th" -- 11,12,13 are non-std
663 | last_dig == 1 = "st"
664 | last_dig == 2 = "nd"
665 | last_dig == 3 = "rd"
668 last_dig = n `rem` 10
670 -- | Converts an integer to a verbal multiplicity:
672 -- > speakN 0 = text "none"
673 -- > speakN 5 = text "five"
674 -- > speakN 10 = text "10"
675 speakN :: Int -> SDoc
676 speakN 0 = ptext (sLit "none") -- E.g. "he has none"
677 speakN 1 = ptext (sLit "one") -- E.g. "he has one"
678 speakN 2 = ptext (sLit "two")
679 speakN 3 = ptext (sLit "three")
680 speakN 4 = ptext (sLit "four")
681 speakN 5 = ptext (sLit "five")
682 speakN 6 = ptext (sLit "six")
685 -- | Converts an integer and object description to a statement about the
686 -- multiplicity of those objects:
688 -- > speakNOf 0 (text "melon") = text "no melons"
689 -- > speakNOf 1 (text "melon") = text "one melon"
690 -- > speakNOf 3 (text "melon") = text "three melons"
691 speakNOf :: Int -> SDoc -> SDoc
692 speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'
693 speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument"
694 speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
696 -- | Converts a strictly positive integer into a number of times:
698 -- > speakNTimes 1 = text "once"
699 -- > speakNTimes 2 = text "twice"
700 -- > speakNTimes 4 = text "4 times"
701 speakNTimes :: Int {- >=1 -} -> SDoc
702 speakNTimes t | t == 1 = ptext (sLit "once")
703 | t == 2 = ptext (sLit "twice")
704 | otherwise = speakN t <+> ptext (sLit "times")
706 -- | Determines the pluralisation suffix appropriate for the length of a list:
708 -- > plural [] = char 's'
709 -- > plural ["Hello"] = empty
710 -- > plural ["Hello", "World"] = char 's'
711 plural :: [a] -> SDoc
712 plural [_] = empty -- a bit frightening, but there you are
717 %************************************************************************
719 \subsection{Error handling}
721 %************************************************************************
724 pprPanic :: String -> SDoc -> a
725 -- ^ Throw an exception saying "bug in GHC"
726 pprPgmError :: String -> SDoc -> a
727 -- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
728 pprTrace :: String -> SDoc -> a -> a
729 -- ^ If debug output is on, show some 'SDoc' on the screen
731 pprPanic = pprAndThen panic
733 pprPgmError = pprAndThen pgmError
736 | opt_NoDebugOutput = x
737 | otherwise = pprAndThen trace str doc x
739 pprPanicFastInt :: String -> SDoc -> FastInt
740 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
741 pprPanicFastInt heading pretty_msg = panicFastInt (show (doc PprDebug))
743 doc = text heading <+> pretty_msg
745 pprAndThen :: (String -> a) -> String -> SDoc -> a
746 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
748 doc = sep [text heading, nest 4 pretty_msg]
750 assertPprPanic :: String -> Int -> SDoc -> a
751 -- ^ Panic with an assertation failure, recording the given file and line number.
752 -- Should typically be accessed with the ASSERT family of macros
753 assertPprPanic file line msg
754 = panic (show (doc PprDebug))
756 doc = sep [hsep[text "ASSERT failed! file",
758 text "line", int line],
761 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
762 -- ^ Just warn about an assertion failure, recording the given file and line number.
763 -- Should typically be accessed with the WARN macros
764 warnPprTrace _ _file _line _msg x | opt_NoDebugOutput = x
765 warnPprTrace False _file _line _msg x = x
766 warnPprTrace True file line msg x
767 = trace (show (doc PprDebug)) x
769 doc = sep [hsep [text "WARNING: file", text file, text "line", int line],