Outputable.lhs 34.2 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP Project, Glasgow University, 1992-1998
4
5
6
%

\begin{code}
batterseapower's avatar
batterseapower committed
7
8
9
10
11
12
-- | This module defines classes and functions for pretty-printing. It also
-- exports a number of helpful debugging and other utilities such as 'trace' and 'panic'.
--
-- The interface to this module is very similar to the standard Hughes-PJ pretty printing
-- module, except that it exports a number of additional functions that are rarely used,
-- and works over the 'SDoc' type.
13
module Outputable (
dterei's avatar
dterei committed
14
15
16
        -- * Type classes
        Outputable(..), OutputableBndr(..),
        PlatformOutputable(..),
17

batterseapower's avatar
batterseapower committed
18
        -- * Pretty printing combinators
dterei's avatar
dterei committed
19
20
21
22
23
24
        SDoc, runSDoc, initSDocContext,
        docToSDoc,
        interppSP, interpp'SP, pprQuotedList, pprWithCommas, quotedListWithOr,
        empty, nest,
        char,
        text, ftext, ptext,
25
        int, intWithCommas, integer, float, double, rational,
26
27
        parens, cparen, brackets, braces, quotes, quote, 
        doubleQuotes, angleBrackets, paBrackets,
dterei's avatar
dterei committed
28
29
30
31
32
33
34
35
36
        semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
        blankLine,
        (<>), (<+>), hcat, hsep,
        ($$), ($+$), vcat,
        sep, cat,
        fsep, fcat,
        hang, punctuate, ppWhen, ppUnless,
        speakNth, speakNTimes, speakN, speakNOf, plural,
37

38
        coloured, PprColour, colType, colCoerc, colDataCon,
Thomas Schilling's avatar
Thomas Schilling committed
39
        colBinder, bold, keyword,
40

batterseapower's avatar
batterseapower committed
41
        -- * Converting 'SDoc' into strings and outputing it
42
        hPrintDump,
dterei's avatar
dterei committed
43
44
45
        printForC, printForAsm, printForUser, printForUserPartWay,
        pprCode, mkCodeStyle,
        showSDoc, showSDocOneLine,
46
47
        showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine,
        showPpr,
Ian Lynagh's avatar
Ian Lynagh committed
48
        showSDocUnqual,
49
        renderWithStyle,
50

dterei's avatar
dterei committed
51
        pprInfixVar, pprPrefixVar,
52
        pprHsChar, pprHsString, 
53
        pprFastFilePath,
54

batterseapower's avatar
batterseapower committed
55
        -- * Controlling the style in which output is printed
dterei's avatar
dterei committed
56
        BindingSite(..),
batterseapower's avatar
batterseapower committed
57

dterei's avatar
dterei committed
58
        PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
batterseapower's avatar
batterseapower committed
59
        QualifyName(..),
dterei's avatar
dterei committed
60
61
62
63
64
        getPprStyle, withPprStyle, withPprStyleDoc,
        pprDeeper, pprDeeperList, pprSetDepth,
        codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
        ifPprDebug, qualName, qualModule,
        mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
65
        mkUserStyle, cmdlineParserStyle, Depth(..),
dterei's avatar
dterei committed
66
67
68
69

        -- * Error handling and debugging utilities
        pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
        pprTrace, pprDefiniteTrace, warnPprTrace,
Ian Lynagh's avatar
Ian Lynagh committed
70
71
        trace, pgmError, panic, sorry, panicFastInt, assertPanic,
        pprDebugAndThen,
72
73
    ) where

