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