2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 {-# LANGUAGE DeriveDataTypeable #-}
9 -- | Abstract syntax of global declarations.
11 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
12 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
14 -- * Toplevel declarations
16 -- ** Class or type declarations
17 TyClDecl(..), LTyClDecl,
18 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
19 isFamInstDecl, tcdName, tyClDeclTyVars,
21 -- ** Instance declarations
22 InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
24 -- ** Standalone deriving declarations
25 DerivDecl(..), LDerivDecl,
26 -- ** @RULE@ declarations
27 RuleDecl(..), LRuleDecl, RuleBndr(..),
28 collectRuleBndrSigTys,
29 -- ** @VECTORISE@ declarations
30 VectDecl(..), LVectDecl,
31 -- ** @default@ declarations
32 DefaultDecl(..), LDefaultDecl,
33 -- ** Top-level template haskell splice
35 -- ** Foreign function interface declarations
36 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
38 -- ** Data-constructor declarations
39 ConDecl(..), LConDecl, ResType(..),
40 HsConDeclDetails, hsConDeclArgTys,
41 -- ** Document comments
42 DocDecl(..), LDocDecl, docDeclDoc,
44 WarnDecl(..), LWarnDecl,
46 AnnDecl(..), LAnnDecl,
47 AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
50 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups
54 import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, pprExpr )
55 -- Because Expr imports Decls via HsBracket
62 import {- Kind parts of -} Type
73 import Control.Monad ( liftM )
75 import Data.Maybe ( isJust )
78 %************************************************************************
80 \subsection[HsDecl]{Declarations}
82 %************************************************************************
85 type LHsDecl id = Located (HsDecl id)
87 -- | A Haskell Declaration
89 = TyClD (TyClDecl id) -- ^ A type or class declaration.
90 | InstD (InstDecl id) -- ^ An instance declaration.
91 | DerivD (DerivDecl id)
94 | DefD (DefaultDecl id)
95 | ForD (ForeignDecl id)
96 | WarningD (WarnDecl id)
100 | SpliceD (SpliceDecl id)
102 | QuasiQuoteD (HsQuasiQuote id)
103 deriving (Data, Typeable)
106 -- NB: all top-level fixity decls are contained EITHER
108 -- OR in the ClassDecls in TyClDs
111 -- a) data constructors
112 -- b) class methods (but they can be also done in the
113 -- signatures of class decls)
114 -- c) imported functions (that have an IfacSig)
115 -- d) top level decls
117 -- The latter is for class methods only
119 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
120 -- fed to the renamer.
123 hs_valds :: HsValBinds id,
125 hs_tyclds :: [[LTyClDecl id]],
126 -- A list of mutually-recursive groups
127 -- Parser generates a singleton list;
128 -- renamer does dependency analysis
130 hs_instds :: [LInstDecl id],
131 hs_derivds :: [LDerivDecl id],
133 hs_fixds :: [LFixitySig id],
134 -- Snaffled out of both top-level fixity signatures,
135 -- and those in class declarations
137 hs_defds :: [LDefaultDecl id],
138 hs_fords :: [LForeignDecl id],
139 hs_warnds :: [LWarnDecl id],
140 hs_annds :: [LAnnDecl id],
141 hs_ruleds :: [LRuleDecl id],
142 hs_vects :: [LVectDecl id],
144 hs_docs :: [LDocDecl]
145 } deriving (Data, Typeable)
147 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
148 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
149 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
151 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
152 hs_fixds = [], hs_defds = [], hs_annds = [],
153 hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
154 hs_valds = error "emptyGroup hs_valds: Can't happen",
157 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
160 hs_valds = val_groups1,
163 hs_derivds = derivds1,
173 hs_valds = val_groups2,
176 hs_derivds = derivds2,
187 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
188 hs_tyclds = tyclds1 ++ tyclds2,
189 hs_instds = instds1 ++ instds2,
190 hs_derivds = derivds1 ++ derivds2,
191 hs_fixds = fixds1 ++ fixds2,
192 hs_annds = annds1 ++ annds2,
193 hs_defds = defds1 ++ defds2,
194 hs_fords = fords1 ++ fords2,
195 hs_warnds = warnds1 ++ warnds2,
196 hs_ruleds = rulds1 ++ rulds2,
197 hs_vects = vects1 ++ vects2,
198 hs_docs = docs1 ++ docs2 }
202 instance OutputableBndr name => Outputable (HsDecl name) where
203 ppr (TyClD dcl) = ppr dcl
204 ppr (ValD binds) = ppr binds
205 ppr (DefD def) = ppr def
206 ppr (InstD inst) = ppr inst
207 ppr (DerivD deriv) = ppr deriv
208 ppr (ForD fd) = ppr fd
209 ppr (SigD sd) = ppr sd
210 ppr (RuleD rd) = ppr rd
211 ppr (VectD vect) = ppr vect
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,
229 hs_vects = vect_decls })
231 [ppr_ds fix_decls, ppr_ds default_decls,
232 ppr_ds deprec_decls, ppr_ds ann_decls,
235 if isEmptyValBinds val_decls
237 else Just (ppr val_decls),
238 ppr_ds (concat tycl_decls),
241 ppr_ds foreign_decls]
243 ppr_ds :: Outputable a => [a] -> Maybe SDoc
245 ppr_ds ds = Just (vcat (map ppr ds))
247 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
248 -- Concatenate vertically with white-space between non-blanks
250 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
251 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
254 = SpliceDecl -- Top level splice
255 (Located (HsExpr id))
256 HsExplicitFlag -- Explicit <=> $(f x y)
257 -- Implicit <=> f x y, i.e. a naked top level expression
258 deriving (Data, Typeable)
260 instance OutputableBndr name => Outputable (SpliceDecl name) where
261 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
265 %************************************************************************
267 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
269 %************************************************************************
271 --------------------------------
273 --------------------------------
275 Here is the story about the implicit names that go with type, class,
276 and instance decls. It's a bit tricky, so pay attention!
278 "Implicit" (or "system") binders
279 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
280 Each data type decl defines
281 a worker name for each constructor
282 to-T and from-T convertors
283 Each class decl defines
284 a tycon for the class
285 a data constructor for that tycon
286 the worker for that constructor
287 a selector for each superclass
289 All have occurrence names that are derived uniquely from their parent
292 None of these get separate definitions in an interface file; they are
293 fully defined by the data or class decl. But they may *occur* in
294 interface files, of course. Any such occurrence must haul in the
295 relevant type or class decl.
298 - Ensure they "point to" the parent data/class decl
299 when loading that decl from an interface file
300 (See RnHiFiles.getSysBinders)
302 - When typechecking the decl, we build the implicit TyCons and Ids.
303 When doing so we look them up in the name cache (RnEnv.lookupSysName),
304 to ensure correct module and provenance is set
306 These are the two places that we have to conjure up the magic derived
307 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
311 - Occurrence name is derived uniquely from the method name
314 - If there is a default method name at all, it's recorded in
315 the ClassOpSig (in HsBinds), in the DefMeth field.
316 (DefMeth is defined in Class.lhs)
318 Source-code class decls and interface-code class decls are treated subtly
319 differently, which has given me a great deal of confusion over the years.
320 Here's the deal. (We distinguish the two cases because source-code decls
321 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
323 In *source-code* class declarations:
325 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
326 This is done by RdrHsSyn.mkClassOpSigDM
328 - The renamer renames it to a Name
330 - During typechecking, we generate a binding for each $dm for
331 which there's a programmer-supplied default method:
336 We generate a binding for $dmop1 but not for $dmop2.
337 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
338 The Name for $dmop2 is simply discarded.
340 In *interface-file* class declarations:
341 - When parsing, we see if there's an explicit programmer-supplied default method
342 because there's an '=' sign to indicate it:
344 op1 = :: <type> -- NB the '='
346 We use this info to generate a DefMeth with a suitable RdrName for op1,
347 and a NoDefMeth for op2
348 - The interface file has a separate definition for $dmop1, with unfolding etc.
349 - The renamer renames it to a Name.
350 - The renamer treats $dmop1 as a free variable of the declaration, so that
351 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
352 This doesn't happen for source code class decls, because they *bind* the default method.
356 Each instance declaration gives rise to one dictionary function binding.
358 The type checker makes up new source-code instance declarations
359 (e.g. from 'deriving' or generic default methods --- see
360 TcInstDcls.tcInstDecls1). So we can't generate the names for
361 dictionary functions in advance (we don't know how many we need).
363 On the other hand for interface-file instance declarations, the decl
364 specifies the name of the dictionary function, and it has a binding elsewhere
365 in the interface file:
366 instance {Eq Int} = dEqInt
367 dEqInt :: {Eq Int} <pragma info>
369 So again we treat source code and interface file code slightly differently.
372 - Source code instance decls have a Nothing in the (Maybe name) field
373 (see data InstDecl below)
375 - The typechecker makes up a Local name for the dict fun for any source-code
376 instance decl, whether it comes from a source-code instance decl, or whether
377 the instance decl is derived from some other construct (e.g. 'deriving').
379 - The occurrence name it chooses is derived from the instance decl (just for
380 documentation really) --- e.g. dNumInt. Two dict funs may share a common
381 occurrence name, but will have different uniques. E.g.
382 instance Foo [Int] where ...
383 instance Foo [Bool] where ...
384 These might both be dFooList
386 - The CoreTidy phase externalises the name, and ensures the occurrence name is
387 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
389 - We can take this relaxed approach (changing the occurrence name later)
390 because dict fun Ids are not captured in a TyCon or Class (unlike default
391 methods, say). Instead, they are kept separately in the InstEnv. This
392 makes it easy to adjust them after compiling a module. (Once we've finished
393 compiling that module, they don't change any more.)
397 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
398 in the (Maybe name) field.
400 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
401 suck in the dfun binding
405 -- Representation of indexed types
406 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
407 -- Family kind signatures are represented by the variant `TyFamily'. It
408 -- covers "type family", "newtype family", and "data family" declarations,
409 -- distinguished by the value of the field `tcdFlavour'.
411 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
412 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
414 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
415 -- synonym declaration and 'tcdVars' contains the type parameters of the
418 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
419 -- 'pats' are type patterns for the type-indexes of the type constructor
420 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
421 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
422 -- *not* 'length tcdVars'.
424 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
426 type LTyClDecl name = Located (TyClDecl name)
428 -- | A type or class declaration.
431 tcdLName :: Located name,
432 tcdExtName :: Maybe FastString
436 | -- | @type/data family T :: *->*@
437 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
438 tcdLName :: Located name, -- type constructor
439 tcdTyVars :: [LHsTyVarBndr name], -- type variables
440 tcdKind :: Maybe Kind -- result kind
444 | -- | Declares a data type or newtype, giving its construcors
446 -- data/newtype T a = <constrs>
447 -- data/newtype instance T [a] = <constrs>
449 TyData { tcdND :: NewOrData,
450 tcdCtxt :: LHsContext name, -- ^ Context
451 tcdLName :: Located name, -- ^ Type constructor
453 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
455 tcdTyPats :: Maybe [LHsType name],
458 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
459 -- in this case @tcdTyVars = fv( tcdTyPats )@.
460 -- @Nothing@ for everything else.
462 tcdKindSig:: Maybe Kind,
463 -- ^ Optional kind signature.
465 -- @(Just k)@ for a GADT-style @data@, or @data
466 -- instance@ decl with explicit kind sig
468 tcdCons :: [LConDecl name],
469 -- ^ Data constructors
471 -- For @data T a = T1 | T2 a@
472 -- the 'LConDecl's all have 'ResTyH98'.
473 -- For @data T a where { T1 :: T a }@
474 -- the 'LConDecls' all have 'ResTyGADT'.
476 tcdDerivs :: Maybe [LHsType name]
477 -- ^ Derivings; @Nothing@ => not specified,
478 -- @Just []@ => derive exactly what is asked
480 -- These "types" must be of form
482 -- forall ab. C ty1 ty2
484 -- Typically the foralls and ty args are empty, but they
485 -- are non-empty for the newtype-deriving case
488 | TySynonym { tcdLName :: Located name, -- ^ type constructor
489 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
490 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
491 -- See comments for tcdTyPats in TyData
492 -- 'Nothing' => vanilla type synonym
494 tcdSynRhs :: LHsType name -- ^ synonym expansion
497 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
498 tcdLName :: Located name, -- ^ Name of the class
499 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
500 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
501 tcdSigs :: [LSig name], -- ^ Methods' signatures
502 tcdMeths :: LHsBinds name, -- ^ Default methods
503 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
504 -- only 'TyFamily' and
506 -- latter for defaults
507 tcdDocs :: [LDocDecl] -- ^ Haddock docs
509 deriving (Data, Typeable)
512 = NewType -- ^ @newtype Blah ...@
513 | DataType -- ^ @data Blah ...@
514 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
517 = TypeFamily -- ^ @type family ...@
518 | DataFamily -- ^ @data family ...@
519 deriving (Data, Typeable)
525 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
527 isDataDecl :: TyClDecl name -> Bool
528 isDataDecl (TyData {}) = True
529 isDataDecl _other = False
531 -- | type or type instance declaration
532 isTypeDecl :: TyClDecl name -> Bool
533 isTypeDecl (TySynonym {}) = True
534 isTypeDecl _other = False
536 -- | vanilla Haskell type synonym (ie, not a type instance)
537 isSynDecl :: TyClDecl name -> Bool
538 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
539 isSynDecl _other = False
542 isClassDecl :: TyClDecl name -> Bool
543 isClassDecl (ClassDecl {}) = True
544 isClassDecl _ = False
546 -- | type family declaration
547 isFamilyDecl :: TyClDecl name -> Bool
548 isFamilyDecl (TyFamily {}) = True
549 isFamilyDecl _other = False
551 -- | family instance (types, newtypes, and data types)
552 isFamInstDecl :: TyClDecl name -> Bool
555 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
562 tcdName :: TyClDecl name -> name
563 tcdName decl = unLoc (tcdLName decl)
565 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
566 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
567 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
568 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
569 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
570 tyClDeclTyVars (ForeignType {}) = []
574 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
575 -- class, synonym decls, data, newtype, family decls, family instances
577 = (count isClassDecl decls,
578 count isSynDecl decls, -- excluding...
579 count isDataTy decls, -- ...family...
580 count isNewTy decls, -- ...instances
581 count isFamilyDecl decls,
582 count isFamInstDecl decls)
584 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
587 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
592 instance OutputableBndr name
593 => Outputable (TyClDecl name) where
595 ppr (ForeignType {tcdLName = ltycon})
596 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
598 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
599 tcdTyVars = tyvars, tcdKind = mb_kind})
600 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
602 pp_flavour = case flavour of
603 TypeFamily -> ptext (sLit "type family")
604 DataFamily -> ptext (sLit "data family")
606 pp_kind = case mb_kind of
608 Just kind -> dcolon <+> pprKind kind
610 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
611 tcdSynRhs = mono_ty})
612 = hang (ptext (sLit "type") <+>
613 (if isJust typats then ptext (sLit "instance") else empty) <+>
614 pp_decl_head [] ltycon tyvars typats <+>
618 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
619 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
620 tcdCons = condecls, tcdDerivs = derivings})
621 = pp_tydecl (null condecls && isJust mb_sig)
623 (if isJust typats then ptext (sLit "instance") else empty) <+>
624 pp_decl_head (unLoc context) ltycon tyvars typats <+>
626 (pp_condecls condecls)
629 ppr_sigx Nothing = empty
630 ppr_sigx (Just kind) = dcolon <+> pprKind kind
632 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
634 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
635 | null sigs && null ats -- No "where" part
638 | otherwise -- Laid out
639 = sep [hsep [top_matter, ptext (sLit "where {")],
640 nest 4 (sep [ sep (map ppr_semi ats)
641 , sep (map ppr_semi sigs)
642 , pprLHsBinds methods
645 top_matter = ptext (sLit "class")
646 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
647 <+> pprFundeps (map unLoc fds)
648 ppr_semi :: Outputable a => a -> SDoc
649 ppr_semi decl = ppr decl <> semi
651 pp_decl_head :: OutputableBndr name
654 -> [LHsTyVarBndr name]
655 -> Maybe [LHsType name]
657 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
658 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
659 pp_decl_head context thing _ (Just typats) -- explicit type patterns
660 = hsep [ pprHsContext context, ppr thing
661 , hsep (map (pprParendHsType.unLoc) typats)]
663 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
664 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
665 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
666 pp_condecls cs -- In H98 syntax
667 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
669 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
670 pp_tydecl True pp_head _ _
672 pp_tydecl False pp_head pp_decl_rhs derivings
673 = hang pp_head 4 (sep [
677 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
680 instance Outputable NewOrData where
681 ppr NewType = ptext (sLit "newtype")
682 ppr DataType = ptext (sLit "data")
686 %************************************************************************
688 \subsection[ConDecl]{A data-constructor declaration}
690 %************************************************************************
693 type LConDecl name = Located (ConDecl name)
695 -- data T b = forall a. Eq a => MkT a b
696 -- MkT :: forall b a. Eq a => MkT a b
699 -- MkT1 :: Int -> T Int
701 -- data T = Int `MkT` Int
705 -- Int `MkT` Int :: T Int
709 { con_name :: Located name
710 -- ^ Constructor name. This is used for the DataCon itself, and for
711 -- the user-callable wrapper Id.
713 , con_explicit :: HsExplicitFlag
714 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
716 , con_qvars :: [LHsTyVarBndr name]
717 -- ^ Type variables. Depending on 'con_res' this describes the
718 -- follewing entities
720 -- - ResTyH98: the constructor's *existential* type variables
721 -- - ResTyGADT: *all* the constructor's quantified type variables
723 , con_cxt :: LHsContext name
724 -- ^ The context. This /does not/ include the \"stupid theta\" which
725 -- lives only in the 'TyData' decl.
727 , con_details :: HsConDeclDetails name
728 -- ^ The main payload
730 , con_res :: ResType name
731 -- ^ Result type of the constructor
733 , con_doc :: Maybe LHsDocString
734 -- ^ A possible Haddock comment.
736 , con_old_rec :: Bool
737 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
738 -- GADT-style record decl C { blah } :: T a b
739 -- Remove this when we no longer parse this stuff, and hence do not
740 -- need to report decprecated use
741 } deriving (Data, Typeable)
743 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
745 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
746 hsConDeclArgTys (PrefixCon tys) = tys
747 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
748 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
751 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
752 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
753 -- and here is its result type
754 deriving (Data, Typeable)
756 instance OutputableBndr name => Outputable (ResType name) where
758 ppr ResTyH98 = ptext (sLit "ResTyH98")
759 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
764 instance (OutputableBndr name) => Outputable (ConDecl name) where
767 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
768 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
769 , con_cxt = cxt, con_details = details
770 , con_res = ResTyH98, con_doc = doc })
771 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
773 ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
774 ppr_details (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
775 ppr_details (RecCon fields) = ppr con <+> pprConDeclFields fields
777 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
778 , con_cxt = cxt, con_details = PrefixCon arg_tys
779 , con_res = ResTyGADT res_ty })
780 = ppr con <+> dcolon <+>
781 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
783 mk_fun_ty a b = noLoc (HsFunTy a b)
785 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
786 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
787 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
788 pprConDeclFields fields <+> arrow <+> ppr res_ty]
790 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
791 = pprPanic "pprConDecl" (ppr con)
792 -- In GADT syntax we don't allow infix constructors
795 %************************************************************************
797 \subsection[InstDecl]{An instance declaration}
799 %************************************************************************
802 type LInstDecl name = Located (InstDecl name)
805 = InstDecl (LHsType name) -- Context => Class Instance-type
806 -- Using a polytype means that the renamer conveniently
807 -- figures out the quantified type variables for us.
809 [LSig name] -- User-supplied pragmatic info
810 [LTyClDecl name]-- Associated types (ie, 'TyData' and
812 deriving (Data, Typeable)
814 instance (OutputableBndr name) => Outputable (InstDecl name) where
816 ppr (InstDecl inst_ty binds uprags ats)
817 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
818 , nest 4 $ vcat (map ppr ats)
819 , nest 4 $ vcat (map ppr uprags)
820 , nest 4 $ pprLHsBinds binds ]
822 -- Extract the declarations of associated types from an instance
824 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
825 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
828 %************************************************************************
830 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
832 %************************************************************************
835 type LDerivDecl name = Located (DerivDecl name)
837 data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
838 deriving (Data, Typeable)
840 instance (OutputableBndr name) => Outputable (DerivDecl name) where
842 = hsep [ptext (sLit "deriving instance"), ppr ty]
845 %************************************************************************
847 \subsection[DefaultDecl]{A @default@ declaration}
849 %************************************************************************
851 There can only be one default declaration per module, but it is hard
852 for the parser to check that; we pass them all through in the abstract
853 syntax, and that restriction must be checked in the front end.
856 type LDefaultDecl name = Located (DefaultDecl name)
858 data DefaultDecl name
859 = DefaultDecl [LHsType name]
860 deriving (Data, Typeable)
862 instance (OutputableBndr name)
863 => Outputable (DefaultDecl name) where
865 ppr (DefaultDecl tys)
866 = ptext (sLit "default") <+> parens (interpp'SP tys)
869 %************************************************************************
871 \subsection{Foreign function interface declaration}
873 %************************************************************************
877 -- foreign declarations are distinguished as to whether they define or use a
880 -- * the Boolean value indicates whether the pre-standard deprecated syntax
883 type LForeignDecl name = Located (ForeignDecl name)
885 data ForeignDecl name
886 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
887 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
888 deriving (Data, Typeable)
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 -- interruptible, safe or unsafe
909 FastString -- name of C header
910 CImportSpec -- details of the C entity
911 deriving (Data, Typeable)
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
919 deriving (Data, Typeable)
921 -- specification of an externally exported entity in dependence on the calling
924 data ForeignExport = CExport CExportSpec -- contains the calling convention
925 deriving (Data, Typeable)
927 -- pretty printing of foreign declarations
930 instance OutputableBndr name => Outputable (ForeignDecl name) where
931 ppr (ForeignImport n ty fimport) =
932 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
933 2 (dcolon <+> ppr ty)
934 ppr (ForeignExport n ty fexport) =
935 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
936 2 (dcolon <+> ppr ty)
938 instance Outputable ForeignImport where
939 ppr (CImport cconv safety header spec) =
940 ppr cconv <+> ppr safety <+>
941 char '"' <> pprCEntity spec <> char '"'
943 pp_hdr = if nullFS header then empty else ftext header
945 pprCEntity (CLabel lbl) =
946 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
947 pprCEntity (CFunction (StaticTarget lbl _)) =
948 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
949 pprCEntity (CFunction (DynamicTarget)) =
950 ptext (sLit "dynamic")
951 pprCEntity (CWrapper) = ptext (sLit "wrapper")
953 instance Outputable ForeignExport where
954 ppr (CExport (CExportStatic lbl cconv)) =
955 ppr cconv <+> char '"' <> ppr lbl <> char '"'
959 %************************************************************************
961 \subsection{Transformation rules}
963 %************************************************************************
966 type LRuleDecl name = Located (RuleDecl name)
969 = HsRule -- Source rule
970 RuleName -- Rule name
972 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
973 (Located (HsExpr name)) -- LHS
974 NameSet -- Free-vars from the LHS
975 (Located (HsExpr name)) -- RHS
976 NameSet -- Free-vars from the RHS
977 deriving (Data, Typeable)
980 = RuleBndr (Located name)
981 | RuleBndrSig (Located name) (LHsType name)
982 deriving (Data, Typeable)
984 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
985 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
987 instance OutputableBndr name => Outputable (RuleDecl name) where
988 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
989 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
990 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
991 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
993 pp_forall | null ns = empty
994 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
996 instance OutputableBndr name => Outputable (RuleBndr name) where
997 ppr (RuleBndr name) = ppr name
998 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1002 %************************************************************************
1004 \subsection{Vectorisation declarations}
1006 %************************************************************************
1008 A vectorisation pragma
1010 {-# VECTORISE f = closure1 g (scalar_map g) #-} OR
1011 {-# VECTORISE SCALAR f #-}
1013 Note [Typechecked vectorisation pragmas]
1014 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1015 In case of the first variant of vectorisation pragmas (with an explicit expression),
1016 we need to infer the type of that expression during type checking and then keep that type
1017 around until vectorisation, so that it can be checked against the *vectorised* type of 'f'.
1018 (We cannot determine vectorised types during type checking due to internal information of
1019 the vectoriser being needed.)
1021 To this end, we annotate the 'Id' of 'f' (the variable mentioned in the PRAGMA) with the
1022 inferred type of the expression. This is slightly dodgy, as this is really the type of
1023 '$v_f' (the name of the vectorised function).
1026 type LVectDecl name = Located (VectDecl name)
1031 (Maybe (LHsExpr name)) -- 'Nothing' => SCALAR declaration
1032 deriving (Data, Typeable)
1034 instance OutputableBndr name => Outputable (VectDecl name) where
1036 = sep [text "{-# VECTORISE" <+> ppr v,
1038 Nothing -> text "SCALAR #-}"
1039 Just rhs -> pprExpr (unLoc rhs) <+> text "#-}") ]
1042 %************************************************************************
1044 \subsection[DocDecl]{Document comments}
1046 %************************************************************************
1050 type LDocDecl = Located (DocDecl)
1053 = DocCommentNext HsDocString
1054 | DocCommentPrev HsDocString
1055 | DocCommentNamed String HsDocString
1056 | DocGroup Int HsDocString
1057 deriving (Data, Typeable)
1059 -- Okay, I need to reconstruct the document comments, but for now:
1060 instance Outputable DocDecl where
1061 ppr _ = text "<document comment>"
1063 docDeclDoc :: DocDecl -> HsDocString
1064 docDeclDoc (DocCommentNext d) = d
1065 docDeclDoc (DocCommentPrev d) = d
1066 docDeclDoc (DocCommentNamed _ d) = d
1067 docDeclDoc (DocGroup _ d) = d
1071 %************************************************************************
1073 \subsection[DeprecDecl]{Deprecations}
1075 %************************************************************************
1077 We use exported entities for things to deprecate.
1080 type LWarnDecl name = Located (WarnDecl name)
1082 data WarnDecl name = Warning name WarningTxt
1083 deriving (Data, Typeable)
1085 instance OutputableBndr name => Outputable (WarnDecl name) where
1086 ppr (Warning thing txt)
1087 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1090 %************************************************************************
1092 \subsection[AnnDecl]{Annotations}
1094 %************************************************************************
1097 type LAnnDecl name = Located (AnnDecl name)
1099 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1100 deriving (Data, Typeable)
1102 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1103 ppr (HsAnnotation provenance expr)
1104 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1107 data AnnProvenance name = ValueAnnProvenance name
1108 | TypeAnnProvenance name
1109 | ModuleAnnProvenance
1110 deriving (Data, Typeable)
1112 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1113 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1114 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1115 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1117 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1118 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1119 modifyAnnProvenanceNameM fm prov =
1121 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1122 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1123 ModuleAnnProvenance -> return ModuleAnnProvenance
1125 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1126 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1127 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1128 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name