f67fdde37d1a1c97913af23a67872502748aa7c0
[ghc.git] / compiler / hsSyn / HsDecls.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 \begin{code}
7 {-# LANGUAGE DeriveDataTypeable #-}
8
9 -- | Abstract syntax of global declarations.
10 --
11 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
12 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
13 module HsDecls (
14   -- * Toplevel declarations
15   HsDecl(..), LHsDecl,
16   -- ** Class or type declarations
17   TyClDecl(..), LTyClDecl,
18   isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
19   isFamInstDecl, tcdName, tyClDeclTyVars,
20   countTyClDecls,
21   -- ** Instance declarations
22   InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
23   instDeclATs,
24   -- ** Standalone deriving declarations
25   DerivDecl(..), LDerivDecl,
26   -- ** @RULE@ declarations
27   RuleDecl(..), LRuleDecl, RuleBndr(..),
28   collectRuleBndrSigTys,
29   -- ** @VECTORISE@ declarations
30   VectDecl(..), LVectDecl,
31   lvectDeclName,
32   -- ** @default@ declarations
33   DefaultDecl(..), LDefaultDecl,
34   -- ** Top-level template haskell splice
35   SpliceDecl(..),
36   -- ** Foreign function interface declarations
37   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
38   noForeignImportCoercionYet, noForeignExportCoercionYet,
39   CImportSpec(..),
40   -- ** Data-constructor declarations
41   ConDecl(..), LConDecl, ResType(..), 
42   HsConDeclDetails, hsConDeclArgTys, 
43   -- ** Document comments
44   DocDecl(..), LDocDecl, docDeclDoc,
45   -- ** Deprecations
46   WarnDecl(..),  LWarnDecl,
47   -- ** Annotations
48   AnnDecl(..), LAnnDecl, 
49   AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
50
51   -- * Grouping
52   HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups
53     ) where
54
55 -- friends:
56 import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, pprExpr )
57         -- Because Expr imports Decls via HsBracket
58
59 import HsBinds
60 import HsPat
61 import HsTypes
62 import HsDoc
63 import TyCon
64 import NameSet
65 import Name
66 import {- Kind parts of -} Type
67 import BasicTypes
68 import Coercion
69 import ForeignCall
70
71 -- others:
72 import Class
73 import Outputable       
74 import Util
75 import SrcLoc
76 import FastString
77
78 import Bag
79 import Control.Monad    ( liftM )
80 import Data.Data        hiding (TyCon)
81 import Data.Maybe       ( isJust )
82 \end{code}
83
84 %************************************************************************
85 %*                                                                      *
86 \subsection[HsDecl]{Declarations}
87 %*                                                                      *
88 %************************************************************************
89
90 \begin{code}
91 type LHsDecl id = Located (HsDecl id)
92
93 -- | A Haskell Declaration
94 data HsDecl id
95   = TyClD       (TyClDecl id)     -- ^ A type or class declaration.
96   | InstD       (InstDecl  id)    -- ^ An instance declaration.
97   | DerivD      (DerivDecl id)
98   | ValD        (HsBind id)
99   | SigD        (Sig id)
100   | DefD        (DefaultDecl id)
101   | ForD        (ForeignDecl id)
102   | WarningD    (WarnDecl id)
103   | AnnD        (AnnDecl id)
104   | RuleD       (RuleDecl id)
105   | VectD       (VectDecl id)
106   | SpliceD     (SpliceDecl id)
107   | DocD        (DocDecl)
108   | QuasiQuoteD (HsQuasiQuote id)
109   deriving (Data, Typeable)
110
111
112 -- NB: all top-level fixity decls are contained EITHER
113 -- EITHER SigDs
114 -- OR     in the ClassDecls in TyClDs
115 --
116 -- The former covers
117 --      a) data constructors
118 --      b) class methods (but they can be also done in the
119 --              signatures of class decls)
120 --      c) imported functions (that have an IfacSig)
121 --      d) top level decls
122 --
123 -- The latter is for class methods only
124
125 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
126 -- fed to the renamer.
127 data HsGroup id
128   = HsGroup {
129         hs_valds  :: HsValBinds id,
130
131         hs_tyclds :: [[LTyClDecl id]],  
132                 -- A list of mutually-recursive groups
133                 -- Parser generates a singleton list;
134                 -- renamer does dependency analysis
135
136         hs_instds :: [LInstDecl id],
137         hs_derivds :: [LDerivDecl id],
138
139         hs_fixds  :: [LFixitySig id],
140                 -- Snaffled out of both top-level fixity signatures,
141                 -- and those in class declarations
142
143         hs_defds  :: [LDefaultDecl id],
144         hs_fords  :: [LForeignDecl id],
145         hs_warnds :: [LWarnDecl id],
146         hs_annds  :: [LAnnDecl id],
147         hs_ruleds :: [LRuleDecl id],
148         hs_vects  :: [LVectDecl id],
149
150         hs_docs   :: [LDocDecl]
151   } deriving (Data, Typeable)
152
153 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
154 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
155 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
156
157 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
158                        hs_fixds = [], hs_defds = [], hs_annds = [],
159                        hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
160                        hs_valds = error "emptyGroup hs_valds: Can't happen",
161                        hs_docs = [] }
162
163 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
164 appendGroups 
165     HsGroup { 
166         hs_valds  = val_groups1,
167         hs_tyclds = tyclds1, 
168         hs_instds = instds1,
169         hs_derivds = derivds1,
170         hs_fixds  = fixds1, 
171         hs_defds  = defds1,
172         hs_annds  = annds1,
173         hs_fords  = fords1, 
174         hs_warnds = warnds1,
175         hs_ruleds = rulds1,
176         hs_vects = vects1,
177   hs_docs   = docs1 }
178     HsGroup { 
179         hs_valds  = val_groups2,
180         hs_tyclds = tyclds2, 
181         hs_instds = instds2,
182         hs_derivds = derivds2,
183         hs_fixds  = fixds2, 
184         hs_defds  = defds2,
185         hs_annds  = annds2,
186         hs_fords  = fords2, 
187         hs_warnds = warnds2,
188         hs_ruleds = rulds2,
189         hs_vects  = vects2,
190         hs_docs   = docs2 }
191   = 
192     HsGroup { 
193         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
194         hs_tyclds = tyclds1 ++ tyclds2, 
195         hs_instds = instds1 ++ instds2,
196         hs_derivds = derivds1 ++ derivds2,
197         hs_fixds  = fixds1 ++ fixds2,
198         hs_annds  = annds1 ++ annds2,
199         hs_defds  = defds1 ++ defds2,
200         hs_fords  = fords1 ++ fords2, 
201         hs_warnds = warnds1 ++ warnds2,
202         hs_ruleds = rulds1 ++ rulds2,
203         hs_vects  = vects1 ++ vects2,
204         hs_docs   = docs1  ++ docs2 }
205 \end{code}
206
207 \begin{code}
208 instance OutputableBndr name => Outputable (HsDecl name) where
209     ppr (TyClD dcl)             = ppr dcl
210     ppr (ValD binds)            = ppr binds
211     ppr (DefD def)              = ppr def
212     ppr (InstD inst)            = ppr inst
213     ppr (DerivD deriv)          = ppr deriv
214     ppr (ForD fd)               = ppr fd
215     ppr (SigD sd)               = ppr sd
216     ppr (RuleD rd)              = ppr rd
217     ppr (VectD vect)            = ppr vect
218     ppr (WarningD wd)           = ppr wd
219     ppr (AnnD ad)               = ppr ad
220     ppr (SpliceD dd)            = ppr dd
221     ppr (DocD doc)              = ppr doc
222     ppr (QuasiQuoteD qq)        = ppr qq
223
224 instance OutputableBndr name => Outputable (HsGroup name) where
225     ppr (HsGroup { hs_valds  = val_decls,
226                    hs_tyclds = tycl_decls,
227                    hs_instds = inst_decls,
228                    hs_derivds = deriv_decls,
229                    hs_fixds  = fix_decls,
230                    hs_warnds = deprec_decls,
231                    hs_annds  = ann_decls,
232                    hs_fords  = foreign_decls,
233                    hs_defds  = default_decls,
234                    hs_ruleds = rule_decls,
235                    hs_vects  = vect_decls })
236         = vcat_mb empty 
237             [ppr_ds fix_decls, ppr_ds default_decls, 
238              ppr_ds deprec_decls, ppr_ds ann_decls,
239              ppr_ds rule_decls,
240              ppr_ds vect_decls,
241              if isEmptyValBinds val_decls 
242                 then Nothing 
243                 else Just (ppr val_decls),
244              ppr_ds (concat tycl_decls), 
245              ppr_ds inst_decls,
246              ppr_ds deriv_decls,
247              ppr_ds foreign_decls]
248         where
249           ppr_ds :: Outputable a => [a] -> Maybe SDoc
250           ppr_ds [] = Nothing
251           ppr_ds ds = Just (vcat (map ppr ds))
252
253           vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
254           -- Concatenate vertically with white-space between non-blanks
255           vcat_mb _    []             = empty
256           vcat_mb gap (Nothing : ds) = vcat_mb gap ds
257           vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
258
259 data SpliceDecl id 
260   = SpliceDecl                  -- Top level splice
261         (Located (HsExpr id))
262         HsExplicitFlag          -- Explicit <=> $(f x y)
263                                 -- Implicit <=> f x y,  i.e. a naked top level expression
264     deriving (Data, Typeable)
265
266 instance OutputableBndr name => Outputable (SpliceDecl name) where
267    ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
268 \end{code}
269
270
271 %************************************************************************
272 %*                                                                      *
273 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
274 %*                                                                      *
275 %************************************************************************
276
277                 --------------------------------
278                         THE NAMING STORY
279                 --------------------------------
280
281 Here is the story about the implicit names that go with type, class,
282 and instance decls.  It's a bit tricky, so pay attention!
283
284 "Implicit" (or "system") binders
285 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
286   Each data type decl defines 
287         a worker name for each constructor
288         to-T and from-T convertors
289   Each class decl defines
290         a tycon for the class
291         a data constructor for that tycon
292         the worker for that constructor
293         a selector for each superclass
294
295 All have occurrence names that are derived uniquely from their parent
296 declaration.
297
298 None of these get separate definitions in an interface file; they are
299 fully defined by the data or class decl.  But they may *occur* in
300 interface files, of course.  Any such occurrence must haul in the
301 relevant type or class decl.
302
303 Plan of attack:
304  - Ensure they "point to" the parent data/class decl 
305    when loading that decl from an interface file
306    (See RnHiFiles.getSysBinders)
307
308  - When typechecking the decl, we build the implicit TyCons and Ids.
309    When doing so we look them up in the name cache (RnEnv.lookupSysName),
310    to ensure correct module and provenance is set
311
312 These are the two places that we have to conjure up the magic derived
313 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
314
315 Default methods
316 ~~~~~~~~~~~~~~~
317  - Occurrence name is derived uniquely from the method name
318    E.g. $dmmax
319
320  - If there is a default method name at all, it's recorded in
321    the ClassOpSig (in HsBinds), in the DefMeth field.
322    (DefMeth is defined in Class.lhs)
323
324 Source-code class decls and interface-code class decls are treated subtly
325 differently, which has given me a great deal of confusion over the years.
326 Here's the deal.  (We distinguish the two cases because source-code decls
327 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
328
329 In *source-code* class declarations:
330
331  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
332    This is done by RdrHsSyn.mkClassOpSigDM
333
334  - The renamer renames it to a Name
335
336  - During typechecking, we generate a binding for each $dm for 
337    which there's a programmer-supplied default method:
338         class Foo a where
339           op1 :: <type>
340           op2 :: <type>
341           op1 = ...
342    We generate a binding for $dmop1 but not for $dmop2.
343    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
344    The Name for $dmop2 is simply discarded.
345
346 In *interface-file* class declarations:
347   - When parsing, we see if there's an explicit programmer-supplied default method
348     because there's an '=' sign to indicate it:
349         class Foo a where
350           op1 = :: <type>       -- NB the '='
351           op2   :: <type>
352     We use this info to generate a DefMeth with a suitable RdrName for op1,
353     and a NoDefMeth for op2
354   - The interface file has a separate definition for $dmop1, with unfolding etc.
355   - The renamer renames it to a Name.
356   - The renamer treats $dmop1 as a free variable of the declaration, so that
357     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)  
358     This doesn't happen for source code class decls, because they *bind* the default method.
359
360 Dictionary functions
361 ~~~~~~~~~~~~~~~~~~~~
362 Each instance declaration gives rise to one dictionary function binding.
363
364 The type checker makes up new source-code instance declarations
365 (e.g. from 'deriving' or generic default methods --- see
366 TcInstDcls.tcInstDecls1).  So we can't generate the names for
367 dictionary functions in advance (we don't know how many we need).
368
369 On the other hand for interface-file instance declarations, the decl
370 specifies the name of the dictionary function, and it has a binding elsewhere
371 in the interface file:
372         instance {Eq Int} = dEqInt
373         dEqInt :: {Eq Int} <pragma info>
374
375 So again we treat source code and interface file code slightly differently.
376
377 Source code:
378   - Source code instance decls have a Nothing in the (Maybe name) field
379     (see data InstDecl below)
380
381   - The typechecker makes up a Local name for the dict fun for any source-code
382     instance decl, whether it comes from a source-code instance decl, or whether
383     the instance decl is derived from some other construct (e.g. 'deriving').
384
385   - The occurrence name it chooses is derived from the instance decl (just for 
386     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
387     occurrence name, but will have different uniques.  E.g.
388         instance Foo [Int]  where ...
389         instance Foo [Bool] where ...
390     These might both be dFooList
391
392   - The CoreTidy phase externalises the name, and ensures the occurrence name is
393     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
394
395   - We can take this relaxed approach (changing the occurrence name later) 
396     because dict fun Ids are not captured in a TyCon or Class (unlike default
397     methods, say).  Instead, they are kept separately in the InstEnv.  This
398     makes it easy to adjust them after compiling a module.  (Once we've finished
399     compiling that module, they don't change any more.)
400
401
402 Interface file code:
403   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
404     in the (Maybe name) field.
405
406   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
407     suck in the dfun binding
408
409
410 \begin{code}
411 -- Representation of indexed types
412 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
413 -- Family kind signatures are represented by the variant `TyFamily'.  It
414 -- covers "type family", "newtype family", and "data family" declarations,
415 -- distinguished by the value of the field `tcdFlavour'.
416 --
417 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
418 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
419 --
420 --   * If it is 'Nothing', we have a *vanilla* data type declaration or type
421 --     synonym declaration and 'tcdVars' contains the type parameters of the
422 --     type constructor.
423 --
424 --   * If it is 'Just pats', we have the definition of an indexed type.  Then,
425 --     'pats' are type patterns for the type-indexes of the type constructor
426 --     and 'tcdTyVars' are the variables in those patterns.  Hence, the arity of
427 --     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
428 --     *not* 'length tcdVars'.
429 --
430 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
431
432 type LTyClDecl name = Located (TyClDecl name)
433
434 -- | A type or class declaration.
435 data TyClDecl name
436   = ForeignType { 
437                 tcdLName    :: Located name,
438                 tcdExtName  :: Maybe FastString
439     }
440
441
442   | -- | @type/data family T :: *->*@
443     TyFamily {  tcdFlavour:: FamilyFlavour,             -- type or data
444                 tcdLName  :: Located name,              -- type constructor
445                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
446                 tcdKind   :: Maybe Kind                 -- result kind
447     }
448
449
450   | -- | Declares a data type or newtype, giving its construcors
451     -- @
452     --  data/newtype T a = <constrs>
453     --  data/newtype instance T [a] = <constrs>
454     -- @
455     TyData {    tcdND     :: NewOrData,
456                 tcdCtxt   :: LHsContext name,           -- ^ Context
457                 tcdLName  :: Located name,              -- ^ Type constructor
458
459                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ Type variables
460                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns.
461                   -- See Note [tcdTyVars and tcdTyPats] 
462
463                 tcdKindSig:: Maybe Kind,
464                         -- ^ Optional kind signature.
465                         --
466                         -- @(Just k)@ for a GADT-style @data@, or @data
467                         -- instance@ decl with explicit kind sig
468
469                 tcdCons   :: [LConDecl name],
470                         -- ^ Data constructors
471                         --
472                         -- For @data T a = T1 | T2 a@
473                         --   the 'LConDecl's all have 'ResTyH98'.
474                         -- For @data T a where { T1 :: T a }@
475                         --   the 'LConDecls' all have 'ResTyGADT'.
476
477                 tcdDerivs :: Maybe [LHsType name]
478                         -- ^ Derivings; @Nothing@ => not specified,
479                         --              @Just []@ => derive exactly what is asked
480                         --
481                         -- These "types" must be of form
482                         -- @
483                         --      forall ab. C ty1 ty2
484                         -- @
485                         -- Typically the foralls and ty args are empty, but they
486                         -- are non-empty for the newtype-deriving case
487     }
488
489   | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
490                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
491                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
492                   -- See Note [tcdTyVars and tcdTyPats] 
493
494                 tcdSynRhs :: LHsType name               -- ^ synonym expansion
495     }
496
497   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
498                 tcdLName   :: Located name,             -- ^ Name of the class
499                 tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
500                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
501                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
502                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
503                 tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
504                                                         --   only 'TyFamily'
505                 tcdATDefs  :: [LTyClDecl name],         -- ^ Associated type defaults; ie
506                                                         --   only 'TySynonym'
507                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
508     }
509   deriving (Data, Typeable)
510
511 data NewOrData
512   = NewType                     -- ^ @newtype Blah ...@
513   | DataType                    -- ^ @data Blah ...@
514   deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
515
516 data FamilyFlavour
517   = TypeFamily                  -- ^ @type family ...@
518   | DataFamily                  -- ^ @data family ...@
519   deriving (Data, Typeable)
520 \end{code}
521
522 Note [tcdTyVars and tcdTyPats] 
523 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
524 We use TyData and TySynonym both for vanilla data/type declarations
525      type T a = Int
526 AND for data/type family instance declarations
527      type instance F [a] = (a,Int)
528
529 tcdTyPats = Nothing
530    This is a vanilla data type or type synonym
531    tcdTyVars are the quantified type variables
532
533 tcdTyPats = Just tys
534    This is a data/type family instance declaration
535    tcdTyVars are fv(tys)
536
537    Eg   class C a b where
538           type F a x :: *
539         instance D p s => C (p,q) [r] where
540           type F (p,q) x = p -> x
541    The tcdTyVars of the F instance decl are {p,q,x},
542    i.e. not including s, nor r 
543         (and indeed neither s nor should be mentioned
544          on the RHS of the F instance decl; Trac #5515)
545
546 ------------------------------
547 Simple classifiers
548
549 \begin{code}
550 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
551 -- declaration.
552 isDataDecl :: TyClDecl name -> Bool
553 isDataDecl (TyData {}) = True
554 isDataDecl _other      = False
555
556 -- | type or type instance declaration
557 isTypeDecl :: TyClDecl name -> Bool
558 isTypeDecl (TySynonym {}) = True
559 isTypeDecl _other         = False
560
561 -- | vanilla Haskell type synonym (ie, not a type instance)
562 isSynDecl :: TyClDecl name -> Bool
563 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
564 isSynDecl _other                            = False
565
566 -- | type class
567 isClassDecl :: TyClDecl name -> Bool
568 isClassDecl (ClassDecl {}) = True
569 isClassDecl _              = False
570
571 -- | type family declaration
572 isFamilyDecl :: TyClDecl name -> Bool
573 isFamilyDecl (TyFamily {}) = True
574 isFamilyDecl _other        = False
575
576 -- | family instance (types, newtypes, and data types)
577 isFamInstDecl :: TyClDecl name -> Bool
578 isFamInstDecl tydecl
579    | isTypeDecl tydecl
580      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
581    | otherwise            = False
582 \end{code}
583
584 Dealing with names
585
586 \begin{code}
587 tcdName :: TyClDecl name -> name
588 tcdName decl = unLoc (tcdLName decl)
589
590 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
591 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
592 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
593 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
594 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
595 tyClDeclTyVars (ForeignType {})                = []
596 \end{code}
597
598 \begin{code}
599 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
600         -- class, synonym decls, data, newtype, family decls, family instances
601 countTyClDecls decls 
602  = (count isClassDecl    decls,
603     count isSynDecl      decls,  -- excluding...
604     count isDataTy       decls,  -- ...family...
605     count isNewTy        decls,  -- ...instances
606     count isFamilyDecl   decls,
607     count isFamInstDecl  decls)
608  where
609    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
610    isDataTy _                                             = False
611    
612    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
613    isNewTy _                                            = False
614 \end{code}
615
616 \begin{code}
617 instance OutputableBndr name
618               => Outputable (TyClDecl name) where
619
620     ppr (ForeignType {tcdLName = ltycon})
621         = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
622
623     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
624                    tcdTyVars = tyvars, tcdKind = mb_kind})
625       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
626         where
627           pp_flavour = case flavour of
628                          TypeFamily -> ptext (sLit "type family")
629                          DataFamily -> ptext (sLit "data family")
630
631           pp_kind = case mb_kind of
632                       Nothing   -> empty
633                       Just kind -> dcolon <+> pprKind kind
634
635     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
636                     tcdSynRhs = mono_ty})
637       = hang (ptext (sLit "type") <+> 
638               (if isJust typats then ptext (sLit "instance") else empty) <+>
639               pp_decl_head [] ltycon tyvars typats <+> 
640               equals)
641              4 (ppr mono_ty)
642
643     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
644                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
645                  tcdCons = condecls, tcdDerivs = derivings})
646       = pp_tydecl (null condecls && isJust mb_sig) 
647                   (ppr new_or_data <+> 
648                    (if isJust typats then ptext (sLit "instance") else empty) <+>
649                    pp_decl_head (unLoc context) ltycon tyvars typats <+> 
650                    ppr_sigx mb_sig)
651                   (pp_condecls condecls)
652                   derivings
653       where
654         ppr_sigx Nothing     = empty
655         ppr_sigx (Just kind) = dcolon <+> pprKind kind
656
657     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
658                     tcdFDs  = fds,
659                     tcdSigs = sigs, tcdMeths = methods,
660                     tcdATs = ats, tcdATDefs = at_defs})
661       | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
662       = top_matter
663
664       | otherwise       -- Laid out
665       = vcat [ top_matter <+> ptext (sLit "where")
666              , nest 2 $ pprDeclList (map ppr ats ++
667                                      map ppr at_defs ++
668                                      pprLHsBindsForUser methods sigs) ]
669       where
670         top_matter = ptext (sLit "class") 
671                      <+> pp_decl_head (unLoc context) lclas tyvars Nothing
672                      <+> pprFundeps (map unLoc fds)
673
674 pp_decl_head :: OutputableBndr name
675    => HsContext name
676    -> Located name
677    -> [LHsTyVarBndr name]
678    -> Maybe [LHsType name]
679    -> SDoc
680 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
681   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
682 pp_decl_head context thing _      (Just typats) -- explicit type patterns
683   = hsep [ pprHsContext context, ppr thing
684          , hsep (map (pprParendHsType.unLoc) typats)]
685
686 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
687 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
688   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
689 pp_condecls cs                    -- In H98 syntax
690   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
691
692 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
693 pp_tydecl True  pp_head _ _
694   = pp_head
695 pp_tydecl False pp_head pp_decl_rhs derivings
696   = hang pp_head 4 (sep [
697       pp_decl_rhs,
698       case derivings of
699         Nothing -> empty
700         Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
701     ])
702
703 instance Outputable NewOrData where
704   ppr NewType  = ptext (sLit "newtype")
705   ppr DataType = ptext (sLit "data")
706 \end{code}
707
708
709 %************************************************************************
710 %*                                                                      *
711 \subsection[ConDecl]{A data-constructor declaration}
712 %*                                                                      *
713 %************************************************************************
714
715 \begin{code}
716 type LConDecl name = Located (ConDecl name)
717
718 -- data T b = forall a. Eq a => MkT a b
719 --   MkT :: forall b a. Eq a => MkT a b
720
721 -- data T b where
722 --      MkT1 :: Int -> T Int
723
724 -- data T = Int `MkT` Int
725 --        | MkT2
726
727 -- data T a where
728 --      Int `MkT` Int :: T Int
729
730 data ConDecl name
731   = ConDecl
732     { con_name      :: Located name
733         -- ^ Constructor name.  This is used for the DataCon itself, and for
734         -- the user-callable wrapper Id.
735
736     , con_explicit  :: HsExplicitFlag
737         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
738
739     , con_qvars     :: [LHsTyVarBndr name]
740         -- ^ Type variables.  Depending on 'con_res' this describes the
741         -- following entities
742         --
743         --  - ResTyH98:  the constructor's *existential* type variables
744         --  - ResTyGADT: *all* the constructor's quantified type variables
745         --
746         -- If con_explicit is Implicit, then con_qvars is irrelevant
747         -- until after renaming.  
748
749     , con_cxt       :: LHsContext name
750         -- ^ The context.  This /does not/ include the \"stupid theta\" which
751         -- lives only in the 'TyData' decl.
752
753     , con_details   :: HsConDeclDetails name
754         -- ^ The main payload
755
756     , con_res       :: ResType name
757         -- ^ Result type of the constructor
758
759     , con_doc       :: Maybe LHsDocString
760         -- ^ A possible Haddock comment.
761
762     , con_old_rec :: Bool   
763         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
764         --                             GADT-style record decl   C { blah } :: T a b
765         -- Remove this when we no longer parse this stuff, and hence do not
766         -- need to report decprecated use
767     } deriving (Data, Typeable)
768
769 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
770
771 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
772 hsConDeclArgTys (PrefixCon tys)    = tys
773 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
774 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
775
776 data ResType name
777    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
778    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
779                                 --      and here is its result type
780    deriving (Data, Typeable)
781
782 instance OutputableBndr name => Outputable (ResType name) where
783          -- Debugging only
784    ppr ResTyH98 = ptext (sLit "ResTyH98")
785    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
786 \end{code}
787
788
789 \begin{code}
790 instance (OutputableBndr name) => Outputable (ConDecl name) where
791     ppr = pprConDecl
792
793 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
794 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
795                     , con_cxt = cxt, con_details = details
796                     , con_res = ResTyH98, con_doc = doc })
797   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
798   where
799     ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
800     ppr_details (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
801     ppr_details (RecCon fields)  = ppr con <+> pprConDeclFields fields
802
803 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
804                     , con_cxt = cxt, con_details = PrefixCon arg_tys
805                     , con_res = ResTyGADT res_ty })
806   = ppr con <+> dcolon <+> 
807     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
808   where
809     mk_fun_ty a b = noLoc (HsFunTy a b)
810
811 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
812                     , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
813   = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, 
814          pprConDeclFields fields <+> arrow <+> ppr res_ty]
815
816 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
817   = pprPanic "pprConDecl" (ppr con)
818         -- In GADT syntax we don't allow infix constructors
819 \end{code}
820
821 %************************************************************************
822 %*                                                                      *
823 \subsection[InstDecl]{An instance declaration}
824 %*                                                                      *
825 %************************************************************************
826
827 \begin{code}
828 type LInstDecl name = Located (InstDecl name)
829
830 data InstDecl name
831   = InstDecl    (LHsType name)  -- Context => Class Instance-type
832                                 -- Using a polytype means that the renamer conveniently
833                                 -- figures out the quantified type variables for us.
834                 (LHsBinds name)
835                 [LSig name]     -- User-supplied pragmatic info
836                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
837                                 -- 'TySynonym' only)
838   deriving (Data, Typeable)
839
840 instance (OutputableBndr name) => Outputable (InstDecl name) where
841     ppr (InstDecl inst_ty binds sigs ats)
842       | null sigs && null ats && isEmptyBag binds  -- No "where" part
843       = top_matter
844
845       | otherwise       -- Laid out
846       = vcat [ top_matter <+> ptext (sLit "where")
847              , nest 2 $ pprDeclList (map ppr ats ++
848                                      pprLHsBindsForUser binds sigs) ]
849       where
850         top_matter = ptext (sLit "instance") <+> ppr inst_ty
851
852 -- Extract the declarations of associated types from an instance
853 --
854 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
855 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
856 \end{code}
857
858 %************************************************************************
859 %*                                                                      *
860 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
861 %*                                                                      *
862 %************************************************************************
863
864 \begin{code}
865 type LDerivDecl name = Located (DerivDecl name)
866
867 data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
868   deriving (Data, Typeable)
869
870 instance (OutputableBndr name) => Outputable (DerivDecl name) where
871     ppr (DerivDecl ty) 
872         = hsep [ptext (sLit "deriving instance"), ppr ty]
873 \end{code}
874
875 %************************************************************************
876 %*                                                                      *
877 \subsection[DefaultDecl]{A @default@ declaration}
878 %*                                                                      *
879 %************************************************************************
880
881 There can only be one default declaration per module, but it is hard
882 for the parser to check that; we pass them all through in the abstract
883 syntax, and that restriction must be checked in the front end.
884
885 \begin{code}
886 type LDefaultDecl name = Located (DefaultDecl name)
887
888 data DefaultDecl name
889   = DefaultDecl [LHsType name]
890   deriving (Data, Typeable)
891
892 instance (OutputableBndr name)
893               => Outputable (DefaultDecl name) where
894
895     ppr (DefaultDecl tys)
896       = ptext (sLit "default") <+> parens (interpp'SP tys)
897 \end{code}
898
899 %************************************************************************
900 %*                                                                      *
901 \subsection{Foreign function interface declaration}
902 %*                                                                      *
903 %************************************************************************
904
905 \begin{code}
906
907 -- foreign declarations are distinguished as to whether they define or use a
908 -- Haskell name
909 --
910 --  * the Boolean value indicates whether the pre-standard deprecated syntax
911 --   has been used
912 --
913 type LForeignDecl name = Located (ForeignDecl name)
914
915 data ForeignDecl name
916   = ForeignImport (Located name) -- defines this name
917                   (LHsType name) -- sig_ty
918                   Coercion       -- rep_ty ~ sig_ty
919                   ForeignImport
920   | ForeignExport (Located name) -- uses this name
921                   (LHsType name) -- sig_ty
922                   Coercion       -- sig_ty ~ rep_ty
923                   ForeignExport
924   deriving (Data, Typeable)
925 {-
926     In both ForeignImport and ForeignExport:
927         sig_ty is the type given in the Haskell code
928         rep_ty is the representation for this type, i.e. with newtypes
929                coerced away and type functions evaluated.
930     Thus if the declaration is valid, then rep_ty will only use types
931     such as Int and IO that we know how to make foreign calls with.
932 -}
933
934 noForeignImportCoercionYet :: Coercion
935 noForeignImportCoercionYet
936     = panic "ForeignImport coercion evaluated before typechecking"
937
938 noForeignExportCoercionYet :: Coercion
939 noForeignExportCoercionYet
940     = panic "ForeignExport coercion evaluated before typechecking"
941
942 -- Specification Of an imported external entity in dependence on the calling
943 -- convention 
944 --
945 data ForeignImport = -- import of a C entity
946                      --
947                      --  * the two strings specifying a header file or library
948                      --   may be empty, which indicates the absence of a
949                      --   header or object specification (both are not used
950                      --   in the case of `CWrapper' and when `CFunction'
951                      --   has a dynamic target)
952                      --
953                      --  * the calling convention is irrelevant for code
954                      --   generation in the case of `CLabel', but is needed
955                      --   for pretty printing 
956                      --
957                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
958                      --
959                      CImport  CCallConv       -- ccall or stdcall
960                               Safety          -- interruptible, safe or unsafe
961                               FastString      -- name of C header
962                               CImportSpec     -- details of the C entity
963   deriving (Data, Typeable)
964
965 -- details of an external C entity
966 --
967 data CImportSpec = CLabel    CLabelString     -- import address of a C label
968                  | CFunction CCallTarget      -- static or dynamic function
969                  | CWrapper                   -- wrapper to expose closures
970                                               -- (former f.e.d.)
971   deriving (Data, Typeable)
972
973 -- specification of an externally exported entity in dependence on the calling
974 -- convention
975 --
976 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
977   deriving (Data, Typeable)
978
979 -- pretty printing of foreign declarations
980 --
981
982 instance OutputableBndr name => Outputable (ForeignDecl name) where
983   ppr (ForeignImport n ty _ fimport) =
984     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
985        2 (dcolon <+> ppr ty)
986   ppr (ForeignExport n ty _ fexport) =
987     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
988        2 (dcolon <+> ppr ty)
989
990 instance Outputable ForeignImport where
991   ppr (CImport  cconv safety header spec) =
992     ppr cconv <+> ppr safety <+> 
993     char '"' <> pprCEntity spec <> char '"'
994     where
995       pp_hdr = if nullFS header then empty else ftext header
996
997       pprCEntity (CLabel lbl) = 
998         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
999       pprCEntity (CFunction (StaticTarget lbl _)) = 
1000         ptext (sLit "static") <+> pp_hdr <+> ppr lbl
1001       pprCEntity (CFunction (DynamicTarget)) =
1002         ptext (sLit "dynamic")
1003       pprCEntity (CWrapper) = ptext (sLit "wrapper")
1004
1005 instance Outputable ForeignExport where
1006   ppr (CExport  (CExportStatic lbl cconv)) = 
1007     ppr cconv <+> char '"' <> ppr lbl <> char '"'
1008 \end{code}
1009
1010
1011 %************************************************************************
1012 %*                                                                      *
1013 \subsection{Transformation rules}
1014 %*                                                                      *
1015 %************************************************************************
1016
1017 \begin{code}
1018 type LRuleDecl name = Located (RuleDecl name)
1019
1020 data RuleDecl name
1021   = HsRule                      -- Source rule
1022         RuleName                -- Rule name
1023         Activation
1024         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
1025         (Located (HsExpr name)) -- LHS
1026         NameSet                 -- Free-vars from the LHS
1027         (Located (HsExpr name)) -- RHS
1028         NameSet                 -- Free-vars from the RHS
1029   deriving (Data, Typeable)
1030
1031 data RuleBndr name
1032   = RuleBndr (Located name)
1033   | RuleBndrSig (Located name) (LHsType name)
1034   deriving (Data, Typeable)
1035
1036 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
1037 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1038
1039 instance OutputableBndr name => Outputable (RuleDecl name) where
1040   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1041         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1042                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
1043                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1044         where
1045           pp_forall | null ns   = empty
1046                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1047
1048 instance OutputableBndr name => Outputable (RuleBndr name) where
1049    ppr (RuleBndr name) = ppr name
1050    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1051 \end{code}
1052
1053
1054 %************************************************************************
1055 %*                                                                      *
1056 \subsection{Vectorisation declarations}
1057 %*                                                                      *
1058 %************************************************************************
1059
1060 A vectorisation pragma, one of
1061
1062   {-# VECTORISE f = closure1 g (scalar_map g) #-}
1063   {-# VECTORISE SCALAR f #-}
1064   {-# NOVECTORISE f #-}
1065
1066   {-# VECTORISE type T = ty #-}
1067   {-# VECTORISE SCALAR type T #-}
1068   
1069 \begin{code}
1070 type LVectDecl name = Located (VectDecl name)
1071
1072 data VectDecl name
1073   = HsVect
1074       (Located name)
1075       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
1076   | HsNoVect
1077       (Located name)
1078   | HsVectTypeIn                -- pre type-checking
1079       Bool                      -- 'TRUE' => SCALAR declaration
1080       (Located name)
1081       (Maybe (Located name))    -- 'Nothing' => no right-hand side
1082   | HsVectTypeOut               -- post type-checking
1083       Bool                      -- 'TRUE' => SCALAR declaration
1084       TyCon
1085       (Maybe TyCon)             -- 'Nothing' => no right-hand side
1086   deriving (Data, Typeable)
1087
1088 lvectDeclName :: NamedThing name => LVectDecl name -> Name
1089 lvectDeclName (L _ (HsVect        (L _ name) _))   = getName name
1090 lvectDeclName (L _ (HsNoVect      (L _ name)))     = getName name
1091 lvectDeclName (L _ (HsVectTypeIn  _ (L _ name) _)) = getName name
1092 lvectDeclName (L _ (HsVectTypeOut _ tycon _))      = getName tycon
1093
1094 instance OutputableBndr name => Outputable (VectDecl name) where
1095   ppr (HsVect v Nothing)
1096     = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
1097   ppr (HsVect v (Just rhs))
1098     = sep [text "{-# VECTORISE" <+> ppr v,
1099            nest 4 $ 
1100              pprExpr (unLoc rhs) <+> text "#-}" ]
1101   ppr (HsNoVect v)
1102     = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1103   ppr (HsVectTypeIn False t Nothing)
1104     = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
1105   ppr (HsVectTypeIn False t (Just t'))
1106     = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
1107   ppr (HsVectTypeIn True t Nothing)
1108     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1109   ppr (HsVectTypeIn True t (Just t'))
1110     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
1111   ppr (HsVectTypeOut False t Nothing)
1112     = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
1113   ppr (HsVectTypeOut False t (Just t'))
1114     = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
1115   ppr (HsVectTypeOut True t Nothing)
1116     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1117   ppr (HsVectTypeOut True t (Just t'))
1118     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
1119 \end{code}
1120
1121 %************************************************************************
1122 %*                                                                      *
1123 \subsection[DocDecl]{Document comments}
1124 %*                                                                      *
1125 %************************************************************************
1126
1127 \begin{code}
1128
1129 type LDocDecl = Located (DocDecl)
1130
1131 data DocDecl
1132   = DocCommentNext HsDocString
1133   | DocCommentPrev HsDocString
1134   | DocCommentNamed String HsDocString
1135   | DocGroup Int HsDocString
1136   deriving (Data, Typeable)
1137  
1138 -- Okay, I need to reconstruct the document comments, but for now:
1139 instance Outputable DocDecl where
1140   ppr _ = text "<document comment>"
1141
1142 docDeclDoc :: DocDecl -> HsDocString
1143 docDeclDoc (DocCommentNext d) = d
1144 docDeclDoc (DocCommentPrev d) = d
1145 docDeclDoc (DocCommentNamed _ d) = d
1146 docDeclDoc (DocGroup _ d) = d
1147
1148 \end{code}
1149
1150 %************************************************************************
1151 %*                                                                      *
1152 \subsection[DeprecDecl]{Deprecations}
1153 %*                                                                      *
1154 %************************************************************************
1155
1156 We use exported entities for things to deprecate.
1157
1158 \begin{code}
1159 type LWarnDecl name = Located (WarnDecl name)
1160
1161 data WarnDecl name = Warning name WarningTxt
1162   deriving (Data, Typeable)
1163
1164 instance OutputableBndr name => Outputable (WarnDecl name) where
1165     ppr (Warning thing txt)
1166       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1167 \end{code}
1168
1169 %************************************************************************
1170 %*                                                                      *
1171 \subsection[AnnDecl]{Annotations}
1172 %*                                                                      *
1173 %************************************************************************
1174
1175 \begin{code}
1176 type LAnnDecl name = Located (AnnDecl name)
1177
1178 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1179   deriving (Data, Typeable)
1180
1181 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1182     ppr (HsAnnotation provenance expr) 
1183       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1184
1185
1186 data AnnProvenance name = ValueAnnProvenance name
1187                         | TypeAnnProvenance name
1188                         | ModuleAnnProvenance
1189   deriving (Data, Typeable)
1190
1191 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1192 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1193 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1194 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1195
1196 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1197 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1198 modifyAnnProvenanceNameM fm prov =
1199     case prov of
1200             ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1201             TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1202             ModuleAnnProvenance -> return ModuleAnnProvenance
1203
1204 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1205 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1206 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1207 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1208 \end{code}