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 WarnDecl(..), LWarnDecl,
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
50 import {- Kind parts of -} Type
61 import Data.Maybe ( isJust )
64 %************************************************************************
66 \subsection[HsDecl]{Declarations}
68 %************************************************************************
71 type LHsDecl id = Located (HsDecl id)
76 | DerivD (DerivDecl id)
79 | DefD (DefaultDecl id)
80 | ForD (ForeignDecl id)
81 | WarningD (WarnDecl id)
83 | SpliceD (SpliceDecl id)
87 -- NB: all top-level fixity decls are contained EITHER
89 -- OR in the ClassDecls in TyClDs
92 -- a) data constructors
93 -- b) class methods (but they can be also done in the
94 -- signatures of class decls)
95 -- c) imported functions (that have an IfacSig)
98 -- The latter is for class methods only
100 -- A [HsDecl] is categorised into a HsGroup before being
101 -- fed to the renamer.
104 hs_valds :: HsValBinds id,
105 hs_tyclds :: [LTyClDecl id],
106 hs_instds :: [LInstDecl id],
107 hs_derivds :: [LDerivDecl id],
109 hs_fixds :: [LFixitySig id],
110 -- Snaffled out of both top-level fixity signatures,
111 -- and those in class declarations
113 hs_defds :: [LDefaultDecl id],
114 hs_fords :: [LForeignDecl id],
115 hs_warnds :: [LWarnDecl id],
116 hs_ruleds :: [LRuleDecl id],
118 hs_docs :: [LDocDecl id]
121 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
122 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
123 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
125 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
126 hs_fixds = [], hs_defds = [], hs_fords = [],
127 hs_warnds = [], hs_ruleds = [],
128 hs_valds = error "emptyGroup hs_valds: Can't happen",
131 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
134 hs_valds = val_groups1,
137 hs_derivds = derivds1,
145 hs_valds = val_groups2,
148 hs_derivds = derivds2,
157 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
158 hs_tyclds = tyclds1 ++ tyclds2,
159 hs_instds = instds1 ++ instds2,
160 hs_derivds = derivds1 ++ derivds2,
161 hs_fixds = fixds1 ++ fixds2,
162 hs_defds = defds1 ++ defds2,
163 hs_fords = fords1 ++ fords2,
164 hs_warnds = warnds1 ++ warnds2,
165 hs_ruleds = rulds1 ++ rulds2,
166 hs_docs = docs1 ++ docs2 }
170 instance OutputableBndr name => Outputable (HsDecl name) where
171 ppr (TyClD dcl) = ppr dcl
172 ppr (ValD binds) = ppr binds
173 ppr (DefD def) = ppr def
174 ppr (InstD inst) = ppr inst
175 ppr (DerivD deriv) = ppr deriv
176 ppr (ForD fd) = ppr fd
177 ppr (SigD sd) = ppr sd
178 ppr (RuleD rd) = ppr rd
179 ppr (WarningD wd) = ppr wd
180 ppr (SpliceD dd) = ppr dd
181 ppr (DocD doc) = ppr doc
183 instance OutputableBndr name => Outputable (HsGroup name) where
184 ppr (HsGroup { hs_valds = val_decls,
185 hs_tyclds = tycl_decls,
186 hs_instds = inst_decls,
187 hs_derivds = deriv_decls,
188 hs_fixds = fix_decls,
189 hs_warnds = deprec_decls,
190 hs_fords = foreign_decls,
191 hs_defds = default_decls,
192 hs_ruleds = rule_decls })
193 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
194 ppr_ds deprec_decls, ppr_ds rule_decls,
196 ppr_ds tycl_decls, ppr_ds inst_decls,
198 ppr_ds foreign_decls]
201 ppr_ds ds = text "" $$ vcat (map ppr ds)
203 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
205 instance OutputableBndr name => Outputable (SpliceDecl name) where
206 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
210 %************************************************************************
212 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
214 %************************************************************************
216 --------------------------------
218 --------------------------------
220 Here is the story about the implicit names that go with type, class,
221 and instance decls. It's a bit tricky, so pay attention!
223 "Implicit" (or "system") binders
224 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
225 Each data type decl defines
226 a worker name for each constructor
227 to-T and from-T convertors
228 Each class decl defines
229 a tycon for the class
230 a data constructor for that tycon
231 the worker for that constructor
232 a selector for each superclass
234 All have occurrence names that are derived uniquely from their parent
237 None of these get separate definitions in an interface file; they are
238 fully defined by the data or class decl. But they may *occur* in
239 interface files, of course. Any such occurrence must haul in the
240 relevant type or class decl.
243 - Ensure they "point to" the parent data/class decl
244 when loading that decl from an interface file
245 (See RnHiFiles.getSysBinders)
247 - When typechecking the decl, we build the implicit TyCons and Ids.
248 When doing so we look them up in the name cache (RnEnv.lookupSysName),
249 to ensure correct module and provenance is set
251 These are the two places that we have to conjure up the magic derived
252 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
256 - Occurrence name is derived uniquely from the method name
259 - If there is a default method name at all, it's recorded in
260 the ClassOpSig (in HsBinds), in the DefMeth field.
261 (DefMeth is defined in Class.lhs)
263 Source-code class decls and interface-code class decls are treated subtly
264 differently, which has given me a great deal of confusion over the years.
265 Here's the deal. (We distinguish the two cases because source-code decls
266 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
268 In *source-code* class declarations:
270 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
271 This is done by RdrHsSyn.mkClassOpSigDM
273 - The renamer renames it to a Name
275 - During typechecking, we generate a binding for each $dm for
276 which there's a programmer-supplied default method:
281 We generate a binding for $dmop1 but not for $dmop2.
282 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
283 The Name for $dmop2 is simply discarded.
285 In *interface-file* class declarations:
286 - When parsing, we see if there's an explicit programmer-supplied default method
287 because there's an '=' sign to indicate it:
289 op1 = :: <type> -- NB the '='
291 We use this info to generate a DefMeth with a suitable RdrName for op1,
292 and a NoDefMeth for op2
293 - The interface file has a separate definition for $dmop1, with unfolding etc.
294 - The renamer renames it to a Name.
295 - The renamer treats $dmop1 as a free variable of the declaration, so that
296 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
297 This doesn't happen for source code class decls, because they *bind* the default method.
301 Each instance declaration gives rise to one dictionary function binding.
303 The type checker makes up new source-code instance declarations
304 (e.g. from 'deriving' or generic default methods --- see
305 TcInstDcls.tcInstDecls1). So we can't generate the names for
306 dictionary functions in advance (we don't know how many we need).
308 On the other hand for interface-file instance declarations, the decl
309 specifies the name of the dictionary function, and it has a binding elsewhere
310 in the interface file:
311 instance {Eq Int} = dEqInt
312 dEqInt :: {Eq Int} <pragma info>
314 So again we treat source code and interface file code slightly differently.
317 - Source code instance decls have a Nothing in the (Maybe name) field
318 (see data InstDecl below)
320 - The typechecker makes up a Local name for the dict fun for any source-code
321 instance decl, whether it comes from a source-code instance decl, or whether
322 the instance decl is derived from some other construct (e.g. 'deriving').
324 - The occurrence name it chooses is derived from the instance decl (just for
325 documentation really) --- e.g. dNumInt. Two dict funs may share a common
326 occurrence name, but will have different uniques. E.g.
327 instance Foo [Int] where ...
328 instance Foo [Bool] where ...
329 These might both be dFooList
331 - The CoreTidy phase externalises the name, and ensures the occurrence name is
332 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
334 - We can take this relaxed approach (changing the occurrence name later)
335 because dict fun Ids are not captured in a TyCon or Class (unlike default
336 methods, say). Instead, they are kept separately in the InstEnv. This
337 makes it easy to adjust them after compiling a module. (Once we've finished
338 compiling that module, they don't change any more.)
342 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
343 in the (Maybe name) field.
345 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
346 suck in the dfun binding
350 -- Representation of indexed types
351 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
352 -- Family kind signatures are represented by the variant `TyFamily'. It
353 -- covers "type family", "newtype family", and "data family" declarations,
354 -- distinguished by the value of the field `tcdFlavour'.
356 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
357 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
359 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
360 -- synonym declaration and 'tcdVars' contains the type parameters of the
363 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
364 -- 'pats' are type patterns for the type-indexes of the type constructor
365 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
366 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
367 -- *not* 'length tcdVars'.
369 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
371 type LTyClDecl name = Located (TyClDecl name)
375 tcdLName :: Located name,
376 tcdExtName :: Maybe FastString,
380 -- type/data/newtype family T :: *->*
381 | TyFamily { tcdFlavour:: FamilyFlavour, -- type, new, or data
382 tcdLName :: Located name, -- type constructor
383 tcdTyVars :: [LHsTyVarBndr name], -- type variables
384 tcdKind :: Maybe Kind -- result kind
387 -- Declares a data type or newtype, giving its construcors
388 -- data/newtype T a = <constrs>
389 -- data/newtype instance T [a] = <constrs>
390 | TyData { tcdND :: NewOrData,
391 tcdCtxt :: LHsContext name, -- Context
392 tcdLName :: Located name, -- Type constructor
394 tcdTyVars :: [LHsTyVarBndr name], -- Type variables
396 tcdTyPats :: Maybe [LHsType name], -- Type patterns
397 -- Just [t1..tn] for data instance T t1..tn = ...
398 -- in this case tcdTyVars = fv( tcdTyPats )
399 -- Nothing for everything else
401 tcdKindSig:: Maybe Kind, -- Optional kind sig
402 -- (Just k) for a GADT-style 'data', or 'data
403 -- instance' decl with explicit kind sig
405 tcdCons :: [LConDecl name], -- Data constructors
406 -- For data T a = T1 | T2 a
407 -- the LConDecls all have ResTyH98
408 -- For data T a where { T1 :: T a }
409 -- the LConDecls all have ResTyGADT
411 tcdDerivs :: Maybe [LHsType name]
412 -- Derivings; Nothing => not specified
413 -- Just [] => derive exactly what is asked
414 -- These "types" must be of form
415 -- forall ab. C ty1 ty2
416 -- Typically the foralls and ty args are empty, but they
417 -- are non-empty for the newtype-deriving case
420 | TySynonym { tcdLName :: Located name, -- type constructor
421 tcdTyVars :: [LHsTyVarBndr name], -- type variables
422 tcdTyPats :: Maybe [LHsType name], -- Type patterns
423 -- See comments for tcdTyPats in TyData
424 -- 'Nothing' => vanilla type synonym
426 tcdSynRhs :: LHsType name -- synonym expansion
429 | ClassDecl { tcdCtxt :: LHsContext name, -- Context...
430 tcdLName :: Located name, -- Name of the class
431 tcdTyVars :: [LHsTyVarBndr name], -- Class type variables
432 tcdFDs :: [Located (FunDep name)], -- Functional deps
433 tcdSigs :: [LSig name], -- Methods' signatures
434 tcdMeths :: LHsBinds name, -- Default methods
435 tcdATs :: [LTyClDecl name], -- Associated types; ie
436 -- only 'TyFamily' and
438 -- latter for defaults
439 tcdDocs :: [LDocDecl name] -- Haddock docs
443 = NewType -- "newtype Blah ..."
444 | DataType -- "data Blah ..."
445 deriving( Eq ) -- Needed because Demand derives Eq
448 = TypeFamily -- "type family ..."
449 | DataFamily -- "data family ..."
455 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl ::
456 TyClDecl name -> Bool
458 -- data/newtype or data/newtype instance declaration
459 isDataDecl (TyData {}) = True
460 isDataDecl _other = False
462 -- type or type instance declaration
463 isTypeDecl (TySynonym {}) = True
464 isTypeDecl _other = False
466 -- vanilla Haskell type synonym (ie, not a type instance)
467 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
468 isSynDecl _other = False
471 isClassDecl (ClassDecl {}) = True
472 isClassDecl _ = False
474 -- type family declaration
475 isFamilyDecl (TyFamily {}) = True
476 isFamilyDecl _other = False
478 -- family instance (types, newtypes, and data types)
481 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
488 tcdName :: TyClDecl name -> name
489 tcdName decl = unLoc (tcdLName decl)
491 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
492 -- Returns all the *binding* names of the decl, along with their SrcLocs
493 -- The first one is guaranteed to be the name of the decl
494 -- For record fields, the first one counts as the SrcLoc
495 -- We use the equality to filter out duplicate field names
497 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
498 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
499 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
501 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
503 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
505 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
506 = tc_name : conDeclsNames (map unLoc cons)
508 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
509 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
510 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
511 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
512 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
513 tyClDeclTyVars (ForeignType {}) = []
517 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
518 -- class, synonym decls, data, newtype, family decls, family instances
520 = (count isClassDecl decls,
521 count isSynDecl decls, -- excluding...
522 count isDataTy decls, -- ...family...
523 count isNewTy decls, -- ...instances
524 count isFamilyDecl decls,
525 count isFamInstDecl decls)
527 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
530 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
535 instance OutputableBndr name
536 => Outputable (TyClDecl name) where
538 ppr (ForeignType {tcdLName = ltycon})
539 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
541 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
542 tcdTyVars = tyvars, tcdKind = mb_kind})
543 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
545 pp_flavour = case flavour of
546 TypeFamily -> ptext (sLit "type family")
547 DataFamily -> ptext (sLit "data family")
549 pp_kind = case mb_kind of
551 Just kind -> dcolon <+> pprKind kind
553 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
554 tcdSynRhs = mono_ty})
555 = hang (ptext (sLit "type") <+>
556 (if isJust typats then ptext (sLit "instance") else empty) <+>
557 pp_decl_head [] ltycon tyvars typats <+>
561 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
562 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
563 tcdCons = condecls, tcdDerivs = derivings})
564 = pp_tydecl (null condecls && isJust mb_sig)
566 (if isJust typats then ptext (sLit "instance") else empty) <+>
567 pp_decl_head (unLoc context) ltycon tyvars typats <+>
569 (pp_condecls condecls)
572 ppr_sig Nothing = empty
573 ppr_sig (Just kind) = dcolon <+> pprKind kind
575 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
577 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
578 | null sigs && null ats -- No "where" part
581 | otherwise -- Laid out
582 = sep [hsep [top_matter, ptext (sLit "where {")],
583 nest 4 (sep [ sep (map ppr_semi ats)
584 , sep (map ppr_semi sigs)
585 , pprLHsBinds methods
588 top_matter = ptext (sLit "class")
589 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
590 <+> pprFundeps (map unLoc fds)
591 ppr_semi decl = ppr decl <> semi
593 pp_decl_head :: OutputableBndr name
596 -> [LHsTyVarBndr name]
597 -> Maybe [LHsType name]
599 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
600 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
601 pp_decl_head context thing _ (Just typats) -- explicit type patterns
602 = hsep [ pprHsContext context, ppr thing
603 , hsep (map (pprParendHsType.unLoc) typats)]
605 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
606 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
607 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
608 pp_condecls cs -- In H98 syntax
609 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
611 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
612 pp_tydecl True pp_head _ _
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, pprHsInfix 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 pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
728 = pprPanic "pprConDecl" (ppr con)
729 -- In GADT syntax we don't allow infix constructors
732 ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
733 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
735 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
737 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
740 %************************************************************************
742 \subsection[InstDecl]{An instance declaration
744 %************************************************************************
747 type LInstDecl name = Located (InstDecl name)
750 = InstDecl (LHsType name) -- Context => Class Instance-type
751 -- Using a polytype means that the renamer conveniently
752 -- figures out the quantified type variables for us.
754 [LSig name] -- User-supplied pragmatic info
755 [LTyClDecl name]-- Associated types (ie, 'TyData' and
758 instance (OutputableBndr name) => Outputable (InstDecl name) where
760 ppr (InstDecl inst_ty binds uprags ats)
761 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
762 , nest 4 $ vcat (map ppr ats)
763 , nest 4 $ vcat (map ppr uprags)
764 , nest 4 $ pprLHsBinds binds ]
766 -- Extract the declarations of associated types from an instance
768 instDeclATs :: InstDecl name -> [LTyClDecl name]
769 instDeclATs (InstDecl _ _ _ ats) = ats
772 %************************************************************************
774 \subsection[DerivDecl]{A stand-alone instance deriving declaration
776 %************************************************************************
779 type LDerivDecl name = Located (DerivDecl name)
781 data DerivDecl name = DerivDecl (LHsType name)
783 instance (OutputableBndr name) => Outputable (DerivDecl name) where
785 = hsep [ptext (sLit "derived instance"), ppr ty]
788 %************************************************************************
790 \subsection[DefaultDecl]{A @default@ declaration}
792 %************************************************************************
794 There can only be one default declaration per module, but it is hard
795 for the parser to check that; we pass them all through in the abstract
796 syntax, and that restriction must be checked in the front end.
799 type LDefaultDecl name = Located (DefaultDecl name)
801 data DefaultDecl name
802 = DefaultDecl [LHsType name]
804 instance (OutputableBndr name)
805 => Outputable (DefaultDecl name) where
807 ppr (DefaultDecl tys)
808 = ptext (sLit "default") <+> parens (interpp'SP tys)
811 %************************************************************************
813 \subsection{Foreign function interface declaration}
815 %************************************************************************
819 -- foreign declarations are distinguished as to whether they define or use a
822 -- * the Boolean value indicates whether the pre-standard deprecated syntax
825 type LForeignDecl name = Located (ForeignDecl name)
827 data ForeignDecl name
828 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
829 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
831 -- Specification Of an imported external entity in dependence on the calling
834 data ForeignImport = -- import of a C entity
836 -- * the two strings specifying a header file or library
837 -- may be empty, which indicates the absence of a
838 -- header or object specification (both are not used
839 -- in the case of `CWrapper' and when `CFunction'
840 -- has a dynamic target)
842 -- * the calling convention is irrelevant for code
843 -- generation in the case of `CLabel', but is needed
844 -- for pretty printing
846 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
848 CImport CCallConv -- ccall or stdcall
849 Safety -- safe or unsafe
850 FastString -- name of C header
851 FastString -- name of library object
852 CImportSpec -- details of the C entity
854 -- import of a .NET function
856 | DNImport DNCallSpec
858 -- details of an external C entity
860 data CImportSpec = CLabel CLabelString -- import address of a C label
861 | CFunction CCallTarget -- static or dynamic function
862 | CWrapper -- wrapper to expose closures
865 -- specification of an externally exported entity in dependence on the calling
868 data ForeignExport = CExport CExportSpec -- contains the calling convention
869 | DNExport -- presently unused
871 -- abstract type imported from .NET
873 data FoType = DNType -- In due course we'll add subtype stuff
874 deriving (Eq) -- Used for equality instance for TyClDecl
877 -- pretty printing of foreign declarations
880 instance OutputableBndr name => Outputable (ForeignDecl name) where
881 ppr (ForeignImport n ty fimport) =
882 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
883 2 (dcolon <+> ppr ty)
884 ppr (ForeignExport n ty fexport) =
885 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
886 2 (dcolon <+> ppr ty)
888 instance Outputable ForeignImport where
889 ppr (DNImport spec) =
890 ptext (sLit "dotnet") <+> ppr spec
891 ppr (CImport cconv safety header lib spec) =
892 ppr cconv <+> ppr safety <+>
893 char '"' <> pprCEntity header lib spec <> char '"'
895 pprCEntity header lib (CLabel lbl) =
896 ptext (sLit "static") <+> ftext header <+> char '&' <>
897 pprLib lib <> ppr lbl
898 pprCEntity header lib (CFunction (StaticTarget lbl)) =
899 ptext (sLit "static") <+> ftext header <+> char '&' <>
900 pprLib lib <> ppr lbl
901 pprCEntity _ _ (CFunction (DynamicTarget)) =
902 ptext (sLit "dynamic")
903 pprCEntity _ _ (CWrapper) = ptext (sLit "wrapper")
905 pprLib lib | nullFS lib = empty
906 | otherwise = char '[' <> ppr lib <> char ']'
908 instance Outputable ForeignExport where
909 ppr (CExport (CExportStatic lbl cconv)) =
910 ppr cconv <+> char '"' <> ppr lbl <> char '"'
912 ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
914 instance Outputable FoType where
915 ppr DNType = ptext (sLit "type dotnet")
919 %************************************************************************
921 \subsection{Transformation rules}
923 %************************************************************************
926 type LRuleDecl name = Located (RuleDecl name)
929 = HsRule -- Source rule
930 RuleName -- Rule name
932 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
933 (Located (HsExpr name)) -- LHS
934 NameSet -- Free-vars from the LHS
935 (Located (HsExpr name)) -- RHS
936 NameSet -- Free-vars from the RHS
939 = RuleBndr (Located name)
940 | RuleBndrSig (Located name) (LHsType name)
942 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
943 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
945 instance OutputableBndr name => Outputable (RuleDecl name) where
946 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
947 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
948 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
949 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
951 pp_forall | null ns = empty
952 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
954 instance OutputableBndr name => Outputable (RuleBndr name) where
955 ppr (RuleBndr name) = ppr name
956 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
959 %************************************************************************
961 \subsection[DocDecl]{Document comments}
963 %************************************************************************
967 type LDocDecl name = Located (DocDecl name)
970 = DocCommentNext (HsDoc name)
971 | DocCommentPrev (HsDoc name)
972 | DocCommentNamed String (HsDoc name)
973 | DocGroup Int (HsDoc name)
975 -- Okay, I need to reconstruct the document comments, but for now:
976 instance Outputable (DocDecl name) where
977 ppr _ = text "<document comment>"
979 docDeclDoc :: DocDecl name -> HsDoc name
980 docDeclDoc (DocCommentNext d) = d
981 docDeclDoc (DocCommentPrev d) = d
982 docDeclDoc (DocCommentNamed _ d) = d
983 docDeclDoc (DocGroup _ d) = d
987 %************************************************************************
989 \subsection[DeprecDecl]{Deprecations}
991 %************************************************************************
993 We use exported entities for things to deprecate.
996 type LWarnDecl name = Located (WarnDecl name)
998 data WarnDecl name = Warning name WarningTxt
1000 instance OutputableBndr name => Outputable (WarnDecl name) where
1001 ppr (Warning thing txt)
1002 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]