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]
235 ppr_ds :: Outputable a => [a] -> Maybe SDoc
237 ppr_ds ds = Just (vcat (map ppr ds))
239 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
240 -- Concatenate vertically with white-space between non-blanks
242 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
243 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
246 = SpliceDecl -- Top level splice
247 (Located (HsExpr id))
248 HsExplicitFlag -- Explicit <=> $(f x y)
249 -- Implicit <=> f x y, i.e. a naked top level expression
250 deriving (Data, Typeable)
252 instance OutputableBndr name => Outputable (SpliceDecl name) where
253 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
257 %************************************************************************
259 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
261 %************************************************************************
263 --------------------------------
265 --------------------------------
267 Here is the story about the implicit names that go with type, class,
268 and instance decls. It's a bit tricky, so pay attention!
270 "Implicit" (or "system") binders
271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 Each data type decl defines
273 a worker name for each constructor
274 to-T and from-T convertors
275 Each class decl defines
276 a tycon for the class
277 a data constructor for that tycon
278 the worker for that constructor
279 a selector for each superclass
281 All have occurrence names that are derived uniquely from their parent
284 None of these get separate definitions in an interface file; they are
285 fully defined by the data or class decl. But they may *occur* in
286 interface files, of course. Any such occurrence must haul in the
287 relevant type or class decl.
290 - Ensure they "point to" the parent data/class decl
291 when loading that decl from an interface file
292 (See RnHiFiles.getSysBinders)
294 - When typechecking the decl, we build the implicit TyCons and Ids.
295 When doing so we look them up in the name cache (RnEnv.lookupSysName),
296 to ensure correct module and provenance is set
298 These are the two places that we have to conjure up the magic derived
299 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
303 - Occurrence name is derived uniquely from the method name
306 - If there is a default method name at all, it's recorded in
307 the ClassOpSig (in HsBinds), in the DefMeth field.
308 (DefMeth is defined in Class.lhs)
310 Source-code class decls and interface-code class decls are treated subtly
311 differently, which has given me a great deal of confusion over the years.
312 Here's the deal. (We distinguish the two cases because source-code decls
313 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
315 In *source-code* class declarations:
317 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
318 This is done by RdrHsSyn.mkClassOpSigDM
320 - The renamer renames it to a Name
322 - During typechecking, we generate a binding for each $dm for
323 which there's a programmer-supplied default method:
328 We generate a binding for $dmop1 but not for $dmop2.
329 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
330 The Name for $dmop2 is simply discarded.
332 In *interface-file* class declarations:
333 - When parsing, we see if there's an explicit programmer-supplied default method
334 because there's an '=' sign to indicate it:
336 op1 = :: <type> -- NB the '='
338 We use this info to generate a DefMeth with a suitable RdrName for op1,
339 and a NoDefMeth for op2
340 - The interface file has a separate definition for $dmop1, with unfolding etc.
341 - The renamer renames it to a Name.
342 - The renamer treats $dmop1 as a free variable of the declaration, so that
343 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
344 This doesn't happen for source code class decls, because they *bind* the default method.
348 Each instance declaration gives rise to one dictionary function binding.
350 The type checker makes up new source-code instance declarations
351 (e.g. from 'deriving' or generic default methods --- see
352 TcInstDcls.tcInstDecls1). So we can't generate the names for
353 dictionary functions in advance (we don't know how many we need).
355 On the other hand for interface-file instance declarations, the decl
356 specifies the name of the dictionary function, and it has a binding elsewhere
357 in the interface file:
358 instance {Eq Int} = dEqInt
359 dEqInt :: {Eq Int} <pragma info>
361 So again we treat source code and interface file code slightly differently.
364 - Source code instance decls have a Nothing in the (Maybe name) field
365 (see data InstDecl below)
367 - The typechecker makes up a Local name for the dict fun for any source-code
368 instance decl, whether it comes from a source-code instance decl, or whether
369 the instance decl is derived from some other construct (e.g. 'deriving').
371 - The occurrence name it chooses is derived from the instance decl (just for
372 documentation really) --- e.g. dNumInt. Two dict funs may share a common
373 occurrence name, but will have different uniques. E.g.
374 instance Foo [Int] where ...
375 instance Foo [Bool] where ...
376 These might both be dFooList
378 - The CoreTidy phase externalises the name, and ensures the occurrence name is
379 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
381 - We can take this relaxed approach (changing the occurrence name later)
382 because dict fun Ids are not captured in a TyCon or Class (unlike default
383 methods, say). Instead, they are kept separately in the InstEnv. This
384 makes it easy to adjust them after compiling a module. (Once we've finished
385 compiling that module, they don't change any more.)
389 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
390 in the (Maybe name) field.
392 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
393 suck in the dfun binding
397 -- Representation of indexed types
398 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
399 -- Family kind signatures are represented by the variant `TyFamily'. It
400 -- covers "type family", "newtype family", and "data family" declarations,
401 -- distinguished by the value of the field `tcdFlavour'.
403 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
404 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
406 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
407 -- synonym declaration and 'tcdVars' contains the type parameters of the
410 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
411 -- 'pats' are type patterns for the type-indexes of the type constructor
412 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
413 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
414 -- *not* 'length tcdVars'.
416 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
418 type LTyClDecl name = Located (TyClDecl name)
420 -- | A type or class declaration.
423 tcdLName :: Located name,
424 tcdExtName :: Maybe FastString
428 | -- | @type/data family T :: *->*@
429 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
430 tcdLName :: Located name, -- type constructor
431 tcdTyVars :: [LHsTyVarBndr name], -- type variables
432 tcdKind :: Maybe Kind -- result kind
436 | -- | Declares a data type or newtype, giving its construcors
438 -- data/newtype T a = <constrs>
439 -- data/newtype instance T [a] = <constrs>
441 TyData { tcdND :: NewOrData,
442 tcdCtxt :: LHsContext name, -- ^ Context
443 tcdLName :: Located name, -- ^ Type constructor
445 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
447 tcdTyPats :: Maybe [LHsType name],
450 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
451 -- in this case @tcdTyVars = fv( tcdTyPats )@.
452 -- @Nothing@ for everything else.
454 tcdKindSig:: Maybe Kind,
455 -- ^ Optional kind signature.
457 -- @(Just k)@ for a GADT-style @data@, or @data
458 -- instance@ decl with explicit kind sig
460 tcdCons :: [LConDecl name],
461 -- ^ Data constructors
463 -- For @data T a = T1 | T2 a@
464 -- the 'LConDecl's all have 'ResTyH98'.
465 -- For @data T a where { T1 :: T a }@
466 -- the 'LConDecls' all have 'ResTyGADT'.
468 tcdDerivs :: Maybe [LHsType name]
469 -- ^ Derivings; @Nothing@ => not specified,
470 -- @Just []@ => derive exactly what is asked
472 -- These "types" must be of form
474 -- forall ab. C ty1 ty2
476 -- Typically the foralls and ty args are empty, but they
477 -- are non-empty for the newtype-deriving case
480 | TySynonym { tcdLName :: Located name, -- ^ type constructor
481 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
482 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
483 -- See comments for tcdTyPats in TyData
484 -- 'Nothing' => vanilla type synonym
486 tcdSynRhs :: LHsType name -- ^ synonym expansion
489 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
490 tcdLName :: Located name, -- ^ Name of the class
491 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
492 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
493 tcdSigs :: [LSig name], -- ^ Methods' signatures
494 tcdMeths :: LHsBinds name, -- ^ Default methods
495 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
496 -- only 'TyFamily' and
498 -- latter for defaults
499 tcdDocs :: [LDocDecl] -- ^ Haddock docs
501 deriving (Data, Typeable)
504 = NewType -- ^ @newtype Blah ...@
505 | DataType -- ^ @data Blah ...@
506 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
509 = TypeFamily -- ^ @type family ...@
510 | DataFamily -- ^ @data family ...@
511 deriving (Data, Typeable)
517 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
519 isDataDecl :: TyClDecl name -> Bool
520 isDataDecl (TyData {}) = True
521 isDataDecl _other = False
523 -- | type or type instance declaration
524 isTypeDecl :: TyClDecl name -> Bool
525 isTypeDecl (TySynonym {}) = True
526 isTypeDecl _other = False
528 -- | vanilla Haskell type synonym (ie, not a type instance)
529 isSynDecl :: TyClDecl name -> Bool
530 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
531 isSynDecl _other = False
534 isClassDecl :: TyClDecl name -> Bool
535 isClassDecl (ClassDecl {}) = True
536 isClassDecl _ = False
538 -- | type family declaration
539 isFamilyDecl :: TyClDecl name -> Bool
540 isFamilyDecl (TyFamily {}) = True
541 isFamilyDecl _other = False
543 -- | family instance (types, newtypes, and data types)
544 isFamInstDecl :: TyClDecl name -> Bool
547 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
554 tcdName :: TyClDecl name -> name
555 tcdName decl = unLoc (tcdLName decl)
557 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
558 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
559 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
560 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
561 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
562 tyClDeclTyVars (ForeignType {}) = []
566 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
567 -- class, synonym decls, data, newtype, family decls, family instances
569 = (count isClassDecl decls,
570 count isSynDecl decls, -- excluding...
571 count isDataTy decls, -- ...family...
572 count isNewTy decls, -- ...instances
573 count isFamilyDecl decls,
574 count isFamInstDecl decls)
576 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
579 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
584 instance OutputableBndr name
585 => Outputable (TyClDecl name) where
587 ppr (ForeignType {tcdLName = ltycon})
588 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
590 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
591 tcdTyVars = tyvars, tcdKind = mb_kind})
592 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
594 pp_flavour = case flavour of
595 TypeFamily -> ptext (sLit "type family")
596 DataFamily -> ptext (sLit "data family")
598 pp_kind = case mb_kind of
600 Just kind -> dcolon <+> pprKind kind
602 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
603 tcdSynRhs = mono_ty})
604 = hang (ptext (sLit "type") <+>
605 (if isJust typats then ptext (sLit "instance") else empty) <+>
606 pp_decl_head [] ltycon tyvars typats <+>
610 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
611 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
612 tcdCons = condecls, tcdDerivs = derivings})
613 = pp_tydecl (null condecls && isJust mb_sig)
615 (if isJust typats then ptext (sLit "instance") else empty) <+>
616 pp_decl_head (unLoc context) ltycon tyvars typats <+>
618 (pp_condecls condecls)
621 ppr_sig Nothing = empty
622 ppr_sig (Just kind) = dcolon <+> pprKind kind
624 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
626 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
627 | null sigs && null ats -- No "where" part
630 | otherwise -- Laid out
631 = sep [hsep [top_matter, ptext (sLit "where {")],
632 nest 4 (sep [ sep (map ppr_semi ats)
633 , sep (map ppr_semi sigs)
634 , pprLHsBinds methods
637 top_matter = ptext (sLit "class")
638 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
639 <+> pprFundeps (map unLoc fds)
640 ppr_semi :: Outputable a => a -> SDoc
641 ppr_semi decl = ppr decl <> semi
643 pp_decl_head :: OutputableBndr name
646 -> [LHsTyVarBndr name]
647 -> Maybe [LHsType name]
649 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
650 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
651 pp_decl_head context thing _ (Just typats) -- explicit type patterns
652 = hsep [ pprHsContext context, ppr thing
653 , hsep (map (pprParendHsType.unLoc) typats)]
655 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
656 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
657 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
658 pp_condecls cs -- In H98 syntax
659 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
661 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
662 pp_tydecl True pp_head _ _
664 pp_tydecl False pp_head pp_decl_rhs derivings
665 = hang pp_head 4 (sep [
669 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
672 instance Outputable NewOrData where
673 ppr NewType = ptext (sLit "newtype")
674 ppr DataType = ptext (sLit "data")
678 %************************************************************************
680 \subsection[ConDecl]{A data-constructor declaration}
682 %************************************************************************
685 type LConDecl name = Located (ConDecl name)
687 -- data T b = forall a. Eq a => MkT a b
688 -- MkT :: forall b a. Eq a => MkT a b
691 -- MkT1 :: Int -> T Int
693 -- data T = Int `MkT` Int
697 -- Int `MkT` Int :: T Int
701 { con_name :: Located name
702 -- ^ Constructor name. This is used for the DataCon itself, and for
703 -- the user-callable wrapper Id.
705 , con_explicit :: HsExplicitFlag
706 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
708 , con_qvars :: [LHsTyVarBndr name]
709 -- ^ Type variables. Depending on 'con_res' this describes the
710 -- follewing entities
712 -- - ResTyH98: the constructor's *existential* type variables
713 -- - ResTyGADT: *all* the constructor's quantified type variables
715 , con_cxt :: LHsContext name
716 -- ^ The context. This /does not/ include the \"stupid theta\" which
717 -- lives only in the 'TyData' decl.
719 , con_details :: HsConDeclDetails name
720 -- ^ The main payload
722 , con_res :: ResType name
723 -- ^ Result type of the constructor
725 , con_doc :: Maybe LHsDocString
726 -- ^ A possible Haddock comment.
728 , con_old_rec :: Bool
729 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
730 -- GADT-style record decl C { blah } :: T a b
731 -- Remove this when we no longer parse this stuff, and hence do not
732 -- need to report decprecated use
733 } deriving (Data, Typeable)
735 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
737 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
738 hsConDeclArgTys (PrefixCon tys) = tys
739 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
740 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
743 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
744 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
745 -- and here is its result type
746 deriving (Data, Typeable)
748 instance OutputableBndr name => Outputable (ResType name) where
750 ppr ResTyH98 = ptext (sLit "ResTyH98")
751 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
756 instance (OutputableBndr name) => Outputable (ConDecl name) where
759 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
760 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
761 , con_cxt = cxt, con_details = details
762 , con_res = ResTyH98, con_doc = doc })
763 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
765 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
766 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
767 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
769 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
770 , con_cxt = cxt, con_details = PrefixCon arg_tys
771 , con_res = ResTyGADT res_ty })
772 = ppr con <+> dcolon <+>
773 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
775 mk_fun_ty a b = noLoc (HsFunTy a b)
777 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
778 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
779 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
780 pprConDeclFields fields <+> arrow <+> ppr res_ty]
782 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
783 = pprPanic "pprConDecl" (ppr con)
784 -- In GADT syntax we don't allow infix constructors
787 %************************************************************************
789 \subsection[InstDecl]{An instance declaration
791 %************************************************************************
794 type LInstDecl name = Located (InstDecl name)
797 = InstDecl (LHsType name) -- Context => Class Instance-type
798 -- Using a polytype means that the renamer conveniently
799 -- figures out the quantified type variables for us.
801 [LSig name] -- User-supplied pragmatic info
802 [LTyClDecl name]-- Associated types (ie, 'TyData' and
804 deriving (Data, Typeable)
806 instance (OutputableBndr name) => Outputable (InstDecl name) where
808 ppr (InstDecl inst_ty binds uprags ats)
809 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
810 , nest 4 $ vcat (map ppr ats)
811 , nest 4 $ vcat (map ppr uprags)
812 , nest 4 $ pprLHsBinds binds ]
814 -- Extract the declarations of associated types from an instance
816 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
817 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
820 %************************************************************************
822 \subsection[DerivDecl]{A stand-alone instance deriving declaration
824 %************************************************************************
827 type LDerivDecl name = Located (DerivDecl name)
829 data DerivDecl name = DerivDecl (LHsType name)
830 deriving (Data, Typeable)
832 instance (OutputableBndr name) => Outputable (DerivDecl name) where
834 = hsep [ptext (sLit "deriving instance"), ppr ty]
837 %************************************************************************
839 \subsection[DefaultDecl]{A @default@ declaration}
841 %************************************************************************
843 There can only be one default declaration per module, but it is hard
844 for the parser to check that; we pass them all through in the abstract
845 syntax, and that restriction must be checked in the front end.
848 type LDefaultDecl name = Located (DefaultDecl name)
850 data DefaultDecl name
851 = DefaultDecl [LHsType name]
852 deriving (Data, Typeable)
854 instance (OutputableBndr name)
855 => Outputable (DefaultDecl name) where
857 ppr (DefaultDecl tys)
858 = ptext (sLit "default") <+> parens (interpp'SP tys)
861 %************************************************************************
863 \subsection{Foreign function interface declaration}
865 %************************************************************************
869 -- foreign declarations are distinguished as to whether they define or use a
872 -- * the Boolean value indicates whether the pre-standard deprecated syntax
875 type LForeignDecl name = Located (ForeignDecl name)
877 data ForeignDecl name
878 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
879 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
880 deriving (Data, Typeable)
882 -- Specification Of an imported external entity in dependence on the calling
885 data ForeignImport = -- import of a C entity
887 -- * the two strings specifying a header file or library
888 -- may be empty, which indicates the absence of a
889 -- header or object specification (both are not used
890 -- in the case of `CWrapper' and when `CFunction'
891 -- has a dynamic target)
893 -- * the calling convention is irrelevant for code
894 -- generation in the case of `CLabel', but is needed
895 -- for pretty printing
897 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
899 CImport CCallConv -- ccall or stdcall
900 Safety -- interruptible, safe or unsafe
901 FastString -- name of C header
902 CImportSpec -- details of the C entity
903 deriving (Data, Typeable)
905 -- details of an external C entity
907 data CImportSpec = CLabel CLabelString -- import address of a C label
908 | CFunction CCallTarget -- static or dynamic function
909 | CWrapper -- wrapper to expose closures
911 deriving (Data, Typeable)
913 -- specification of an externally exported entity in dependence on the calling
916 data ForeignExport = CExport CExportSpec -- contains the calling convention
917 deriving (Data, Typeable)
919 -- pretty printing of foreign declarations
922 instance OutputableBndr name => Outputable (ForeignDecl name) where
923 ppr (ForeignImport n ty fimport) =
924 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
925 2 (dcolon <+> ppr ty)
926 ppr (ForeignExport n ty fexport) =
927 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
928 2 (dcolon <+> ppr ty)
930 instance Outputable ForeignImport where
931 ppr (CImport cconv safety header spec) =
932 ppr cconv <+> ppr safety <+>
933 char '"' <> pprCEntity spec <> char '"'
935 pp_hdr = if nullFS header then empty else ftext header
937 pprCEntity (CLabel lbl) =
938 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
939 pprCEntity (CFunction (StaticTarget lbl _)) =
940 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
941 pprCEntity (CFunction (DynamicTarget)) =
942 ptext (sLit "dynamic")
943 pprCEntity (CWrapper) = ptext (sLit "wrapper")
945 instance Outputable ForeignExport where
946 ppr (CExport (CExportStatic lbl cconv)) =
947 ppr cconv <+> char '"' <> ppr lbl <> char '"'
951 %************************************************************************
953 \subsection{Transformation rules}
955 %************************************************************************
958 type LRuleDecl name = Located (RuleDecl name)
961 = HsRule -- Source rule
962 RuleName -- Rule name
964 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
965 (Located (HsExpr name)) -- LHS
966 NameSet -- Free-vars from the LHS
967 (Located (HsExpr name)) -- RHS
968 NameSet -- Free-vars from the RHS
969 deriving (Data, Typeable)
972 = RuleBndr (Located name)
973 | RuleBndrSig (Located name) (LHsType name)
974 deriving (Data, Typeable)
976 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
977 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
979 instance OutputableBndr name => Outputable (RuleDecl name) where
980 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
981 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
982 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
983 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
985 pp_forall | null ns = empty
986 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
988 instance OutputableBndr name => Outputable (RuleBndr name) where
989 ppr (RuleBndr name) = ppr name
990 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
993 %************************************************************************
995 \subsection[DocDecl]{Document comments}
997 %************************************************************************
1001 type LDocDecl = Located (DocDecl)
1004 = DocCommentNext HsDocString
1005 | DocCommentPrev HsDocString
1006 | DocCommentNamed String HsDocString
1007 | DocGroup Int HsDocString
1008 deriving (Data, Typeable)
1010 -- Okay, I need to reconstruct the document comments, but for now:
1011 instance Outputable DocDecl where
1012 ppr _ = text "<document comment>"
1014 docDeclDoc :: DocDecl -> HsDocString
1015 docDeclDoc (DocCommentNext d) = d
1016 docDeclDoc (DocCommentPrev d) = d
1017 docDeclDoc (DocCommentNamed _ d) = d
1018 docDeclDoc (DocGroup _ d) = d
1022 %************************************************************************
1024 \subsection[DeprecDecl]{Deprecations}
1026 %************************************************************************
1028 We use exported entities for things to deprecate.
1031 type LWarnDecl name = Located (WarnDecl name)
1033 data WarnDecl name = Warning name WarningTxt
1034 deriving (Data, Typeable)
1036 instance OutputableBndr name => Outputable (WarnDecl name) where
1037 ppr (Warning thing txt)
1038 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1041 %************************************************************************
1043 \subsection[AnnDecl]{Annotations}
1045 %************************************************************************
1048 type LAnnDecl name = Located (AnnDecl name)
1050 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1051 deriving (Data, Typeable)
1053 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1054 ppr (HsAnnotation provenance expr)
1055 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1058 data AnnProvenance name = ValueAnnProvenance name
1059 | TypeAnnProvenance name
1060 | ModuleAnnProvenance
1061 deriving (Data, Typeable)
1063 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1064 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1065 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1066 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1068 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1069 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1070 modifyAnnProvenanceNameM fm prov =
1072 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1073 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1074 ModuleAnnProvenance -> return ModuleAnnProvenance
1076 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1077 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1078 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1079 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name