Ian Lynagh's avatar
Ian Lynagh committed
74
import {-# SOURCE #-}   DynFlags( DynFlags )
dterei's avatar
dterei committed
75
import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
76
import {-# SOURCE #-}   Name( Name, nameModule )
77

Simon Marlow's avatar
Simon Marlow committed
78
import StaticFlags
dterei's avatar
dterei committed
79
import FastString
80
import FastTypes
81
import Platform
82
import qualified Pretty
83
import Util
dterei's avatar
dterei committed
84
import Pretty           ( Doc, Mode(..) )
85
import Panic
86

Ian Lynagh's avatar
Ian Lynagh committed
87
import Data.Char
88
import qualified Data.Map as M
89
import qualified Data.IntMap as IM
90
91
import Data.Set (Set)
import qualified Data.Set as Set
92
import Data.Word
93
import System.IO        ( Handle, hFlush )
94
import System.FilePath
95
96


Ian Lynagh's avatar
Ian Lynagh committed
97
#if __GLASGOW_HASKELL__ >= 701
98
import GHC.Show         ( showMultiLineString )
99
100
101
#else
showMultiLineString :: String -> [String]
-- Crude version
102
showMultiLineString s = [ showList s "" ]
103
#endif
104
105
\end{code}

sof's avatar
sof committed
106

107

108
%************************************************************************
dterei's avatar
dterei committed
109
%*                                                                      *
sof's avatar
sof committed
110
\subsection{The @PprStyle@ data type}
dterei's avatar
dterei committed
111
%*                                                                      *
112
113
114
%************************************************************************

\begin{code}
115

sof's avatar
sof committed
116
data PprStyle
117
  = PprUser PrintUnqualified Depth
dterei's avatar
dterei committed
118
119
120
121
122
                -- Pretty-print in a way that will make sense to the
                -- ordinary user; must be very close to Haskell
                -- syntax, etc.
                -- Assumes printing tidied code: non-system names are
                -- printed without uniques.
sof's avatar
sof committed
123

124
  | PprCode CodeStyle
dterei's avatar
dterei committed
125
                -- Print code; either C or assembler
sof's avatar
sof committed
126

dterei's avatar
dterei committed
127
128
129
  | PprDump     -- For -ddump-foo; less verbose than PprDebug.
                -- Does not assume tidied code: non-external names
                -- are printed with uniques.
130

dterei's avatar
dterei committed
131
  | PprDebug    -- Full debugging output
132

dterei's avatar
dterei committed
133
134
data CodeStyle = CStyle         -- The format of labels differs for C and assembler
               | AsmStyle
135
136

data Depth = AllTheWay
dterei's avatar
dterei committed
137
           | PartWay Int        -- 0 => stop
138
139


Simon Marlow's avatar
Simon Marlow committed
140
141
-- -----------------------------------------------------------------------------
-- Printing original names
142

Simon Marlow's avatar
Simon Marlow committed
143
144
145
146
147
148
149
150
151
152
153
-- When printing code that contains original names, we need to map the
-- original names back to something the user understands.  This is the
-- purpose of the pair of functions that gets passed around
-- when rendering 'SDoc'.

-- | given an /original/ name, this function tells you which module
-- name it should be qualified with when printing for the user, if
-- any.  For example, given @Control.Exception.catch@, which is in scope
-- as @Exception.catch@, this fuction will return @Just "Exception"@.
-- Note that the return value is a ModuleName, not a Module, because
-- in source code, names are qualified by ModuleNames.
154
type QueryQualifyName = Name -> QualifyName
155

156
-- See Note [Printing original names] in HscTypes
157
158
159
data QualifyName                        -- given P:M.T
        = NameUnqual                    -- refer to it as "T"
        | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
dterei's avatar
dterei committed
160
        | NameNotInScope1
161
162
163
164
165
166
                -- it is not in scope at all, but M.T is not bound in the current
                -- scope, so we can refer to it as "M.T"
        | NameNotInScope2
                -- it is not in scope at all, and M.T is already bound in the
                -- current scope, so we must refer to it as "P:M.T"

Simon Marlow's avatar
Simon Marlow committed
167
168

-- | For a given module, we need to know whether to print it with
169
170
-- a package name to disambiguate it.
type QueryQualifyModule = Module -> Bool
Simon Marlow's avatar
Simon Marlow committed
171

172
type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
Simon Marlow's avatar
Simon Marlow committed
173

174
alwaysQualifyNames :: QueryQualifyName
175
alwaysQualifyNames n = NameQual (moduleName (nameModule n))
Simon Marlow's avatar
Simon Marlow committed
176

177
neverQualifyNames :: QueryQualifyName
178
neverQualifyNames _ = NameUnqual
Simon Marlow's avatar
Simon Marlow committed
179

180
alwaysQualifyModules :: QueryQualifyModule
181
alwaysQualifyModules _ = True
Simon Marlow's avatar
Simon Marlow committed
182

183
neverQualifyModules :: QueryQualifyModule
184
185
neverQualifyModules _ = False

186
alwaysQualify, neverQualify :: PrintUnqualified
Simon Marlow's avatar
Simon Marlow committed
187
188
alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
neverQualify  = (neverQualifyNames,  neverQualifyModules)
189

190
191
defaultUserStyle, defaultDumpStyle :: PprStyle

192
193
defaultUserStyle = mkUserStyle alwaysQualify AllTheWay

194
defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
dterei's avatar
dterei committed
195
                 |  otherwise          = PprDump
196

Simon Marlow's avatar
Simon Marlow committed
197
-- | Style for printing error messages
198
mkErrStyle :: PrintUnqualified -> PprStyle
Simon Marlow's avatar
Simon Marlow committed
199
mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
200
201
202
203
204

defaultErrStyle :: PprStyle
-- Default style for error messages
-- It's a bit of a hack because it doesn't take into account what's in scope
-- Only used for desugarer warnings, and typechecker errors in interface sigs
dterei's avatar
dterei committed
205
defaultErrStyle
Simon Marlow's avatar
Simon Marlow committed
206
207
  | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
  | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
208

209
mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
Simon Marlow's avatar
Simon Marlow committed
210
211
212
mkUserStyle unqual depth
   | opt_PprStyle_Debug = PprDebug
   | otherwise          = PprUser unqual depth
213
214
215

cmdlineParserStyle :: PprStyle
cmdlineParserStyle = PprUser alwaysQualify AllTheWay
sof's avatar
sof committed
216
\end{code}
217

sof's avatar
sof committed
218
219
220
221
Orthogonal to the above printing styles are (possibly) some
command-line flags that affect printing (often carried with the
style).  The most likely ones are variations on how much type info is
shown.
sof's avatar
sof committed
222

sof's avatar
sof committed
223
224
The following test decides whether or not we are actually generating
code (either C or assembly), or generating interface files.
225
226

%************************************************************************
dterei's avatar
dterei committed
227
%*                                                                      *
228
\subsection{The @SDoc@ data type}
dterei's avatar
dterei committed
229
%*                                                                      *
230
231
232
%************************************************************************

\begin{code}
Thomas Schilling's avatar
Thomas Schilling committed
233
newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }
234
235
236
237
238

data SDocContext = SDC
  { sdocStyle      :: !PprStyle
  , sdocLastColour :: !PprColour
    -- ^ The most recently used colour.  This allows nesting colours.
Ian Lynagh's avatar
Ian Lynagh committed
239
  , sdocDynFlags   :: DynFlags
240
241
  }

Ian Lynagh's avatar
Ian Lynagh committed
242
243
initSDocContext :: DynFlags -> PprStyle -> SDocContext
initSDocContext dflags sty = SDC
244
245
  { sdocStyle = sty
  , sdocLastColour = colReset
Ian Lynagh's avatar
Ian Lynagh committed
246
  , sdocDynFlags = dflags
247
  }
248
249

withPprStyle :: PprStyle -> SDoc -> SDoc
Thomas Schilling's avatar
Thomas Schilling committed
250
withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
251

Ian Lynagh's avatar
Ian Lynagh committed
252
253
withPprStyleDoc :: DynFlags -> PprStyle -> SDoc -> Doc
withPprStyleDoc dflags sty d = runSDoc d (initSDocContext dflags sty)
254

255
pprDeeper :: SDoc -> SDoc
Thomas Schilling's avatar
Thomas Schilling committed
256
257
258
259
260
pprDeeper d = SDoc $ \ctx -> case ctx of
  SDC{sdocStyle=PprUser _ (PartWay 0)} -> Pretty.text "..."
  SDC{sdocStyle=PprUser q (PartWay n)} ->
    runSDoc d ctx{sdocStyle = PprUser q (PartWay (n-1))}
  _ -> runSDoc d ctx
261

262
263
pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
-- Truncate a list that list that is longer than the current depth
Thomas Schilling's avatar
Thomas Schilling committed
264
265
266
267
268
269
270
271
272
273
274
pprDeeperList f ds = SDoc work
 where
  work ctx@SDC{sdocStyle=PprUser q (PartWay n)}
   | n==0      = Pretty.text "..."
   | otherwise =
      runSDoc (f (go 0 ds)) ctx{sdocStyle = PprUser q (PartWay (n-1))}
   where
     go _ [] = []
     go i (d:ds) | i >= n    = [text "...."]
                 | otherwise = d : go (i+1) ds
  work other_ctx = runSDoc (f ds) other_ctx
275

276
pprSetDepth :: Depth -> SDoc -> SDoc
dterei's avatar
dterei committed
277
278
279
280
281
282
pprSetDepth depth doc = SDoc $ \ctx ->
    case ctx of
        SDC{sdocStyle=PprUser q _} ->
            runSDoc doc ctx{sdocStyle = PprUser q depth}
        _ ->
            runSDoc doc ctx
283

284
getPprStyle :: (PprStyle -> SDoc) -> SDoc
Thomas Schilling's avatar
Thomas Schilling committed
285
getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx
286
287
\end{code}

sof's avatar
sof committed
288
\begin{code}
289
qualName :: PprStyle -> QueryQualifyName
290
291
qualName (PprUser (qual_name,_) _)  n = qual_name n
qualName _other                     n = NameQual (moduleName (nameModule n))
Simon Marlow's avatar
Simon Marlow committed
292

293
qualModule :: PprStyle -> QueryQualifyModule
294
295
qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
qualModule _other                   _m = True
296

sof's avatar
sof committed
297
codeStyle :: PprStyle -> Bool
dterei's avatar
dterei committed
298
299
codeStyle (PprCode _)     = True
codeStyle _               = False
sof's avatar
sof committed
300

301
302
asmStyle :: PprStyle -> Bool
asmStyle (PprCode AsmStyle)  = True
303
asmStyle _other              = False
304

305
306
dumpStyle :: PprStyle -> Bool
dumpStyle PprDump = True
307
dumpStyle _other  = False
308

309
debugStyle :: PprStyle -> Bool
dterei's avatar
dterei committed
310
311
debugStyle PprDebug = True
debugStyle _other   = False
312

sof's avatar
sof committed
313
userStyle ::  PprStyle -> Bool
314
userStyle (PprUser _ _) = True
315
userStyle _other        = False
sof's avatar
sof committed
316

dterei's avatar
dterei committed
317
318
319
320
321
ifPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
ifPprDebug d = SDoc $ \ctx ->
    case ctx of
        SDC{sdocStyle=PprDebug} -> runSDoc d ctx
        _                       -> Pretty.empty
sof's avatar
sof committed
322
\end{code}
323

sof's avatar
sof committed
324
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
325
hPrintDump :: DynFlags -> Handle -> SDoc -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
326
hPrintDump dflags h doc = do
Thomas Schilling's avatar
Thomas Schilling committed
327
   Pretty.printDoc PageMode h
Ian Lynagh's avatar
Ian Lynagh committed
328
     (runSDoc better_doc (initSDocContext dflags defaultDumpStyle))
329
   hFlush h
sof's avatar
sof committed
330
 where
331
   better_doc = doc $$ blankLine
332

333
printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
334
printForUser dflags handle unqual doc
Thomas Schilling's avatar
Thomas Schilling committed
335
  = Pretty.printDoc PageMode handle
Ian Lynagh's avatar
Ian Lynagh committed
336
      (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
337

338
339
printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
                    -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
340
printForUserPartWay dflags handle d unqual doc
Thomas Schilling's avatar
Thomas Schilling committed
341
  = Pretty.printDoc PageMode handle
Ian Lynagh's avatar
Ian Lynagh committed
342
      (runSDoc doc (initSDocContext dflags (mkUserStyle unqual (PartWay d))))
343

344
-- printForC, printForAsm do what they sound like
345
printForC :: DynFlags -> Handle -> SDoc -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
346
printForC dflags handle doc =
Thomas Schilling's avatar
Thomas Schilling committed
347
  Pretty.printDoc LeftMode handle
Ian Lynagh's avatar
Ian Lynagh committed
348
    (runSDoc doc (initSDocContext dflags (PprCode CStyle)))
349

350
printForAsm :: DynFlags -> Handle -> SDoc -> IO ()
Ian Lynagh's avatar
Ian Lynagh committed
351
printForAsm dflags handle doc =
Thomas Schilling's avatar
Thomas Schilling committed
352
  Pretty.printDoc LeftMode handle
Ian Lynagh's avatar
Ian Lynagh committed
353
    (runSDoc doc (initSDocContext dflags (PprCode AsmStyle)))
354

sof's avatar
sof committed
355
356
pprCode :: CodeStyle -> SDoc -> SDoc
pprCode cs d = withPprStyle (PprCode cs) d
357

358
359
360
mkCodeStyle :: CodeStyle -> PprStyle
mkCodeStyle = PprCode

361
362
-- Can't make SDoc an instance of Show because SDoc is just a function type
-- However, Doc *is* an instance of Show
363
-- showSDoc just blasts it out as a string
Ian Lynagh's avatar
Ian Lynagh committed
364
showSDoc :: DynFlags -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
365
showSDoc dflags d =
Thomas Schilling's avatar
Thomas Schilling committed
366
  Pretty.showDocWith PageMode
Ian Lynagh's avatar
Ian Lynagh committed
367
    (runSDoc d (initSDocContext dflags defaultUserStyle))
368

Ian Lynagh's avatar
Ian Lynagh committed
369
renderWithStyle :: DynFlags -> SDoc -> PprStyle -> String
Ian Lynagh's avatar
Ian Lynagh committed
370
371
renderWithStyle dflags sdoc sty =
  Pretty.render (runSDoc sdoc (initSDocContext dflags sty))
372

373
374
375
-- This shows an SDoc, but on one line only. It's cheaper than a full
-- showSDoc, designed for when we're getting results like "Foo.bar"
-- and "foo{uniq strictness}" so we don't want fancy layout anyway.
376
showSDocOneLine :: DynFlags -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
377
showSDocOneLine dflags d
378
 = Pretty.showDocWith PageMode
Ian Lynagh's avatar
Ian Lynagh committed
379
    (runSDoc d (initSDocContext dflags defaultUserStyle))
380

381
showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
382
383
showSDocForUser dflags unqual doc
 = show (runSDoc doc (initSDocContext dflags (mkUserStyle unqual AllTheWay)))
384

385
showSDocUnqual :: DynFlags -> SDoc -> String
386
-- Only used in the gruesome isOperator
Ian Lynagh's avatar
Ian Lynagh committed
387
388
showSDocUnqual dflags d
 = show (runSDoc d (initSDocContext dflags (mkUserStyle neverQualify AllTheWay)))
389

390
showSDocDump :: DynFlags -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
391
392
showSDocDump dflags d
 = Pretty.showDocWith PageMode (runSDoc d (initSDocContext dflags defaultDumpStyle))
393

394
showSDocDumpOneLine :: DynFlags -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
395
396
showSDocDumpOneLine dflags d
 = Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext dflags PprDump))
