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