2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsDecls]{Abstract syntax: global declarations}
6 Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
11 HsDecl(..), TyClDecl(..), InstDecl(..), RuleDecl(..), RuleBndr(..),
13 ForeignDecl(..), ForeignImport(..), ForeignExport(..),
14 CImportSpec(..), FoType(..),
15 ConDecl(..), CoreDecl(..),
16 BangType(..), getBangType, getBangStrictness, unbangedType,
17 DeprecDecl(..), DeprecTxt,
18 hsDeclName, instDeclName,
19 tyClDeclName, tyClDeclNames, tyClDeclTyVars,
20 isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
21 isTypeOrClassDecl, countTyClDecls,
22 isSourceInstDecl, ifaceRuleDeclName,
24 collectRuleBndrSigTys, isSrcRule
27 #include "HsVersions.h"
30 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
31 -- Because Expr imports Decls via HsBracket
33 import HsBinds ( HsBinds, MonoBinds, Sig(..) )
34 import HsPat ( HsConDetails(..), hsConArgs )
35 import HsImpExp ( pprHsVar )
37 import PprCore ( pprCoreRule )
38 import HsCore ( UfExpr, UfBinder, HsIdInfo, pprHsIdInfo,
39 eq_ufBinders, eq_ufExpr, pprUfExpr
41 import CoreSyn ( CoreRule(..), RuleName )
42 import BasicTypes ( NewOrData(..), StrictnessMark(..), Activation(..), FixitySig(..) )
43 import ForeignCall ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
47 import Name ( NamedThing )
48 import FunDeps ( pprFundeps )
49 import TyCon ( DataConDetails(..), visibleDataCons )
50 import Class ( FunDep, DefMeth(..) )
51 import CStrings ( CLabelString )
53 import Util ( eqListBy, count )
54 import SrcLoc ( SrcLoc )
57 import Maybe ( isNothing, fromJust )
61 %************************************************************************
63 \subsection[HsDecl]{Declarations}
65 %************************************************************************
71 | DefD (DefaultDecl id)
73 | ForD (ForeignDecl id)
75 | DeprecD (DeprecDecl id)
78 | SpliceD (HsExpr id) -- Top level splice
80 -- NB: all top-level fixity decls are contained EITHER
82 -- OR in the ClassDecls in TyClDs
85 -- a) data constructors
86 -- b) class methods (but they can be also done in the
87 -- signatures of class decls)
88 -- c) imported functions (that have an IfacSig)
91 -- The latter is for class methods only
96 hsDeclName :: (NamedThing name, OutputableBndr name)
97 => HsDecl name -> name
99 hsDeclName (TyClD decl) = tyClDeclName decl
100 hsDeclName (InstD decl) = instDeclName decl
101 hsDeclName (ForD decl) = foreignDeclName decl
102 hsDeclName (FixD (FixitySig name _ _)) = name
103 hsDeclName (CoreD (CoreDecl name _ _ _)) = name
104 -- Others don't make sense
106 hsDeclName x = pprPanic "HsDecls.hsDeclName" (ppr x)
110 instDeclName :: InstDecl name -> name
111 instDeclName (InstDecl _ _ _ (Just name) _) = name
116 instance OutputableBndr name => Outputable (HsDecl name) where
118 ppr (TyClD dcl) = ppr dcl
119 ppr (ValD binds) = ppr binds
120 ppr (DefD def) = ppr def
121 ppr (InstD inst) = ppr inst
122 ppr (ForD fd) = ppr fd
123 ppr (FixD fd) = ppr fd
124 ppr (RuleD rd) = ppr rd
125 ppr (DeprecD dd) = ppr dd
126 ppr (CoreD dd) = ppr dd
127 ppr (SpliceD e) = ptext SLIT("splice") <> parens (pprExpr e)
131 %************************************************************************
133 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
135 %************************************************************************
137 --------------------------------
139 --------------------------------
141 Here is the story about the implicit names that go with type, class, and instance
142 decls. It's a bit tricky, so pay attention!
144 "Implicit" (or "system") binders
145 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
146 Each data type decl defines
147 a worker name for each constructor
148 to-T and from-T convertors
149 Each class decl defines
150 a tycon for the class
151 a data constructor for that tycon
152 the worker for that constructor
153 a selector for each superclass
155 All have occurrence names that are derived uniquely from their parent declaration.
157 None of these get separate definitions in an interface file; they are
158 fully defined by the data or class decl. But they may *occur* in
159 interface files, of course. Any such occurrence must haul in the
160 relevant type or class decl.
163 - Ensure they "point to" the parent data/class decl
164 when loading that decl from an interface file
165 (See RnHiFiles.getSysBinders)
167 - When typechecking the decl, we build the implicit TyCons and Ids.
168 When doing so we look them up in the name cache (RnEnv.lookupSysName),
169 to ensure correct module and provenance is set
171 These are the two places that we have to conjure up the magic derived
172 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
176 - Occurrence name is derived uniquely from the method name
179 - If there is a default method name at all, it's recorded in
180 the ClassOpSig (in HsBinds), in the DefMeth field.
181 (DefMeth is defined in Class.lhs)
183 Source-code class decls and interface-code class decls are treated subtly
184 differently, which has given me a great deal of confusion over the years.
185 Here's the deal. (We distinguish the two cases because source-code decls
186 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
188 In *source-code* class declarations:
189 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
190 This is done by RdrHsSyn.mkClassOpSigDM
192 - The renamer renames it to a Name
194 - During typechecking, we generate a binding for each $dm for
195 which there's a programmer-supplied default method:
200 We generate a binding for $dmop1 but not for $dmop2.
201 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
202 The Name for $dmop2 is simply discarded.
204 In *interface-file* class declarations:
205 - When parsing, we see if there's an explicit programmer-supplied default method
206 because there's an '=' sign to indicate it:
208 op1 = :: <type> -- NB the '='
210 We use this info to generate a DefMeth with a suitable RdrName for op1,
211 and a NoDefMeth for op2
212 - The interface file has a separate definition for $dmop1, with unfolding etc.
213 - The renamer renames it to a Name.
214 - The renamer treats $dmop1 as a free variable of the declaration, so that
215 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
216 This doesn't happen for source code class decls, because they *bind* the default method.
220 Each instance declaration gives rise to one dictionary function binding.
222 The type checker makes up new source-code instance declarations
223 (e.g. from 'deriving' or generic default methods --- see
224 TcInstDcls.tcInstDecls1). So we can't generate the names for
225 dictionary functions in advance (we don't know how many we need).
227 On the other hand for interface-file instance declarations, the decl
228 specifies the name of the dictionary function, and it has a binding elsewhere
229 in the interface file:
230 instance {Eq Int} = dEqInt
231 dEqInt :: {Eq Int} <pragma info>
233 So again we treat source code and interface file code slightly differently.
236 - Source code instance decls have a Nothing in the (Maybe name) field
237 (see data InstDecl below)
239 - The typechecker makes up a Local name for the dict fun for any source-code
240 instance decl, whether it comes from a source-code instance decl, or whether
241 the instance decl is derived from some other construct (e.g. 'deriving').
243 - The occurrence name it chooses is derived from the instance decl (just for
244 documentation really) --- e.g. dNumInt. Two dict funs may share a common
245 occurrence name, but will have different uniques. E.g.
246 instance Foo [Int] where ...
247 instance Foo [Bool] where ...
248 These might both be dFooList
250 - The CoreTidy phase externalises the name, and ensures the occurrence name is
251 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
253 - We can take this relaxed approach (changing the occurrence name later)
254 because dict fun Ids are not captured in a TyCon or Class (unlike default
255 methods, say). Instead, they are kept separately in the InstEnv. This
256 makes it easy to adjust them after compiling a module. (Once we've finished
257 compiling that module, they don't change any more.)
261 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
262 in the (Maybe name) field.
264 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
265 suck in the dfun binding
269 -- TyClDecls are precisely the kind of declarations that can
270 -- appear in interface files; or (internally) in GHC's interface
271 -- for a module. That's why (despite the misnomer) IfaceSig and ForeignType
272 -- are both in TyClDecl
275 = IfaceSig { tcdName :: name, -- It may seem odd to classify an interface-file signature
276 tcdType :: HsType name, -- as a 'TyClDecl', but it's very convenient.
277 tcdIdInfo :: [HsIdInfo name],
281 | ForeignType { tcdName :: name, -- See remarks about IfaceSig above
282 tcdExtName :: Maybe FastString,
286 | TyData { tcdND :: NewOrData,
287 tcdCtxt :: HsContext name, -- Context
288 tcdName :: name, -- Type constructor
289 tcdTyVars :: [HsTyVarBndr name], -- Type variables
290 tcdCons :: DataConDetails (ConDecl name), -- Data constructors
291 tcdDerivs :: Maybe (HsContext name), -- Derivings; Nothing => not specified
292 -- Just [] => derive exactly what is asked
293 tcdGeneric :: Maybe Bool, -- Nothing <=> source decl
294 -- Just x <=> interface-file decl;
295 -- x=True <=> generic converter functions available
296 -- We need this for imported data decls, since the
297 -- imported modules may have been compiled with
298 -- different flags to the current compilation unit
302 | TySynonym { tcdName :: name, -- type constructor
303 tcdTyVars :: [HsTyVarBndr name], -- type variables
304 tcdSynRhs :: HsType name, -- synonym expansion
308 | ClassDecl { tcdCtxt :: HsContext name, -- Context...
309 tcdName :: name, -- Name of the class
310 tcdTyVars :: [HsTyVarBndr name], -- The class type variables
311 tcdFDs :: [FunDep name], -- Functional dependencies
312 tcdSigs :: [Sig name], -- Methods' signatures
313 tcdMeths :: Maybe (MonoBinds name), -- Default methods
314 -- Nothing for imported class decls
315 -- Just bs for source class decls
323 isIfaceSigDecl, isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
325 isIfaceSigDecl (IfaceSig {}) = True
326 isIfaceSigDecl other = False
328 isSynDecl (TySynonym {}) = True
329 isSynDecl other = False
331 isDataDecl (TyData {}) = True
332 isDataDecl other = False
334 isClassDecl (ClassDecl {}) = True
335 isClassDecl other = False
337 isTypeOrClassDecl (ClassDecl {}) = True
338 isTypeOrClassDecl (TyData {}) = True
339 isTypeOrClassDecl (TySynonym {}) = True
340 isTypeOrClassDecl (ForeignType {}) = True
341 isTypeOrClassDecl other = False
347 --------------------------------
348 tyClDeclName :: TyClDecl name -> name
349 tyClDeclName tycl_decl = tcdName tycl_decl
351 --------------------------------
352 tyClDeclNames :: Eq name => TyClDecl name -> [(name, SrcLoc)]
353 -- Returns all the *binding* names of the decl, along with their SrcLocs
354 -- The first one is guaranteed to be the name of the decl
355 -- For record fields, the first one counts as the SrcLoc
356 -- We use the equality to filter out duplicate field names
358 tyClDeclNames (TySynonym {tcdName = name, tcdLoc = loc}) = [(name,loc)]
359 tyClDeclNames (IfaceSig {tcdName = name, tcdLoc = loc}) = [(name,loc)]
360 tyClDeclNames (ForeignType {tcdName = name, tcdLoc = loc}) = [(name,loc)]
362 tyClDeclNames (ClassDecl {tcdName = cls_name, tcdSigs = sigs, tcdLoc = loc})
363 = (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
365 tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
366 = (tc_name,loc) : conDeclsNames cons
369 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
370 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
371 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
372 tyClDeclTyVars (ForeignType {}) = []
373 tyClDeclTyVars (IfaceSig {}) = []
377 instance (NamedThing name, Ord name) => Eq (TyClDecl name) where
378 -- Used only when building interface files
379 (==) d1@(IfaceSig {}) d2@(IfaceSig {})
380 = tcdName d1 == tcdName d2 &&
381 tcdType d1 == tcdType d2 &&
382 tcdIdInfo d1 == tcdIdInfo d2
384 (==) d1@(ForeignType {}) d2@(ForeignType {})
385 = tcdName d1 == tcdName d2 &&
386 tcdFoType d1 == tcdFoType d2
388 (==) d1@(TyData {}) d2@(TyData {})
389 = tcdName d1 == tcdName d2 &&
390 tcdND d1 == tcdND d2 &&
391 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
392 eq_hsContext env (tcdCtxt d1) (tcdCtxt d2) &&
393 eq_hsCD env (tcdCons d1) (tcdCons d2)
396 (==) d1@(TySynonym {}) d2@(TySynonym {})
397 = tcdName d1 == tcdName d2 &&
398 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
399 eq_hsType env (tcdSynRhs d1) (tcdSynRhs d2)
402 (==) d1@(ClassDecl {}) d2@(ClassDecl {})
403 = tcdName d1 == tcdName d2 &&
404 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
405 eq_hsContext env (tcdCtxt d1) (tcdCtxt d2) &&
406 eqListBy (eq_hsFD env) (tcdFDs d1) (tcdFDs d2) &&
407 eqListBy (eq_cls_sig env) (tcdSigs d1) (tcdSigs d2)
410 (==) _ _ = False -- default case
412 eq_hsCD env (DataCons c1) (DataCons c2) = eqListBy (eq_ConDecl env) c1 c2
413 eq_hsCD env Unknown Unknown = True
414 eq_hsCD env (HasCons n1) (HasCons n2) = n1 == n2
415 eq_hsCD env d1 d2 = False
417 eq_hsFD env (ns1,ms1) (ns2,ms2)
418 = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
420 eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
421 = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
423 -- Ignore the name of the default method for (DefMeth id)
424 -- This is used for comparing declarations before putting
425 -- them into interface files, and the name of the default
426 -- method isn't relevant
427 NoDefMeth `eq_dm` NoDefMeth = True
428 GenDefMeth `eq_dm` GenDefMeth = True
429 DefMeth _ `eq_dm` DefMeth _ = True
430 dm1 `eq_dm` dm2 = False
434 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
435 -- class, data, newtype, synonym decls
437 = (count isClassDecl decls,
438 count isSynDecl decls,
439 count isIfaceSigDecl decls,
440 count isDataTy decls,
443 isDataTy TyData{tcdND=DataType} = True
446 isNewTy TyData{tcdND=NewType} = True
451 instance OutputableBndr name
452 => Outputable (TyClDecl name) where
454 ppr (IfaceSig {tcdName = var, tcdType = ty, tcdIdInfo = info})
455 = getPprStyle $ \ sty ->
456 hsep [ pprHsVar var, dcolon, ppr ty, pprHsIdInfo info ]
458 ppr (ForeignType {tcdName = tycon})
459 = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
461 ppr (TySynonym {tcdName = tycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
462 = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
465 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
466 tcdTyVars = tyvars, tcdCons = condecls,
467 tcdDerivs = derivings})
468 = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars)
469 (pp_condecls condecls)
472 keyword = case new_or_data of
473 NewType -> SLIT("newtype")
474 DataType -> SLIT("data")
476 ppr (ClassDecl {tcdCtxt = context, tcdName = clas, tcdTyVars = tyvars, tcdFDs = fds,
477 tcdSigs = sigs, tcdMeths = methods})
478 | null sigs -- No "where" part
481 | otherwise -- Laid out
482 = sep [hsep [top_matter, ptext SLIT("where {")],
483 nest 4 (sep [sep (map ppr_sig sigs), pp_methods, char '}'])]
485 top_matter = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
486 ppr_sig sig = ppr sig <> semi
488 pp_methods = if isNothing methods
490 else ppr (fromJust methods)
492 pp_decl_head :: OutputableBndr name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
493 pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
495 pp_condecls Unknown = ptext SLIT("{- abstract -}")
496 pp_condecls (HasCons n) = ptext SLIT("{- abstract with") <+> int n <+> ptext SLIT("constructors -}")
497 pp_condecls (DataCons cs) = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
499 pp_tydecl pp_head pp_decl_rhs derivings
500 = hang pp_head 4 (sep [
504 Just ds -> hsep [ptext SLIT("deriving"), ppr_hs_context ds]
509 %************************************************************************
511 \subsection[ConDecl]{A data-constructor declaration}
513 %************************************************************************
517 = ConDecl name -- Constructor name; this is used for the
518 -- DataCon itself, and for the user-callable wrapper Id
520 [HsTyVarBndr name] -- Existentially quantified type variables
521 (HsContext name) -- ...and context
522 -- If both are empty then there are no existentials
524 (HsConDetails name (BangType name))
529 conDeclsNames :: Eq name => DataConDetails (ConDecl name) -> [(name,SrcLoc)]
530 -- See tyClDeclNames for what this does
531 -- The function is boringly complicated because of the records
532 -- And since we only have equality, we have to be a little careful
534 = snd (foldl do_one ([], []) (visibleDataCons cons))
536 do_one (flds_seen, acc) (ConDecl name _ _ (RecCon flds) loc)
537 = (new_flds ++ flds_seen, (name,loc) : [(f,loc) | f <- new_flds] ++ acc)
539 new_flds = [ f | (f,_) <- flds, not (f `elem` flds_seen) ]
541 do_one (flds_seen, acc) (ConDecl name _ _ _ loc)
542 = (flds_seen, (name,loc):acc)
546 conDetailsTys details = map getBangType (hsConArgs details)
548 eq_ConDecl env (ConDecl n1 tvs1 cxt1 cds1 _)
549 (ConDecl n2 tvs2 cxt2 cds2 _)
551 (eq_hsTyVars env tvs1 tvs2 $ \ env ->
552 eq_hsContext env cxt1 cxt2 &&
553 eq_ConDetails env cds1 cds2)
555 eq_ConDetails env (PrefixCon bts1) (PrefixCon bts2)
556 = eqListBy (eq_btype env) bts1 bts2
557 eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
558 = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
559 eq_ConDetails env (RecCon fs1) (RecCon fs2)
560 = eqListBy (eq_fld env) fs1 fs2
561 eq_ConDetails env _ _ = False
563 eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2
567 data BangType name = BangType StrictnessMark (HsType name)
569 getBangType (BangType _ ty) = ty
570 getBangStrictness (BangType s _) = s
572 unbangedType ty = BangType NotMarkedStrict ty
574 eq_btype env (BangType s1 t1) (BangType s2 t2) = s1==s2 && eq_hsType env t1 t2
578 instance (OutputableBndr name) => Outputable (ConDecl name) where
579 ppr (ConDecl con tvs cxt con_details loc)
580 = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
582 ppr_con_details con (InfixCon ty1 ty2)
583 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
585 -- ConDecls generated by MkIface.ifaceTyThing always have a PrefixCon, even
586 -- if the constructor is an infix one. This is because in an interface file
587 -- we don't distinguish between the two. Hence when printing these for the
588 -- user, we need to parenthesise infix constructor names.
589 ppr_con_details con (PrefixCon tys)
590 = hsep (pprHsVar con : map ppr_bang tys)
592 ppr_con_details con (RecCon fields)
593 = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
595 ppr_field (n, ty) = ppr n <+> dcolon <+> ppr_bang ty
597 instance OutputableBndr name => Outputable (BangType name) where
600 ppr_bang (BangType s ty) = ppr s <> pprParendHsType ty
604 %************************************************************************
606 \subsection[InstDecl]{An instance declaration
608 %************************************************************************
612 = InstDecl (HsType name) -- Context => Class Instance-type
613 -- Using a polytype means that the renamer conveniently
614 -- figures out the quantified type variables for us.
618 [Sig name] -- User-supplied pragmatic info
620 (Maybe name) -- Name for the dictionary function
621 -- Nothing for source-file instance decls
625 isSourceInstDecl :: InstDecl name -> Bool
626 isSourceInstDecl (InstDecl _ _ _ maybe_dfun _) = isNothing maybe_dfun
630 instance (OutputableBndr name) => Outputable (InstDecl name) where
632 ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
633 = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
637 pp_dfun = case maybe_dfun_name of
643 instance Ord name => Eq (InstDecl name) where
644 -- Used for interface comparison only, so don't compare bindings
645 (==) (InstDecl inst_ty1 _ _ dfun1 _) (InstDecl inst_ty2 _ _ dfun2 _)
646 = inst_ty1 == inst_ty2 && dfun1 == dfun2
650 %************************************************************************
652 \subsection[DefaultDecl]{A @default@ declaration}
654 %************************************************************************
656 There can only be one default declaration per module, but it is hard
657 for the parser to check that; we pass them all through in the abstract
658 syntax, and that restriction must be checked in the front end.
661 data DefaultDecl name
662 = DefaultDecl [HsType name]
665 instance (OutputableBndr name)
666 => Outputable (DefaultDecl name) where
668 ppr (DefaultDecl tys src_loc)
669 = ptext SLIT("default") <+> parens (interpp'SP tys)
672 %************************************************************************
674 \subsection{Foreign function interface declaration}
676 %************************************************************************
680 -- foreign declarations are distinguished as to whether they define or use a
683 -- * the Boolean value indicates whether the pre-standard deprecated syntax
686 data ForeignDecl name
687 = ForeignImport name (HsType name) ForeignImport Bool SrcLoc -- defines name
688 | ForeignExport name (HsType name) ForeignExport Bool SrcLoc -- uses name
690 -- yield the Haskell name defined or used in a foreign declaration
692 foreignDeclName :: ForeignDecl name -> name
693 foreignDeclName (ForeignImport n _ _ _ _) = n
694 foreignDeclName (ForeignExport n _ _ _ _) = n
696 -- specification of an imported external entity in dependence on the calling
699 data ForeignImport = -- import of a C entity
701 -- * the two strings specifying a header file or library
702 -- may be empty, which indicates the absence of a
703 -- header or object specification (both are not used
704 -- in the case of `CWrapper' and when `CFunction'
705 -- has a dynamic target)
707 -- * the calling convention is irrelevant for code
708 -- generation in the case of `CLabel', but is needed
709 -- for pretty printing
711 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
713 CImport CCallConv -- ccall or stdcall
714 Safety -- safe or unsafe
715 FastString -- name of C header
716 FastString -- name of library object
717 CImportSpec -- details of the C entity
719 -- import of a .NET function
721 | DNImport DNCallSpec
723 -- details of an external C entity
725 data CImportSpec = CLabel CLabelString -- import address of a C label
726 | CFunction CCallTarget -- static or dynamic function
727 | CWrapper -- wrapper to expose closures
730 -- specification of an externally exported entity in dependence on the calling
733 data ForeignExport = CExport CExportSpec -- contains the calling convention
734 | DNExport -- presently unused
736 -- abstract type imported from .NET
738 data FoType = DNType -- In due course we'll add subtype stuff
739 deriving (Eq) -- Used for equality instance for TyClDecl
742 -- pretty printing of foreign declarations
745 instance OutputableBndr name => Outputable (ForeignDecl name) where
746 ppr (ForeignImport n ty fimport _ _) =
747 ptext SLIT("foreign import") <+> ppr fimport <+>
748 ppr n <+> dcolon <+> ppr ty
749 ppr (ForeignExport n ty fexport _ _) =
750 ptext SLIT("foreign export") <+> ppr fexport <+>
751 ppr n <+> dcolon <+> ppr ty
753 instance Outputable ForeignImport where
754 ppr (DNImport spec) =
755 ptext SLIT("dotnet") <+> ppr spec
756 ppr (CImport cconv safety header lib spec) =
757 ppr cconv <+> ppr safety <+>
758 char '"' <> pprCEntity header lib spec <> char '"'
760 pprCEntity header lib (CLabel lbl) =
761 ptext SLIT("static") <+> ftext header <+> char '&' <>
762 pprLib lib <> ppr lbl
763 pprCEntity header lib (CFunction (StaticTarget lbl)) =
764 ptext SLIT("static") <+> ftext header <+> char '&' <>
765 pprLib lib <> ppr lbl
766 pprCEntity header lib (CFunction (DynamicTarget)) =
767 ptext SLIT("dynamic")
768 pprCEntity header lib (CFunction (CasmTarget _)) =
769 panic "HsDecls.pprCEntity: malformed C function target"
770 pprCEntity _ _ (CWrapper) = ptext SLIT("wrapper")
772 pprLib lib | nullFastString lib = empty
773 | otherwise = char '[' <> ppr lib <> char ']'
775 instance Outputable ForeignExport where
776 ppr (CExport (CExportStatic lbl cconv)) =
777 ppr cconv <+> char '"' <> ppr lbl <> char '"'
779 ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
781 instance Outputable FoType where
782 ppr DNType = ptext SLIT("type dotnet")
786 %************************************************************************
788 \subsection{Transformation rules}
790 %************************************************************************
794 = HsRule -- Source rule
795 RuleName -- Rule name
797 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
802 | IfaceRule -- One that's come in from an interface file; pre-typecheck
805 [UfBinder name] -- Tyvars and term vars
807 [UfExpr name] -- Args of LHS
808 (UfExpr name) -- Pre typecheck
811 | IfaceRuleOut -- Post typecheck
815 isSrcRule (HsRule _ _ _ _ _ _) = True
816 isSrcRule other = False
818 ifaceRuleDeclName :: RuleDecl name -> name
819 ifaceRuleDeclName (IfaceRule _ _ _ n _ _ _) = n
820 ifaceRuleDeclName (IfaceRuleOut n r) = n
821 ifaceRuleDeclName (HsRule fs _ _ _ _ _) = pprPanic "ifaceRuleDeclName" (ppr fs)
825 | RuleBndrSig name (HsType name)
827 collectRuleBndrSigTys :: [RuleBndr name] -> [HsType name]
828 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
830 instance (NamedThing name, Ord name) => Eq (RuleDecl name) where
831 -- Works for IfaceRules only; used when comparing interface file versions
832 (IfaceRule n1 a1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 a2 bs2 f2 es2 rhs2 _)
833 = n1==n2 && f1 == f2 && a1==a2 &&
834 eq_ufBinders emptyEqHsEnv bs1 bs2 (\env ->
835 eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))
837 instance OutputableBndr name => Outputable (RuleDecl name) where
838 ppr (HsRule name act ns lhs rhs loc)
839 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
840 pp_forall, pprExpr lhs, equals <+> pprExpr rhs,
843 pp_forall | null ns = empty
844 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
846 ppr (IfaceRule name act tpl_vars fn tpl_args rhs loc)
847 = hsep [ doubleQuotes (ftext name), ppr act,
848 ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
849 ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
850 ptext SLIT("=") <+> ppr rhs
853 ppr (IfaceRuleOut fn rule) = pprCoreRule (ppr fn) rule
855 instance OutputableBndr name => Outputable (RuleBndr name) where
856 ppr (RuleBndr name) = ppr name
857 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
861 %************************************************************************
863 \subsection[DeprecDecl]{Deprecations}
865 %************************************************************************
867 We use exported entities for things to deprecate.
870 data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
872 type DeprecTxt = FastString -- reason/explanation for deprecation
874 instance OutputableBndr name => Outputable (DeprecDecl name) where
875 ppr (Deprecation thing txt _)
876 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
880 %************************************************************************
882 External-core declarations
884 %************************************************************************
887 data CoreDecl name -- a Core value binding (from 'external Core' input)
893 instance OutputableBndr name => Outputable (CoreDecl name) where
894 ppr (CoreDecl var ty rhs loc)
895 = getPprStyle $ \ sty ->
896 hsep [ pprHsVar var, dcolon, ppr ty, ppr rhs ]