397

398
showSDocDebug :: DynFlags -> SDoc -> String
Ian Lynagh's avatar
Ian Lynagh committed
399
showSDocDebug dflags d = show (runSDoc d (initSDocContext dflags PprDebug))
400

Ian Lynagh's avatar
Ian Lynagh committed
401
showPpr :: Outputable a => DynFlags -> a -> String
Ian Lynagh's avatar
Ian Lynagh committed
402
showPpr dflags = showSDoc dflags . ppr
403
404
\end{code}

405
\begin{code}
406
docToSDoc :: Doc -> SDoc
Thomas Schilling's avatar
Thomas Schilling committed
407
docToSDoc d = SDoc (\_ -> d)
408

409
410
empty    :: SDoc
char     :: Char       -> SDoc
batterseapower's avatar
batterseapower committed
411
text     :: String     -> SDoc
412
ftext    :: FastString -> SDoc
413
ptext    :: LitString  -> SDoc
414
415
416
417
418
419
int      :: Int        -> SDoc
integer  :: Integer    -> SDoc
float    :: Float      -> SDoc
double   :: Double     -> SDoc
rational :: Rational   -> SDoc

Thomas Schilling's avatar
Thomas Schilling committed
420
421
422
423
424
425
426
427
428
429
empty       = docToSDoc $ Pretty.empty
char c      = docToSDoc $ Pretty.char c
text s      = docToSDoc $ Pretty.text s
ftext s     = docToSDoc $ Pretty.ftext s
ptext s     = docToSDoc $ Pretty.ptext s
int n       = docToSDoc $ Pretty.int n
integer n   = docToSDoc $ Pretty.integer n
float n     = docToSDoc $ Pretty.float n
double n    = docToSDoc $ Pretty.double n
rational n  = docToSDoc $ Pretty.rational n
430

