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