2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
9 {-# OPTIONS -fno-warn-incomplete-patterns #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 {-# LANGUAGE DeriveDataTypeable #-}
17 -- | Abstract syntax of global declarations.
19 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
20 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
22 -- * Toplevel declarations
24 -- ** Class or type declarations
25 TyClDecl(..), LTyClDecl,
26 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
27 isFamInstDecl, tcdName, tyClDeclTyVars,
29 -- ** Instance declarations
30 InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
32 -- ** Standalone deriving declarations
33 DerivDecl(..), LDerivDecl,
34 -- ** @RULE@ declarations
35 RuleDecl(..), LRuleDecl, RuleBndr(..),
36 collectRuleBndrSigTys,
37 -- ** @VECTORISE@ declarations
38 VectDecl(..), LVectDecl,
39 -- ** @default@ declarations
40 DefaultDecl(..), LDefaultDecl,
41 -- ** Top-level template haskell splice
43 -- ** Foreign function interface declarations
44 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
46 -- ** Data-constructor declarations
47 ConDecl(..), LConDecl, ResType(..),
48 HsConDeclDetails, hsConDeclArgTys,
49 -- ** Document comments
50 DocDecl(..), LDocDecl, docDeclDoc,
52 WarnDecl(..), LWarnDecl,
54 AnnDecl(..), LAnnDecl,
55 AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
58 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups
62 import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, pprExpr )
63 -- Because Expr imports Decls via HsBracket
70 import {- Kind parts of -} Type
81 import Control.Monad ( liftM )
83 import Data.Maybe ( isJust )
86 %************************************************************************
88 \subsection[HsDecl]{Declarations}
90 %************************************************************************
93 type LHsDecl id = Located (HsDecl id)
95 -- | A Haskell Declaration
97 = TyClD (TyClDecl id) -- ^ A type or class declaration.
98 | InstD (InstDecl id) -- ^ An instance declaration.
99 | DerivD (DerivDecl id)
102 | DefD (DefaultDecl id)
103 | ForD (ForeignDecl id)
104 | WarningD (WarnDecl id)
106 | RuleD (RuleDecl id)
107 | VectD (VectDecl id)
108 | SpliceD (SpliceDecl id)
110 | QuasiQuoteD (HsQuasiQuote id)
111 deriving (Data, Typeable)
114 -- NB: all top-level fixity decls are contained EITHER
116 -- OR in the ClassDecls in TyClDs
119 -- a) data constructors
120 -- b) class methods (but they can be also done in the
121 -- signatures of class decls)
122 -- c) imported functions (that have an IfacSig)
123 -- d) top level decls
125 -- The latter is for class methods only
127 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
128 -- fed to the renamer.
131 hs_valds :: HsValBinds id,
133 hs_tyclds :: [[LTyClDecl id]],
134 -- A list of mutually-recursive groups
135 -- Parser generates a singleton list;
136 -- renamer does dependency analysis
138 hs_instds :: [LInstDecl id],
139 hs_derivds :: [LDerivDecl id],
141 hs_fixds :: [LFixitySig id],
142 -- Snaffled out of both top-level fixity signatures,
143 -- and those in class declarations
145 hs_defds :: [LDefaultDecl id],
146 hs_fords :: [LForeignDecl id],
147 hs_warnds :: [LWarnDecl id],
148 hs_annds :: [LAnnDecl id],
149 hs_ruleds :: [LRuleDecl id],
150 hs_vects :: [LVectDecl id],
152 hs_docs :: [LDocDecl]
153 } deriving (Data, Typeable)
155 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
156 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
157 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
159 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
160 hs_fixds = [], hs_defds = [], hs_annds = [],
161 hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
162 hs_valds = error "emptyGroup hs_valds: Can't happen",
165 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
168 hs_valds = val_groups1,
171 hs_derivds = derivds1,
181 hs_valds = val_groups2,
184 hs_derivds = derivds2,
195 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
196 hs_tyclds = tyclds1 ++ tyclds2,
197 hs_instds = instds1 ++ instds2,
198 hs_derivds = derivds1 ++ derivds2,
199 hs_fixds = fixds1 ++ fixds2,
200 hs_annds = annds1 ++ annds2,
201 hs_defds = defds1 ++ defds2,
202 hs_fords = fords1 ++ fords2,
203 hs_warnds = warnds1 ++ warnds2,
204 hs_ruleds = rulds1 ++ rulds2,
205 hs_vects = vects1 ++ vects2,
206 hs_docs = docs1 ++ docs2 }
210 instance OutputableBndr name => Outputable (HsDecl name) where
211 ppr (TyClD dcl) = ppr dcl
212 ppr (ValD binds) = ppr binds
213 ppr (DefD def) = ppr def
214 ppr (InstD inst) = ppr inst
215 ppr (DerivD deriv) = ppr deriv
216 ppr (ForD fd) = ppr fd
217 ppr (SigD sd) = ppr sd
218 ppr (RuleD rd) = ppr rd
219 ppr (VectD vect) = ppr vect
220 ppr (WarningD wd) = ppr wd
221 ppr (AnnD ad) = ppr ad
222 ppr (SpliceD dd) = ppr dd
223 ppr (DocD doc) = ppr doc
224 ppr (QuasiQuoteD qq) = ppr qq
226 instance OutputableBndr name => Outputable (HsGroup name) where
227 ppr (HsGroup { hs_valds = val_decls,
228 hs_tyclds = tycl_decls,
229 hs_instds = inst_decls,
230 hs_derivds = deriv_decls,
231 hs_fixds = fix_decls,
232 hs_warnds = deprec_decls,
233 hs_annds = ann_decls,
234 hs_fords = foreign_decls,
235 hs_defds = default_decls,
236 hs_ruleds = rule_decls,
237 hs_vects = vect_decls })
239 [ppr_ds fix_decls, ppr_ds default_decls,
240 ppr_ds deprec_decls, ppr_ds ann_decls,
243 if isEmptyValBinds val_decls
245 else Just (ppr val_decls),
246 ppr_ds (concat tycl_decls),
249 ppr_ds foreign_decls]
251 ppr_ds :: Outputable a => [a] -> Maybe SDoc
253 ppr_ds ds = Just (vcat (map ppr ds))
255 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
256 -- Concatenate vertically with white-space between non-blanks
258 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
259 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
262 = SpliceDecl -- Top level splice
263 (Located (HsExpr id))
264 HsExplicitFlag -- Explicit <=> $(f x y)
265 -- Implicit <=> f x y, i.e. a naked top level expression
266 deriving (Data, Typeable)
268 instance OutputableBndr name => Outputable (SpliceDecl name) where
269 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
273 %************************************************************************
275 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
277 %************************************************************************
279 --------------------------------
281 --------------------------------
283 Here is the story about the implicit names that go with type, class,
284 and instance decls. It's a bit tricky, so pay attention!
286 "Implicit" (or "system") binders
287 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
288 Each data type decl defines
289 a worker name for each constructor
290 to-T and from-T convertors
291 Each class decl defines
292 a tycon for the class
293 a data constructor for that tycon
294 the worker for that constructor
295 a selector for each superclass
297 All have occurrence names that are derived uniquely from their parent
300 None of these get separate definitions in an interface file; they are
301 fully defined by the data or class decl. But they may *occur* in
302 interface files, of course. Any such occurrence must haul in the
303 relevant type or class decl.
306 - Ensure they "point to" the parent data/class decl
307 when loading that decl from an interface file
308 (See RnHiFiles.getSysBinders)
310 - When typechecking the decl, we build the implicit TyCons and Ids.
311 When doing so we look them up in the name cache (RnEnv.lookupSysName),
312 to ensure correct module and provenance is set
314 These are the two places that we have to conjure up the magic derived
315 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
319 - Occurrence name is derived uniquely from the method name
322 - If there is a default method name at all, it's recorded in
323 the ClassOpSig (in HsBinds), in the DefMeth field.
324 (DefMeth is defined in Class.lhs)
326 Source-code class decls and interface-code class decls are treated subtly
327 differently, which has given me a great deal of confusion over the years.
328 Here's the deal. (We distinguish the two cases because source-code decls
329 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
331 In *source-code* class declarations:
333 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
334 This is done by RdrHsSyn.mkClassOpSigDM
336 - The renamer renames it to a Name
338 - During typechecking, we generate a binding for each $dm for
339 which there's a programmer-supplied default method:
344 We generate a binding for $dmop1 but not for $dmop2.
345 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
346 The Name for $dmop2 is simply discarded.
348 In *interface-file* class declarations:
349 - When parsing, we see if there's an explicit programmer-supplied default method
350 because there's an '=' sign to indicate it:
352 op1 = :: <type> -- NB the '='
354 We use this info to generate a DefMeth with a suitable RdrName for op1,
355 and a NoDefMeth for op2
356 - The interface file has a separate definition for $dmop1, with unfolding etc.
357 - The renamer renames it to a Name.
358 - The renamer treats $dmop1 as a free variable of the declaration, so that
359 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
360 This doesn't happen for source code class decls, because they *bind* the default method.
364 Each instance declaration gives rise to one dictionary function binding.
366 The type checker makes up new source-code instance declarations
367 (e.g. from 'deriving' or generic default methods --- see
368 TcInstDcls.tcInstDecls1). So we can't generate the names for
369 dictionary functions in advance (we don't know how many we need).
371 On the other hand for interface-file instance declarations, the decl
372 specifies the name of the dictionary function, and it has a binding elsewhere
373 in the interface file:
374 instance {Eq Int} = dEqInt
375 dEqInt :: {Eq Int} <pragma info>
377 So again we treat source code and interface file code slightly differently.
380 - Source code instance decls have a Nothing in the (Maybe name) field
381 (see data InstDecl below)
383 - The typechecker makes up a Local name for the dict fun for any source-code
384 instance decl, whether it comes from a source-code instance decl, or whether
385 the instance decl is derived from some other construct (e.g. 'deriving').
387 - The occurrence name it chooses is derived from the instance decl (just for
388 documentation really) --- e.g. dNumInt. Two dict funs may share a common
389 occurrence name, but will have different uniques. E.g.
390 instance Foo [Int] where ...
391 instance Foo [Bool] where ...
392 These might both be dFooList
394 - The CoreTidy phase externalises the name, and ensures the occurrence name is
395 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
397 - We can take this relaxed approach (changing the occurrence name later)
398 because dict fun Ids are not captured in a TyCon or Class (unlike default
399 methods, say). Instead, they are kept separately in the InstEnv. This
400 makes it easy to adjust them after compiling a module. (Once we've finished
401 compiling that module, they don't change any more.)
405 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
406 in the (Maybe name) field.
408 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
409 suck in the dfun binding
413 -- Representation of indexed types
414 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
415 -- Family kind signatures are represented by the variant `TyFamily'. It
416 -- covers "type family", "newtype family", and "data family" declarations,
417 -- distinguished by the value of the field `tcdFlavour'.
419 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
420 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
422 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
423 -- synonym declaration and 'tcdVars' contains the type parameters of the
426 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
427 -- 'pats' are type patterns for the type-indexes of the type constructor
428 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
429 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
430 -- *not* 'length tcdVars'.
432 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
434 type LTyClDecl name = Located (TyClDecl name)
436 -- | A type or class declaration.
439 tcdLName :: Located name,
440 tcdExtName :: Maybe FastString
444 | -- | @type/data family T :: *->*@
445 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
446 tcdLName :: Located name, -- type constructor
447 tcdTyVars :: [LHsTyVarBndr name], -- type variables
448 tcdKind :: Maybe Kind -- result kind
452 | -- | Declares a data type or newtype, giving its construcors
454 -- data/newtype T a = <constrs>
455 -- data/newtype instance T [a] = <constrs>
457 TyData { tcdND :: NewOrData,
458 tcdCtxt :: LHsContext name, -- ^ Context
459 tcdLName :: Located name, -- ^ Type constructor
461 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
463 tcdTyPats :: Maybe [LHsType name],
466 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
467 -- in this case @tcdTyVars = fv( tcdTyPats )@.
468 -- @Nothing@ for everything else.
470 tcdKindSig:: Maybe Kind,
471 -- ^ Optional kind signature.
473 -- @(Just k)@ for a GADT-style @data@, or @data
474 -- instance@ decl with explicit kind sig
476 tcdCons :: [LConDecl name],
477 -- ^ Data constructors
479 -- For @data T a = T1 | T2 a@
480 -- the 'LConDecl's all have 'ResTyH98'.
481 -- For @data T a where { T1 :: T a }@
482 -- the 'LConDecls' all have 'ResTyGADT'.
484 tcdDerivs :: Maybe [LHsType name]
485 -- ^ Derivings; @Nothing@ => not specified,
486 -- @Just []@ => derive exactly what is asked
488 -- These "types" must be of form
490 -- forall ab. C ty1 ty2
492 -- Typically the foralls and ty args are empty, but they
493 -- are non-empty for the newtype-deriving case
496 | TySynonym { tcdLName :: Located name, -- ^ type constructor
497 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
498 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
499 -- See comments for tcdTyPats in TyData
500 -- 'Nothing' => vanilla type synonym
502 tcdSynRhs :: LHsType name -- ^ synonym expansion
505 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
506 tcdLName :: Located name, -- ^ Name of the class
507 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
508 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
509 tcdSigs :: [LSig name], -- ^ Methods' signatures
510 tcdMeths :: LHsBinds name, -- ^ Default methods
511 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
512 -- only 'TyFamily' and
514 -- latter for defaults
515 tcdDocs :: [LDocDecl] -- ^ Haddock docs
517 deriving (Data, Typeable)
520 = NewType -- ^ @newtype Blah ...@
521 | DataType -- ^ @data Blah ...@
522 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
525 = TypeFamily -- ^ @type family ...@
526 | DataFamily -- ^ @data family ...@
527 deriving (Data, Typeable)
533 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
535 isDataDecl :: TyClDecl name -> Bool
536 isDataDecl (TyData {}) = True
537 isDataDecl _other = False
539 -- | type or type instance declaration
540 isTypeDecl :: TyClDecl name -> Bool
541 isTypeDecl (TySynonym {}) = True
542 isTypeDecl _other = False
544 -- | vanilla Haskell type synonym (ie, not a type instance)
545 isSynDecl :: TyClDecl name -> Bool
546 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
547 isSynDecl _other = False
550 isClassDecl :: TyClDecl name -> Bool
551 isClassDecl (ClassDecl {}) = True
552 isClassDecl _ = False
554 -- | type family declaration
555 isFamilyDecl :: TyClDecl name -> Bool
556 isFamilyDecl (TyFamily {}) = True
557 isFamilyDecl _other = False
559 -- | family instance (types, newtypes, and data types)
560 isFamInstDecl :: TyClDecl name -> Bool
563 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
570 tcdName :: TyClDecl name -> name
571 tcdName decl = unLoc (tcdLName decl)
573 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
574 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
575 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
576 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
577 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
578 tyClDeclTyVars (ForeignType {}) = []
582 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
583 -- class, synonym decls, data, newtype, family decls, family instances
585 = (count isClassDecl decls,
586 count isSynDecl decls, -- excluding...
587 count isDataTy decls, -- ...family...
588 count isNewTy decls, -- ...instances
589 count isFamilyDecl decls,
590 count isFamInstDecl decls)
592 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
595 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
600 instance OutputableBndr name
601 => Outputable (TyClDecl name) where
603 ppr (ForeignType {tcdLName = ltycon})
604 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
606 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
607 tcdTyVars = tyvars, tcdKind = mb_kind})
608 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
610 pp_flavour = case flavour of
611 TypeFamily -> ptext (sLit "type family")
612 DataFamily -> ptext (sLit "data family")
614 pp_kind = case mb_kind of
616 Just kind -> dcolon <+> pprKind kind
618 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
619 tcdSynRhs = mono_ty})
620 = hang (ptext (sLit "type") <+>
621 (if isJust typats then ptext (sLit "instance") else empty) <+>
622 pp_decl_head [] ltycon tyvars typats <+>
626 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
627 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
628 tcdCons = condecls, tcdDerivs = derivings})
629 = pp_tydecl (null condecls && isJust mb_sig)
631 (if isJust typats then ptext (sLit "instance") else empty) <+>
632 pp_decl_head (unLoc context) ltycon tyvars typats <+>
634 (pp_condecls condecls)
637 ppr_sig Nothing = empty
638 ppr_sig (Just kind) = dcolon <+> pprKind kind
640 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
642 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
643 | null sigs && null ats -- No "where" part
646 | otherwise -- Laid out
647 = sep [hsep [top_matter, ptext (sLit "where {")],
648 nest 4 (sep [ sep (map ppr_semi ats)
649 , sep (map ppr_semi sigs)
650 , pprLHsBinds methods
653 top_matter = ptext (sLit "class")
654 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
655 <+> pprFundeps (map unLoc fds)
656 ppr_semi :: Outputable a => a -> SDoc
657 ppr_semi decl = ppr decl <> semi
659 pp_decl_head :: OutputableBndr name
662 -> [LHsTyVarBndr name]
663 -> Maybe [LHsType name]
665 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
666 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
667 pp_decl_head context thing _ (Just typats) -- explicit type patterns
668 = hsep [ pprHsContext context, ppr thing
669 , hsep (map (pprParendHsType.unLoc) typats)]
671 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
672 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
673 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
674 pp_condecls cs -- In H98 syntax
675 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
677 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
678 pp_tydecl True pp_head _ _
680 pp_tydecl False pp_head pp_decl_rhs derivings
681 = hang pp_head 4 (sep [
685 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
688 instance Outputable NewOrData where
689 ppr NewType = ptext (sLit "newtype")
690 ppr DataType = ptext (sLit "data")
694 %************************************************************************
696 \subsection[ConDecl]{A data-constructor declaration}
698 %************************************************************************
701 type LConDecl name = Located (ConDecl name)
703 -- data T b = forall a. Eq a => MkT a b
704 -- MkT :: forall b a. Eq a => MkT a b
707 -- MkT1 :: Int -> T Int
709 -- data T = Int `MkT` Int
713 -- Int `MkT` Int :: T Int
717 { con_name :: Located name
718 -- ^ Constructor name. This is used for the DataCon itself, and for
719 -- the user-callable wrapper Id.
721 , con_explicit :: HsExplicitFlag
722 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
724 , con_qvars :: [LHsTyVarBndr name]
725 -- ^ Type variables. Depending on 'con_res' this describes the
726 -- follewing entities
728 -- - ResTyH98: the constructor's *existential* type variables
729 -- - ResTyGADT: *all* the constructor's quantified type variables
731 , con_cxt :: LHsContext name
732 -- ^ The context. This /does not/ include the \"stupid theta\" which
733 -- lives only in the 'TyData' decl.
735 , con_details :: HsConDeclDetails name
736 -- ^ The main payload
738 , con_res :: ResType name
739 -- ^ Result type of the constructor
741 , con_doc :: Maybe LHsDocString
742 -- ^ A possible Haddock comment.
744 , con_old_rec :: Bool
745 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
746 -- GADT-style record decl C { blah } :: T a b
747 -- Remove this when we no longer parse this stuff, and hence do not
748 -- need to report decprecated use
749 } deriving (Data, Typeable)
751 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
753 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
754 hsConDeclArgTys (PrefixCon tys) = tys
755 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
756 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
759 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
760 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
761 -- and here is its result type
762 deriving (Data, Typeable)
764 instance OutputableBndr name => Outputable (ResType name) where
766 ppr ResTyH98 = ptext (sLit "ResTyH98")
767 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
772 instance (OutputableBndr name) => Outputable (ConDecl name) where
775 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
776 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
777 , con_cxt = cxt, con_details = details
778 , con_res = ResTyH98, con_doc = doc })
779 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
781 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
782 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
783 ppr_details con (RecCon fields) = ppr con <+> pprConDeclFields fields
785 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
786 , con_cxt = cxt, con_details = PrefixCon arg_tys
787 , con_res = ResTyGADT res_ty })
788 = ppr con <+> dcolon <+>
789 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
791 mk_fun_ty a b = noLoc (HsFunTy a b)
793 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
794 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
795 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
796 pprConDeclFields fields <+> arrow <+> ppr res_ty]
798 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
799 = pprPanic "pprConDecl" (ppr con)
800 -- In GADT syntax we don't allow infix constructors
803 %************************************************************************
805 \subsection[InstDecl]{An instance declaration
807 %************************************************************************
810 type LInstDecl name = Located (InstDecl name)
813 = InstDecl (LHsType name) -- Context => Class Instance-type
814 -- Using a polytype means that the renamer conveniently
815 -- figures out the quantified type variables for us.
817 [LSig name] -- User-supplied pragmatic info
818 [LTyClDecl name]-- Associated types (ie, 'TyData' and
820 deriving (Data, Typeable)
822 instance (OutputableBndr name) => Outputable (InstDecl name) where
824 ppr (InstDecl inst_ty binds uprags ats)
825 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
826 , nest 4 $ vcat (map ppr ats)
827 , nest 4 $ vcat (map ppr uprags)
828 , nest 4 $ pprLHsBinds binds ]
830 -- Extract the declarations of associated types from an instance
832 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
833 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
836 %************************************************************************
838 \subsection[DerivDecl]{A stand-alone instance deriving declaration
840 %************************************************************************
843 type LDerivDecl name = Located (DerivDecl name)
845 data DerivDecl name = DerivDecl (LHsType name)
846 deriving (Data, Typeable)
848 instance (OutputableBndr name) => Outputable (DerivDecl name) where
850 = hsep [ptext (sLit "deriving instance"), ppr ty]
853 %************************************************************************
855 \subsection[DefaultDecl]{A @default@ declaration}
857 %************************************************************************
859 There can only be one default declaration per module, but it is hard
860 for the parser to check that; we pass them all through in the abstract
861 syntax, and that restriction must be checked in the front end.
864 type LDefaultDecl name = Located (DefaultDecl name)
866 data DefaultDecl name
867 = DefaultDecl [LHsType name]
868 deriving (Data, Typeable)
870 instance (OutputableBndr name)
871 => Outputable (DefaultDecl name) where
873 ppr (DefaultDecl tys)
874 = ptext (sLit "default") <+> parens (interpp'SP tys)
877 %************************************************************************
879 \subsection{Foreign function interface declaration}
881 %************************************************************************
885 -- foreign declarations are distinguished as to whether they define or use a
888 -- * the Boolean value indicates whether the pre-standard deprecated syntax
891 type LForeignDecl name = Located (ForeignDecl name)
893 data ForeignDecl name
894 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
895 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
896 deriving (Data, Typeable)
898 -- Specification Of an imported external entity in dependence on the calling
901 data ForeignImport = -- import of a C entity
903 -- * the two strings specifying a header file or library
904 -- may be empty, which indicates the absence of a
905 -- header or object specification (both are not used
906 -- in the case of `CWrapper' and when `CFunction'
907 -- has a dynamic target)
909 -- * the calling convention is irrelevant for code
910 -- generation in the case of `CLabel', but is needed
911 -- for pretty printing
913 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
915 CImport CCallConv -- ccall or stdcall
916 Safety -- interruptible, safe or unsafe
917 FastString -- name of C header
918 CImportSpec -- details of the C entity
919 deriving (Data, Typeable)
921 -- details of an external C entity
923 data CImportSpec = CLabel CLabelString -- import address of a C label
924 | CFunction CCallTarget -- static or dynamic function
925 | CWrapper -- wrapper to expose closures
927 deriving (Data, Typeable)
929 -- specification of an externally exported entity in dependence on the calling
932 data ForeignExport = CExport CExportSpec -- contains the calling convention
933 deriving (Data, Typeable)
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 (CImport cconv safety header spec) =
948 ppr cconv <+> ppr safety <+>
949 char '"' <> pprCEntity spec <> char '"'
951 pp_hdr = if nullFS header then empty else ftext header
953 pprCEntity (CLabel lbl) =
954 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
955 pprCEntity (CFunction (StaticTarget lbl _)) =
956 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
957 pprCEntity (CFunction (DynamicTarget)) =
958 ptext (sLit "dynamic")
959 pprCEntity (CWrapper) = ptext (sLit "wrapper")
961 instance Outputable ForeignExport where
962 ppr (CExport (CExportStatic lbl cconv)) =
963 ppr cconv <+> char '"' <> ppr lbl <> char '"'
967 %************************************************************************
969 \subsection{Transformation rules}
971 %************************************************************************
974 type LRuleDecl name = Located (RuleDecl name)
977 = HsRule -- Source rule
978 RuleName -- Rule name
980 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
981 (Located (HsExpr name)) -- LHS
982 NameSet -- Free-vars from the LHS
983 (Located (HsExpr name)) -- RHS
984 NameSet -- Free-vars from the RHS
985 deriving (Data, Typeable)
988 = RuleBndr (Located name)
989 | RuleBndrSig (Located name) (LHsType name)
990 deriving (Data, Typeable)
992 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
993 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
995 instance OutputableBndr name => Outputable (RuleDecl name) where
996 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
997 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
998 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
999 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1001 pp_forall | null ns = empty
1002 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1004 instance OutputableBndr name => Outputable (RuleBndr name) where
1005 ppr (RuleBndr name) = ppr name
1006 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1010 %************************************************************************
1012 \subsection{Vectorisation declarations}
1014 %************************************************************************
1016 A vectorisation pragma
1018 {-# VECTORISE f = closure1 g (scalar_map g) #-} OR
1019 {-# VECTORISE SCALAR f #-}
1021 Note [Typechecked vectorisation pragmas]
1022 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1023 In case of the first variant of vectorisation pragmas (with an explicit expression),
1024 we need to infer the type of that expression during type checking and then keep that type
1025 around until vectorisation, so that it can be checked against the *vectorised* type of 'f'.
1026 (We cannot determine vectorised types during type checking due to internal information of
1027 the vectoriser being needed.)
1029 To this end, we annotate the 'Id' of 'f' (the variable mentioned in the PRAGMA) with the
1030 inferred type of the expression. This is slightly dodgy, as this is really the type of
1031 '$v_f' (the name of the vectorised function).
1034 type LVectDecl name = Located (VectDecl name)
1039 (Maybe (LHsExpr name)) -- 'Nothing' => SCALAR declaration
1040 deriving (Data, Typeable)
1042 instance OutputableBndr name => Outputable (VectDecl name) where
1044 = sep [text "{-# VECTORISE" <+> ppr v,
1046 Nothing -> text "SCALAR #-}"
1047 Just rhs -> pprExpr (unLoc rhs) <+> text "#-}") ]
1050 %************************************************************************
1052 \subsection[DocDecl]{Document comments}
1054 %************************************************************************
1058 type LDocDecl = Located (DocDecl)
1061 = DocCommentNext HsDocString
1062 | DocCommentPrev HsDocString
1063 | DocCommentNamed String HsDocString
1064 | DocGroup Int HsDocString
1065 deriving (Data, Typeable)
1067 -- Okay, I need to reconstruct the document comments, but for now:
1068 instance Outputable DocDecl where
1069 ppr _ = text "<document comment>"
1071 docDeclDoc :: DocDecl -> HsDocString
1072 docDeclDoc (DocCommentNext d) = d
1073 docDeclDoc (DocCommentPrev d) = d
1074 docDeclDoc (DocCommentNamed _ d) = d
1075 docDeclDoc (DocGroup _ d) = d
1079 %************************************************************************
1081 \subsection[DeprecDecl]{Deprecations}
1083 %************************************************************************
1085 We use exported entities for things to deprecate.
1088 type LWarnDecl name = Located (WarnDecl name)
1090 data WarnDecl name = Warning name WarningTxt
1091 deriving (Data, Typeable)
1093 instance OutputableBndr name => Outputable (WarnDecl name) where
1094 ppr (Warning thing txt)
1095 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1098 %************************************************************************
1100 \subsection[AnnDecl]{Annotations}
1102 %************************************************************************
1105 type LAnnDecl name = Located (AnnDecl name)
1107 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1108 deriving (Data, Typeable)
1110 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1111 ppr (HsAnnotation provenance expr)
1112 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1115 data AnnProvenance name = ValueAnnProvenance name
1116 | TypeAnnProvenance name
1117 | ModuleAnnProvenance
1118 deriving (Data, Typeable)
1120 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1121 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1122 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1123 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1125 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1126 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1127 modifyAnnProvenanceNameM fm prov =
1129 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1130 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1131 ModuleAnnProvenance -> return ModuleAnnProvenance
1133 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1134 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1135 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1136 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name