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