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