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