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
16 -- | Abstract syntax of global declarations.
18 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
19 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
21 -- * Toplevel declarations
23 -- ** Class or type declarations
24 TyClDecl(..), LTyClDecl,
25 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
26 isFamInstDecl, tcdName, tyClDeclNames, tyClDeclTyVars,
28 -- ** Instance declarations
29 InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
31 -- ** Standalone deriving declarations
32 DerivDecl(..), LDerivDecl,
33 -- ** @RULE@ declarations
34 RuleDecl(..), LRuleDecl, RuleBndr(..),
35 collectRuleBndrSigTys,
36 -- ** @default@ declarations
37 DefaultDecl(..), LDefaultDecl,
38 -- ** Top-level template haskell splice
40 -- ** Foreign function interface declarations
41 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
42 CImportSpec(..), FoType(..),
43 -- ** Data-constructor declarations
44 ConDecl(..), LConDecl, ResType(..),
45 HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
46 -- ** Document comments
47 DocDecl(..), LDocDecl, docDeclDoc,
49 WarnDecl(..), LWarnDecl,
51 AnnDecl(..), LAnnDecl,
52 AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
55 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups
59 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
60 -- Because Expr imports Decls via HsBracket
67 import {- Kind parts of -} Type
78 import Control.Monad ( liftM )
79 import Data.Maybe ( isJust )
82 %************************************************************************
84 \subsection[HsDecl]{Declarations}
86 %************************************************************************
89 type LHsDecl id = Located (HsDecl id)
91 -- | A Haskell Declaration
93 = TyClD (TyClDecl id) -- ^ A type or class declaration.
94 | InstD (InstDecl id) -- ^ An instance declaration.
95 | DerivD (DerivDecl id)
98 | DefD (DefaultDecl id)
99 | ForD (ForeignDecl id)
100 | WarningD (WarnDecl id)
102 | RuleD (RuleDecl id)
103 | SpliceD (SpliceDecl id)
107 -- NB: all top-level fixity decls are contained EITHER
109 -- OR in the ClassDecls in TyClDs
112 -- a) data constructors
113 -- b) class methods (but they can be also done in the
114 -- signatures of class decls)
115 -- c) imported functions (that have an IfacSig)
116 -- d) top level decls
118 -- The latter is for class methods only
120 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
121 -- fed to the renamer.
124 hs_valds :: HsValBinds id,
125 hs_tyclds :: [LTyClDecl id],
126 hs_instds :: [LInstDecl id],
127 hs_derivds :: [LDerivDecl id],
129 hs_fixds :: [LFixitySig id],
130 -- Snaffled out of both top-level fixity signatures,
131 -- and those in class declarations
133 hs_defds :: [LDefaultDecl id],
134 hs_fords :: [LForeignDecl id],
135 hs_warnds :: [LWarnDecl id],
136 hs_annds :: [LAnnDecl id],
137 hs_ruleds :: [LRuleDecl id],
139 hs_docs :: [LDocDecl id]
142 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
143 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
144 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
146 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
147 hs_fixds = [], hs_defds = [], hs_annds = [],
148 hs_fords = [], hs_warnds = [], hs_ruleds = [],
149 hs_valds = error "emptyGroup hs_valds: Can't happen",
152 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
155 hs_valds = val_groups1,
158 hs_derivds = derivds1,
167 hs_valds = val_groups2,
170 hs_derivds = derivds2,
180 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
181 hs_tyclds = tyclds1 ++ tyclds2,
182 hs_instds = instds1 ++ instds2,
183 hs_derivds = derivds1 ++ derivds2,
184 hs_fixds = fixds1 ++ fixds2,
185 hs_annds = annds1 ++ annds2,
186 hs_defds = defds1 ++ defds2,
187 hs_fords = fords1 ++ fords2,
188 hs_warnds = warnds1 ++ warnds2,
189 hs_ruleds = rulds1 ++ rulds2,
190 hs_docs = docs1 ++ docs2 }
194 instance OutputableBndr name => Outputable (HsDecl name) where
195 ppr (TyClD dcl) = ppr dcl
196 ppr (ValD binds) = ppr binds
197 ppr (DefD def) = ppr def
198 ppr (InstD inst) = ppr inst
199 ppr (DerivD deriv) = ppr deriv
200 ppr (ForD fd) = ppr fd
201 ppr (SigD sd) = ppr sd
202 ppr (RuleD rd) = ppr rd
203 ppr (WarningD wd) = ppr wd
204 ppr (AnnD ad) = ppr ad
205 ppr (SpliceD dd) = ppr dd
206 ppr (DocD doc) = ppr doc
208 instance OutputableBndr name => Outputable (HsGroup name) where
209 ppr (HsGroup { hs_valds = val_decls,
210 hs_tyclds = tycl_decls,
211 hs_instds = inst_decls,
212 hs_derivds = deriv_decls,
213 hs_fixds = fix_decls,
214 hs_warnds = deprec_decls,
215 hs_annds = ann_decls,
216 hs_fords = foreign_decls,
217 hs_defds = default_decls,
218 hs_ruleds = rule_decls })
219 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
220 ppr_ds deprec_decls, ppr_ds ann_decls,
223 ppr_ds tycl_decls, ppr_ds inst_decls,
225 ppr_ds foreign_decls]
228 ppr_ds ds = text "" $$ vcat (map ppr ds)
230 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
232 instance OutputableBndr name => Outputable (SpliceDecl name) where
233 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
237 %************************************************************************
239 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
241 %************************************************************************
243 --------------------------------
245 --------------------------------
247 Here is the story about the implicit names that go with type, class,
248 and instance decls. It's a bit tricky, so pay attention!
250 "Implicit" (or "system") binders
251 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
252 Each data type decl defines
253 a worker name for each constructor
254 to-T and from-T convertors
255 Each class decl defines
256 a tycon for the class
257 a data constructor for that tycon
258 the worker for that constructor
259 a selector for each superclass
261 All have occurrence names that are derived uniquely from their parent
264 None of these get separate definitions in an interface file; they are
265 fully defined by the data or class decl. But they may *occur* in
266 interface files, of course. Any such occurrence must haul in the
267 relevant type or class decl.
270 - Ensure they "point to" the parent data/class decl
271 when loading that decl from an interface file
272 (See RnHiFiles.getSysBinders)
274 - When typechecking the decl, we build the implicit TyCons and Ids.
275 When doing so we look them up in the name cache (RnEnv.lookupSysName),
276 to ensure correct module and provenance is set
278 These are the two places that we have to conjure up the magic derived
279 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
283 - Occurrence name is derived uniquely from the method name
286 - If there is a default method name at all, it's recorded in
287 the ClassOpSig (in HsBinds), in the DefMeth field.
288 (DefMeth is defined in Class.lhs)
290 Source-code class decls and interface-code class decls are treated subtly
291 differently, which has given me a great deal of confusion over the years.
292 Here's the deal. (We distinguish the two cases because source-code decls
293 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
295 In *source-code* class declarations:
297 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
298 This is done by RdrHsSyn.mkClassOpSigDM
300 - The renamer renames it to a Name
302 - During typechecking, we generate a binding for each $dm for
303 which there's a programmer-supplied default method:
308 We generate a binding for $dmop1 but not for $dmop2.
309 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
310 The Name for $dmop2 is simply discarded.
312 In *interface-file* class declarations:
313 - When parsing, we see if there's an explicit programmer-supplied default method
314 because there's an '=' sign to indicate it:
316 op1 = :: <type> -- NB the '='
318 We use this info to generate a DefMeth with a suitable RdrName for op1,
319 and a NoDefMeth for op2
320 - The interface file has a separate definition for $dmop1, with unfolding etc.
321 - The renamer renames it to a Name.
322 - The renamer treats $dmop1 as a free variable of the declaration, so that
323 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
324 This doesn't happen for source code class decls, because they *bind* the default method.
328 Each instance declaration gives rise to one dictionary function binding.
330 The type checker makes up new source-code instance declarations
331 (e.g. from 'deriving' or generic default methods --- see
332 TcInstDcls.tcInstDecls1). So we can't generate the names for
333 dictionary functions in advance (we don't know how many we need).
335 On the other hand for interface-file instance declarations, the decl
336 specifies the name of the dictionary function, and it has a binding elsewhere
337 in the interface file:
338 instance {Eq Int} = dEqInt
339 dEqInt :: {Eq Int} <pragma info>
341 So again we treat source code and interface file code slightly differently.
344 - Source code instance decls have a Nothing in the (Maybe name) field
345 (see data InstDecl below)
347 - The typechecker makes up a Local name for the dict fun for any source-code
348 instance decl, whether it comes from a source-code instance decl, or whether
349 the instance decl is derived from some other construct (e.g. 'deriving').
351 - The occurrence name it chooses is derived from the instance decl (just for
352 documentation really) --- e.g. dNumInt. Two dict funs may share a common
353 occurrence name, but will have different uniques. E.g.
354 instance Foo [Int] where ...
355 instance Foo [Bool] where ...
356 These might both be dFooList
358 - The CoreTidy phase externalises the name, and ensures the occurrence name is
359 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
361 - We can take this relaxed approach (changing the occurrence name later)
362 because dict fun Ids are not captured in a TyCon or Class (unlike default
363 methods, say). Instead, they are kept separately in the InstEnv. This
364 makes it easy to adjust them after compiling a module. (Once we've finished
365 compiling that module, they don't change any more.)
369 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
370 in the (Maybe name) field.
372 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
373 suck in the dfun binding
377 -- Representation of indexed types
378 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
379 -- Family kind signatures are represented by the variant `TyFamily'. It
380 -- covers "type family", "newtype family", and "data family" declarations,
381 -- distinguished by the value of the field `tcdFlavour'.
383 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
384 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
386 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
387 -- synonym declaration and 'tcdVars' contains the type parameters of the
390 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
391 -- 'pats' are type patterns for the type-indexes of the type constructor
392 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
393 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
394 -- *not* 'length tcdVars'.
396 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
398 type LTyClDecl name = Located (TyClDecl name)
400 -- | A type or class declaration.
403 tcdLName :: Located name,
404 tcdExtName :: Maybe FastString,
409 | -- | @type/data family T :: *->*@
410 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
411 tcdLName :: Located name, -- type constructor
412 tcdTyVars :: [LHsTyVarBndr name], -- type variables
413 tcdKind :: Maybe Kind -- result kind
417 | -- | Declares a data type or newtype, giving its construcors
419 -- data/newtype T a = <constrs>
420 -- data/newtype instance T [a] = <constrs>
422 TyData { tcdND :: NewOrData,
423 tcdCtxt :: LHsContext name, -- ^ Context
424 tcdLName :: Located name, -- ^ Type constructor
426 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
428 tcdTyPats :: Maybe [LHsType name],
431 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
432 -- in this case @tcdTyVars = fv( tcdTyPats )@.
433 -- @Nothing@ for everything else.
435 tcdKindSig:: Maybe Kind,
436 -- ^ Optional kind signature.
438 -- @(Just k)@ for a GADT-style @data@, or @data
439 -- instance@ decl with explicit kind sig
441 tcdCons :: [LConDecl name],
442 -- ^ Data constructors
444 -- For @data T a = T1 | T2 a@
445 -- the 'LConDecl's all have 'ResTyH98'.
446 -- For @data T a where { T1 :: T a }@
447 -- the 'LConDecls' all have 'ResTyGADT'.
449 tcdDerivs :: Maybe [LHsType name]
450 -- ^ Derivings; @Nothing@ => not specified,
451 -- @Just []@ => derive exactly what is asked
453 -- These "types" must be of form
455 -- forall ab. C ty1 ty2
457 -- Typically the foralls and ty args are empty, but they
458 -- are non-empty for the newtype-deriving case
461 | TySynonym { tcdLName :: Located name, -- ^ type constructor
462 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
463 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
464 -- See comments for tcdTyPats in TyData
465 -- 'Nothing' => vanilla type synonym
467 tcdSynRhs :: LHsType name -- ^ synonym expansion
470 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
471 tcdLName :: Located name, -- ^ Name of the class
472 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
473 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
474 tcdSigs :: [LSig name], -- ^ Methods' signatures
475 tcdMeths :: LHsBinds name, -- ^ Default methods
476 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
477 -- only 'TyFamily' and
479 -- latter for defaults
480 tcdDocs :: [LDocDecl name] -- ^ Haddock docs
484 = NewType -- ^ @newtype Blah ...@
485 | DataType -- ^ @data Blah ...@
486 deriving( Eq ) -- Needed because Demand derives Eq
489 = TypeFamily -- ^ @type family ...@
490 | DataFamily -- ^ @data family ...@
496 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
498 isDataDecl :: TyClDecl name -> Bool
499 isDataDecl (TyData {}) = True
500 isDataDecl _other = False
502 -- | type or type instance declaration
503 isTypeDecl :: TyClDecl name -> Bool
504 isTypeDecl (TySynonym {}) = True
505 isTypeDecl _other = False
507 -- | vanilla Haskell type synonym (ie, not a type instance)
508 isSynDecl :: TyClDecl name -> Bool
509 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
510 isSynDecl _other = False
513 isClassDecl :: TyClDecl name -> Bool
514 isClassDecl (ClassDecl {}) = True
515 isClassDecl _ = False
517 -- | type family declaration
518 isFamilyDecl :: TyClDecl name -> Bool
519 isFamilyDecl (TyFamily {}) = True
520 isFamilyDecl _other = False
522 -- | family instance (types, newtypes, and data types)
523 isFamInstDecl :: TyClDecl name -> Bool
526 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
533 tcdName :: TyClDecl name -> name
534 tcdName decl = unLoc (tcdLName decl)
536 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
537 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
538 -- The first one is guaranteed to be the name of the decl. For record fields
539 -- mentioned in multiple constructors, the SrcLoc will be from the first
540 -- occurence. We use the equality to filter out duplicate field names
542 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
543 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
544 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
546 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
548 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
550 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
551 = tc_name : hsConDeclsNames cons
553 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
554 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
555 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
556 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
557 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
558 tyClDeclTyVars (ForeignType {}) = []
562 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
563 -- class, synonym decls, data, newtype, family decls, family instances
565 = (count isClassDecl decls,
566 count isSynDecl decls, -- excluding...
567 count isDataTy decls, -- ...family...
568 count isNewTy decls, -- ...instances
569 count isFamilyDecl decls,
570 count isFamInstDecl decls)
572 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
575 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
580 instance OutputableBndr name
581 => Outputable (TyClDecl name) where
583 ppr (ForeignType {tcdLName = ltycon})
584 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
586 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
587 tcdTyVars = tyvars, tcdKind = mb_kind})
588 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
590 pp_flavour = case flavour of
591 TypeFamily -> ptext (sLit "type family")
592 DataFamily -> ptext (sLit "data family")
594 pp_kind = case mb_kind of
596 Just kind -> dcolon <+> pprKind kind
598 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
599 tcdSynRhs = mono_ty})
600 = hang (ptext (sLit "type") <+>
601 (if isJust typats then ptext (sLit "instance") else empty) <+>
602 pp_decl_head [] ltycon tyvars typats <+>
606 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
607 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
608 tcdCons = condecls, tcdDerivs = derivings})
609 = pp_tydecl (null condecls && isJust mb_sig)
611 (if isJust typats then ptext (sLit "instance") else empty) <+>
612 pp_decl_head (unLoc context) ltycon tyvars typats <+>
614 (pp_condecls condecls)
617 ppr_sig Nothing = empty
618 ppr_sig (Just kind) = dcolon <+> pprKind kind
620 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
622 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
623 | null sigs && null ats -- No "where" part
626 | otherwise -- Laid out
627 = sep [hsep [top_matter, ptext (sLit "where {")],
628 nest 4 (sep [ sep (map ppr_semi ats)
629 , sep (map ppr_semi sigs)
630 , pprLHsBinds methods
633 top_matter = ptext (sLit "class")
634 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
635 <+> pprFundeps (map unLoc fds)
636 ppr_semi decl = ppr decl <> semi
638 pp_decl_head :: OutputableBndr name
641 -> [LHsTyVarBndr name]
642 -> Maybe [LHsType name]
644 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
645 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
646 pp_decl_head context thing _ (Just typats) -- explicit type patterns
647 = hsep [ pprHsContext context, ppr thing
648 , hsep (map (pprParendHsType.unLoc) typats)]
650 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
651 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
652 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
653 pp_condecls cs -- In H98 syntax
654 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
656 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
657 pp_tydecl True pp_head _ _
659 pp_tydecl False pp_head pp_decl_rhs derivings
660 = hang pp_head 4 (sep [
664 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
667 instance Outputable NewOrData where
668 ppr NewType = ptext (sLit "newtype")
669 ppr DataType = ptext (sLit "data")
673 %************************************************************************
675 \subsection[ConDecl]{A data-constructor declaration}
677 %************************************************************************
680 type LConDecl name = Located (ConDecl name)
682 -- data T b = forall a. Eq a => MkT a b
683 -- MkT :: forall b a. Eq a => MkT a b
686 -- MkT1 :: Int -> T Int
688 -- data T = Int `MkT` Int
692 -- Int `MkT` Int :: T Int
696 { con_name :: Located name
697 -- ^ Constructor name. This is used for the DataCon itself, and for
698 -- the user-callable wrapper Id.
700 , con_explicit :: HsExplicitForAll
701 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
703 , con_qvars :: [LHsTyVarBndr name]
704 -- ^ Type variables. Depending on 'con_res' this describes the
705 -- follewing entities
707 -- - ResTyH98: the constructor's *existential* type variables
708 -- - ResTyGADT: *all* the constructor's quantified type variables
710 , con_cxt :: LHsContext name
711 -- ^ The context. This /does not/ include the \"stupid theta\" which
712 -- lives only in the 'TyData' decl.
714 , con_details :: HsConDeclDetails name
715 -- ^ The main payload
717 , con_res :: ResType name
718 -- ^ Result type of the constructor
720 , con_doc :: Maybe (LHsDoc name)
721 -- ^ A possible Haddock comment.
723 , con_old_rec :: Bool
724 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
725 -- GADT-style record decl C { blah } :: T a b
726 -- Remove this when we no longer parse this stuff, and hence do not
727 -- need to report decprecated use
730 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
732 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
733 hsConDeclArgTys (PrefixCon tys) = tys
734 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
735 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
738 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
739 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
740 -- and here is its result type
742 instance OutputableBndr name => Outputable (ResType name) where
744 ppr ResTyH98 = ptext (sLit "ResTyH98")
745 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
749 hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
750 -- See tyClDeclNames for what this does
751 -- The function is boringly complicated because of the records
752 -- And since we only have equality, we have to be a little careful
754 = snd (foldl do_one ([], []) cons)
756 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
757 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
759 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
760 (map cd_fld_name flds)
762 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
763 = (flds_seen, lname:acc)
768 instance (OutputableBndr name) => Outputable (ConDecl name) where
771 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
772 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
773 , con_cxt = cxt, con_details = details
774 , con_res = ResTyH98, con_doc = doc })
775 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
777 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
778 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
779 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
781 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
782 , con_cxt = cxt, con_details = PrefixCon arg_tys
783 , con_res = ResTyGADT res_ty })
784 = ppr con <+> dcolon <+>
785 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
787 mk_fun_ty a b = noLoc (HsFunTy a b)
789 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
790 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
791 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
792 pprConDeclFields fields <+> arrow <+> ppr res_ty]
794 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
795 = pprPanic "pprConDecl" (ppr con)
796 -- In GADT syntax we don't allow infix constructors
799 %************************************************************************
801 \subsection[InstDecl]{An instance declaration
803 %************************************************************************
806 type LInstDecl name = Located (InstDecl name)
809 = InstDecl (LHsType name) -- Context => Class Instance-type
810 -- Using a polytype means that the renamer conveniently
811 -- figures out the quantified type variables for us.
813 [LSig name] -- User-supplied pragmatic info
814 [LTyClDecl name]-- Associated types (ie, 'TyData' and
817 instance (OutputableBndr name) => Outputable (InstDecl name) where
819 ppr (InstDecl inst_ty binds uprags ats)
820 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
821 , nest 4 $ vcat (map ppr ats)
822 , nest 4 $ vcat (map ppr uprags)
823 , nest 4 $ pprLHsBinds binds ]
825 -- Extract the declarations of associated types from an instance
827 instDeclATs :: InstDecl name -> [LTyClDecl name]
828 instDeclATs (InstDecl _ _ _ ats) = ats
831 %************************************************************************
833 \subsection[DerivDecl]{A stand-alone instance deriving declaration
835 %************************************************************************
838 type LDerivDecl name = Located (DerivDecl name)
840 data DerivDecl name = DerivDecl (LHsType name)
842 instance (OutputableBndr name) => Outputable (DerivDecl name) where
844 = hsep [ptext (sLit "derived instance"), ppr ty]
847 %************************************************************************
849 \subsection[DefaultDecl]{A @default@ declaration}
851 %************************************************************************
853 There can only be one default declaration per module, but it is hard
854 for the parser to check that; we pass them all through in the abstract
855 syntax, and that restriction must be checked in the front end.
858 type LDefaultDecl name = Located (DefaultDecl name)
860 data DefaultDecl name
861 = DefaultDecl [LHsType name]
863 instance (OutputableBndr name)
864 => Outputable (DefaultDecl name) where
866 ppr (DefaultDecl tys)
867 = ptext (sLit "default") <+> parens (interpp'SP tys)
870 %************************************************************************
872 \subsection{Foreign function interface declaration}
874 %************************************************************************
878 -- foreign declarations are distinguished as to whether they define or use a
881 -- * the Boolean value indicates whether the pre-standard deprecated syntax
884 type LForeignDecl name = Located (ForeignDecl name)
886 data ForeignDecl name
887 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
888 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
890 -- Specification Of an imported external entity in dependence on the calling
893 data ForeignImport = -- import of a C entity
895 -- * the two strings specifying a header file or library
896 -- may be empty, which indicates the absence of a
897 -- header or object specification (both are not used
898 -- in the case of `CWrapper' and when `CFunction'
899 -- has a dynamic target)
901 -- * the calling convention is irrelevant for code
902 -- generation in the case of `CLabel', but is needed
903 -- for pretty printing
905 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
907 CImport CCallConv -- ccall or stdcall
908 Safety -- safe or unsafe
909 FastString -- name of C header
910 CImportSpec -- details of the C entity
912 -- import of a .NET function
914 | DNImport DNCallSpec
916 -- details of an external C entity
918 data CImportSpec = CLabel CLabelString -- import address of a C label
919 | CFunction CCallTarget -- static or dynamic function
920 | CWrapper -- wrapper to expose closures
923 -- specification of an externally exported entity in dependence on the calling
926 data ForeignExport = CExport CExportSpec -- contains the calling convention
927 | DNExport -- presently unused
929 -- abstract type imported from .NET
931 data FoType = DNType -- In due course we'll add subtype stuff
932 deriving (Eq) -- Used for equality instance for TyClDecl
935 -- pretty printing of foreign declarations
938 instance OutputableBndr name => Outputable (ForeignDecl name) where
939 ppr (ForeignImport n ty fimport) =
940 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
941 2 (dcolon <+> ppr ty)
942 ppr (ForeignExport n ty fexport) =
943 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
944 2 (dcolon <+> ppr ty)
946 instance Outputable ForeignImport where
947 ppr (DNImport spec) =
948 ptext (sLit "dotnet") <+> ppr spec
949 ppr (CImport cconv safety header spec) =
950 ppr cconv <+> ppr safety <+>
951 char '"' <> pprCEntity spec <> char '"'
953 pp_hdr = if nullFS header then empty else ftext header
955 pprCEntity (CLabel lbl) =
956 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
957 pprCEntity (CFunction (StaticTarget lbl)) =
958 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
959 pprCEntity (CFunction (DynamicTarget)) =
960 ptext (sLit "dynamic")
961 pprCEntity (CWrapper) = ptext (sLit "wrapper")
963 instance Outputable ForeignExport where
964 ppr (CExport (CExportStatic lbl cconv)) =
965 ppr cconv <+> char '"' <> ppr lbl <> char '"'
967 ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
969 instance Outputable FoType where
970 ppr DNType = ptext (sLit "type dotnet")
974 %************************************************************************
976 \subsection{Transformation rules}
978 %************************************************************************
981 type LRuleDecl name = Located (RuleDecl name)
984 = HsRule -- Source rule
985 RuleName -- Rule name
987 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
988 (Located (HsExpr name)) -- LHS
989 NameSet -- Free-vars from the LHS
990 (Located (HsExpr name)) -- RHS
991 NameSet -- Free-vars from the RHS
994 = RuleBndr (Located name)
995 | RuleBndrSig (Located name) (LHsType name)
997 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
998 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1000 instance OutputableBndr name => Outputable (RuleDecl name) where
1001 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1002 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1003 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
1004 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1006 pp_forall | null ns = empty
1007 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1009 instance OutputableBndr name => Outputable (RuleBndr name) where
1010 ppr (RuleBndr name) = ppr name
1011 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1014 %************************************************************************
1016 \subsection[DocDecl]{Document comments}
1018 %************************************************************************
1022 type LDocDecl name = Located (DocDecl name)
1025 = DocCommentNext (HsDoc name)
1026 | DocCommentPrev (HsDoc name)
1027 | DocCommentNamed String (HsDoc name)
1028 | DocGroup Int (HsDoc name)
1030 -- Okay, I need to reconstruct the document comments, but for now:
1031 instance Outputable (DocDecl name) where
1032 ppr _ = text "<document comment>"
1034 docDeclDoc :: DocDecl name -> HsDoc name
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
1055 instance OutputableBndr name => Outputable (WarnDecl name) where
1056 ppr (Warning thing txt)
1057 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1060 %************************************************************************
1062 \subsection[AnnDecl]{Annotations}
1064 %************************************************************************
1067 type LAnnDecl name = Located (AnnDecl name)
1069 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1071 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1072 ppr (HsAnnotation provenance expr)
1073 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1076 data AnnProvenance name = ValueAnnProvenance name
1077 | TypeAnnProvenance name
1078 | ModuleAnnProvenance
1080 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1081 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1082 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1083 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1085 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1086 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1087 modifyAnnProvenanceNameM fm prov =
1089 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1090 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1091 ModuleAnnProvenance -> return ModuleAnnProvenance
1093 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1094 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1095 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1096 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name