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