Add Data and Typeable instances to HsSyn
[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, tyClDeclNames, 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, hsConDeclsNames,
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 = SpliceDecl (Located (HsExpr id))   -- Top level splice
236     deriving (Data, Typeable)
237
238 instance OutputableBndr name => Outputable (SpliceDecl name) where
239    ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
240 \end{code}
241
242
243 %************************************************************************
244 %*                                                                      *
245 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
246 %*                                                                      *
247 %************************************************************************
248
249                 --------------------------------
250                         THE NAMING STORY
251                 --------------------------------
252
253 Here is the story about the implicit names that go with type, class,
254 and instance decls.  It's a bit tricky, so pay attention!
255
256 "Implicit" (or "system") binders
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258   Each data type decl defines 
259         a worker name for each constructor
260         to-T and from-T convertors
261   Each class decl defines
262         a tycon for the class
263         a data constructor for that tycon
264         the worker for that constructor
265         a selector for each superclass
266
267 All have occurrence names that are derived uniquely from their parent
268 declaration.
269
270 None of these get separate definitions in an interface file; they are
271 fully defined by the data or class decl.  But they may *occur* in
272 interface files, of course.  Any such occurrence must haul in the
273 relevant type or class decl.
274
275 Plan of attack:
276  - Ensure they "point to" the parent data/class decl 
277    when loading that decl from an interface file
278    (See RnHiFiles.getSysBinders)
279
280  - When typechecking the decl, we build the implicit TyCons and Ids.
281    When doing so we look them up in the name cache (RnEnv.lookupSysName),
282    to ensure correct module and provenance is set
283
284 These are the two places that we have to conjure up the magic derived
285 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
286
287 Default methods
288 ~~~~~~~~~~~~~~~
289  - Occurrence name is derived uniquely from the method name
290    E.g. $dmmax
291
292  - If there is a default method name at all, it's recorded in
293    the ClassOpSig (in HsBinds), in the DefMeth field.
294    (DefMeth is defined in Class.lhs)
295
296 Source-code class decls and interface-code class decls are treated subtly
297 differently, which has given me a great deal of confusion over the years.
298 Here's the deal.  (We distinguish the two cases because source-code decls
299 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
300
301 In *source-code* class declarations:
302
303  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
304    This is done by RdrHsSyn.mkClassOpSigDM
305
306  - The renamer renames it to a Name
307
308  - During typechecking, we generate a binding for each $dm for 
309    which there's a programmer-supplied default method:
310         class Foo a where
311           op1 :: <type>
312           op2 :: <type>
313           op1 = ...
314    We generate a binding for $dmop1 but not for $dmop2.
315    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
316    The Name for $dmop2 is simply discarded.
317
318 In *interface-file* class declarations:
319   - When parsing, we see if there's an explicit programmer-supplied default method
320     because there's an '=' sign to indicate it:
321         class Foo a where
322           op1 = :: <type>       -- NB the '='
323           op2   :: <type>
324     We use this info to generate a DefMeth with a suitable RdrName for op1,
325     and a NoDefMeth for op2
326   - The interface file has a separate definition for $dmop1, with unfolding etc.
327   - The renamer renames it to a Name.
328   - The renamer treats $dmop1 as a free variable of the declaration, so that
329     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)  
330     This doesn't happen for source code class decls, because they *bind* the default method.
331
332 Dictionary functions
333 ~~~~~~~~~~~~~~~~~~~~
334 Each instance declaration gives rise to one dictionary function binding.
335
336 The type checker makes up new source-code instance declarations
337 (e.g. from 'deriving' or generic default methods --- see
338 TcInstDcls.tcInstDecls1).  So we can't generate the names for
339 dictionary functions in advance (we don't know how many we need).
340
341 On the other hand for interface-file instance declarations, the decl
342 specifies the name of the dictionary function, and it has a binding elsewhere
343 in the interface file:
344         instance {Eq Int} = dEqInt
345         dEqInt :: {Eq Int} <pragma info>
346
347 So again we treat source code and interface file code slightly differently.
348
349 Source code:
350   - Source code instance decls have a Nothing in the (Maybe name) field
351     (see data InstDecl below)
352
353   - The typechecker makes up a Local name for the dict fun for any source-code
354     instance decl, whether it comes from a source-code instance decl, or whether
355     the instance decl is derived from some other construct (e.g. 'deriving').
356
357   - The occurrence name it chooses is derived from the instance decl (just for 
358     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
359     occurrence name, but will have different uniques.  E.g.
360         instance Foo [Int]  where ...
361         instance Foo [Bool] where ...
362     These might both be dFooList
363
364   - The CoreTidy phase externalises the name, and ensures the occurrence name is
365     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
366
367   - We can take this relaxed approach (changing the occurrence name later) 
368     because dict fun Ids are not captured in a TyCon or Class (unlike default
369     methods, say).  Instead, they are kept separately in the InstEnv.  This
370     makes it easy to adjust them after compiling a module.  (Once we've finished
371     compiling that module, they don't change any more.)
372
373
374 Interface file code:
375   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
376     in the (Maybe name) field.
377
378   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
379     suck in the dfun binding
380
381
382 \begin{code}
383 -- Representation of indexed types
384 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
385 -- Family kind signatures are represented by the variant `TyFamily'.  It
386 -- covers "type family", "newtype family", and "data family" declarations,
387 -- distinguished by the value of the field `tcdFlavour'.
388 --
389 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
390 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
391 --
392 --   * If it is 'Nothing', we have a *vanilla* data type declaration or type
393 --     synonym declaration and 'tcdVars' contains the type parameters of the
394 --     type constructor.
395 --
396 --   * If it is 'Just pats', we have the definition of an indexed type.  Then,
397 --     'pats' are type patterns for the type-indexes of the type constructor
398 --     and 'tcdTyVars' are the variables in those patterns.  Hence, the arity of
399 --     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
400 --     *not* 'length tcdVars'.
401 --
402 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
403
404 type LTyClDecl name = Located (TyClDecl name)
405
406 -- | A type or class declaration.
407 data TyClDecl name
408   = ForeignType { 
409                 tcdLName    :: Located name,
410                 tcdExtName  :: Maybe FastString
411     }
412
413
414   | -- | @type/data family T :: *->*@
415     TyFamily {  tcdFlavour:: FamilyFlavour,             -- type or data
416                 tcdLName  :: Located name,              -- type constructor
417                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
418                 tcdKind   :: Maybe Kind                 -- result kind
419     }
420
421
422   | -- | Declares a data type or newtype, giving its construcors
423     -- @
424     --  data/newtype T a = <constrs>
425     --  data/newtype instance T [a] = <constrs>
426     -- @
427     TyData {    tcdND     :: NewOrData,
428                 tcdCtxt   :: LHsContext name,           -- ^ Context
429                 tcdLName  :: Located name,              -- ^ Type constructor
430
431                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ Type variables
432                         
433                 tcdTyPats :: Maybe [LHsType name],
434                         -- ^ Type patterns.
435                         --
436                         -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
437                         --      in this case @tcdTyVars = fv( tcdTyPats )@.
438                         -- @Nothing@ for everything else.
439
440                 tcdKindSig:: Maybe Kind,
441                         -- ^ Optional kind signature.
442                         --
443                         -- @(Just k)@ for a GADT-style @data@, or @data
444                         -- instance@ decl with explicit kind sig
445
446                 tcdCons   :: [LConDecl name],
447                         -- ^ Data constructors
448                         --
449                         -- For @data T a = T1 | T2 a@
450                         --   the 'LConDecl's all have 'ResTyH98'.
451                         -- For @data T a where { T1 :: T a }@
452                         --   the 'LConDecls' all have 'ResTyGADT'.
453
454                 tcdDerivs :: Maybe [LHsType name]
455                         -- ^ Derivings; @Nothing@ => not specified,
456                         --              @Just []@ => derive exactly what is asked
457                         --
458                         -- These "types" must be of form
459                         -- @
460                         --      forall ab. C ty1 ty2
461                         -- @
462                         -- Typically the foralls and ty args are empty, but they
463                         -- are non-empty for the newtype-deriving case
464     }
465
466   | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
467                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
468                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
469                         -- See comments for tcdTyPats in TyData
470                         -- 'Nothing' => vanilla type synonym
471
472                 tcdSynRhs :: LHsType name               -- ^ synonym expansion
473     }
474
475   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
476                 tcdLName   :: Located name,             -- ^ Name of the class
477                 tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
478                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
479                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
480                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
481                 tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
482                                                         --   only 'TyFamily' and
483                                                         --   'TySynonym'; the
484                                                         --   latter for defaults
485                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
486     }
487   deriving (Data, Typeable)
488
489 data NewOrData
490   = NewType                     -- ^ @newtype Blah ...@
491   | DataType                    -- ^ @data Blah ...@
492   deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
493
494 data FamilyFlavour
495   = TypeFamily                  -- ^ @type family ...@
496   | DataFamily                  -- ^ @data family ...@
497   deriving (Data, Typeable)
498 \end{code}
499
500 Simple classifiers
501
502 \begin{code}
503 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
504 -- declaration.
505 isDataDecl :: TyClDecl name -> Bool
506 isDataDecl (TyData {}) = True
507 isDataDecl _other      = False
508
509 -- | type or type instance declaration
510 isTypeDecl :: TyClDecl name -> Bool
511 isTypeDecl (TySynonym {}) = True
512 isTypeDecl _other         = False
513
514 -- | vanilla Haskell type synonym (ie, not a type instance)
515 isSynDecl :: TyClDecl name -> Bool
516 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
517 isSynDecl _other                            = False
518
519 -- | type class
520 isClassDecl :: TyClDecl name -> Bool
521 isClassDecl (ClassDecl {}) = True
522 isClassDecl _              = False
523
524 -- | type family declaration
525 isFamilyDecl :: TyClDecl name -> Bool
526 isFamilyDecl (TyFamily {}) = True
527 isFamilyDecl _other        = False
528
529 -- | family instance (types, newtypes, and data types)
530 isFamInstDecl :: TyClDecl name -> Bool
531 isFamInstDecl tydecl
532    | isTypeDecl tydecl
533      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
534    | otherwise            = False
535 \end{code}
536
537 Dealing with names
538
539 \begin{code}
540 tcdName :: TyClDecl name -> name
541 tcdName decl = unLoc (tcdLName decl)
542
543 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
544 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
545 -- The first one is guaranteed to be the name of the decl. For record fields
546 -- mentioned in multiple constructors, the SrcLoc will be from the first
547 -- occurence.  We use the equality to filter out duplicate field names
548
549 tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
550 tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
551 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
552
553 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
554   = cls_name : 
555     concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
556
557 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
558   = tc_name : hsConDeclsNames cons
559
560 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
561 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
562 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
563 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
564 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
565 tyClDeclTyVars (ForeignType {})                = []
566 \end{code}
567
568 \begin{code}
569 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
570         -- class, synonym decls, data, newtype, family decls, family instances
571 countTyClDecls decls 
572  = (count isClassDecl    decls,
573     count isSynDecl      decls,  -- excluding...
574     count isDataTy       decls,  -- ...family...
575     count isNewTy        decls,  -- ...instances
576     count isFamilyDecl   decls,
577     count isFamInstDecl  decls)
578  where
579    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
580    isDataTy _                                             = False
581    
582    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
583    isNewTy _                                            = False
584 \end{code}
585
586 \begin{code}
587 instance OutputableBndr name
588               => Outputable (TyClDecl name) where
589
590     ppr (ForeignType {tcdLName = ltycon})
591         = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
592
593     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
594                    tcdTyVars = tyvars, tcdKind = mb_kind})
595       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
596         where
597           pp_flavour = case flavour of
598                          TypeFamily -> ptext (sLit "type family")
599                          DataFamily -> ptext (sLit "data family")
600
601           pp_kind = case mb_kind of
602                       Nothing   -> empty
603                       Just kind -> dcolon <+> pprKind kind
604
605     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
606                     tcdSynRhs = mono_ty})
607       = hang (ptext (sLit "type") <+> 
608               (if isJust typats then ptext (sLit "instance") else empty) <+>
609               pp_decl_head [] ltycon tyvars typats <+> 
610               equals)
611              4 (ppr mono_ty)
612
613     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
614                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
615                  tcdCons = condecls, tcdDerivs = derivings})
616       = pp_tydecl (null condecls && isJust mb_sig) 
617                   (ppr new_or_data <+> 
618                    (if isJust typats then ptext (sLit "instance") else empty) <+>
619                    pp_decl_head (unLoc context) ltycon tyvars typats <+> 
620                    ppr_sig mb_sig)
621                   (pp_condecls condecls)
622                   derivings
623       where
624         ppr_sig Nothing = empty
625         ppr_sig (Just kind) = dcolon <+> pprKind kind
626
627     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
628                     tcdFDs = fds, 
629                     tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
630       | null sigs && null ats  -- No "where" part
631       = top_matter
632
633       | otherwise       -- Laid out
634       = sep [hsep [top_matter, ptext (sLit "where {")],
635              nest 4 (sep [ sep (map ppr_semi ats)
636                          , sep (map ppr_semi sigs)
637                          , pprLHsBinds methods
638                          , char '}'])]
639       where
640         top_matter    =     ptext (sLit "class") 
641                         <+> pp_decl_head (unLoc context) lclas tyvars Nothing
642                         <+> pprFundeps (map unLoc fds)
643         ppr_semi decl = ppr decl <> semi
644
645 pp_decl_head :: OutputableBndr name
646    => HsContext name
647    -> Located name
648    -> [LHsTyVarBndr name]
649    -> Maybe [LHsType name]
650    -> SDoc
651 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
652   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
653 pp_decl_head context thing _      (Just typats) -- explicit type patterns
654   = hsep [ pprHsContext context, ppr thing
655          , hsep (map (pprParendHsType.unLoc) typats)]
656
657 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
658 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
659   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
660 pp_condecls cs                    -- In H98 syntax
661   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
662
663 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
664 pp_tydecl True  pp_head _ _
665   = pp_head
666 pp_tydecl False pp_head pp_decl_rhs derivings
667   = hang pp_head 4 (sep [
668       pp_decl_rhs,
669       case derivings of
670         Nothing -> empty
671         Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
672     ])
673
674 instance Outputable NewOrData where
675   ppr NewType  = ptext (sLit "newtype")
676   ppr DataType = ptext (sLit "data")
677 \end{code}
678
679
680 %************************************************************************
681 %*                                                                      *
682 \subsection[ConDecl]{A data-constructor declaration}
683 %*                                                                      *
684 %************************************************************************
685
686 \begin{code}
687 type LConDecl name = Located (ConDecl name)
688
689 -- data T b = forall a. Eq a => MkT a b
690 --   MkT :: forall b a. Eq a => MkT a b
691
692 -- data T b where
693 --      MkT1 :: Int -> T Int
694
695 -- data T = Int `MkT` Int
696 --        | MkT2
697
698 -- data T a where
699 --      Int `MkT` Int :: T Int
700
701 data ConDecl name
702   = ConDecl
703     { con_name      :: Located name
704         -- ^ Constructor name.  This is used for the DataCon itself, and for
705         -- the user-callable wrapper Id.
706
707     , con_explicit  :: HsExplicitFlag
708         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
709
710     , con_qvars     :: [LHsTyVarBndr name]
711         -- ^ Type variables.  Depending on 'con_res' this describes the
712         -- follewing entities
713         --
714         --  - ResTyH98:  the constructor's *existential* type variables
715         --  - ResTyGADT: *all* the constructor's quantified type variables
716
717     , con_cxt       :: LHsContext name
718         -- ^ The context.  This /does not/ include the \"stupid theta\" which
719         -- lives only in the 'TyData' decl.
720
721     , con_details   :: HsConDeclDetails name
722         -- ^ The main payload
723
724     , con_res       :: ResType name
725         -- ^ Result type of the constructor
726
727     , con_doc       :: Maybe LHsDocString
728         -- ^ A possible Haddock comment.
729
730     , con_old_rec :: Bool   
731         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
732         --                             GADT-style record decl   C { blah } :: T a b
733         -- Remove this when we no longer parse this stuff, and hence do not
734         -- need to report decprecated use
735     } deriving (Data, Typeable)
736
737 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
738
739 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
740 hsConDeclArgTys (PrefixCon tys)    = tys
741 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
742 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
743
744 data ResType name
745    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
746    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
747                                 --      and here is its result type
748    deriving (Data, Typeable)
749
750 instance OutputableBndr name => Outputable (ResType name) where
751          -- Debugging only
752    ppr ResTyH98 = ptext (sLit "ResTyH98")
753    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
754 \end{code}
755
756 \begin{code}
757 hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
758   -- See tyClDeclNames for what this does
759   -- The function is boringly complicated because of the records
760   -- And since we only have equality, we have to be a little careful
761 hsConDeclsNames cons
762   = snd (foldl do_one ([], []) cons)
763   where
764     do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
765         = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
766         where
767           new_flds = filterOut (\f -> unLoc f `elem` flds_seen) 
768                                (map cd_fld_name flds)
769
770     do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
771         = (flds_seen, lname:acc)
772 \end{code}
773   
774
775 \begin{code}
776 instance (OutputableBndr name) => Outputable (ConDecl name) where
777     ppr = pprConDecl
778
779 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
780 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
781                     , con_cxt = cxt, con_details = details
782                     , con_res = ResTyH98, con_doc = doc })
783   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
784   where
785     ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
786     ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
787     ppr_details con (RecCon fields)  = ppr con <+> pprConDeclFields fields
788
789 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
790                     , con_cxt = cxt, con_details = PrefixCon arg_tys
791                     , con_res = ResTyGADT res_ty })
792   = ppr con <+> dcolon <+> 
793     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
794   where
795     mk_fun_ty a b = noLoc (HsFunTy a b)
796
797 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
798                     , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
799   = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, 
800          pprConDeclFields fields <+> arrow <+> ppr res_ty]
801
802 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
803   = pprPanic "pprConDecl" (ppr con)
804         -- In GADT syntax we don't allow infix constructors
805 \end{code}
806
807 %************************************************************************
808 %*                                                                      *
809 \subsection[InstDecl]{An instance declaration
810 %*                                                                      *
811 %************************************************************************
812
813 \begin{code}
814 type LInstDecl name = Located (InstDecl name)
815
816 data InstDecl name
817   = InstDecl    (LHsType name)  -- Context => Class Instance-type
818                                 -- Using a polytype means that the renamer conveniently
819                                 -- figures out the quantified type variables for us.
820                 (LHsBinds name)
821                 [LSig name]     -- User-supplied pragmatic info
822                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
823                                 -- 'TySynonym' only)
824   deriving (Data, Typeable)
825
826 instance (OutputableBndr name) => Outputable (InstDecl name) where
827
828     ppr (InstDecl inst_ty binds uprags ats)
829       = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
830              , nest 4 $ vcat (map ppr ats)
831              , nest 4 $ vcat (map ppr uprags)
832              , nest 4 $ pprLHsBinds binds ]
833
834 -- Extract the declarations of associated types from an instance
835 --
836 instDeclATs :: InstDecl name -> [LTyClDecl name]
837 instDeclATs (InstDecl _ _ _ ats) = ats
838 \end{code}
839
840 %************************************************************************
841 %*                                                                      *
842 \subsection[DerivDecl]{A stand-alone instance deriving declaration
843 %*                                                                      *
844 %************************************************************************
845
846 \begin{code}
847 type LDerivDecl name = Located (DerivDecl name)
848
849 data DerivDecl name = DerivDecl (LHsType name)
850   deriving (Data, Typeable)
851
852 instance (OutputableBndr name) => Outputable (DerivDecl name) where
853     ppr (DerivDecl ty) 
854         = hsep [ptext (sLit "deriving instance"), ppr ty]
855 \end{code}
856
857 %************************************************************************
858 %*                                                                      *
859 \subsection[DefaultDecl]{A @default@ declaration}
860 %*                                                                      *
861 %************************************************************************
862
863 There can only be one default declaration per module, but it is hard
864 for the parser to check that; we pass them all through in the abstract
865 syntax, and that restriction must be checked in the front end.
866
867 \begin{code}
868 type LDefaultDecl name = Located (DefaultDecl name)
869
870 data DefaultDecl name
871   = DefaultDecl [LHsType name]
872   deriving (Data, Typeable)
873
874 instance (OutputableBndr name)
875               => Outputable (DefaultDecl name) where
876
877     ppr (DefaultDecl tys)
878       = ptext (sLit "default") <+> parens (interpp'SP tys)
879 \end{code}
880
881 %************************************************************************
882 %*                                                                      *
883 \subsection{Foreign function interface declaration}
884 %*                                                                      *
885 %************************************************************************
886
887 \begin{code}
888
889 -- foreign declarations are distinguished as to whether they define or use a
890 -- Haskell name
891 --
892 --  * the Boolean value indicates whether the pre-standard deprecated syntax
893 --   has been used
894 --
895 type LForeignDecl name = Located (ForeignDecl name)
896
897 data ForeignDecl name
898   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
899   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
900   deriving (Data, Typeable)
901
902 -- Specification Of an imported external entity in dependence on the calling
903 -- convention 
904 --
905 data ForeignImport = -- import of a C entity
906                      --
907                      --  * the two strings specifying a header file or library
908                      --   may be empty, which indicates the absence of a
909                      --   header or object specification (both are not used
910                      --   in the case of `CWrapper' and when `CFunction'
911                      --   has a dynamic target)
912                      --
913                      --  * the calling convention is irrelevant for code
914                      --   generation in the case of `CLabel', but is needed
915                      --   for pretty printing 
916                      --
917                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
918                      --
919                      CImport  CCallConv       -- ccall or stdcall
920                               Safety          -- safe or unsafe
921                               FastString      -- name of C header
922                               CImportSpec     -- details of the C entity
923   deriving (Data, Typeable)
924
925 -- details of an external C entity
926 --
927 data CImportSpec = CLabel    CLabelString     -- import address of a C label
928                  | CFunction CCallTarget      -- static or dynamic function
929                  | CWrapper                   -- wrapper to expose closures
930                                               -- (former f.e.d.)
931   deriving (Data, Typeable)
932
933 -- specification of an externally exported entity in dependence on the calling
934 -- convention
935 --
936 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
937   deriving (Data, Typeable)
938
939 -- pretty printing of foreign declarations
940 --
941
942 instance OutputableBndr name => Outputable (ForeignDecl name) where
943   ppr (ForeignImport n ty fimport) =
944     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
945        2 (dcolon <+> ppr ty)
946   ppr (ForeignExport n ty fexport) =
947     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
948        2 (dcolon <+> ppr ty)
949
950 instance Outputable ForeignImport where
951   ppr (CImport  cconv safety header spec) =
952     ppr cconv <+> ppr safety <+> 
953     char '"' <> pprCEntity spec <> char '"'
954     where
955       pp_hdr = if nullFS header then empty else ftext header
956
957       pprCEntity (CLabel lbl) = 
958         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
959       pprCEntity (CFunction (StaticTarget lbl _)) = 
960         ptext (sLit "static") <+> pp_hdr <+> ppr lbl
961       pprCEntity (CFunction (DynamicTarget)) =
962         ptext (sLit "dynamic")
963       pprCEntity (CWrapper) = ptext (sLit "wrapper")
964
965 instance Outputable ForeignExport where
966   ppr (CExport  (CExportStatic lbl cconv)) = 
967     ppr cconv <+> char '"' <> ppr lbl <> char '"'
968 \end{code}
969
970
971 %************************************************************************
972 %*                                                                      *
973 \subsection{Transformation rules}
974 %*                                                                      *
975 %************************************************************************
976
977 \begin{code}
978 type LRuleDecl name = Located (RuleDecl name)
979
980 data RuleDecl name
981   = HsRule                      -- Source rule
982         RuleName                -- Rule name
983         Activation
984         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
985         (Located (HsExpr name)) -- LHS
986         NameSet                 -- Free-vars from the LHS
987         (Located (HsExpr name)) -- RHS
988         NameSet                 -- Free-vars from the RHS
989   deriving (Data, Typeable)
990
991 data RuleBndr name
992   = RuleBndr (Located name)
993   | RuleBndrSig (Located name) (LHsType name)
994   deriving (Data, Typeable)
995
996 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
997 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
998
999 instance OutputableBndr name => Outputable (RuleDecl name) where
1000   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1001         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1002                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
1003                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1004         where
1005           pp_forall | null ns   = empty
1006                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1007
1008 instance OutputableBndr name => Outputable (RuleBndr name) where
1009    ppr (RuleBndr name) = ppr name
1010    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1011 \end{code}
1012
1013 %************************************************************************
1014 %*                                                                      *
1015 \subsection[DocDecl]{Document comments}
1016 %*                                                                      *
1017 %************************************************************************
1018
1019 \begin{code}
1020
1021 type LDocDecl = Located (DocDecl)
1022
1023 data DocDecl
1024   = DocCommentNext HsDocString
1025   | DocCommentPrev HsDocString
1026   | DocCommentNamed String HsDocString
1027   | DocGroup Int HsDocString
1028   deriving (Data, Typeable)
1029  
1030 -- Okay, I need to reconstruct the document comments, but for now:
1031 instance Outputable DocDecl where
1032   ppr _ = text "<document comment>"
1033
1034 docDeclDoc :: DocDecl -> HsDocString
1035 docDeclDoc (DocCommentNext d) = d
1036 docDeclDoc (DocCommentPrev d) = d
1037 docDeclDoc (DocCommentNamed _ d) = d
1038 docDeclDoc (DocGroup _ d) = d
1039
1040 \end{code}
1041
1042 %************************************************************************
1043 %*                                                                      *
1044 \subsection[DeprecDecl]{Deprecations}
1045 %*                                                                      *
1046 %************************************************************************
1047
1048 We use exported entities for things to deprecate.
1049
1050 \begin{code}
1051 type LWarnDecl name = Located (WarnDecl name)
1052
1053 data WarnDecl name = Warning name WarningTxt
1054   deriving (Data, Typeable)
1055
1056 instance OutputableBndr name => Outputable (WarnDecl name) where
1057     ppr (Warning thing txt)
1058       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1059 \end{code}
1060
1061 %************************************************************************
1062 %*                                                                      *
1063 \subsection[AnnDecl]{Annotations}
1064 %*                                                                      *
1065 %************************************************************************
1066
1067 \begin{code}
1068 type LAnnDecl name = Located (AnnDecl name)
1069
1070 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1071   deriving (Data, Typeable)
1072
1073 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1074     ppr (HsAnnotation provenance expr) 
1075       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1076
1077
1078 data AnnProvenance name = ValueAnnProvenance name
1079                         | TypeAnnProvenance name
1080                         | ModuleAnnProvenance
1081   deriving (Data, Typeable)
1082
1083 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1084 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1085 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1086 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1087
1088 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1089 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1090 modifyAnnProvenanceNameM fm prov =
1091     case prov of
1092             ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1093             TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1094             ModuleAnnProvenance -> return ModuleAnnProvenance
1095
1096 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1097 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1098 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1099 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1100 \end{code}