Implement unboxed sum primitive type
[ghc.git] / compiler / utils / Outputable.hs
1 {-# LANGUAGE CPP, ImplicitParams #-}
2 {-
3 (c) The University of Glasgow 2006-2012
4 (c) The GRASP Project, Glasgow University, 1992-1998
5 -}
6
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'.
9 --
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.
13 module Outputable (
14 -- * Type classes
15 Outputable(..), OutputableBndr(..),
16
17 -- * Pretty printing combinators
18 SDoc, runSDoc, initSDocContext,
19 docToSDoc,
20 interppSP, interpp'SP,
21 pprQuotedList, pprWithCommas, quotedListWithOr, quotedListWithNor,
22 pprWithBars,
23 empty, isEmpty, nest,
24 char,
25 text, ftext, ptext, ztext,
26 int, intWithCommas, integer, float, double, rational, doublePrec,
27 parens, cparen, brackets, braces, quotes, quote,
28 doubleQuotes, angleBrackets, paBrackets,
29 semi, comma, colon, dcolon, space, equals, dot, vbar,
30 arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
31 lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
32 blankLine, forAllLit,
33 (<>), (<+>), hcat, hsep,
34 ($$), ($+$), vcat,
35 sep, cat,
36 fsep, fcat,
37 hang, hangNotEmpty, punctuate, ppWhen, ppUnless,
38 speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes,
39 unicodeSyntax,
40
41 coloured, PprColour, colType, colCoerc, colDataCon,
42 colBinder, bold, keyword,
43
44 -- * Converting 'SDoc' into strings and outputing it
45 printForC, printForAsm, printForUser, printForUserPartWay,
46 pprCode, mkCodeStyle,
47 showSDoc, showSDocUnsafe, showSDocOneLine,
48 showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine,
49 showSDocUnqual, showPpr,
50 renderWithStyle,
51
52 pprInfixVar, pprPrefixVar,
53 pprHsChar, pprHsString, pprHsBytes,
54
55 primFloatSuffix, primDoubleSuffix,
56 pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
57
58 pprFastFilePath,
59
60 -- * Controlling the style in which output is printed
61 BindingSite(..),
62
63 PprStyle, CodeStyle(..), PrintUnqualified(..),
64 QueryQualifyName, QueryQualifyModule, QueryQualifyPackage,
65 reallyAlwaysQualify, reallyAlwaysQualifyNames,
66 alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
67 neverQualify, neverQualifyNames, neverQualifyModules,
68 alwaysQualifyPackages, neverQualifyPackages,
69 QualifyName(..), queryQual,
70 sdocWithDynFlags, sdocWithPlatform,
71 getPprStyle, withPprStyle, withPprStyleDoc,
72 pprDeeper, pprDeeperList, pprSetDepth,
73 codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
74 ifPprDebug, qualName, qualModule, qualPackage,
75 mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
76 mkUserStyle, cmdlineParserStyle, Depth(..),
77
78 -- * Error handling and debugging utilities
79 pprPanic, pprSorry, assertPprPanic, pprPgmError,
80 pprTrace, pprTraceIt, warnPprTrace, pprSTrace,
81 trace, pgmError, panic, sorry, assertPanic,
82 pprDebugAndThen,
83 ) where
84
85 import {-# SOURCE #-} DynFlags( DynFlags,
86 targetPlatform, pprUserLength, pprCols,
87 useUnicode, useUnicodeSyntax,
88 unsafeGlobalDynFlags )
89 import {-# SOURCE #-} Module( UnitId, Module, ModuleName, moduleName )
90 import {-# SOURCE #-} OccName( OccName )
91 import {-# SOURCE #-} StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
92
93 import FastString
94 import qualified Pretty
95 import Util
96 import Platform
97 import Pretty ( Doc, Mode(..) )
98 import Panic
99 import GHC.Serialized
100 import GHC.LanguageExtensions (Extension)
101
102 import Data.ByteString (ByteString)
103 import qualified Data.ByteString as BS
104 import Data.Char
105 import qualified Data.Map as M
106 import Data.Int
107 import qualified Data.IntMap as IM
108 import Data.Set (Set)
109 import qualified Data.Set as Set
110 import Data.String
111 import Data.Word
112 import System.IO ( Handle )
113 import System.FilePath
114 import Text.Printf
115 import Numeric (showFFloat)
116 import Data.Graph (SCC(..))
117 import Data.List (intersperse)
118
119 import GHC.Fingerprint
120 import GHC.Show ( showMultiLineString )
121 #if __GLASGOW_HASKELL__ > 710
122 import GHC.Stack
123 #endif
124
125 {-
126 ************************************************************************
127 * *
128 \subsection{The @PprStyle@ data type}
129 * *
130 ************************************************************************
131 -}
132
133 data PprStyle
134 = PprUser PrintUnqualified Depth
135 -- Pretty-print in a way that will make sense to the
136 -- ordinary user; must be very close to Haskell
137 -- syntax, etc.
138 -- Assumes printing tidied code: non-system names are
139 -- printed without uniques.
140
141 | PprDump PrintUnqualified
142 -- For -ddump-foo; less verbose than PprDebug, but more than PprUser
143 -- Does not assume tidied code: non-external names
144 -- are printed with uniques.
145
146 | PprDebug -- Full debugging output
147
148 | PprCode CodeStyle
149 -- Print code; either C or assembler
150
151 data CodeStyle = CStyle -- The format of labels differs for C and assembler
152 | AsmStyle
153
154 data Depth = AllTheWay
155 | PartWay Int -- 0 => stop
156
157
158 -- -----------------------------------------------------------------------------
159 -- Printing original names
160
161 -- | When printing code that contains original names, we need to map the
162 -- original names back to something the user understands. This is the
163 -- purpose of the triple of functions that gets passed around
164 -- when rendering 'SDoc'.
165 data PrintUnqualified = QueryQualify {
166 queryQualifyName :: QueryQualifyName,
167 queryQualifyModule :: QueryQualifyModule,
168 queryQualifyPackage :: QueryQualifyPackage
169 }
170
171 -- | given an /original/ name, this function tells you which module
172 -- name it should be qualified with when printing for the user, if
173 -- any. For example, given @Control.Exception.catch@, which is in scope
174 -- as @Exception.catch@, this function will return @Just "Exception"@.
175 -- Note that the return value is a ModuleName, not a Module, because
176 -- in source code, names are qualified by ModuleNames.
177 type QueryQualifyName = Module -> OccName -> QualifyName
178
179 -- | For a given module, we need to know whether to print it with
180 -- a package name to disambiguate it.
181 type QueryQualifyModule = Module -> Bool
182
183 -- | For a given package, we need to know whether to print it with
184 -- the unit id to disambiguate it.
185 type QueryQualifyPackage = UnitId -> Bool
186
187 -- See Note [Printing original names] in HscTypes
188 data QualifyName -- Given P:M.T
189 = NameUnqual -- It's in scope unqualified as "T"
190 -- OR nothing called "T" is in scope
191
192 | NameQual ModuleName -- It's in scope qualified as "X.T"
193
194 | NameNotInScope1 -- It's not in scope at all, but M.T is not bound
195 -- in the current scope, so we can refer to it as "M.T"
196
197 | NameNotInScope2 -- It's not in scope at all, and M.T is already bound in
198 -- the current scope, so we must refer to it as "P:M.T"
199
200 reallyAlwaysQualifyNames :: QueryQualifyName
201 reallyAlwaysQualifyNames _ _ = NameNotInScope2
202
203 -- | NB: This won't ever show package IDs
204 alwaysQualifyNames :: QueryQualifyName
205 alwaysQualifyNames m _ = NameQual (moduleName m)
206
207 neverQualifyNames :: QueryQualifyName
208 neverQualifyNames _ _ = NameUnqual
209
210 alwaysQualifyModules :: QueryQualifyModule
211 alwaysQualifyModules _ = True
212
213 neverQualifyModules :: QueryQualifyModule
214 neverQualifyModules _ = False
215
216 alwaysQualifyPackages :: QueryQualifyPackage
217 alwaysQualifyPackages _ = True
218
219 neverQualifyPackages :: QueryQualifyPackage
220 neverQualifyPackages _ = False
221
222 reallyAlwaysQualify, alwaysQualify, neverQualify :: PrintUnqualified
223 reallyAlwaysQualify
224 = QueryQualify reallyAlwaysQualifyNames
225 alwaysQualifyModules
226 alwaysQualifyPackages
227 alwaysQualify = QueryQualify alwaysQualifyNames
228 alwaysQualifyModules
229 alwaysQualifyPackages
230 neverQualify = QueryQualify neverQualifyNames
231 neverQualifyModules
232 neverQualifyPackages
233
234 defaultUserStyle, defaultDumpStyle :: PprStyle
235
236 defaultUserStyle = mkUserStyle neverQualify AllTheWay
237 -- Print without qualifiers to reduce verbosity, unless -dppr-debug
238
239 defaultDumpStyle | opt_PprStyle_Debug = PprDebug
240 | otherwise = PprDump neverQualify
241
242 mkDumpStyle :: PrintUnqualified -> PprStyle
243 mkDumpStyle print_unqual | opt_PprStyle_Debug = PprDebug
244 | otherwise = PprDump print_unqual
245
246 defaultErrStyle :: DynFlags -> PprStyle
247 -- Default style for error messages, when we don't know PrintUnqualified
248 -- It's a bit of a hack because it doesn't take into account what's in scope
249 -- Only used for desugarer warnings, and typechecker errors in interface sigs
250 -- NB that -dppr-debug will still get into PprDebug style
251 defaultErrStyle dflags = mkErrStyle dflags neverQualify
252
253 -- | Style for printing error messages
254 mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
255 mkErrStyle dflags qual = mkUserStyle qual (PartWay (pprUserLength dflags))
256
257 cmdlineParserStyle :: PprStyle
258 cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay
259
260 mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
261 mkUserStyle unqual depth
262 | opt_PprStyle_Debug = PprDebug
263 | otherwise = PprUser unqual depth
264
265 instance Outputable PprStyle where
266 ppr (PprUser {}) = text "user-style"
267 ppr (PprCode {}) = text "code-style"
268 ppr (PprDump {}) = text "dump-style"
269 ppr (PprDebug {}) = text "debug-style"
270
271 {-
272 Orthogonal to the above printing styles are (possibly) some
273 command-line flags that affect printing (often carried with the
274 style). The most likely ones are variations on how much type info is
275 shown.
276
277 The following test decides whether or not we are actually generating
278 code (either C or assembly), or generating interface files.
279
280 ************************************************************************
281 * *
282 \subsection{The @SDoc@ data type}
283 * *
284 ************************************************************************
285 -}
286
287 newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }
288
289 data SDocContext = SDC
290 { sdocStyle :: !PprStyle
291 , sdocLastColour :: !PprColour
292 -- ^ The most recently used colour. This allows nesting colours.
293 , sdocDynFlags :: !DynFlags
294 }
295
296 instance IsString SDoc where
297 fromString = text
298
299 initSDocContext :: DynFlags -> PprStyle -> SDocContext
300 initSDocContext dflags sty = SDC
301 { sdocStyle = sty
302 , sdocLastColour = colReset
303 , sdocDynFlags = dflags
304 }
305
306 withPprStyle :: PprStyle -> SDoc -> SDoc
307 withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
308
309 withPprStyleDoc :: DynFlags -> PprStyle -> SDoc -> Doc
310 withPprStyleDoc dflags sty d = runSDoc d (initSDocContext dflags sty)
311
312 pprDeeper :: SDoc -> SDoc
313 pprDeeper d = SDoc $ \ctx -> case ctx of
314 SDC{sdocStyle=PprUser _ (PartWay 0)} -> Pretty.text "..."
315 SDC{sdocStyle=PprUser q (PartWay n)} ->
316 runSDoc d ctx{sdocStyle = PprUser q (PartWay (n-1))}
317 _ -> runSDoc d ctx
318
319 -- | Truncate a list that is longer than the current depth.
320 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
321 pprDeeperList f ds
322 | null ds = f []
323 | otherwise = SDoc work
324 where
325 work ctx@SDC{sdocStyle=PprUser q (PartWay n)}
326 | n==0 = Pretty.text "..."
327 | otherwise =
328 runSDoc (f (go 0 ds)) ctx{sdocStyle = PprUser q (PartWay (n-1))}
329 where
330 go _ [] = []
331 go i (d:ds) | i >= n = [text "...."]
332 | otherwise = d : go (i+1) ds
333 work other_ctx = runSDoc (f ds) other_ctx
334
335 pprSetDepth :: Depth -> SDoc -> SDoc
336 pprSetDepth depth doc = SDoc $ \ctx ->
337 case ctx of
338 SDC{sdocStyle=PprUser q _} ->
339 runSDoc doc ctx{sdocStyle = PprUser q depth}
340 _ ->
341 runSDoc doc ctx
342
343 getPprStyle :: (PprStyle -> SDoc) -> SDoc
344 getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx
345
346 sdocWithDynFlags :: (DynFlags -> SDoc) -> SDoc
347 sdocWithDynFlags f = SDoc $ \ctx -> runSDoc (f (sdocDynFlags ctx)) ctx
348
349 sdocWithPlatform :: (Platform -> SDoc) -> SDoc
350 sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
351
352 qualName :: PprStyle -> QueryQualifyName
353 qualName (PprUser q _) mod occ = queryQualifyName q mod occ
354 qualName (PprDump q) mod occ = queryQualifyName q mod occ
355 qualName _other mod _ = NameQual (moduleName mod)
356
357 qualModule :: PprStyle -> QueryQualifyModule
358 qualModule (PprUser q _) m = queryQualifyModule q m
359 qualModule (PprDump q) m = queryQualifyModule q m
360 qualModule _other _m = True
361
362 qualPackage :: PprStyle -> QueryQualifyPackage
363 qualPackage (PprUser q _) m = queryQualifyPackage q m
364 qualPackage (PprDump q) m = queryQualifyPackage q m
365 qualPackage _other _m = True
366
367 queryQual :: PprStyle -> PrintUnqualified
368 queryQual s = QueryQualify (qualName s)
369 (qualModule s)
370 (qualPackage s)
371
372 codeStyle :: PprStyle -> Bool
373 codeStyle (PprCode _) = True
374 codeStyle _ = False
375
376 asmStyle :: PprStyle -> Bool
377 asmStyle (PprCode AsmStyle) = True
378 asmStyle _other = False
379
380 dumpStyle :: PprStyle -> Bool
381 dumpStyle (PprDump {}) = True
382 dumpStyle _other = False
383
384 debugStyle :: PprStyle -> Bool
385 debugStyle PprDebug = True
386 debugStyle _other = False
387
388 userStyle :: PprStyle -> Bool
389 userStyle (PprUser _ _) = True
390 userStyle _other = False
391
392 ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
393 ifPprDebug d = SDoc $ \ctx ->
394 case ctx of
395 SDC{sdocStyle=PprDebug} -> runSDoc d ctx
396 _ -> Pretty.empty
397
398 printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
399 printForUser dflags handle unqual doc
400 = Pretty.printDoc PageMode (pprCols dflags) handle
401 (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
402
403 printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
404 -> IO ()
405 printForUserPartWay dflags handle d unqual doc
406 = Pretty.printDoc PageMode (pprCols dflags) handle
407 (runSDoc doc (initSDocContext dflags (mkUserStyle unqual (PartWay d))))
408
409 -- printForC, printForAsm do what they sound like
410 printForC :: DynFlags -> Handle -> SDoc -> IO ()
411 printForC dflags handle doc =
412 Pretty.printDoc LeftMode (pprCols dflags) handle
413 (runSDoc doc (initSDocContext dflags (PprCode CStyle)))
414
415 printForAsm :: DynFlags -> Handle -> SDoc -> IO ()
416 printForAsm dflags handle doc =
417 Pretty.printDoc LeftMode (pprCols dflags) handle
418 (runSDoc doc (initSDocContext dflags (PprCode AsmStyle)))
419
420 pprCode :: CodeStyle -> SDoc -> SDoc
421 pprCode cs d = withPprStyle (PprCode cs) d
422
423 mkCodeStyle :: CodeStyle -> PprStyle
424 mkCodeStyle = PprCode
425
426 -- Can't make SDoc an instance of Show because SDoc is just a function type
427 -- However, Doc *is* an instance of Show
428 -- showSDoc just blasts it out as a string
429 showSDoc :: DynFlags -> SDoc -> String
430 showSDoc dflags sdoc = renderWithStyle dflags sdoc defaultUserStyle
431
432 -- showSDocUnsafe is unsafe, because `unsafeGlobalDynFlags` might not be
433 -- initialised yet.
434 showSDocUnsafe :: SDoc -> String
435 showSDocUnsafe sdoc = showSDoc unsafeGlobalDynFlags sdoc
436
437 showPpr :: Outputable a => DynFlags -> a -> String
438 showPpr dflags thing = showSDoc dflags (ppr thing)
439
440 showSDocUnqual :: DynFlags -> SDoc -> String
441 -- Only used by Haddock
442 showSDocUnqual dflags sdoc = showSDoc dflags sdoc
443
444 showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
445 -- Allows caller to specify the PrintUnqualified to use
446 showSDocForUser dflags unqual doc
447 = renderWithStyle dflags doc (mkUserStyle unqual AllTheWay)
448
449 showSDocDump :: DynFlags -> SDoc -> String
450 showSDocDump dflags d = renderWithStyle dflags d defaultDumpStyle
451
452 showSDocDebug :: DynFlags -> SDoc -> String
453 showSDocDebug dflags d = renderWithStyle dflags d PprDebug
454
455 renderWithStyle :: DynFlags -> SDoc -> PprStyle -> String
456 renderWithStyle dflags sdoc sty
457 = let s = Pretty.style{ Pretty.mode = PageMode,
458 Pretty.lineLength = pprCols dflags }
459 in Pretty.renderStyle s $ runSDoc sdoc (initSDocContext dflags sty)
460
461 -- This shows an SDoc, but on one line only. It's cheaper than a full
462 -- showSDoc, designed for when we're getting results like "Foo.bar"
463 -- and "foo{uniq strictness}" so we don't want fancy layout anyway.
464 showSDocOneLine :: DynFlags -> SDoc -> String
465 showSDocOneLine dflags d
466 = let s = Pretty.style{ Pretty.mode = OneLineMode,
467 Pretty.lineLength = pprCols dflags } in
468 Pretty.renderStyle s $ runSDoc d (initSDocContext dflags defaultUserStyle)
469
470 showSDocDumpOneLine :: DynFlags -> SDoc -> String
471 showSDocDumpOneLine dflags d
472 = let s = Pretty.style{ Pretty.mode = OneLineMode,
473 Pretty.lineLength = irrelevantNCols } in
474 Pretty.renderStyle s $ runSDoc d (initSDocContext dflags defaultDumpStyle)
475
476 irrelevantNCols :: Int
477 -- Used for OneLineMode and LeftMode when number of cols isn't used
478 irrelevantNCols = 1
479
480 isEmpty :: DynFlags -> SDoc -> Bool
481 isEmpty dflags sdoc = Pretty.isEmpty $ runSDoc sdoc dummySDocContext
482 where dummySDocContext = initSDocContext dflags PprDebug
483
484 docToSDoc :: Doc -> SDoc
485 docToSDoc d = SDoc (\_ -> d)
486
487 empty :: SDoc
488 char :: Char -> SDoc
489 text :: String -> SDoc
490 ftext :: FastString -> SDoc
491 ptext :: LitString -> SDoc
492 ztext :: FastZString -> SDoc
493 int :: Int -> SDoc
494 integer :: Integer -> SDoc
495 float :: Float -> SDoc
496 double :: Double -> SDoc
497 rational :: Rational -> SDoc
498
499 empty = docToSDoc $ Pretty.empty
500 char c = docToSDoc $ Pretty.char c
501
502 text s = docToSDoc $ Pretty.text s
503 {-# INLINE text #-} -- Inline so that the RULE Pretty.text will fire
504
505 ftext s = docToSDoc $ Pretty.ftext s
506 ptext s = docToSDoc $ Pretty.ptext s
507 ztext s = docToSDoc $ Pretty.ztext s
508 int n = docToSDoc $ Pretty.int n
509 integer n = docToSDoc $ Pretty.integer n
510 float n = docToSDoc $ Pretty.float n
511 double n = docToSDoc $ Pretty.double n
512 rational n = docToSDoc $ Pretty.rational n
513
514 -- | @doublePrec p n@ shows a floating point number @n@ with @p@
515 -- digits of precision after the decimal point.
516 doublePrec :: Int -> Double -> SDoc
517 doublePrec p n = text (showFFloat (Just p) n "")
518
519 parens, braces, brackets, quotes, quote,
520 paBrackets, doubleQuotes, angleBrackets :: SDoc -> SDoc
521
522 parens d = SDoc $ Pretty.parens . runSDoc d
523 braces d = SDoc $ Pretty.braces . runSDoc d
524 brackets d = SDoc $ Pretty.brackets . runSDoc d
525 quote d = SDoc $ Pretty.quote . runSDoc d
526 doubleQuotes d = SDoc $ Pretty.doubleQuotes . runSDoc d
527 angleBrackets d = char '<' <> d <> char '>'
528 paBrackets d = text "[:" <> d <> text ":]"
529
530 cparen :: Bool -> SDoc -> SDoc
531 cparen b d = SDoc $ Pretty.maybeParens b . runSDoc d
532
533 -- 'quotes' encloses something in single quotes...
534 -- but it omits them if the thing begins or ends in a single quote
535 -- so that we don't get `foo''. Instead we just have foo'.
536 quotes d =
537 sdocWithDynFlags $ \dflags ->
538 if useUnicode dflags
539 then char '' <> d <> char ''
540 else SDoc $ \sty ->
541 let pp_d = runSDoc d sty
542 str = show pp_d
543 in case (str, snocView str) of
544 (_, Just (_, '\'')) -> pp_d
545 ('\'' : _, _) -> pp_d
546 _other -> Pretty.quotes pp_d
547
548 semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc
549 arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc
550 lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
551
552 blankLine = docToSDoc $ Pretty.text ""
553 dcolon = unicodeSyntax (char '') (docToSDoc $ Pretty.text "::")
554 arrow = unicodeSyntax (char '') (docToSDoc $ Pretty.text "->")
555 larrow = unicodeSyntax (char '') (docToSDoc $ Pretty.text "<-")
556 darrow = unicodeSyntax (char '') (docToSDoc $ Pretty.text "=>")
557 arrowt = unicodeSyntax (char '') (docToSDoc $ Pretty.text ">-")
558 larrowt = unicodeSyntax (char '') (docToSDoc $ Pretty.text "-<")
559 arrowtt = unicodeSyntax (char '') (docToSDoc $ Pretty.text ">>-")
560 larrowtt = unicodeSyntax (char '') (docToSDoc $ Pretty.text "-<<")
561 semi = docToSDoc $ Pretty.semi
562 comma = docToSDoc $ Pretty.comma
563 colon = docToSDoc $ Pretty.colon
564 equals = docToSDoc $ Pretty.equals
565 space = docToSDoc $ Pretty.space
566 underscore = char '_'
567 dot = char '.'
568 vbar = char '|'
569 lparen = docToSDoc $ Pretty.lparen
570 rparen = docToSDoc $ Pretty.rparen
571 lbrack = docToSDoc $ Pretty.lbrack
572 rbrack = docToSDoc $ Pretty.rbrack
573 lbrace = docToSDoc $ Pretty.lbrace
574 rbrace = docToSDoc $ Pretty.rbrace
575
576 forAllLit :: SDoc
577 forAllLit = unicodeSyntax (char '') (text "forall")
578
579 unicodeSyntax :: SDoc -> SDoc -> SDoc
580 unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
581 if useUnicode dflags && useUnicodeSyntax dflags
582 then unicode
583 else plain
584
585 nest :: Int -> SDoc -> SDoc
586 -- ^ Indent 'SDoc' some specified amount
587 (<>) :: SDoc -> SDoc -> SDoc
588 -- ^ Join two 'SDoc' together horizontally without a gap
589 (<+>) :: SDoc -> SDoc -> SDoc
590 -- ^ Join two 'SDoc' together horizontally with a gap between them
591 ($$) :: SDoc -> SDoc -> SDoc
592 -- ^ Join two 'SDoc' together vertically; if there is
593 -- no vertical overlap it "dovetails" the two onto one line
594 ($+$) :: SDoc -> SDoc -> SDoc
595 -- ^ Join two 'SDoc' together vertically
596
597 nest n d = SDoc $ Pretty.nest n . runSDoc d
598 (<>) d1 d2 = SDoc $ \sty -> (Pretty.<>) (runSDoc d1 sty) (runSDoc d2 sty)
599 (<+>) d1 d2 = SDoc $ \sty -> (Pretty.<+>) (runSDoc d1 sty) (runSDoc d2 sty)
600 ($$) d1 d2 = SDoc $ \sty -> (Pretty.$$) (runSDoc d1 sty) (runSDoc d2 sty)
601 ($+$) d1 d2 = SDoc $ \sty -> (Pretty.$+$) (runSDoc d1 sty) (runSDoc d2 sty)
602
603 hcat :: [SDoc] -> SDoc
604 -- ^ Concatenate 'SDoc' horizontally
605 hsep :: [SDoc] -> SDoc
606 -- ^ Concatenate 'SDoc' horizontally with a space between each one
607 vcat :: [SDoc] -> SDoc
608 -- ^ Concatenate 'SDoc' vertically with dovetailing
609 sep :: [SDoc] -> SDoc
610 -- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
611 cat :: [SDoc] -> SDoc
612 -- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits
613 fsep :: [SDoc] -> SDoc
614 -- ^ A paragraph-fill combinator. It's much like sep, only it
615 -- keeps fitting things on one line until it can't fit any more.
616 fcat :: [SDoc] -> SDoc
617 -- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'
618
619
620 hcat ds = SDoc $ \sty -> Pretty.hcat [runSDoc d sty | d <- ds]
621 hsep ds = SDoc $ \sty -> Pretty.hsep [runSDoc d sty | d <- ds]
622 vcat ds = SDoc $ \sty -> Pretty.vcat [runSDoc d sty | d <- ds]
623 sep ds = SDoc $ \sty -> Pretty.sep [runSDoc d sty | d <- ds]
624 cat ds = SDoc $ \sty -> Pretty.cat [runSDoc d sty | d <- ds]
625 fsep ds = SDoc $ \sty -> Pretty.fsep [runSDoc d sty | d <- ds]
626 fcat ds = SDoc $ \sty -> Pretty.fcat [runSDoc d sty | d <- ds]
627
628 hang :: SDoc -- ^ The header
629 -> Int -- ^ Amount to indent the hung body
630 -> SDoc -- ^ The hung body, indented and placed below the header
631 -> SDoc
632 hang d1 n d2 = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty)
633
634 -- | This behaves like 'hang', but does not indent the second document
635 -- when the header is empty.
636 hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc
637 hangNotEmpty d1 n d2 =
638 SDoc $ \sty -> Pretty.hangNotEmpty (runSDoc d1 sty) n (runSDoc d2 sty)
639
640 punctuate :: SDoc -- ^ The punctuation
641 -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
642 -> [SDoc] -- ^ Punctuated list
643 punctuate _ [] = []
644 punctuate p (d:ds) = go d ds
645 where
646 go d [] = [d]
647 go d (e:es) = (d <> p) : go e es
648
649 ppWhen, ppUnless :: Bool -> SDoc -> SDoc
650 ppWhen True doc = doc
651 ppWhen False _ = empty
652
653 ppUnless True _ = empty
654 ppUnless False doc = doc
655
656 -- | A colour\/style for use with 'coloured'.
657 newtype PprColour = PprColour String
658
659 -- Colours
660
661 colType :: PprColour
662 colType = PprColour "\27[34m"
663
664 colBold :: PprColour
665 colBold = PprColour "\27[;1m"
666
667 colCoerc :: PprColour
668 colCoerc = PprColour "\27[34m"
669
670 colDataCon :: PprColour
671 colDataCon = PprColour "\27[31m"
672
673 colBinder :: PprColour
674 colBinder = PprColour "\27[32m"
675
676 colReset :: PprColour
677 colReset = PprColour "\27[0m"
678
679 -- | Apply the given colour\/style for the argument.
680 --
681 -- Only takes effect if colours are enabled.
682 coloured :: PprColour -> SDoc -> SDoc
683 -- TODO: coloured _ sdoc ctxt | coloursDisabled = sdoc ctxt
684 coloured col@(PprColour c) sdoc =
685 SDoc $ \ctx@SDC{ sdocLastColour = PprColour lc } ->
686 let ctx' = ctx{ sdocLastColour = col } in
687 Pretty.zeroWidthText c Pretty.<> runSDoc sdoc ctx' Pretty.<> Pretty.zeroWidthText lc
688
689 bold :: SDoc -> SDoc
690 bold = coloured colBold
691
692 keyword :: SDoc -> SDoc
693 keyword = bold
694
695 {-
696 ************************************************************************
697 * *
698 \subsection[Outputable-class]{The @Outputable@ class}
699 * *
700 ************************************************************************
701 -}
702
703 -- | Class designating that some type has an 'SDoc' representation
704 class Outputable a where
705 ppr :: a -> SDoc
706 pprPrec :: Rational -> a -> SDoc
707 -- 0 binds least tightly
708 -- We use Rational because there is always a
709 -- Rational between any other two Rationals
710
711 ppr = pprPrec 0
712 pprPrec _ = ppr
713
714 instance Outputable Char where
715 ppr c = text [c]
716
717 instance Outputable Bool where
718 ppr True = text "True"
719 ppr False = text "False"
720
721 instance Outputable Ordering where
722 ppr LT = text "LT"
723 ppr EQ = text "EQ"
724 ppr GT = text "GT"
725
726 instance Outputable Int32 where
727 ppr n = integer $ fromIntegral n
728
729 instance Outputable Int64 where
730 ppr n = integer $ fromIntegral n
731
732 instance Outputable Int where
733 ppr n = int n
734
735 instance Outputable Word16 where
736 ppr n = integer $ fromIntegral n
737
738 instance Outputable Word32 where
739 ppr n = integer $ fromIntegral n
740
741 instance Outputable Word where
742 ppr n = integer $ fromIntegral n
743
744 instance Outputable () where
745 ppr _ = text "()"
746
747 instance (Outputable a) => Outputable [a] where
748 ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
749
750 instance (Outputable a) => Outputable (Set a) where
751 ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))
752
753 instance (Outputable a, Outputable b) => Outputable (a, b) where
754 ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
755
756 instance Outputable a => Outputable (Maybe a) where
757 ppr Nothing = text "Nothing"
758 ppr (Just x) = text "Just" <+> ppr x
759
760 instance (Outputable a, Outputable b) => Outputable (Either a b) where
761 ppr (Left x) = text "Left" <+> ppr x
762 ppr (Right y) = text "Right" <+> ppr y
763
764 -- ToDo: may not be used
765 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
766 ppr (x,y,z) =
767 parens (sep [ppr x <> comma,
768 ppr y <> comma,
769 ppr z ])
770
771 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
772 Outputable (a, b, c, d) where
773 ppr (a,b,c,d) =
774 parens (sep [ppr a <> comma,
775 ppr b <> comma,
776 ppr c <> comma,
777 ppr d])
778
779 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
780 Outputable (a, b, c, d, e) where
781 ppr (a,b,c,d,e) =
782 parens (sep [ppr a <> comma,
783 ppr b <> comma,
784 ppr c <> comma,
785 ppr d <> comma,
786 ppr e])
787
788 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>
789 Outputable (a, b, c, d, e, f) where
790 ppr (a,b,c,d,e,f) =
791 parens (sep [ppr a <> comma,
792 ppr b <> comma,
793 ppr c <> comma,
794 ppr d <> comma,
795 ppr e <> comma,
796 ppr f])
797
798 instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>
799 Outputable (a, b, c, d, e, f, g) where
800 ppr (a,b,c,d,e,f,g) =
801 parens (sep [ppr a <> comma,
802 ppr b <> comma,
803 ppr c <> comma,
804 ppr d <> comma,
805 ppr e <> comma,
806 ppr f <> comma,
807 ppr g])
808
809 instance Outputable FastString where
810 ppr fs = ftext fs -- Prints an unadorned string,
811 -- no double quotes or anything
812
813 instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
814 ppr m = ppr (M.toList m)
815 instance (Outputable elt) => Outputable (IM.IntMap elt) where
816 ppr m = ppr (IM.toList m)
817
818 instance Outputable Fingerprint where
819 ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2)
820
821 instance Outputable a => Outputable (SCC a) where
822 ppr (AcyclicSCC v) = text "NONREC" $$ (nest 3 (ppr v))
823 ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
824
825 instance Outputable Serialized where
826 ppr (Serialized the_type bytes) = int (length bytes) <+> text "of type" <+> text (show the_type)
827
828 instance Outputable Extension where
829 ppr = text . show
830
831 {-
832 ************************************************************************
833 * *
834 \subsection{The @OutputableBndr@ class}
835 * *
836 ************************************************************************
837 -}
838
839 -- | 'BindingSite' is used to tell the thing that prints binder what
840 -- language construct is binding the identifier. This can be used
841 -- to decide how much info to print.
842 -- Also see Note [Binding-site specific printing] in PprCore
843 data BindingSite
844 = LambdaBind -- ^ The x in (\x. e)
845 | CaseBind -- ^ The x in case scrut of x { (y,z) -> ... }
846 | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... }
847 | LetBind -- ^ The x in (let x = rhs in e)
848
849 -- | When we print a binder, we often want to print its type too.
850 -- The @OutputableBndr@ class encapsulates this idea.
851 class Outputable a => OutputableBndr a where
852 pprBndr :: BindingSite -> a -> SDoc
853 pprBndr _b x = ppr x
854
855 pprPrefixOcc, pprInfixOcc :: a -> SDoc
856 -- Print an occurrence of the name, suitable either in the
857 -- prefix position of an application, thus (f a b) or ((+) x)
858 -- or infix position, thus (a `f` b) or (x + y)
859
860 {-
861 ************************************************************************
862 * *
863 \subsection{Random printing helpers}
864 * *
865 ************************************************************************
866 -}
867
868 -- We have 31-bit Chars and will simply use Show instances of Char and String.
869
870 -- | Special combinator for showing character literals.
871 pprHsChar :: Char -> SDoc
872 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
873 | otherwise = text (show c)
874
875 -- | Special combinator for showing string literals.
876 pprHsString :: FastString -> SDoc
877 pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))
878
879 -- | Special combinator for showing bytestring literals.
880 pprHsBytes :: ByteString -> SDoc
881 pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
882 in vcat (map text (showMultiLineString escaped)) <> char '#'
883 where escape :: Word8 -> String
884 escape w = let c = chr (fromIntegral w)
885 in if isAscii c
886 then [c]
887 else '\\' : show w
888
889 -- Postfix modifiers for unboxed literals.
890 -- See Note [Printing of literals in Core] in `basicTypes/Literal.hs`.
891 primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc
892 primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc
893 primCharSuffix = char '#'
894 primFloatSuffix = char '#'
895 primIntSuffix = char '#'
896 primDoubleSuffix = text "##"
897 primWordSuffix = text "##"
898 primInt64Suffix = text "L#"
899 primWord64Suffix = text "L##"
900
901 -- | Special combinator for showing unboxed literals.
902 pprPrimChar :: Char -> SDoc
903 pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
904 pprPrimChar c = pprHsChar c <> primCharSuffix
905 pprPrimInt i = integer i <> primIntSuffix
906 pprPrimWord w = integer w <> primWordSuffix
907 pprPrimInt64 i = integer i <> primInt64Suffix
908 pprPrimWord64 w = integer w <> primWord64Suffix
909
910 ---------------------
911 -- Put a name in parens if it's an operator
912 pprPrefixVar :: Bool -> SDoc -> SDoc
913 pprPrefixVar is_operator pp_v
914 | is_operator = parens pp_v
915 | otherwise = pp_v
916
917 -- Put a name in backquotes if it's not an operator
918 pprInfixVar :: Bool -> SDoc -> SDoc
919 pprInfixVar is_operator pp_v
920 | is_operator = pp_v
921 | otherwise = char '`' <> pp_v <> char '`'
922
923 ---------------------
924 pprFastFilePath :: FastString -> SDoc
925 pprFastFilePath path = text $ normalise $ unpackFS path
926
927 {-
928 ************************************************************************
929 * *
930 \subsection{Other helper functions}
931 * *
932 ************************************************************************
933 -}
934
935 pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use
936 -> [a] -- ^ The things to be pretty printed
937 -> SDoc -- ^ 'SDoc' where the things have been pretty printed,
938 -- comma-separated and finally packed into a paragraph.
939 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
940
941 pprWithBars :: (a -> SDoc) -- ^ The pretty printing function to use
942 -> [a] -- ^ The things to be pretty printed
943 -> SDoc -- ^ 'SDoc' where the things have been pretty printed,
944 -- bar-separated and finally packed into a paragraph.
945 pprWithBars pp xs = fsep (intersperse vbar (map pp xs))
946
947 -- | Returns the separated concatenation of the pretty printed things.
948 interppSP :: Outputable a => [a] -> SDoc
949 interppSP xs = sep (map ppr xs)
950
951 -- | Returns the comma-separated concatenation of the pretty printed things.
952 interpp'SP :: Outputable a => [a] -> SDoc
953 interpp'SP xs = sep (punctuate comma (map ppr xs))
954
955 -- | Returns the comma-separated concatenation of the quoted pretty printed things.
956 --
957 -- > [x,y,z] ==> `x', `y', `z'
958 pprQuotedList :: Outputable a => [a] -> SDoc
959 pprQuotedList = quotedList . map ppr
960
961 quotedList :: [SDoc] -> SDoc
962 quotedList xs = hsep (punctuate comma (map quotes xs))
963
964 quotedListWithOr :: [SDoc] -> SDoc
965 -- [x,y,z] ==> `x', `y' or `z'
966 quotedListWithOr xs@(_:_:_) = quotedList (init xs) <+> text "or" <+> quotes (last xs)
967 quotedListWithOr xs = quotedList xs
968
969 quotedListWithNor :: [SDoc] -> SDoc
970 -- [x,y,z] ==> `x', `y' nor `z'
971 quotedListWithNor xs@(_:_:_) = quotedList (init xs) <+> text "nor" <+> quotes (last xs)
972 quotedListWithNor xs = quotedList xs
973
974 {-
975 ************************************************************************
976 * *
977 \subsection{Printing numbers verbally}
978 * *
979 ************************************************************************
980 -}
981
982 intWithCommas :: Integral a => a -> SDoc
983 -- Prints a big integer with commas, eg 345,821
984 intWithCommas n
985 | n < 0 = char '-' <> intWithCommas (-n)
986 | q == 0 = int (fromIntegral r)
987 | otherwise = intWithCommas q <> comma <> zeroes <> int (fromIntegral r)
988 where
989 (q,r) = n `quotRem` 1000
990 zeroes | r >= 100 = empty
991 | r >= 10 = char '0'
992 | otherwise = text "00"
993
994 -- | Converts an integer to a verbal index:
995 --
996 -- > speakNth 1 = text "first"
997 -- > speakNth 5 = text "fifth"
998 -- > speakNth 21 = text "21st"
999 speakNth :: Int -> SDoc
1000 speakNth 1 = text "first"
1001 speakNth 2 = text "second"
1002 speakNth 3 = text "third"
1003 speakNth 4 = text "fourth"
1004 speakNth 5 = text "fifth"
1005 speakNth 6 = text "sixth"
1006 speakNth n = hcat [ int n, text suffix ]
1007 where
1008 suffix | n <= 20 = "th" -- 11,12,13 are non-std
1009 | last_dig == 1 = "st"
1010 | last_dig == 2 = "nd"
1011 | last_dig == 3 = "rd"
1012 | otherwise = "th"
1013
1014 last_dig = n `rem` 10
1015
1016 -- | Converts an integer to a verbal multiplicity:
1017 --
1018 -- > speakN 0 = text "none"
1019 -- > speakN 5 = text "five"
1020 -- > speakN 10 = text "10"
1021 speakN :: Int -> SDoc
1022 speakN 0 = text "none" -- E.g. "he has none"
1023 speakN 1 = text "one" -- E.g. "he has one"
1024 speakN 2 = text "two"
1025 speakN 3 = text "three"
1026 speakN 4 = text "four"
1027 speakN 5 = text "five"
1028 speakN 6 = text "six"
1029 speakN n = int n
1030
1031 -- | Converts an integer and object description to a statement about the
1032 -- multiplicity of those objects:
1033 --
1034 -- > speakNOf 0 (text "melon") = text "no melons"
1035 -- > speakNOf 1 (text "melon") = text "one melon"
1036 -- > speakNOf 3 (text "melon") = text "three melons"
1037 speakNOf :: Int -> SDoc -> SDoc
1038 speakNOf 0 d = text "no" <+> d <> char 's'
1039 speakNOf 1 d = text "one" <+> d -- E.g. "one argument"
1040 speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
1041
1042 -- | Determines the pluralisation suffix appropriate for the length of a list:
1043 --
1044 -- > plural [] = char 's'
1045 -- > plural ["Hello"] = empty
1046 -- > plural ["Hello", "World"] = char 's'
1047 plural :: [a] -> SDoc
1048 plural [_] = empty -- a bit frightening, but there you are
1049 plural _ = char 's'
1050
1051 -- | Determines the form of to be appropriate for the length of a list:
1052 --
1053 -- > isOrAre [] = text "are"
1054 -- > isOrAre ["Hello"] = text "is"
1055 -- > isOrAre ["Hello", "World"] = text "are"
1056 isOrAre :: [a] -> SDoc
1057 isOrAre [_] = text "is"
1058 isOrAre _ = text "are"
1059
1060 -- | Determines the form of to do appropriate for the length of a list:
1061 --
1062 -- > doOrDoes [] = text "do"
1063 -- > doOrDoes ["Hello"] = text "does"
1064 -- > doOrDoes ["Hello", "World"] = text "do"
1065 doOrDoes :: [a] -> SDoc
1066 doOrDoes [_] = text "does"
1067 doOrDoes _ = text "do"
1068
1069 {-
1070 ************************************************************************
1071 * *
1072 \subsection{Error handling}
1073 * *
1074 ************************************************************************
1075 -}
1076
1077 pprPanic :: String -> SDoc -> a
1078 -- ^ Throw an exception saying "bug in GHC"
1079 pprPanic = panicDoc
1080
1081 pprSorry :: String -> SDoc -> a
1082 -- ^ Throw an exception saying "this isn't finished yet"
1083 pprSorry = sorryDoc
1084
1085
1086 pprPgmError :: String -> SDoc -> a
1087 -- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
1088 pprPgmError = pgmErrorDoc
1089
1090
1091 pprTrace :: String -> SDoc -> a -> a
1092 -- ^ If debug output is on, show some 'SDoc' on the screen
1093 pprTrace str doc x
1094 | opt_NoDebugOutput = x
1095 | otherwise = pprDebugAndThen unsafeGlobalDynFlags trace (text str) doc x
1096
1097 -- | @pprTraceIt desc x@ is equivalent to @pprTrace desc (ppr x) x@
1098 pprTraceIt :: Outputable a => String -> a -> a
1099 pprTraceIt desc x = pprTrace desc (ppr x) x
1100
1101
1102 -- | If debug output is on, show some 'SDoc' on the screen along
1103 -- with a call stack when available.
1104 #if __GLASGOW_HASKELL__ > 710
1105 pprSTrace :: (?callStack :: CallStack) => SDoc -> a -> a
1106 pprSTrace = pprTrace (prettyCallStack ?callStack)
1107 #else
1108 pprSTrace :: SDoc -> a -> a
1109 pprSTrace = pprTrace "no callstack info"
1110 #endif
1111
1112 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
1113 -- ^ Just warn about an assertion failure, recording the given file and line number.
1114 -- Should typically be accessed with the WARN macros
1115 warnPprTrace _ _ _ _ x | not debugIsOn = x
1116 warnPprTrace _ _file _line _msg x | opt_NoDebugOutput = x
1117 warnPprTrace False _file _line _msg x = x
1118 warnPprTrace True file line msg x
1119 = pprDebugAndThen unsafeGlobalDynFlags trace heading msg x
1120 where
1121 heading = hsep [text "WARNING: file", text file <> comma, text "line", int line]
1122
1123 -- | Panic with an assertation failure, recording the given file and
1124 -- line number. Should typically be accessed with the ASSERT family of macros
1125 #if __GLASGOW_HASKELL__ > 710
1126 assertPprPanic :: (?callStack :: CallStack) => String -> Int -> SDoc -> a
1127 assertPprPanic _file _line msg
1128 = pprPanic "ASSERT failed!" doc
1129 where
1130 doc = sep [ text (prettyCallStack ?callStack)
1131 , msg ]
1132 #else
1133 assertPprPanic :: String -> Int -> SDoc -> a
1134 assertPprPanic file line msg
1135 = pprPanic "ASSERT failed!" doc
1136 where
1137 doc = sep [ hsep [ text "file", text file
1138 , text "line", int line ]
1139 , msg ]
1140 #endif
1141
1142 pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a
1143 pprDebugAndThen dflags cont heading pretty_msg
1144 = cont (showSDocDump dflags doc)
1145 where
1146 doc = sep [heading, nest 2 pretty_msg]