431
432
parens, braces, brackets, quotes, quote, 
        paBrackets, doubleQuotes, angleBrackets :: SDoc -> SDoc
433

434
435
436
437
438
parens d        = SDoc $ Pretty.parens . runSDoc d
braces d        = SDoc $ Pretty.braces . runSDoc d
brackets d      = SDoc $ Pretty.brackets . runSDoc d
quote d         = SDoc $ Pretty.quote . runSDoc d
doubleQuotes d  = SDoc $ Pretty.doubleQuotes . runSDoc d
Thomas Schilling's avatar
Thomas Schilling committed
439
angleBrackets d = char '<' <> d <> char '>'
440
paBrackets d    = ptext (sLit "[:") <> d <> ptext (sLit ":]")
441

442
443
cparen :: Bool -> SDoc -> SDoc

Thomas Schilling's avatar
Thomas Schilling committed
444
cparen b d     = SDoc $ Pretty.cparen b . runSDoc d
mnislaih's avatar
mnislaih committed
445

446
-- 'quotes' encloses something in single quotes...
447
-- but it omits them if the thing begins or ends in a single quote
448
-- so that we don't get `foo''.  Instead we just have foo'.
dterei's avatar
dterei committed
449
quotes d = SDoc $ \sty ->
450
451
452
453
454
455
           let pp_d = runSDoc d sty
               str  = show pp_d
           in case (str, snocView str) of
             (_, Just (_, '\'')) -> pp_d
             ('\'' : _, _)       -> pp_d
             _other              -> Pretty.quotes pp_d
456

457
semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
458
darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
459

Thomas Schilling's avatar
Thomas Schilling committed
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
blankLine  = docToSDoc $ Pretty.ptext (sLit "")
dcolon     = docToSDoc $ Pretty.ptext (sLit "::")
arrow      = docToSDoc $ Pretty.ptext (sLit "->")
darrow     = docToSDoc $ Pretty.ptext (sLit "=>")
semi       = docToSDoc $ Pretty.semi
comma      = docToSDoc $ Pretty.comma
colon      = docToSDoc $ Pretty.colon
equals     = docToSDoc $ Pretty.equals
space      = docToSDoc $ Pretty.space
underscore = char '_'
dot        = char '.'
lparen     = docToSDoc $ Pretty.lparen
rparen     = docToSDoc $ Pretty.rparen
lbrack     = docToSDoc $ Pretty.lbrack
rbrack     = docToSDoc $ Pretty.rbrack
lbrace     = docToSDoc $ Pretty.lbrace
rbrace     = docToSDoc $ Pretty.rbrace
477
478

