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