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(..),
12 DefaultDecl(..), HsGroup(..),
13 ForeignDecl(..), ForeignImport(..), ForeignExport(..),
14 CImportSpec(..), FoType(..),
15 ConDecl(..), CoreDecl(..),
16 BangType(..), getBangType, getBangStrictness, unbangedType,
17 DeprecDecl(..), DeprecTxt,
18 tyClDeclName, tyClDeclNames, tyClDeclTyVars,
19 isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
20 isTypeOrClassDecl, countTyClDecls,
21 isSourceInstDecl, ifaceRuleDeclName,
23 collectRuleBndrSigTys, isSrcRule
26 #include "HsVersions.h"
29 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
30 -- Because Expr imports Decls via HsBracket
32 import HsBinds ( HsBinds, MonoBinds, Sig(..) )
33 import HsPat ( HsConDetails(..), hsConArgs )
34 import HsImpExp ( pprHsVar )
36 import PprCore ( pprCoreRule )
37 import HsCore ( UfExpr, UfBinder, HsIdInfo, pprHsIdInfo,
38 eq_ufBinders, eq_ufExpr, pprUfExpr
40 import CoreSyn ( CoreRule(..), RuleName )
41 import BasicTypes ( NewOrData(..), StrictnessMark(..), Activation(..), FixitySig(..) )
42 import ForeignCall ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
46 import Name ( NamedThing )
47 import FunDeps ( pprFundeps )
48 import TyCon ( DataConDetails(..), visibleDataCons )
49 import Class ( FunDep, DefMeth(..) )
50 import CStrings ( CLabelString )
52 import Util ( eqListBy, count )
53 import SrcLoc ( SrcLoc )
56 import Maybe ( isNothing, fromJust )
60 %************************************************************************
62 \subsection[HsDecl]{Declarations}
64 %************************************************************************
72 | DefD (DefaultDecl id)
73 | ForD (ForeignDecl id)
74 | DeprecD (DeprecDecl id)
77 | SpliceD (HsExpr id) -- Top level splice
79 -- NB: all top-level fixity decls are contained EITHER
81 -- OR in the ClassDecls in TyClDs
84 -- a) data constructors
85 -- b) class methods (but they can be also done in the
86 -- signatures of class decls)
87 -- c) imported functions (that have an IfacSig)
90 -- The latter is for class methods only
92 -- A [HsDecl] is categorised into a HsGroup before being
93 -- fed to the renamer.
96 hs_valds :: HsBinds id,
97 -- Before the renamer, this is a single big MonoBinds,
98 -- with all the bindings, and all the signatures.
99 -- The renamer does dependency analysis, using ThenBinds
100 -- to give the structure
102 hs_tyclds :: [TyClDecl id],
103 hs_instds :: [InstDecl id],
105 hs_fixds :: [FixitySig id],
106 -- Snaffled out of both top-level fixity signatures,
107 -- and those in class declarations
109 hs_defds :: [DefaultDecl id],
110 hs_fords :: [ForeignDecl id],
111 hs_depds :: [DeprecDecl id],
112 hs_ruleds :: [RuleDecl id],
113 hs_coreds :: [CoreDecl id]
118 instance OutputableBndr name => Outputable (HsDecl name) where
119 ppr (TyClD dcl) = ppr dcl
120 ppr (ValD binds) = ppr binds
121 ppr (DefD def) = ppr def
122 ppr (InstD inst) = ppr inst
123 ppr (ForD fd) = ppr fd
124 ppr (SigD sd) = ppr sd
125 ppr (RuleD rd) = ppr rd
126 ppr (DeprecD dd) = ppr dd
127 ppr (CoreD dd) = ppr dd
128 ppr (SpliceD e) = ptext SLIT("splice") <> parens (pprExpr e)
130 instance OutputableBndr name => Outputable (HsGroup name) where
131 ppr (HsGroup { hs_valds = val_decls,
132 hs_tyclds = tycl_decls,
133 hs_instds = inst_decls,
134 hs_fixds = fix_decls,
135 hs_depds = deprec_decls,
136 hs_fords = foreign_decls,
137 hs_defds = default_decls,
138 hs_ruleds = rule_decls,
139 hs_coreds = core_decls })
140 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
141 ppr_ds deprec_decls, ppr_ds rule_decls,
143 ppr_ds tycl_decls, ppr_ds inst_decls,
144 ppr_ds foreign_decls, ppr_ds core_decls]
147 ppr_ds ds = text "" $$ vcat (map ppr ds)
151 %************************************************************************
153 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
155 %************************************************************************
157 --------------------------------
159 --------------------------------
161 Here is the story about the implicit names that go with type, class, and instance
162 decls. It's a bit tricky, so pay attention!
164 "Implicit" (or "system") binders
165 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
166 Each data type decl defines
167 a worker name for each constructor
168 to-T and from-T convertors
169 Each class decl defines
170 a tycon for the class
171 a data constructor for that tycon
172 the worker for that constructor
173 a selector for each superclass
175 All have occurrence names that are derived uniquely from their parent declaration.
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.
183 - Ensure they "point to" the parent data/class decl
184 when loading that decl from an interface file
185 (See RnHiFiles.getSysBinders)
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
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.)
196 - Occurrence name is derived uniquely from the method name
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)
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.
208 In *source-code* class declarations:
209 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
210 This is done by RdrHsSyn.mkClassOpSigDM
212 - The renamer renames it to a Name
214 - During typechecking, we generate a binding for each $dm for
215 which there's a programmer-supplied default method:
220 We generate a binding for $dmop1 but not for $dmop2.
221 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
222 The Name for $dmop2 is simply discarded.
224 In *interface-file* class declarations:
225 - When parsing, we see if there's an explicit programmer-supplied default method
226 because there's an '=' sign to indicate it:
228 op1 = :: <type> -- NB the '='
230 We use this info to generate a DefMeth with a suitable RdrName for op1,
231 and a NoDefMeth for op2
232 - The interface file has a separate definition for $dmop1, with unfolding etc.
233 - The renamer renames it to a Name.
234 - The renamer treats $dmop1 as a free variable of the declaration, so that
235 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
236 This doesn't happen for source code class decls, because they *bind* the default method.
240 Each instance declaration gives rise to one dictionary function binding.
242 The type checker makes up new source-code instance declarations
243 (e.g. from 'deriving' or generic default methods --- see
244 TcInstDcls.tcInstDecls1). So we can't generate the names for
245 dictionary functions in advance (we don't know how many we need).
247 On the other hand for interface-file instance declarations, the decl
248 specifies the name of the dictionary function, and it has a binding elsewhere
249 in the interface file:
250 instance {Eq Int} = dEqInt
251 dEqInt :: {Eq Int} <pragma info>
253 So again we treat source code and interface file code slightly differently.
256 - Source code instance decls have a Nothing in the (Maybe name) field
257 (see data InstDecl below)
259 - The typechecker makes up a Local name for the dict fun for any source-code
260 instance decl, whether it comes from a source-code instance decl, or whether
261 the instance decl is derived from some other construct (e.g. 'deriving').
263 - The occurrence name it chooses is derived from the instance decl (just for
264 documentation really) --- e.g. dNumInt. Two dict funs may share a common
265 occurrence name, but will have different uniques. E.g.
266 instance Foo [Int] where ...
267 instance Foo [Bool] where ...
268 These might both be dFooList
270 - The CoreTidy phase externalises the name, and ensures the occurrence name is
271 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
273 - We can take this relaxed approach (changing the occurrence name later)
274 because dict fun Ids are not captured in a TyCon or Class (unlike default
275 methods, say). Instead, they are kept separately in the InstEnv. This
276 makes it easy to adjust them after compiling a module. (Once we've finished
277 compiling that module, they don't change any more.)
281 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
282 in the (Maybe name) field.
284 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
285 suck in the dfun binding
289 -- TyClDecls are precisely the kind of declarations that can
290 -- appear in interface files; or (internally) in GHC's interface
291 -- for a module. That's why (despite the misnomer) IfaceSig and ForeignType
292 -- are both in TyClDecl
295 = IfaceSig { tcdName :: name, -- It may seem odd to classify an interface-file signature
296 tcdType :: HsType name, -- as a 'TyClDecl', but it's very convenient.
297 tcdIdInfo :: [HsIdInfo name],
301 | ForeignType { tcdName :: name, -- See remarks about IfaceSig above
302 tcdExtName :: Maybe FastString,
306 | TyData { tcdND :: NewOrData,
307 tcdCtxt :: HsContext name, -- Context
308 tcdName :: name, -- Type constructor
309 tcdTyVars :: [HsTyVarBndr name], -- Type variables
310 tcdCons :: DataConDetails (ConDecl name), -- Data constructors
311 tcdDerivs :: Maybe (HsContext name), -- Derivings; Nothing => not specified
312 -- Just [] => derive exactly what is asked
313 tcdGeneric :: Maybe Bool, -- Nothing <=> source decl
314 -- Just x <=> interface-file decl;
315 -- x=True <=> generic converter functions available
316 -- We need this for imported data decls, since the
317 -- imported modules may have been compiled with
318 -- different flags to the current compilation unit
322 | TySynonym { tcdName :: name, -- type constructor
323 tcdTyVars :: [HsTyVarBndr name], -- type variables
324 tcdSynRhs :: HsType name, -- synonym expansion
328 | ClassDecl { tcdCtxt :: HsContext name, -- Context...
329 tcdName :: name, -- Name of the class
330 tcdTyVars :: [HsTyVarBndr name], -- The class type variables
331 tcdFDs :: [FunDep name], -- Functional dependencies
332 tcdSigs :: [Sig name], -- Methods' signatures
333 tcdMeths :: Maybe (MonoBinds name), -- Default methods
334 -- Nothing for imported class decls
335 -- Just bs for source class decls
343 isIfaceSigDecl, isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
345 isIfaceSigDecl (IfaceSig {}) = True
346 isIfaceSigDecl other = False
348 isSynDecl (TySynonym {}) = True
349 isSynDecl other = False
351 isDataDecl (TyData {}) = True
352 isDataDecl other = False
354 isClassDecl (ClassDecl {}) = True
355 isClassDecl other = False
357 isTypeOrClassDecl (ClassDecl {}) = True
358 isTypeOrClassDecl (TyData {}) = True
359 isTypeOrClassDecl (TySynonym {}) = True
360 isTypeOrClassDecl (ForeignType {}) = True
361 isTypeOrClassDecl other = False
367 --------------------------------
368 tyClDeclName :: TyClDecl name -> name
369 tyClDeclName tycl_decl = tcdName tycl_decl
371 --------------------------------
372 tyClDeclNames :: Eq name => TyClDecl name -> [(name, SrcLoc)]
373 -- Returns all the *binding* names of the decl, along with their SrcLocs
374 -- The first one is guaranteed to be the name of the decl
375 -- For record fields, the first one counts as the SrcLoc
376 -- We use the equality to filter out duplicate field names
378 tyClDeclNames (TySynonym {tcdName = name, tcdLoc = loc}) = [(name,loc)]
379 tyClDeclNames (IfaceSig {tcdName = name, tcdLoc = loc}) = [(name,loc)]
380 tyClDeclNames (ForeignType {tcdName = name, tcdLoc = loc}) = [(name,loc)]
382 tyClDeclNames (ClassDecl {tcdName = cls_name, tcdSigs = sigs, tcdLoc = loc})
383 = (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
385 tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
386 = (tc_name,loc) : conDeclsNames cons
389 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
390 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
391 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
392 tyClDeclTyVars (ForeignType {}) = []
393 tyClDeclTyVars (IfaceSig {}) = []
397 instance (NamedThing name, Ord name) => Eq (TyClDecl name) where
398 -- Used only when building interface files
399 (==) d1@(IfaceSig {}) d2@(IfaceSig {})
400 = tcdName d1 == tcdName d2 &&
401 tcdType d1 == tcdType d2 &&
402 tcdIdInfo d1 == tcdIdInfo d2
404 (==) d1@(ForeignType {}) d2@(ForeignType {})
405 = tcdName d1 == tcdName d2 &&
406 tcdFoType d1 == tcdFoType d2
408 (==) d1@(TyData {}) d2@(TyData {})
409 = tcdName d1 == tcdName d2 &&
410 tcdND d1 == tcdND d2 &&
411 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
412 eq_hsContext env (tcdCtxt d1) (tcdCtxt d2) &&
413 eq_hsCD env (tcdCons d1) (tcdCons d2)
416 (==) d1@(TySynonym {}) d2@(TySynonym {})
417 = tcdName d1 == tcdName d2 &&
418 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
419 eq_hsType env (tcdSynRhs d1) (tcdSynRhs d2)
422 (==) d1@(ClassDecl {}) d2@(ClassDecl {})
423 = tcdName d1 == tcdName d2 &&
424 eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
425 eq_hsContext env (tcdCtxt d1) (tcdCtxt d2) &&
426 eqListBy (eq_hsFD env) (tcdFDs d1) (tcdFDs d2) &&
427 eqListBy (eq_cls_sig env) (tcdSigs d1) (tcdSigs d2)
430 (==) _ _ = False -- default case
432 eq_hsCD env (DataCons c1) (DataCons c2) = eqListBy (eq_ConDecl env) c1 c2
433 eq_hsCD env Unknown Unknown = True
434 eq_hsCD env (HasCons n1) (HasCons n2) = n1 == n2
435 eq_hsCD env d1 d2 = False
437 eq_hsFD env (ns1,ms1) (ns2,ms2)
438 = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
440 eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
441 = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
443 -- Ignore the name of the default method for (DefMeth id)
444 -- This is used for comparing declarations before putting
445 -- them into interface files, and the name of the default
446 -- method isn't relevant
447 NoDefMeth `eq_dm` NoDefMeth = True
448 GenDefMeth `eq_dm` GenDefMeth = True
449 DefMeth _ `eq_dm` DefMeth _ = True
450 dm1 `eq_dm` dm2 = False
454 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
455 -- class, data, newtype, synonym decls
457 = (count isClassDecl decls,
458 count isSynDecl decls,
459 count isIfaceSigDecl decls,
460 count isDataTy decls,
463 isDataTy TyData{tcdND=DataType} = True
466 isNewTy TyData{tcdND=NewType} = True
471 instance OutputableBndr name
472 => Outputable (TyClDecl name) where
474 ppr (IfaceSig {tcdName = var, tcdType = ty, tcdIdInfo = info})
475 = getPprStyle $ \ sty ->
476 hsep [ pprHsVar var, dcolon, ppr ty, pprHsIdInfo info ]
478 ppr (ForeignType {tcdName = tycon})
479 = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
481 ppr (TySynonym {tcdName = tycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
482 = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
485 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
486 tcdTyVars = tyvars, tcdCons = condecls,
487 tcdDerivs = derivings})
488 = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars)
489 (pp_condecls condecls)
492 keyword = case new_or_data of
493 NewType -> SLIT("newtype")
494 DataType -> SLIT("data")
496 ppr (ClassDecl {tcdCtxt = context, tcdName = clas, tcdTyVars = tyvars, tcdFDs = fds,
497 tcdSigs = sigs, tcdMeths = methods})
498 | null sigs -- No "where" part
501 | otherwise -- Laid out
502 = sep [hsep [top_matter, ptext SLIT("where {")],
503 nest 4 (sep [sep (map ppr_sig sigs), pp_methods, char '}'])]
505 top_matter = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
506 ppr_sig sig = ppr sig <> semi
508 pp_methods = if isNothing methods
510 else ppr (fromJust methods)
512 pp_decl_head :: OutputableBndr name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
513 pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
515 pp_condecls Unknown = ptext SLIT("{- abstract -}")
516 pp_condecls (HasCons n) = ptext SLIT("{- abstract with") <+> int n <+> ptext SLIT("constructors -}")
517 pp_condecls (DataCons cs) = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
519 pp_tydecl pp_head pp_decl_rhs derivings
520 = hang pp_head 4 (sep [
524 Just ds -> hsep [ptext SLIT("deriving"), ppr_hs_context ds]
529 %************************************************************************
531 \subsection[ConDecl]{A data-constructor declaration}
533 %************************************************************************
537 = ConDecl name -- Constructor name; this is used for the
538 -- DataCon itself, and for the user-callable wrapper Id
540 [HsTyVarBndr name] -- Existentially quantified type variables
541 (HsContext name) -- ...and context
542 -- If both are empty then there are no existentials
544 (HsConDetails name (BangType name))
549 conDeclsNames :: Eq name => DataConDetails (ConDecl name) -> [(name,SrcLoc)]
550 -- See tyClDeclNames for what this does
551 -- The function is boringly complicated because of the records
552 -- And since we only have equality, we have to be a little careful
554 = snd (foldl do_one ([], []) (visibleDataCons cons))
556 do_one (flds_seen, acc) (ConDecl name _ _ (RecCon flds) loc)
557 = (new_flds ++ flds_seen, (name,loc) : [(f,loc) | f <- new_flds] ++ acc)
559 new_flds = [ f | (f,_) <- flds, not (f `elem` flds_seen) ]
561 do_one (flds_seen, acc) (ConDecl name _ _ _ loc)
562 = (flds_seen, (name,loc):acc)
566 conDetailsTys details = map getBangType (hsConArgs details)
568 eq_ConDecl env (ConDecl n1 tvs1 cxt1 cds1 _)
569 (ConDecl n2 tvs2 cxt2 cds2 _)
571 (eq_hsTyVars env tvs1 tvs2 $ \ env ->
572 eq_hsContext env cxt1 cxt2 &&
573 eq_ConDetails env cds1 cds2)
575 eq_ConDetails env (PrefixCon bts1) (PrefixCon bts2)
576 = eqListBy (eq_btype env) bts1 bts2
577 eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
578 = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
579 eq_ConDetails env (RecCon fs1) (RecCon fs2)
580 = eqListBy (eq_fld env) fs1 fs2
581 eq_ConDetails env _ _ = False
583 eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2
587 data BangType name = BangType StrictnessMark (HsType name)
589 getBangType (BangType _ ty) = ty
590 getBangStrictness (BangType s _) = s
592 unbangedType ty = BangType NotMarkedStrict ty
594 eq_btype env (BangType s1 t1) (BangType s2 t2) = s1==s2 && eq_hsType env t1 t2
598 instance (OutputableBndr name) => Outputable (ConDecl name) where
599 ppr (ConDecl con tvs cxt con_details loc)
600 = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
602 ppr_con_details con (InfixCon ty1 ty2)
603 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
605 -- ConDecls generated by MkIface.ifaceTyThing always have a PrefixCon, even
606 -- if the constructor is an infix one. This is because in an interface file
607 -- we don't distinguish between the two. Hence when printing these for the
608 -- user, we need to parenthesise infix constructor names.
609 ppr_con_details con (PrefixCon tys)
610 = hsep (pprHsVar con : map ppr_bang tys)
612 ppr_con_details con (RecCon fields)
613 = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
615 ppr_field (n, ty) = ppr n <+> dcolon <+> ppr_bang ty
617 instance OutputableBndr name => Outputable (BangType name) where
620 ppr_bang (BangType s ty) = ppr s <> pprParendHsType ty
624 %************************************************************************
626 \subsection[InstDecl]{An instance declaration
628 %************************************************************************
632 = InstDecl (HsType name) -- Context => Class Instance-type
633 -- Using a polytype means that the renamer conveniently
634 -- figures out the quantified type variables for us.
638 [Sig name] -- User-supplied pragmatic info
640 (Maybe name) -- Name for the dictionary function
641 -- Nothing for source-file instance decls
645 isSourceInstDecl :: InstDecl name -> Bool
646 isSourceInstDecl (InstDecl _ _ _ maybe_dfun _) = isNothing maybe_dfun
650 instance (OutputableBndr name) => Outputable (InstDecl name) where
652 ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
653 = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
657 pp_dfun = case maybe_dfun_name of
663 instance Ord name => Eq (InstDecl name) where
664 -- Used for interface comparison only, so don't compare bindings
665 (==) (InstDecl inst_ty1 _ _ dfun1 _) (InstDecl inst_ty2 _ _ dfun2 _)
666 = inst_ty1 == inst_ty2 && dfun1 == dfun2
670 %************************************************************************
672 \subsection[DefaultDecl]{A @default@ declaration}
674 %************************************************************************
676 There can only be one default declaration per module, but it is hard
677 for the parser to check that; we pass them all through in the abstract
678 syntax, and that restriction must be checked in the front end.
681 data DefaultDecl name
682 = DefaultDecl [HsType name]
685 instance (OutputableBndr name)
686 => Outputable (DefaultDecl name) where
688 ppr (DefaultDecl tys src_loc)
689 = ptext SLIT("default") <+> parens (interpp'SP tys)
692 %************************************************************************
694 \subsection{Foreign function interface declaration}
696 %************************************************************************
700 -- foreign declarations are distinguished as to whether they define or use a
703 -- * the Boolean value indicates whether the pre-standard deprecated syntax
706 data ForeignDecl name
707 = ForeignImport name (HsType name) ForeignImport Bool SrcLoc -- defines name
708 | ForeignExport name (HsType name) ForeignExport Bool SrcLoc -- uses name
710 -- yield the Haskell name defined or used in a foreign declaration
712 foreignDeclName :: ForeignDecl name -> name
713 foreignDeclName (ForeignImport n _ _ _ _) = n
714 foreignDeclName (ForeignExport n _ _ _ _) = n
716 -- specification of an imported external entity in dependence on the calling
719 data ForeignImport = -- import of a C entity
721 -- * the two strings specifying a header file or library
722 -- may be empty, which indicates the absence of a
723 -- header or object specification (both are not used
724 -- in the case of `CWrapper' and when `CFunction'
725 -- has a dynamic target)
727 -- * the calling convention is irrelevant for code
728 -- generation in the case of `CLabel', but is needed
729 -- for pretty printing
731 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
733 CImport CCallConv -- ccall or stdcall
734 Safety -- safe or unsafe
735 FastString -- name of C header
736 FastString -- name of library object
737 CImportSpec -- details of the C entity
739 -- import of a .NET function
741 | DNImport DNCallSpec
743 -- details of an external C entity
745 data CImportSpec = CLabel CLabelString -- import address of a C label
746 | CFunction CCallTarget -- static or dynamic function
747 | CWrapper -- wrapper to expose closures
750 -- specification of an externally exported entity in dependence on the calling
753 data ForeignExport = CExport CExportSpec -- contains the calling convention
754 | DNExport -- presently unused
756 -- abstract type imported from .NET
758 data FoType = DNType -- In due course we'll add subtype stuff
759 deriving (Eq) -- Used for equality instance for TyClDecl
762 -- pretty printing of foreign declarations
765 instance OutputableBndr name => Outputable (ForeignDecl name) where
766 ppr (ForeignImport n ty fimport _ _) =
767 ptext SLIT("foreign import") <+> ppr fimport <+>
768 ppr n <+> dcolon <+> ppr ty
769 ppr (ForeignExport n ty fexport _ _) =
770 ptext SLIT("foreign export") <+> ppr fexport <+>
771 ppr n <+> dcolon <+> ppr ty
773 instance Outputable ForeignImport where
774 ppr (DNImport spec) =
775 ptext SLIT("dotnet") <+> ppr spec
776 ppr (CImport cconv safety header lib spec) =
777 ppr cconv <+> ppr safety <+>
778 char '"' <> pprCEntity header lib spec <> char '"'
780 pprCEntity header lib (CLabel lbl) =
781 ptext SLIT("static") <+> ftext header <+> char '&' <>
782 pprLib lib <> ppr lbl
783 pprCEntity header lib (CFunction (StaticTarget lbl)) =
784 ptext SLIT("static") <+> ftext header <+> char '&' <>
785 pprLib lib <> ppr lbl
786 pprCEntity header lib (CFunction (DynamicTarget)) =
787 ptext SLIT("dynamic")
788 pprCEntity header lib (CFunction (CasmTarget _)) =
789 panic "HsDecls.pprCEntity: malformed C function target"
790 pprCEntity _ _ (CWrapper) = ptext SLIT("wrapper")
792 pprLib lib | nullFastString lib = empty
793 | otherwise = char '[' <> ppr lib <> char ']'
795 instance Outputable ForeignExport where
796 ppr (CExport (CExportStatic lbl cconv)) =
797 ppr cconv <+> char '"' <> ppr lbl <> char '"'
799 ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
801 instance Outputable FoType where
802 ppr DNType = ptext SLIT("type dotnet")
806 %************************************************************************
808 \subsection{Transformation rules}
810 %************************************************************************
814 = HsRule -- Source rule
815 RuleName -- Rule name
817 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
822 | IfaceRule -- One that's come in from an interface file; pre-typecheck
825 [UfBinder name] -- Tyvars and term vars
827 [UfExpr name] -- Args of LHS
828 (UfExpr name) -- Pre typecheck
831 | IfaceRuleOut -- Post typecheck
835 isSrcRule (HsRule _ _ _ _ _ _) = True
836 isSrcRule other = False
838 ifaceRuleDeclName :: RuleDecl name -> name
839 ifaceRuleDeclName (IfaceRule _ _ _ n _ _ _) = n
840 ifaceRuleDeclName (IfaceRuleOut n r) = n
841 ifaceRuleDeclName (HsRule fs _ _ _ _ _) = pprPanic "ifaceRuleDeclName" (ppr fs)
845 | RuleBndrSig name (HsType name)
847 collectRuleBndrSigTys :: [RuleBndr name] -> [HsType name]
848 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
850 instance (NamedThing name, Ord name) => Eq (RuleDecl name) where
851 -- Works for IfaceRules only; used when comparing interface file versions
852 (IfaceRule n1 a1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 a2 bs2 f2 es2 rhs2 _)
853 = n1==n2 && f1 == f2 && a1==a2 &&
854 eq_ufBinders emptyEqHsEnv bs1 bs2 (\env ->
855 eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))
857 instance OutputableBndr name => Outputable (RuleDecl name) where
858 ppr (HsRule name act ns lhs rhs loc)
859 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
860 pp_forall, pprExpr lhs, equals <+> pprExpr rhs,
863 pp_forall | null ns = empty
864 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
866 ppr (IfaceRule name act tpl_vars fn tpl_args rhs loc)
867 = hsep [ doubleQuotes (ftext name), ppr act,
868 ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
869 ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
870 ptext SLIT("=") <+> ppr rhs
873 ppr (IfaceRuleOut fn rule) = pprCoreRule (ppr fn) rule
875 instance OutputableBndr name => Outputable (RuleBndr name) where
876 ppr (RuleBndr name) = ppr name
877 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
881 %************************************************************************
883 \subsection[DeprecDecl]{Deprecations}
885 %************************************************************************
887 We use exported entities for things to deprecate.
890 data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
892 type DeprecTxt = FastString -- reason/explanation for deprecation
894 instance OutputableBndr name => Outputable (DeprecDecl name) where
895 ppr (Deprecation thing txt _)
896 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
900 %************************************************************************
902 External-core declarations
904 %************************************************************************
907 data CoreDecl name -- a Core value binding (from 'external Core' input)
913 instance OutputableBndr name => Outputable (CoreDecl name) where
914 ppr (CoreDecl var ty rhs loc)
915 = getPprStyle $ \ sty ->
916 hsep [ pprHsVar var, dcolon, ppr ty, ppr rhs ]