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@.
12 {-# OPTIONS -fno-warn-incomplete-patterns #-}
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,
41 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
42 -- Because Expr imports Decls via HsBracket
51 import {- Kind parts of -} Type
62 import Data.Maybe ( isJust )
65 %************************************************************************
67 \subsection[HsDecl]{Declarations}
69 %************************************************************************
72 type LHsDecl id = Located (HsDecl id)
77 | DerivD (DerivDecl id)
80 | DefD (DefaultDecl id)
81 | ForD (ForeignDecl id)
82 | DeprecD (DeprecDecl id)
84 | SpliceD (SpliceDecl id)
88 -- NB: all top-level fixity decls are contained EITHER
90 -- OR in the ClassDecls in TyClDs
93 -- a) data constructors
94 -- b) class methods (but they can be also done in the
95 -- signatures of class decls)
96 -- c) imported functions (that have an IfacSig)
99 -- The latter is for class methods only
101 -- A [HsDecl] is categorised into a HsGroup before being
102 -- fed to the renamer.
105 hs_valds :: HsValBinds id,
106 hs_tyclds :: [LTyClDecl id],
107 hs_instds :: [LInstDecl id],
108 hs_derivds :: [LDerivDecl id],
110 hs_fixds :: [LFixitySig id],
111 -- Snaffled out of both top-level fixity signatures,
112 -- and those in class declarations
114 hs_defds :: [LDefaultDecl id],
115 hs_fords :: [LForeignDecl id],
116 hs_depds :: [LDeprecDecl id],
117 hs_ruleds :: [LRuleDecl id],
119 hs_docs :: [LDocDecl id]
122 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
123 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
124 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
126 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
127 hs_fixds = [], hs_defds = [], hs_fords = [],
128 hs_depds = [], hs_ruleds = [],
129 hs_valds = error "emptyGroup hs_valds: Can't happen",
132 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
135 hs_valds = val_groups1,
138 hs_derivds = derivds1,
146 hs_valds = val_groups2,
149 hs_derivds = derivds2,
158 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
159 hs_tyclds = tyclds1 ++ tyclds2,
160 hs_instds = instds1 ++ instds2,
161 hs_derivds = derivds1 ++ derivds2,
162 hs_fixds = fixds1 ++ fixds2,
163 hs_defds = defds1 ++ defds2,
164 hs_fords = fords1 ++ fords2,
165 hs_depds = depds1 ++ depds2,
166 hs_ruleds = rulds1 ++ rulds2,
167 hs_docs = docs1 ++ docs2 }
171 instance OutputableBndr name => Outputable (HsDecl name) where
172 ppr (TyClD dcl) = ppr dcl
173 ppr (ValD binds) = ppr binds
174 ppr (DefD def) = ppr def
175 ppr (InstD inst) = ppr inst
176 ppr (DerivD deriv) = ppr deriv
177 ppr (ForD fd) = ppr fd
178 ppr (SigD sd) = ppr sd
179 ppr (RuleD rd) = ppr rd
180 ppr (DeprecD dd) = ppr dd
181 ppr (SpliceD dd) = ppr dd
182 ppr (DocD doc) = ppr doc
184 instance OutputableBndr name => Outputable (HsGroup name) where
185 ppr (HsGroup { hs_valds = val_decls,
186 hs_tyclds = tycl_decls,
187 hs_instds = inst_decls,
188 hs_derivds = deriv_decls,
189 hs_fixds = fix_decls,
190 hs_depds = deprec_decls,
191 hs_fords = foreign_decls,
192 hs_defds = default_decls,
193 hs_ruleds = rule_decls })
194 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
195 ppr_ds deprec_decls, ppr_ds rule_decls,
197 ppr_ds tycl_decls, ppr_ds inst_decls,
199 ppr_ds foreign_decls]
202 ppr_ds ds = text "" $$ vcat (map ppr ds)
204 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
206 instance OutputableBndr name => Outputable (SpliceDecl name) where
207 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
211 %************************************************************************
213 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
215 %************************************************************************
217 --------------------------------
219 --------------------------------
221 Here is the story about the implicit names that go with type, class,
222 and instance decls. It's a bit tricky, so pay attention!
224 "Implicit" (or "system") binders
225 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
226 Each data type decl defines
227 a worker name for each constructor
228 to-T and from-T convertors
229 Each class decl defines
230 a tycon for the class
231 a data constructor for that tycon
232 the worker for that constructor
233 a selector for each superclass
235 All have occurrence names that are derived uniquely from their parent
238 None of these get separate definitions in an interface file; they are
239 fully defined by the data or class decl. But they may *occur* in
240 interface files, of course. Any such occurrence must haul in the
241 relevant type or class decl.
244 - Ensure they "point to" the parent data/class decl
245 when loading that decl from an interface file
246 (See RnHiFiles.getSysBinders)
248 - When typechecking the decl, we build the implicit TyCons and Ids.
249 When doing so we look them up in the name cache (RnEnv.lookupSysName),
250 to ensure correct module and provenance is set
252 These are the two places that we have to conjure up the magic derived
253 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
257 - Occurrence name is derived uniquely from the method name
260 - If there is a default method name at all, it's recorded in
261 the ClassOpSig (in HsBinds), in the DefMeth field.
262 (DefMeth is defined in Class.lhs)
264 Source-code class decls and interface-code class decls are treated subtly
265 differently, which has given me a great deal of confusion over the years.
266 Here's the deal. (We distinguish the two cases because source-code decls
267 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
269 In *source-code* class declarations:
271 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
272 This is done by RdrHsSyn.mkClassOpSigDM
274 - The renamer renames it to a Name
276 - During typechecking, we generate a binding for each $dm for
277 which there's a programmer-supplied default method:
282 We generate a binding for $dmop1 but not for $dmop2.
283 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
284 The Name for $dmop2 is simply discarded.
286 In *interface-file* class declarations:
287 - When parsing, we see if there's an explicit programmer-supplied default method
288 because there's an '=' sign to indicate it:
290 op1 = :: <type> -- NB the '='
292 We use this info to generate a DefMeth with a suitable RdrName for op1,
293 and a NoDefMeth for op2
294 - The interface file has a separate definition for $dmop1, with unfolding etc.
295 - The renamer renames it to a Name.
296 - The renamer treats $dmop1 as a free variable of the declaration, so that
297 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
298 This doesn't happen for source code class decls, because they *bind* the default method.
302 Each instance declaration gives rise to one dictionary function binding.
304 The type checker makes up new source-code instance declarations
305 (e.g. from 'deriving' or generic default methods --- see
306 TcInstDcls.tcInstDecls1). So we can't generate the names for
307 dictionary functions in advance (we don't know how many we need).
309 On the other hand for interface-file instance declarations, the decl
310 specifies the name of the dictionary function, and it has a binding elsewhere
311 in the interface file:
312 instance {Eq Int} = dEqInt
313 dEqInt :: {Eq Int} <pragma info>
315 So again we treat source code and interface file code slightly differently.
318 - Source code instance decls have a Nothing in the (Maybe name) field
319 (see data InstDecl below)
321 - The typechecker makes up a Local name for the dict fun for any source-code
322 instance decl, whether it comes from a source-code instance decl, or whether
323 the instance decl is derived from some other construct (e.g. 'deriving').
325 - The occurrence name it chooses is derived from the instance decl (just for
326 documentation really) --- e.g. dNumInt. Two dict funs may share a common
327 occurrence name, but will have different uniques. E.g.
328 instance Foo [Int] where ...
329 instance Foo [Bool] where ...
330 These might both be dFooList
332 - The CoreTidy phase externalises the name, and ensures the occurrence name is
333 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
335 - We can take this relaxed approach (changing the occurrence name later)
336 because dict fun Ids are not captured in a TyCon or Class (unlike default
337 methods, say). Instead, they are kept separately in the InstEnv. This
338 makes it easy to adjust them after compiling a module. (Once we've finished
339 compiling that module, they don't change any more.)
343 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
344 in the (Maybe name) field.
346 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
347 suck in the dfun binding
351 -- Representation of indexed types
352 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
353 -- Family kind signatures are represented by the variant `TyFamily'. It
354 -- covers "type family", "newtype family", and "data family" declarations,
355 -- distinguished by the value of the field `tcdFlavour'.
357 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
358 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
360 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
361 -- synonym declaration and 'tcdVars' contains the type parameters of the
364 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
365 -- 'pats' are type patterns for the type-indexes of the type constructor
366 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
367 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
368 -- *not* 'length tcdVars'.
370 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
372 type LTyClDecl name = Located (TyClDecl name)
376 tcdLName :: Located name,
377 tcdExtName :: Maybe FastString,
381 -- type/data/newtype family T :: *->*
382 | TyFamily { tcdFlavour:: FamilyFlavour, -- type, new, or data
383 tcdLName :: Located name, -- type constructor
384 tcdTyVars :: [LHsTyVarBndr name], -- type variables
385 tcdKind :: Maybe Kind -- result kind
388 -- Declares a data type or newtype, giving its construcors
389 -- data/newtype T a = <constrs>
390 -- data/newtype instance T [a] = <constrs>
391 | TyData { tcdND :: NewOrData,
392 tcdCtxt :: LHsContext name, -- Context
393 tcdLName :: Located name, -- Type constructor
395 tcdTyVars :: [LHsTyVarBndr name], -- Type variables
397 tcdTyPats :: Maybe [LHsType name], -- Type patterns
398 -- Just [t1..tn] for data instance T t1..tn = ...
399 -- in this case tcdTyVars = fv( tcdTyPats )
400 -- Nothing for everything else
402 tcdKindSig:: Maybe Kind, -- Optional kind sig
403 -- (Just k) for a GADT-style 'data', or 'data
404 -- instance' decl with explicit kind sig
406 tcdCons :: [LConDecl name], -- Data constructors
407 -- For data T a = T1 | T2 a
408 -- the LConDecls all have ResTyH98
409 -- For data T a where { T1 :: T a }
410 -- the LConDecls all have ResTyGADT
412 tcdDerivs :: Maybe [LHsType name]
413 -- Derivings; Nothing => not specified
414 -- Just [] => derive exactly what is asked
415 -- These "types" must be of form
416 -- forall ab. C ty1 ty2
417 -- Typically the foralls and ty args are empty, but they
418 -- are non-empty for the newtype-deriving case
421 | TySynonym { tcdLName :: Located name, -- type constructor
422 tcdTyVars :: [LHsTyVarBndr name], -- type variables
423 tcdTyPats :: Maybe [LHsType name], -- Type patterns
424 -- See comments for tcdTyPats in TyData
425 -- 'Nothing' => vanilla type synonym
427 tcdSynRhs :: LHsType name -- synonym expansion
430 | ClassDecl { tcdCtxt :: LHsContext name, -- Context...
431 tcdLName :: Located name, -- Name of the class
432 tcdTyVars :: [LHsTyVarBndr name], -- Class type variables
433 tcdFDs :: [Located (FunDep name)], -- Functional deps
434 tcdSigs :: [LSig name], -- Methods' signatures
435 tcdMeths :: LHsBinds name, -- Default methods
436 tcdATs :: [LTyClDecl name], -- Associated types; ie
437 -- only 'TyFamily' and
439 -- latter for defaults
440 tcdDocs :: [LDocDecl name] -- Haddock docs
444 = NewType -- "newtype Blah ..."
445 | DataType -- "data Blah ..."
446 deriving( Eq ) -- Needed because Demand derives Eq
449 = TypeFamily -- "type family ..."
450 | DataFamily -- "data family ..."
456 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl ::
457 TyClDecl name -> Bool
459 -- data/newtype or data/newtype instance declaration
460 isDataDecl (TyData {}) = True
461 isDataDecl _other = False
463 -- type or type instance declaration
464 isTypeDecl (TySynonym {}) = True
465 isTypeDecl _other = False
467 -- vanilla Haskell type synonym (ie, not a type instance)
468 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
469 isSynDecl _other = False
472 isClassDecl (ClassDecl {}) = True
473 isClassDecl _ = False
475 -- type family declaration
476 isFamilyDecl (TyFamily {}) = True
477 isFamilyDecl _other = False
479 -- family instance (types, newtypes, and data types)
482 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
489 tcdName :: TyClDecl name -> name
490 tcdName decl = unLoc (tcdLName decl)
492 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
493 -- Returns all the *binding* names of the decl, along with their SrcLocs
494 -- The first one is guaranteed to be the name of the decl
495 -- For record fields, the first one counts as the SrcLoc
496 -- We use the equality to filter out duplicate field names
498 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
499 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
500 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
502 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
504 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
506 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
507 = tc_name : conDeclsNames (map unLoc cons)
509 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
510 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
511 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
512 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
513 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
514 tyClDeclTyVars (ForeignType {}) = []
518 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
519 -- class, synonym decls, data, newtype, family decls, family instances
521 = (count isClassDecl decls,
522 count isSynDecl decls, -- excluding...
523 count isDataTy decls, -- ...family...
524 count isNewTy decls, -- ...instances
525 count isFamilyDecl decls,
526 count isFamInstDecl decls)
528 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
531 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
536 instance OutputableBndr name
537 => Outputable (TyClDecl name) where
539 ppr (ForeignType {tcdLName = ltycon})
540 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
542 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
543 tcdTyVars = tyvars, tcdKind = mb_kind})
544 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
546 pp_flavour = case flavour of
547 TypeFamily -> ptext (sLit "type family")
548 DataFamily -> ptext (sLit "data family")
550 pp_kind = case mb_kind of
552 Just kind -> dcolon <+> pprKind kind
554 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
555 tcdSynRhs = mono_ty})
556 = hang (ptext (sLit "type") <+>
557 (if isJust typats then ptext (sLit "instance") else empty) <+>
558 pp_decl_head [] ltycon tyvars typats <+>
562 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
563 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
564 tcdCons = condecls, tcdDerivs = derivings})
565 = pp_tydecl (null condecls && isJust mb_sig)
567 (if isJust typats then ptext (sLit "instance") else empty) <+>
568 pp_decl_head (unLoc context) ltycon tyvars typats <+>
570 (pp_condecls condecls)
573 ppr_sig Nothing = empty
574 ppr_sig (Just kind) = dcolon <+> pprKind kind
576 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
578 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
579 | null sigs && null ats -- No "where" part
582 | otherwise -- Laid out
583 = sep [hsep [top_matter, ptext (sLit "where {")],
584 nest 4 (sep [ sep (map ppr_semi ats)
585 , sep (map ppr_semi sigs)
586 , pprLHsBinds methods
589 top_matter = ptext (sLit "class")
590 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
591 <+> pprFundeps (map unLoc fds)
592 ppr_semi decl = ppr decl <> semi
594 pp_decl_head :: OutputableBndr name
597 -> [LHsTyVarBndr name]
598 -> Maybe [LHsType name]
600 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
601 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
602 pp_decl_head context thing _ (Just typats) -- explicit type patterns
603 = hsep [ pprHsContext context, ppr thing
604 , hsep (map (pprParendHsType.unLoc) typats)]
606 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
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 :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
613 pp_tydecl True pp_head _ _
615 pp_tydecl False pp_head pp_decl_rhs derivings
616 = hang pp_head 4 (sep [
620 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
623 instance Outputable NewOrData where
624 ppr NewType = ptext (sLit "newtype")
625 ppr DataType = ptext (sLit "data")
629 %************************************************************************
631 \subsection[ConDecl]{A data-constructor declaration}
633 %************************************************************************
636 type LConDecl name = Located (ConDecl name)
638 -- data T b = forall a. Eq a => MkT a b
639 -- MkT :: forall b a. Eq a => MkT a b
642 -- MkT1 :: Int -> T Int
644 -- data T = Int `MkT` Int
648 -- Int `MkT` Int :: T Int
652 { con_name :: Located name -- Constructor name; this is used for the
653 -- DataCon itself, and for the user-callable wrapper Id
655 , con_explicit :: HsExplicitForAll -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
657 , con_qvars :: [LHsTyVarBndr name] -- ResTyH98: the constructor's existential type variables
658 -- ResTyGADT: all the constructor's quantified type variables
660 , con_cxt :: LHsContext name -- The context. This *does not* include the
661 -- "stupid theta" which lives only in the TyData decl
663 , con_details :: HsConDeclDetails name -- The main payload
665 , con_res :: ResType name -- Result type of the constructor
667 , con_doc :: Maybe (LHsDoc name) -- A possible Haddock comment
670 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
672 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
673 hsConDeclArgTys (PrefixCon tys) = tys
674 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
675 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
677 data ConDeclField name -- Record fields have Haddoc docs on them
678 = ConDeclField { cd_fld_name :: Located name,
679 cd_fld_type :: LBangType name,
680 cd_fld_doc :: Maybe (LHsDoc name) }
683 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
684 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
685 -- and here is its result type
689 conDeclsNames :: (Eq name) => [ConDecl name] -> [Located name]
690 -- See tyClDeclNames for what this does
691 -- The function is boringly complicated because of the records
692 -- And since we only have equality, we have to be a little careful
694 = snd (foldl do_one ([], []) cons)
696 do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
697 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
699 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
700 (map cd_fld_name flds)
702 do_one (flds_seen, acc) c
703 = (flds_seen, (con_name c):acc)
708 instance (OutputableBndr name) => Outputable (ConDecl name) where
711 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
712 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
713 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
715 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
716 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
717 ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
719 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
720 = ppr con <+> dcolon <+>
721 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
723 mk_fun_ty a b = noLoc (HsFunTy a b)
725 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
726 = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
728 pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
729 = pprPanic "pprConDecl" (ppr con)
730 -- In GADT syntax we don't allow infix constructors
733 ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
734 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
736 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
738 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
741 %************************************************************************
743 \subsection[InstDecl]{An instance declaration
745 %************************************************************************
748 type LInstDecl name = Located (InstDecl name)
751 = InstDecl (LHsType name) -- Context => Class Instance-type
752 -- Using a polytype means that the renamer conveniently
753 -- figures out the quantified type variables for us.
755 [LSig name] -- User-supplied pragmatic info
756 [LTyClDecl name]-- Associated types (ie, 'TyData' and
759 instance (OutputableBndr name) => Outputable (InstDecl name) where
761 ppr (InstDecl inst_ty binds uprags ats)
762 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
763 , nest 4 $ vcat (map ppr ats)
764 , nest 4 $ vcat (map ppr uprags)
765 , nest 4 $ pprLHsBinds binds ]
767 -- Extract the declarations of associated types from an instance
769 instDeclATs :: InstDecl name -> [LTyClDecl name]
770 instDeclATs (InstDecl _ _ _ ats) = ats
773 %************************************************************************
775 \subsection[DerivDecl]{A stand-alone instance deriving declaration
777 %************************************************************************
780 type LDerivDecl name = Located (DerivDecl name)
782 data DerivDecl name = DerivDecl (LHsType name)
784 instance (OutputableBndr name) => Outputable (DerivDecl name) where
786 = hsep [ptext (sLit "derived instance"), ppr ty]
789 %************************************************************************
791 \subsection[DefaultDecl]{A @default@ declaration}
793 %************************************************************************
795 There can only be one default declaration per module, but it is hard
796 for the parser to check that; we pass them all through in the abstract
797 syntax, and that restriction must be checked in the front end.
800 type LDefaultDecl name = Located (DefaultDecl name)
802 data DefaultDecl name
803 = DefaultDecl [LHsType name]
805 instance (OutputableBndr name)
806 => Outputable (DefaultDecl name) where
808 ppr (DefaultDecl tys)
809 = ptext (sLit "default") <+> parens (interpp'SP tys)
812 %************************************************************************
814 \subsection{Foreign function interface declaration}
816 %************************************************************************
820 -- foreign declarations are distinguished as to whether they define or use a
823 -- * the Boolean value indicates whether the pre-standard deprecated syntax
826 type LForeignDecl name = Located (ForeignDecl name)
828 data ForeignDecl name
829 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
830 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
832 -- Specification Of an imported external entity in dependence on the calling
835 data ForeignImport = -- import of a C entity
837 -- * the two strings specifying a header file or library
838 -- may be empty, which indicates the absence of a
839 -- header or object specification (both are not used
840 -- in the case of `CWrapper' and when `CFunction'
841 -- has a dynamic target)
843 -- * the calling convention is irrelevant for code
844 -- generation in the case of `CLabel', but is needed
845 -- for pretty printing
847 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
849 CImport CCallConv -- ccall or stdcall
850 Safety -- safe or unsafe
851 FastString -- name of C header
852 FastString -- name of library object
853 CImportSpec -- details of the C entity
855 -- import of a .NET function
857 | DNImport DNCallSpec
859 -- details of an external C entity
861 data CImportSpec = CLabel CLabelString -- import address of a C label
862 | CFunction CCallTarget -- static or dynamic function
863 | CWrapper -- wrapper to expose closures
866 -- specification of an externally exported entity in dependence on the calling
869 data ForeignExport = CExport CExportSpec -- contains the calling convention
870 | DNExport -- presently unused
872 -- abstract type imported from .NET
874 data FoType = DNType -- In due course we'll add subtype stuff
875 deriving (Eq) -- Used for equality instance for TyClDecl
878 -- pretty printing of foreign declarations
881 instance OutputableBndr name => Outputable (ForeignDecl name) where
882 ppr (ForeignImport n ty fimport) =
883 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
884 2 (dcolon <+> ppr ty)
885 ppr (ForeignExport n ty fexport) =
886 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
887 2 (dcolon <+> ppr ty)
889 instance Outputable ForeignImport where
890 ppr (DNImport spec) =
891 ptext (sLit "dotnet") <+> ppr spec
892 ppr (CImport cconv safety header lib spec) =
893 ppr cconv <+> ppr safety <+>
894 char '"' <> pprCEntity header lib spec <> char '"'
896 pprCEntity header lib (CLabel lbl) =
897 ptext (sLit "static") <+> ftext header <+> char '&' <>
898 pprLib lib <> ppr lbl
899 pprCEntity header lib (CFunction (StaticTarget lbl)) =
900 ptext (sLit "static") <+> ftext header <+> char '&' <>
901 pprLib lib <> ppr lbl
902 pprCEntity _ _ (CFunction (DynamicTarget)) =
903 ptext (sLit "dynamic")
904 pprCEntity _ _ (CWrapper) = ptext (sLit "wrapper")
906 pprLib lib | nullFS lib = empty
907 | otherwise = char '[' <> ppr lib <> char ']'
909 instance Outputable ForeignExport where
910 ppr (CExport (CExportStatic lbl cconv)) =
911 ppr cconv <+> char '"' <> ppr lbl <> char '"'
913 ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
915 instance Outputable FoType where
916 ppr DNType = ptext (sLit "type dotnet")
920 %************************************************************************
922 \subsection{Transformation rules}
924 %************************************************************************
927 type LRuleDecl name = Located (RuleDecl name)
930 = HsRule -- Source rule
931 RuleName -- Rule name
933 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
934 (Located (HsExpr name)) -- LHS
935 NameSet -- Free-vars from the LHS
936 (Located (HsExpr name)) -- RHS
937 NameSet -- Free-vars from the RHS
940 = RuleBndr (Located name)
941 | RuleBndrSig (Located name) (LHsType name)
943 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
944 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
946 instance OutputableBndr name => Outputable (RuleDecl name) where
947 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
948 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
949 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
950 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
952 pp_forall | null ns = empty
953 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
955 instance OutputableBndr name => Outputable (RuleBndr name) where
956 ppr (RuleBndr name) = ppr name
957 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
960 %************************************************************************
962 \subsection[DocDecl]{Document comments}
964 %************************************************************************
968 type LDocDecl name = Located (DocDecl name)
971 = DocCommentNext (HsDoc name)
972 | DocCommentPrev (HsDoc name)
973 | DocCommentNamed String (HsDoc name)
974 | DocGroup Int (HsDoc name)
976 -- Okay, I need to reconstruct the document comments, but for now:
977 instance Outputable (DocDecl name) where
978 ppr _ = text "<document comment>"
980 docDeclDoc :: DocDecl name -> HsDoc name
981 docDeclDoc (DocCommentNext d) = d
982 docDeclDoc (DocCommentPrev d) = d
983 docDeclDoc (DocCommentNamed _ d) = d
984 docDeclDoc (DocGroup _ d) = d
988 %************************************************************************
990 \subsection[DeprecDecl]{Deprecations}
992 %************************************************************************
994 We use exported entities for things to deprecate.
997 type LDeprecDecl name = Located (DeprecDecl name)
999 data DeprecDecl name = Deprecation name DeprecTxt
1001 instance OutputableBndr name => Outputable (DeprecDecl name) where
1002 ppr (Deprecation thing txt)
1003 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]