Use OPTIONS rather than OPTIONS_GHC for pragmas
[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 HsDecls: Abstract syntax: global declarations
7
8 Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
9 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
10
11 \begin{code}
12 {-# OPTIONS -w #-}
13 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 --     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
17 -- for details
18
19 module HsDecls (
20         HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl, 
21         InstDecl(..), LInstDecl, DerivDecl(..), LDerivDecl, NewOrData(..),
22         FamilyFlavour(..),
23         RuleDecl(..), LRuleDecl, RuleBndr(..),
24         DefaultDecl(..), LDefaultDecl, SpliceDecl(..),
25         ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
26         CImportSpec(..), FoType(..),
27         ConDecl(..), ResType(..), ConDeclField(..), LConDecl,   
28         HsConDeclDetails, hsConDeclArgTys,
29         DocDecl(..), LDocDecl, docDeclDoc,
30         DeprecDecl(..),  LDeprecDecl,
31         HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
32         tcdName, tyClDeclNames, tyClDeclTyVars,
33         isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
34         isFamInstDecl, 
35         countTyClDecls,
36         instDeclATs,
37         collectRuleBndrSigTys, 
38     ) where
39
40 #include "HsVersions.h"
41
42 -- friends:
43 import {-# SOURCE #-}   HsExpr( HsExpr, pprExpr )
44         -- Because Expr imports Decls via HsBracket
45
46 import HsBinds
47 import HsPat
48 import HsImpExp
49 import HsTypes
50 import HsDoc
51 import NameSet
52 import CoreSyn
53 import {- Kind parts of -} Type
54 import BasicTypes
55 import ForeignCall
56
57 -- others:
58 import Class
59 import Outputable       
60 import Util
61 import SrcLoc
62 import FastString
63
64 import Data.Maybe       ( isJust )
65 \end{code}
66
67 %************************************************************************
68 %*                                                                      *
69 \subsection[HsDecl]{Declarations}
70 %*                                                                      *
71 %************************************************************************
72
73 \begin{code}
74 type LHsDecl id = Located (HsDecl id)
75
76 data HsDecl id
77   = TyClD       (TyClDecl id)
78   | InstD       (InstDecl  id)
79   | DerivD      (DerivDecl id)
80   | ValD        (HsBind id)
81   | SigD        (Sig id)
82   | DefD        (DefaultDecl id)
83   | ForD        (ForeignDecl id)
84   | DeprecD     (DeprecDecl id)
85   | RuleD       (RuleDecl id)
86   | SpliceD     (SpliceDecl id)
87   | DocD        (DocDecl id)
88
89
90 -- NB: all top-level fixity decls are contained EITHER
91 -- EITHER SigDs
92 -- OR     in the ClassDecls in TyClDs
93 --
94 -- The former covers
95 --      a) data constructors
96 --      b) class methods (but they can be also done in the
97 --              signatures of class decls)
98 --      c) imported functions (that have an IfacSig)
99 --      d) top level decls
100 --
101 -- The latter is for class methods only
102
103 -- A [HsDecl] is categorised into a HsGroup before being 
104 -- fed to the renamer.
105 data HsGroup id
106   = HsGroup {
107         hs_valds  :: HsValBinds id,
108         hs_tyclds :: [LTyClDecl id],
109         hs_instds :: [LInstDecl id],
110         hs_derivds :: [LDerivDecl id],
111
112         hs_fixds  :: [LFixitySig id],
113                 -- Snaffled out of both top-level fixity signatures,
114                 -- and those in class declarations
115
116         hs_defds  :: [LDefaultDecl id],
117         hs_fords  :: [LForeignDecl id],
118         hs_depds  :: [LDeprecDecl id],
119         hs_ruleds :: [LRuleDecl id],
120
121         hs_docs   :: [LDocDecl id]
122   }
123
124 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
125 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
126 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
127
128 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
129                        hs_fixds = [], hs_defds = [], hs_fords = [], 
130                        hs_depds = [], hs_ruleds = [],
131                        hs_valds = error "emptyGroup hs_valds: Can't happen",
132                        hs_docs = [] }
133
134 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
135 appendGroups 
136     HsGroup { 
137         hs_valds  = val_groups1,
138         hs_tyclds = tyclds1, 
139         hs_instds = instds1,
140         hs_derivds = derivds1,
141         hs_fixds  = fixds1, 
142         hs_defds  = defds1,
143         hs_fords  = fords1, 
144         hs_depds  = depds1,
145         hs_ruleds = rulds1,
146   hs_docs   = docs1 }
147     HsGroup { 
148         hs_valds  = val_groups2,
149         hs_tyclds = tyclds2, 
150         hs_instds = instds2,
151         hs_derivds = derivds2,
152         hs_fixds  = fixds2, 
153         hs_defds  = defds2,
154         hs_fords  = fords2, 
155         hs_depds  = depds2,
156         hs_ruleds = rulds2,
157   hs_docs   = docs2 }
158   = 
159     HsGroup { 
160         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
161         hs_tyclds = tyclds1 ++ tyclds2, 
162         hs_instds = instds1 ++ instds2,
163         hs_derivds = derivds1 ++ derivds2,
164         hs_fixds  = fixds1 ++ fixds2, 
165         hs_defds  = defds1 ++ defds2,
166         hs_fords  = fords1 ++ fords2, 
167         hs_depds  = depds1 ++ depds2,
168         hs_ruleds = rulds1 ++ rulds2,
169   hs_docs   = docs1  ++ docs2 }
170 \end{code}
171
172 \begin{code}
173 instance OutputableBndr name => Outputable (HsDecl name) where
174     ppr (TyClD dcl)             = ppr dcl
175     ppr (ValD binds)            = ppr binds
176     ppr (DefD def)              = ppr def
177     ppr (InstD inst)            = ppr inst
178     ppr (DerivD deriv)          = ppr deriv
179     ppr (ForD fd)               = ppr fd
180     ppr (SigD sd)               = ppr sd
181     ppr (RuleD rd)              = ppr rd
182     ppr (DeprecD dd)            = ppr dd
183     ppr (SpliceD dd)            = ppr dd
184     ppr (DocD doc)              = ppr doc
185
186 instance OutputableBndr name => Outputable (HsGroup name) where
187     ppr (HsGroup { hs_valds  = val_decls,
188                    hs_tyclds = tycl_decls,
189                    hs_instds = inst_decls,
190                    hs_derivds = deriv_decls,
191                    hs_fixds  = fix_decls,
192                    hs_depds  = deprec_decls,
193                    hs_fords  = foreign_decls,
194                    hs_defds  = default_decls,
195                    hs_ruleds = rule_decls })
196         = vcat [ppr_ds fix_decls, ppr_ds default_decls, 
197                 ppr_ds deprec_decls, ppr_ds rule_decls,
198                 ppr val_decls,
199                 ppr_ds tycl_decls, ppr_ds inst_decls,
200                 ppr_ds deriv_decls,
201                 ppr_ds foreign_decls]
202         where
203           ppr_ds [] = empty
204           ppr_ds ds = text "" $$ vcat (map ppr ds)
205
206 data SpliceDecl id = SpliceDecl (Located (HsExpr id))   -- Top level splice
207
208 instance OutputableBndr name => Outputable (SpliceDecl name) where
209    ppr (SpliceDecl e) = ptext SLIT("$") <> parens (pprExpr (unLoc e))
210 \end{code}
211
212
213 %************************************************************************
214 %*                                                                      *
215 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
216 %*                                                                      *
217 %************************************************************************
218
219                 --------------------------------
220                         THE NAMING STORY
221                 --------------------------------
222
223 Here is the story about the implicit names that go with type, class,
224 and instance decls.  It's a bit tricky, so pay attention!
225
226 "Implicit" (or "system") binders
227 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
228   Each data type decl defines 
229         a worker name for each constructor
230         to-T and from-T convertors
231   Each class decl defines
232         a tycon for the class
233         a data constructor for that tycon
234         the worker for that constructor
235         a selector for each superclass
236
237 All have occurrence names that are derived uniquely from their parent
238 declaration.
239
240 None of these get separate definitions in an interface file; they are
241 fully defined by the data or class decl.  But they may *occur* in
242 interface files, of course.  Any such occurrence must haul in the
243 relevant type or class decl.
244
245 Plan of attack:
246  - Ensure they "point to" the parent data/class decl 
247    when loading that decl from an interface file
248    (See RnHiFiles.getSysBinders)
249
250  - When typechecking the decl, we build the implicit TyCons and Ids.
251    When doing so we look them up in the name cache (RnEnv.lookupSysName),
252    to ensure correct module and provenance is set
253
254 These are the two places that we have to conjure up the magic derived
255 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
256
257 Default methods
258 ~~~~~~~~~~~~~~~
259  - Occurrence name is derived uniquely from the method name
260    E.g. $dmmax
261
262  - If there is a default method name at all, it's recorded in
263    the ClassOpSig (in HsBinds), in the DefMeth field.
264    (DefMeth is defined in Class.lhs)
265
266 Source-code class decls and interface-code class decls are treated subtly
267 differently, which has given me a great deal of confusion over the years.
268 Here's the deal.  (We distinguish the two cases because source-code decls
269 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
270
271 In *source-code* class declarations:
272
273  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
274    This is done by RdrHsSyn.mkClassOpSigDM
275
276  - The renamer renames it to a Name
277
278  - During typechecking, we generate a binding for each $dm for 
279    which there's a programmer-supplied default method:
280         class Foo a where
281           op1 :: <type>
282           op2 :: <type>
283           op1 = ...
284    We generate a binding for $dmop1 but not for $dmop2.
285    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
286    The Name for $dmop2 is simply discarded.
287
288 In *interface-file* class declarations:
289   - When parsing, we see if there's an explicit programmer-supplied default method
290     because there's an '=' sign to indicate it:
291         class Foo a where
292           op1 = :: <type>       -- NB the '='
293           op2   :: <type>
294     We use this info to generate a DefMeth with a suitable RdrName for op1,
295     and a NoDefMeth for op2
296   - The interface file has a separate definition for $dmop1, with unfolding etc.
297   - The renamer renames it to a Name.
298   - The renamer treats $dmop1 as a free variable of the declaration, so that
299     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)  
300     This doesn't happen for source code class decls, because they *bind* the default method.
301
302 Dictionary functions
303 ~~~~~~~~~~~~~~~~~~~~
304 Each instance declaration gives rise to one dictionary function binding.
305
306 The type checker makes up new source-code instance declarations
307 (e.g. from 'deriving' or generic default methods --- see
308 TcInstDcls.tcInstDecls1).  So we can't generate the names for
309 dictionary functions in advance (we don't know how many we need).
310
311 On the other hand for interface-file instance declarations, the decl
312 specifies the name of the dictionary function, and it has a binding elsewhere
313 in the interface file:
314         instance {Eq Int} = dEqInt
315         dEqInt :: {Eq Int} <pragma info>
316
317 So again we treat source code and interface file code slightly differently.
318
319 Source code:
320   - Source code instance decls have a Nothing in the (Maybe name) field
321     (see data InstDecl below)
322
323   - The typechecker makes up a Local name for the dict fun for any source-code
324     instance decl, whether it comes from a source-code instance decl, or whether
325     the instance decl is derived from some other construct (e.g. 'deriving').
326
327   - The occurrence name it chooses is derived from the instance decl (just for 
328     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
329     occurrence name, but will have different uniques.  E.g.
330         instance Foo [Int]  where ...
331         instance Foo [Bool] where ...
332     These might both be dFooList
333
334   - The CoreTidy phase externalises the name, and ensures the occurrence name is
335     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
336
337   - We can take this relaxed approach (changing the occurrence name later) 
338     because dict fun Ids are not captured in a TyCon or Class (unlike default
339     methods, say).  Instead, they are kept separately in the InstEnv.  This
340     makes it easy to adjust them after compiling a module.  (Once we've finished
341     compiling that module, they don't change any more.)
342
343
344 Interface file code:
345   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
346     in the (Maybe name) field.
347
348   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
349     suck in the dfun binding
350
351
352 \begin{code}
353 -- Representation of indexed types
354 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
355 -- Family kind signatures are represented by the variant `TyFamily'.  It
356 -- covers "type family", "newtype family", and "data family" declarations,
357 -- distinguished by the value of the field `tcdFlavour'.
358 --
359 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
360 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
361 --
362 --   * If it is 'Nothing', we have a *vanilla* data type declaration or type
363 --     synonym declaration and 'tcdVars' contains the type parameters of the
364 --     type constructor.
365 --
366 --   * If it is 'Just pats', we have the definition of an indexed type.  Then,
367 --     'pats' are type patterns for the type-indexes of the type constructor
368 --     and 'tcdTyVars' are the variables in those patterns.  Hence, the arity of
369 --     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
370 --     *not* 'length tcdVars'.
371 --
372 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
373
374 type LTyClDecl name = Located (TyClDecl name)
375
376 data TyClDecl name
377   = ForeignType { 
378                 tcdLName    :: Located name,
379                 tcdExtName  :: Maybe FastString,
380                 tcdFoType   :: FoType
381     }
382
383         -- type/data/newtype family T :: *->*
384   | TyFamily {  tcdFlavour:: FamilyFlavour,             -- type, new, or data
385                 tcdLName  :: Located name,              -- type constructor
386                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
387                 tcdKind   :: Maybe Kind                 -- result kind
388     }
389
390         -- Declares a data type or newtype, giving its construcors
391         --      data/newtype T a = <constrs>
392         --      data/newtype instance T [a] = <constrs>
393   | TyData {    tcdND     :: NewOrData,
394                 tcdCtxt   :: LHsContext name,           -- Context
395                 tcdLName  :: Located name,              -- Type constructor
396
397                 tcdTyVars :: [LHsTyVarBndr name],       -- Type variables
398                         
399                 tcdTyPats :: Maybe [LHsType name],      -- Type patterns
400                         -- Just [t1..tn] for data instance T t1..tn = ...
401                         --      in this case tcdTyVars = fv( tcdTyPats )
402                         -- Nothing for everything else
403
404                 tcdKindSig:: Maybe Kind,                -- Optional kind sig 
405                         -- (Just k) for a GADT-style 'data', or 'data
406                         -- instance' decl with explicit kind sig
407
408                 tcdCons   :: [LConDecl name],           -- Data constructors
409                         -- For data T a = T1 | T2 a          
410                         --   the LConDecls all have ResTyH98
411                         -- For data T a where { T1 :: T a }  
412                         --   the LConDecls all have ResTyGADT
413
414                 tcdDerivs :: Maybe [LHsType name]
415                         -- Derivings; Nothing => not specified
416                         --            Just [] => derive exactly what is asked
417                         -- These "types" must be of form
418                         --      forall ab. C ty1 ty2
419                         -- Typically the foralls and ty args are empty, but they
420                         -- are non-empty for the newtype-deriving case
421     }
422
423   | TySynonym { tcdLName  :: Located name,              -- type constructor
424                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
425                 tcdTyPats :: Maybe [LHsType name],      -- Type patterns
426                         -- See comments for tcdTyPats in TyData
427                         -- 'Nothing' => vanilla type synonym
428
429                 tcdSynRhs :: LHsType name               -- synonym expansion
430     }
431
432   | ClassDecl { tcdCtxt    :: LHsContext name,          -- Context...
433                 tcdLName   :: Located name,             -- Name of the class
434                 tcdTyVars  :: [LHsTyVarBndr name],      -- Class type variables
435                 tcdFDs     :: [Located (FunDep name)],  -- Functional deps
436                 tcdSigs    :: [LSig name],              -- Methods' signatures
437                 tcdMeths   :: LHsBinds name,            -- Default methods
438                 tcdATs     :: [LTyClDecl name],         -- Associated types; ie
439                                                         --   only 'TyFamily' and
440                                                         --   'TySynonym'; the
441                                                         --   latter for defaults
442                 tcdDocs    :: [LDocDecl name]           -- Haddock docs
443     }
444
445 data NewOrData
446   = NewType                     -- "newtype Blah ..."
447   | DataType                    -- "data Blah ..."
448   deriving( Eq )                -- Needed because Demand derives Eq
449
450 data FamilyFlavour
451   = TypeFamily                  -- "type family ..."
452   | DataFamily                  -- "data family ..."
453 \end{code}
454
455 Simple classifiers
456
457 \begin{code}
458 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl :: 
459   TyClDecl name -> Bool
460
461 -- data/newtype or data/newtype instance declaration
462 isDataDecl (TyData {}) = True
463 isDataDecl _other      = False
464
465 -- type or type instance declaration
466 isTypeDecl (TySynonym {}) = True
467 isTypeDecl _other         = False
468
469 -- vanilla Haskell type synonym (ie, not a type instance)
470 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
471 isSynDecl _other                            = False
472
473 -- type class
474 isClassDecl (ClassDecl {}) = True
475 isClassDecl other          = False
476
477 -- type family declaration
478 isFamilyDecl (TyFamily {}) = True
479 isFamilyDecl _other        = False
480
481 -- family instance (types, newtypes, and data types)
482 isFamInstDecl tydecl
483    | isTypeDecl tydecl
484      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
485    | otherwise            = False
486 \end{code}
487
488 Dealing with names
489
490 \begin{code}
491 tcdName :: TyClDecl name -> name
492 tcdName decl = unLoc (tcdLName decl)
493
494 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
495 -- Returns all the *binding* names of the decl, along with their SrcLocs
496 -- The first one is guaranteed to be the name of the decl
497 -- For record fields, the first one counts as the SrcLoc
498 -- We use the equality to filter out duplicate field names
499
500 tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
501 tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
502 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
503
504 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
505   = cls_name : 
506     concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
507
508 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
509   = tc_name : conDeclsNames (map unLoc cons)
510
511 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
512 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
513 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
514 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
515 tyClDeclTyVars (ForeignType {})                = []
516 \end{code}
517
518 \begin{code}
519 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
520         -- class, synonym decls, data, newtype, family decls, family instances
521 countTyClDecls decls 
522  = (count isClassDecl    decls,
523     count isSynDecl      decls,  -- excluding...
524     count isDataTy       decls,  -- ...family...
525     count isNewTy        decls,  -- ...instances
526     count isFamilyDecl   decls,
527     count isFamInstDecl  decls)
528  where
529    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
530    isDataTy _                                             = False
531    
532    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
533    isNewTy _                                            = False
534 \end{code}
535
536 \begin{code}
537 instance OutputableBndr name
538               => Outputable (TyClDecl name) where
539
540     ppr (ForeignType {tcdLName = ltycon})
541         = hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
542
543     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
544                    tcdTyVars = tyvars, tcdKind = mb_kind})
545       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
546         where
547           pp_flavour = case flavour of
548                          TypeFamily -> ptext SLIT("type family")
549                          DataFamily -> ptext SLIT("data family")
550
551           pp_kind = case mb_kind of
552                       Nothing   -> empty
553                       Just kind -> dcolon <+> pprKind kind
554
555     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
556                     tcdSynRhs = mono_ty})
557       = hang (ptext SLIT("type") <+> 
558               (if isJust typats then ptext SLIT("instance") else empty) <+>
559               pp_decl_head [] ltycon tyvars typats <+> 
560               equals)
561              4 (ppr mono_ty)
562
563     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
564                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
565                  tcdCons = condecls, tcdDerivs = derivings})
566       = pp_tydecl (null condecls && isJust mb_sig) 
567                   (ppr new_or_data <+> 
568                    (if isJust typats then ptext SLIT("instance") else empty) <+>
569                    pp_decl_head (unLoc context) ltycon tyvars typats <+> 
570                    ppr_sig mb_sig)
571                   (pp_condecls condecls)
572                   derivings
573       where
574         ppr_sig Nothing = empty
575         ppr_sig (Just kind) = dcolon <+> pprKind kind
576
577     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
578                     tcdFDs = fds, 
579                     tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
580       | null sigs && null ats  -- No "where" part
581       = top_matter
582
583       | otherwise       -- Laid out
584       = sep [hsep [top_matter, ptext SLIT("where {")],
585              nest 4 (sep [ sep (map ppr_semi ats)
586                          , sep (map ppr_semi sigs)
587                          , pprLHsBinds methods
588                          , char '}'])]
589       where
590         top_matter    =     ptext SLIT("class") 
591                         <+> pp_decl_head (unLoc context) lclas tyvars Nothing
592                         <+> pprFundeps (map unLoc fds)
593         ppr_semi decl = ppr decl <> semi
594
595 pp_decl_head :: OutputableBndr name
596    => HsContext name
597    -> Located name
598    -> [LHsTyVarBndr name]
599    -> Maybe [LHsType name]
600    -> SDoc
601 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
602   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
603 pp_decl_head context thing _      (Just typats) -- explicit type patterns
604   = hsep [ pprHsContext context, ppr thing
605          , hsep (map (pprParendHsType.unLoc) typats)]
606
607 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
608   = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
609 pp_condecls cs                    -- In H98 syntax
610   = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
611
612 pp_tydecl True pp_head pp_decl_rhs derivings
613   = pp_head
614 pp_tydecl False pp_head pp_decl_rhs derivings
615   = hang pp_head 4 (sep [
616       pp_decl_rhs,
617       case derivings of
618         Nothing -> empty
619         Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
620     ])
621
622 instance Outputable NewOrData where
623   ppr NewType  = ptext SLIT("newtype")
624   ppr DataType = ptext SLIT("data")
625 \end{code}
626
627
628 %************************************************************************
629 %*                                                                      *
630 \subsection[ConDecl]{A data-constructor declaration}
631 %*                                                                      *
632 %************************************************************************
633
634 \begin{code}
635 type LConDecl name = Located (ConDecl name)
636
637 -- data T b = forall a. Eq a => MkT a b
638 --   MkT :: forall b a. Eq a => MkT a b
639
640 -- data T b where
641 --      MkT1 :: Int -> T Int
642
643 -- data T = Int `MkT` Int
644 --        | MkT2
645
646 -- data T a where
647 --      Int `MkT` Int :: T Int
648
649 data ConDecl name
650   = ConDecl
651     { con_name      :: Located name         -- Constructor name; this is used for the
652                                             -- DataCon itself, and for the user-callable wrapper Id
653
654     , con_explicit  :: HsExplicitForAll     -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
655
656     , con_qvars     :: [LHsTyVarBndr name]  -- ResTyH98: the constructor's existential type variables
657                                             -- ResTyGADT:    all the constructor's quantified type variables
658
659     , con_cxt       :: LHsContext name      -- The context.  This *does not* include the
660                                             -- "stupid theta" which lives only in the TyData decl
661
662     , con_details   :: HsConDeclDetails name    -- The main payload
663
664     , con_res       :: ResType name         -- Result type of the constructor
665
666     , con_doc       :: Maybe (LHsDoc name)  -- A possible Haddock comment
667     }
668
669 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
670
671 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
672 hsConDeclArgTys (PrefixCon tys)    = tys
673 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
674 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
675
676 data ConDeclField name  -- Record fields have Haddoc docs on them
677   = ConDeclField { cd_fld_name :: Located name,
678                    cd_fld_type :: LBangType name, 
679                    cd_fld_doc  :: Maybe (LHsDoc name) }
680
681 data ResType name
682    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
683    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
684                                 --      and here is its result type
685 \end{code}
686
687 \begin{code}
688 conDeclsNames :: forall name. Eq name => [ConDecl name] -> [Located name]
689   -- See tyClDeclNames for what this does
690   -- The function is boringly complicated because of the records
691   -- And since we only have equality, we have to be a little careful
692 conDeclsNames cons
693   = snd (foldl do_one ([], []) cons)
694   where
695     do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
696         = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
697         where
698           new_flds = filterOut (\f -> unLoc f `elem` flds_seen) 
699                                (map cd_fld_name flds)
700
701     do_one (flds_seen, acc) c
702         = (flds_seen, (con_name c):acc)
703 \end{code}
704   
705
706 \begin{code}
707 instance (OutputableBndr name) => Outputable (ConDecl name) where
708     ppr = pprConDecl
709
710 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
711 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
712   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
713   where
714     ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
715     ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
716     ppr_details con (RecCon fields)  = ppr con <+> ppr_fields fields
717
718 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
719   = ppr con <+> dcolon <+> 
720     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
721   where
722     mk_fun_ty a b = noLoc (HsFunTy a b)
723
724 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
725   = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
726
727 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
728   where
729     ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty, 
730                             cd_fld_doc = doc })
731         = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
732 \end{code}
733
734 %************************************************************************
735 %*                                                                      *
736 \subsection[InstDecl]{An instance declaration
737 %*                                                                      *
738 %************************************************************************
739
740 \begin{code}
741 type LInstDecl name = Located (InstDecl name)
742
743 data InstDecl name
744   = InstDecl    (LHsType name)  -- Context => Class Instance-type
745                                 -- Using a polytype means that the renamer conveniently
746                                 -- figures out the quantified type variables for us.
747                 (LHsBinds name)
748                 [LSig name]     -- User-supplied pragmatic info
749                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
750                                 -- 'TySynonym' only)
751
752 instance (OutputableBndr name) => Outputable (InstDecl name) where
753
754     ppr (InstDecl inst_ty binds uprags ats)
755       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
756               nest 4 (ppr ats),
757               nest 4 (ppr uprags),
758               nest 4 (pprLHsBinds binds) ]
759
760 -- Extract the declarations of associated types from an instance
761 --
762 instDeclATs :: InstDecl name -> [LTyClDecl name]
763 instDeclATs (InstDecl _ _ _ ats) = ats
764 \end{code}
765
766 %************************************************************************
767 %*                                                                      *
768 \subsection[DerivDecl]{A stand-alone instance deriving declaration
769 %*                                                                      *
770 %************************************************************************
771
772 \begin{code}
773 type LDerivDecl name = Located (DerivDecl name)
774
775 data DerivDecl name = DerivDecl (LHsType name)
776
777 instance (OutputableBndr name) => Outputable (DerivDecl name) where
778     ppr (DerivDecl ty) 
779         = hsep [ptext SLIT("derived instance"), ppr ty]
780 \end{code}
781
782 %************************************************************************
783 %*                                                                      *
784 \subsection[DefaultDecl]{A @default@ declaration}
785 %*                                                                      *
786 %************************************************************************
787
788 There can only be one default declaration per module, but it is hard
789 for the parser to check that; we pass them all through in the abstract
790 syntax, and that restriction must be checked in the front end.
791
792 \begin{code}
793 type LDefaultDecl name = Located (DefaultDecl name)
794
795 data DefaultDecl name
796   = DefaultDecl [LHsType name]
797
798 instance (OutputableBndr name)
799               => Outputable (DefaultDecl name) where
800
801     ppr (DefaultDecl tys)
802       = ptext SLIT("default") <+> parens (interpp'SP tys)
803 \end{code}
804
805 %************************************************************************
806 %*                                                                      *
807 \subsection{Foreign function interface declaration}
808 %*                                                                      *
809 %************************************************************************
810
811 \begin{code}
812
813 -- foreign declarations are distinguished as to whether they define or use a
814 -- Haskell name
815 --
816 --  * the Boolean value indicates whether the pre-standard deprecated syntax
817 --   has been used
818 --
819 type LForeignDecl name = Located (ForeignDecl name)
820
821 data ForeignDecl name
822   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
823   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
824
825 -- Specification Of an imported external entity in dependence on the calling
826 -- convention 
827 --
828 data ForeignImport = -- import of a C entity
829                      --
830                      --  * the two strings specifying a header file or library
831                      --   may be empty, which indicates the absence of a
832                      --   header or object specification (both are not used
833                      --   in the case of `CWrapper' and when `CFunction'
834                      --   has a dynamic target)
835                      --
836                      --  * the calling convention is irrelevant for code
837                      --   generation in the case of `CLabel', but is needed
838                      --   for pretty printing 
839                      --
840                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
841                      --
842                      CImport  CCallConv       -- ccall or stdcall
843                               Safety          -- safe or unsafe
844                               FastString      -- name of C header
845                               FastString      -- name of library object
846                               CImportSpec     -- details of the C entity
847
848                      -- import of a .NET function
849                      --
850                    | DNImport DNCallSpec
851
852 -- details of an external C entity
853 --
854 data CImportSpec = CLabel    CLabelString     -- import address of a C label
855                  | CFunction CCallTarget      -- static or dynamic function
856                  | CWrapper                   -- wrapper to expose closures
857                                               -- (former f.e.d.)
858
859 -- specification of an externally exported entity in dependence on the calling
860 -- convention
861 --
862 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
863                    | DNExport                -- presently unused
864
865 -- abstract type imported from .NET
866 --
867 data FoType = DNType            -- In due course we'll add subtype stuff
868             deriving (Eq)       -- Used for equality instance for TyClDecl
869
870
871 -- pretty printing of foreign declarations
872 --
873
874 instance OutputableBndr name => Outputable (ForeignDecl name) where
875   ppr (ForeignImport n ty fimport) =
876     hang (ptext SLIT("foreign import") <+> ppr fimport <+> ppr n)
877        2 (dcolon <+> ppr ty)
878   ppr (ForeignExport n ty fexport) =
879     hang (ptext SLIT("foreign export") <+> ppr fexport <+> ppr n)
880        2 (dcolon <+> ppr ty)
881
882 instance Outputable ForeignImport where
883   ppr (DNImport                         spec) = 
884     ptext SLIT("dotnet") <+> ppr spec
885   ppr (CImport  cconv safety header lib spec) =
886     ppr cconv <+> ppr safety <+> 
887     char '"' <> pprCEntity header lib spec <> char '"'
888     where
889       pprCEntity header lib (CLabel lbl) = 
890         ptext SLIT("static") <+> ftext header <+> char '&' <>
891         pprLib lib <> ppr lbl
892       pprCEntity header lib (CFunction (StaticTarget lbl)) = 
893         ptext SLIT("static") <+> ftext header <+> char '&' <>
894         pprLib lib <> ppr lbl
895       pprCEntity header lib (CFunction (DynamicTarget)) = 
896         ptext SLIT("dynamic")
897       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
898       --
899       pprLib lib | nullFS lib = empty
900                  | otherwise  = char '[' <> ppr lib <> char ']'
901
902 instance Outputable ForeignExport where
903   ppr (CExport  (CExportStatic lbl cconv)) = 
904     ppr cconv <+> char '"' <> ppr lbl <> char '"'
905   ppr (DNExport                          ) = 
906     ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
907
908 instance Outputable FoType where
909   ppr DNType = ptext SLIT("type dotnet")
910 \end{code}
911
912
913 %************************************************************************
914 %*                                                                      *
915 \subsection{Transformation rules}
916 %*                                                                      *
917 %************************************************************************
918
919 \begin{code}
920 type LRuleDecl name = Located (RuleDecl name)
921
922 data RuleDecl name
923   = HsRule                      -- Source rule
924         RuleName                -- Rule name
925         Activation
926         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
927         (Located (HsExpr name)) -- LHS
928         NameSet                 -- Free-vars from the LHS
929         (Located (HsExpr name)) -- RHS
930         NameSet                 -- Free-vars from the RHS
931
932 data RuleBndr name
933   = RuleBndr (Located name)
934   | RuleBndrSig (Located name) (LHsType name)
935
936 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
937 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
938
939 instance OutputableBndr name => Outputable (RuleDecl name) where
940   ppr (HsRule name act ns lhs fv_lhs rhs fv_rhs)
941         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
942                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
943                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
944         where
945           pp_forall | null ns   = empty
946                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
947
948 instance OutputableBndr name => Outputable (RuleBndr name) where
949    ppr (RuleBndr name) = ppr name
950    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
951 \end{code}
952
953 %************************************************************************
954 %*                                                                      *
955 \subsection[DocDecl]{Document comments}
956 %*                                                                      *
957 %************************************************************************
958
959 \begin{code}
960
961 type LDocDecl name = Located (DocDecl name)
962
963 data DocDecl name
964   = DocCommentNext (HsDoc name)
965   | DocCommentPrev (HsDoc name)
966   | DocCommentNamed String (HsDoc name)
967   | DocGroup Int (HsDoc name)
968  
969 -- Okay, I need to reconstruct the document comments, but for now:
970 instance Outputable (DocDecl name) where
971   ppr _ = text "<document comment>"
972
973 docDeclDoc (DocCommentNext d) = d
974 docDeclDoc (DocCommentPrev d) = d
975 docDeclDoc (DocCommentNamed _ d) = d
976 docDeclDoc (DocGroup _ d) = d
977
978 \end{code}
979
980 %************************************************************************
981 %*                                                                      *
982 \subsection[DeprecDecl]{Deprecations}
983 %*                                                                      *
984 %************************************************************************
985
986 We use exported entities for things to deprecate.
987
988 \begin{code}
989 type LDeprecDecl name = Located (DeprecDecl name)
990
991 data DeprecDecl name = Deprecation name DeprecTxt
992
993 instance OutputableBndr name => Outputable (DeprecDecl name) where
994     ppr (Deprecation thing txt)
995       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
996 \end{code}