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