nest :: Int -> SDoc -> SDoc
batterseapower's avatar
batterseapower committed
479
480
481
482
483
484
-- ^ Indent 'SDoc' some specified amount
(<>) :: SDoc -> SDoc -> SDoc
-- ^ Join two 'SDoc' together horizontally without a gap
(<+>) :: SDoc -> SDoc -> SDoc
-- ^ Join two 'SDoc' together horizontally with a gap between them
($$) :: SDoc -> SDoc -> SDoc
dterei's avatar
dterei committed
485
-- ^ Join two 'SDoc' together vertically; if there is
batterseapower's avatar
batterseapower committed
486
487
488
-- no vertical overlap it "dovetails" the two onto one line
($+$) :: SDoc -> SDoc -> SDoc
-- ^ Join two 'SDoc' together vertically
489

Thomas Schilling's avatar
Thomas Schilling committed
490
491
492
493
494
nest n d    = SDoc $ Pretty.nest n . runSDoc d
(<>) d1 d2  = SDoc $ \sty -> (Pretty.<>)  (runSDoc d1 sty) (runSDoc d2 sty)
(<+>) d1 d2 = SDoc $ \sty -> (Pretty.<+>) (runSDoc d1 sty) (runSDoc d2 sty)
($$) d1 d2  = SDoc $ \sty -> (Pretty.$$)  (runSDoc d1 sty) (runSDoc d2 sty)
($+$) d1 d2 = SDoc $ \sty -> (Pretty.$+$) (runSDoc d1 sty) (runSDoc d2 sty)
495

batterseapower's avatar
batterseapower committed
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
hcat :: [SDoc] -> SDoc
-- ^ Concatenate 'SDoc' horizontally
hsep :: [SDoc] -> SDoc
-- ^ Concatenate 'SDoc' horizontally with a space between each one
vcat :: [SDoc] -> SDoc
-- ^ Concatenate 'SDoc' vertically with dovetailing
sep :: [SDoc] -> SDoc
-- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
cat :: [SDoc] -> SDoc
-- ^ Catenate: is either like 'hcat' or like 'vcat', depending on what fits
fsep :: [SDoc] -> SDoc
-- ^ A paragraph-fill combinator. It's much like sep, only it
-- keeps fitting things on one line until it can't fit any more.
fcat :: [SDoc] -> SDoc
-- ^ This behaves like 'fsep', but it uses '<>' for horizontal conposition rather than '<+>'
511
512


Thomas Schilling's avatar
Thomas Schilling committed
513
514
515
516
517
518
519
hcat ds = SDoc $ \sty -> Pretty.hcat [runSDoc d sty | d <- ds]
hsep ds = SDoc $ \sty -> Pretty.hsep [runSDoc d sty | d <- ds]
vcat ds = SDoc $ \sty -> Pretty.vcat [runSDoc d sty | d <- ds]
sep ds  = SDoc $ \sty -> Pretty.sep  [runSDoc d sty | d <- ds]
cat ds  = SDoc $ \sty -> Pretty.cat  [runSDoc d sty | d <- ds]
fsep ds = SDoc $ \sty -> Pretty.fsep [runSDoc d sty | d <- ds]
fcat ds = SDoc $ \sty -> Pretty.fcat [runSDoc d sty | d <- ds]
520

batterseapower's avatar
batterseapower committed
521
522
523
524
hang :: SDoc  -- ^ The header
      -> Int  -- ^ Amount to indent the hung body
      -> SDoc -- ^ The hung body, indented and placed below the header
      -> SDoc
Thomas Schilling's avatar
Thomas Schilling committed
525
hang d1 n d2   = SDoc $ \sty -> Pretty.hang (runSDoc d1 sty) n (runSDoc d2 sty)
526

batterseapower's avatar
batterseapower committed
527
528
529
punctuate :: SDoc   -- ^ The punctuation
          -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
          -> [SDoc] -- ^ Punctuated list
530
punctuate _ []     = []
531
punctuate p (d:ds) = go d ds
dterei's avatar
dterei committed
532
533
534
                   where
                     go d [] = [d]
                     go d (e:es) = (d <> p) : go e es
535
536
537
538
539
540
541

ppWhen, ppUnless :: Bool -> SDoc -> SDoc
ppWhen True  doc = doc
ppWhen False _   = empty

ppUnless True  _   = empty
ppUnless False doc = doc
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

-- | A colour\/style for use with 'coloured'.
newtype PprColour = PprColour String

-- Colours

colType :: PprColour
colType = PprColour "\27[34m"

colBold :: PprColour
colBold = PprColour "\27[;1m"

colCoerc :: PprColour
colCoerc = PprColour "\27[34m"

colDataCon :: PprColour
Thomas Schilling's avatar
Thomas Schilling committed
558
colDataCon = PprColour "\27[31m"
559

Thomas Schilling's avatar
Thomas Schilling committed
560
561
colBinder :: PprColour
colBinder = PprColour "\27[32m"
562
563
564
565
566
567
568
569
570

colReset :: PprColour
colReset = PprColour "\27[0m"

-- | Apply the given colour\/style for the argument.
--
-- Only takes effect if colours are enabled.
coloured :: PprColour -> SDoc -> SDoc
-- TODO: coloured _ sdoc ctxt | coloursDisabled = sdoc ctxt
Thomas Schilling's avatar
Thomas Schilling committed
571
572
573
574
coloured col@(PprColour c) sdoc =
  SDoc $ \ctx@SDC{ sdocLastColour = PprColour lc } ->
    let ctx' = ctx{ sdocLastColour = col } in
    Pretty.zeroWidthText c Pretty.<> runSDoc sdoc ctx' Pretty.<> Pretty.zeroWidthText lc
