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,
130 hs_tyclds :: [[LTyClDecl id]],
131 -- A list of mutually-recursive groups
132 -- Parser generates a singleton list;
133 -- renamer does dependency analysis
135 hs_instds :: [LInstDecl id],
136 hs_derivds :: [LDerivDecl id],
138 hs_fixds :: [LFixitySig id],
139 -- Snaffled out of both top-level fixity signatures,
140 -- and those in class declarations
142 hs_defds :: [LDefaultDecl id],
143 hs_fords :: [LForeignDecl id],
144 hs_warnds :: [LWarnDecl id],
145 hs_annds :: [LAnnDecl id],
146 hs_ruleds :: [LRuleDecl id],
148 hs_docs :: [LDocDecl]
149 } deriving (Data, Typeable)
151 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
152 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
153 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
155 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
156 hs_fixds = [], hs_defds = [], hs_annds = [],
157 hs_fords = [], hs_warnds = [], hs_ruleds = [],
158 hs_valds = error "emptyGroup hs_valds: Can't happen",
161 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
164 hs_valds = val_groups1,
167 hs_derivds = derivds1,
176 hs_valds = val_groups2,
179 hs_derivds = derivds2,
189 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
190 hs_tyclds = tyclds1 ++ tyclds2,
191 hs_instds = instds1 ++ instds2,
192 hs_derivds = derivds1 ++ derivds2,
193 hs_fixds = fixds1 ++ fixds2,
194 hs_annds = annds1 ++ annds2,
195 hs_defds = defds1 ++ defds2,
196 hs_fords = fords1 ++ fords2,
197 hs_warnds = warnds1 ++ warnds2,
198 hs_ruleds = rulds1 ++ rulds2,
199 hs_docs = docs1 ++ docs2 }
203 instance OutputableBndr name => Outputable (HsDecl name) where
204 ppr (TyClD dcl) = ppr dcl
205 ppr (ValD binds) = ppr binds
206 ppr (DefD def) = ppr def
207 ppr (InstD inst) = ppr inst
208 ppr (DerivD deriv) = ppr deriv
209 ppr (ForD fd) = ppr fd
210 ppr (SigD sd) = ppr sd
211 ppr (RuleD rd) = ppr rd
212 ppr (WarningD wd) = ppr wd
213 ppr (AnnD ad) = ppr ad
214 ppr (SpliceD dd) = ppr dd
215 ppr (DocD doc) = ppr doc
216 ppr (QuasiQuoteD qq) = ppr qq
218 instance OutputableBndr name => Outputable (HsGroup name) where
219 ppr (HsGroup { hs_valds = val_decls,
220 hs_tyclds = tycl_decls,
221 hs_instds = inst_decls,
222 hs_derivds = deriv_decls,
223 hs_fixds = fix_decls,
224 hs_warnds = deprec_decls,
225 hs_annds = ann_decls,
226 hs_fords = foreign_decls,
227 hs_defds = default_decls,
228 hs_ruleds = rule_decls })
230 [ppr_ds fix_decls, ppr_ds default_decls,
231 ppr_ds deprec_decls, ppr_ds ann_decls,
233 if isEmptyValBinds val_decls
235 else Just (ppr val_decls),
236 ppr_ds (concat tycl_decls),
239 ppr_ds foreign_decls]
241 ppr_ds :: Outputable a => [a] -> Maybe SDoc
243 ppr_ds ds = Just (vcat (map ppr ds))
245 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
246 -- Concatenate vertically with white-space between non-blanks
248 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
249 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
252 = SpliceDecl -- Top level splice
253 (Located (HsExpr id))
254 HsExplicitFlag -- Explicit <=> $(f x y)
255 -- Implicit <=> f x y, i.e. a naked top level expression
256 deriving (Data, Typeable)
258 instance OutputableBndr name => Outputable (SpliceDecl name) where
259 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
263 %************************************************************************
265 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
267 %************************************************************************
269 --------------------------------
271 --------------------------------
273 Here is the story about the implicit names that go with type, class,
274 and instance decls. It's a bit tricky, so pay attention!
276 "Implicit" (or "system") binders
277 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 Each data type decl defines
279 a worker name for each constructor
280 to-T and from-T convertors
281 Each class decl defines
282 a tycon for the class
283 a data constructor for that tycon
284 the worker for that constructor
285 a selector for each superclass
287 All have occurrence names that are derived uniquely from their parent
290 None of these get separate definitions in an interface file; they are
291 fully defined by the data or class decl. But they may *occur* in
292 interface files, of course. Any such occurrence must haul in the
293 relevant type or class decl.
296 - Ensure they "point to" the parent data/class decl
297 when loading that decl from an interface file
298 (See RnHiFiles.getSysBinders)
300 - When typechecking the decl, we build the implicit TyCons and Ids.
301 When doing so we look them up in the name cache (RnEnv.lookupSysName),
302 to ensure correct module and provenance is set
304 These are the two places that we have to conjure up the magic derived
305 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
309 - Occurrence name is derived uniquely from the method name
312 - If there is a default method name at all, it's recorded in
313 the ClassOpSig (in HsBinds), in the DefMeth field.
314 (DefMeth is defined in Class.lhs)
316 Source-code class decls and interface-code class decls are treated subtly
317 differently, which has given me a great deal of confusion over the years.
318 Here's the deal. (We distinguish the two cases because source-code decls
319 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
321 In *source-code* class declarations:
323 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
324 This is done by RdrHsSyn.mkClassOpSigDM
326 - The renamer renames it to a Name
328 - During typechecking, we generate a binding for each $dm for
329 which there's a programmer-supplied default method:
334 We generate a binding for $dmop1 but not for $dmop2.
335 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
336 The Name for $dmop2 is simply discarded.
338 In *interface-file* class declarations:
339 - When parsing, we see if there's an explicit programmer-supplied default method
340 because there's an '=' sign to indicate it:
342 op1 = :: <type> -- NB the '='
344 We use this info to generate a DefMeth with a suitable RdrName for op1,
345 and a NoDefMeth for op2
346 - The interface file has a separate definition for $dmop1, with unfolding etc.
347 - The renamer renames it to a Name.
348 - The renamer treats $dmop1 as a free variable of the declaration, so that
349 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
350 This doesn't happen for source code class decls, because they *bind* the default method.
354 Each instance declaration gives rise to one dictionary function binding.
356 The type checker makes up new source-code instance declarations
357 (e.g. from 'deriving' or generic default methods --- see
358 TcInstDcls.tcInstDecls1). So we can't generate the names for
359 dictionary functions in advance (we don't know how many we need).
361 On the other hand for interface-file instance declarations, the decl
362 specifies the name of the dictionary function, and it has a binding elsewhere
363 in the interface file:
364 instance {Eq Int} = dEqInt
365 dEqInt :: {Eq Int} <pragma info>
367 So again we treat source code and interface file code slightly differently.
370 - Source code instance decls have a Nothing in the (Maybe name) field
371 (see data InstDecl below)
373 - The typechecker makes up a Local name for the dict fun for any source-code
374 instance decl, whether it comes from a source-code instance decl, or whether
375 the instance decl is derived from some other construct (e.g. 'deriving').
377 - The occurrence name it chooses is derived from the instance decl (just for
378 documentation really) --- e.g. dNumInt. Two dict funs may share a common
379 occurrence name, but will have different uniques. E.g.
380 instance Foo [Int] where ...
381 instance Foo [Bool] where ...
382 These might both be dFooList
384 - The CoreTidy phase externalises the name, and ensures the occurrence name is
385 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
387 - We can take this relaxed approach (changing the occurrence name later)
388 because dict fun Ids are not captured in a TyCon or Class (unlike default
389 methods, say). Instead, they are kept separately in the InstEnv. This
390 makes it easy to adjust them after compiling a module. (Once we've finished
391 compiling that module, they don't change any more.)
395 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
396 in the (Maybe name) field.
398 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
399 suck in the dfun binding
403 -- Representation of indexed types
404 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
405 -- Family kind signatures are represented by the variant `TyFamily'. It
406 -- covers "type family", "newtype family", and "data family" declarations,
407 -- distinguished by the value of the field `tcdFlavour'.
409 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
410 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
412 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
413 -- synonym declaration and 'tcdVars' contains the type parameters of the
416 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
417 -- 'pats' are type patterns for the type-indexes of the type constructor
418 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
419 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
420 -- *not* 'length tcdVars'.
422 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
424 type LTyClDecl name = Located (TyClDecl name)
426 -- | A type or class declaration.
429 tcdLName :: Located name,
430 tcdExtName :: Maybe FastString
434 | -- | @type/data family T :: *->*@
435 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
436 tcdLName :: Located name, -- type constructor
437 tcdTyVars :: [LHsTyVarBndr name], -- type variables
438 tcdKind :: Maybe Kind -- result kind
442 | -- | Declares a data type or newtype, giving its construcors
444 -- data/newtype T a = <constrs>
445 -- data/newtype instance T [a] = <constrs>
447 TyData { tcdND :: NewOrData,
448 tcdCtxt :: LHsContext name, -- ^ Context
449 tcdLName :: Located name, -- ^ Type constructor
451 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
453 tcdTyPats :: Maybe [LHsType name],
456 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
457 -- in this case @tcdTyVars = fv( tcdTyPats )@.
458 -- @Nothing@ for everything else.
460 tcdKindSig:: Maybe Kind,
461 -- ^ Optional kind signature.
463 -- @(Just k)@ for a GADT-style @data@, or @data
464 -- instance@ decl with explicit kind sig
466 tcdCons :: [LConDecl name],
467 -- ^ Data constructors
469 -- For @data T a = T1 | T2 a@
470 -- the 'LConDecl's all have 'ResTyH98'.
471 -- For @data T a where { T1 :: T a }@
472 -- the 'LConDecls' all have 'ResTyGADT'.
474 tcdDerivs :: Maybe [LHsType name]
475 -- ^ Derivings; @Nothing@ => not specified,
476 -- @Just []@ => derive exactly what is asked
478 -- These "types" must be of form
480 -- forall ab. C ty1 ty2
482 -- Typically the foralls and ty args are empty, but they
483 -- are non-empty for the newtype-deriving case
486 | TySynonym { tcdLName :: Located name, -- ^ type constructor
487 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
488 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
489 -- See comments for tcdTyPats in TyData
490 -- 'Nothing' => vanilla type synonym
492 tcdSynRhs :: LHsType name -- ^ synonym expansion
495 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
496 tcdLName :: Located name, -- ^ Name of the class
497 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
498 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
499 tcdSigs :: [LSig name], -- ^ Methods' signatures
500 tcdMeths :: LHsBinds name, -- ^ Default methods
501 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
502 -- only 'TyFamily' and
504 -- latter for defaults
505 tcdDocs :: [LDocDecl] -- ^ Haddock docs
507 deriving (Data, Typeable)
510 = NewType -- ^ @newtype Blah ...@
511 | DataType -- ^ @data Blah ...@
512 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
515 = TypeFamily -- ^ @type family ...@
516 | DataFamily -- ^ @data family ...@
517 deriving (Data, Typeable)
523 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
525 isDataDecl :: TyClDecl name -> Bool
526 isDataDecl (TyData {}) = True
527 isDataDecl _other = False
529 -- | type or type instance declaration
530 isTypeDecl :: TyClDecl name -> Bool
531 isTypeDecl (TySynonym {}) = True
532 isTypeDecl _other = False
534 -- | vanilla Haskell type synonym (ie, not a type instance)
535 isSynDecl :: TyClDecl name -> Bool
536 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
537 isSynDecl _other = False
540 isClassDecl :: TyClDecl name -> Bool
541 isClassDecl (ClassDecl {}) = True
542 isClassDecl _ = False
544 -- | type family declaration
545 isFamilyDecl :: TyClDecl name -> Bool
546 isFamilyDecl (TyFamily {}) = True
547 isFamilyDecl _other = False
549 -- | family instance (types, newtypes, and data types)
550 isFamInstDecl :: TyClDecl name -> Bool
553 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
560 tcdName :: TyClDecl name -> name
561 tcdName decl = unLoc (tcdLName decl)
563 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
564 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
565 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
566 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
567 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
568 tyClDeclTyVars (ForeignType {}) = []
572 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
573 -- class, synonym decls, data, newtype, family decls, family instances
575 = (count isClassDecl decls,
576 count isSynDecl decls, -- excluding...
577 count isDataTy decls, -- ...family...
578 count isNewTy decls, -- ...instances
579 count isFamilyDecl decls,
580 count isFamInstDecl decls)
582 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
585 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
590 instance OutputableBndr name
591 => Outputable (TyClDecl name) where
593 ppr (ForeignType {tcdLName = ltycon})
594 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
596 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
597 tcdTyVars = tyvars, tcdKind = mb_kind})
598 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
600 pp_flavour = case flavour of
601 TypeFamily -> ptext (sLit "type family")
602 DataFamily -> ptext (sLit "data family")
604 pp_kind = case mb_kind of
606 Just kind -> dcolon <+> pprKind kind
608 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
609 tcdSynRhs = mono_ty})
610 = hang (ptext (sLit "type") <+>
611 (if isJust typats then ptext (sLit "instance") else empty) <+>
612 pp_decl_head [] ltycon tyvars typats <+>
616 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
617 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
618 tcdCons = condecls, tcdDerivs = derivings})
619 = pp_tydecl (null condecls && isJust mb_sig)
621 (if isJust typats then ptext (sLit "instance") else empty) <+>
622 pp_decl_head (unLoc context) ltycon tyvars typats <+>
624 (pp_condecls condecls)
627 ppr_sig Nothing = empty
628 ppr_sig (Just kind) = dcolon <+> pprKind kind
630 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
632 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
633 | null sigs && null ats -- No "where" part
636 | otherwise -- Laid out
637 = sep [hsep [top_matter, ptext (sLit "where {")],
638 nest 4 (sep [ sep (map ppr_semi ats)
639 , sep (map ppr_semi sigs)
640 , pprLHsBinds methods
643 top_matter = ptext (sLit "class")
644 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
645 <+> pprFundeps (map unLoc fds)
646 ppr_semi :: Outputable a => a -> SDoc
647 ppr_semi decl = ppr decl <> semi
649 pp_decl_head :: OutputableBndr name
652 -> [LHsTyVarBndr name]
653 -> Maybe [LHsType name]
655 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
656 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
657 pp_decl_head context thing _ (Just typats) -- explicit type patterns
658 = hsep [ pprHsContext context, ppr thing
659 , hsep (map (pprParendHsType.unLoc) typats)]
661 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
662 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
663 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
664 pp_condecls cs -- In H98 syntax
665 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
667 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
668 pp_tydecl True pp_head _ _
670 pp_tydecl False pp_head pp_decl_rhs derivings
671 = hang pp_head 4 (sep [
675 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
678 instance Outputable NewOrData where
679 ppr NewType = ptext (sLit "newtype")
680 ppr DataType = ptext (sLit "data")
684 %************************************************************************
686 \subsection[ConDecl]{A data-constructor declaration}
688 %************************************************************************
691 type LConDecl name = Located (ConDecl name)
693 -- data T b = forall a. Eq a => MkT a b
694 -- MkT :: forall b a. Eq a => MkT a b
697 -- MkT1 :: Int -> T Int
699 -- data T = Int `MkT` Int
703 -- Int `MkT` Int :: T Int
707 { con_name :: Located name
708 -- ^ Constructor name. This is used for the DataCon itself, and for
709 -- the user-callable wrapper Id.
711 , con_explicit :: HsExplicitFlag
712 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
714 , con_qvars :: [LHsTyVarBndr name]
715 -- ^ Type variables. Depending on 'con_res' this describes the
716 -- follewing entities
718 -- - ResTyH98: the constructor's *existential* type variables
719 -- - ResTyGADT: *all* the constructor's quantified type variables
721 , con_cxt :: LHsContext name
722 -- ^ The context. This /does not/ include the \"stupid theta\" which
723 -- lives only in the 'TyData' decl.
725 , con_details :: HsConDeclDetails name
726 -- ^ The main payload
728 , con_res :: ResType name
729 -- ^ Result type of the constructor
731 , con_doc :: Maybe LHsDocString
732 -- ^ A possible Haddock comment.
734 , con_old_rec :: Bool
735 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
736 -- GADT-style record decl C { blah } :: T a b
737 -- Remove this when we no longer parse this stuff, and hence do not
738 -- need to report decprecated use
739 } deriving (Data, Typeable)
741 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
743 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
744 hsConDeclArgTys (PrefixCon tys) = tys
745 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
746 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
749 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
750 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
751 -- and here is its result type
752 deriving (Data, Typeable)
754 instance OutputableBndr name => Outputable (ResType name) where
756 ppr ResTyH98 = ptext (sLit "ResTyH98")
757 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
762 instance (OutputableBndr name) => Outputable (ConDecl name) where
765 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
766 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
767 , con_cxt = cxt, con_details = details
768 , con_res = ResTyH98, con_doc = doc })
769 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
771 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
772 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
773 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
775 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
776 , con_cxt = cxt, con_details = PrefixCon arg_tys
777 , con_res = ResTyGADT res_ty })
778 = ppr con <+> dcolon <+>
779 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
781 mk_fun_ty a b = noLoc (HsFunTy a b)
783 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
784 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
785 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
786 pprConDeclFields fields <+> arrow <+> ppr res_ty]
788 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
789 = pprPanic "pprConDecl" (ppr con)
790 -- In GADT syntax we don't allow infix constructors
793 %************************************************************************
795 \subsection[InstDecl]{An instance declaration
797 %************************************************************************
800 type LInstDecl name = Located (InstDecl name)
803 = InstDecl (LHsType name) -- Context => Class Instance-type
804 -- Using a polytype means that the renamer conveniently
805 -- figures out the quantified type variables for us.
807 [LSig name] -- User-supplied pragmatic info
808 [LTyClDecl name]-- Associated types (ie, 'TyData' and
810 deriving (Data, Typeable)
812 instance (OutputableBndr name) => Outputable (InstDecl name) where
814 ppr (InstDecl inst_ty binds uprags ats)
815 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
816 , nest 4 $ vcat (map ppr ats)
817 , nest 4 $ vcat (map ppr uprags)
818 , nest 4 $ pprLHsBinds binds ]
820 -- Extract the declarations of associated types from an instance
822 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
823 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
826 %************************************************************************
828 \subsection[DerivDecl]{A stand-alone instance deriving declaration
830 %************************************************************************
833 type LDerivDecl name = Located (DerivDecl name)
835 data DerivDecl name = DerivDecl (LHsType name)
836 deriving (Data, Typeable)
838 instance (OutputableBndr name) => Outputable (DerivDecl name) where
840 = hsep [ptext (sLit "deriving instance"), ppr ty]
843 %************************************************************************
845 \subsection[DefaultDecl]{A @default@ declaration}
847 %************************************************************************
849 There can only be one default declaration per module, but it is hard
850 for the parser to check that; we pass them all through in the abstract
851 syntax, and that restriction must be checked in the front end.
854 type LDefaultDecl name = Located (DefaultDecl name)
856 data DefaultDecl name
857 = DefaultDecl [LHsType name]
858 deriving (Data, Typeable)
860 instance (OutputableBndr name)
861 => Outputable (DefaultDecl name) where
863 ppr (DefaultDecl tys)
864 = ptext (sLit "default") <+> parens (interpp'SP tys)
867 %************************************************************************
869 \subsection{Foreign function interface declaration}
871 %************************************************************************
875 -- foreign declarations are distinguished as to whether they define or use a
878 -- * the Boolean value indicates whether the pre-standard deprecated syntax
881 type LForeignDecl name = Located (ForeignDecl name)
883 data ForeignDecl name
884 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
885 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
886 deriving (Data, Typeable)
888 -- Specification Of an imported external entity in dependence on the calling
891 data ForeignImport = -- import of a C entity
893 -- * the two strings specifying a header file or library
894 -- may be empty, which indicates the absence of a
895 -- header or object specification (both are not used
896 -- in the case of `CWrapper' and when `CFunction'
897 -- has a dynamic target)
899 -- * the calling convention is irrelevant for code
900 -- generation in the case of `CLabel', but is needed
901 -- for pretty printing
903 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
905 CImport CCallConv -- ccall or stdcall
906 Safety -- interruptible, safe or unsafe
907 FastString -- name of C header
908 CImportSpec -- details of the C entity
909 deriving (Data, Typeable)
911 -- details of an external C entity
913 data CImportSpec = CLabel CLabelString -- import address of a C label
914 | CFunction CCallTarget -- static or dynamic function
915 | CWrapper -- wrapper to expose closures
917 deriving (Data, Typeable)
919 -- specification of an externally exported entity in dependence on the calling
922 data ForeignExport = CExport CExportSpec -- contains the calling convention
923 deriving (Data, Typeable)
925 -- pretty printing of foreign declarations
928 instance OutputableBndr name => Outputable (ForeignDecl name) where
929 ppr (ForeignImport n ty fimport) =
930 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
931 2 (dcolon <+> ppr ty)
932 ppr (ForeignExport n ty fexport) =
933 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
934 2 (dcolon <+> ppr ty)
936 instance Outputable ForeignImport where
937 ppr (CImport cconv safety header spec) =
938 ppr cconv <+> ppr safety <+>
939 char '"' <> pprCEntity spec <> char '"'
941 pp_hdr = if nullFS header then empty else ftext header
943 pprCEntity (CLabel lbl) =
944 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
945 pprCEntity (CFunction (StaticTarget lbl _)) =
946 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
947 pprCEntity (CFunction (DynamicTarget)) =
948 ptext (sLit "dynamic")
949 pprCEntity (CWrapper) = ptext (sLit "wrapper")
951 instance Outputable ForeignExport where
952 ppr (CExport (CExportStatic lbl cconv)) =
953 ppr cconv <+> char '"' <> ppr lbl <> char '"'
957 %************************************************************************
959 \subsection{Transformation rules}
961 %************************************************************************
964 type LRuleDecl name = Located (RuleDecl name)
967 = HsRule -- Source rule
968 RuleName -- Rule name
970 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
971 (Located (HsExpr name)) -- LHS
972 NameSet -- Free-vars from the LHS
973 (Located (HsExpr name)) -- RHS
974 NameSet -- Free-vars from the RHS
975 deriving (Data, Typeable)
978 = RuleBndr (Located name)
979 | RuleBndrSig (Located name) (LHsType name)
980 deriving (Data, Typeable)
982 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
983 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
985 instance OutputableBndr name => Outputable (RuleDecl name) where
986 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
987 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
988 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
989 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
991 pp_forall | null ns = empty
992 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
994 instance OutputableBndr name => Outputable (RuleBndr name) where
995 ppr (RuleBndr name) = ppr name
996 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
999 %************************************************************************
1001 \subsection[DocDecl]{Document comments}
1003 %************************************************************************
1007 type LDocDecl = Located (DocDecl)
1010 = DocCommentNext HsDocString
1011 | DocCommentPrev HsDocString
1012 | DocCommentNamed String HsDocString
1013 | DocGroup Int HsDocString
1014 deriving (Data, Typeable)
1016 -- Okay, I need to reconstruct the document comments, but for now:
1017 instance Outputable DocDecl where
1018 ppr _ = text "<document comment>"
1020 docDeclDoc :: DocDecl -> HsDocString
1021 docDeclDoc (DocCommentNext d) = d
1022 docDeclDoc (DocCommentPrev d) = d
1023 docDeclDoc (DocCommentNamed _ d) = d
1024 docDeclDoc (DocGroup _ d) = d
1028 %************************************************************************
1030 \subsection[DeprecDecl]{Deprecations}
1032 %************************************************************************
1034 We use exported entities for things to deprecate.
1037 type LWarnDecl name = Located (WarnDecl name)
1039 data WarnDecl name = Warning name WarningTxt
1040 deriving (Data, Typeable)
1042 instance OutputableBndr name => Outputable (WarnDecl name) where
1043 ppr (Warning thing txt)
1044 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1047 %************************************************************************
1049 \subsection[AnnDecl]{Annotations}
1051 %************************************************************************
1054 type LAnnDecl name = Located (AnnDecl name)
1056 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1057 deriving (Data, Typeable)
1059 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1060 ppr (HsAnnotation provenance expr)
1061 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1064 data AnnProvenance name = ValueAnnProvenance name
1065 | TypeAnnProvenance name
1066 | ModuleAnnProvenance
1067 deriving (Data, Typeable)
1069 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1070 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1071 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1072 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1074 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1075 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1076 modifyAnnProvenanceNameM fm prov =
1078 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1079 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1080 ModuleAnnProvenance -> return ModuleAnnProvenance
1082 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1083 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1084 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1085 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name