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, tyClDeclNames, 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, hsConDeclsNames,
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 })
224 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
225 ppr_ds deprec_decls, ppr_ds ann_decls,
228 ppr_ds tycl_decls, ppr_ds inst_decls,
230 ppr_ds foreign_decls]
233 ppr_ds ds = blankLine $$ vcat (map ppr ds)
235 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
236 deriving (Data, Typeable)
238 instance OutputableBndr name => Outputable (SpliceDecl name) where
239 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
243 %************************************************************************
245 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
247 %************************************************************************
249 --------------------------------
251 --------------------------------
253 Here is the story about the implicit names that go with type, class,
254 and instance decls. It's a bit tricky, so pay attention!
256 "Implicit" (or "system") binders
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
258 Each data type decl defines
259 a worker name for each constructor
260 to-T and from-T convertors
261 Each class decl defines
262 a tycon for the class
263 a data constructor for that tycon
264 the worker for that constructor
265 a selector for each superclass
267 All have occurrence names that are derived uniquely from their parent
270 None of these get separate definitions in an interface file; they are
271 fully defined by the data or class decl. But they may *occur* in
272 interface files, of course. Any such occurrence must haul in the
273 relevant type or class decl.
276 - Ensure they "point to" the parent data/class decl
277 when loading that decl from an interface file
278 (See RnHiFiles.getSysBinders)
280 - When typechecking the decl, we build the implicit TyCons and Ids.
281 When doing so we look them up in the name cache (RnEnv.lookupSysName),
282 to ensure correct module and provenance is set
284 These are the two places that we have to conjure up the magic derived
285 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
289 - Occurrence name is derived uniquely from the method name
292 - If there is a default method name at all, it's recorded in
293 the ClassOpSig (in HsBinds), in the DefMeth field.
294 (DefMeth is defined in Class.lhs)
296 Source-code class decls and interface-code class decls are treated subtly
297 differently, which has given me a great deal of confusion over the years.
298 Here's the deal. (We distinguish the two cases because source-code decls
299 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
301 In *source-code* class declarations:
303 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
304 This is done by RdrHsSyn.mkClassOpSigDM
306 - The renamer renames it to a Name
308 - During typechecking, we generate a binding for each $dm for
309 which there's a programmer-supplied default method:
314 We generate a binding for $dmop1 but not for $dmop2.
315 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
316 The Name for $dmop2 is simply discarded.
318 In *interface-file* class declarations:
319 - When parsing, we see if there's an explicit programmer-supplied default method
320 because there's an '=' sign to indicate it:
322 op1 = :: <type> -- NB the '='
324 We use this info to generate a DefMeth with a suitable RdrName for op1,
325 and a NoDefMeth for op2
326 - The interface file has a separate definition for $dmop1, with unfolding etc.
327 - The renamer renames it to a Name.
328 - The renamer treats $dmop1 as a free variable of the declaration, so that
329 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
330 This doesn't happen for source code class decls, because they *bind* the default method.
334 Each instance declaration gives rise to one dictionary function binding.
336 The type checker makes up new source-code instance declarations
337 (e.g. from 'deriving' or generic default methods --- see
338 TcInstDcls.tcInstDecls1). So we can't generate the names for
339 dictionary functions in advance (we don't know how many we need).
341 On the other hand for interface-file instance declarations, the decl
342 specifies the name of the dictionary function, and it has a binding elsewhere
343 in the interface file:
344 instance {Eq Int} = dEqInt
345 dEqInt :: {Eq Int} <pragma info>
347 So again we treat source code and interface file code slightly differently.
350 - Source code instance decls have a Nothing in the (Maybe name) field
351 (see data InstDecl below)
353 - The typechecker makes up a Local name for the dict fun for any source-code
354 instance decl, whether it comes from a source-code instance decl, or whether
355 the instance decl is derived from some other construct (e.g. 'deriving').
357 - The occurrence name it chooses is derived from the instance decl (just for
358 documentation really) --- e.g. dNumInt. Two dict funs may share a common
359 occurrence name, but will have different uniques. E.g.
360 instance Foo [Int] where ...
361 instance Foo [Bool] where ...
362 These might both be dFooList
364 - The CoreTidy phase externalises the name, and ensures the occurrence name is
365 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
367 - We can take this relaxed approach (changing the occurrence name later)
368 because dict fun Ids are not captured in a TyCon or Class (unlike default
369 methods, say). Instead, they are kept separately in the InstEnv. This
370 makes it easy to adjust them after compiling a module. (Once we've finished
371 compiling that module, they don't change any more.)
375 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
376 in the (Maybe name) field.
378 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
379 suck in the dfun binding
383 -- Representation of indexed types
384 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
385 -- Family kind signatures are represented by the variant `TyFamily'. It
386 -- covers "type family", "newtype family", and "data family" declarations,
387 -- distinguished by the value of the field `tcdFlavour'.
389 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
390 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
392 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
393 -- synonym declaration and 'tcdVars' contains the type parameters of the
396 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
397 -- 'pats' are type patterns for the type-indexes of the type constructor
398 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
399 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
400 -- *not* 'length tcdVars'.
402 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
404 type LTyClDecl name = Located (TyClDecl name)
406 -- | A type or class declaration.
409 tcdLName :: Located name,
410 tcdExtName :: Maybe FastString
414 | -- | @type/data family T :: *->*@
415 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
416 tcdLName :: Located name, -- type constructor
417 tcdTyVars :: [LHsTyVarBndr name], -- type variables
418 tcdKind :: Maybe Kind -- result kind
422 | -- | Declares a data type or newtype, giving its construcors
424 -- data/newtype T a = <constrs>
425 -- data/newtype instance T [a] = <constrs>
427 TyData { tcdND :: NewOrData,
428 tcdCtxt :: LHsContext name, -- ^ Context
429 tcdLName :: Located name, -- ^ Type constructor
431 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
433 tcdTyPats :: Maybe [LHsType name],
436 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
437 -- in this case @tcdTyVars = fv( tcdTyPats )@.
438 -- @Nothing@ for everything else.
440 tcdKindSig:: Maybe Kind,
441 -- ^ Optional kind signature.
443 -- @(Just k)@ for a GADT-style @data@, or @data
444 -- instance@ decl with explicit kind sig
446 tcdCons :: [LConDecl name],
447 -- ^ Data constructors
449 -- For @data T a = T1 | T2 a@
450 -- the 'LConDecl's all have 'ResTyH98'.
451 -- For @data T a where { T1 :: T a }@
452 -- the 'LConDecls' all have 'ResTyGADT'.
454 tcdDerivs :: Maybe [LHsType name]
455 -- ^ Derivings; @Nothing@ => not specified,
456 -- @Just []@ => derive exactly what is asked
458 -- These "types" must be of form
460 -- forall ab. C ty1 ty2
462 -- Typically the foralls and ty args are empty, but they
463 -- are non-empty for the newtype-deriving case
466 | TySynonym { tcdLName :: Located name, -- ^ type constructor
467 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
468 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
469 -- See comments for tcdTyPats in TyData
470 -- 'Nothing' => vanilla type synonym
472 tcdSynRhs :: LHsType name -- ^ synonym expansion
475 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
476 tcdLName :: Located name, -- ^ Name of the class
477 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
478 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
479 tcdSigs :: [LSig name], -- ^ Methods' signatures
480 tcdMeths :: LHsBinds name, -- ^ Default methods
481 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
482 -- only 'TyFamily' and
484 -- latter for defaults
485 tcdDocs :: [LDocDecl] -- ^ Haddock docs
487 deriving (Data, Typeable)
490 = NewType -- ^ @newtype Blah ...@
491 | DataType -- ^ @data Blah ...@
492 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
495 = TypeFamily -- ^ @type family ...@
496 | DataFamily -- ^ @data family ...@
497 deriving (Data, Typeable)
503 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
505 isDataDecl :: TyClDecl name -> Bool
506 isDataDecl (TyData {}) = True
507 isDataDecl _other = False
509 -- | type or type instance declaration
510 isTypeDecl :: TyClDecl name -> Bool
511 isTypeDecl (TySynonym {}) = True
512 isTypeDecl _other = False
514 -- | vanilla Haskell type synonym (ie, not a type instance)
515 isSynDecl :: TyClDecl name -> Bool
516 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
517 isSynDecl _other = False
520 isClassDecl :: TyClDecl name -> Bool
521 isClassDecl (ClassDecl {}) = True
522 isClassDecl _ = False
524 -- | type family declaration
525 isFamilyDecl :: TyClDecl name -> Bool
526 isFamilyDecl (TyFamily {}) = True
527 isFamilyDecl _other = False
529 -- | family instance (types, newtypes, and data types)
530 isFamInstDecl :: TyClDecl name -> Bool
533 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
540 tcdName :: TyClDecl name -> name
541 tcdName decl = unLoc (tcdLName decl)
543 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
544 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
545 -- The first one is guaranteed to be the name of the decl. For record fields
546 -- mentioned in multiple constructors, the SrcLoc will be from the first
547 -- occurence. We use the equality to filter out duplicate field names
549 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
550 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
551 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
553 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
555 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
557 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
558 = tc_name : hsConDeclsNames cons
560 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
561 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
562 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
563 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
564 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
565 tyClDeclTyVars (ForeignType {}) = []
569 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
570 -- class, synonym decls, data, newtype, family decls, family instances
572 = (count isClassDecl decls,
573 count isSynDecl decls, -- excluding...
574 count isDataTy decls, -- ...family...
575 count isNewTy decls, -- ...instances
576 count isFamilyDecl decls,
577 count isFamInstDecl decls)
579 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
582 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
587 instance OutputableBndr name
588 => Outputable (TyClDecl name) where
590 ppr (ForeignType {tcdLName = ltycon})
591 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
593 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
594 tcdTyVars = tyvars, tcdKind = mb_kind})
595 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
597 pp_flavour = case flavour of
598 TypeFamily -> ptext (sLit "type family")
599 DataFamily -> ptext (sLit "data family")
601 pp_kind = case mb_kind of
603 Just kind -> dcolon <+> pprKind kind
605 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
606 tcdSynRhs = mono_ty})
607 = hang (ptext (sLit "type") <+>
608 (if isJust typats then ptext (sLit "instance") else empty) <+>
609 pp_decl_head [] ltycon tyvars typats <+>
613 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
614 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
615 tcdCons = condecls, tcdDerivs = derivings})
616 = pp_tydecl (null condecls && isJust mb_sig)
618 (if isJust typats then ptext (sLit "instance") else empty) <+>
619 pp_decl_head (unLoc context) ltycon tyvars typats <+>
621 (pp_condecls condecls)
624 ppr_sig Nothing = empty
625 ppr_sig (Just kind) = dcolon <+> pprKind kind
627 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
629 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
630 | null sigs && null ats -- No "where" part
633 | otherwise -- Laid out
634 = sep [hsep [top_matter, ptext (sLit "where {")],
635 nest 4 (sep [ sep (map ppr_semi ats)
636 , sep (map ppr_semi sigs)
637 , pprLHsBinds methods
640 top_matter = ptext (sLit "class")
641 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
642 <+> pprFundeps (map unLoc fds)
643 ppr_semi decl = ppr decl <> semi
645 pp_decl_head :: OutputableBndr name
648 -> [LHsTyVarBndr name]
649 -> Maybe [LHsType name]
651 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
652 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
653 pp_decl_head context thing _ (Just typats) -- explicit type patterns
654 = hsep [ pprHsContext context, ppr thing
655 , hsep (map (pprParendHsType.unLoc) typats)]
657 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
658 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
659 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
660 pp_condecls cs -- In H98 syntax
661 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
663 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
664 pp_tydecl True pp_head _ _
666 pp_tydecl False pp_head pp_decl_rhs derivings
667 = hang pp_head 4 (sep [
671 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
674 instance Outputable NewOrData where
675 ppr NewType = ptext (sLit "newtype")
676 ppr DataType = ptext (sLit "data")
680 %************************************************************************
682 \subsection[ConDecl]{A data-constructor declaration}
684 %************************************************************************
687 type LConDecl name = Located (ConDecl name)
689 -- data T b = forall a. Eq a => MkT a b
690 -- MkT :: forall b a. Eq a => MkT a b
693 -- MkT1 :: Int -> T Int
695 -- data T = Int `MkT` Int
699 -- Int `MkT` Int :: T Int
703 { con_name :: Located name
704 -- ^ Constructor name. This is used for the DataCon itself, and for
705 -- the user-callable wrapper Id.
707 , con_explicit :: HsExplicitFlag
708 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
710 , con_qvars :: [LHsTyVarBndr name]
711 -- ^ Type variables. Depending on 'con_res' this describes the
712 -- follewing entities
714 -- - ResTyH98: the constructor's *existential* type variables
715 -- - ResTyGADT: *all* the constructor's quantified type variables
717 , con_cxt :: LHsContext name
718 -- ^ The context. This /does not/ include the \"stupid theta\" which
719 -- lives only in the 'TyData' decl.
721 , con_details :: HsConDeclDetails name
722 -- ^ The main payload
724 , con_res :: ResType name
725 -- ^ Result type of the constructor
727 , con_doc :: Maybe LHsDocString
728 -- ^ A possible Haddock comment.
730 , con_old_rec :: Bool
731 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
732 -- GADT-style record decl C { blah } :: T a b
733 -- Remove this when we no longer parse this stuff, and hence do not
734 -- need to report decprecated use
735 } deriving (Data, Typeable)
737 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
739 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
740 hsConDeclArgTys (PrefixCon tys) = tys
741 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
742 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
745 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
746 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
747 -- and here is its result type
748 deriving (Data, Typeable)
750 instance OutputableBndr name => Outputable (ResType name) where
752 ppr ResTyH98 = ptext (sLit "ResTyH98")
753 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
757 hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
758 -- See tyClDeclNames for what this does
759 -- The function is boringly complicated because of the records
760 -- And since we only have equality, we have to be a little careful
762 = snd (foldl do_one ([], []) cons)
764 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
765 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
767 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
768 (map cd_fld_name flds)
770 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
771 = (flds_seen, lname:acc)
776 instance (OutputableBndr name) => Outputable (ConDecl name) where
779 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
780 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
781 , con_cxt = cxt, con_details = details
782 , con_res = ResTyH98, con_doc = doc })
783 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
785 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
786 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
787 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
789 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
790 , con_cxt = cxt, con_details = PrefixCon arg_tys
791 , con_res = ResTyGADT res_ty })
792 = ppr con <+> dcolon <+>
793 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
795 mk_fun_ty a b = noLoc (HsFunTy a b)
797 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
798 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
799 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
800 pprConDeclFields fields <+> arrow <+> ppr res_ty]
802 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
803 = pprPanic "pprConDecl" (ppr con)
804 -- In GADT syntax we don't allow infix constructors
807 %************************************************************************
809 \subsection[InstDecl]{An instance declaration
811 %************************************************************************
814 type LInstDecl name = Located (InstDecl name)
817 = InstDecl (LHsType name) -- Context => Class Instance-type
818 -- Using a polytype means that the renamer conveniently
819 -- figures out the quantified type variables for us.
821 [LSig name] -- User-supplied pragmatic info
822 [LTyClDecl name]-- Associated types (ie, 'TyData' and
824 deriving (Data, Typeable)
826 instance (OutputableBndr name) => Outputable (InstDecl name) where
828 ppr (InstDecl inst_ty binds uprags ats)
829 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
830 , nest 4 $ vcat (map ppr ats)
831 , nest 4 $ vcat (map ppr uprags)
832 , nest 4 $ pprLHsBinds binds ]
834 -- Extract the declarations of associated types from an instance
836 instDeclATs :: InstDecl name -> [LTyClDecl name]
837 instDeclATs (InstDecl _ _ _ ats) = ats
840 %************************************************************************
842 \subsection[DerivDecl]{A stand-alone instance deriving declaration
844 %************************************************************************
847 type LDerivDecl name = Located (DerivDecl name)
849 data DerivDecl name = DerivDecl (LHsType name)
850 deriving (Data, Typeable)
852 instance (OutputableBndr name) => Outputable (DerivDecl name) where
854 = hsep [ptext (sLit "deriving instance"), ppr ty]
857 %************************************************************************
859 \subsection[DefaultDecl]{A @default@ declaration}
861 %************************************************************************
863 There can only be one default declaration per module, but it is hard
864 for the parser to check that; we pass them all through in the abstract
865 syntax, and that restriction must be checked in the front end.
868 type LDefaultDecl name = Located (DefaultDecl name)
870 data DefaultDecl name
871 = DefaultDecl [LHsType name]
872 deriving (Data, Typeable)
874 instance (OutputableBndr name)
875 => Outputable (DefaultDecl name) where
877 ppr (DefaultDecl tys)
878 = ptext (sLit "default") <+> parens (interpp'SP tys)
881 %************************************************************************
883 \subsection{Foreign function interface declaration}
885 %************************************************************************
889 -- foreign declarations are distinguished as to whether they define or use a
892 -- * the Boolean value indicates whether the pre-standard deprecated syntax
895 type LForeignDecl name = Located (ForeignDecl name)
897 data ForeignDecl name
898 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
899 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
900 deriving (Data, Typeable)
902 -- Specification Of an imported external entity in dependence on the calling
905 data ForeignImport = -- import of a C entity
907 -- * the two strings specifying a header file or library
908 -- may be empty, which indicates the absence of a
909 -- header or object specification (both are not used
910 -- in the case of `CWrapper' and when `CFunction'
911 -- has a dynamic target)
913 -- * the calling convention is irrelevant for code
914 -- generation in the case of `CLabel', but is needed
915 -- for pretty printing
917 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
919 CImport CCallConv -- ccall or stdcall
920 Safety -- safe or unsafe
921 FastString -- name of C header
922 CImportSpec -- details of the C entity
923 deriving (Data, Typeable)
925 -- details of an external C entity
927 data CImportSpec = CLabel CLabelString -- import address of a C label
928 | CFunction CCallTarget -- static or dynamic function
929 | CWrapper -- wrapper to expose closures
931 deriving (Data, Typeable)
933 -- specification of an externally exported entity in dependence on the calling
936 data ForeignExport = CExport CExportSpec -- contains the calling convention
937 deriving (Data, Typeable)
939 -- pretty printing of foreign declarations
942 instance OutputableBndr name => Outputable (ForeignDecl name) where
943 ppr (ForeignImport n ty fimport) =
944 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
945 2 (dcolon <+> ppr ty)
946 ppr (ForeignExport n ty fexport) =
947 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
948 2 (dcolon <+> ppr ty)
950 instance Outputable ForeignImport where
951 ppr (CImport cconv safety header spec) =
952 ppr cconv <+> ppr safety <+>
953 char '"' <> pprCEntity spec <> char '"'
955 pp_hdr = if nullFS header then empty else ftext header
957 pprCEntity (CLabel lbl) =
958 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
959 pprCEntity (CFunction (StaticTarget lbl _)) =
960 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
961 pprCEntity (CFunction (DynamicTarget)) =
962 ptext (sLit "dynamic")
963 pprCEntity (CWrapper) = ptext (sLit "wrapper")
965 instance Outputable ForeignExport where
966 ppr (CExport (CExportStatic lbl cconv)) =
967 ppr cconv <+> char '"' <> ppr lbl <> char '"'
971 %************************************************************************
973 \subsection{Transformation rules}
975 %************************************************************************
978 type LRuleDecl name = Located (RuleDecl name)
981 = HsRule -- Source rule
982 RuleName -- Rule name
984 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
985 (Located (HsExpr name)) -- LHS
986 NameSet -- Free-vars from the LHS
987 (Located (HsExpr name)) -- RHS
988 NameSet -- Free-vars from the RHS
989 deriving (Data, Typeable)
992 = RuleBndr (Located name)
993 | RuleBndrSig (Located name) (LHsType name)
994 deriving (Data, Typeable)
996 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
997 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
999 instance OutputableBndr name => Outputable (RuleDecl name) where
1000 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1001 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1002 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
1003 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1005 pp_forall | null ns = empty
1006 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1008 instance OutputableBndr name => Outputable (RuleBndr name) where
1009 ppr (RuleBndr name) = ppr name
1010 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1013 %************************************************************************
1015 \subsection[DocDecl]{Document comments}
1017 %************************************************************************
1021 type LDocDecl = Located (DocDecl)
1024 = DocCommentNext HsDocString
1025 | DocCommentPrev HsDocString
1026 | DocCommentNamed String HsDocString
1027 | DocGroup Int HsDocString
1028 deriving (Data, Typeable)
1030 -- Okay, I need to reconstruct the document comments, but for now:
1031 instance Outputable DocDecl where
1032 ppr _ = text "<document comment>"
1034 docDeclDoc :: DocDecl -> HsDocString
1035 docDeclDoc (DocCommentNext d) = d
1036 docDeclDoc (DocCommentPrev d) = d
1037 docDeclDoc (DocCommentNamed _ d) = d
1038 docDeclDoc (DocGroup _ d) = d
1042 %************************************************************************
1044 \subsection[DeprecDecl]{Deprecations}
1046 %************************************************************************
1048 We use exported entities for things to deprecate.
1051 type LWarnDecl name = Located (WarnDecl name)
1053 data WarnDecl name = Warning name WarningTxt
1054 deriving (Data, Typeable)
1056 instance OutputableBndr name => Outputable (WarnDecl name) where
1057 ppr (Warning thing txt)
1058 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1061 %************************************************************************
1063 \subsection[AnnDecl]{Annotations}
1065 %************************************************************************
1068 type LAnnDecl name = Located (AnnDecl name)
1070 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1071 deriving (Data, Typeable)
1073 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1074 ppr (HsAnnotation provenance expr)
1075 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1078 data AnnProvenance name = ValueAnnProvenance name
1079 | TypeAnnProvenance name
1080 | ModuleAnnProvenance
1081 deriving (Data, Typeable)
1083 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1084 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1085 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1086 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1088 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1089 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1090 modifyAnnProvenanceNameM fm prov =
1092 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1093 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1094 ModuleAnnProvenance -> return ModuleAnnProvenance
1096 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1097 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1098 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1099 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name