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