Functions and types can now be post-hoc vectorised; i.e., in modules where they are...
[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       = vcat [ top_matter <+> ptext (sLit "where")
644              , nest 2 $ pprDeclList (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       = vcat [ top_matter <+> ptext (sLit "where")
824              , nest 2 $ pprDeclList (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 \end{code}
834
835 %************************************************************************
836 %*                                                                      *
837 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
838 %*                                                                      *
839 %************************************************************************
840
841 \begin{code}
842 type LDerivDecl name = Located (DerivDecl name)
843
844 data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
845   deriving (Data, Typeable)
846
847 instance (OutputableBndr name) => Outputable (DerivDecl name) where
848     ppr (DerivDecl ty) 
849         = hsep [ptext (sLit "deriving instance"), ppr ty]
850 \end{code}
851
852 %************************************************************************
853 %*                                                                      *
854 \subsection[DefaultDecl]{A @default@ declaration}
855 %*                                                                      *
856 %************************************************************************
857
858 There can only be one default declaration per module, but it is hard
859 for the parser to check that; we pass them all through in the abstract
860 syntax, and that restriction must be checked in the front end.
861
862 \begin{code}
863 type LDefaultDecl name = Located (DefaultDecl name)
864
865 data DefaultDecl name
866   = DefaultDecl [LHsType name]
867   deriving (Data, Typeable)
868
869 instance (OutputableBndr name)
870               => Outputable (DefaultDecl name) where
871
872     ppr (DefaultDecl tys)
873       = ptext (sLit "default") <+> parens (interpp'SP tys)
874 \end{code}
875
876 %************************************************************************
877 %*                                                                      *
878 \subsection{Foreign function interface declaration}
879 %*                                                                      *
880 %************************************************************************
881
882 \begin{code}
883
884 -- foreign declarations are distinguished as to whether they define or use a
885 -- Haskell name
886 --
887 --  * the Boolean value indicates whether the pre-standard deprecated syntax
888 --   has been used
889 --
890 type LForeignDecl name = Located (ForeignDecl name)
891
892 data ForeignDecl name
893   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
894   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
895   deriving (Data, Typeable)
896
897 -- Specification Of an imported external entity in dependence on the calling
898 -- convention 
899 --
900 data ForeignImport = -- import of a C entity
901                      --
902                      --  * the two strings specifying a header file or library
903                      --   may be empty, which indicates the absence of a
904                      --   header or object specification (both are not used
905                      --   in the case of `CWrapper' and when `CFunction'
906                      --   has a dynamic target)
907                      --
908                      --  * the calling convention is irrelevant for code
909                      --   generation in the case of `CLabel', but is needed
910                      --   for pretty printing 
911                      --
912                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
913                      --
914                      CImport  CCallConv       -- ccall or stdcall
915                               Safety          -- interruptible, safe or unsafe
916                               FastString      -- name of C header
917                               CImportSpec     -- details of the C entity
918   deriving (Data, Typeable)
919
920 -- details of an external C entity
921 --
922 data CImportSpec = CLabel    CLabelString     -- import address of a C label
923                  | CFunction CCallTarget      -- static or dynamic function
924                  | CWrapper                   -- wrapper to expose closures
925                                               -- (former f.e.d.)
926   deriving (Data, Typeable)
927
928 -- specification of an externally exported entity in dependence on the calling
929 -- convention
930 --
931 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
932   deriving (Data, Typeable)
933
934 -- pretty printing of foreign declarations
935 --
936
937 instance OutputableBndr name => Outputable (ForeignDecl name) where
938   ppr (ForeignImport n ty fimport) =
939     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
940        2 (dcolon <+> ppr ty)
941   ppr (ForeignExport n ty fexport) =
942     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
943        2 (dcolon <+> ppr ty)
944
945 instance Outputable ForeignImport where
946   ppr (CImport  cconv safety header spec) =
947     ppr cconv <+> ppr safety <+> 
948     char '"' <> pprCEntity spec <> char '"'
949     where
950       pp_hdr = if nullFS header then empty else ftext header
951
952       pprCEntity (CLabel lbl) = 
953         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
954       pprCEntity (CFunction (StaticTarget lbl _)) = 
955         ptext (sLit "static") <+> pp_hdr <+> ppr lbl
956       pprCEntity (CFunction (DynamicTarget)) =
957         ptext (sLit "dynamic")
958       pprCEntity (CWrapper) = ptext (sLit "wrapper")
959
960 instance Outputable ForeignExport where
961   ppr (CExport  (CExportStatic lbl cconv)) = 
962     ppr cconv <+> char '"' <> ppr lbl <> char '"'
963 \end{code}
964
965
966 %************************************************************************
967 %*                                                                      *
968 \subsection{Transformation rules}
969 %*                                                                      *
970 %************************************************************************
971
972 \begin{code}
973 type LRuleDecl name = Located (RuleDecl name)
974
975 data RuleDecl name
976   = HsRule                      -- Source rule
977         RuleName                -- Rule name
978         Activation
979         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
980         (Located (HsExpr name)) -- LHS
981         NameSet                 -- Free-vars from the LHS
982         (Located (HsExpr name)) -- RHS
983         NameSet                 -- Free-vars from the RHS
984   deriving (Data, Typeable)
985
986 data RuleBndr name
987   = RuleBndr (Located name)
988   | RuleBndrSig (Located name) (LHsType name)
989   deriving (Data, Typeable)
990
991 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
992 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
993
994 instance OutputableBndr name => Outputable (RuleDecl name) where
995   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
996         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
997                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
998                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
999         where
1000           pp_forall | null ns   = empty
1001                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1002
1003 instance OutputableBndr name => Outputable (RuleBndr name) where
1004    ppr (RuleBndr name) = ppr name
1005    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1006 \end{code}
1007
1008
1009 %************************************************************************
1010 %*                                                                      *
1011 \subsection{Vectorisation declarations}
1012 %*                                                                      *
1013 %************************************************************************
1014
1015 A vectorisation pragma, one of
1016
1017   {-# VECTORISE f = closure1 g (scalar_map g) #-}
1018   {-# VECTORISE SCALAR f #-}
1019   {-# NOVECTORISE f #-}
1020
1021   {-# VECTORISE type T = ty #-}
1022   {-# VECTORISE SCALAR type T #-}
1023   
1024 \begin{code}
1025 type LVectDecl name = Located (VectDecl name)
1026
1027 data VectDecl name
1028   = HsVect
1029       (Located name)
1030       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
1031   | HsNoVect
1032       (Located name)
1033   | HsVectTypeIn                -- pre type-checking
1034       (Located name)
1035       (Maybe (LHsType name))    -- 'Nothing' => SCALAR declaration
1036   | HsVectTypeOut               -- post type-checking
1037       TyCon
1038       (Maybe Type)              -- 'Nothing' => SCALAR declaration
1039   deriving (Data, Typeable)
1040
1041 lvectDeclName :: NamedThing name => LVectDecl name -> Name
1042 lvectDeclName (L _ (HsVect        (L _ name) _)) = getName name
1043 lvectDeclName (L _ (HsNoVect      (L _ name)))   = getName name
1044 lvectDeclName (L _ (HsVectTypeIn  (L _ name) _)) = getName name
1045 lvectDeclName (L _ (HsVectTypeOut tycon _))      = getName tycon
1046
1047 instance OutputableBndr name => Outputable (VectDecl name) where
1048   ppr (HsVect v Nothing)
1049     = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
1050   ppr (HsVect v (Just rhs))
1051     = sep [text "{-# VECTORISE" <+> ppr v,
1052            nest 4 $ 
1053              pprExpr (unLoc rhs) <+> text "#-}" ]
1054   ppr (HsNoVect v)
1055     = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1056   ppr (HsVectTypeIn t Nothing)
1057     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1058   ppr (HsVectTypeIn t (Just ty))
1059     = sep [text "{-# VECTORISE type" <+> ppr t,
1060            nest 4 $ 
1061              ppr (unLoc ty) <+> text "#-}" ]
1062   ppr (HsVectTypeOut t Nothing)
1063     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1064   ppr (HsVectTypeOut t (Just ty))
1065     = sep [text "{-# VECTORISE type" <+> ppr t,
1066            nest 4 $ 
1067              ppr ty <+> text "#-}" ]
1068 \end{code}
1069
1070 %************************************************************************
1071 %*                                                                      *
1072 \subsection[DocDecl]{Document comments}
1073 %*                                                                      *
1074 %************************************************************************
1075
1076 \begin{code}
1077
1078 type LDocDecl = Located (DocDecl)
1079
1080 data DocDecl
1081   = DocCommentNext HsDocString
1082   | DocCommentPrev HsDocString
1083   | DocCommentNamed String HsDocString
1084   | DocGroup Int HsDocString
1085   deriving (Data, Typeable)
1086  
1087 -- Okay, I need to reconstruct the document comments, but for now:
1088 instance Outputable DocDecl where
1089   ppr _ = text "<document comment>"
1090
1091 docDeclDoc :: DocDecl -> HsDocString
1092 docDeclDoc (DocCommentNext d) = d
1093 docDeclDoc (DocCommentPrev d) = d
1094 docDeclDoc (DocCommentNamed _ d) = d
1095 docDeclDoc (DocGroup _ d) = d
1096
1097 \end{code}
1098
1099 %************************************************************************
1100 %*                                                                      *
1101 \subsection[DeprecDecl]{Deprecations}
1102 %*                                                                      *
1103 %************************************************************************
1104
1105 We use exported entities for things to deprecate.
1106
1107 \begin{code}
1108 type LWarnDecl name = Located (WarnDecl name)
1109
1110 data WarnDecl name = Warning name WarningTxt
1111   deriving (Data, Typeable)
1112
1113 instance OutputableBndr name => Outputable (WarnDecl name) where
1114     ppr (Warning thing txt)
1115       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1116 \end{code}
1117
1118 %************************************************************************
1119 %*                                                                      *
1120 \subsection[AnnDecl]{Annotations}
1121 %*                                                                      *
1122 %************************************************************************
1123
1124 \begin{code}
1125 type LAnnDecl name = Located (AnnDecl name)
1126
1127 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1128   deriving (Data, Typeable)
1129
1130 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1131     ppr (HsAnnotation provenance expr) 
1132       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1133
1134
1135 data AnnProvenance name = ValueAnnProvenance name
1136                         | TypeAnnProvenance name
1137                         | ModuleAnnProvenance
1138   deriving (Data, Typeable)
1139
1140 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1141 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1142 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1143 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1144
1145 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1146 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1147 modifyAnnProvenanceNameM fm prov =
1148     case prov of
1149             ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1150             TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1151             ModuleAnnProvenance -> return ModuleAnnProvenance
1152
1153 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1154 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1155 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1156 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1157 \end{code}