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