575
576
577
578
579
580
581

bold :: SDoc -> SDoc
bold = coloured colBold

keyword :: SDoc -> SDoc
keyword = bold

582
\end{code}
sof's avatar
sof committed
583

sof's avatar
sof committed
584
585

%************************************************************************
dterei's avatar
dterei committed
586
%*                                                                      *
sof's avatar
sof committed
587
\subsection[Outputable-class]{The @Outputable@ class}
dterei's avatar
dterei committed
588
%*                                                                      *
sof's avatar
sof committed
589
590
591
%************************************************************************

\begin{code}
batterseapower's avatar
batterseapower committed
592
-- | Class designating that some type has an 'SDoc' representation
sof's avatar
sof committed
593
class Outputable a where
dterei's avatar
dterei committed
594
595
596
597
598
        ppr :: a -> SDoc
        pprPrec :: Rational -> a -> SDoc
                -- 0 binds least tightly
                -- We use Rational because there is always a
                -- Rational between any other two Rationals
Simon Peyton Jones's avatar
Simon Peyton Jones committed
599

dterei's avatar
dterei committed
600
601
        ppr = pprPrec 0
        pprPrec _ = ppr
602
603

class PlatformOutputable a where
dterei's avatar
dterei committed
604
605
606
607
608
        pprPlatform :: Platform -> a -> SDoc
        pprPlatformPrec :: Platform -> Rational -> a -> SDoc

        pprPlatform platform = pprPlatformPrec platform 0
        pprPlatformPrec platform _ = pprPlatform platform
sof's avatar
sof committed
609
610
\end{code}

611
612
\begin{code}
instance Outputable Bool where
Ian Lynagh's avatar
Ian Lynagh committed
613
614
    ppr True  = ptext (sLit "True")
    ppr False = ptext (sLit "False")
615

sof's avatar
sof committed
616
instance Outputable Int where
617
   ppr n = int n
618
619
instance PlatformOutputable Int where
   pprPlatform _ = ppr
sof's avatar
sof committed
620

621
622
623
instance Outputable Word16 where
   ppr n = integer $ fromIntegral n

624
625
626
instance Outputable Word32 where
   ppr n = integer $ fromIntegral n

627
628
629
instance Outputable Word where
   ppr n = integer $ fromIntegral n

630
631
instance Outputable () where
   ppr _ = text "()"
632
633
instance PlatformOutputable () where
   pprPlatform _ _ = text "()"
634

635
instance (Outputable a) => Outputable [a] where
636
    ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
637
638
instance (PlatformOutputable a) => PlatformOutputable [a] where
    pprPlatform platform xs = brackets (fsep (punctuate comma (map (pprPlatform platform) xs)))
639

640
641
642
instance (Outputable a) => Outputable (Set a) where
    ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))

643
instance (Outputable a, Outputable b) => Outputable (a, b) where
644
    ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
645
646
647
instance (PlatformOutputable a, PlatformOutputable b) => PlatformOutputable (a, b) where
    pprPlatform platform (x,y)
     = parens (sep [pprPlatform platform x <> comma, pprPlatform platform y])
648

649
instance Outputable a => Outputable (Maybe a) where
Ian Lynagh's avatar
Ian Lynagh committed
650
651
  ppr Nothing = ptext (sLit "Nothing")
  ppr (Just x) = ptext (sLit "Just") <+> ppr x
652
653
654
instance PlatformOutputable a => PlatformOutputable (Maybe a) where
  pprPlatform _        Nothing  = ptext (sLit "Nothing")
  pprPlatform platform (Just x) = ptext (sLit "Just") <+> pprPlatform platform x
655

656
instance (Outputable a, Outputable b) => Outputable (Either a b) where
Ian Lynagh's avatar
Ian Lynagh committed
657
658
  ppr (Left x)  = ptext (sLit "Left")  <+> ppr x
  ppr (Right y) = ptext (sLit "Right") <+> ppr y
659

660
661
-- ToDo: may not be used
instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
662
    ppr (x,y,z) =
663
      parens (sep [ppr x <> comma,
dterei's avatar
dterei committed
664
665
                   ppr y <> comma,
                   ppr z ])
666

667
instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
dterei's avatar
dterei committed
668
         Outputable (a, b, c, d) where
669
670
    ppr (a,b,c,d) =
      parens (sep [ppr a <> comma,
dterei's avatar
dterei committed
671
672
673
                   ppr b <> comma,
                   ppr c <> comma,
                   ppr d])
674
675

instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
dterei's avatar
dterei committed
676
         Outputable (a, b, c, d, e) where
677
678
    ppr (a,b,c,d,e) =
      parens (sep [ppr a <> comma,
dterei's avatar
dterei committed
679
680
681
682
                   ppr b <> comma,
                   ppr c <> comma,
                   ppr d <> comma,
                   ppr e])
683

684
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>
dterei's avatar
dterei committed
685
         Outputable (a, b, c, d, e, f) where
686
687
    ppr (a,b,c,d,e,f) =
      parens (sep [ppr a <> comma,
dterei's avatar
dterei committed
688
689
690
691
692
                   ppr b <> comma,
                   ppr c <> comma,
                   ppr d <> comma,
                   ppr e <> comma,
                   ppr f])
693
694

instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>
dterei's avatar
dterei committed
695
         Outputable (a, b, c, d, e, f, g) where
696
697
    ppr (a,b,c,d,e,f,g) =
      parens (sep [ppr a <> comma,
dterei's avatar
dterei committed
698
699
700
701
702
703
                   ppr b <> comma,
                   ppr c <> comma,
                   ppr d <> comma,
                   ppr e <> comma,
                   ppr f <> comma,
                   ppr g])
704

