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