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                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns.
459                   -- See Note [tcdTyVars and tcdTyPats] 
460
461                 tcdKindSig:: Maybe Kind,
462                         -- ^ Optional kind signature.
463                         --
464                         -- @(Just k)@ for a GADT-style @data@, or @data
465                         -- instance@ decl with explicit kind sig
466
467                 tcdCons   :: [LConDecl name],
468                         -- ^ Data constructors
469                         --
470                         -- For @data T a = T1 | T2 a@
471                         --   the 'LConDecl's all have 'ResTyH98'.
472                         -- For @data T a where { T1 :: T a }@
473                         --   the 'LConDecls' all have 'ResTyGADT'.
474
475                 tcdDerivs :: Maybe [LHsType name]
476                         -- ^ Derivings; @Nothing@ => not specified,
477                         --              @Just []@ => derive exactly what is asked
478                         --
479                         -- These "types" must be of form
480                         -- @
481                         --      forall ab. C ty1 ty2
482                         -- @
483                         -- Typically the foralls and ty args are empty, but they
484                         -- are non-empty for the newtype-deriving case
485     }
486
487   | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
488                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
489                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
490                   -- See Note [tcdTyVars and tcdTyPats] 
491
492                 tcdSynRhs :: LHsType name               -- ^ synonym expansion
493     }
494
495   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
496                 tcdLName   :: Located name,             -- ^ Name of the class
497                 tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
498                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
499                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
500                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
501                 tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
502                                                         --   only 'TyFamily'
503                 tcdATDefs  :: [LTyClDecl name],         -- ^ Associated type defaults; ie
504                                                         --   only 'TySynonym'
505                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
506     }
507   deriving (Data, Typeable)
508
509 data NewOrData
510   = NewType                     -- ^ @newtype Blah ...@
511   | DataType                    -- ^ @data Blah ...@
512   deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
513
514 data FamilyFlavour
515   = TypeFamily                  -- ^ @type family ...@
516   | DataFamily                  -- ^ @data family ...@
517   deriving (Data, Typeable)
518 \end{code}
519
520 Note [tcdTyVars and tcdTyPats] 
521 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
522 We use TyData and TySynonym both for vanilla data/type declarations
523      type T a = Int
524 AND for data/type family instance declarations
525      type instance F [a] = (a,Int)
526
527 tcdTyPats = Nothing
528    This is a vanilla data type or type synonym
529    tcdTyVars are the quantified type variables
530
531 tcdTyPats = Just tys
532    This is a data/type family instance declaration
533    tcdTyVars are fv(tys)
534
535    Eg   instance C (a,b) where
536           type F a x y = x->y
537    After the renamer, the tcdTyVars of the F decl are {x,y}
538
539 ------------------------------
540 Simple classifiers
541
542 \begin{code}
543 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
544 -- declaration.
545 isDataDecl :: TyClDecl name -> Bool
546 isDataDecl (TyData {}) = True
547 isDataDecl _other      = False
548
549 -- | type or type instance declaration
550 isTypeDecl :: TyClDecl name -> Bool
551 isTypeDecl (TySynonym {}) = True
552 isTypeDecl _other         = False
553
554 -- | vanilla Haskell type synonym (ie, not a type instance)
555 isSynDecl :: TyClDecl name -> Bool
556 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
557 isSynDecl _other                            = False
558
559 -- | type class
560 isClassDecl :: TyClDecl name -> Bool
561 isClassDecl (ClassDecl {}) = True
562 isClassDecl _              = False
563
564 -- | type family declaration
565 isFamilyDecl :: TyClDecl name -> Bool
566 isFamilyDecl (TyFamily {}) = True
567 isFamilyDecl _other        = False
568
569 -- | family instance (types, newtypes, and data types)
570 isFamInstDecl :: TyClDecl name -> Bool
571 isFamInstDecl tydecl
572    | isTypeDecl tydecl
573      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
574    | otherwise            = False
575 \end{code}
576
577 Dealing with names
578
579 \begin{code}
580 tcdName :: TyClDecl name -> name
581 tcdName decl = unLoc (tcdLName decl)
582
583 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
584 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
585 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
586 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
587 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
588 tyClDeclTyVars (ForeignType {})                = []
589 \end{code}
590
591 \begin{code}
592 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
593         -- class, synonym decls, data, newtype, family decls, family instances
594 countTyClDecls decls 
595  = (count isClassDecl    decls,
596     count isSynDecl      decls,  -- excluding...
597     count isDataTy       decls,  -- ...family...
598     count isNewTy        decls,  -- ...instances
599     count isFamilyDecl   decls,
600     count isFamInstDecl  decls)
601  where
602    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
603    isDataTy _                                             = False
604    
605    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
606    isNewTy _                                            = False
607 \end{code}
608
609 \begin{code}
610 instance OutputableBndr name
611               => Outputable (TyClDecl name) where
612
613     ppr (ForeignType {tcdLName = ltycon})
614         = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
615
616     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
617                    tcdTyVars = tyvars, tcdKind = mb_kind})
618       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
619         where
620           pp_flavour = case flavour of
621                          TypeFamily -> ptext (sLit "type family")
622                          DataFamily -> ptext (sLit "data family")
623
624           pp_kind = case mb_kind of
625                       Nothing   -> empty
626                       Just kind -> dcolon <+> pprKind kind
627
628     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
629                     tcdSynRhs = mono_ty})
630       = hang (ptext (sLit "type") <+> 
631               (if isJust typats then ptext (sLit "instance") else empty) <+>
632               pp_decl_head [] ltycon tyvars typats <+> 
633               equals)
634              4 (ppr mono_ty)
635
636     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
637                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
638                  tcdCons = condecls, tcdDerivs = derivings})
639       = pp_tydecl (null condecls && isJust mb_sig) 
640                   (ppr new_or_data <+> 
641                    (if isJust typats then ptext (sLit "instance") else empty) <+>
642                    pp_decl_head (unLoc context) ltycon tyvars typats <+> 
643                    ppr_sigx mb_sig)
644                   (pp_condecls condecls)
645                   derivings
646       where
647         ppr_sigx Nothing     = empty
648         ppr_sigx (Just kind) = dcolon <+> pprKind kind
649
650     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
651                     tcdFDs  = fds,
652                     tcdSigs = sigs, tcdMeths = methods,
653                     tcdATs = ats, tcdATDefs = at_defs})
654       | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
655       = top_matter
656
657       | otherwise       -- Laid out
658       = vcat [ top_matter <+> ptext (sLit "where")
659              , nest 2 $ pprDeclList (map ppr ats ++
660                                      map ppr at_defs ++
661                                      pprLHsBindsForUser methods sigs) ]
662       where
663         top_matter = ptext (sLit "class") 
664                      <+> pp_decl_head (unLoc context) lclas tyvars Nothing
665                      <+> pprFundeps (map unLoc fds)
666
667 pp_decl_head :: OutputableBndr name
668    => HsContext name
669    -> Located name
670    -> [LHsTyVarBndr name]
671    -> Maybe [LHsType name]
672    -> SDoc
673 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
674   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
675 pp_decl_head context thing _      (Just typats) -- explicit type patterns
676   = hsep [ pprHsContext context, ppr thing
677          , hsep (map (pprParendHsType.unLoc) typats)]
678
679 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
680 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
681   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
682 pp_condecls cs                    -- In H98 syntax
683   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
684
685 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
686 pp_tydecl True  pp_head _ _
687   = pp_head
688 pp_tydecl False pp_head pp_decl_rhs derivings
689   = hang pp_head 4 (sep [
690       pp_decl_rhs,
691       case derivings of
692         Nothing -> empty
693         Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
694     ])
695
696 instance Outputable NewOrData where
697   ppr NewType  = ptext (sLit "newtype")
698   ppr DataType = ptext (sLit "data")
699 \end{code}
700
701
702 %************************************************************************
703 %*                                                                      *
704 \subsection[ConDecl]{A data-constructor declaration}
705 %*                                                                      *
706 %************************************************************************
707
708 \begin{code}
709 type LConDecl name = Located (ConDecl name)
710
711 -- data T b = forall a. Eq a => MkT a b
712 --   MkT :: forall b a. Eq a => MkT a b
713
714 -- data T b where
715 --      MkT1 :: Int -> T Int
716
717 -- data T = Int `MkT` Int
718 --        | MkT2
719
720 -- data T a where
721 --      Int `MkT` Int :: T Int
722
723 data ConDecl name
724   = ConDecl
725     { con_name      :: Located name
726         -- ^ Constructor name.  This is used for the DataCon itself, and for
727         -- the user-callable wrapper Id.
728
729     , con_explicit  :: HsExplicitFlag
730         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
731
732     , con_qvars     :: [LHsTyVarBndr name]
733         -- ^ Type variables.  Depending on 'con_res' this describes the
734         -- following entities
735         --
736         --  - ResTyH98:  the constructor's *existential* type variables
737         --  - ResTyGADT: *all* the constructor's quantified type variables
738         --
739         -- If con_explicit is Implicit, then con_qvars is irrelevant
740         -- until after renaming.  
741
742     , con_cxt       :: LHsContext name
743         -- ^ The context.  This /does not/ include the \"stupid theta\" which
744         -- lives only in the 'TyData' decl.
745
746     , con_details   :: HsConDeclDetails name
747         -- ^ The main payload
748
749     , con_res       :: ResType name
750         -- ^ Result type of the constructor
751
752     , con_doc       :: Maybe LHsDocString
753         -- ^ A possible Haddock comment.
754
755     , con_old_rec :: Bool   
756         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
757         --                             GADT-style record decl   C { blah } :: T a b
758         -- Remove this when we no longer parse this stuff, and hence do not
759         -- need to report decprecated use
760     } deriving (Data, Typeable)
761
762 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
763
764 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
765 hsConDeclArgTys (PrefixCon tys)    = tys
766 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
767 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
768
769 data ResType name
770    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
771    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
772                                 --      and here is its result type
773    deriving (Data, Typeable)
774
775 instance OutputableBndr name => Outputable (ResType name) where
776          -- Debugging only
777    ppr ResTyH98 = ptext (sLit "ResTyH98")
778    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
779 \end{code}
780
781
782 \begin{code}
783 instance (OutputableBndr name) => Outputable (ConDecl name) where
784     ppr = pprConDecl
785
786 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
787 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
788                     , con_cxt = cxt, con_details = details
789                     , con_res = ResTyH98, con_doc = doc })
790   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
791   where
792     ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
793     ppr_details (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
794     ppr_details (RecCon fields)  = ppr con <+> pprConDeclFields fields
795
796 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
797                     , con_cxt = cxt, con_details = PrefixCon arg_tys
798                     , con_res = ResTyGADT res_ty })
799   = ppr con <+> dcolon <+> 
800     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
801   where
802     mk_fun_ty a b = noLoc (HsFunTy a b)
803
804 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
805                     , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
806   = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, 
807          pprConDeclFields fields <+> arrow <+> ppr res_ty]
808
809 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
810   = pprPanic "pprConDecl" (ppr con)
811         -- In GADT syntax we don't allow infix constructors
812 \end{code}
813
814 %************************************************************************
815 %*                                                                      *
816 \subsection[InstDecl]{An instance declaration}
817 %*                                                                      *
818 %************************************************************************
819
820 \begin{code}
821 type LInstDecl name = Located (InstDecl name)
822
823 data InstDecl name
824   = InstDecl    (LHsType name)  -- Context => Class Instance-type
825                                 -- Using a polytype means that the renamer conveniently
826                                 -- figures out the quantified type variables for us.
827                 (LHsBinds name)
828                 [LSig name]     -- User-supplied pragmatic info
829                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
830                                 -- 'TySynonym' only)
831   deriving (Data, Typeable)
832
833 instance (OutputableBndr name) => Outputable (InstDecl name) where
834     ppr (InstDecl inst_ty binds sigs ats)
835       | null sigs && null ats && isEmptyBag binds  -- No "where" part
836       = top_matter
837
838       | otherwise       -- Laid out
839       = vcat [ top_matter <+> ptext (sLit "where")
840              , nest 2 $ pprDeclList (map ppr ats ++
841                                      pprLHsBindsForUser binds sigs) ]
842       where
843         top_matter = ptext (sLit "instance") <+> ppr inst_ty
844
845 -- Extract the declarations of associated types from an instance
846 --
847 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
848 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
849 \end{code}
850
851 %************************************************************************
852 %*                                                                      *
853 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
854 %*                                                                      *
855 %************************************************************************
856
857 \begin{code}
858 type LDerivDecl name = Located (DerivDecl name)
859
860 data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
861   deriving (Data, Typeable)
862
863 instance (OutputableBndr name) => Outputable (DerivDecl name) where
864     ppr (DerivDecl ty) 
865         = hsep [ptext (sLit "deriving instance"), ppr ty]
866 \end{code}
867
868 %************************************************************************
869 %*                                                                      *
870 \subsection[DefaultDecl]{A @default@ declaration}
871 %*                                                                      *
872 %************************************************************************
873
874 There can only be one default declaration per module, but it is hard
875 for the parser to check that; we pass them all through in the abstract
876 syntax, and that restriction must be checked in the front end.
877
878 \begin{code}
879 type LDefaultDecl name = Located (DefaultDecl name)
880
881 data DefaultDecl name
882   = DefaultDecl [LHsType name]
883   deriving (Data, Typeable)
884
885 instance (OutputableBndr name)
886               => Outputable (DefaultDecl name) where
887
888     ppr (DefaultDecl tys)
889       = ptext (sLit "default") <+> parens (interpp'SP tys)
890 \end{code}
891
892 %************************************************************************
893 %*                                                                      *
894 \subsection{Foreign function interface declaration}
895 %*                                                                      *
896 %************************************************************************
897
898 \begin{code}
899
900 -- foreign declarations are distinguished as to whether they define or use a
901 -- Haskell name
902 --
903 --  * the Boolean value indicates whether the pre-standard deprecated syntax
904 --   has been used
905 --
906 type LForeignDecl name = Located (ForeignDecl name)
907
908 data ForeignDecl name
909   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
910   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
911   deriving (Data, Typeable)
912
913 -- Specification Of an imported external entity in dependence on the calling
914 -- convention 
915 --
916 data ForeignImport = -- import of a C entity
917                      --
918                      --  * the two strings specifying a header file or library
919                      --   may be empty, which indicates the absence of a
920                      --   header or object specification (both are not used
921                      --   in the case of `CWrapper' and when `CFunction'
922                      --   has a dynamic target)
923                      --
924                      --  * the calling convention is irrelevant for code
925                      --   generation in the case of `CLabel', but is needed
926                      --   for pretty printing 
927                      --
928                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
929                      --
930                      CImport  CCallConv       -- ccall or stdcall
931                               Safety          -- interruptible, safe or unsafe
932                               FastString      -- name of C header
933                               CImportSpec     -- details of the C entity
934   deriving (Data, Typeable)
935
936 -- details of an external C entity
937 --
938 data CImportSpec = CLabel    CLabelString     -- import address of a C label
939                  | CFunction CCallTarget      -- static or dynamic function
940                  | CWrapper                   -- wrapper to expose closures
941                                               -- (former f.e.d.)
942   deriving (Data, Typeable)
943
944 -- specification of an externally exported entity in dependence on the calling
945 -- convention
946 --
947 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
948   deriving (Data, Typeable)
949
950 -- pretty printing of foreign declarations
951 --
952
953 instance OutputableBndr name => Outputable (ForeignDecl name) where
954   ppr (ForeignImport n ty fimport) =
955     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
956        2 (dcolon <+> ppr ty)
957   ppr (ForeignExport n ty fexport) =
958     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
959        2 (dcolon <+> ppr ty)
960
961 instance Outputable ForeignImport where
962   ppr (CImport  cconv safety header spec) =
963     ppr cconv <+> ppr safety <+> 
964     char '"' <> pprCEntity spec <> char '"'
965     where
966       pp_hdr = if nullFS header then empty else ftext header
967
968       pprCEntity (CLabel lbl) = 
969         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
970       pprCEntity (CFunction (StaticTarget lbl _)) = 
971         ptext (sLit "static") <+> pp_hdr <+> ppr lbl
972       pprCEntity (CFunction (DynamicTarget)) =
973         ptext (sLit "dynamic")
974       pprCEntity (CWrapper) = ptext (sLit "wrapper")
975
976 instance Outputable ForeignExport where
977   ppr (CExport  (CExportStatic lbl cconv)) = 
978     ppr cconv <+> char '"' <> ppr lbl <> char '"'
979 \end{code}
980
981
982 %************************************************************************
983 %*                                                                      *
984 \subsection{Transformation rules}
985 %*                                                                      *
986 %************************************************************************
987
988 \begin{code}
989 type LRuleDecl name = Located (RuleDecl name)
990
991 data RuleDecl name
992   = HsRule                      -- Source rule
993         RuleName                -- Rule name
994         Activation
995         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
996         (Located (HsExpr name)) -- LHS
997         NameSet                 -- Free-vars from the LHS
998         (Located (HsExpr name)) -- RHS
999         NameSet                 -- Free-vars from the RHS
1000   deriving (Data, Typeable)
1001
1002 data RuleBndr name
1003   = RuleBndr (Located name)
1004   | RuleBndrSig (Located name) (LHsType name)
1005   deriving (Data, Typeable)
1006
1007 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
1008 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1009
1010 instance OutputableBndr name => Outputable (RuleDecl name) where
1011   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1012         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1013                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
1014                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1015         where
1016           pp_forall | null ns   = empty
1017                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1018
1019 instance OutputableBndr name => Outputable (RuleBndr name) where
1020    ppr (RuleBndr name) = ppr name
1021    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1022 \end{code}
1023
1024
1025 %************************************************************************
1026 %*                                                                      *
1027 \subsection{Vectorisation declarations}
1028 %*                                                                      *
1029 %************************************************************************
1030
1031 A vectorisation pragma, one of
1032
1033   {-# VECTORISE f = closure1 g (scalar_map g) #-}
1034   {-# VECTORISE SCALAR f #-}
1035   {-# NOVECTORISE f #-}
1036
1037   {-# VECTORISE type T = ty #-}
1038   {-# VECTORISE SCALAR type T #-}
1039   
1040 \begin{code}
1041 type LVectDecl name = Located (VectDecl name)
1042
1043 data VectDecl name
1044   = HsVect
1045       (Located name)
1046       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
1047   | HsNoVect
1048       (Located name)
1049   | HsVectTypeIn                -- pre type-checking
1050       (Located name)
1051       (Maybe (LHsType name))    -- 'Nothing' => SCALAR declaration
1052   | HsVectTypeOut               -- post type-checking
1053       TyCon
1054       (Maybe Type)              -- 'Nothing' => SCALAR declaration
1055   deriving (Data, Typeable)
1056
1057 lvectDeclName :: NamedThing name => LVectDecl name -> Name
1058 lvectDeclName (L _ (HsVect        (L _ name) _)) = getName name
1059 lvectDeclName (L _ (HsNoVect      (L _ name)))   = getName name
1060 lvectDeclName (L _ (HsVectTypeIn  (L _ name) _)) = getName name
1061 lvectDeclName (L _ (HsVectTypeOut tycon _))      = getName tycon
1062
1063 instance OutputableBndr name => Outputable (VectDecl name) where
1064   ppr (HsVect v Nothing)
1065     = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
1066   ppr (HsVect v (Just rhs))
1067     = sep [text "{-# VECTORISE" <+> ppr v,
1068            nest 4 $ 
1069              pprExpr (unLoc rhs) <+> text "#-}" ]
1070   ppr (HsNoVect v)
1071     = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1072   ppr (HsVectTypeIn t Nothing)
1073     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1074   ppr (HsVectTypeIn t (Just ty))
1075     = sep [text "{-# VECTORISE type" <+> ppr t,
1076            nest 4 $ 
1077              ppr (unLoc ty) <+> text "#-}" ]
1078   ppr (HsVectTypeOut t Nothing)
1079     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1080   ppr (HsVectTypeOut t (Just ty))
1081     = sep [text "{-# VECTORISE type" <+> ppr t,
1082            nest 4 $ 
1083              ppr ty <+> text "#-}" ]
1084 \end{code}
1085
1086 %************************************************************************
1087 %*                                                                      *
1088 \subsection[DocDecl]{Document comments}
1089 %*                                                                      *
1090 %************************************************************************
1091
1092 \begin{code}
1093
1094 type LDocDecl = Located (DocDecl)
1095
1096 data DocDecl
1097   = DocCommentNext HsDocString
1098   | DocCommentPrev HsDocString
1099   | DocCommentNamed String HsDocString
1100   | DocGroup Int HsDocString
1101   deriving (Data, Typeable)
1102  
1103 -- Okay, I need to reconstruct the document comments, but for now:
1104 instance Outputable DocDecl where
1105   ppr _ = text "<document comment>"
1106
1107 docDeclDoc :: DocDecl -> HsDocString
1108 docDeclDoc (DocCommentNext d) = d
1109 docDeclDoc (DocCommentPrev d) = d
1110 docDeclDoc (DocCommentNamed _ d) = d
1111 docDeclDoc (DocGroup _ d) = d
1112
1113 \end{code}
1114
1115 %************************************************************************
1116 %*                                                                      *
1117 \subsection[DeprecDecl]{Deprecations}
1118 %*                                                                      *
1119 %************************************************************************
1120
1121 We use exported entities for things to deprecate.
1122
1123 \begin{code}
1124 type LWarnDecl name = Located (WarnDecl name)
1125
1126 data WarnDecl name = Warning name WarningTxt
1127   deriving (Data, Typeable)
1128
1129 instance OutputableBndr name => Outputable (WarnDecl name) where
1130     ppr (Warning thing txt)
1131       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1132 \end{code}
1133
1134 %************************************************************************
1135 %*                                                                      *
1136 \subsection[AnnDecl]{Annotations}
1137 %*                                                                      *
1138 %************************************************************************
1139
1140 \begin{code}
1141 type LAnnDecl name = Located (AnnDecl name)
1142
1143 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1144   deriving (Data, Typeable)
1145
1146 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1147     ppr (HsAnnotation provenance expr) 
1148       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1149
1150
1151 data AnnProvenance name = ValueAnnProvenance name
1152                         | TypeAnnProvenance name
1153                         | ModuleAnnProvenance
1154   deriving (Data, Typeable)
1155
1156 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1157 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1158 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1159 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1160
1161 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1162 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1163 modifyAnnProvenanceNameM fm prov =
1164     case prov of
1165             ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1166             TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1167             ModuleAnnProvenance -> return ModuleAnnProvenance
1168
1169 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1170 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1171 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1172 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1173 \end{code}