patch from #1782; fixes check-packages target on Solaris
[ghc-hetmet.git] / compiler / utils / Outputable.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-1998
4 %
5
6 Outputable: defines classes for pretty-printing and forcing, both
7 forms of ``output.''
8
9 \begin{code}
10 module Outputable (
11         Outputable(..), OutputableBndr(..),     -- Class
12
13         BindingSite(..),
14
15         PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, QualifyName(..),
16         getPprStyle, withPprStyle, withPprStyleDoc, 
17         pprDeeper, pprDeeperList, pprSetDepth,
18         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
19         ifPprDebug, qualName, qualModule,
20         mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
21
22         SDoc,           -- Abstract
23         docToSDoc,
24         interppSP, interpp'SP, pprQuotedList, pprWithCommas,
25         empty, nest,
26         text, char, ftext, ptext,
27         int, integer, float, double, rational,
28         parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
29         semi, comma, colon, dcolon, space, equals, dot, arrow,
30         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
31         (<>), (<+>), hcat, hsep, 
32         ($$), ($+$), vcat, 
33         sep, cat, 
34         fsep, fcat, 
35         hang, punctuate,
36         speakNth, speakNTimes, speakN, speakNOf, plural,
37
38         printSDoc, printErrs, hPrintDump, printDump,
39         printForC, printForAsm, printForUser,
40         pprCode, mkCodeStyle,
41         showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
42         showSDocUnqual, showsPrecSDoc,
43         pprHsChar, pprHsString,
44
45         -- error handling
46         pprPanic, assertPprPanic, pprPanic#, pprPgmError, 
47         pprTrace, warnPprTrace,
48         trace, pgmError, panic, panic#, assertPanic
49     ) where
50
51 #include "HsVersions.h"
52
53
54 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
55 import {-# SOURCE #-}   OccName( OccName )
56
57 import StaticFlags      ( opt_PprStyle_Debug, opt_PprUserLength )
58 import FastString
59 import FastTypes
60 import GHC.Ptr
61 import qualified Pretty
62 import Pretty           ( Doc, Mode(..) )
63 import Panic
64
65 import Data.Word        ( Word32 )
66 import System.IO        ( Handle, stderr, stdout, hFlush )
67 import Data.Char        ( ord )
68 \end{code}
69
70
71 %************************************************************************
72 %*                                                                      *
73 \subsection{The @PprStyle@ data type}
74 %*                                                                      *
75 %************************************************************************
76
77 \begin{code}
78
79 data PprStyle
80   = PprUser PrintUnqualified Depth
81                 -- Pretty-print in a way that will make sense to the
82                 -- ordinary user; must be very close to Haskell
83                 -- syntax, etc.
84                 -- Assumes printing tidied code: non-system names are
85                 -- printed without uniques.
86
87   | PprCode CodeStyle
88                 -- Print code; either C or assembler
89
90   | PprDump     -- For -ddump-foo; less verbose than PprDebug.
91                 -- Does not assume tidied code: non-external names
92                 -- are printed with uniques.
93
94   | PprDebug    -- Full debugging output
95
96 data CodeStyle = CStyle         -- The format of labels differs for C and assembler
97                | AsmStyle
98
99 data Depth = AllTheWay
100            | PartWay Int        -- 0 => stop
101
102
103 -- -----------------------------------------------------------------------------
104 -- Printing original names
105
106 -- When printing code that contains original names, we need to map the
107 -- original names back to something the user understands.  This is the
108 -- purpose of the pair of functions that gets passed around
109 -- when rendering 'SDoc'.
110
111 -- | given an /original/ name, this function tells you which module
112 -- name it should be qualified with when printing for the user, if
113 -- any.  For example, given @Control.Exception.catch@, which is in scope
114 -- as @Exception.catch@, this fuction will return @Just "Exception"@.
115 -- Note that the return value is a ModuleName, not a Module, because
116 -- in source code, names are qualified by ModuleNames.
117 type QueryQualifyName = Module -> OccName -> QualifyName
118
119 data QualifyName                        -- given P:M.T
120         = NameUnqual                    -- refer to it as "T"
121         | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
122         | NameNotInScope1               
123                 -- it is not in scope at all, but M.T is not bound in the current
124                 -- scope, so we can refer to it as "M.T"
125         | NameNotInScope2
126                 -- it is not in scope at all, and M.T is already bound in the
127                 -- current scope, so we must refer to it as "P:M.T"
128
129
130 -- | For a given module, we need to know whether to print it with
131 -- a package name to disambiguate it.
132 type QueryQualifyModule = Module -> Bool
133
134 type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
135
136 alwaysQualifyNames :: QueryQualifyName
137 alwaysQualifyNames m _ = NameQual (moduleName m)
138
139 neverQualifyNames :: QueryQualifyName
140 neverQualifyNames _ _ = NameUnqual
141
142 alwaysQualifyModules :: QueryQualifyModule
143 alwaysQualifyModules _ = True
144
145 neverQualifyModules :: QueryQualifyModule
146 neverQualifyModules _ = False
147
148 type QueryQualifies = (QueryQualifyName, QueryQualifyModule)
149
150 alwaysQualify, neverQualify :: QueryQualifies
151 alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
152 neverQualify  = (neverQualifyNames,  neverQualifyModules)
153
154 defaultUserStyle, defaultDumpStyle :: PprStyle
155
156 defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
157
158 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
159                  |  otherwise          = PprDump
160
161 -- | Style for printing error messages
162 mkErrStyle :: PrintUnqualified -> PprStyle
163 mkErrStyle qual = mkUserStyle qual (PartWay opt_PprUserLength)
164
165 defaultErrStyle :: PprStyle
166 -- Default style for error messages
167 -- It's a bit of a hack because it doesn't take into account what's in scope
168 -- Only used for desugarer warnings, and typechecker errors in interface sigs
169 defaultErrStyle 
170   | opt_PprStyle_Debug   = mkUserStyle alwaysQualify AllTheWay
171   | otherwise            = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
172
173 mkUserStyle :: QueryQualifies -> Depth -> PprStyle
174 mkUserStyle unqual depth
175    | opt_PprStyle_Debug = PprDebug
176    | otherwise          = PprUser unqual depth
177 \end{code}
178
179 Orthogonal to the above printing styles are (possibly) some
180 command-line flags that affect printing (often carried with the
181 style).  The most likely ones are variations on how much type info is
182 shown.
183
184 The following test decides whether or not we are actually generating
185 code (either C or assembly), or generating interface files.
186
187 %************************************************************************
188 %*                                                                      *
189 \subsection{The @SDoc@ data type}
190 %*                                                                      *
191 %************************************************************************
192
193 \begin{code}
194 type SDoc = PprStyle -> Doc
195
196 withPprStyle :: PprStyle -> SDoc -> SDoc
197 withPprStyle sty d _sty' = d sty
198
199 withPprStyleDoc :: PprStyle -> SDoc -> Doc
200 withPprStyleDoc sty d = d sty
201
202 pprDeeper :: SDoc -> SDoc
203 pprDeeper _ (PprUser _ (PartWay 0)) = Pretty.text "..."
204 pprDeeper d (PprUser q (PartWay n)) = d (PprUser q (PartWay (n-1)))
205 pprDeeper d other_sty               = d other_sty
206
207 pprDeeperList :: ([SDoc] -> SDoc) -> [SDoc] -> SDoc
208 -- Truncate a list that list that is longer than the current depth
209 pprDeeperList f ds (PprUser q (PartWay n))
210   | n==0      = Pretty.text "..."
211   | otherwise = f (go 0 ds) (PprUser q (PartWay (n-1)))
212   where
213     go _ [] = []
214     go i (d:ds) | i >= n    = [text "...."]
215                 | otherwise = d : go (i+1) ds
216
217 pprDeeperList f ds other_sty
218   = f ds other_sty
219
220 pprSetDepth :: Int -> SDoc -> SDoc
221 pprSetDepth  n d (PprUser q _) = d (PprUser q (PartWay n))
222 pprSetDepth _n d other_sty     = d other_sty
223
224 getPprStyle :: (PprStyle -> SDoc) -> SDoc
225 getPprStyle df sty = df sty sty
226 \end{code}
227
228 \begin{code}
229 qualName :: PprStyle -> QueryQualifyName
230 qualName (PprUser (qual_name,_) _) m  n = qual_name m n
231 qualName _other                    m _n = NameQual (moduleName m)
232
233 qualModule :: PprStyle -> QueryQualifyModule
234 qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
235 qualModule _other                   _m = True
236
237 codeStyle :: PprStyle -> Bool
238 codeStyle (PprCode _)     = True
239 codeStyle _               = False
240
241 asmStyle :: PprStyle -> Bool
242 asmStyle (PprCode AsmStyle)  = True
243 asmStyle _other              = False
244
245 dumpStyle :: PprStyle -> Bool
246 dumpStyle PprDump = True
247 dumpStyle _other  = False
248
249 debugStyle :: PprStyle -> Bool
250 debugStyle PprDebug       = True
251 debugStyle _other         = False
252
253 userStyle ::  PprStyle -> Bool
254 userStyle (PprUser _ _) = True
255 userStyle _other        = False
256
257 ifPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
258 ifPprDebug d sty@PprDebug = d sty
259 ifPprDebug _ _            = Pretty.empty
260 \end{code}
261
262 \begin{code}
263 -- Unused [7/02 sof]
264 printSDoc :: SDoc -> PprStyle -> IO ()
265 printSDoc d sty = do
266   Pretty.printDoc PageMode stdout (d sty)
267   hFlush stdout
268
269 -- I'm not sure whether the direct-IO approach of Pretty.printDoc
270 -- above is better or worse than the put-big-string approach here
271 printErrs :: Doc -> IO ()
272 printErrs doc = do Pretty.printDoc PageMode stderr doc
273                    hFlush stderr
274
275 printDump :: SDoc -> IO ()
276 printDump doc = hPrintDump stdout doc
277
278 hPrintDump :: Handle -> SDoc -> IO ()
279 hPrintDump h doc = do
280    Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
281    hFlush h
282  where
283    better_doc = doc $$ text ""
284
285 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
286 printForUser handle unqual doc 
287   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
288
289 -- printForC, printForAsm do what they sound like
290 printForC :: Handle -> SDoc -> IO ()
291 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
292
293 printForAsm :: Handle -> SDoc -> IO ()
294 printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
295
296 pprCode :: CodeStyle -> SDoc -> SDoc
297 pprCode cs d = withPprStyle (PprCode cs) d
298
299 mkCodeStyle :: CodeStyle -> PprStyle
300 mkCodeStyle = PprCode
301
302 -- Can't make SDoc an instance of Show because SDoc is just a function type
303 -- However, Doc *is* an instance of Show
304 -- showSDoc just blasts it out as a string
305 showSDoc :: SDoc -> String
306 showSDoc d = show (d defaultUserStyle)
307
308 showSDocForUser :: PrintUnqualified -> SDoc -> String
309 showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
310
311 showSDocUnqual :: SDoc -> String
312 -- Only used in the gruesome HsExpr.isOperator
313 showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
314
315 showsPrecSDoc :: Int -> SDoc -> ShowS
316 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
317
318 showSDocDump :: SDoc -> String
319 showSDocDump d = show (d PprDump)
320
321 showSDocDebug :: SDoc -> String
322 showSDocDebug d = show (d PprDebug)
323 \end{code}
324
325 \begin{code}
326 docToSDoc :: Doc -> SDoc
327 docToSDoc d = \_ -> d
328
329 empty    :: SDoc
330 text     :: String     -> SDoc
331 char     :: Char       -> SDoc
332 ftext    :: FastString -> SDoc
333 ptext    :: Ptr t      -> SDoc
334 int      :: Int        -> SDoc
335 integer  :: Integer    -> SDoc
336 float    :: Float      -> SDoc
337 double   :: Double     -> SDoc
338 rational :: Rational   -> SDoc
339
340 empty _sty      = Pretty.empty
341 text s _sty     = Pretty.text s
342 char c _sty     = Pretty.char c
343 ftext s _sty    = Pretty.ftext s
344 ptext s _sty    = Pretty.ptext s
345 int n _sty      = Pretty.int n
346 integer n _sty  = Pretty.integer n
347 float n _sty    = Pretty.float n
348 double n _sty   = Pretty.double n
349 rational n _sty = Pretty.rational n
350
351 parens, braces, brackets, quotes, doubleQuotes, angleBrackets :: SDoc -> SDoc
352
353 parens d sty       = Pretty.parens (d sty)
354 braces d sty       = Pretty.braces (d sty)
355 brackets d sty     = Pretty.brackets (d sty)
356 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
357 angleBrackets d    = char '<' <> d <> char '>'
358
359 cparen :: Bool -> SDoc -> SDoc
360
361 cparen b d sty       = Pretty.cparen b (d sty)
362
363 -- quotes encloses something in single quotes...
364 -- but it omits them if the thing ends in a single quote
365 -- so that we don't get `foo''.  Instead we just have foo'.
366 quotes d sty = case show pp_d of
367                  ('\'' : _) -> pp_d
368                  _other     -> Pretty.quotes pp_d
369              where
370                pp_d = d sty
371
372 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
373 lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
374
375 semi _sty   = Pretty.semi
376 comma _sty  = Pretty.comma
377 colon _sty  = Pretty.colon
378 equals _sty = Pretty.equals
379 space _sty  = Pretty.space
380 dcolon _sty = Pretty.ptext SLIT("::")
381 arrow  _sty = Pretty.ptext SLIT("->")
382 underscore  = char '_'
383 dot         = char '.'
384 lparen _sty = Pretty.lparen
385 rparen _sty = Pretty.rparen
386 lbrack _sty = Pretty.lbrack
387 rbrack _sty = Pretty.rbrack
388 lbrace _sty = Pretty.lbrace
389 rbrace _sty = Pretty.rbrace
390
391 nest :: Int -> SDoc -> SDoc
392 (<>), (<+>), ($$), ($+$) :: SDoc -> SDoc -> SDoc
393
394 nest n d sty    = Pretty.nest n (d sty)
395 (<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
396 (<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
397 ($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
398 ($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
399
400 hcat, hsep, vcat, sep, cat, fsep, fcat :: [SDoc] -> SDoc
401
402
403 hcat ds sty = Pretty.hcat [d sty | d <- ds]
404 hsep ds sty = Pretty.hsep [d sty | d <- ds]
405 vcat ds sty = Pretty.vcat [d sty | d <- ds]
406 sep ds sty  = Pretty.sep  [d sty | d <- ds]
407 cat ds sty  = Pretty.cat  [d sty | d <- ds]
408 fsep ds sty = Pretty.fsep [d sty | d <- ds]
409 fcat ds sty = Pretty.fcat [d sty | d <- ds]
410
411 hang :: SDoc -> Int -> SDoc -> SDoc
412
413 hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
414
415 punctuate :: SDoc -> [SDoc] -> [SDoc]
416 punctuate _ []     = []
417 punctuate p (d:ds) = go d ds
418                    where
419                      go d [] = [d]
420                      go d (e:es) = (d <> p) : go e es
421 \end{code}
422
423
424 %************************************************************************
425 %*                                                                      *
426 \subsection[Outputable-class]{The @Outputable@ class}
427 %*                                                                      *
428 %************************************************************************
429
430 \begin{code}
431 class Outputable a where
432         ppr :: a -> SDoc
433 \end{code}
434
435 \begin{code}
436 instance Outputable Bool where
437     ppr True  = ptext SLIT("True")
438     ppr False = ptext SLIT("False")
439
440 instance Outputable Int where
441    ppr n = int n
442
443 instance Outputable () where
444    ppr _ = text "()"
445
446 instance (Outputable a) => Outputable [a] where
447     ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
448
449 instance (Outputable a, Outputable b) => Outputable (a, b) where
450     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
451
452 instance Outputable a => Outputable (Maybe a) where
453   ppr Nothing = ptext SLIT("Nothing")
454   ppr (Just x) = ptext SLIT("Just") <+> ppr x
455
456 instance (Outputable a, Outputable b) => Outputable (Either a b) where
457   ppr (Left x)  = ptext SLIT("Left")  <+> ppr x
458   ppr (Right y) = ptext SLIT("Right") <+> ppr y
459
460 -- ToDo: may not be used
461 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
462     ppr (x,y,z) =
463       parens (sep [ppr x <> comma,
464                    ppr y <> comma,
465                    ppr z ])
466
467 instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
468          Outputable (a, b, c, d) where
469     ppr (x,y,z,w) =
470       parens (sep [ppr x <> comma,
471                    ppr y <> comma,
472                    ppr z <> comma,
473                    ppr w])
474
475 instance Outputable FastString where
476     ppr fs = ftext fs           -- Prints an unadorned string,
477                                 -- no double quotes or anything
478 \end{code}
479
480
481 %************************************************************************
482 %*                                                                      *
483 \subsection{The @OutputableBndr@ class}
484 %*                                                                      *
485 %************************************************************************
486
487 When we print a binder, we often want to print its type too.
488 The @OutputableBndr@ class encapsulates this idea.
489
490 @BindingSite@ is used to tell the thing that prints binder what
491 language construct is binding the identifier.  This can be used
492 to decide how much info to print.
493
494 \begin{code}
495 data BindingSite = LambdaBind | CaseBind | LetBind
496
497 class Outputable a => OutputableBndr a where
498    pprBndr :: BindingSite -> a -> SDoc
499    pprBndr _b x = ppr x
500 \end{code}
501
502
503
504 %************************************************************************
505 %*                                                                      *
506 \subsection{Random printing helpers}
507 %*                                                                      *
508 %************************************************************************
509
510 \begin{code}
511 -- We have 31-bit Chars and will simply use Show instances
512 -- of Char and String.
513
514 pprHsChar :: Char -> SDoc
515 pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
516             | otherwise      = text (show c)
517
518 pprHsString :: FastString -> SDoc
519 pprHsString fs = text (show (unpackFS fs))
520 \end{code}
521
522
523 %************************************************************************
524 %*                                                                      *
525 \subsection{Other helper functions}
526 %*                                                                      *
527 %************************************************************************
528
529 \begin{code}
530 pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
531 pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
532
533 interppSP  :: Outputable a => [a] -> SDoc
534 interppSP  xs = sep (map ppr xs)
535
536 interpp'SP :: Outputable a => [a] -> SDoc
537 interpp'SP xs = sep (punctuate comma (map ppr xs))
538
539 pprQuotedList :: Outputable a => [a] -> SDoc
540 -- [x,y,z]  ==>  `x', `y', `z'
541 pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
542 \end{code}
543
544
545 %************************************************************************
546 %*                                                                      *
547 \subsection{Printing numbers verbally}
548 %*                                                                      *
549 %************************************************************************
550
551 @speakNth@ converts an integer to a verbal index; eg 1 maps to
552 ``first'' etc.
553
554 \begin{code}
555 speakNth :: Int -> SDoc
556 speakNth 1 = ptext SLIT("first")
557 speakNth 2 = ptext SLIT("second")
558 speakNth 3 = ptext SLIT("third")
559 speakNth 4 = ptext SLIT("fourth")
560 speakNth 5 = ptext SLIT("fifth")
561 speakNth 6 = ptext SLIT("sixth")
562 speakNth n = hcat [ int n, text suffix ]
563   where
564     suffix | n <= 20       = "th"       -- 11,12,13 are non-std
565            | last_dig == 1 = "st"
566            | last_dig == 2 = "nd"
567            | last_dig == 3 = "rd"
568            | otherwise     = "th"
569
570     last_dig = n `rem` 10
571
572 speakN :: Int -> SDoc
573 speakN 0 = ptext SLIT("none")   -- E.g.  "he has none"
574 speakN 1 = ptext SLIT("one")    -- E.g.  "he has one"
575 speakN 2 = ptext SLIT("two")
576 speakN 3 = ptext SLIT("three")
577 speakN 4 = ptext SLIT("four")
578 speakN 5 = ptext SLIT("five")
579 speakN 6 = ptext SLIT("six")
580 speakN n = int n
581
582 speakNOf :: Int -> SDoc -> SDoc
583 speakNOf 0 d = ptext SLIT("no") <+> d <> char 's'       -- E.g. "no arguments"
584 speakNOf 1 d = ptext SLIT("one") <+> d                  -- E.g. "one argument"
585 speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments"
586
587 speakNTimes :: Int {- >=1 -} -> SDoc
588 speakNTimes t | t == 1     = ptext SLIT("once")
589               | t == 2     = ptext SLIT("twice")
590               | otherwise  = speakN t <+> ptext SLIT("times")
591
592 plural :: [a] -> SDoc
593 plural [_] = empty  -- a bit frightening, but there you are
594 plural _   = char 's'
595 \end{code}
596
597
598 %************************************************************************
599 %*                                                                      *
600 \subsection{Error handling}
601 %*                                                                      *
602 %************************************************************************
603
604 \begin{code}
605 pprPanic, pprPgmError :: String -> SDoc -> a
606 pprTrace :: String -> SDoc -> a -> a
607 pprPanic    = pprAndThen panic          -- Throw an exn saying "bug in GHC"
608
609 pprPgmError = pprAndThen pgmError       -- Throw an exn saying "bug in pgm being compiled"
610                                         --      (used for unusual pgm errors)
611 pprTrace    = pprAndThen trace
612
613 pprPanic# :: String -> SDoc -> FastInt
614 pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
615                              where
616                                doc = text heading <+> pretty_msg
617
618 pprAndThen :: (String -> a) -> String -> SDoc -> a
619 pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
620     where
621      doc = sep [text heading, nest 4 pretty_msg]
622
623 assertPprPanic :: String -> Int -> SDoc -> a
624 assertPprPanic file line msg
625   = panic (show (doc PprDebug))
626   where
627     doc = sep [hsep[text "ASSERT failed! file", 
628                            text file, 
629                            text "line", int line], 
630                     msg]
631
632 warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
633 warnPprTrace False _file _line _msg x = x
634 warnPprTrace True   file  line  msg x
635   = trace (show (doc PprDebug)) x
636   where
637     doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
638                msg]
639 \end{code}