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(..),
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)
105 | QuasiQuoteD (HsQuasiQuote id)
108 -- NB: all top-level fixity decls are contained EITHER
110 -- OR in the ClassDecls in TyClDs
113 -- a) data constructors
114 -- b) class methods (but they can be also done in the
115 -- signatures of class decls)
116 -- c) imported functions (that have an IfacSig)
117 -- d) top level decls
119 -- The latter is for class methods only
121 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
122 -- fed to the renamer.
125 hs_valds :: HsValBinds id,
126 hs_tyclds :: [LTyClDecl id],
127 hs_instds :: [LInstDecl id],
128 hs_derivds :: [LDerivDecl id],
130 hs_fixds :: [LFixitySig id],
131 -- Snaffled out of both top-level fixity signatures,
132 -- and those in class declarations
134 hs_defds :: [LDefaultDecl id],
135 hs_fords :: [LForeignDecl id],
136 hs_warnds :: [LWarnDecl id],
137 hs_annds :: [LAnnDecl id],
138 hs_ruleds :: [LRuleDecl id],
140 hs_docs :: [LDocDecl]
143 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
144 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
145 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
147 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
148 hs_fixds = [], hs_defds = [], hs_annds = [],
149 hs_fords = [], hs_warnds = [], hs_ruleds = [],
150 hs_valds = error "emptyGroup hs_valds: Can't happen",
153 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
156 hs_valds = val_groups1,
159 hs_derivds = derivds1,
168 hs_valds = val_groups2,
171 hs_derivds = derivds2,
181 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
182 hs_tyclds = tyclds1 ++ tyclds2,
183 hs_instds = instds1 ++ instds2,
184 hs_derivds = derivds1 ++ derivds2,
185 hs_fixds = fixds1 ++ fixds2,
186 hs_annds = annds1 ++ annds2,
187 hs_defds = defds1 ++ defds2,
188 hs_fords = fords1 ++ fords2,
189 hs_warnds = warnds1 ++ warnds2,
190 hs_ruleds = rulds1 ++ rulds2,
191 hs_docs = docs1 ++ docs2 }
195 instance OutputableBndr name => Outputable (HsDecl name) where
196 ppr (TyClD dcl) = ppr dcl
197 ppr (ValD binds) = ppr binds
198 ppr (DefD def) = ppr def
199 ppr (InstD inst) = ppr inst
200 ppr (DerivD deriv) = ppr deriv
201 ppr (ForD fd) = ppr fd
202 ppr (SigD sd) = ppr sd
203 ppr (RuleD rd) = ppr rd
204 ppr (WarningD wd) = ppr wd
205 ppr (AnnD ad) = ppr ad
206 ppr (SpliceD dd) = ppr dd
207 ppr (DocD doc) = ppr doc
208 ppr (QuasiQuoteD qq) = ppr qq
210 instance OutputableBndr name => Outputable (HsGroup name) where
211 ppr (HsGroup { hs_valds = val_decls,
212 hs_tyclds = tycl_decls,
213 hs_instds = inst_decls,
214 hs_derivds = deriv_decls,
215 hs_fixds = fix_decls,
216 hs_warnds = deprec_decls,
217 hs_annds = ann_decls,
218 hs_fords = foreign_decls,
219 hs_defds = default_decls,
220 hs_ruleds = rule_decls })
221 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
222 ppr_ds deprec_decls, ppr_ds ann_decls,
225 ppr_ds tycl_decls, ppr_ds inst_decls,
227 ppr_ds foreign_decls]
230 ppr_ds ds = blankLine $$ vcat (map ppr ds)
232 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
234 instance OutputableBndr name => Outputable (SpliceDecl name) where
235 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
239 %************************************************************************
241 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
243 %************************************************************************
245 --------------------------------
247 --------------------------------
249 Here is the story about the implicit names that go with type, class,
250 and instance decls. It's a bit tricky, so pay attention!
252 "Implicit" (or "system") binders
253 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
254 Each data type decl defines
255 a worker name for each constructor
256 to-T and from-T convertors
257 Each class decl defines
258 a tycon for the class
259 a data constructor for that tycon
260 the worker for that constructor
261 a selector for each superclass
263 All have occurrence names that are derived uniquely from their parent
266 None of these get separate definitions in an interface file; they are
267 fully defined by the data or class decl. But they may *occur* in
268 interface files, of course. Any such occurrence must haul in the
269 relevant type or class decl.
272 - Ensure they "point to" the parent data/class decl
273 when loading that decl from an interface file
274 (See RnHiFiles.getSysBinders)
276 - When typechecking the decl, we build the implicit TyCons and Ids.
277 When doing so we look them up in the name cache (RnEnv.lookupSysName),
278 to ensure correct module and provenance is set
280 These are the two places that we have to conjure up the magic derived
281 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
285 - Occurrence name is derived uniquely from the method name
288 - If there is a default method name at all, it's recorded in
289 the ClassOpSig (in HsBinds), in the DefMeth field.
290 (DefMeth is defined in Class.lhs)
292 Source-code class decls and interface-code class decls are treated subtly
293 differently, which has given me a great deal of confusion over the years.
294 Here's the deal. (We distinguish the two cases because source-code decls
295 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
297 In *source-code* class declarations:
299 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
300 This is done by RdrHsSyn.mkClassOpSigDM
302 - The renamer renames it to a Name
304 - During typechecking, we generate a binding for each $dm for
305 which there's a programmer-supplied default method:
310 We generate a binding for $dmop1 but not for $dmop2.
311 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
312 The Name for $dmop2 is simply discarded.
314 In *interface-file* class declarations:
315 - When parsing, we see if there's an explicit programmer-supplied default method
316 because there's an '=' sign to indicate it:
318 op1 = :: <type> -- NB the '='
320 We use this info to generate a DefMeth with a suitable RdrName for op1,
321 and a NoDefMeth for op2
322 - The interface file has a separate definition for $dmop1, with unfolding etc.
323 - The renamer renames it to a Name.
324 - The renamer treats $dmop1 as a free variable of the declaration, so that
325 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
326 This doesn't happen for source code class decls, because they *bind* the default method.
330 Each instance declaration gives rise to one dictionary function binding.
332 The type checker makes up new source-code instance declarations
333 (e.g. from 'deriving' or generic default methods --- see
334 TcInstDcls.tcInstDecls1). So we can't generate the names for
335 dictionary functions in advance (we don't know how many we need).
337 On the other hand for interface-file instance declarations, the decl
338 specifies the name of the dictionary function, and it has a binding elsewhere
339 in the interface file:
340 instance {Eq Int} = dEqInt
341 dEqInt :: {Eq Int} <pragma info>
343 So again we treat source code and interface file code slightly differently.
346 - Source code instance decls have a Nothing in the (Maybe name) field
347 (see data InstDecl below)
349 - The typechecker makes up a Local name for the dict fun for any source-code
350 instance decl, whether it comes from a source-code instance decl, or whether
351 the instance decl is derived from some other construct (e.g. 'deriving').
353 - The occurrence name it chooses is derived from the instance decl (just for
354 documentation really) --- e.g. dNumInt. Two dict funs may share a common
355 occurrence name, but will have different uniques. E.g.
356 instance Foo [Int] where ...
357 instance Foo [Bool] where ...
358 These might both be dFooList
360 - The CoreTidy phase externalises the name, and ensures the occurrence name is
361 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
363 - We can take this relaxed approach (changing the occurrence name later)
364 because dict fun Ids are not captured in a TyCon or Class (unlike default
365 methods, say). Instead, they are kept separately in the InstEnv. This
366 makes it easy to adjust them after compiling a module. (Once we've finished
367 compiling that module, they don't change any more.)
371 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
372 in the (Maybe name) field.
374 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
375 suck in the dfun binding
379 -- Representation of indexed types
380 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
381 -- Family kind signatures are represented by the variant `TyFamily'. It
382 -- covers "type family", "newtype family", and "data family" declarations,
383 -- distinguished by the value of the field `tcdFlavour'.
385 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
386 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
388 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
389 -- synonym declaration and 'tcdVars' contains the type parameters of the
392 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
393 -- 'pats' are type patterns for the type-indexes of the type constructor
394 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
395 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
396 -- *not* 'length tcdVars'.
398 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
400 type LTyClDecl name = Located (TyClDecl name)
402 -- | A type or class declaration.
405 tcdLName :: Located name,
406 tcdExtName :: Maybe FastString
410 | -- | @type/data family T :: *->*@
411 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
412 tcdLName :: Located name, -- type constructor
413 tcdTyVars :: [LHsTyVarBndr name], -- type variables
414 tcdKind :: Maybe Kind -- result kind
418 | -- | Declares a data type or newtype, giving its construcors
420 -- data/newtype T a = <constrs>
421 -- data/newtype instance T [a] = <constrs>
423 TyData { tcdND :: NewOrData,
424 tcdCtxt :: LHsContext name, -- ^ Context
425 tcdLName :: Located name, -- ^ Type constructor
427 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
429 tcdTyPats :: Maybe [LHsType name],
432 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
433 -- in this case @tcdTyVars = fv( tcdTyPats )@.
434 -- @Nothing@ for everything else.
436 tcdKindSig:: Maybe Kind,
437 -- ^ Optional kind signature.
439 -- @(Just k)@ for a GADT-style @data@, or @data
440 -- instance@ decl with explicit kind sig
442 tcdCons :: [LConDecl name],
443 -- ^ Data constructors
445 -- For @data T a = T1 | T2 a@
446 -- the 'LConDecl's all have 'ResTyH98'.
447 -- For @data T a where { T1 :: T a }@
448 -- the 'LConDecls' all have 'ResTyGADT'.
450 tcdDerivs :: Maybe [LHsType name]
451 -- ^ Derivings; @Nothing@ => not specified,
452 -- @Just []@ => derive exactly what is asked
454 -- These "types" must be of form
456 -- forall ab. C ty1 ty2
458 -- Typically the foralls and ty args are empty, but they
459 -- are non-empty for the newtype-deriving case
462 | TySynonym { tcdLName :: Located name, -- ^ type constructor
463 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
464 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
465 -- See comments for tcdTyPats in TyData
466 -- 'Nothing' => vanilla type synonym
468 tcdSynRhs :: LHsType name -- ^ synonym expansion
471 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
472 tcdLName :: Located name, -- ^ Name of the class
473 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
474 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
475 tcdSigs :: [LSig name], -- ^ Methods' signatures
476 tcdMeths :: LHsBinds name, -- ^ Default methods
477 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
478 -- only 'TyFamily' and
480 -- latter for defaults
481 tcdDocs :: [LDocDecl] -- ^ Haddock docs
485 = NewType -- ^ @newtype Blah ...@
486 | DataType -- ^ @data Blah ...@
487 deriving( Eq ) -- Needed because Demand derives Eq
490 = TypeFamily -- ^ @type family ...@
491 | DataFamily -- ^ @data family ...@
497 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
499 isDataDecl :: TyClDecl name -> Bool
500 isDataDecl (TyData {}) = True
501 isDataDecl _other = False
503 -- | type or type instance declaration
504 isTypeDecl :: TyClDecl name -> Bool
505 isTypeDecl (TySynonym {}) = True
506 isTypeDecl _other = False
508 -- | vanilla Haskell type synonym (ie, not a type instance)
509 isSynDecl :: TyClDecl name -> Bool
510 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
511 isSynDecl _other = False
514 isClassDecl :: TyClDecl name -> Bool
515 isClassDecl (ClassDecl {}) = True
516 isClassDecl _ = False
518 -- | type family declaration
519 isFamilyDecl :: TyClDecl name -> Bool
520 isFamilyDecl (TyFamily {}) = True
521 isFamilyDecl _other = False
523 -- | family instance (types, newtypes, and data types)
524 isFamInstDecl :: TyClDecl name -> Bool
527 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
534 tcdName :: TyClDecl name -> name
535 tcdName decl = unLoc (tcdLName decl)
537 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
538 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
539 -- The first one is guaranteed to be the name of the decl. For record fields
540 -- mentioned in multiple constructors, the SrcLoc will be from the first
541 -- occurence. We use the equality to filter out duplicate field names
543 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
544 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
545 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
547 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
549 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
551 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
552 = tc_name : hsConDeclsNames cons
554 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
555 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
556 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
557 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
558 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
559 tyClDeclTyVars (ForeignType {}) = []
563 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
564 -- class, synonym decls, data, newtype, family decls, family instances
566 = (count isClassDecl decls,
567 count isSynDecl decls, -- excluding...
568 count isDataTy decls, -- ...family...
569 count isNewTy decls, -- ...instances
570 count isFamilyDecl decls,
571 count isFamInstDecl decls)
573 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
576 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
581 instance OutputableBndr name
582 => Outputable (TyClDecl name) where
584 ppr (ForeignType {tcdLName = ltycon})
585 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
587 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
588 tcdTyVars = tyvars, tcdKind = mb_kind})
589 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
591 pp_flavour = case flavour of
592 TypeFamily -> ptext (sLit "type family")
593 DataFamily -> ptext (sLit "data family")
595 pp_kind = case mb_kind of
597 Just kind -> dcolon <+> pprKind kind
599 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
600 tcdSynRhs = mono_ty})
601 = hang (ptext (sLit "type") <+>
602 (if isJust typats then ptext (sLit "instance") else empty) <+>
603 pp_decl_head [] ltycon tyvars typats <+>
607 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
608 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
609 tcdCons = condecls, tcdDerivs = derivings})
610 = pp_tydecl (null condecls && isJust mb_sig)
612 (if isJust typats then ptext (sLit "instance") else empty) <+>
613 pp_decl_head (unLoc context) ltycon tyvars typats <+>
615 (pp_condecls condecls)
618 ppr_sig Nothing = empty
619 ppr_sig (Just kind) = dcolon <+> pprKind kind
621 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
623 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
624 | null sigs && null ats -- No "where" part
627 | otherwise -- Laid out
628 = sep [hsep [top_matter, ptext (sLit "where {")],
629 nest 4 (sep [ sep (map ppr_semi ats)
630 , sep (map ppr_semi sigs)
631 , pprLHsBinds methods
634 top_matter = ptext (sLit "class")
635 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
636 <+> pprFundeps (map unLoc fds)
637 ppr_semi decl = ppr decl <> semi
639 pp_decl_head :: OutputableBndr name
642 -> [LHsTyVarBndr name]
643 -> Maybe [LHsType name]
645 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
646 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
647 pp_decl_head context thing _ (Just typats) -- explicit type patterns
648 = hsep [ pprHsContext context, ppr thing
649 , hsep (map (pprParendHsType.unLoc) typats)]
651 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
652 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
653 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
654 pp_condecls cs -- In H98 syntax
655 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
657 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
658 pp_tydecl True pp_head _ _
660 pp_tydecl False pp_head pp_decl_rhs derivings
661 = hang pp_head 4 (sep [
665 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
668 instance Outputable NewOrData where
669 ppr NewType = ptext (sLit "newtype")
670 ppr DataType = ptext (sLit "data")
674 %************************************************************************
676 \subsection[ConDecl]{A data-constructor declaration}
678 %************************************************************************
681 type LConDecl name = Located (ConDecl name)
683 -- data T b = forall a. Eq a => MkT a b
684 -- MkT :: forall b a. Eq a => MkT a b
687 -- MkT1 :: Int -> T Int
689 -- data T = Int `MkT` Int
693 -- Int `MkT` Int :: T Int
697 { con_name :: Located name
698 -- ^ Constructor name. This is used for the DataCon itself, and for
699 -- the user-callable wrapper Id.
701 , con_explicit :: HsExplicitFlag
702 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
704 , con_qvars :: [LHsTyVarBndr name]
705 -- ^ Type variables. Depending on 'con_res' this describes the
706 -- follewing entities
708 -- - ResTyH98: the constructor's *existential* type variables
709 -- - ResTyGADT: *all* the constructor's quantified type variables
711 , con_cxt :: LHsContext name
712 -- ^ The context. This /does not/ include the \"stupid theta\" which
713 -- lives only in the 'TyData' decl.
715 , con_details :: HsConDeclDetails name
716 -- ^ The main payload
718 , con_res :: ResType name
719 -- ^ Result type of the constructor
721 , con_doc :: Maybe LHsDocString
722 -- ^ A possible Haddock comment.
724 , con_old_rec :: Bool
725 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
726 -- GADT-style record decl C { blah } :: T a b
727 -- Remove this when we no longer parse this stuff, and hence do not
728 -- need to report decprecated use
731 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
733 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
734 hsConDeclArgTys (PrefixCon tys) = tys
735 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
736 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
739 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
740 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
741 -- and here is its result type
743 instance OutputableBndr name => Outputable (ResType name) where
745 ppr ResTyH98 = ptext (sLit "ResTyH98")
746 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
750 hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
751 -- See tyClDeclNames for what this does
752 -- The function is boringly complicated because of the records
753 -- And since we only have equality, we have to be a little careful
755 = snd (foldl do_one ([], []) cons)
757 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
758 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
760 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
761 (map cd_fld_name flds)
763 do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
764 = (flds_seen, lname:acc)
769 instance (OutputableBndr name) => Outputable (ConDecl name) where
772 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
773 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
774 , con_cxt = cxt, con_details = details
775 , con_res = ResTyH98, con_doc = doc })
776 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
778 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
779 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
780 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
782 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
783 , con_cxt = cxt, con_details = PrefixCon arg_tys
784 , con_res = ResTyGADT res_ty })
785 = ppr con <+> dcolon <+>
786 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
788 mk_fun_ty a b = noLoc (HsFunTy a b)
790 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
791 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
792 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
793 pprConDeclFields fields <+> arrow <+> ppr res_ty]
795 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
796 = pprPanic "pprConDecl" (ppr con)
797 -- In GADT syntax we don't allow infix constructors
800 %************************************************************************
802 \subsection[InstDecl]{An instance declaration
804 %************************************************************************
807 type LInstDecl name = Located (InstDecl name)
810 = InstDecl (LHsType name) -- Context => Class Instance-type
811 -- Using a polytype means that the renamer conveniently
812 -- figures out the quantified type variables for us.
814 [LSig name] -- User-supplied pragmatic info
815 [LTyClDecl name]-- Associated types (ie, 'TyData' and
818 instance (OutputableBndr name) => Outputable (InstDecl name) where
820 ppr (InstDecl inst_ty binds uprags ats)
821 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
822 , nest 4 $ vcat (map ppr ats)
823 , nest 4 $ vcat (map ppr uprags)
824 , nest 4 $ pprLHsBinds binds ]
826 -- Extract the declarations of associated types from an instance
828 instDeclATs :: InstDecl name -> [LTyClDecl name]
829 instDeclATs (InstDecl _ _ _ ats) = ats
832 %************************************************************************
834 \subsection[DerivDecl]{A stand-alone instance deriving declaration
836 %************************************************************************
839 type LDerivDecl name = Located (DerivDecl name)
841 data DerivDecl name = DerivDecl (LHsType name)
843 instance (OutputableBndr name) => Outputable (DerivDecl name) where
845 = hsep [ptext (sLit "deriving instance"), ppr ty]
848 %************************************************************************
850 \subsection[DefaultDecl]{A @default@ declaration}
852 %************************************************************************
854 There can only be one default declaration per module, but it is hard
855 for the parser to check that; we pass them all through in the abstract
856 syntax, and that restriction must be checked in the front end.
859 type LDefaultDecl name = Located (DefaultDecl name)
861 data DefaultDecl name
862 = DefaultDecl [LHsType name]
864 instance (OutputableBndr name)
865 => Outputable (DefaultDecl name) where
867 ppr (DefaultDecl tys)
868 = ptext (sLit "default") <+> parens (interpp'SP tys)
871 %************************************************************************
873 \subsection{Foreign function interface declaration}
875 %************************************************************************
879 -- foreign declarations are distinguished as to whether they define or use a
882 -- * the Boolean value indicates whether the pre-standard deprecated syntax
885 type LForeignDecl name = Located (ForeignDecl name)
887 data ForeignDecl name
888 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
889 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
891 -- Specification Of an imported external entity in dependence on the calling
894 data ForeignImport = -- import of a C entity
896 -- * the two strings specifying a header file or library
897 -- may be empty, which indicates the absence of a
898 -- header or object specification (both are not used
899 -- in the case of `CWrapper' and when `CFunction'
900 -- has a dynamic target)
902 -- * the calling convention is irrelevant for code
903 -- generation in the case of `CLabel', but is needed
904 -- for pretty printing
906 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
908 CImport CCallConv -- ccall or stdcall
909 Safety -- safe or unsafe
910 FastString -- name of C header
911 CImportSpec -- details of the C entity
913 -- details of an external C entity
915 data CImportSpec = CLabel CLabelString -- import address of a C label
916 | CFunction CCallTarget -- static or dynamic function
917 | CWrapper -- wrapper to expose closures
920 -- specification of an externally exported entity in dependence on the calling
923 data ForeignExport = CExport CExportSpec -- contains the calling convention
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
977 = RuleBndr (Located name)
978 | RuleBndrSig (Located name) (LHsType name)
980 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
981 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
983 instance OutputableBndr name => Outputable (RuleDecl name) where
984 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
985 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
986 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
987 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
989 pp_forall | null ns = empty
990 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
992 instance OutputableBndr name => Outputable (RuleBndr name) where
993 ppr (RuleBndr name) = ppr name
994 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
997 %************************************************************************
999 \subsection[DocDecl]{Document comments}
1001 %************************************************************************
1005 type LDocDecl = Located (DocDecl)
1008 = DocCommentNext HsDocString
1009 | DocCommentPrev HsDocString
1010 | DocCommentNamed String HsDocString
1011 | DocGroup Int HsDocString
1013 -- Okay, I need to reconstruct the document comments, but for now:
1014 instance Outputable DocDecl where
1015 ppr _ = text "<document comment>"
1017 docDeclDoc :: DocDecl -> HsDocString
1018 docDeclDoc (DocCommentNext d) = d
1019 docDeclDoc (DocCommentPrev d) = d
1020 docDeclDoc (DocCommentNamed _ d) = d
1021 docDeclDoc (DocGroup _ d) = d
1025 %************************************************************************
1027 \subsection[DeprecDecl]{Deprecations}
1029 %************************************************************************
1031 We use exported entities for things to deprecate.
1034 type LWarnDecl name = Located (WarnDecl name)
1036 data WarnDecl name = Warning name WarningTxt
1038 instance OutputableBndr name => Outputable (WarnDecl name) where
1039 ppr (Warning thing txt)
1040 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1043 %************************************************************************
1045 \subsection[AnnDecl]{Annotations}
1047 %************************************************************************
1050 type LAnnDecl name = Located (AnnDecl name)
1052 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1054 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1055 ppr (HsAnnotation provenance expr)
1056 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1059 data AnnProvenance name = ValueAnnProvenance name
1060 | TypeAnnProvenance name
1061 | ModuleAnnProvenance
1063 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1064 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1065 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1066 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1068 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1069 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1070 modifyAnnProvenanceNameM fm prov =
1072 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1073 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1074 ModuleAnnProvenance -> return ModuleAnnProvenance
1076 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1077 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1078 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1079 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name