705
instance Outputable FastString where
dterei's avatar
dterei committed
706
707
    ppr fs = ftext fs           -- Prints an unadorned string,
                                -- no double quotes or anything
708

709
instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
710
    ppr m = ppr (M.toList m)
711
712
instance (PlatformOutputable key, PlatformOutputable elt) => PlatformOutputable (M.Map key elt) where
    pprPlatform platform m = pprPlatform platform (M.toList m)
713
714
instance (Outputable elt) => Outputable (IM.IntMap elt) where
    ppr m = ppr (IM.toList m)
715
716
717
\end{code}

%************************************************************************
dterei's avatar
dterei committed
718
%*                                                                      *
719
\subsection{The @OutputableBndr@ class}
dterei's avatar
dterei committed
720
%*                                                                      *
721
722
723
%************************************************************************

\begin{code}
batterseapower's avatar
batterseapower committed
724
725
726
-- | 'BindingSite' is used to tell the thing that prints binder what
-- language construct is binding the identifier.  This can be used
-- to decide how much info to print.
727
728
data BindingSite = LambdaBind | CaseBind | LetBind

batterseapower's avatar
batterseapower committed
729
730
-- | When we print a binder, we often want to print its type too.
-- The @OutputableBndr@ class encapsulates this idea.
731
732
class Outputable a => OutputableBndr a where
   pprBndr :: BindingSite -> a -> SDoc
733
   pprBndr _b x = ppr x
734
735
736
737
738

   pprPrefixOcc, pprInfixOcc :: a -> SDoc
      -- Print an occurrence of the name, suitable either in the 
      -- prefix position of an application, thus   (f a b) or  ((+) x)
      -- or infix position,                 thus   (a `f` b) or  (x + y)
739
740
741
\end{code}

%************************************************************************
dterei's avatar
dterei committed
742
%*                                                                      *
743
\subsection{Random printing helpers}
dterei's avatar
dterei committed
744
%*                                                                      *
745
746
747
%************************************************************************

\begin{code}
748
-- We have 31-bit Chars and will simply use Show instances of Char and String.
batterseapower's avatar
batterseapower committed
749
750

-- | Special combinator for showing character literals.
751
752
753
pprHsChar :: Char -> SDoc
pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
            | otherwise      = text (show c)
754

batterseapower's avatar
batterseapower committed
755
-- | Special combinator for showing string literals.
756
pprHsString :: FastString -> SDoc
757
pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))
758
759
760
761
762
763

---------------------
-- Put a name in parens if it's an operator
pprPrefixVar :: Bool -> SDoc -> SDoc
pprPrefixVar is_operator pp_v
  | is_operator = parens pp_v
dterei's avatar
dterei committed
764
  | otherwise   = pp_v
765
766
767

-- Put a name in backquotes if it's not an operator
pprInfixVar :: Bool -> SDoc -> SDoc
dterei's avatar
dterei committed
768
pprInfixVar is_operator pp_v
769
770
771
772
  | is_operator = pp_v
  | otherwise   = char '`' <> pp_v <> char '`'

---------------------
773
774
pprFastFilePath :: FastString -> SDoc
pprFastFilePath path = text $ normalise $ unpackFS path
sof's avatar
sof committed
775
776
\end{code}

sof's avatar
sof committed
777
%************************************************************************
dterei's avatar
dterei committed
778
%*                                                                      *
sof's avatar
sof committed
779
\subsection{Other helper functions}
dterei's avatar
dterei committed
780
%*                                                                      *
sof's avatar
sof committed
781
782
783
%************************************************************************

\begin{code}
batterseapower's avatar
batterseapower committed
784
785
786
787
pprWithCommas :: (a -> SDoc) -- ^ The pretty printing function to use
              -> [a]         -- ^ The things to be pretty printed
              -> SDoc        -- ^ 'SDoc' where the things have been pretty printed,
                             -- comma-separated and finally packed into a paragraph.
788
pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
789

batterseapower's avatar
batterseapower committed
790
-- | Returns the seperated concatenation of the pretty printed things.
791
interppSP  :: Outputable a => [a] -> SDoc
792
interppSP  xs = sep (map ppr xs)
sof's avatar
sof committed
793

batterseapower's avatar
batterseapower committed
794
-- | Returns the comma-seperated concatenation of the pretty printed things.
795
interpp'SP :: Outputable a => [a] -> SDoc
796
interpp'SP xs = sep (punctuate comma (map ppr xs))
797

batterseapower's avatar
batterseapower committed
798
799
800
-- | Returns the comma-seperated concatenation of the quoted pretty printed things.
--
-- > [x,y,z]  ==>  `x', `y', `z'
801
pprQuotedList :: Outputable a => [a] -> SDoc
802
803
804
805
806
807
808
809
810
pprQuotedList = quotedList . map ppr

quotedList :: [SDoc] -> SDoc
quotedList xs = hsep (punctuate comma (map quotes xs))

quotedListWithOr :: [SDoc] -> SDoc
-- [x,y,z]  ==>  `x', `y' or `z'
quotedListWithOr xs@(_:_:_) = quotedList (init xs) <+> ptext (sLit "or") <+> quotes (last xs)
quotedListWithOr xs = quotedList xs
sof's avatar
sof committed
811
812
813
814
\end{code}


%************************************************************************
dterei's avatar
dterei committed
815
%*                                                                      *
sof's avatar
sof committed
816
\subsection{Printing numbers verbally}
dterei's avatar
dterei committed
817
%*                                                                      *
sof's avatar
sof committed
818
%************************************************************************
sof's avatar
sof committed
819
820

\begin{code}
821
822
823
824
825
826
827
828
829
intWithCommas :: Integral a => a -> SDoc
-- Prints a big integer with commas, eg 345,821
intWithCommas n
  | n < 0     = char '-' <> intWithCommas (-n)
  | q == 0    = int (fromIntegral r)
  | otherwise = intWithCommas q <> comma <> int (fromIntegral r)
  where
    (q,r) = n `quotRem` 1000

