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