2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
9 {-# OPTIONS -fno-warn-incomplete-patterns #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 {-# LANGUAGE DeriveDataTypeable #-}
17 -- | Abstract syntax of global declarations.
19 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
20 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
22 -- * Toplevel declarations
24 -- ** Class or type declarations
25 TyClDecl(..), LTyClDecl,
26 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
27 isFamInstDecl, tcdName, tyClDeclTyVars,
29 -- ** Instance declarations
30 InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
32 -- ** Standalone deriving declarations
33 DerivDecl(..), LDerivDecl,
34 -- ** @RULE@ declarations
35 RuleDecl(..), LRuleDecl, RuleBndr(..),
36 collectRuleBndrSigTys,
37 -- ** @default@ declarations
38 DefaultDecl(..), LDefaultDecl,
39 -- ** Top-level template haskell splice
41 -- ** Foreign function interface declarations
42 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
44 -- ** Data-constructor declarations
45 ConDecl(..), LConDecl, ResType(..),
46 HsConDeclDetails, hsConDeclArgTys,
47 -- ** Document comments
48 DocDecl(..), LDocDecl, docDeclDoc,
50 WarnDecl(..), LWarnDecl,
52 AnnDecl(..), LAnnDecl,
53 AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
56 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups
60 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
61 -- Because Expr imports Decls via HsBracket
68 import {- Kind parts of -} Type
79 import Control.Monad ( liftM )
81 import Data.Maybe ( isJust )
84 %************************************************************************
86 \subsection[HsDecl]{Declarations}
88 %************************************************************************
91 type LHsDecl id = Located (HsDecl id)
93 -- | A Haskell Declaration
95 = TyClD (TyClDecl id) -- ^ A type or class declaration.
96 | InstD (InstDecl id) -- ^ An instance declaration.
97 | DerivD (DerivDecl id)
100 | DefD (DefaultDecl id)
101 | ForD (ForeignDecl id)
102 | WarningD (WarnDecl id)
104 | RuleD (RuleDecl id)
105 | SpliceD (SpliceDecl id)
107 | QuasiQuoteD (HsQuasiQuote id)
108 deriving (Data, Typeable)
111 -- NB: all top-level fixity decls are contained EITHER
113 -- OR in the ClassDecls in TyClDs
116 -- a) data constructors
117 -- b) class methods (but they can be also done in the
118 -- signatures of class decls)
119 -- c) imported functions (that have an IfacSig)
120 -- d) top level decls
122 -- The latter is for class methods only
124 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
125 -- fed to the renamer.
128 hs_valds :: HsValBinds id,
129 hs_tyclds :: [LTyClDecl id],
130 hs_instds :: [LInstDecl id],
131 hs_derivds :: [LDerivDecl id],
133 hs_fixds :: [LFixitySig id],
134 -- Snaffled out of both top-level fixity signatures,
135 -- and those in class declarations
137 hs_defds :: [LDefaultDecl id],
138 hs_fords :: [LForeignDecl id],
139 hs_warnds :: [LWarnDecl id],
140 hs_annds :: [LAnnDecl id],
141 hs_ruleds :: [LRuleDecl id],
143 hs_docs :: [LDocDecl]
144 } deriving (Data, Typeable)
146 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
147 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
148 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
150 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
151 hs_fixds = [], hs_defds = [], hs_annds = [],
152 hs_fords = [], hs_warnds = [], hs_ruleds = [],
153 hs_valds = error "emptyGroup hs_valds: Can't happen",
156 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
159 hs_valds = val_groups1,
162 hs_derivds = derivds1,
171 hs_valds = val_groups2,
174 hs_derivds = derivds2,
184 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
185 hs_tyclds = tyclds1 ++ tyclds2,
186 hs_instds = instds1 ++ instds2,
187 hs_derivds = derivds1 ++ derivds2,
188 hs_fixds = fixds1 ++ fixds2,
189 hs_annds = annds1 ++ annds2,
190 hs_defds = defds1 ++ defds2,
191 hs_fords = fords1 ++ fords2,
192 hs_warnds = warnds1 ++ warnds2,
193 hs_ruleds = rulds1 ++ rulds2,
194 hs_docs = docs1 ++ docs2 }
198 instance OutputableBndr name => Outputable (HsDecl name) where
199 ppr (TyClD dcl) = ppr dcl
200 ppr (ValD binds) = ppr binds
201 ppr (DefD def) = ppr def
202 ppr (InstD inst) = ppr inst
203 ppr (DerivD deriv) = ppr deriv
204 ppr (ForD fd) = ppr fd
205 ppr (SigD sd) = ppr sd
206 ppr (RuleD rd) = ppr rd
207 ppr (WarningD wd) = ppr wd
208 ppr (AnnD ad) = ppr ad
209 ppr (SpliceD dd) = ppr dd
210 ppr (DocD doc) = ppr doc
211 ppr (QuasiQuoteD qq) = ppr qq
213 instance OutputableBndr name => Outputable (HsGroup name) where
214 ppr (HsGroup { hs_valds = val_decls,
215 hs_tyclds = tycl_decls,
216 hs_instds = inst_decls,
217 hs_derivds = deriv_decls,
218 hs_fixds = fix_decls,
219 hs_warnds = deprec_decls,
220 hs_annds = ann_decls,
221 hs_fords = foreign_decls,
222 hs_defds = default_decls,
223 hs_ruleds = rule_decls })
225 [ppr_ds fix_decls, ppr_ds default_decls,
226 ppr_ds deprec_decls, ppr_ds ann_decls,
228 if isEmptyValBinds val_decls
230 else Just (ppr val_decls),
231 ppr_ds tycl_decls, ppr_ds inst_decls,
233 ppr_ds foreign_decls]
236 ppr_ds ds = Just (vcat (map ppr ds))
238 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
239 -- Concatenate vertically with white-space between non-blanks
241 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
242 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
245 = SpliceDecl -- Top level splice
246 (Located (HsExpr id))
247 HsExplicitFlag -- Explicit <=> $(f x y)
248 -- Implicit <=> f x y, i.e. a naked top level expression
249 deriving (Data, Typeable)
251 instance OutputableBndr name => Outputable (SpliceDecl name) where
252 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
256 %************************************************************************
258 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
260 %************************************************************************
262 --------------------------------
264 --------------------------------
266 Here is the story about the implicit names that go with type, class,
267 and instance decls. It's a bit tricky, so pay attention!
269 "Implicit" (or "system") binders
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271 Each data type decl defines
272 a worker name for each constructor
273 to-T and from-T convertors
274 Each class decl defines
275 a tycon for the class
276 a data constructor for that tycon
277 the worker for that constructor
278 a selector for each superclass
280 All have occurrence names that are derived uniquely from their parent
283 None of these get separate definitions in an interface file; they are
284 fully defined by the data or class decl. But they may *occur* in
285 interface files, of course. Any such occurrence must haul in the
286 relevant type or class decl.
289 - Ensure they "point to" the parent data/class decl
290 when loading that decl from an interface file
291 (See RnHiFiles.getSysBinders)
293 - When typechecking the decl, we build the implicit TyCons and Ids.
294 When doing so we look them up in the name cache (RnEnv.lookupSysName),
295 to ensure correct module and provenance is set
297 These are the two places that we have to conjure up the magic derived
298 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
302 - Occurrence name is derived uniquely from the method name
305 - If there is a default method name at all, it's recorded in
306 the ClassOpSig (in HsBinds), in the DefMeth field.
307 (DefMeth is defined in Class.lhs)
309 Source-code class decls and interface-code class decls are treated subtly
310 differently, which has given me a great deal of confusion over the years.
311 Here's the deal. (We distinguish the two cases because source-code decls
312 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
314 In *source-code* class declarations:
316 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
317 This is done by RdrHsSyn.mkClassOpSigDM
319 - The renamer renames it to a Name
321 - During typechecking, we generate a binding for each $dm for
322 which there's a programmer-supplied default method:
327 We generate a binding for $dmop1 but not for $dmop2.
328 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
329 The Name for $dmop2 is simply discarded.
331 In *interface-file* class declarations:
332 - When parsing, we see if there's an explicit programmer-supplied default method
333 because there's an '=' sign to indicate it:
335 op1 = :: <type> -- NB the '='
337 We use this info to generate a DefMeth with a suitable RdrName for op1,
338 and a NoDefMeth for op2
339 - The interface file has a separate definition for $dmop1, with unfolding etc.
340 - The renamer renames it to a Name.
341 - The renamer treats $dmop1 as a free variable of the declaration, so that
342 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
343 This doesn't happen for source code class decls, because they *bind* the default method.
347 Each instance declaration gives rise to one dictionary function binding.
349 The type checker makes up new source-code instance declarations
350 (e.g. from 'deriving' or generic default methods --- see
351 TcInstDcls.tcInstDecls1). So we can't generate the names for
352 dictionary functions in advance (we don't know how many we need).
354 On the other hand for interface-file instance declarations, the decl
355 specifies the name of the dictionary function, and it has a binding elsewhere
356 in the interface file:
357 instance {Eq Int} = dEqInt
358 dEqInt :: {Eq Int} <pragma info>
360 So again we treat source code and interface file code slightly differently.
363 - Source code instance decls have a Nothing in the (Maybe name) field
364 (see data InstDecl below)
366 - The typechecker makes up a Local name for the dict fun for any source-code
367 instance decl, whether it comes from a source-code instance decl, or whether
368 the instance decl is derived from some other construct (e.g. 'deriving').
370 - The occurrence name it chooses is derived from the instance decl (just for
371 documentation really) --- e.g. dNumInt. Two dict funs may share a common
372 occurrence name, but will have different uniques. E.g.
373 instance Foo [Int] where ...
374 instance Foo [Bool] where ...
375 These might both be dFooList
377 - The CoreTidy phase externalises the name, and ensures the occurrence name is
378 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
380 - We can take this relaxed approach (changing the occurrence name later)
381 because dict fun Ids are not captured in a TyCon or Class (unlike default
382 methods, say). Instead, they are kept separately in the InstEnv. This
383 makes it easy to adjust them after compiling a module. (Once we've finished
384 compiling that module, they don't change any more.)
388 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
389 in the (Maybe name) field.
391 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
392 suck in the dfun binding
396 -- Representation of indexed types
397 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
398 -- Family kind signatures are represented by the variant `TyFamily'. It
399 -- covers "type family", "newtype family", and "data family" declarations,
400 -- distinguished by the value of the field `tcdFlavour'.
402 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
403 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
405 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
406 -- synonym declaration and 'tcdVars' contains the type parameters of the
409 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
410 -- 'pats' are type patterns for the type-indexes of the type constructor
411 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
412 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
413 -- *not* 'length tcdVars'.
415 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
417 type LTyClDecl name = Located (TyClDecl name)
419 -- | A type or class declaration.
422 tcdLName :: Located name,
423 tcdExtName :: Maybe FastString
427 | -- | @type/data family T :: *->*@
428 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
429 tcdLName :: Located name, -- type constructor
430 tcdTyVars :: [LHsTyVarBndr name], -- type variables
431 tcdKind :: Maybe Kind -- result kind
435 | -- | Declares a data type or newtype, giving its construcors
437 -- data/newtype T a = <constrs>
438 -- data/newtype instance T [a] = <constrs>
440 TyData { tcdND :: NewOrData,
441 tcdCtxt :: LHsContext name, -- ^ Context
442 tcdLName :: Located name, -- ^ Type constructor
444 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
446 tcdTyPats :: Maybe [LHsType name],
449 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
450 -- in this case @tcdTyVars = fv( tcdTyPats )@.
451 -- @Nothing@ for everything else.
453 tcdKindSig:: Maybe Kind,
454 -- ^ Optional kind signature.
456 -- @(Just k)@ for a GADT-style @data@, or @data
457 -- instance@ decl with explicit kind sig
459 tcdCons :: [LConDecl name],
460 -- ^ Data constructors
462 -- For @data T a = T1 | T2 a@
463 -- the 'LConDecl's all have 'ResTyH98'.
464 -- For @data T a where { T1 :: T a }@
465 -- the 'LConDecls' all have 'ResTyGADT'.
467 tcdDerivs :: Maybe [LHsType name]
468 -- ^ Derivings; @Nothing@ => not specified,
469 -- @Just []@ => derive exactly what is asked
471 -- These "types" must be of form
473 -- forall ab. C ty1 ty2
475 -- Typically the foralls and ty args are empty, but they
476 -- are non-empty for the newtype-deriving case
479 | TySynonym { tcdLName :: Located name, -- ^ type constructor
480 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
481 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
482 -- See comments for tcdTyPats in TyData
483 -- 'Nothing' => vanilla type synonym
485 tcdSynRhs :: LHsType name -- ^ synonym expansion
488 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
489 tcdLName :: Located name, -- ^ Name of the class
490 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
491 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
492 tcdSigs :: [LSig name], -- ^ Methods' signatures
493 tcdMeths :: LHsBinds name, -- ^ Default methods
494 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
495 -- only 'TyFamily' and
497 -- latter for defaults
498 tcdDocs :: [LDocDecl] -- ^ Haddock docs
500 deriving (Data, Typeable)
503 = NewType -- ^ @newtype Blah ...@
504 | DataType -- ^ @data Blah ...@
505 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
508 = TypeFamily -- ^ @type family ...@
509 | DataFamily -- ^ @data family ...@
510 deriving (Data, Typeable)
516 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
518 isDataDecl :: TyClDecl name -> Bool
519 isDataDecl (TyData {}) = True
520 isDataDecl _other = False
522 -- | type or type instance declaration
523 isTypeDecl :: TyClDecl name -> Bool
524 isTypeDecl (TySynonym {}) = True
525 isTypeDecl _other = False
527 -- | vanilla Haskell type synonym (ie, not a type instance)
528 isSynDecl :: TyClDecl name -> Bool
529 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
530 isSynDecl _other = False
533 isClassDecl :: TyClDecl name -> Bool
534 isClassDecl (ClassDecl {}) = True
535 isClassDecl _ = False
537 -- | type family declaration
538 isFamilyDecl :: TyClDecl name -> Bool
539 isFamilyDecl (TyFamily {}) = True
540 isFamilyDecl _other = False
542 -- | family instance (types, newtypes, and data types)
543 isFamInstDecl :: TyClDecl name -> Bool
546 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
553 tcdName :: TyClDecl name -> name
554 tcdName decl = unLoc (tcdLName decl)
556 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
557 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
558 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
559 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
560 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
561 tyClDeclTyVars (ForeignType {}) = []
565 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
566 -- class, synonym decls, data, newtype, family decls, family instances
568 = (count isClassDecl decls,
569 count isSynDecl decls, -- excluding...
570 count isDataTy decls, -- ...family...
571 count isNewTy decls, -- ...instances
572 count isFamilyDecl decls,
573 count isFamInstDecl decls)
575 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
578 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
583 instance OutputableBndr name
584 => Outputable (TyClDecl name) where
586 ppr (ForeignType {tcdLName = ltycon})
587 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
589 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
590 tcdTyVars = tyvars, tcdKind = mb_kind})
591 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
593 pp_flavour = case flavour of
594 TypeFamily -> ptext (sLit "type family")
595 DataFamily -> ptext (sLit "data family")
597 pp_kind = case mb_kind of
599 Just kind -> dcolon <+> pprKind kind
601 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
602 tcdSynRhs = mono_ty})
603 = hang (ptext (sLit "type") <+>
604 (if isJust typats then ptext (sLit "instance") else empty) <+>
605 pp_decl_head [] ltycon tyvars typats <+>
609 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
610 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
611 tcdCons = condecls, tcdDerivs = derivings})
612 = pp_tydecl (null condecls && isJust mb_sig)
614 (if isJust typats then ptext (sLit "instance") else empty) <+>
615 pp_decl_head (unLoc context) ltycon tyvars typats <+>
617 (pp_condecls condecls)
620 ppr_sig Nothing = empty
621 ppr_sig (Just kind) = dcolon <+> pprKind kind
623 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
625 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
626 | null sigs && null ats -- No "where" part
629 | otherwise -- Laid out
630 = sep [hsep [top_matter, ptext (sLit "where {")],
631 nest 4 (sep [ sep (map ppr_semi ats)
632 , sep (map ppr_semi sigs)
633 , pprLHsBinds methods
636 top_matter = ptext (sLit "class")
637 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
638 <+> pprFundeps (map unLoc fds)
639 ppr_semi decl = ppr decl <> semi
641 pp_decl_head :: OutputableBndr name
644 -> [LHsTyVarBndr name]
645 -> Maybe [LHsType name]
647 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
648 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
649 pp_decl_head context thing _ (Just typats) -- explicit type patterns
650 = hsep [ pprHsContext context, ppr thing
651 , hsep (map (pprParendHsType.unLoc) typats)]
653 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
654 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
655 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
656 pp_condecls cs -- In H98 syntax
657 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
659 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
660 pp_tydecl True pp_head _ _
662 pp_tydecl False pp_head pp_decl_rhs derivings
663 = hang pp_head 4 (sep [
667 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
670 instance Outputable NewOrData where
671 ppr NewType = ptext (sLit "newtype")
672 ppr DataType = ptext (sLit "data")
676 %************************************************************************
678 \subsection[ConDecl]{A data-constructor declaration}
680 %************************************************************************
683 type LConDecl name = Located (ConDecl name)
685 -- data T b = forall a. Eq a => MkT a b
686 -- MkT :: forall b a. Eq a => MkT a b
689 -- MkT1 :: Int -> T Int
691 -- data T = Int `MkT` Int
695 -- Int `MkT` Int :: T Int
699 { con_name :: Located name
700 -- ^ Constructor name. This is used for the DataCon itself, and for
701 -- the user-callable wrapper Id.
703 , con_explicit :: HsExplicitFlag
704 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
706 , con_qvars :: [LHsTyVarBndr name]
707 -- ^ Type variables. Depending on 'con_res' this describes the
708 -- follewing entities
710 -- - ResTyH98: the constructor's *existential* type variables
711 -- - ResTyGADT: *all* the constructor's quantified type variables
713 , con_cxt :: LHsContext name
714 -- ^ The context. This /does not/ include the \"stupid theta\" which
715 -- lives only in the 'TyData' decl.
717 , con_details :: HsConDeclDetails name
718 -- ^ The main payload
720 , con_res :: ResType name
721 -- ^ Result type of the constructor
723 , con_doc :: Maybe LHsDocString
724 -- ^ A possible Haddock comment.
726 , con_old_rec :: Bool
727 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
728 -- GADT-style record decl C { blah } :: T a b
729 -- Remove this when we no longer parse this stuff, and hence do not
730 -- need to report decprecated use
731 } deriving (Data, Typeable)
733 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
735 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
736 hsConDeclArgTys (PrefixCon tys) = tys
737 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
738 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
741 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
742 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
743 -- and here is its result type
744 deriving (Data, Typeable)
746 instance OutputableBndr name => Outputable (ResType name) where
748 ppr ResTyH98 = ptext (sLit "ResTyH98")
749 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
754 instance (OutputableBndr name) => Outputable (ConDecl name) where
757 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
758 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
759 , con_cxt = cxt, con_details = details
760 , con_res = ResTyH98, con_doc = doc })
761 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
763 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
764 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
765 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
767 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
768 , con_cxt = cxt, con_details = PrefixCon arg_tys
769 , con_res = ResTyGADT res_ty })
770 = ppr con <+> dcolon <+>
771 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
773 mk_fun_ty a b = noLoc (HsFunTy a b)
775 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
776 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
777 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
778 pprConDeclFields fields <+> arrow <+> ppr res_ty]
780 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
781 = pprPanic "pprConDecl" (ppr con)
782 -- In GADT syntax we don't allow infix constructors
785 %************************************************************************
787 \subsection[InstDecl]{An instance declaration
789 %************************************************************************
792 type LInstDecl name = Located (InstDecl name)
795 = InstDecl (LHsType name) -- Context => Class Instance-type
796 -- Using a polytype means that the renamer conveniently
797 -- figures out the quantified type variables for us.
799 [LSig name] -- User-supplied pragmatic info
800 [LTyClDecl name]-- Associated types (ie, 'TyData' and
802 deriving (Data, Typeable)
804 instance (OutputableBndr name) => Outputable (InstDecl name) where
806 ppr (InstDecl inst_ty binds uprags ats)
807 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
808 , nest 4 $ vcat (map ppr ats)
809 , nest 4 $ vcat (map ppr uprags)
810 , nest 4 $ pprLHsBinds binds ]
812 -- Extract the declarations of associated types from an instance
814 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
815 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
818 %************************************************************************
820 \subsection[DerivDecl]{A stand-alone instance deriving declaration
822 %************************************************************************
825 type LDerivDecl name = Located (DerivDecl name)
827 data DerivDecl name = DerivDecl (LHsType name)
828 deriving (Data, Typeable)
830 instance (OutputableBndr name) => Outputable (DerivDecl name) where
832 = hsep [ptext (sLit "deriving instance"), ppr ty]
835 %************************************************************************
837 \subsection[DefaultDecl]{A @default@ declaration}
839 %************************************************************************
841 There can only be one default declaration per module, but it is hard
842 for the parser to check that; we pass them all through in the abstract
843 syntax, and that restriction must be checked in the front end.
846 type LDefaultDecl name = Located (DefaultDecl name)
848 data DefaultDecl name
849 = DefaultDecl [LHsType name]
850 deriving (Data, Typeable)
852 instance (OutputableBndr name)
853 => Outputable (DefaultDecl name) where
855 ppr (DefaultDecl tys)
856 = ptext (sLit "default") <+> parens (interpp'SP tys)
859 %************************************************************************
861 \subsection{Foreign function interface declaration}
863 %************************************************************************
867 -- foreign declarations are distinguished as to whether they define or use a
870 -- * the Boolean value indicates whether the pre-standard deprecated syntax
873 type LForeignDecl name = Located (ForeignDecl name)
875 data ForeignDecl name
876 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
877 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
878 deriving (Data, Typeable)
880 -- Specification Of an imported external entity in dependence on the calling
883 data ForeignImport = -- import of a C entity
885 -- * the two strings specifying a header file or library
886 -- may be empty, which indicates the absence of a
887 -- header or object specification (both are not used
888 -- in the case of `CWrapper' and when `CFunction'
889 -- has a dynamic target)
891 -- * the calling convention is irrelevant for code
892 -- generation in the case of `CLabel', but is needed
893 -- for pretty printing
895 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
897 CImport CCallConv -- ccall or stdcall
898 Safety -- safe or unsafe
899 FastString -- name of C header
900 CImportSpec -- details of the C entity
901 deriving (Data, Typeable)
903 -- details of an external C entity
905 data CImportSpec = CLabel CLabelString -- import address of a C label
906 | CFunction CCallTarget -- static or dynamic function
907 | CWrapper -- wrapper to expose closures
909 deriving (Data, Typeable)
911 -- specification of an externally exported entity in dependence on the calling
914 data ForeignExport = CExport CExportSpec -- contains the calling convention
915 deriving (Data, Typeable)
917 -- pretty printing of foreign declarations
920 instance OutputableBndr name => Outputable (ForeignDecl name) where
921 ppr (ForeignImport n ty fimport) =
922 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
923 2 (dcolon <+> ppr ty)
924 ppr (ForeignExport n ty fexport) =
925 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
926 2 (dcolon <+> ppr ty)
928 instance Outputable ForeignImport where
929 ppr (CImport cconv safety header spec) =
930 ppr cconv <+> ppr safety <+>
931 char '"' <> pprCEntity spec <> char '"'
933 pp_hdr = if nullFS header then empty else ftext header
935 pprCEntity (CLabel lbl) =
936 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
937 pprCEntity (CFunction (StaticTarget lbl _)) =
938 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
939 pprCEntity (CFunction (DynamicTarget)) =
940 ptext (sLit "dynamic")
941 pprCEntity (CWrapper) = ptext (sLit "wrapper")
943 instance Outputable ForeignExport where
944 ppr (CExport (CExportStatic lbl cconv)) =
945 ppr cconv <+> char '"' <> ppr lbl <> char '"'
949 %************************************************************************
951 \subsection{Transformation rules}
953 %************************************************************************
956 type LRuleDecl name = Located (RuleDecl name)
959 = HsRule -- Source rule
960 RuleName -- Rule name
962 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
963 (Located (HsExpr name)) -- LHS
964 NameSet -- Free-vars from the LHS
965 (Located (HsExpr name)) -- RHS
966 NameSet -- Free-vars from the RHS
967 deriving (Data, Typeable)
970 = RuleBndr (Located name)
971 | RuleBndrSig (Located name) (LHsType name)
972 deriving (Data, Typeable)
974 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
975 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
977 instance OutputableBndr name => Outputable (RuleDecl name) where
978 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
979 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
980 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
981 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
983 pp_forall | null ns = empty
984 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
986 instance OutputableBndr name => Outputable (RuleBndr name) where
987 ppr (RuleBndr name) = ppr name
988 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
991 %************************************************************************
993 \subsection[DocDecl]{Document comments}
995 %************************************************************************
999 type LDocDecl = Located (DocDecl)
1002 = DocCommentNext HsDocString
1003 | DocCommentPrev HsDocString
1004 | DocCommentNamed String HsDocString
1005 | DocGroup Int HsDocString
1006 deriving (Data, Typeable)
1008 -- Okay, I need to reconstruct the document comments, but for now:
1009 instance Outputable DocDecl where
1010 ppr _ = text "<document comment>"
1012 docDeclDoc :: DocDecl -> HsDocString
1013 docDeclDoc (DocCommentNext d) = d
1014 docDeclDoc (DocCommentPrev d) = d
1015 docDeclDoc (DocCommentNamed _ d) = d
1016 docDeclDoc (DocGroup _ d) = d
1020 %************************************************************************
1022 \subsection[DeprecDecl]{Deprecations}
1024 %************************************************************************
1026 We use exported entities for things to deprecate.
1029 type LWarnDecl name = Located (WarnDecl name)
1031 data WarnDecl name = Warning name WarningTxt
1032 deriving (Data, Typeable)
1034 instance OutputableBndr name => Outputable (WarnDecl name) where
1035 ppr (Warning thing txt)
1036 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1039 %************************************************************************
1041 \subsection[AnnDecl]{Annotations}
1043 %************************************************************************
1046 type LAnnDecl name = Located (AnnDecl name)
1048 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1049 deriving (Data, Typeable)
1051 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1052 ppr (HsAnnotation provenance expr)
1053 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1056 data AnnProvenance name = ValueAnnProvenance name
1057 | TypeAnnProvenance name
1058 | ModuleAnnProvenance
1059 deriving (Data, Typeable)
1061 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1062 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1063 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1064 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1066 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1067 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1068 modifyAnnProvenanceNameM fm prov =
1070 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1071 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1072 ModuleAnnProvenance -> return ModuleAnnProvenance
1074 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1075 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1076 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1077 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name