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
49 import {- Kind parts of -} Type
60 import Data.Maybe ( isJust )
63 %************************************************************************
65 \subsection[HsDecl]{Declarations}
67 %************************************************************************
70 type LHsDecl id = Located (HsDecl id)
75 | DerivD (DerivDecl id)
78 | DefD (DefaultDecl id)
79 | ForD (ForeignDecl id)
80 | WarningD (WarnDecl id)
82 | SpliceD (SpliceDecl id)
86 -- NB: all top-level fixity decls are contained EITHER
88 -- OR in the ClassDecls in TyClDs
91 -- a) data constructors
92 -- b) class methods (but they can be also done in the
93 -- signatures of class decls)
94 -- c) imported functions (that have an IfacSig)
97 -- The latter is for class methods only
99 -- A [HsDecl] is categorised into a HsGroup before being
100 -- fed to the renamer.
103 hs_valds :: HsValBinds id,
104 hs_tyclds :: [LTyClDecl id],
105 hs_instds :: [LInstDecl id],
106 hs_derivds :: [LDerivDecl id],
108 hs_fixds :: [LFixitySig id],
109 -- Snaffled out of both top-level fixity signatures,
110 -- and those in class declarations
112 hs_defds :: [LDefaultDecl id],
113 hs_fords :: [LForeignDecl id],
114 hs_warnds :: [LWarnDecl id],
115 hs_ruleds :: [LRuleDecl id],
117 hs_docs :: [LDocDecl id]
120 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
121 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
122 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
124 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
125 hs_fixds = [], hs_defds = [], hs_fords = [],
126 hs_warnds = [], hs_ruleds = [],
127 hs_valds = error "emptyGroup hs_valds: Can't happen",
130 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
133 hs_valds = val_groups1,
136 hs_derivds = derivds1,
144 hs_valds = val_groups2,
147 hs_derivds = derivds2,
156 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
157 hs_tyclds = tyclds1 ++ tyclds2,
158 hs_instds = instds1 ++ instds2,
159 hs_derivds = derivds1 ++ derivds2,
160 hs_fixds = fixds1 ++ fixds2,
161 hs_defds = defds1 ++ defds2,
162 hs_fords = fords1 ++ fords2,
163 hs_warnds = warnds1 ++ warnds2,
164 hs_ruleds = rulds1 ++ rulds2,
165 hs_docs = docs1 ++ docs2 }
169 instance OutputableBndr name => Outputable (HsDecl name) where
170 ppr (TyClD dcl) = ppr dcl
171 ppr (ValD binds) = ppr binds
172 ppr (DefD def) = ppr def
173 ppr (InstD inst) = ppr inst
174 ppr (DerivD deriv) = ppr deriv
175 ppr (ForD fd) = ppr fd
176 ppr (SigD sd) = ppr sd
177 ppr (RuleD rd) = ppr rd
178 ppr (WarningD wd) = ppr wd
179 ppr (SpliceD dd) = ppr dd
180 ppr (DocD doc) = ppr doc
182 instance OutputableBndr name => Outputable (HsGroup name) where
183 ppr (HsGroup { hs_valds = val_decls,
184 hs_tyclds = tycl_decls,
185 hs_instds = inst_decls,
186 hs_derivds = deriv_decls,
187 hs_fixds = fix_decls,
188 hs_warnds = deprec_decls,
189 hs_fords = foreign_decls,
190 hs_defds = default_decls,
191 hs_ruleds = rule_decls })
192 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
193 ppr_ds deprec_decls, ppr_ds rule_decls,
195 ppr_ds tycl_decls, ppr_ds inst_decls,
197 ppr_ds foreign_decls]
200 ppr_ds ds = text "" $$ vcat (map ppr ds)
202 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
204 instance OutputableBndr name => Outputable (SpliceDecl name) where
205 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
209 %************************************************************************
211 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
213 %************************************************************************
215 --------------------------------
217 --------------------------------
219 Here is the story about the implicit names that go with type, class,
220 and instance decls. It's a bit tricky, so pay attention!
222 "Implicit" (or "system") binders
223 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
224 Each data type decl defines
225 a worker name for each constructor
226 to-T and from-T convertors
227 Each class decl defines
228 a tycon for the class
229 a data constructor for that tycon
230 the worker for that constructor
231 a selector for each superclass
233 All have occurrence names that are derived uniquely from their parent
236 None of these get separate definitions in an interface file; they are
237 fully defined by the data or class decl. But they may *occur* in
238 interface files, of course. Any such occurrence must haul in the
239 relevant type or class decl.
242 - Ensure they "point to" the parent data/class decl
243 when loading that decl from an interface file
244 (See RnHiFiles.getSysBinders)
246 - When typechecking the decl, we build the implicit TyCons and Ids.
247 When doing so we look them up in the name cache (RnEnv.lookupSysName),
248 to ensure correct module and provenance is set
250 These are the two places that we have to conjure up the magic derived
251 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
255 - Occurrence name is derived uniquely from the method name
258 - If there is a default method name at all, it's recorded in
259 the ClassOpSig (in HsBinds), in the DefMeth field.
260 (DefMeth is defined in Class.lhs)
262 Source-code class decls and interface-code class decls are treated subtly
263 differently, which has given me a great deal of confusion over the years.
264 Here's the deal. (We distinguish the two cases because source-code decls
265 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
267 In *source-code* class declarations:
269 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
270 This is done by RdrHsSyn.mkClassOpSigDM
272 - The renamer renames it to a Name
274 - During typechecking, we generate a binding for each $dm for
275 which there's a programmer-supplied default method:
280 We generate a binding for $dmop1 but not for $dmop2.
281 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
282 The Name for $dmop2 is simply discarded.
284 In *interface-file* class declarations:
285 - When parsing, we see if there's an explicit programmer-supplied default method
286 because there's an '=' sign to indicate it:
288 op1 = :: <type> -- NB the '='
290 We use this info to generate a DefMeth with a suitable RdrName for op1,
291 and a NoDefMeth for op2
292 - The interface file has a separate definition for $dmop1, with unfolding etc.
293 - The renamer renames it to a Name.
294 - The renamer treats $dmop1 as a free variable of the declaration, so that
295 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
296 This doesn't happen for source code class decls, because they *bind* the default method.
300 Each instance declaration gives rise to one dictionary function binding.
302 The type checker makes up new source-code instance declarations
303 (e.g. from 'deriving' or generic default methods --- see
304 TcInstDcls.tcInstDecls1). So we can't generate the names for
305 dictionary functions in advance (we don't know how many we need).
307 On the other hand for interface-file instance declarations, the decl
308 specifies the name of the dictionary function, and it has a binding elsewhere
309 in the interface file:
310 instance {Eq Int} = dEqInt
311 dEqInt :: {Eq Int} <pragma info>
313 So again we treat source code and interface file code slightly differently.
316 - Source code instance decls have a Nothing in the (Maybe name) field
317 (see data InstDecl below)
319 - The typechecker makes up a Local name for the dict fun for any source-code
320 instance decl, whether it comes from a source-code instance decl, or whether
321 the instance decl is derived from some other construct (e.g. 'deriving').
323 - The occurrence name it chooses is derived from the instance decl (just for
324 documentation really) --- e.g. dNumInt. Two dict funs may share a common
325 occurrence name, but will have different uniques. E.g.
326 instance Foo [Int] where ...
327 instance Foo [Bool] where ...
328 These might both be dFooList
330 - The CoreTidy phase externalises the name, and ensures the occurrence name is
331 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
333 - We can take this relaxed approach (changing the occurrence name later)
334 because dict fun Ids are not captured in a TyCon or Class (unlike default
335 methods, say). Instead, they are kept separately in the InstEnv. This
336 makes it easy to adjust them after compiling a module. (Once we've finished
337 compiling that module, they don't change any more.)
341 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
342 in the (Maybe name) field.
344 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
345 suck in the dfun binding
349 -- Representation of indexed types
350 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
351 -- Family kind signatures are represented by the variant `TyFamily'. It
352 -- covers "type family", "newtype family", and "data family" declarations,
353 -- distinguished by the value of the field `tcdFlavour'.
355 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
356 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
358 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
359 -- synonym declaration and 'tcdVars' contains the type parameters of the
362 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
363 -- 'pats' are type patterns for the type-indexes of the type constructor
364 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
365 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
366 -- *not* 'length tcdVars'.
368 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
370 type LTyClDecl name = Located (TyClDecl name)
374 tcdLName :: Located name,
375 tcdExtName :: Maybe FastString,
379 -- type/data/newtype family T :: *->*
380 | TyFamily { tcdFlavour:: FamilyFlavour, -- type, new, or data
381 tcdLName :: Located name, -- type constructor
382 tcdTyVars :: [LHsTyVarBndr name], -- type variables
383 tcdKind :: Maybe Kind -- result kind
386 -- Declares a data type or newtype, giving its construcors
387 -- data/newtype T a = <constrs>
388 -- data/newtype instance T [a] = <constrs>
389 | TyData { tcdND :: NewOrData,
390 tcdCtxt :: LHsContext name, -- Context
391 tcdLName :: Located name, -- Type constructor
393 tcdTyVars :: [LHsTyVarBndr name], -- Type variables
395 tcdTyPats :: Maybe [LHsType name], -- Type patterns
396 -- Just [t1..tn] for data instance T t1..tn = ...
397 -- in this case tcdTyVars = fv( tcdTyPats )
398 -- Nothing for everything else
400 tcdKindSig:: Maybe Kind, -- Optional kind sig
401 -- (Just k) for a GADT-style 'data', or 'data
402 -- instance' decl with explicit kind sig
404 tcdCons :: [LConDecl name], -- Data constructors
405 -- For data T a = T1 | T2 a
406 -- the LConDecls all have ResTyH98
407 -- For data T a where { T1 :: T a }
408 -- the LConDecls all have ResTyGADT
410 tcdDerivs :: Maybe [LHsType name]
411 -- Derivings; Nothing => not specified
412 -- Just [] => derive exactly what is asked
413 -- These "types" must be of form
414 -- forall ab. C ty1 ty2
415 -- Typically the foralls and ty args are empty, but they
416 -- are non-empty for the newtype-deriving case
419 | TySynonym { tcdLName :: Located name, -- type constructor
420 tcdTyVars :: [LHsTyVarBndr name], -- type variables
421 tcdTyPats :: Maybe [LHsType name], -- Type patterns
422 -- See comments for tcdTyPats in TyData
423 -- 'Nothing' => vanilla type synonym
425 tcdSynRhs :: LHsType name -- synonym expansion
428 | ClassDecl { tcdCtxt :: LHsContext name, -- Context...
429 tcdLName :: Located name, -- Name of the class
430 tcdTyVars :: [LHsTyVarBndr name], -- Class type variables
431 tcdFDs :: [Located (FunDep name)], -- Functional deps
432 tcdSigs :: [LSig name], -- Methods' signatures
433 tcdMeths :: LHsBinds name, -- Default methods
434 tcdATs :: [LTyClDecl name], -- Associated types; ie
435 -- only 'TyFamily' and
437 -- latter for defaults
438 tcdDocs :: [LDocDecl name] -- Haddock docs
442 = NewType -- "newtype Blah ..."
443 | DataType -- "data Blah ..."
444 deriving( Eq ) -- Needed because Demand derives Eq
447 = TypeFamily -- "type family ..."
448 | DataFamily -- "data family ..."
454 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl ::
455 TyClDecl name -> Bool
457 -- data/newtype or data/newtype instance declaration
458 isDataDecl (TyData {}) = True
459 isDataDecl _other = False
461 -- type or type instance declaration
462 isTypeDecl (TySynonym {}) = True
463 isTypeDecl _other = False
465 -- vanilla Haskell type synonym (ie, not a type instance)
466 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
467 isSynDecl _other = False
470 isClassDecl (ClassDecl {}) = True
471 isClassDecl _ = False
473 -- type family declaration
474 isFamilyDecl (TyFamily {}) = True
475 isFamilyDecl _other = False
477 -- family instance (types, newtypes, and data types)
480 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
487 tcdName :: TyClDecl name -> name
488 tcdName decl = unLoc (tcdLName decl)
490 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
491 -- Returns all the *binding* names of the decl, along with their SrcLocs
492 -- The first one is guaranteed to be the name of the decl
493 -- For record fields, the first one counts as the SrcLoc
494 -- We use the equality to filter out duplicate field names
496 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
497 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
498 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
500 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
502 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
504 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
505 = tc_name : conDeclsNames (map unLoc cons)
507 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
508 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
509 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
510 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
511 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
512 tyClDeclTyVars (ForeignType {}) = []
516 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
517 -- class, synonym decls, data, newtype, family decls, family instances
519 = (count isClassDecl decls,
520 count isSynDecl decls, -- excluding...
521 count isDataTy decls, -- ...family...
522 count isNewTy decls, -- ...instances
523 count isFamilyDecl decls,
524 count isFamInstDecl decls)
526 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
529 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
534 instance OutputableBndr name
535 => Outputable (TyClDecl name) where
537 ppr (ForeignType {tcdLName = ltycon})
538 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
540 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
541 tcdTyVars = tyvars, tcdKind = mb_kind})
542 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
544 pp_flavour = case flavour of
545 TypeFamily -> ptext (sLit "type family")
546 DataFamily -> ptext (sLit "data family")
548 pp_kind = case mb_kind of
550 Just kind -> dcolon <+> pprKind kind
552 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
553 tcdSynRhs = mono_ty})
554 = hang (ptext (sLit "type") <+>
555 (if isJust typats then ptext (sLit "instance") else empty) <+>
556 pp_decl_head [] ltycon tyvars typats <+>
560 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
561 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
562 tcdCons = condecls, tcdDerivs = derivings})
563 = pp_tydecl (null condecls && isJust mb_sig)
565 (if isJust typats then ptext (sLit "instance") else empty) <+>
566 pp_decl_head (unLoc context) ltycon tyvars typats <+>
568 (pp_condecls condecls)
571 ppr_sig Nothing = empty
572 ppr_sig (Just kind) = dcolon <+> pprKind kind
574 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
576 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
577 | null sigs && null ats -- No "where" part
580 | otherwise -- Laid out
581 = sep [hsep [top_matter, ptext (sLit "where {")],
582 nest 4 (sep [ sep (map ppr_semi ats)
583 , sep (map ppr_semi sigs)
584 , pprLHsBinds methods
587 top_matter = ptext (sLit "class")
588 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
589 <+> pprFundeps (map unLoc fds)
590 ppr_semi decl = ppr decl <> semi
592 pp_decl_head :: OutputableBndr name
595 -> [LHsTyVarBndr name]
596 -> Maybe [LHsType name]
598 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
599 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
600 pp_decl_head context thing _ (Just typats) -- explicit type patterns
601 = hsep [ pprHsContext context, ppr thing
602 , hsep (map (pprParendHsType.unLoc) typats)]
604 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
605 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
606 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
607 pp_condecls cs -- In H98 syntax
608 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
610 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
611 pp_tydecl True pp_head _ _
613 pp_tydecl False pp_head pp_decl_rhs derivings
614 = hang pp_head 4 (sep [
618 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
621 instance Outputable NewOrData where
622 ppr NewType = ptext (sLit "newtype")
623 ppr DataType = ptext (sLit "data")
627 %************************************************************************
629 \subsection[ConDecl]{A data-constructor declaration}
631 %************************************************************************
634 type LConDecl name = Located (ConDecl name)
636 -- data T b = forall a. Eq a => MkT a b
637 -- MkT :: forall b a. Eq a => MkT a b
640 -- MkT1 :: Int -> T Int
642 -- data T = Int `MkT` Int
646 -- Int `MkT` Int :: T Int
650 { con_name :: Located name -- Constructor name; this is used for the
651 -- DataCon itself, and for the user-callable wrapper Id
653 , con_explicit :: HsExplicitForAll -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
655 , con_qvars :: [LHsTyVarBndr name] -- ResTyH98: the constructor's existential type variables
656 -- ResTyGADT: all the constructor's quantified type variables
658 , con_cxt :: LHsContext name -- The context. This *does not* include the
659 -- "stupid theta" which lives only in the TyData decl
661 , con_details :: HsConDeclDetails name -- The main payload
663 , con_res :: ResType name -- Result type of the constructor
665 , con_doc :: Maybe (LHsDoc name) -- A possible Haddock comment
668 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
670 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
671 hsConDeclArgTys (PrefixCon tys) = tys
672 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
673 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
675 data ConDeclField name -- Record fields have Haddoc docs on them
676 = ConDeclField { cd_fld_name :: Located name,
677 cd_fld_type :: LBangType name,
678 cd_fld_doc :: Maybe (LHsDoc name) }
681 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
682 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
683 -- and here is its result type
687 conDeclsNames :: (Eq name) => [ConDecl name] -> [Located name]
688 -- See tyClDeclNames for what this does
689 -- The function is boringly complicated because of the records
690 -- And since we only have equality, we have to be a little careful
692 = snd (foldl do_one ([], []) cons)
694 do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
695 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
697 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
698 (map cd_fld_name flds)
700 do_one (flds_seen, acc) c
701 = (flds_seen, (con_name c):acc)
706 instance (OutputableBndr name) => Outputable (ConDecl name) where
709 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
710 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
711 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
713 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
714 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
715 ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
717 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
718 = ppr con <+> dcolon <+>
719 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
721 mk_fun_ty a b = noLoc (HsFunTy a b)
723 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
724 = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
726 pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
727 = pprPanic "pprConDecl" (ppr con)
728 -- In GADT syntax we don't allow infix constructors
731 ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
732 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
734 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
736 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
739 %************************************************************************
741 \subsection[InstDecl]{An instance declaration
743 %************************************************************************
746 type LInstDecl name = Located (InstDecl name)
749 = InstDecl (LHsType name) -- Context => Class Instance-type
750 -- Using a polytype means that the renamer conveniently
751 -- figures out the quantified type variables for us.
753 [LSig name] -- User-supplied pragmatic info
754 [LTyClDecl name]-- Associated types (ie, 'TyData' and
757 instance (OutputableBndr name) => Outputable (InstDecl name) where
759 ppr (InstDecl inst_ty binds uprags ats)
760 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
761 , nest 4 $ vcat (map ppr ats)
762 , nest 4 $ vcat (map ppr uprags)
763 , nest 4 $ pprLHsBinds binds ]
765 -- Extract the declarations of associated types from an instance
767 instDeclATs :: InstDecl name -> [LTyClDecl name]
768 instDeclATs (InstDecl _ _ _ ats) = ats
771 %************************************************************************
773 \subsection[DerivDecl]{A stand-alone instance deriving declaration
775 %************************************************************************
778 type LDerivDecl name = Located (DerivDecl name)
780 data DerivDecl name = DerivDecl (LHsType name)
782 instance (OutputableBndr name) => Outputable (DerivDecl name) where
784 = hsep [ptext (sLit "derived instance"), ppr ty]
787 %************************************************************************
789 \subsection[DefaultDecl]{A @default@ declaration}
791 %************************************************************************
793 There can only be one default declaration per module, but it is hard
794 for the parser to check that; we pass them all through in the abstract
795 syntax, and that restriction must be checked in the front end.
798 type LDefaultDecl name = Located (DefaultDecl name)
800 data DefaultDecl name
801 = DefaultDecl [LHsType name]
803 instance (OutputableBndr name)
804 => Outputable (DefaultDecl name) where
806 ppr (DefaultDecl tys)
807 = ptext (sLit "default") <+> parens (interpp'SP tys)
810 %************************************************************************
812 \subsection{Foreign function interface declaration}
814 %************************************************************************
818 -- foreign declarations are distinguished as to whether they define or use a
821 -- * the Boolean value indicates whether the pre-standard deprecated syntax
824 type LForeignDecl name = Located (ForeignDecl name)
826 data ForeignDecl name
827 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
828 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
830 -- Specification Of an imported external entity in dependence on the calling
833 data ForeignImport = -- import of a C entity
835 -- * the two strings specifying a header file or library
836 -- may be empty, which indicates the absence of a
837 -- header or object specification (both are not used
838 -- in the case of `CWrapper' and when `CFunction'
839 -- has a dynamic target)
841 -- * the calling convention is irrelevant for code
842 -- generation in the case of `CLabel', but is needed
843 -- for pretty printing
845 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
847 CImport CCallConv -- ccall or stdcall
848 Safety -- safe or unsafe
849 FastString -- name of C header
850 FastString -- name of library object
851 CImportSpec -- details of the C entity
853 -- import of a .NET function
855 | DNImport DNCallSpec
857 -- details of an external C entity
859 data CImportSpec = CLabel CLabelString -- import address of a C label
860 | CFunction CCallTarget -- static or dynamic function
861 | CWrapper -- wrapper to expose closures
864 -- specification of an externally exported entity in dependence on the calling
867 data ForeignExport = CExport CExportSpec -- contains the calling convention
868 | DNExport -- presently unused
870 -- abstract type imported from .NET
872 data FoType = DNType -- In due course we'll add subtype stuff
873 deriving (Eq) -- Used for equality instance for TyClDecl
876 -- pretty printing of foreign declarations
879 instance OutputableBndr name => Outputable (ForeignDecl name) where
880 ppr (ForeignImport n ty fimport) =
881 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
882 2 (dcolon <+> ppr ty)
883 ppr (ForeignExport n ty fexport) =
884 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
885 2 (dcolon <+> ppr ty)
887 instance Outputable ForeignImport where
888 ppr (DNImport spec) =
889 ptext (sLit "dotnet") <+> ppr spec
890 ppr (CImport cconv safety header lib spec) =
891 ppr cconv <+> ppr safety <+>
892 char '"' <> pprCEntity header lib spec <> char '"'
894 pprCEntity header lib (CLabel lbl) =
895 ptext (sLit "static") <+> ftext header <+> char '&' <>
896 pprLib lib <> ppr lbl
897 pprCEntity header lib (CFunction (StaticTarget lbl)) =
898 ptext (sLit "static") <+> ftext header <+> char '&' <>
899 pprLib lib <> ppr lbl
900 pprCEntity _ _ (CFunction (DynamicTarget)) =
901 ptext (sLit "dynamic")
902 pprCEntity _ _ (CWrapper) = ptext (sLit "wrapper")
904 pprLib lib | nullFS lib = empty
905 | otherwise = char '[' <> ppr lib <> char ']'
907 instance Outputable ForeignExport where
908 ppr (CExport (CExportStatic lbl cconv)) =
909 ppr cconv <+> char '"' <> ppr lbl <> char '"'
911 ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
913 instance Outputable FoType where
914 ppr DNType = ptext (sLit "type dotnet")
918 %************************************************************************
920 \subsection{Transformation rules}
922 %************************************************************************
925 type LRuleDecl name = Located (RuleDecl name)
928 = HsRule -- Source rule
929 RuleName -- Rule name
931 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
932 (Located (HsExpr name)) -- LHS
933 NameSet -- Free-vars from the LHS
934 (Located (HsExpr name)) -- RHS
935 NameSet -- Free-vars from the RHS
938 = RuleBndr (Located name)
939 | RuleBndrSig (Located name) (LHsType name)
941 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
942 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
944 instance OutputableBndr name => Outputable (RuleDecl name) where
945 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
946 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
947 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
948 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
950 pp_forall | null ns = empty
951 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
953 instance OutputableBndr name => Outputable (RuleBndr name) where
954 ppr (RuleBndr name) = ppr name
955 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
958 %************************************************************************
960 \subsection[DocDecl]{Document comments}
962 %************************************************************************
966 type LDocDecl name = Located (DocDecl name)
969 = DocCommentNext (HsDoc name)
970 | DocCommentPrev (HsDoc name)
971 | DocCommentNamed String (HsDoc name)
972 | DocGroup Int (HsDoc name)
974 -- Okay, I need to reconstruct the document comments, but for now:
975 instance Outputable (DocDecl name) where
976 ppr _ = text "<document comment>"
978 docDeclDoc :: DocDecl name -> HsDoc name
979 docDeclDoc (DocCommentNext d) = d
980 docDeclDoc (DocCommentPrev d) = d
981 docDeclDoc (DocCommentNamed _ d) = d
982 docDeclDoc (DocGroup _ d) = d
986 %************************************************************************
988 \subsection[DeprecDecl]{Deprecations}
990 %************************************************************************
992 We use exported entities for things to deprecate.
995 type LWarnDecl name = Located (WarnDecl name)
997 data WarnDecl name = Warning name WarningTxt
999 instance OutputableBndr name => Outputable (WarnDecl name) where
1000 ppr (Warning thing txt)
1001 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]