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,
32 -- ** @default@ declarations
33 DefaultDecl(..), LDefaultDecl,
34 -- ** Top-level template haskell splice
36 -- ** Foreign function interface declarations
37 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
39 -- ** Data-constructor declarations
40 ConDecl(..), LConDecl, ResType(..),
41 HsConDeclDetails, hsConDeclArgTys,
42 -- ** Document comments
43 DocDecl(..), LDocDecl, docDeclDoc,
45 WarnDecl(..), LWarnDecl,
47 AnnDecl(..), LAnnDecl,
48 AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
51 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups
55 import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, pprExpr )
56 -- Because Expr imports Decls via HsBracket
63 import {- Kind parts of -} Type
74 import Control.Monad ( liftM )
76 import Data.Maybe ( isJust )
79 %************************************************************************
81 \subsection[HsDecl]{Declarations}
83 %************************************************************************
86 type LHsDecl id = Located (HsDecl id)
88 -- | A Haskell Declaration
90 = TyClD (TyClDecl id) -- ^ A type or class declaration.
91 | InstD (InstDecl id) -- ^ An instance declaration.
92 | DerivD (DerivDecl id)
95 | DefD (DefaultDecl id)
96 | ForD (ForeignDecl id)
97 | WarningD (WarnDecl id)
100 | VectD (VectDecl id)
101 | SpliceD (SpliceDecl id)
103 | QuasiQuoteD (HsQuasiQuote id)
104 deriving (Data, Typeable)
107 -- NB: all top-level fixity decls are contained EITHER
109 -- OR in the ClassDecls in TyClDs
112 -- a) data constructors
113 -- b) class methods (but they can be also done in the
114 -- signatures of class decls)
115 -- c) imported functions (that have an IfacSig)
116 -- d) top level decls
118 -- The latter is for class methods only
120 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
121 -- fed to the renamer.
124 hs_valds :: HsValBinds id,
126 hs_tyclds :: [[LTyClDecl id]],
127 -- A list of mutually-recursive groups
128 -- Parser generates a singleton list;
129 -- renamer does dependency analysis
131 hs_instds :: [LInstDecl id],
132 hs_derivds :: [LDerivDecl id],
134 hs_fixds :: [LFixitySig id],
135 -- Snaffled out of both top-level fixity signatures,
136 -- and those in class declarations
138 hs_defds :: [LDefaultDecl id],
139 hs_fords :: [LForeignDecl id],
140 hs_warnds :: [LWarnDecl id],
141 hs_annds :: [LAnnDecl id],
142 hs_ruleds :: [LRuleDecl id],
143 hs_vects :: [LVectDecl id],
145 hs_docs :: [LDocDecl]
146 } deriving (Data, Typeable)
148 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
149 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
150 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
152 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
153 hs_fixds = [], hs_defds = [], hs_annds = [],
154 hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
155 hs_valds = error "emptyGroup hs_valds: Can't happen",
158 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
161 hs_valds = val_groups1,
164 hs_derivds = derivds1,
174 hs_valds = val_groups2,
177 hs_derivds = derivds2,
188 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
189 hs_tyclds = tyclds1 ++ tyclds2,
190 hs_instds = instds1 ++ instds2,
191 hs_derivds = derivds1 ++ derivds2,
192 hs_fixds = fixds1 ++ fixds2,
193 hs_annds = annds1 ++ annds2,
194 hs_defds = defds1 ++ defds2,
195 hs_fords = fords1 ++ fords2,
196 hs_warnds = warnds1 ++ warnds2,
197 hs_ruleds = rulds1 ++ rulds2,
198 hs_vects = vects1 ++ vects2,
199 hs_docs = docs1 ++ docs2 }
203 instance OutputableBndr name => Outputable (HsDecl name) where
204 ppr (TyClD dcl) = ppr dcl
205 ppr (ValD binds) = ppr binds
206 ppr (DefD def) = ppr def
207 ppr (InstD inst) = ppr inst
208 ppr (DerivD deriv) = ppr deriv
209 ppr (ForD fd) = ppr fd
210 ppr (SigD sd) = ppr sd
211 ppr (RuleD rd) = ppr rd
212 ppr (VectD vect) = ppr vect
213 ppr (WarningD wd) = ppr wd
214 ppr (AnnD ad) = ppr ad
215 ppr (SpliceD dd) = ppr dd
216 ppr (DocD doc) = ppr doc
217 ppr (QuasiQuoteD qq) = ppr qq
219 instance OutputableBndr name => Outputable (HsGroup name) where
220 ppr (HsGroup { hs_valds = val_decls,
221 hs_tyclds = tycl_decls,
222 hs_instds = inst_decls,
223 hs_derivds = deriv_decls,
224 hs_fixds = fix_decls,
225 hs_warnds = deprec_decls,
226 hs_annds = ann_decls,
227 hs_fords = foreign_decls,
228 hs_defds = default_decls,
229 hs_ruleds = rule_decls,
230 hs_vects = vect_decls })
232 [ppr_ds fix_decls, ppr_ds default_decls,
233 ppr_ds deprec_decls, ppr_ds ann_decls,
236 if isEmptyValBinds val_decls
238 else Just (ppr val_decls),
239 ppr_ds (concat tycl_decls),
242 ppr_ds foreign_decls]
244 ppr_ds :: Outputable a => [a] -> Maybe SDoc
246 ppr_ds ds = Just (vcat (map ppr ds))
248 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
249 -- Concatenate vertically with white-space between non-blanks
251 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
252 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
255 = SpliceDecl -- Top level splice
256 (Located (HsExpr id))
257 HsExplicitFlag -- Explicit <=> $(f x y)
258 -- Implicit <=> f x y, i.e. a naked top level expression
259 deriving (Data, Typeable)
261 instance OutputableBndr name => Outputable (SpliceDecl name) where
262 ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
266 %************************************************************************
268 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
270 %************************************************************************
272 --------------------------------
274 --------------------------------
276 Here is the story about the implicit names that go with type, class,
277 and instance decls. It's a bit tricky, so pay attention!
279 "Implicit" (or "system") binders
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 Each data type decl defines
282 a worker name for each constructor
283 to-T and from-T convertors
284 Each class decl defines
285 a tycon for the class
286 a data constructor for that tycon
287 the worker for that constructor
288 a selector for each superclass
290 All have occurrence names that are derived uniquely from their parent
293 None of these get separate definitions in an interface file; they are
294 fully defined by the data or class decl. But they may *occur* in
295 interface files, of course. Any such occurrence must haul in the
296 relevant type or class decl.
299 - Ensure they "point to" the parent data/class decl
300 when loading that decl from an interface file
301 (See RnHiFiles.getSysBinders)
303 - When typechecking the decl, we build the implicit TyCons and Ids.
304 When doing so we look them up in the name cache (RnEnv.lookupSysName),
305 to ensure correct module and provenance is set
307 These are the two places that we have to conjure up the magic derived
308 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
312 - Occurrence name is derived uniquely from the method name
315 - If there is a default method name at all, it's recorded in
316 the ClassOpSig (in HsBinds), in the DefMeth field.
317 (DefMeth is defined in Class.lhs)
319 Source-code class decls and interface-code class decls are treated subtly
320 differently, which has given me a great deal of confusion over the years.
321 Here's the deal. (We distinguish the two cases because source-code decls
322 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
324 In *source-code* class declarations:
326 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
327 This is done by RdrHsSyn.mkClassOpSigDM
329 - The renamer renames it to a Name
331 - During typechecking, we generate a binding for each $dm for
332 which there's a programmer-supplied default method:
337 We generate a binding for $dmop1 but not for $dmop2.
338 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
339 The Name for $dmop2 is simply discarded.
341 In *interface-file* class declarations:
342 - When parsing, we see if there's an explicit programmer-supplied default method
343 because there's an '=' sign to indicate it:
345 op1 = :: <type> -- NB the '='
347 We use this info to generate a DefMeth with a suitable RdrName for op1,
348 and a NoDefMeth for op2
349 - The interface file has a separate definition for $dmop1, with unfolding etc.
350 - The renamer renames it to a Name.
351 - The renamer treats $dmop1 as a free variable of the declaration, so that
352 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
353 This doesn't happen for source code class decls, because they *bind* the default method.
357 Each instance declaration gives rise to one dictionary function binding.
359 The type checker makes up new source-code instance declarations
360 (e.g. from 'deriving' or generic default methods --- see
361 TcInstDcls.tcInstDecls1). So we can't generate the names for
362 dictionary functions in advance (we don't know how many we need).
364 On the other hand for interface-file instance declarations, the decl
365 specifies the name of the dictionary function, and it has a binding elsewhere
366 in the interface file:
367 instance {Eq Int} = dEqInt
368 dEqInt :: {Eq Int} <pragma info>
370 So again we treat source code and interface file code slightly differently.
373 - Source code instance decls have a Nothing in the (Maybe name) field
374 (see data InstDecl below)
376 - The typechecker makes up a Local name for the dict fun for any source-code
377 instance decl, whether it comes from a source-code instance decl, or whether
378 the instance decl is derived from some other construct (e.g. 'deriving').
380 - The occurrence name it chooses is derived from the instance decl (just for
381 documentation really) --- e.g. dNumInt. Two dict funs may share a common
382 occurrence name, but will have different uniques. E.g.
383 instance Foo [Int] where ...
384 instance Foo [Bool] where ...
385 These might both be dFooList
387 - The CoreTidy phase externalises the name, and ensures the occurrence name is
388 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
390 - We can take this relaxed approach (changing the occurrence name later)
391 because dict fun Ids are not captured in a TyCon or Class (unlike default
392 methods, say). Instead, they are kept separately in the InstEnv. This
393 makes it easy to adjust them after compiling a module. (Once we've finished
394 compiling that module, they don't change any more.)
398 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
399 in the (Maybe name) field.
401 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
402 suck in the dfun binding
406 -- Representation of indexed types
407 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
408 -- Family kind signatures are represented by the variant `TyFamily'. It
409 -- covers "type family", "newtype family", and "data family" declarations,
410 -- distinguished by the value of the field `tcdFlavour'.
412 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
413 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
415 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
416 -- synonym declaration and 'tcdVars' contains the type parameters of the
419 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
420 -- 'pats' are type patterns for the type-indexes of the type constructor
421 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
422 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
423 -- *not* 'length tcdVars'.
425 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
427 type LTyClDecl name = Located (TyClDecl name)
429 -- | A type or class declaration.
432 tcdLName :: Located name,
433 tcdExtName :: Maybe FastString
437 | -- | @type/data family T :: *->*@
438 TyFamily { tcdFlavour:: FamilyFlavour, -- type or data
439 tcdLName :: Located name, -- type constructor
440 tcdTyVars :: [LHsTyVarBndr name], -- type variables
441 tcdKind :: Maybe Kind -- result kind
445 | -- | Declares a data type or newtype, giving its construcors
447 -- data/newtype T a = <constrs>
448 -- data/newtype instance T [a] = <constrs>
450 TyData { tcdND :: NewOrData,
451 tcdCtxt :: LHsContext name, -- ^ Context
452 tcdLName :: Located name, -- ^ Type constructor
454 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
456 tcdTyPats :: Maybe [LHsType name],
459 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
460 -- in this case @tcdTyVars = fv( tcdTyPats )@.
461 -- @Nothing@ for everything else.
463 tcdKindSig:: Maybe Kind,
464 -- ^ Optional kind signature.
466 -- @(Just k)@ for a GADT-style @data@, or @data
467 -- instance@ decl with explicit kind sig
469 tcdCons :: [LConDecl name],
470 -- ^ Data constructors
472 -- For @data T a = T1 | T2 a@
473 -- the 'LConDecl's all have 'ResTyH98'.
474 -- For @data T a where { T1 :: T a }@
475 -- the 'LConDecls' all have 'ResTyGADT'.
477 tcdDerivs :: Maybe [LHsType name]
478 -- ^ Derivings; @Nothing@ => not specified,
479 -- @Just []@ => derive exactly what is asked
481 -- These "types" must be of form
483 -- forall ab. C ty1 ty2
485 -- Typically the foralls and ty args are empty, but they
486 -- are non-empty for the newtype-deriving case
489 | TySynonym { tcdLName :: Located name, -- ^ type constructor
490 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
491 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
492 -- See comments for tcdTyPats in TyData
493 -- 'Nothing' => vanilla type synonym
495 tcdSynRhs :: LHsType name -- ^ synonym expansion
498 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
499 tcdLName :: Located name, -- ^ Name of the class
500 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
501 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
502 tcdSigs :: [LSig name], -- ^ Methods' signatures
503 tcdMeths :: LHsBinds name, -- ^ Default methods
504 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
505 -- only 'TyFamily' and
507 -- latter for defaults
508 tcdDocs :: [LDocDecl] -- ^ Haddock docs
510 deriving (Data, Typeable)
513 = NewType -- ^ @newtype Blah ...@
514 | DataType -- ^ @data Blah ...@
515 deriving( Eq, Data, Typeable ) -- Needed because Demand derives Eq
518 = TypeFamily -- ^ @type family ...@
519 | DataFamily -- ^ @data family ...@
520 deriving (Data, Typeable)
526 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
528 isDataDecl :: TyClDecl name -> Bool
529 isDataDecl (TyData {}) = True
530 isDataDecl _other = False
532 -- | type or type instance declaration
533 isTypeDecl :: TyClDecl name -> Bool
534 isTypeDecl (TySynonym {}) = True
535 isTypeDecl _other = False
537 -- | vanilla Haskell type synonym (ie, not a type instance)
538 isSynDecl :: TyClDecl name -> Bool
539 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
540 isSynDecl _other = False
543 isClassDecl :: TyClDecl name -> Bool
544 isClassDecl (ClassDecl {}) = True
545 isClassDecl _ = False
547 -- | type family declaration
548 isFamilyDecl :: TyClDecl name -> Bool
549 isFamilyDecl (TyFamily {}) = True
550 isFamilyDecl _other = False
552 -- | family instance (types, newtypes, and data types)
553 isFamInstDecl :: TyClDecl name -> Bool
556 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
563 tcdName :: TyClDecl name -> name
564 tcdName decl = unLoc (tcdLName decl)
566 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
567 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
568 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
569 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
570 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
571 tyClDeclTyVars (ForeignType {}) = []
575 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
576 -- class, synonym decls, data, newtype, family decls, family instances
578 = (count isClassDecl decls,
579 count isSynDecl decls, -- excluding...
580 count isDataTy decls, -- ...family...
581 count isNewTy decls, -- ...instances
582 count isFamilyDecl decls,
583 count isFamInstDecl decls)
585 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
588 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
593 instance OutputableBndr name
594 => Outputable (TyClDecl name) where
596 ppr (ForeignType {tcdLName = ltycon})
597 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
599 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
600 tcdTyVars = tyvars, tcdKind = mb_kind})
601 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
603 pp_flavour = case flavour of
604 TypeFamily -> ptext (sLit "type family")
605 DataFamily -> ptext (sLit "data family")
607 pp_kind = case mb_kind of
609 Just kind -> dcolon <+> pprKind kind
611 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
612 tcdSynRhs = mono_ty})
613 = hang (ptext (sLit "type") <+>
614 (if isJust typats then ptext (sLit "instance") else empty) <+>
615 pp_decl_head [] ltycon tyvars typats <+>
619 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
620 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
621 tcdCons = condecls, tcdDerivs = derivings})
622 = pp_tydecl (null condecls && isJust mb_sig)
624 (if isJust typats then ptext (sLit "instance") else empty) <+>
625 pp_decl_head (unLoc context) ltycon tyvars typats <+>
627 (pp_condecls condecls)
630 ppr_sigx Nothing = empty
631 ppr_sigx (Just kind) = dcolon <+> pprKind kind
633 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
635 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
636 | null sigs && null ats -- No "where" part
639 | otherwise -- Laid out
640 = sep [hsep [top_matter, ptext (sLit "where {")],
641 nest 4 (sep [ sep (map ppr_semi ats)
642 , sep (map ppr_semi sigs)
643 , pprLHsBinds methods
646 top_matter = ptext (sLit "class")
647 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
648 <+> pprFundeps (map unLoc fds)
649 ppr_semi :: Outputable a => a -> SDoc
650 ppr_semi decl = ppr decl <> semi
652 pp_decl_head :: OutputableBndr name
655 -> [LHsTyVarBndr name]
656 -> Maybe [LHsType name]
658 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
659 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
660 pp_decl_head context thing _ (Just typats) -- explicit type patterns
661 = hsep [ pprHsContext context, ppr thing
662 , hsep (map (pprParendHsType.unLoc) typats)]
664 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
665 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
666 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
667 pp_condecls cs -- In H98 syntax
668 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
670 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
671 pp_tydecl True pp_head _ _
673 pp_tydecl False pp_head pp_decl_rhs derivings
674 = hang pp_head 4 (sep [
678 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
681 instance Outputable NewOrData where
682 ppr NewType = ptext (sLit "newtype")
683 ppr DataType = ptext (sLit "data")
687 %************************************************************************
689 \subsection[ConDecl]{A data-constructor declaration}
691 %************************************************************************
694 type LConDecl name = Located (ConDecl name)
696 -- data T b = forall a. Eq a => MkT a b
697 -- MkT :: forall b a. Eq a => MkT a b
700 -- MkT1 :: Int -> T Int
702 -- data T = Int `MkT` Int
706 -- Int `MkT` Int :: T Int
710 { con_name :: Located name
711 -- ^ Constructor name. This is used for the DataCon itself, and for
712 -- the user-callable wrapper Id.
714 , con_explicit :: HsExplicitFlag
715 -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
717 , con_qvars :: [LHsTyVarBndr name]
718 -- ^ Type variables. Depending on 'con_res' this describes the
719 -- follewing entities
721 -- - ResTyH98: the constructor's *existential* type variables
722 -- - ResTyGADT: *all* the constructor's quantified type variables
724 , con_cxt :: LHsContext name
725 -- ^ The context. This /does not/ include the \"stupid theta\" which
726 -- lives only in the 'TyData' decl.
728 , con_details :: HsConDeclDetails name
729 -- ^ The main payload
731 , con_res :: ResType name
732 -- ^ Result type of the constructor
734 , con_doc :: Maybe LHsDocString
735 -- ^ A possible Haddock comment.
737 , con_old_rec :: Bool
738 -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
739 -- GADT-style record decl C { blah } :: T a b
740 -- Remove this when we no longer parse this stuff, and hence do not
741 -- need to report decprecated use
742 } deriving (Data, Typeable)
744 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
746 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
747 hsConDeclArgTys (PrefixCon tys) = tys
748 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
749 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
752 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
753 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
754 -- and here is its result type
755 deriving (Data, Typeable)
757 instance OutputableBndr name => Outputable (ResType name) where
759 ppr ResTyH98 = ptext (sLit "ResTyH98")
760 ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
765 instance (OutputableBndr name) => Outputable (ConDecl name) where
768 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
769 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
770 , con_cxt = cxt, con_details = details
771 , con_res = ResTyH98, con_doc = doc })
772 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
774 ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
775 ppr_details (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
776 ppr_details (RecCon fields) = ppr con <+> pprConDeclFields fields
778 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
779 , con_cxt = cxt, con_details = PrefixCon arg_tys
780 , con_res = ResTyGADT res_ty })
781 = ppr con <+> dcolon <+>
782 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
784 mk_fun_ty a b = noLoc (HsFunTy a b)
786 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
787 , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
788 = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
789 pprConDeclFields fields <+> arrow <+> ppr res_ty]
791 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
792 = pprPanic "pprConDecl" (ppr con)
793 -- In GADT syntax we don't allow infix constructors
796 %************************************************************************
798 \subsection[InstDecl]{An instance declaration}
800 %************************************************************************
803 type LInstDecl name = Located (InstDecl name)
806 = InstDecl (LHsType name) -- Context => Class Instance-type
807 -- Using a polytype means that the renamer conveniently
808 -- figures out the quantified type variables for us.
810 [LSig name] -- User-supplied pragmatic info
811 [LTyClDecl name]-- Associated types (ie, 'TyData' and
813 deriving (Data, Typeable)
815 instance (OutputableBndr name) => Outputable (InstDecl name) where
817 ppr (InstDecl inst_ty binds uprags ats)
818 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
819 , nest 4 $ vcat (map ppr ats)
820 , nest 4 $ vcat (map ppr uprags)
821 , nest 4 $ pprLHsBinds binds ]
823 -- Extract the declarations of associated types from an instance
825 instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
826 instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
829 %************************************************************************
831 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
833 %************************************************************************
836 type LDerivDecl name = Located (DerivDecl name)
838 data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
839 deriving (Data, Typeable)
841 instance (OutputableBndr name) => Outputable (DerivDecl name) where
843 = hsep [ptext (sLit "deriving instance"), ppr ty]
846 %************************************************************************
848 \subsection[DefaultDecl]{A @default@ declaration}
850 %************************************************************************
852 There can only be one default declaration per module, but it is hard
853 for the parser to check that; we pass them all through in the abstract
854 syntax, and that restriction must be checked in the front end.
857 type LDefaultDecl name = Located (DefaultDecl name)
859 data DefaultDecl name
860 = DefaultDecl [LHsType name]
861 deriving (Data, Typeable)
863 instance (OutputableBndr name)
864 => Outputable (DefaultDecl name) where
866 ppr (DefaultDecl tys)
867 = ptext (sLit "default") <+> parens (interpp'SP tys)
870 %************************************************************************
872 \subsection{Foreign function interface declaration}
874 %************************************************************************
878 -- foreign declarations are distinguished as to whether they define or use a
881 -- * the Boolean value indicates whether the pre-standard deprecated syntax
884 type LForeignDecl name = Located (ForeignDecl name)
886 data ForeignDecl name
887 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
888 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
889 deriving (Data, Typeable)
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 -- interruptible, safe or unsafe
910 FastString -- name of C header
911 CImportSpec -- details of the C entity
912 deriving (Data, Typeable)
914 -- details of an external C entity
916 data CImportSpec = CLabel CLabelString -- import address of a C label
917 | CFunction CCallTarget -- static or dynamic function
918 | CWrapper -- wrapper to expose closures
920 deriving (Data, Typeable)
922 -- specification of an externally exported entity in dependence on the calling
925 data ForeignExport = CExport CExportSpec -- contains the calling convention
926 deriving (Data, Typeable)
928 -- pretty printing of foreign declarations
931 instance OutputableBndr name => Outputable (ForeignDecl name) where
932 ppr (ForeignImport n ty fimport) =
933 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
934 2 (dcolon <+> ppr ty)
935 ppr (ForeignExport n ty fexport) =
936 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
937 2 (dcolon <+> ppr ty)
939 instance Outputable ForeignImport where
940 ppr (CImport cconv safety header spec) =
941 ppr cconv <+> ppr safety <+>
942 char '"' <> pprCEntity spec <> char '"'
944 pp_hdr = if nullFS header then empty else ftext header
946 pprCEntity (CLabel lbl) =
947 ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
948 pprCEntity (CFunction (StaticTarget lbl _)) =
949 ptext (sLit "static") <+> pp_hdr <+> ppr lbl
950 pprCEntity (CFunction (DynamicTarget)) =
951 ptext (sLit "dynamic")
952 pprCEntity (CWrapper) = ptext (sLit "wrapper")
954 instance Outputable ForeignExport where
955 ppr (CExport (CExportStatic lbl cconv)) =
956 ppr cconv <+> char '"' <> ppr lbl <> char '"'
960 %************************************************************************
962 \subsection{Transformation rules}
964 %************************************************************************
967 type LRuleDecl name = Located (RuleDecl name)
970 = HsRule -- Source rule
971 RuleName -- Rule name
973 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
974 (Located (HsExpr name)) -- LHS
975 NameSet -- Free-vars from the LHS
976 (Located (HsExpr name)) -- RHS
977 NameSet -- Free-vars from the RHS
978 deriving (Data, Typeable)
981 = RuleBndr (Located name)
982 | RuleBndrSig (Located name) (LHsType name)
983 deriving (Data, Typeable)
985 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
986 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
988 instance OutputableBndr name => Outputable (RuleDecl name) where
989 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
990 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
991 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
992 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
994 pp_forall | null ns = empty
995 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
997 instance OutputableBndr name => Outputable (RuleBndr name) where
998 ppr (RuleBndr name) = ppr name
999 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1003 %************************************************************************
1005 \subsection{Vectorisation declarations}
1007 %************************************************************************
1009 A vectorisation pragma, one of
1011 {-# VECTORISE f = closure1 g (scalar_map g) #-}
1012 {-# VECTORISE SCALAR f #-}
1013 {-# NOVECTORISE f #-}
1015 Note [Typechecked vectorisation pragmas]
1016 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1017 In case of the first variant of vectorisation pragmas (with an explicit expression),
1018 we need to infer the type of that expression during type checking and then keep that type
1019 around until vectorisation, so that it can be checked against the *vectorised* type of 'f'.
1020 (We cannot determine vectorised types during type checking due to internal information of
1021 the vectoriser being needed.)
1023 To this end, we annotate the 'Id' of 'f' (the variable mentioned in the PRAGMA) with the
1024 inferred type of the expression. This is slightly dodgy, as this is really the type of
1025 '$v_f' (the name of the vectorised function).
1028 type LVectDecl name = Located (VectDecl name)
1033 (Maybe (LHsExpr name)) -- 'Nothing' => SCALAR declaration
1036 deriving (Data, Typeable)
1038 lvectDeclName :: LVectDecl name -> name
1039 lvectDeclName (L _ (HsVect (L _ name) _)) = name
1040 lvectDeclName (L _ (HsNoVect (L _ name))) = name
1042 instance OutputableBndr name => Outputable (VectDecl name) where
1043 ppr (HsVect v Nothing)
1044 = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
1045 ppr (HsVect v (Just rhs))
1046 = sep [text "{-# VECTORISE" <+> ppr v,
1048 pprExpr (unLoc rhs) <+> text "#-}" ]
1050 = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1053 %************************************************************************
1055 \subsection[DocDecl]{Document comments}
1057 %************************************************************************
1061 type LDocDecl = Located (DocDecl)
1064 = DocCommentNext HsDocString
1065 | DocCommentPrev HsDocString
1066 | DocCommentNamed String HsDocString
1067 | DocGroup Int HsDocString
1068 deriving (Data, Typeable)
1070 -- Okay, I need to reconstruct the document comments, but for now:
1071 instance Outputable DocDecl where
1072 ppr _ = text "<document comment>"
1074 docDeclDoc :: DocDecl -> HsDocString
1075 docDeclDoc (DocCommentNext d) = d
1076 docDeclDoc (DocCommentPrev d) = d
1077 docDeclDoc (DocCommentNamed _ d) = d
1078 docDeclDoc (DocGroup _ d) = d
1082 %************************************************************************
1084 \subsection[DeprecDecl]{Deprecations}
1086 %************************************************************************
1088 We use exported entities for things to deprecate.
1091 type LWarnDecl name = Located (WarnDecl name)
1093 data WarnDecl name = Warning name WarningTxt
1094 deriving (Data, Typeable)
1096 instance OutputableBndr name => Outputable (WarnDecl name) where
1097 ppr (Warning thing txt)
1098 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1101 %************************************************************************
1103 \subsection[AnnDecl]{Annotations}
1105 %************************************************************************
1108 type LAnnDecl name = Located (AnnDecl name)
1110 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1111 deriving (Data, Typeable)
1113 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1114 ppr (HsAnnotation provenance expr)
1115 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1118 data AnnProvenance name = ValueAnnProvenance name
1119 | TypeAnnProvenance name
1120 | ModuleAnnProvenance
1121 deriving (Data, Typeable)
1123 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1124 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1125 annProvenanceName_maybe (TypeAnnProvenance name) = Just name
1126 annProvenanceName_maybe ModuleAnnProvenance = Nothing
1128 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1129 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1130 modifyAnnProvenanceNameM fm prov =
1132 ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1133 TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1134 ModuleAnnProvenance -> return ModuleAnnProvenance
1136 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1137 pprAnnProvenance ModuleAnnProvenance = ptext (sLit "ANN module")
1138 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1139 pprAnnProvenance (TypeAnnProvenance name) = ptext (sLit "ANN type") <+> ppr name