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