batterseapower's avatar
batterseapower committed
830
831
832
833
834
-- | Converts an integer to a verbal index:
--
-- > speakNth 1 = text "first"
-- > speakNth 5 = text "fifth"
-- > speakNth 21 = text "21st"
835
speakNth :: Int -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
836
837
838
839
840
841
speakNth 1 = ptext (sLit "first")
speakNth 2 = ptext (sLit "second")
speakNth 3 = ptext (sLit "third")
speakNth 4 = ptext (sLit "fourth")
speakNth 5 = ptext (sLit "fifth")
speakNth 6 = ptext (sLit "sixth")
842
speakNth n = hcat [ int n, text suffix ]
sof's avatar
sof committed
843
  where
dterei's avatar
dterei committed
844
845
846
847
848
    suffix | n <= 20       = "th"       -- 11,12,13 are non-std
           | last_dig == 1 = "st"
           | last_dig == 2 = "nd"
           | last_dig == 3 = "rd"
           | otherwise     = "th"
sof's avatar
sof committed
849

850
    last_dig = n `rem` 10
851

batterseapower's avatar
batterseapower committed
852
-- | Converts an integer to a verbal multiplicity:
dterei's avatar
dterei committed
853
--
batterseapower's avatar
batterseapower committed
854
855
856
-- > speakN 0 = text "none"
-- > speakN 5 = text "five"
-- > speakN 10 = text "10"
857
speakN :: Int -> SDoc
dterei's avatar
dterei committed
858
859
speakN 0 = ptext (sLit "none")  -- E.g.  "he has none"
speakN 1 = ptext (sLit "one")   -- E.g.  "he has one"
Ian Lynagh's avatar
Ian Lynagh committed
860
861
862
863
864
speakN 2 = ptext (sLit "two")
speakN 3 = ptext (sLit "three")
speakN 4 = ptext (sLit "four")
speakN 5 = ptext (sLit "five")
speakN 6 = ptext (sLit "six")
865
866
speakN n = int n

batterseapower's avatar
batterseapower committed
867
868
869
870
871
872
-- | Converts an integer and object description to a statement about the
-- multiplicity of those objects:
--
-- > speakNOf 0 (text "melon") = text "no melons"
-- > speakNOf 1 (text "melon") = text "one melon"
-- > speakNOf 3 (text "melon") = text "three melons"
873
speakNOf :: Int -> SDoc -> SDoc
batterseapower's avatar
batterseapower committed
874
speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'
dterei's avatar
dterei committed
875
876
speakNOf 1 d = ptext (sLit "one") <+> d                 -- E.g. "one argument"
speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments"
877

batterseapower's avatar
batterseapower committed
878
879
880
881
882
-- | Converts a strictly positive integer into a number of times:
--
-- > speakNTimes 1 = text "once"
-- > speakNTimes 2 = text "twice"
-- > speakNTimes 4 = text "4 times"
883
speakNTimes :: Int {- >=1 -} -> SDoc
dterei's avatar
dterei committed
884
885
speakNTimes t | t == 1     = ptext (sLit "once")
              | t == 2     = ptext (sLit "twice")
Ian Lynagh's avatar
Ian Lynagh committed
886
              | otherwise  = speakN t <+> ptext (sLit "times")
887

batterseapower's avatar
batterseapower committed
888
889
890
891
892
-- | Determines the pluralisation suffix appropriate for the length of a list:
--
-- > plural [] = char 's'
-- > plural ["Hello"] = empty
-- > plural ["Hello", "World"] = char 's'
893
894
895
plural :: [a] -> SDoc
plural [_] = empty  -- a bit frightening, but there you are
plural _   = char 's'
896
897
\end{code}

898

899
%************************************************************************
dterei's avatar
dterei committed
900
%*                                                                      *
901
\subsection{Error handling}
dterei's avatar
dterei committed
902
%*                                                                      *
903
904
905
%************************************************************************

\begin{code}
906

batterseapower's avatar
batterseapower committed
907
908
pprPanic :: String -> SDoc -> a
-- ^ Throw an exception saying "bug in GHC"
Ian Lynagh's avatar
Ian Lynagh committed
909
pprPanic    = panicDoc
batterseapower's avatar
batterseapower committed
910

911
pprSorry :: String -> SDoc -> a
Ian Lynagh's avatar
Ian Lynagh committed
912
-- ^ Throw an exception saying "this isn't finished yet"
913
pprSorry    = sorryDoc
914
915
916
917


pprPgmError :: String -> SDoc -> a
-- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors)
918
pprPgmError = pgmErrorDoc
919

920
921
922

pprTrace :: String -> SDoc -> a -> a
-- ^ If debug output is on, show some 'SDoc' on the screen
Simon Marlow's avatar
Simon Marlow committed
923
924
pprTrace str doc x
   | opt_NoDebugOutput = x
925
   | otherwise         = pprDebugAndThen tracingDynFlags trace str doc x
926

927
pprDefiniteTrace :: DynFlags -> String -> SDoc -> a -> a
928
-- ^ Same as pprTrace, but show even if -dno-debug-output is on
929
pprDefiniteTrace dflags str doc x = pprDebugAndThen dflags trace str doc x
930

931
pprPanicFastInt :: String -> SDoc -> FastInt
batterseapower's avatar
batterseapower committed
932
-- ^ Specialization of pprPanic that can be safely used with 'FastInt'
933
pprPanicFastInt heading pretty_msg = panicDocFastInt heading pretty_msg
934

935
warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
batterseapower's avatar
batterseapower committed
936
937
-- ^ Just warn about an assertion failure, recording the given file and line number.
-- Should typically be accessed with the WARN macros
938
warnPprTrace _     _     _     _    x | not debugIsOn     = x
Simon Marlow's avatar
Simon Marlow committed
939
warnPprTrace _     _file _line _msg x | opt_NoDebugOutput = x