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