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,
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 _ = 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 :: TyClDecl name -> [LHsTyVarBndr name]
512 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
513 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
514 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
515 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
516 tyClDeclTyVars (ForeignType {}) = []
520 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
521 -- class, synonym decls, data, newtype, family decls, family instances
523 = (count isClassDecl decls,
524 count isSynDecl decls, -- excluding...
525 count isDataTy decls, -- ...family...
526 count isNewTy decls, -- ...instances
527 count isFamilyDecl decls,
528 count isFamInstDecl decls)
530 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
533 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
538 instance OutputableBndr name
539 => Outputable (TyClDecl name) where
541 ppr (ForeignType {tcdLName = ltycon})
542 = hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
544 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
545 tcdTyVars = tyvars, tcdKind = mb_kind})
546 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
548 pp_flavour = case flavour of
549 TypeFamily -> ptext SLIT("type family")
550 DataFamily -> ptext SLIT("data family")
552 pp_kind = case mb_kind of
554 Just kind -> dcolon <+> pprKind kind
556 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
557 tcdSynRhs = mono_ty})
558 = hang (ptext SLIT("type") <+>
559 (if isJust typats then ptext SLIT("instance") else empty) <+>
560 pp_decl_head [] ltycon tyvars typats <+>
564 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
565 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
566 tcdCons = condecls, tcdDerivs = derivings})
567 = pp_tydecl (null condecls && isJust mb_sig)
569 (if isJust typats then ptext SLIT("instance") else empty) <+>
570 pp_decl_head (unLoc context) ltycon tyvars typats <+>
572 (pp_condecls condecls)
575 ppr_sig Nothing = empty
576 ppr_sig (Just kind) = dcolon <+> pprKind kind
578 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
580 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
581 | null sigs && null ats -- No "where" part
584 | otherwise -- Laid out
585 = sep [hsep [top_matter, ptext SLIT("where {")],
586 nest 4 (sep [ sep (map ppr_semi ats)
587 , sep (map ppr_semi sigs)
588 , pprLHsBinds methods
591 top_matter = ptext SLIT("class")
592 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
593 <+> pprFundeps (map unLoc fds)
594 ppr_semi decl = ppr decl <> semi
596 pp_decl_head :: OutputableBndr name
599 -> [LHsTyVarBndr name]
600 -> Maybe [LHsType name]
602 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
603 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
604 pp_decl_head context thing _ (Just typats) -- explicit type patterns
605 = hsep [ pprHsContext context, ppr thing
606 , hsep (map (pprParendHsType.unLoc) typats)]
608 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
609 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
610 = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
611 pp_condecls cs -- In H98 syntax
612 = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
614 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
615 pp_tydecl True pp_head _ _
617 pp_tydecl False pp_head pp_decl_rhs derivings
618 = hang pp_head 4 (sep [
622 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
625 instance Outputable NewOrData where
626 ppr NewType = ptext SLIT("newtype")
627 ppr DataType = ptext SLIT("data")
631 %************************************************************************
633 \subsection[ConDecl]{A data-constructor declaration}
635 %************************************************************************
638 type LConDecl name = Located (ConDecl name)
640 -- data T b = forall a. Eq a => MkT a b
641 -- MkT :: forall b a. Eq a => MkT a b
644 -- MkT1 :: Int -> T Int
646 -- data T = Int `MkT` Int
650 -- Int `MkT` Int :: T Int
654 { con_name :: Located name -- Constructor name; this is used for the
655 -- DataCon itself, and for the user-callable wrapper Id
657 , con_explicit :: HsExplicitForAll -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
659 , con_qvars :: [LHsTyVarBndr name] -- ResTyH98: the constructor's existential type variables
660 -- ResTyGADT: all the constructor's quantified type variables
662 , con_cxt :: LHsContext name -- The context. This *does not* include the
663 -- "stupid theta" which lives only in the TyData decl
665 , con_details :: HsConDeclDetails name -- The main payload
667 , con_res :: ResType name -- Result type of the constructor
669 , con_doc :: Maybe (LHsDoc name) -- A possible Haddock comment
672 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
674 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
675 hsConDeclArgTys (PrefixCon tys) = tys
676 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
677 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
679 data ConDeclField name -- Record fields have Haddoc docs on them
680 = ConDeclField { cd_fld_name :: Located name,
681 cd_fld_type :: LBangType name,
682 cd_fld_doc :: Maybe (LHsDoc name) }
685 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
686 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
687 -- and here is its result type
691 conDeclsNames :: (Eq name) => [ConDecl name] -> [Located name]
692 -- See tyClDeclNames for what this does
693 -- The function is boringly complicated because of the records
694 -- And since we only have equality, we have to be a little careful
696 = snd (foldl do_one ([], []) cons)
698 do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
699 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
701 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
702 (map cd_fld_name flds)
704 do_one (flds_seen, acc) c
705 = (flds_seen, (con_name c):acc)
710 instance (OutputableBndr name) => Outputable (ConDecl name) where
713 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
714 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
715 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
717 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
718 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
719 ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
721 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
722 = ppr con <+> dcolon <+>
723 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
725 mk_fun_ty a b = noLoc (HsFunTy a b)
727 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
728 = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
730 pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
731 = pprPanic "pprConDecl" (ppr con)
732 -- In GADT syntax we don't allow infix constructors
735 ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
736 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
738 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
740 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
743 %************************************************************************
745 \subsection[InstDecl]{An instance declaration
747 %************************************************************************
750 type LInstDecl name = Located (InstDecl name)
753 = InstDecl (LHsType name) -- Context => Class Instance-type
754 -- Using a polytype means that the renamer conveniently
755 -- figures out the quantified type variables for us.
757 [LSig name] -- User-supplied pragmatic info
758 [LTyClDecl name]-- Associated types (ie, 'TyData' and
761 instance (OutputableBndr name) => Outputable (InstDecl name) where
763 ppr (InstDecl inst_ty binds uprags ats)
764 = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")]
765 , nest 4 $ vcat (map ppr ats)
766 , nest 4 $ vcat (map ppr uprags)
767 , nest 4 $ pprLHsBinds binds ]
769 -- Extract the declarations of associated types from an instance
771 instDeclATs :: InstDecl name -> [LTyClDecl name]
772 instDeclATs (InstDecl _ _ _ ats) = ats
775 %************************************************************************
777 \subsection[DerivDecl]{A stand-alone instance deriving declaration
779 %************************************************************************
782 type LDerivDecl name = Located (DerivDecl name)
784 data DerivDecl name = DerivDecl (LHsType name)
786 instance (OutputableBndr name) => Outputable (DerivDecl name) where
788 = hsep [ptext SLIT("derived instance"), ppr ty]
791 %************************************************************************
793 \subsection[DefaultDecl]{A @default@ declaration}
795 %************************************************************************
797 There can only be one default declaration per module, but it is hard
798 for the parser to check that; we pass them all through in the abstract
799 syntax, and that restriction must be checked in the front end.
802 type LDefaultDecl name = Located (DefaultDecl name)
804 data DefaultDecl name
805 = DefaultDecl [LHsType name]
807 instance (OutputableBndr name)
808 => Outputable (DefaultDecl name) where
810 ppr (DefaultDecl tys)
811 = ptext SLIT("default") <+> parens (interpp'SP tys)
814 %************************************************************************
816 \subsection{Foreign function interface declaration}
818 %************************************************************************
822 -- foreign declarations are distinguished as to whether they define or use a
825 -- * the Boolean value indicates whether the pre-standard deprecated syntax
828 type LForeignDecl name = Located (ForeignDecl name)
830 data ForeignDecl name
831 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
832 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
834 -- Specification Of an imported external entity in dependence on the calling
837 data ForeignImport = -- import of a C entity
839 -- * the two strings specifying a header file or library
840 -- may be empty, which indicates the absence of a
841 -- header or object specification (both are not used
842 -- in the case of `CWrapper' and when `CFunction'
843 -- has a dynamic target)
845 -- * the calling convention is irrelevant for code
846 -- generation in the case of `CLabel', but is needed
847 -- for pretty printing
849 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
851 CImport CCallConv -- ccall or stdcall
852 Safety -- safe or unsafe
853 FastString -- name of C header
854 FastString -- name of library object
855 CImportSpec -- details of the C entity
857 -- import of a .NET function
859 | DNImport DNCallSpec
861 -- details of an external C entity
863 data CImportSpec = CLabel CLabelString -- import address of a C label
864 | CFunction CCallTarget -- static or dynamic function
865 | CWrapper -- wrapper to expose closures
868 -- specification of an externally exported entity in dependence on the calling
871 data ForeignExport = CExport CExportSpec -- contains the calling convention
872 | DNExport -- presently unused
874 -- abstract type imported from .NET
876 data FoType = DNType -- In due course we'll add subtype stuff
877 deriving (Eq) -- Used for equality instance for TyClDecl
880 -- pretty printing of foreign declarations
883 instance OutputableBndr name => Outputable (ForeignDecl name) where
884 ppr (ForeignImport n ty fimport) =
885 hang (ptext SLIT("foreign import") <+> ppr fimport <+> ppr n)
886 2 (dcolon <+> ppr ty)
887 ppr (ForeignExport n ty fexport) =
888 hang (ptext SLIT("foreign export") <+> ppr fexport <+> ppr n)
889 2 (dcolon <+> ppr ty)
891 instance Outputable ForeignImport where
892 ppr (DNImport spec) =
893 ptext SLIT("dotnet") <+> ppr spec
894 ppr (CImport cconv safety header lib spec) =
895 ppr cconv <+> ppr safety <+>
896 char '"' <> pprCEntity header lib spec <> char '"'
898 pprCEntity header lib (CLabel lbl) =
899 ptext SLIT("static") <+> ftext header <+> char '&' <>
900 pprLib lib <> ppr lbl
901 pprCEntity header lib (CFunction (StaticTarget lbl)) =
902 ptext SLIT("static") <+> ftext header <+> char '&' <>
903 pprLib lib <> ppr lbl
904 pprCEntity _ _ (CFunction (DynamicTarget)) =
905 ptext SLIT("dynamic")
906 pprCEntity _ _ (CWrapper) = ptext SLIT("wrapper")
908 pprLib lib | nullFS lib = empty
909 | otherwise = char '[' <> ppr lib <> char ']'
911 instance Outputable ForeignExport where
912 ppr (CExport (CExportStatic lbl cconv)) =
913 ppr cconv <+> char '"' <> ppr lbl <> char '"'
915 ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
917 instance Outputable FoType where
918 ppr DNType = ptext SLIT("type dotnet")
922 %************************************************************************
924 \subsection{Transformation rules}
926 %************************************************************************
929 type LRuleDecl name = Located (RuleDecl name)
932 = HsRule -- Source rule
933 RuleName -- Rule name
935 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
936 (Located (HsExpr name)) -- LHS
937 NameSet -- Free-vars from the LHS
938 (Located (HsExpr name)) -- RHS
939 NameSet -- Free-vars from the RHS
942 = RuleBndr (Located name)
943 | RuleBndrSig (Located name) (LHsType name)
945 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
946 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
948 instance OutputableBndr name => Outputable (RuleDecl name) where
949 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
950 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
951 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
952 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
954 pp_forall | null ns = empty
955 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
957 instance OutputableBndr name => Outputable (RuleBndr name) where
958 ppr (RuleBndr name) = ppr name
959 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
962 %************************************************************************
964 \subsection[DocDecl]{Document comments}
966 %************************************************************************
970 type LDocDecl name = Located (DocDecl name)
973 = DocCommentNext (HsDoc name)
974 | DocCommentPrev (HsDoc name)
975 | DocCommentNamed String (HsDoc name)
976 | DocGroup Int (HsDoc name)
978 -- Okay, I need to reconstruct the document comments, but for now:
979 instance Outputable (DocDecl name) where
980 ppr _ = text "<document comment>"
982 docDeclDoc :: DocDecl name -> HsDoc name
983 docDeclDoc (DocCommentNext d) = d
984 docDeclDoc (DocCommentPrev d) = d
985 docDeclDoc (DocCommentNamed _ d) = d
986 docDeclDoc (DocGroup _ d) = d
990 %************************************************************************
992 \subsection[DeprecDecl]{Deprecations}
994 %************************************************************************
996 We use exported entities for things to deprecate.
999 type LDeprecDecl name = Located (DeprecDecl name)
1001 data DeprecDecl name = Deprecation name DeprecTxt
1003 instance OutputableBndr name => Outputable (DeprecDecl name) where
1004 ppr (Deprecation thing txt)
1005 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]