2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 HsDecls: Abstract syntax: global declarations
8 Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
9 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
13 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
20 HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl,
21 InstDecl(..), LInstDecl, DerivDecl(..), LDerivDecl, NewOrData(..),
23 RuleDecl(..), LRuleDecl, RuleBndr(..),
24 DefaultDecl(..), LDefaultDecl, SpliceDecl(..),
25 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
26 CImportSpec(..), FoType(..),
27 ConDecl(..), ResType(..), ConDeclField(..), LConDecl,
28 HsConDeclDetails, hsConDeclArgTys,
29 DocDecl(..), LDocDecl, docDeclDoc,
30 DeprecDecl(..), LDeprecDecl,
31 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups,
32 tcdName, tyClDeclNames, tyClDeclTyVars,
33 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
37 collectRuleBndrSigTys,
40 #include "HsVersions.h"
43 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
44 -- Because Expr imports Decls via HsBracket
53 import {- Kind parts of -} Type
64 import Data.Maybe ( isJust )
67 %************************************************************************
69 \subsection[HsDecl]{Declarations}
71 %************************************************************************
74 type LHsDecl id = Located (HsDecl id)
79 | DerivD (DerivDecl id)
82 | DefD (DefaultDecl id)
83 | ForD (ForeignDecl id)
84 | DeprecD (DeprecDecl id)
86 | SpliceD (SpliceDecl id)
90 -- NB: all top-level fixity decls are contained EITHER
92 -- OR in the ClassDecls in TyClDs
95 -- a) data constructors
96 -- b) class methods (but they can be also done in the
97 -- signatures of class decls)
98 -- c) imported functions (that have an IfacSig)
101 -- The latter is for class methods only
103 -- A [HsDecl] is categorised into a HsGroup before being
104 -- fed to the renamer.
107 hs_valds :: HsValBinds id,
108 hs_tyclds :: [LTyClDecl id],
109 hs_instds :: [LInstDecl id],
110 hs_derivds :: [LDerivDecl id],
112 hs_fixds :: [LFixitySig id],
113 -- Snaffled out of both top-level fixity signatures,
114 -- and those in class declarations
116 hs_defds :: [LDefaultDecl id],
117 hs_fords :: [LForeignDecl id],
118 hs_depds :: [LDeprecDecl id],
119 hs_ruleds :: [LRuleDecl id],
121 hs_docs :: [LDocDecl id]
124 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
125 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
126 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
128 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
129 hs_fixds = [], hs_defds = [], hs_fords = [],
130 hs_depds = [], hs_ruleds = [],
131 hs_valds = error "emptyGroup hs_valds: Can't happen",
134 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
137 hs_valds = val_groups1,
140 hs_derivds = derivds1,
148 hs_valds = val_groups2,
151 hs_derivds = derivds2,
160 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
161 hs_tyclds = tyclds1 ++ tyclds2,
162 hs_instds = instds1 ++ instds2,
163 hs_derivds = derivds1 ++ derivds2,
164 hs_fixds = fixds1 ++ fixds2,
165 hs_defds = defds1 ++ defds2,
166 hs_fords = fords1 ++ fords2,
167 hs_depds = depds1 ++ depds2,
168 hs_ruleds = rulds1 ++ rulds2,
169 hs_docs = docs1 ++ docs2 }
173 instance OutputableBndr name => Outputable (HsDecl name) where
174 ppr (TyClD dcl) = ppr dcl
175 ppr (ValD binds) = ppr binds
176 ppr (DefD def) = ppr def
177 ppr (InstD inst) = ppr inst
178 ppr (DerivD deriv) = ppr deriv
179 ppr (ForD fd) = ppr fd
180 ppr (SigD sd) = ppr sd
181 ppr (RuleD rd) = ppr rd
182 ppr (DeprecD dd) = ppr dd
183 ppr (SpliceD dd) = ppr dd
184 ppr (DocD doc) = ppr doc
186 instance OutputableBndr name => Outputable (HsGroup name) where
187 ppr (HsGroup { hs_valds = val_decls,
188 hs_tyclds = tycl_decls,
189 hs_instds = inst_decls,
190 hs_derivds = deriv_decls,
191 hs_fixds = fix_decls,
192 hs_depds = deprec_decls,
193 hs_fords = foreign_decls,
194 hs_defds = default_decls,
195 hs_ruleds = rule_decls })
196 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
197 ppr_ds deprec_decls, ppr_ds rule_decls,
199 ppr_ds tycl_decls, ppr_ds inst_decls,
201 ppr_ds foreign_decls]
204 ppr_ds ds = text "" $$ vcat (map ppr ds)
206 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
208 instance OutputableBndr name => Outputable (SpliceDecl name) where
209 ppr (SpliceDecl e) = ptext SLIT("$") <> parens (pprExpr (unLoc e))
213 %************************************************************************
215 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
217 %************************************************************************
219 --------------------------------
221 --------------------------------
223 Here is the story about the implicit names that go with type, class,
224 and instance decls. It's a bit tricky, so pay attention!
226 "Implicit" (or "system") binders
227 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
228 Each data type decl defines
229 a worker name for each constructor
230 to-T and from-T convertors
231 Each class decl defines
232 a tycon for the class
233 a data constructor for that tycon
234 the worker for that constructor
235 a selector for each superclass
237 All have occurrence names that are derived uniquely from their parent
240 None of these get separate definitions in an interface file; they are
241 fully defined by the data or class decl. But they may *occur* in
242 interface files, of course. Any such occurrence must haul in the
243 relevant type or class decl.
246 - Ensure they "point to" the parent data/class decl
247 when loading that decl from an interface file
248 (See RnHiFiles.getSysBinders)
250 - When typechecking the decl, we build the implicit TyCons and Ids.
251 When doing so we look them up in the name cache (RnEnv.lookupSysName),
252 to ensure correct module and provenance is set
254 These are the two places that we have to conjure up the magic derived
255 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
259 - Occurrence name is derived uniquely from the method name
262 - If there is a default method name at all, it's recorded in
263 the ClassOpSig (in HsBinds), in the DefMeth field.
264 (DefMeth is defined in Class.lhs)
266 Source-code class decls and interface-code class decls are treated subtly
267 differently, which has given me a great deal of confusion over the years.
268 Here's the deal. (We distinguish the two cases because source-code decls
269 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
271 In *source-code* class declarations:
273 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
274 This is done by RdrHsSyn.mkClassOpSigDM
276 - The renamer renames it to a Name
278 - During typechecking, we generate a binding for each $dm for
279 which there's a programmer-supplied default method:
284 We generate a binding for $dmop1 but not for $dmop2.
285 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
286 The Name for $dmop2 is simply discarded.
288 In *interface-file* class declarations:
289 - When parsing, we see if there's an explicit programmer-supplied default method
290 because there's an '=' sign to indicate it:
292 op1 = :: <type> -- NB the '='
294 We use this info to generate a DefMeth with a suitable RdrName for op1,
295 and a NoDefMeth for op2
296 - The interface file has a separate definition for $dmop1, with unfolding etc.
297 - The renamer renames it to a Name.
298 - The renamer treats $dmop1 as a free variable of the declaration, so that
299 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
300 This doesn't happen for source code class decls, because they *bind* the default method.
304 Each instance declaration gives rise to one dictionary function binding.
306 The type checker makes up new source-code instance declarations
307 (e.g. from 'deriving' or generic default methods --- see
308 TcInstDcls.tcInstDecls1). So we can't generate the names for
309 dictionary functions in advance (we don't know how many we need).
311 On the other hand for interface-file instance declarations, the decl
312 specifies the name of the dictionary function, and it has a binding elsewhere
313 in the interface file:
314 instance {Eq Int} = dEqInt
315 dEqInt :: {Eq Int} <pragma info>
317 So again we treat source code and interface file code slightly differently.
320 - Source code instance decls have a Nothing in the (Maybe name) field
321 (see data InstDecl below)
323 - The typechecker makes up a Local name for the dict fun for any source-code
324 instance decl, whether it comes from a source-code instance decl, or whether
325 the instance decl is derived from some other construct (e.g. 'deriving').
327 - The occurrence name it chooses is derived from the instance decl (just for
328 documentation really) --- e.g. dNumInt. Two dict funs may share a common
329 occurrence name, but will have different uniques. E.g.
330 instance Foo [Int] where ...
331 instance Foo [Bool] where ...
332 These might both be dFooList
334 - The CoreTidy phase externalises the name, and ensures the occurrence name is
335 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
337 - We can take this relaxed approach (changing the occurrence name later)
338 because dict fun Ids are not captured in a TyCon or Class (unlike default
339 methods, say). Instead, they are kept separately in the InstEnv. This
340 makes it easy to adjust them after compiling a module. (Once we've finished
341 compiling that module, they don't change any more.)
345 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
346 in the (Maybe name) field.
348 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
349 suck in the dfun binding
353 -- Representation of indexed types
354 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
355 -- Family kind signatures are represented by the variant `TyFamily'. It
356 -- covers "type family", "newtype family", and "data family" declarations,
357 -- distinguished by the value of the field `tcdFlavour'.
359 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
360 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
362 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
363 -- synonym declaration and 'tcdVars' contains the type parameters of the
366 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
367 -- 'pats' are type patterns for the type-indexes of the type constructor
368 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
369 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
370 -- *not* 'length tcdVars'.
372 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
374 type LTyClDecl name = Located (TyClDecl name)
378 tcdLName :: Located name,
379 tcdExtName :: Maybe FastString,
383 -- type/data/newtype family T :: *->*
384 | TyFamily { tcdFlavour:: FamilyFlavour, -- type, new, or data
385 tcdLName :: Located name, -- type constructor
386 tcdTyVars :: [LHsTyVarBndr name], -- type variables
387 tcdKind :: Maybe Kind -- result kind
390 -- Declares a data type or newtype, giving its construcors
391 -- data/newtype T a = <constrs>
392 -- data/newtype instance T [a] = <constrs>
393 | TyData { tcdND :: NewOrData,
394 tcdCtxt :: LHsContext name, -- Context
395 tcdLName :: Located name, -- Type constructor
397 tcdTyVars :: [LHsTyVarBndr name], -- Type variables
399 tcdTyPats :: Maybe [LHsType name], -- Type patterns
400 -- Just [t1..tn] for data instance T t1..tn = ...
401 -- in this case tcdTyVars = fv( tcdTyPats )
402 -- Nothing for everything else
404 tcdKindSig:: Maybe Kind, -- Optional kind sig
405 -- (Just k) for a GADT-style 'data', or 'data
406 -- instance' decl with explicit kind sig
408 tcdCons :: [LConDecl name], -- Data constructors
409 -- For data T a = T1 | T2 a
410 -- the LConDecls all have ResTyH98
411 -- For data T a where { T1 :: T a }
412 -- the LConDecls all have ResTyGADT
414 tcdDerivs :: Maybe [LHsType name]
415 -- Derivings; Nothing => not specified
416 -- Just [] => derive exactly what is asked
417 -- These "types" must be of form
418 -- forall ab. C ty1 ty2
419 -- Typically the foralls and ty args are empty, but they
420 -- are non-empty for the newtype-deriving case
423 | TySynonym { tcdLName :: Located name, -- type constructor
424 tcdTyVars :: [LHsTyVarBndr name], -- type variables
425 tcdTyPats :: Maybe [LHsType name], -- Type patterns
426 -- See comments for tcdTyPats in TyData
427 -- 'Nothing' => vanilla type synonym
429 tcdSynRhs :: LHsType name -- synonym expansion
432 | ClassDecl { tcdCtxt :: LHsContext name, -- Context...
433 tcdLName :: Located name, -- Name of the class
434 tcdTyVars :: [LHsTyVarBndr name], -- Class type variables
435 tcdFDs :: [Located (FunDep name)], -- Functional deps
436 tcdSigs :: [LSig name], -- Methods' signatures
437 tcdMeths :: LHsBinds name, -- Default methods
438 tcdATs :: [LTyClDecl name], -- Associated types; ie
439 -- only 'TyFamily' and
441 -- latter for defaults
442 tcdDocs :: [LDocDecl name] -- Haddock docs
446 = NewType -- "newtype Blah ..."
447 | DataType -- "data Blah ..."
448 deriving( Eq ) -- Needed because Demand derives Eq
451 = TypeFamily -- "type family ..."
452 | DataFamily -- "data family ..."
458 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl ::
459 TyClDecl name -> Bool
461 -- data/newtype or data/newtype instance declaration
462 isDataDecl (TyData {}) = True
463 isDataDecl _other = False
465 -- type or type instance declaration
466 isTypeDecl (TySynonym {}) = True
467 isTypeDecl _other = False
469 -- vanilla Haskell type synonym (ie, not a type instance)
470 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
471 isSynDecl _other = False
474 isClassDecl (ClassDecl {}) = True
475 isClassDecl other = False
477 -- type family declaration
478 isFamilyDecl (TyFamily {}) = True
479 isFamilyDecl _other = False
481 -- family instance (types, newtypes, and data types)
484 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
491 tcdName :: TyClDecl name -> name
492 tcdName decl = unLoc (tcdLName decl)
494 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
495 -- Returns all the *binding* names of the decl, along with their SrcLocs
496 -- The first one is guaranteed to be the name of the decl
497 -- For record fields, the first one counts as the SrcLoc
498 -- We use the equality to filter out duplicate field names
500 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
501 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
502 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
504 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
506 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
508 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
509 = tc_name : conDeclsNames (map unLoc cons)
511 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
512 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
513 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
514 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
515 tyClDeclTyVars (ForeignType {}) = []
519 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
520 -- class, synonym decls, data, newtype, family decls, family instances
522 = (count isClassDecl decls,
523 count isSynDecl decls, -- excluding...
524 count isDataTy decls, -- ...family...
525 count isNewTy decls, -- ...instances
526 count isFamilyDecl decls,
527 count isFamInstDecl decls)
529 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
532 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
537 instance OutputableBndr name
538 => Outputable (TyClDecl name) where
540 ppr (ForeignType {tcdLName = ltycon})
541 = hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
543 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
544 tcdTyVars = tyvars, tcdKind = mb_kind})
545 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
547 pp_flavour = case flavour of
548 TypeFamily -> ptext SLIT("type family")
549 DataFamily -> ptext SLIT("data family")
551 pp_kind = case mb_kind of
553 Just kind -> dcolon <+> pprKind kind
555 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
556 tcdSynRhs = mono_ty})
557 = hang (ptext SLIT("type") <+>
558 (if isJust typats then ptext SLIT("instance") else empty) <+>
559 pp_decl_head [] ltycon tyvars typats <+>
563 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
564 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
565 tcdCons = condecls, tcdDerivs = derivings})
566 = pp_tydecl (null condecls && isJust mb_sig)
568 (if isJust typats then ptext SLIT("instance") else empty) <+>
569 pp_decl_head (unLoc context) ltycon tyvars typats <+>
571 (pp_condecls condecls)
574 ppr_sig Nothing = empty
575 ppr_sig (Just kind) = dcolon <+> pprKind kind
577 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
579 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
580 | null sigs && null ats -- No "where" part
583 | otherwise -- Laid out
584 = sep [hsep [top_matter, ptext SLIT("where {")],
585 nest 4 (sep [ sep (map ppr_semi ats)
586 , sep (map ppr_semi sigs)
587 , pprLHsBinds methods
590 top_matter = ptext SLIT("class")
591 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
592 <+> pprFundeps (map unLoc fds)
593 ppr_semi decl = ppr decl <> semi
595 pp_decl_head :: OutputableBndr name
598 -> [LHsTyVarBndr name]
599 -> Maybe [LHsType name]
601 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
602 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
603 pp_decl_head context thing _ (Just typats) -- explicit type patterns
604 = hsep [ pprHsContext context, ppr thing
605 , hsep (map (pprParendHsType.unLoc) typats)]
607 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
608 = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
609 pp_condecls cs -- In H98 syntax
610 = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
612 pp_tydecl True pp_head pp_decl_rhs derivings
614 pp_tydecl False pp_head pp_decl_rhs derivings
615 = hang pp_head 4 (sep [
619 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
622 instance Outputable NewOrData where
623 ppr NewType = ptext SLIT("newtype")
624 ppr DataType = ptext SLIT("data")
628 %************************************************************************
630 \subsection[ConDecl]{A data-constructor declaration}
632 %************************************************************************
635 type LConDecl name = Located (ConDecl name)
637 -- data T b = forall a. Eq a => MkT a b
638 -- MkT :: forall b a. Eq a => MkT a b
641 -- MkT1 :: Int -> T Int
643 -- data T = Int `MkT` Int
647 -- Int `MkT` Int :: T Int
651 { con_name :: Located name -- Constructor name; this is used for the
652 -- DataCon itself, and for the user-callable wrapper Id
654 , con_explicit :: HsExplicitForAll -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
656 , con_qvars :: [LHsTyVarBndr name] -- ResTyH98: the constructor's existential type variables
657 -- ResTyGADT: all the constructor's quantified type variables
659 , con_cxt :: LHsContext name -- The context. This *does not* include the
660 -- "stupid theta" which lives only in the TyData decl
662 , con_details :: HsConDeclDetails name -- The main payload
664 , con_res :: ResType name -- Result type of the constructor
666 , con_doc :: Maybe (LHsDoc name) -- A possible Haddock comment
669 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
671 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
672 hsConDeclArgTys (PrefixCon tys) = tys
673 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
674 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
676 data ConDeclField name -- Record fields have Haddoc docs on them
677 = ConDeclField { cd_fld_name :: Located name,
678 cd_fld_type :: LBangType name,
679 cd_fld_doc :: Maybe (LHsDoc name) }
682 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
683 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
684 -- and here is its result type
688 conDeclsNames :: (Eq name) => [ConDecl name] -> [Located name]
689 -- See tyClDeclNames for what this does
690 -- The function is boringly complicated because of the records
691 -- And since we only have equality, we have to be a little careful
693 = snd (foldl do_one ([], []) cons)
695 do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
696 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
698 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
699 (map cd_fld_name flds)
701 do_one (flds_seen, acc) c
702 = (flds_seen, (con_name c):acc)
707 instance (OutputableBndr name) => Outputable (ConDecl name) where
710 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
711 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
712 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
714 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
715 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
716 ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
718 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
719 = ppr con <+> dcolon <+>
720 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
722 mk_fun_ty a b = noLoc (HsFunTy a b)
724 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
725 = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
727 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
729 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
731 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
734 %************************************************************************
736 \subsection[InstDecl]{An instance declaration
738 %************************************************************************
741 type LInstDecl name = Located (InstDecl name)
744 = InstDecl (LHsType name) -- Context => Class Instance-type
745 -- Using a polytype means that the renamer conveniently
746 -- figures out the quantified type variables for us.
748 [LSig name] -- User-supplied pragmatic info
749 [LTyClDecl name]-- Associated types (ie, 'TyData' and
752 instance (OutputableBndr name) => Outputable (InstDecl name) where
754 ppr (InstDecl inst_ty binds uprags ats)
755 = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")]
756 , nest 4 $ vcat (map ppr ats)
757 , nest 4 $ vcat (map ppr uprags)
758 , nest 4 $ pprLHsBinds binds ]
760 -- Extract the declarations of associated types from an instance
762 instDeclATs :: InstDecl name -> [LTyClDecl name]
763 instDeclATs (InstDecl _ _ _ ats) = ats
766 %************************************************************************
768 \subsection[DerivDecl]{A stand-alone instance deriving declaration
770 %************************************************************************
773 type LDerivDecl name = Located (DerivDecl name)
775 data DerivDecl name = DerivDecl (LHsType name)
777 instance (OutputableBndr name) => Outputable (DerivDecl name) where
779 = hsep [ptext SLIT("derived instance"), ppr ty]
782 %************************************************************************
784 \subsection[DefaultDecl]{A @default@ declaration}
786 %************************************************************************
788 There can only be one default declaration per module, but it is hard
789 for the parser to check that; we pass them all through in the abstract
790 syntax, and that restriction must be checked in the front end.
793 type LDefaultDecl name = Located (DefaultDecl name)
795 data DefaultDecl name
796 = DefaultDecl [LHsType name]
798 instance (OutputableBndr name)
799 => Outputable (DefaultDecl name) where
801 ppr (DefaultDecl tys)
802 = ptext SLIT("default") <+> parens (interpp'SP tys)
805 %************************************************************************
807 \subsection{Foreign function interface declaration}
809 %************************************************************************
813 -- foreign declarations are distinguished as to whether they define or use a
816 -- * the Boolean value indicates whether the pre-standard deprecated syntax
819 type LForeignDecl name = Located (ForeignDecl name)
821 data ForeignDecl name
822 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
823 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
825 -- Specification Of an imported external entity in dependence on the calling
828 data ForeignImport = -- import of a C entity
830 -- * the two strings specifying a header file or library
831 -- may be empty, which indicates the absence of a
832 -- header or object specification (both are not used
833 -- in the case of `CWrapper' and when `CFunction'
834 -- has a dynamic target)
836 -- * the calling convention is irrelevant for code
837 -- generation in the case of `CLabel', but is needed
838 -- for pretty printing
840 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
842 CImport CCallConv -- ccall or stdcall
843 Safety -- safe or unsafe
844 FastString -- name of C header
845 FastString -- name of library object
846 CImportSpec -- details of the C entity
848 -- import of a .NET function
850 | DNImport DNCallSpec
852 -- details of an external C entity
854 data CImportSpec = CLabel CLabelString -- import address of a C label
855 | CFunction CCallTarget -- static or dynamic function
856 | CWrapper -- wrapper to expose closures
859 -- specification of an externally exported entity in dependence on the calling
862 data ForeignExport = CExport CExportSpec -- contains the calling convention
863 | DNExport -- presently unused
865 -- abstract type imported from .NET
867 data FoType = DNType -- In due course we'll add subtype stuff
868 deriving (Eq) -- Used for equality instance for TyClDecl
871 -- pretty printing of foreign declarations
874 instance OutputableBndr name => Outputable (ForeignDecl name) where
875 ppr (ForeignImport n ty fimport) =
876 hang (ptext SLIT("foreign import") <+> ppr fimport <+> ppr n)
877 2 (dcolon <+> ppr ty)
878 ppr (ForeignExport n ty fexport) =
879 hang (ptext SLIT("foreign export") <+> ppr fexport <+> ppr n)
880 2 (dcolon <+> ppr ty)
882 instance Outputable ForeignImport where
883 ppr (DNImport spec) =
884 ptext SLIT("dotnet") <+> ppr spec
885 ppr (CImport cconv safety header lib spec) =
886 ppr cconv <+> ppr safety <+>
887 char '"' <> pprCEntity header lib spec <> char '"'
889 pprCEntity header lib (CLabel lbl) =
890 ptext SLIT("static") <+> ftext header <+> char '&' <>
891 pprLib lib <> ppr lbl
892 pprCEntity header lib (CFunction (StaticTarget lbl)) =
893 ptext SLIT("static") <+> ftext header <+> char '&' <>
894 pprLib lib <> ppr lbl
895 pprCEntity header lib (CFunction (DynamicTarget)) =
896 ptext SLIT("dynamic")
897 pprCEntity _ _ (CWrapper) = ptext SLIT("wrapper")
899 pprLib lib | nullFS lib = empty
900 | otherwise = char '[' <> ppr lib <> char ']'
902 instance Outputable ForeignExport where
903 ppr (CExport (CExportStatic lbl cconv)) =
904 ppr cconv <+> char '"' <> ppr lbl <> char '"'
906 ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
908 instance Outputable FoType where
909 ppr DNType = ptext SLIT("type dotnet")
913 %************************************************************************
915 \subsection{Transformation rules}
917 %************************************************************************
920 type LRuleDecl name = Located (RuleDecl name)
923 = HsRule -- Source rule
924 RuleName -- Rule name
926 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
927 (Located (HsExpr name)) -- LHS
928 NameSet -- Free-vars from the LHS
929 (Located (HsExpr name)) -- RHS
930 NameSet -- Free-vars from the RHS
933 = RuleBndr (Located name)
934 | RuleBndrSig (Located name) (LHsType name)
936 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
937 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
939 instance OutputableBndr name => Outputable (RuleDecl name) where
940 ppr (HsRule name act ns lhs fv_lhs rhs fv_rhs)
941 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
942 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
943 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
945 pp_forall | null ns = empty
946 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
948 instance OutputableBndr name => Outputable (RuleBndr name) where
949 ppr (RuleBndr name) = ppr name
950 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
953 %************************************************************************
955 \subsection[DocDecl]{Document comments}
957 %************************************************************************
961 type LDocDecl name = Located (DocDecl name)
964 = DocCommentNext (HsDoc name)
965 | DocCommentPrev (HsDoc name)
966 | DocCommentNamed String (HsDoc name)
967 | DocGroup Int (HsDoc name)
969 -- Okay, I need to reconstruct the document comments, but for now:
970 instance Outputable (DocDecl name) where
971 ppr _ = text "<document comment>"
973 docDeclDoc (DocCommentNext d) = d
974 docDeclDoc (DocCommentPrev d) = d
975 docDeclDoc (DocCommentNamed _ d) = d
976 docDeclDoc (DocGroup _ d) = d
980 %************************************************************************
982 \subsection[DeprecDecl]{Deprecations}
984 %************************************************************************
986 We use exported entities for things to deprecate.
989 type LDeprecDecl name = Located (DeprecDecl name)
991 data DeprecDecl name = Deprecation name DeprecTxt
993 instance OutputableBndr name => Outputable (DeprecDecl name) where
994 ppr (Deprecation thing txt)
995 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]