TTG3 Combined Step 1 and 3 for Trees That Grow
[ghc.git] / compiler / hsSyn / HsDecls.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
7 DeriveTraversable #-}
8 {-# LANGUAGE StandaloneDeriving #-}
9 {-# LANGUAGE FlexibleContexts #-}
10 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
11 -- in module PlaceHolder
12 {-# LANGUAGE ConstraintKinds #-}
13 {-# LANGUAGE FlexibleInstances #-}
14
15 -- | Abstract syntax of global declarations.
16 --
17 -- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
18 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
19 module HsDecls (
20 -- * Toplevel declarations
21 HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving,
22 HsDerivingClause(..), LHsDerivingClause,
23
24 -- ** Class or type declarations
25 TyClDecl(..), LTyClDecl,
26 TyClGroup(..), mkTyClGroup, emptyTyClGroup,
27 tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
28 isClassDecl, isDataDecl, isSynDecl, tcdName,
29 isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
30 isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
31 tyFamInstDeclName, tyFamInstDeclLName,
32 countTyClDecls, pprTyClDeclFlavour,
33 tyClDeclLName, tyClDeclTyVars,
34 hsDeclHasCusk, famDeclHasCusk,
35 FamilyDecl(..), LFamilyDecl,
36
37 -- ** Instance declarations
38 InstDecl(..), LInstDecl, NewOrData(..), FamilyInfo(..),
39 TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
40 DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour, pprFamInstLHS,
41 FamInstEqn, LFamInstEqn, FamEqn(..),
42 TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
43 HsTyPats,
44 LClsInstDecl, ClsInstDecl(..),
45
46 -- ** Standalone deriving declarations
47 DerivDecl(..), LDerivDecl,
48 -- ** @RULE@ declarations
49 LRuleDecls,RuleDecls(..),RuleDecl(..), LRuleDecl, RuleBndr(..),LRuleBndr,
50 collectRuleBndrSigTys,
51 flattenRuleDecls, pprFullRuleName,
52 -- ** @VECTORISE@ declarations
53 VectDecl(..), LVectDecl,
54 lvectDeclName, lvectInstDecl,
55 -- ** @default@ declarations
56 DefaultDecl(..), LDefaultDecl,
57 -- ** Template haskell declaration splice
58 SpliceExplicitFlag(..),
59 SpliceDecl(..), LSpliceDecl,
60 -- ** Foreign function interface declarations
61 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
62 noForeignImportCoercionYet, noForeignExportCoercionYet,
63 CImportSpec(..),
64 -- ** Data-constructor declarations
65 ConDecl(..), LConDecl,
66 HsConDeclDetails, hsConDeclArgTys,
67 getConNames,
68 getConDetails,
69 gadtDeclDetails,
70 -- ** Document comments
71 DocDecl(..), LDocDecl, docDeclDoc,
72 -- ** Deprecations
73 WarnDecl(..), LWarnDecl,
74 WarnDecls(..), LWarnDecls,
75 -- ** Annotations
76 AnnDecl(..), LAnnDecl,
77 AnnProvenance(..), annProvenanceName_maybe,
78 -- ** Role annotations
79 RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
80 -- ** Injective type families
81 FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
82 resultVariableName,
83
84 -- * Grouping
85 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls
86
87 ) where
88
89 -- friends:
90 import GhcPrelude
91
92 import {-# SOURCE #-} HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr,
93 pprSpliceDecl )
94 -- Because Expr imports Decls via HsBracket
95
96 import HsBinds
97 import HsTypes
98 import HsDoc
99 import TyCon
100 import Name
101 import BasicTypes
102 import Coercion
103 import ForeignCall
104 import PlaceHolder ( PlaceHolder, placeHolder )
105 import HsExtension
106 import NameSet
107
108 -- others:
109 import InstEnv
110 import Class
111 import Outputable
112 import Util
113 import SrcLoc
114
115 import Bag
116 import Maybes
117 import Data.Data hiding (TyCon,Fixity, Infix)
118
119 {-
120 ************************************************************************
121 * *
122 \subsection[HsDecl]{Declarations}
123 * *
124 ************************************************************************
125 -}
126
127 type LHsDecl id = Located (HsDecl id)
128 -- ^ When in a list this may have
129 --
130 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
131 --
132
133 -- For details on above see note [Api annotations] in ApiAnnotation
134
135 -- | A Haskell Declaration
136 data HsDecl id
137 = TyClD (TyClDecl id) -- ^ Type or Class Declaration
138 | InstD (InstDecl id) -- ^ Instance declaration
139 | DerivD (DerivDecl id) -- ^ Deriving declaration
140 | ValD (HsBind id) -- ^ Value declaration
141 | SigD (Sig id) -- ^ Signature declaration
142 | DefD (DefaultDecl id) -- ^ 'default' declaration
143 | ForD (ForeignDecl id) -- ^ Foreign declaration
144 | WarningD (WarnDecls id) -- ^ Warning declaration
145 | AnnD (AnnDecl id) -- ^ Annotation declaration
146 | RuleD (RuleDecls id) -- ^ Rule declaration
147 | VectD (VectDecl id) -- ^ Vectorise declaration
148 | SpliceD (SpliceDecl id) -- ^ Splice declaration
149 -- (Includes quasi-quotes)
150 | DocD (DocDecl) -- ^ Documentation comment declaration
151 | RoleAnnotD (RoleAnnotDecl id) -- ^ Role annotation declaration
152 deriving instance (DataIdLR id id) => Data (HsDecl id)
153
154
155 -- NB: all top-level fixity decls are contained EITHER
156 -- EITHER SigDs
157 -- OR in the ClassDecls in TyClDs
158 --
159 -- The former covers
160 -- a) data constructors
161 -- b) class methods (but they can be also done in the
162 -- signatures of class decls)
163 -- c) imported functions (that have an IfacSig)
164 -- d) top level decls
165 --
166 -- The latter is for class methods only
167
168 -- | Haskell Group
169 --
170 -- A 'HsDecl' is categorised into a 'HsGroup' before being
171 -- fed to the renamer.
172 data HsGroup id
173 = HsGroup {
174 hs_valds :: HsValBinds id,
175 hs_splcds :: [LSpliceDecl id],
176
177 hs_tyclds :: [TyClGroup id],
178 -- A list of mutually-recursive groups;
179 -- This includes `InstDecl`s as well;
180 -- Parser generates a singleton list;
181 -- renamer does dependency analysis
182
183 hs_derivds :: [LDerivDecl id],
184
185 hs_fixds :: [LFixitySig id],
186 -- Snaffled out of both top-level fixity signatures,
187 -- and those in class declarations
188
189 hs_defds :: [LDefaultDecl id],
190 hs_fords :: [LForeignDecl id],
191 hs_warnds :: [LWarnDecls id],
192 hs_annds :: [LAnnDecl id],
193 hs_ruleds :: [LRuleDecls id],
194 hs_vects :: [LVectDecl id],
195
196 hs_docs :: [LDocDecl]
197 }
198 deriving instance (DataIdLR id id) => Data (HsGroup id)
199
200 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass a)
201 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
202 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
203
204 hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
205 hsGroupInstDecls = (=<<) group_instds . hs_tyclds
206
207 emptyGroup = HsGroup { hs_tyclds = [],
208 hs_derivds = [],
209 hs_fixds = [], hs_defds = [], hs_annds = [],
210 hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
211 hs_valds = error "emptyGroup hs_valds: Can't happen",
212 hs_splcds = [],
213 hs_docs = [] }
214
215 appendGroups :: HsGroup (GhcPass a) -> HsGroup (GhcPass a)
216 -> HsGroup (GhcPass a)
217 appendGroups
218 HsGroup {
219 hs_valds = val_groups1,
220 hs_splcds = spliceds1,
221 hs_tyclds = tyclds1,
222 hs_derivds = derivds1,
223 hs_fixds = fixds1,
224 hs_defds = defds1,
225 hs_annds = annds1,
226 hs_fords = fords1,
227 hs_warnds = warnds1,
228 hs_ruleds = rulds1,
229 hs_vects = vects1,
230 hs_docs = docs1 }
231 HsGroup {
232 hs_valds = val_groups2,
233 hs_splcds = spliceds2,
234 hs_tyclds = tyclds2,
235 hs_derivds = derivds2,
236 hs_fixds = fixds2,
237 hs_defds = defds2,
238 hs_annds = annds2,
239 hs_fords = fords2,
240 hs_warnds = warnds2,
241 hs_ruleds = rulds2,
242 hs_vects = vects2,
243 hs_docs = docs2 }
244 =
245 HsGroup {
246 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
247 hs_splcds = spliceds1 ++ spliceds2,
248 hs_tyclds = tyclds1 ++ tyclds2,
249 hs_derivds = derivds1 ++ derivds2,
250 hs_fixds = fixds1 ++ fixds2,
251 hs_annds = annds1 ++ annds2,
252 hs_defds = defds1 ++ defds2,
253 hs_fords = fords1 ++ fords2,
254 hs_warnds = warnds1 ++ warnds2,
255 hs_ruleds = rulds1 ++ rulds2,
256 hs_vects = vects1 ++ vects2,
257 hs_docs = docs1 ++ docs2 }
258
259 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
260 => Outputable (HsDecl (GhcPass p)) where
261 ppr (TyClD dcl) = ppr dcl
262 ppr (ValD binds) = ppr binds
263 ppr (DefD def) = ppr def
264 ppr (InstD inst) = ppr inst
265 ppr (DerivD deriv) = ppr deriv
266 ppr (ForD fd) = ppr fd
267 ppr (SigD sd) = ppr sd
268 ppr (RuleD rd) = ppr rd
269 ppr (VectD vect) = ppr vect
270 ppr (WarningD wd) = ppr wd
271 ppr (AnnD ad) = ppr ad
272 ppr (SpliceD dd) = ppr dd
273 ppr (DocD doc) = ppr doc
274 ppr (RoleAnnotD ra) = ppr ra
275
276 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
277 => Outputable (HsGroup (GhcPass p)) where
278 ppr (HsGroup { hs_valds = val_decls,
279 hs_tyclds = tycl_decls,
280 hs_derivds = deriv_decls,
281 hs_fixds = fix_decls,
282 hs_warnds = deprec_decls,
283 hs_annds = ann_decls,
284 hs_fords = foreign_decls,
285 hs_defds = default_decls,
286 hs_ruleds = rule_decls,
287 hs_vects = vect_decls })
288 = vcat_mb empty
289 [ppr_ds fix_decls, ppr_ds default_decls,
290 ppr_ds deprec_decls, ppr_ds ann_decls,
291 ppr_ds rule_decls,
292 ppr_ds vect_decls,
293 if isEmptyValBinds val_decls
294 then Nothing
295 else Just (ppr val_decls),
296 ppr_ds (tyClGroupTyClDecls tycl_decls),
297 ppr_ds (tyClGroupInstDecls tycl_decls),
298 ppr_ds deriv_decls,
299 ppr_ds foreign_decls]
300 where
301 ppr_ds :: Outputable a => [a] -> Maybe SDoc
302 ppr_ds [] = Nothing
303 ppr_ds ds = Just (vcat (map ppr ds))
304
305 vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
306 -- Concatenate vertically with white-space between non-blanks
307 vcat_mb _ [] = empty
308 vcat_mb gap (Nothing : ds) = vcat_mb gap ds
309 vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds
310
311 -- | Located Splice Declaration
312 type LSpliceDecl pass = Located (SpliceDecl pass)
313
314 -- | Splice Declaration
315 data SpliceDecl id
316 = SpliceDecl -- Top level splice
317 (Located (HsSplice id))
318 SpliceExplicitFlag
319 deriving instance (DataIdLR id id) => Data (SpliceDecl id)
320
321 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
322 => Outputable (SpliceDecl (GhcPass p)) where
323 ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
324
325 {-
326 ************************************************************************
327 * *
328 Type and class declarations
329 * *
330 ************************************************************************
331
332 Note [The Naming story]
333 ~~~~~~~~~~~~~~~~~~~~~~~
334 Here is the story about the implicit names that go with type, class,
335 and instance decls. It's a bit tricky, so pay attention!
336
337 "Implicit" (or "system") binders
338 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
339 Each data type decl defines
340 a worker name for each constructor
341 to-T and from-T convertors
342 Each class decl defines
343 a tycon for the class
344 a data constructor for that tycon
345 the worker for that constructor
346 a selector for each superclass
347
348 All have occurrence names that are derived uniquely from their parent
349 declaration.
350
351 None of these get separate definitions in an interface file; they are
352 fully defined by the data or class decl. But they may *occur* in
353 interface files, of course. Any such occurrence must haul in the
354 relevant type or class decl.
355
356 Plan of attack:
357 - Ensure they "point to" the parent data/class decl
358 when loading that decl from an interface file
359 (See RnHiFiles.getSysBinders)
360
361 - When typechecking the decl, we build the implicit TyCons and Ids.
362 When doing so we look them up in the name cache (RnEnv.lookupSysName),
363 to ensure correct module and provenance is set
364
365 These are the two places that we have to conjure up the magic derived
366 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
367
368 Default methods
369 ~~~~~~~~~~~~~~~
370 - Occurrence name is derived uniquely from the method name
371 E.g. $dmmax
372
373 - If there is a default method name at all, it's recorded in
374 the ClassOpSig (in HsBinds), in the DefMethInfo field.
375 (DefMethInfo is defined in Class.hs)
376
377 Source-code class decls and interface-code class decls are treated subtly
378 differently, which has given me a great deal of confusion over the years.
379 Here's the deal. (We distinguish the two cases because source-code decls
380 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
381
382 In *source-code* class declarations:
383
384 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
385 This is done by RdrHsSyn.mkClassOpSigDM
386
387 - The renamer renames it to a Name
388
389 - During typechecking, we generate a binding for each $dm for
390 which there's a programmer-supplied default method:
391 class Foo a where
392 op1 :: <type>
393 op2 :: <type>
394 op1 = ...
395 We generate a binding for $dmop1 but not for $dmop2.
396 The Class for Foo has a Nothing for op2 and
397 a Just ($dm_op1, VanillaDM) for op1.
398 The Name for $dmop2 is simply discarded.
399
400 In *interface-file* class declarations:
401 - When parsing, we see if there's an explicit programmer-supplied default method
402 because there's an '=' sign to indicate it:
403 class Foo a where
404 op1 = :: <type> -- NB the '='
405 op2 :: <type>
406 We use this info to generate a DefMeth with a suitable RdrName for op1,
407 and a NoDefMeth for op2
408 - The interface file has a separate definition for $dmop1, with unfolding etc.
409 - The renamer renames it to a Name.
410 - The renamer treats $dmop1 as a free variable of the declaration, so that
411 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
412 This doesn't happen for source code class decls, because they *bind* the default method.
413
414 Dictionary functions
415 ~~~~~~~~~~~~~~~~~~~~
416 Each instance declaration gives rise to one dictionary function binding.
417
418 The type checker makes up new source-code instance declarations
419 (e.g. from 'deriving' or generic default methods --- see
420 TcInstDcls.tcInstDecls1). So we can't generate the names for
421 dictionary functions in advance (we don't know how many we need).
422
423 On the other hand for interface-file instance declarations, the decl
424 specifies the name of the dictionary function, and it has a binding elsewhere
425 in the interface file:
426 instance {Eq Int} = dEqInt
427 dEqInt :: {Eq Int} <pragma info>
428
429 So again we treat source code and interface file code slightly differently.
430
431 Source code:
432 - Source code instance decls have a Nothing in the (Maybe name) field
433 (see data InstDecl below)
434
435 - The typechecker makes up a Local name for the dict fun for any source-code
436 instance decl, whether it comes from a source-code instance decl, or whether
437 the instance decl is derived from some other construct (e.g. 'deriving').
438
439 - The occurrence name it chooses is derived from the instance decl (just for
440 documentation really) --- e.g. dNumInt. Two dict funs may share a common
441 occurrence name, but will have different uniques. E.g.
442 instance Foo [Int] where ...
443 instance Foo [Bool] where ...
444 These might both be dFooList
445
446 - The CoreTidy phase externalises the name, and ensures the occurrence name is
447 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
448
449 - We can take this relaxed approach (changing the occurrence name later)
450 because dict fun Ids are not captured in a TyCon or Class (unlike default
451 methods, say). Instead, they are kept separately in the InstEnv. This
452 makes it easy to adjust them after compiling a module. (Once we've finished
453 compiling that module, they don't change any more.)
454
455
456 Interface file code:
457 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
458 in the (Maybe name) field.
459
460 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
461 suck in the dfun binding
462 -}
463
464 -- | Located Declaration of a Type or Class
465 type LTyClDecl pass = Located (TyClDecl pass)
466
467 -- | A type or class declaration.
468 data TyClDecl pass
469 = -- | @type/data family T :: *->*@
470 --
471 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
472 -- 'ApiAnnotation.AnnData',
473 -- 'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
474 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
475 -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
476 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
477 -- 'ApiAnnotation.AnnVbar'
478
479 -- For details on above see note [Api annotations] in ApiAnnotation
480 FamDecl { tcdFam :: FamilyDecl pass }
481
482 | -- | @type@ declaration
483 --
484 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
485 -- 'ApiAnnotation.AnnEqual',
486
487 -- For details on above see note [Api annotations] in ApiAnnotation
488 SynDecl { tcdLName :: Located (IdP pass) -- ^ Type constructor
489 , tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an
490 -- associated type these
491 -- include outer binders
492 , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
493 , tcdRhs :: LHsType pass -- ^ RHS of type declaration
494 , tcdFVs :: PostRn pass NameSet }
495
496 | -- | @data@ declaration
497 --
498 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
499 -- 'ApiAnnotation.AnnFamily',
500 -- 'ApiAnnotation.AnnNewType',
501 -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
502 -- 'ApiAnnotation.AnnWhere',
503
504 -- For details on above see note [Api annotations] in ApiAnnotation
505 DataDecl { tcdLName :: Located (IdP pass) -- ^ Type constructor
506 , tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an
507 -- associated type
508 -- these include outer binders
509 -- Eg class T a where
510 -- type F a :: *
511 -- type F a = a -> a
512 -- Here the type decl for 'f'
513 -- includes 'a' in its tcdTyVars
514 , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
515 , tcdDataDefn :: HsDataDefn pass
516 , tcdDataCusk :: PostRn pass Bool -- ^ does this have a CUSK?
517 , tcdFVs :: PostRn pass NameSet }
518
519 | ClassDecl { tcdCtxt :: LHsContext pass, -- ^ Context...
520 tcdLName :: Located (IdP pass), -- ^ Name of the class
521 tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
522 tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration
523 tcdFDs :: [Located (FunDep (Located (IdP pass)))],
524 -- ^ Functional deps
525 tcdSigs :: [LSig pass], -- ^ Methods' signatures
526 tcdMeths :: LHsBinds pass, -- ^ Default methods
527 tcdATs :: [LFamilyDecl pass], -- ^ Associated types;
528 tcdATDefs :: [LTyFamDefltEqn pass],
529 -- ^ Associated type defaults
530 tcdDocs :: [LDocDecl], -- ^ Haddock docs
531 tcdFVs :: PostRn pass NameSet
532 }
533 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
534 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
535 -- 'ApiAnnotation.AnnClose'
536 -- - The tcdFDs will have 'ApiAnnotation.AnnVbar',
537 -- 'ApiAnnotation.AnnComma'
538 -- 'ApiAnnotation.AnnRarrow'
539
540 -- For details on above see note [Api annotations] in ApiAnnotation
541
542 deriving instance (DataIdLR id id) => Data (TyClDecl id)
543
544
545 -- Simple classifiers for TyClDecl
546 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
547
548 -- | @True@ <=> argument is a @data@\/@newtype@
549 -- declaration.
550 isDataDecl :: TyClDecl pass -> Bool
551 isDataDecl (DataDecl {}) = True
552 isDataDecl _other = False
553
554 -- | type or type instance declaration
555 isSynDecl :: TyClDecl pass -> Bool
556 isSynDecl (SynDecl {}) = True
557 isSynDecl _other = False
558
559 -- | type class
560 isClassDecl :: TyClDecl pass -> Bool
561 isClassDecl (ClassDecl {}) = True
562 isClassDecl _ = False
563
564 -- | type/data family declaration
565 isFamilyDecl :: TyClDecl pass -> Bool
566 isFamilyDecl (FamDecl {}) = True
567 isFamilyDecl _other = False
568
569 -- | type family declaration
570 isTypeFamilyDecl :: TyClDecl pass -> Bool
571 isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
572 OpenTypeFamily -> True
573 ClosedTypeFamily {} -> True
574 _ -> False
575 isTypeFamilyDecl _ = False
576
577 -- | open type family info
578 isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
579 isOpenTypeFamilyInfo OpenTypeFamily = True
580 isOpenTypeFamilyInfo _ = False
581
582 -- | closed type family info
583 isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
584 isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
585 isClosedTypeFamilyInfo _ = False
586
587 -- | data family declaration
588 isDataFamilyDecl :: TyClDecl pass -> Bool
589 isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
590 isDataFamilyDecl _other = False
591
592 -- Dealing with names
593
594 tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
595 tyFamInstDeclName = unLoc . tyFamInstDeclLName
596
597 tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
598 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
599 (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
600 = ln
601
602 tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
603 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
604 tyClDeclLName decl = tcdLName decl
605
606 tcdName :: TyClDecl pass -> (IdP pass)
607 tcdName = unLoc . tyClDeclLName
608
609 tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
610 tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
611 tyClDeclTyVars d = tcdTyVars d
612
613 countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
614 -- class, synonym decls, data, newtype, family decls
615 countTyClDecls decls
616 = (count isClassDecl decls,
617 count isSynDecl decls, -- excluding...
618 count isDataTy decls, -- ...family...
619 count isNewTy decls, -- ...instances
620 count isFamilyDecl decls)
621 where
622 isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
623 isDataTy _ = False
624
625 isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
626 isNewTy _ = False
627
628 -- | Does this declaration have a complete, user-supplied kind signature?
629 -- See Note [Complete user-supplied kind signatures]
630 hsDeclHasCusk :: TyClDecl GhcRn -> Bool
631 hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
632 hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
633 -- NB: Keep this synchronized with 'getInitialKind'
634 = hsTvbAllKinded tyvars && rhs_annotated rhs
635 where
636 rhs_annotated (L _ ty) = case ty of
637 HsParTy _ lty -> rhs_annotated lty
638 HsKindSig {} -> True
639 _ -> False
640 hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk
641 hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
642
643 -- Pretty-printing TyClDecl
644 -- ~~~~~~~~~~~~~~~~~~~~~~~~
645
646 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
647 => Outputable (TyClDecl (GhcPass p)) where
648
649 ppr (FamDecl { tcdFam = decl }) = ppr decl
650 ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
651 , tcdRhs = rhs })
652 = hang (text "type" <+>
653 pp_vanilla_decl_head ltycon tyvars fixity [] <+> equals)
654 4 (ppr rhs)
655
656 ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
657 , tcdDataDefn = defn })
658 = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
659
660 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
661 tcdFixity = fixity,
662 tcdFDs = fds,
663 tcdSigs = sigs, tcdMeths = methods,
664 tcdATs = ats, tcdATDefs = at_defs})
665 | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
666 = top_matter
667
668 | otherwise -- Laid out
669 = vcat [ top_matter <+> text "where"
670 , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
671 map ppr_fam_deflt_eqn at_defs ++
672 pprLHsBindsForUser methods sigs) ]
673 where
674 top_matter = text "class"
675 <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
676 <+> pprFundeps (map unLoc fds)
677
678 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
679 => Outputable (TyClGroup (GhcPass p)) where
680 ppr (TyClGroup { group_tyclds = tyclds
681 , group_roles = roles
682 , group_instds = instds
683 }
684 )
685 = ppr tyclds $$
686 ppr roles $$
687 ppr instds
688
689 pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
690 => Located (IdP (GhcPass p))
691 -> LHsQTyVars (GhcPass p)
692 -> LexicalFixity
693 -> HsContext (GhcPass p)
694 -> SDoc
695 pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
696 = hsep [pprHsContext context, pp_tyvars tyvars]
697 where
698 pp_tyvars (varl:varsr)
699 | fixity == Infix && length varsr > 1
700 = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
701 , (ppr.unLoc) (head varsr), char ')'
702 , hsep (map (ppr.unLoc) (tail varsr))]
703 | fixity == Infix
704 = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
705 , hsep (map (ppr.unLoc) varsr)]
706 | otherwise = hsep [ pprPrefixOcc (unLoc thing)
707 , hsep (map (ppr.unLoc) (varl:varsr))]
708 pp_tyvars [] = ppr thing
709
710 pprTyClDeclFlavour :: TyClDecl a -> SDoc
711 pprTyClDeclFlavour (ClassDecl {}) = text "class"
712 pprTyClDeclFlavour (SynDecl {}) = text "type"
713 pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
714 = pprFlavour info <+> text "family"
715 pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
716 = ppr nd
717
718
719 {- Note [Complete user-supplied kind signatures]
720 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
721 We kind-check declarations differently if they have a complete, user-supplied
722 kind signature (CUSK). This is because we can safely generalise a CUSKed
723 declaration before checking all of the others, supporting polymorphic recursion.
724 See ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy
725 and #9200 for lots of discussion of how we got here.
726
727 A declaration has a CUSK if we can know its complete kind without doing any
728 inference, at all. Here are the rules:
729
730 - A class or datatype is said to have a CUSK if and only if all of its type
731 variables are annotated. Its result kind is, by construction, Constraint or *
732 respectively.
733
734 - A type synonym has a CUSK if and only if all of its type variables and its
735 RHS are annotated with kinds.
736
737 - A closed type family is said to have a CUSK if and only if all of its type
738 variables and its return type are annotated.
739
740 - An open type family always has a CUSK -- unannotated type variables (and
741 return type) default to *.
742
743 - Additionally, if -XTypeInType is on, then a data definition with a top-level
744 :: must explicitly bind all kind variables to the right of the ::.
745 See test dependent/should_compile/KindLevels, which requires this case.
746 (Naturally, any kind variable mentioned before the :: should not be bound
747 after it.)
748 -}
749
750
751 {- *********************************************************************
752 * *
753 TyClGroup
754 Strongly connected components of
755 type, class, instance, and role declarations
756 * *
757 ********************************************************************* -}
758
759 {- Note [TyClGroups and dependency analysis]
760 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
761 A TyClGroup represents a strongly connected components of type/class/instance
762 decls, together with the role annotations for the type/class declarations.
763
764 The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order
765 sequence of strongly-connected components.
766
767 Invariants
768 * The type and class declarations, group_tyclds, may depend on each
769 other, or earlier TyClGroups, but not on later ones
770
771 * The role annotations, group_roles, are role-annotations for some or
772 all of the types and classes in group_tyclds (only).
773
774 * The instance declarations, group_instds, may (and usually will)
775 depend on group_tyclds, or on earlier TyClGroups, but not on later
776 ones.
777
778 See Note [Dependency analsis of type, class, and instance decls]
779 in RnSource for more info.
780 -}
781
782 -- | Type or Class Group
783 data TyClGroup pass -- See Note [TyClGroups and dependency analysis]
784 = TyClGroup { group_tyclds :: [LTyClDecl pass]
785 , group_roles :: [LRoleAnnotDecl pass]
786 , group_instds :: [LInstDecl pass] }
787 deriving instance (DataIdLR id id) => Data (TyClGroup id)
788
789 emptyTyClGroup :: TyClGroup pass
790 emptyTyClGroup = TyClGroup [] [] []
791
792 tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
793 tyClGroupTyClDecls = concatMap group_tyclds
794
795 tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
796 tyClGroupInstDecls = concatMap group_instds
797
798 tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
799 tyClGroupRoleDecls = concatMap group_roles
800
801 mkTyClGroup :: [LTyClDecl pass] -> [LInstDecl pass] -> TyClGroup pass
802 mkTyClGroup decls instds = TyClGroup
803 { group_tyclds = decls
804 , group_roles = []
805 , group_instds = instds
806 }
807
808
809
810 {- *********************************************************************
811 * *
812 Data and type family declarations
813 * *
814 ********************************************************************* -}
815
816 {- Note [FamilyResultSig]
817 ~~~~~~~~~~~~~~~~~~~~~~~~~
818
819 This data type represents the return signature of a type family. Possible
820 values are:
821
822 * NoSig - the user supplied no return signature:
823 type family Id a where ...
824
825 * KindSig - the user supplied the return kind:
826 type family Id a :: * where ...
827
828 * TyVarSig - user named the result with a type variable and possibly
829 provided a kind signature for that variable:
830 type family Id a = r where ...
831 type family Id a = (r :: *) where ...
832
833 Naming result of a type family is required if we want to provide
834 injectivity annotation for a type family:
835 type family Id a = r | r -> a where ...
836
837 See also: Note [Injectivity annotation]
838
839 Note [Injectivity annotation]
840 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
841
842 A user can declare a type family to be injective:
843
844 type family Id a = r | r -> a where ...
845
846 * The part after the "|" is called "injectivity annotation".
847 * "r -> a" part is called "injectivity condition"; at the moment terms
848 "injectivity annotation" and "injectivity condition" are synonymous
849 because we only allow a single injectivity condition.
850 * "r" is the "LHS of injectivity condition". LHS can only contain the
851 variable naming the result of a type family.
852
853 * "a" is the "RHS of injectivity condition". RHS contains space-separated
854 type and kind variables representing the arguments of a type
855 family. Variables can be omitted if a type family is not injective in
856 these arguments. Example:
857 type family Foo a b c = d | d -> a c where ...
858
859 Note that:
860 (a) naming of type family result is required to provide injectivity
861 annotation
862 (b) for associated types if the result was named then injectivity annotation
863 is mandatory. Otherwise result type variable is indistinguishable from
864 associated type default.
865
866 It is possible that in the future this syntax will be extended to support
867 more complicated injectivity annotations. For example we could declare that
868 if we know the result of Plus and one of its arguments we can determine the
869 other argument:
870
871 type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...
872
873 Here injectivity annotation would consist of two comma-separated injectivity
874 conditions.
875
876 See also Note [Injective type families] in TyCon
877 -}
878
879 -- | Located type Family Result Signature
880 type LFamilyResultSig pass = Located (FamilyResultSig pass)
881
882 -- | type Family Result Signature
883 data FamilyResultSig pass = -- see Note [FamilyResultSig]
884 NoSig
885 -- ^ - 'ApiAnnotation.AnnKeywordId' :
886
887 -- For details on above see note [Api annotations] in ApiAnnotation
888
889 | KindSig (LHsKind pass)
890 -- ^ - 'ApiAnnotation.AnnKeywordId' :
891 -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
892 -- 'ApiAnnotation.AnnCloseP'
893
894 -- For details on above see note [Api annotations] in ApiAnnotation
895
896 | TyVarSig (LHsTyVarBndr pass)
897 -- ^ - 'ApiAnnotation.AnnKeywordId' :
898 -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
899 -- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
900
901 -- For details on above see note [Api annotations] in ApiAnnotation
902
903 deriving instance (DataIdLR pass pass) => Data (FamilyResultSig pass)
904
905 -- | Located type Family Declaration
906 type LFamilyDecl pass = Located (FamilyDecl pass)
907
908 -- | type Family Declaration
909 data FamilyDecl pass = FamilyDecl
910 { fdInfo :: FamilyInfo pass -- type/data, closed/open
911 , fdLName :: Located (IdP pass) -- type constructor
912 , fdTyVars :: LHsQTyVars pass -- type variables
913 , fdFixity :: LexicalFixity -- Fixity used in the declaration
914 , fdResultSig :: LFamilyResultSig pass -- result signature
915 , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
916 }
917 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
918 -- 'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
919 -- 'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
920 -- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',
921 -- 'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
922 -- 'ApiAnnotation.AnnVbar'
923
924 -- For details on above see note [Api annotations] in ApiAnnotation
925
926 deriving instance (DataIdLR id id) => Data (FamilyDecl id)
927
928 -- | Located Injectivity Annotation
929 type LInjectivityAnn pass = Located (InjectivityAnn pass)
930
931 -- | If the user supplied an injectivity annotation it is represented using
932 -- InjectivityAnn. At the moment this is a single injectivity condition - see
933 -- Note [Injectivity annotation]. `Located name` stores the LHS of injectivity
934 -- condition. `[Located name]` stores the RHS of injectivity condition. Example:
935 --
936 -- type family Foo a b c = r | r -> a c where ...
937 --
938 -- This will be represented as "InjectivityAnn `r` [`a`, `c`]"
939 data InjectivityAnn pass
940 = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]
941 -- ^ - 'ApiAnnotation.AnnKeywordId' :
942 -- 'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
943
944 -- For details on above see note [Api annotations] in ApiAnnotation
945 deriving instance (DataId pass) => Data (InjectivityAnn pass)
946
947 data FamilyInfo pass
948 = DataFamily
949 | OpenTypeFamily
950 -- | 'Nothing' if we're in an hs-boot file and the user
951 -- said "type family Foo x where .."
952 | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
953 deriving instance (DataIdLR pass pass) => Data (FamilyInfo pass)
954
955 -- | Does this family declaration have a complete, user-supplied kind signature?
956 famDeclHasCusk :: Maybe Bool
957 -- ^ if associated, does the enclosing class have a CUSK?
958 -> FamilyDecl pass -> Bool
959 famDeclHasCusk _ (FamilyDecl { fdInfo = ClosedTypeFamily _
960 , fdTyVars = tyvars
961 , fdResultSig = L _ resultSig })
962 = hsTvbAllKinded tyvars && hasReturnKindSignature resultSig
963 famDeclHasCusk mb_class_cusk _ = mb_class_cusk `orElse` True
964 -- all un-associated open families have CUSKs!
965
966 -- | Does this family declaration have user-supplied return kind signature?
967 hasReturnKindSignature :: FamilyResultSig a -> Bool
968 hasReturnKindSignature NoSig = False
969 hasReturnKindSignature (TyVarSig (L _ UserTyVar{})) = False
970 hasReturnKindSignature _ = True
971
972 -- | Maybe return name of the result type variable
973 resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
974 resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig
975 resultVariableName _ = Nothing
976
977 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
978 => Outputable (FamilyDecl (GhcPass p)) where
979 ppr = pprFamilyDecl TopLevel
980
981 pprFamilyDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
982 => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
983 pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
984 , fdTyVars = tyvars
985 , fdFixity = fixity
986 , fdResultSig = L _ result
987 , fdInjectivityAnn = mb_inj })
988 = vcat [ pprFlavour info <+> pp_top_level <+>
989 pp_vanilla_decl_head ltycon tyvars fixity [] <+>
990 pp_kind <+> pp_inj <+> pp_where
991 , nest 2 $ pp_eqns ]
992 where
993 pp_top_level = case top_level of
994 TopLevel -> text "family"
995 NotTopLevel -> empty
996
997 pp_kind = case result of
998 NoSig -> empty
999 KindSig kind -> dcolon <+> ppr kind
1000 TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr
1001 pp_inj = case mb_inj of
1002 Just (L _ (InjectivityAnn lhs rhs)) ->
1003 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
1004 Nothing -> empty
1005 (pp_where, pp_eqns) = case info of
1006 ClosedTypeFamily mb_eqns ->
1007 ( text "where"
1008 , case mb_eqns of
1009 Nothing -> text ".."
1010 Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
1011 _ -> (empty, empty)
1012
1013 pprFlavour :: FamilyInfo pass -> SDoc
1014 pprFlavour DataFamily = text "data"
1015 pprFlavour OpenTypeFamily = text "type"
1016 pprFlavour (ClosedTypeFamily {}) = text "type"
1017
1018 instance Outputable (FamilyInfo pass) where
1019 ppr info = pprFlavour info <+> text "family"
1020
1021
1022
1023 {- *********************************************************************
1024 * *
1025 Data types and data constructors
1026 * *
1027 ********************************************************************* -}
1028
1029 -- | Haskell Data type Definition
1030 data HsDataDefn pass -- The payload of a data type defn
1031 -- Used *both* for vanilla data declarations,
1032 -- *and* for data family instances
1033 = -- | Declares a data type or newtype, giving its constructors
1034 -- @
1035 -- data/newtype T a = <constrs>
1036 -- data/newtype instance T [a] = <constrs>
1037 -- @
1038 HsDataDefn { dd_ND :: NewOrData,
1039 dd_ctxt :: LHsContext pass, -- ^ Context
1040 dd_cType :: Maybe (Located CType),
1041 dd_kindSig:: Maybe (LHsKind pass),
1042 -- ^ Optional kind signature.
1043 --
1044 -- @(Just k)@ for a GADT-style @data@,
1045 -- or @data instance@ decl, with explicit kind sig
1046 --
1047 -- Always @Nothing@ for H98-syntax decls
1048
1049 dd_cons :: [LConDecl pass],
1050 -- ^ Data constructors
1051 --
1052 -- For @data T a = T1 | T2 a@
1053 -- the 'LConDecl's all have 'ConDeclH98'.
1054 -- For @data T a where { T1 :: T a }@
1055 -- the 'LConDecls' all have 'ConDeclGADT'.
1056
1057 dd_derivs :: HsDeriving pass -- ^ Optional 'deriving' claues
1058
1059 -- For details on above see note [Api annotations] in ApiAnnotation
1060 }
1061 deriving instance (DataIdLR id id) => Data (HsDataDefn id)
1062
1063 -- | Haskell Deriving clause
1064 type HsDeriving pass = Located [LHsDerivingClause pass]
1065 -- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is
1066 -- plural because one can specify multiple deriving clauses using the
1067 -- @-XDerivingStrategies@ language extension.
1068 --
1069 -- The list of 'LHsDerivingClause's corresponds to exactly what the user
1070 -- requested to derive, in order. If no deriving clauses were specified,
1071 -- the list is empty.
1072
1073 type LHsDerivingClause pass = Located (HsDerivingClause pass)
1074
1075 -- | A single @deriving@ clause of a data declaration.
1076 --
1077 -- - 'ApiAnnotation.AnnKeywordId' :
1078 -- 'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
1079 -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
1080 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1081 data HsDerivingClause pass
1082 -- See Note [Deriving strategies] in TcDeriv
1083 = HsDerivingClause
1084 { deriv_clause_strategy :: Maybe (Located DerivStrategy)
1085 -- ^ The user-specified strategy (if any) to use when deriving
1086 -- 'deriv_clause_tys'.
1087 , deriv_clause_tys :: Located [LHsSigType pass]
1088 -- ^ The types to derive.
1089 --
1090 -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
1091 -- we can mention type variables that aren't bound by the datatype, e.g.
1092 --
1093 -- > data T b = ... deriving (C [a])
1094 --
1095 -- should produce a derived instance for @C [a] (T b)@.
1096 }
1097 deriving instance (DataIdLR id id) => Data (HsDerivingClause id)
1098
1099 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1100 => Outputable (HsDerivingClause (GhcPass p)) where
1101 ppr (HsDerivingClause { deriv_clause_strategy = dcs
1102 , deriv_clause_tys = L _ dct })
1103 = hsep [ text "deriving"
1104 , ppDerivStrategy dcs
1105 , pp_dct dct ]
1106 where
1107 -- This complexity is to distinguish between
1108 -- deriving Show
1109 -- deriving (Show)
1110 pp_dct [a@(HsIB { hsib_body = ty })]
1111 | isCompoundHsType ty = parens (ppr a)
1112 | otherwise = ppr a
1113 pp_dct _ = parens (interpp'SP dct)
1114
1115 data NewOrData
1116 = NewType -- ^ @newtype Blah ...@
1117 | DataType -- ^ @data Blah ...@
1118 deriving( Eq, Data ) -- Needed because Demand derives Eq
1119
1120 -- | Located data Constructor Declaration
1121 type LConDecl pass = Located (ConDecl pass)
1122 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
1123 -- in a GADT constructor list
1124
1125 -- For details on above see note [Api annotations] in ApiAnnotation
1126
1127 -- |
1128 --
1129 -- @
1130 -- data T b = forall a. Eq a => MkT a b
1131 -- MkT :: forall b a. Eq a => MkT a b
1132 --
1133 -- data T b where
1134 -- MkT1 :: Int -> T Int
1135 --
1136 -- data T = Int `MkT` Int
1137 -- | MkT2
1138 --
1139 -- data T a where
1140 -- Int `MkT` Int :: T Int
1141 -- @
1142 --
1143 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
1144 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',
1145 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',
1146 -- 'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',
1147 -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'
1148
1149 -- For details on above see note [Api annotations] in ApiAnnotation
1150
1151 -- | data Constructor Declaration
1152 data ConDecl pass
1153 = ConDeclGADT
1154 { con_names :: [Located (IdP pass)]
1155 , con_type :: LHsSigType pass
1156 -- ^ The type after the ‘::’
1157 , con_doc :: Maybe LHsDocString
1158 -- ^ A possible Haddock comment.
1159 }
1160
1161 | ConDeclH98
1162 { con_name :: Located (IdP pass)
1163
1164 , con_qvars :: Maybe (LHsQTyVars pass)
1165 -- User-written forall (if any), and its implicit
1166 -- kind variables
1167 -- Non-Nothing means an explicit user-written forall
1168 -- e.g. data T a = forall b. MkT b (b->a)
1169 -- con_qvars = {b}
1170
1171 , con_cxt :: Maybe (LHsContext pass)
1172 -- ^ User-written context (if any)
1173
1174 , con_details :: HsConDeclDetails pass
1175 -- ^ Arguments
1176
1177 , con_doc :: Maybe LHsDocString
1178 -- ^ A possible Haddock comment.
1179 }
1180 deriving instance (DataIdLR pass pass) => Data (ConDecl pass)
1181
1182 -- | Haskell data Constructor Declaration Details
1183 type HsConDeclDetails pass
1184 = HsConDetails (LBangType pass) (Located [LConDeclField pass])
1185
1186 getConNames :: ConDecl pass -> [Located (IdP pass)]
1187 getConNames ConDeclH98 {con_name = name} = [name]
1188 getConNames ConDeclGADT {con_names = names} = names
1189
1190 -- don't call with RdrNames, because it can't deal with HsAppsTy
1191 getConDetails :: ConDecl pass -> HsConDeclDetails pass
1192 getConDetails ConDeclH98 {con_details = details} = details
1193 getConDetails ConDeclGADT {con_type = ty } = details
1194 where
1195 (details,_,_,_) = gadtDeclDetails ty
1196
1197 -- don't call with RdrNames, because it can't deal with HsAppsTy
1198 gadtDeclDetails :: LHsSigType pass
1199 -> ( HsConDeclDetails pass
1200 , LHsType pass
1201 , LHsContext pass
1202 , [LHsTyVarBndr pass] )
1203 gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs)
1204 where
1205 (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
1206 (details, res_ty) -- See Note [Sorting out the result type]
1207 = case tau of
1208 L _ (HsFunTy _ (L l (HsRecTy _ flds)) res_ty')
1209 -> (RecCon (L l flds), res_ty')
1210 _other -> (PrefixCon [], tau)
1211
1212 hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]
1213 hsConDeclArgTys (PrefixCon tys) = tys
1214 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
1215 hsConDeclArgTys (RecCon flds) = map (cd_fld_type . unLoc) (unLoc flds)
1216
1217 pp_data_defn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1218 => (HsContext (GhcPass p) -> SDoc) -- Printing the header
1219 -> HsDataDefn (GhcPass p)
1220 -> SDoc
1221 pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
1222 , dd_cType = mb_ct
1223 , dd_kindSig = mb_sig
1224 , dd_cons = condecls, dd_derivs = derivings })
1225 | null condecls
1226 = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig
1227 <+> pp_derivings derivings
1228
1229 | otherwise
1230 = hang (ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig)
1231 2 (pp_condecls condecls $$ pp_derivings derivings)
1232 where
1233 pp_ct = case mb_ct of
1234 Nothing -> empty
1235 Just ct -> ppr ct
1236 pp_sig = case mb_sig of
1237 Nothing -> empty
1238 Just kind -> dcolon <+> ppr kind
1239 pp_derivings (L _ ds) = vcat (map ppr ds)
1240
1241 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1242 => Outputable (HsDataDefn (GhcPass p)) where
1243 ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
1244
1245 instance Outputable NewOrData where
1246 ppr NewType = text "newtype"
1247 ppr DataType = text "data"
1248
1249 pp_condecls :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1250 => [LConDecl (GhcPass p)] -> SDoc
1251 pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
1252 = hang (text "where") 2 (vcat (map ppr cs))
1253 pp_condecls cs -- In H98 syntax
1254 = equals <+> sep (punctuate (text " |") (map ppr cs))
1255
1256 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1257 => Outputable (ConDecl (GhcPass p)) where
1258 ppr = pprConDecl
1259
1260 pprConDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1261 => ConDecl (GhcPass p) -> SDoc
1262 pprConDecl (ConDeclH98 { con_name = L _ con
1263 , con_qvars = mtvs
1264 , con_cxt = mcxt
1265 , con_details = details
1266 , con_doc = doc })
1267 = sep [ppr_mbDoc doc, pprHsForAll tvs cxt, ppr_details details]
1268 where
1269 ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2]
1270 ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con
1271 : map (pprHsType . unLoc) tys)
1272 ppr_details (RecCon fields) = pprPrefixOcc con
1273 <+> pprConDeclFields (unLoc fields)
1274 tvs = case mtvs of
1275 Nothing -> []
1276 Just (HsQTvs { hsq_explicit = tvs }) -> tvs
1277
1278 cxt = fromMaybe (noLoc []) mcxt
1279
1280 pprConDecl (ConDeclGADT { con_names = cons, con_type = res_ty, con_doc = doc })
1281 = sep [ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
1282 <+> ppr res_ty]
1283
1284 ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
1285 ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
1286
1287 {-
1288 ************************************************************************
1289 * *
1290 Instance declarations
1291 * *
1292 ************************************************************************
1293
1294 Note [Type family instance declarations in HsSyn]
1295 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1296 The data type FamEqn represents one equation of a type family instance.
1297 Aside from the pass, it is also parameterised over two fields:
1298 feqn_pats and feqn_rhs.
1299
1300 feqn_pats is either LHsTypes (for ordinary data/type family instances) or
1301 LHsQTyVars (for associated type family default instances). In particular:
1302
1303 * An ordinary type family instance declaration looks like this in source Haskell
1304 type instance T [a] Int = a -> a
1305 (or something similar for a closed family)
1306 It is represented by a FamInstEqn, with a *type* (LHsType) in the feqn_pats
1307 field.
1308
1309 * On the other hand, the *default instance* of an associated type looks like
1310 this in source Haskell
1311 class C a where
1312 type T a b
1313 type T a b = a -> b -- The default instance
1314 It is represented by a TyFamDefltEqn, with *type variables* (LHsQTyVars) in
1315 the feqn_pats field.
1316
1317 feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType
1318 (for type family instances).
1319 -}
1320
1321 ----------------- Type synonym family instances -------------
1322
1323 -- | Located Type Family Instance Equation
1324 type LTyFamInstEqn pass = Located (TyFamInstEqn pass)
1325 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
1326 -- when in a list
1327
1328 -- For details on above see note [Api annotations] in ApiAnnotation
1329
1330 -- | Located Type Family Default Equation
1331 type LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)
1332
1333 -- | Haskell Type Patterns
1334 type HsTyPats pass = [LHsType pass]
1335
1336 {- Note [Family instance declaration binders]
1337 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1338 For ordinary data/type family instances, the feqn_pats field of FamEqn stores
1339 the LHS type (and kind) patterns. These type patterns can of course contain
1340 type (and kind) variables, which are bound in the hsib_vars field of the
1341 HsImplicitBndrs in FamInstEqn. Note in particular
1342
1343 * The hsib_vars *includes* any anonymous wildcards. For example
1344 type instance F a _ = a
1345 The hsib_vars will be {a, _}. Remember that each separate wildcard
1346 '_' gets its own unique. In this context wildcards behave just like
1347 an ordinary type variable, only anonymous.
1348
1349 * The hsib_vars *includes* type variables that are already in scope
1350
1351 Eg class C s t where
1352 type F t p :: *
1353 instance C w (a,b) where
1354 type F (a,b) x = x->a
1355 The hsib_vars of the F decl are {a,b,x}, even though the F decl
1356 is nested inside the 'instance' decl.
1357
1358 However after the renamer, the uniques will match up:
1359 instance C w7 (a8,b9) where
1360 type F (a8,b9) x10 = x10->a8
1361 so that we can compare the type pattern in the 'instance' decl and
1362 in the associated 'type' decl
1363
1364 For associated type family default instances (TyFamDefltEqn), instead of using
1365 type patterns with binders in a surrounding HsImplicitBndrs, we use raw type
1366 variables (LHsQTyVars) in the feqn_pats field of FamEqn.
1367 -}
1368
1369 -- | Type Family Instance Equation
1370 type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)
1371
1372 -- | Type Family Default Equation
1373 type TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)
1374 -- See Note [Type family instance declarations in HsSyn]
1375
1376 -- | Located Type Family Instance Declaration
1377 type LTyFamInstDecl pass = Located (TyFamInstDecl pass)
1378
1379 -- | Type Family Instance Declaration
1380 newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
1381 -- ^
1382 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
1383 -- 'ApiAnnotation.AnnInstance',
1384
1385 -- For details on above see note [Api annotations] in ApiAnnotation
1386 deriving instance DataIdLR pass pass => Data (TyFamInstDecl pass)
1387
1388 ----------------- Data family instances -------------
1389
1390 -- | Located Data Family Instance Declaration
1391 type LDataFamInstDecl pass = Located (DataFamInstDecl pass)
1392
1393 -- | Data Family Instance Declaration
1394 newtype DataFamInstDecl pass
1395 = DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }
1396 -- ^
1397 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
1398 -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
1399 -- 'ApiAnnotation.AnnDcolon'
1400 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
1401 -- 'ApiAnnotation.AnnClose'
1402
1403 -- For details on above see note [Api annotations] in ApiAnnotation
1404 deriving instance DataIdLR pass pass => Data (DataFamInstDecl pass)
1405
1406 ----------------- Family instances (common types) -------------
1407
1408 -- | Located Family Instance Equation
1409 type LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)
1410
1411 -- | Family Instance Equation
1412 type FamInstEqn pass rhs
1413 = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)
1414 -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).
1415 -- See Note [Family instance declaration binders]
1416
1417 -- | Family Equation
1418 --
1419 -- One equation in a type family instance declaration, data family instance
1420 -- declaration, or type family default.
1421 -- See Note [Type family instance declarations in HsSyn]
1422 -- See Note [Family instance declaration binders]
1423 data FamEqn pass pats rhs
1424 = FamEqn
1425 { feqn_tycon :: Located (IdP pass)
1426 , feqn_pats :: pats
1427 , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
1428 , feqn_rhs :: rhs
1429 }
1430 -- ^
1431 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
1432
1433 -- For details on above see note [Api annotations] in ApiAnnotation
1434 deriving instance (DataId pass, Data pats, Data rhs)
1435 => Data (FamEqn pass pats rhs)
1436
1437 ----------------- Class instances -------------
1438
1439 -- | Located Class Instance Declaration
1440 type LClsInstDecl pass = Located (ClsInstDecl pass)
1441
1442 -- | Class Instance Declaration
1443 data ClsInstDecl pass
1444 = ClsInstDecl
1445 { cid_poly_ty :: LHsSigType pass -- Context => Class Instance-type
1446 -- Using a polytype means that the renamer conveniently
1447 -- figures out the quantified type variables for us.
1448 , cid_binds :: LHsBinds pass -- Class methods
1449 , cid_sigs :: [LSig pass] -- User-supplied pragmatic info
1450 , cid_tyfam_insts :: [LTyFamInstDecl pass] -- Type family instances
1451 , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
1452 , cid_overlap_mode :: Maybe (Located OverlapMode)
1453 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1454 -- 'ApiAnnotation.AnnClose',
1455
1456 -- For details on above see note [Api annotations] in ApiAnnotation
1457 }
1458 -- ^
1459 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',
1460 -- 'ApiAnnotation.AnnWhere',
1461 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
1462
1463 -- For details on above see note [Api annotations] in ApiAnnotation
1464 deriving instance (DataIdLR id id) => Data (ClsInstDecl id)
1465
1466
1467 ----------------- Instances of all kinds -------------
1468
1469 -- | Located Instance Declaration
1470 type LInstDecl pass = Located (InstDecl pass)
1471
1472 -- | Instance Declaration
1473 data InstDecl pass -- Both class and family instances
1474 = ClsInstD
1475 { cid_inst :: ClsInstDecl pass }
1476 | DataFamInstD -- data family instance
1477 { dfid_inst :: DataFamInstDecl pass }
1478 | TyFamInstD -- type family instance
1479 { tfid_inst :: TyFamInstDecl pass }
1480 deriving instance (DataIdLR id id) => Data (InstDecl id)
1481
1482 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1483 => Outputable (TyFamInstDecl (GhcPass p)) where
1484 ppr = pprTyFamInstDecl TopLevel
1485
1486 pprTyFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1487 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
1488 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
1489 = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
1490
1491 ppr_instance_keyword :: TopLevelFlag -> SDoc
1492 ppr_instance_keyword TopLevel = text "instance"
1493 ppr_instance_keyword NotTopLevel = empty
1494
1495 ppr_fam_inst_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1496 => TyFamInstEqn (GhcPass p) -> SDoc
1497 ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon
1498 , feqn_pats = pats
1499 , feqn_fixity = fixity
1500 , feqn_rhs = rhs }})
1501 = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
1502
1503 ppr_fam_deflt_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1504 => LTyFamDefltEqn (GhcPass p) -> SDoc
1505 ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon
1506 , feqn_pats = tvs
1507 , feqn_fixity = fixity
1508 , feqn_rhs = rhs }))
1509 = text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
1510 <+> equals <+> ppr rhs
1511
1512 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1513 => Outputable (DataFamInstDecl (GhcPass p)) where
1514 ppr = pprDataFamInstDecl TopLevel
1515
1516 pprDataFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1517 => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
1518 pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
1519 FamEqn { feqn_tycon = tycon
1520 , feqn_pats = pats
1521 , feqn_fixity = fixity
1522 , feqn_rhs = defn }}})
1523 = pp_data_defn pp_hdr defn
1524 where
1525 pp_hdr ctxt = ppr_instance_keyword top_lvl
1526 <+> pprFamInstLHS tycon pats fixity ctxt (dd_kindSig defn)
1527
1528 pprDataFamInstFlavour :: DataFamInstDecl pass -> SDoc
1529 pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
1530 FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
1531 = ppr nd
1532
1533 pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1534 => Located (IdP (GhcPass p))
1535 -> HsTyPats (GhcPass p)
1536 -> LexicalFixity
1537 -> HsContext (GhcPass p)
1538 -> Maybe (LHsKind (GhcPass p))
1539 -> SDoc
1540 pprFamInstLHS thing typats fixity context mb_kind_sig
1541 -- explicit type patterns
1542 = hsep [ pprHsContext context, pp_pats typats, pp_kind_sig ]
1543 where
1544 pp_pats (patl:patsr)
1545 | fixity == Infix
1546 = hsep [pprHsType (unLoc patl), pprInfixOcc (unLoc thing)
1547 , hsep (map (pprHsType.unLoc) patsr)]
1548 | otherwise = hsep [ pprPrefixOcc (unLoc thing)
1549 , hsep (map (pprHsType.unLoc) (patl:patsr))]
1550 pp_pats [] = pprPrefixOcc (unLoc thing)
1551
1552 pp_kind_sig
1553 | Just k <- mb_kind_sig
1554 = dcolon <+> ppr k
1555 | otherwise
1556 = empty
1557
1558 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1559 => Outputable (ClsInstDecl (GhcPass p)) where
1560 ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
1561 , cid_sigs = sigs, cid_tyfam_insts = ats
1562 , cid_overlap_mode = mbOverlap
1563 , cid_datafam_insts = adts })
1564 | null sigs, null ats, null adts, isEmptyBag binds -- No "where" part
1565 = top_matter
1566
1567 | otherwise -- Laid out
1568 = vcat [ top_matter <+> text "where"
1569 , nest 2 $ pprDeclList $
1570 map (pprTyFamInstDecl NotTopLevel . unLoc) ats ++
1571 map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
1572 pprLHsBindsForUser binds sigs ]
1573 where
1574 top_matter = text "instance" <+> ppOverlapPragma mbOverlap
1575 <+> ppr inst_ty
1576
1577 ppDerivStrategy :: Maybe (Located DerivStrategy) -> SDoc
1578 ppDerivStrategy mb =
1579 case mb of
1580 Nothing -> empty
1581 Just (L _ ds) -> ppr ds
1582
1583 ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
1584 ppOverlapPragma mb =
1585 case mb of
1586 Nothing -> empty
1587 Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}"
1588 Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
1589 Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}"
1590 Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}"
1591 Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}"
1592 where
1593 maybe_stext NoSourceText alt = text alt
1594 maybe_stext (SourceText src) _ = text src <+> text "#-}"
1595
1596
1597 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1598 => Outputable (InstDecl (GhcPass p)) where
1599 ppr (ClsInstD { cid_inst = decl }) = ppr decl
1600 ppr (TyFamInstD { tfid_inst = decl }) = ppr decl
1601 ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
1602
1603 -- Extract the declarations of associated data types from an instance
1604
1605 instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]
1606 instDeclDataFamInsts inst_decls
1607 = concatMap do_one inst_decls
1608 where
1609 do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))
1610 = map unLoc fam_insts
1611 do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst]
1612 do_one (L _ (TyFamInstD {})) = []
1613
1614 {-
1615 ************************************************************************
1616 * *
1617 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
1618 * *
1619 ************************************************************************
1620 -}
1621
1622 -- | Located Deriving Declaration
1623 type LDerivDecl pass = Located (DerivDecl pass)
1624
1625 -- | Deriving Declaration
1626 data DerivDecl pass = DerivDecl
1627 { deriv_type :: LHsSigType pass
1628 , deriv_strategy :: Maybe (Located DerivStrategy)
1629 , deriv_overlap_mode :: Maybe (Located OverlapMode)
1630 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
1631 -- 'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',
1632 -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
1633 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1634
1635 -- For details on above see note [Api annotations] in ApiAnnotation
1636 }
1637 deriving instance (DataIdLR pass pass) => Data (DerivDecl pass)
1638
1639 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1640 => Outputable (DerivDecl (GhcPass p)) where
1641 ppr (DerivDecl { deriv_type = ty
1642 , deriv_strategy = ds
1643 , deriv_overlap_mode = o })
1644 = hsep [ text "deriving"
1645 , ppDerivStrategy ds
1646 , text "instance"
1647 , ppOverlapPragma o
1648 , ppr ty ]
1649
1650 {-
1651 ************************************************************************
1652 * *
1653 \subsection[DefaultDecl]{A @default@ declaration}
1654 * *
1655 ************************************************************************
1656
1657 There can only be one default declaration per module, but it is hard
1658 for the parser to check that; we pass them all through in the abstract
1659 syntax, and that restriction must be checked in the front end.
1660 -}
1661
1662 -- | Located Default Declaration
1663 type LDefaultDecl pass = Located (DefaultDecl pass)
1664
1665 -- | Default Declaration
1666 data DefaultDecl pass
1667 = DefaultDecl [LHsType pass]
1668 -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
1669 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1670
1671 -- For details on above see note [Api annotations] in ApiAnnotation
1672 deriving instance (DataIdLR pass pass) => Data (DefaultDecl pass)
1673
1674 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1675 => Outputable (DefaultDecl (GhcPass p)) where
1676
1677 ppr (DefaultDecl tys)
1678 = text "default" <+> parens (interpp'SP tys)
1679
1680 {-
1681 ************************************************************************
1682 * *
1683 \subsection{Foreign function interface declaration}
1684 * *
1685 ************************************************************************
1686 -}
1687
1688 -- foreign declarations are distinguished as to whether they define or use a
1689 -- Haskell name
1690 --
1691 -- * the Boolean value indicates whether the pre-standard deprecated syntax
1692 -- has been used
1693
1694 -- | Located Foreign Declaration
1695 type LForeignDecl pass = Located (ForeignDecl pass)
1696
1697 -- | Foreign Declaration
1698 data ForeignDecl pass
1699 = ForeignImport
1700 { fd_name :: Located (IdP pass) -- defines this name
1701 , fd_sig_ty :: LHsSigType pass -- sig_ty
1702 , fd_co :: PostTc pass Coercion -- rep_ty ~ sig_ty
1703 , fd_fi :: ForeignImport }
1704
1705 | ForeignExport
1706 { fd_name :: Located (IdP pass) -- uses this name
1707 , fd_sig_ty :: LHsSigType pass -- sig_ty
1708 , fd_co :: PostTc pass Coercion -- rep_ty ~ sig_ty
1709 , fd_fe :: ForeignExport }
1710 -- ^
1711 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
1712 -- 'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',
1713 -- 'ApiAnnotation.AnnDcolon'
1714
1715 -- For details on above see note [Api annotations] in ApiAnnotation
1716
1717 deriving instance (DataIdLR pass pass) => Data (ForeignDecl pass)
1718 {-
1719 In both ForeignImport and ForeignExport:
1720 sig_ty is the type given in the Haskell code
1721 rep_ty is the representation for this type, i.e. with newtypes
1722 coerced away and type functions evaluated.
1723 Thus if the declaration is valid, then rep_ty will only use types
1724 such as Int and IO that we know how to make foreign calls with.
1725 -}
1726
1727 noForeignImportCoercionYet :: PlaceHolder
1728 noForeignImportCoercionYet = placeHolder
1729
1730 noForeignExportCoercionYet :: PlaceHolder
1731 noForeignExportCoercionYet = placeHolder
1732
1733 -- Specification Of an imported external entity in dependence on the calling
1734 -- convention
1735 --
1736 data ForeignImport = -- import of a C entity
1737 --
1738 -- * the two strings specifying a header file or library
1739 -- may be empty, which indicates the absence of a
1740 -- header or object specification (both are not used
1741 -- in the case of `CWrapper' and when `CFunction'
1742 -- has a dynamic target)
1743 --
1744 -- * the calling convention is irrelevant for code
1745 -- generation in the case of `CLabel', but is needed
1746 -- for pretty printing
1747 --
1748 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
1749 --
1750 CImport (Located CCallConv) -- ccall or stdcall
1751 (Located Safety) -- interruptible, safe or unsafe
1752 (Maybe Header) -- name of C header
1753 CImportSpec -- details of the C entity
1754 (Located SourceText) -- original source text for
1755 -- the C entity
1756 deriving Data
1757
1758 -- details of an external C entity
1759 --
1760 data CImportSpec = CLabel CLabelString -- import address of a C label
1761 | CFunction CCallTarget -- static or dynamic function
1762 | CWrapper -- wrapper to expose closures
1763 -- (former f.e.d.)
1764 deriving Data
1765
1766 -- specification of an externally exported entity in dependence on the calling
1767 -- convention
1768 --
1769 data ForeignExport = CExport (Located CExportSpec) -- contains the calling
1770 -- convention
1771 (Located SourceText) -- original source text for
1772 -- the C entity
1773 deriving Data
1774
1775 -- pretty printing of foreign declarations
1776 --
1777
1778 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1779 => Outputable (ForeignDecl (GhcPass p)) where
1780 ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
1781 = hang (text "foreign import" <+> ppr fimport <+> ppr n)
1782 2 (dcolon <+> ppr ty)
1783 ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
1784 hang (text "foreign export" <+> ppr fexport <+> ppr n)
1785 2 (dcolon <+> ppr ty)
1786
1787 instance Outputable ForeignImport where
1788 ppr (CImport cconv safety mHeader spec (L _ srcText)) =
1789 ppr cconv <+> ppr safety
1790 <+> pprWithSourceText srcText (pprCEntity spec "")
1791 where
1792 pp_hdr = case mHeader of
1793 Nothing -> empty
1794 Just (Header _ header) -> ftext header
1795
1796 pprCEntity (CLabel lbl) _ =
1797 doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl
1798 pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =
1799 if dqNeeded then doubleQuotes ce else empty
1800 where
1801 dqNeeded = (take 6 src == "static")
1802 || isJust mHeader
1803 || not isFun
1804 || st /= NoSourceText
1805 ce =
1806 -- We may need to drop leading spaces first
1807 (if take 6 src == "static" then text "static" else empty)
1808 <+> pp_hdr
1809 <+> (if isFun then empty else text "value")
1810 <+> (pprWithSourceText st empty)
1811 pprCEntity (CFunction DynamicTarget) _ =
1812 doubleQuotes $ text "dynamic"
1813 pprCEntity CWrapper _ = doubleQuotes $ text "wrapper"
1814
1815 instance Outputable ForeignExport where
1816 ppr (CExport (L _ (CExportStatic _ lbl cconv)) _) =
1817 ppr cconv <+> char '"' <> ppr lbl <> char '"'
1818
1819 {-
1820 ************************************************************************
1821 * *
1822 \subsection{Transformation rules}
1823 * *
1824 ************************************************************************
1825 -}
1826
1827 -- | Located Rule Declarations
1828 type LRuleDecls pass = Located (RuleDecls pass)
1829
1830 -- Note [Pragma source text] in BasicTypes
1831 -- | Rule Declarations
1832 data RuleDecls pass = HsRules { rds_src :: SourceText
1833 , rds_rules :: [LRuleDecl pass] }
1834 deriving instance (DataIdLR pass pass) => Data (RuleDecls pass)
1835
1836 -- | Located Rule Declaration
1837 type LRuleDecl pass = Located (RuleDecl pass)
1838
1839 -- | Rule Declaration
1840 data RuleDecl pass
1841 = HsRule -- Source rule
1842 (Located (SourceText,RuleName)) -- Rule name
1843 -- Note [Pragma source text] in BasicTypes
1844 Activation
1845 [LRuleBndr pass] -- Forall'd vars; after typechecking this
1846 -- includes tyvars
1847 (Located (HsExpr pass)) -- LHS
1848 (PostRn pass NameSet) -- Free-vars from the LHS
1849 (Located (HsExpr pass)) -- RHS
1850 (PostRn pass NameSet) -- Free-vars from the RHS
1851 -- ^
1852 -- - 'ApiAnnotation.AnnKeywordId' :
1853 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
1854 -- 'ApiAnnotation.AnnVal',
1855 -- 'ApiAnnotation.AnnClose',
1856 -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
1857 -- 'ApiAnnotation.AnnEqual',
1858
1859 -- For details on above see note [Api annotations] in ApiAnnotation
1860 deriving instance (DataIdLR pass pass) => Data (RuleDecl pass)
1861
1862 flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
1863 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
1864
1865 -- | Located Rule Binder
1866 type LRuleBndr pass = Located (RuleBndr pass)
1867
1868 -- | Rule Binder
1869 data RuleBndr pass
1870 = RuleBndr (Located (IdP pass))
1871 | RuleBndrSig (Located (IdP pass)) (LHsSigWcType pass)
1872 -- ^
1873 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1874 -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
1875
1876 -- For details on above see note [Api annotations] in ApiAnnotation
1877 deriving instance (DataIdLR pass pass) => Data (RuleBndr pass)
1878
1879 collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
1880 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1881
1882 pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
1883 pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
1884
1885 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1886 => Outputable (RuleDecls (GhcPass p)) where
1887 ppr (HsRules st rules)
1888 = pprWithSourceText st (text "{-# RULES")
1889 <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
1890
1891 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1892 => Outputable (RuleDecl (GhcPass p)) where
1893 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1894 = sep [pprFullRuleName name <+> ppr act,
1895 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
1896 nest 6 (equals <+> pprExpr (unLoc rhs)) ]
1897 where
1898 pp_forall | null ns = empty
1899 | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
1900
1901 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1902 => Outputable (RuleBndr (GhcPass p)) where
1903 ppr (RuleBndr name) = ppr name
1904 ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty)
1905
1906 {-
1907 ************************************************************************
1908 * *
1909 \subsection{Vectorisation declarations}
1910 * *
1911 ************************************************************************
1912
1913 A vectorisation pragma, one of
1914
1915 {-# VECTORISE f = closure1 g (scalar_map g) #-}
1916 {-# VECTORISE SCALAR f #-}
1917 {-# NOVECTORISE f #-}
1918
1919 {-# VECTORISE type T = ty #-}
1920 {-# VECTORISE SCALAR type T #-}
1921 -}
1922
1923 -- | Located Vectorise Declaration
1924 type LVectDecl pass = Located (VectDecl pass)
1925
1926 -- | Vectorise Declaration
1927 data VectDecl pass
1928 = HsVect
1929 SourceText -- Note [Pragma source text] in BasicTypes
1930 (Located (IdP pass))
1931 (LHsExpr pass)
1932 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1933 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnClose'
1934
1935 -- For details on above see note [Api annotations] in ApiAnnotation
1936 | HsNoVect
1937 SourceText -- Note [Pragma source text] in BasicTypes
1938 (Located (IdP pass))
1939 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1940 -- 'ApiAnnotation.AnnClose'
1941
1942 -- For details on above see note [Api annotations] in ApiAnnotation
1943 | HsVectTypeIn -- pre type-checking
1944 SourceText -- Note [Pragma source text] in BasicTypes
1945 Bool -- 'TRUE' => SCALAR declaration
1946 (Located (IdP pass))
1947 (Maybe (Located (IdP pass))) -- 'Nothing' => no right-hand side
1948 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1949 -- 'ApiAnnotation.AnnType','ApiAnnotation.AnnClose',
1950 -- 'ApiAnnotation.AnnEqual'
1951
1952 -- For details on above see note [Api annotations] in ApiAnnotation
1953 | HsVectTypeOut -- post type-checking
1954 Bool -- 'TRUE' => SCALAR declaration
1955 TyCon
1956 (Maybe TyCon) -- 'Nothing' => no right-hand side
1957 | HsVectClassIn -- pre type-checking
1958 SourceText -- Note [Pragma source text] in BasicTypes
1959 (Located (IdP pass))
1960 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1961 -- 'ApiAnnotation.AnnClass','ApiAnnotation.AnnClose',
1962
1963 -- For details on above see note [Api annotations] in ApiAnnotation
1964 | HsVectClassOut -- post type-checking
1965 Class
1966 | HsVectInstIn -- pre type-checking (always SCALAR) !!!FIXME: should be superfluous now
1967 (LHsSigType pass)
1968 | HsVectInstOut -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
1969 ClsInst
1970 deriving instance (DataIdLR pass pass) => Data (VectDecl pass)
1971
1972 lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name
1973 lvectDeclName (L _ (HsVect _ (L _ name) _)) = getName name
1974 lvectDeclName (L _ (HsNoVect _ (L _ name))) = getName name
1975 lvectDeclName (L _ (HsVectTypeIn _ _ (L _ name) _)) = getName name
1976 lvectDeclName (L _ (HsVectTypeOut _ tycon _)) = getName tycon
1977 lvectDeclName (L _ (HsVectClassIn _ (L _ name))) = getName name
1978 lvectDeclName (L _ (HsVectClassOut cls)) = getName cls
1979 lvectDeclName (L _ (HsVectInstIn _))
1980 = panic "HsDecls.lvectDeclName: HsVectInstIn"
1981 lvectDeclName (L _ (HsVectInstOut _))
1982 = panic "HsDecls.lvectDeclName: HsVectInstOut"
1983
1984 lvectInstDecl :: LVectDecl pass -> Bool
1985 lvectInstDecl (L _ (HsVectInstIn _)) = True
1986 lvectInstDecl (L _ (HsVectInstOut _)) = True
1987 lvectInstDecl _ = False
1988
1989 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
1990 => Outputable (VectDecl (GhcPass p)) where
1991 ppr (HsVect _ v rhs)
1992 = sep [text "{-# VECTORISE" <+> ppr v,
1993 nest 4 $
1994 pprExpr (unLoc rhs) <+> text "#-}" ]
1995 ppr (HsNoVect _ v)
1996 = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1997 ppr (HsVectTypeIn _ False t Nothing)
1998 = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
1999 ppr (HsVectTypeIn _ False t (Just t'))
2000 = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
2001 ppr (HsVectTypeIn _ True t Nothing)
2002 = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
2003 ppr (HsVectTypeIn _ True t (Just t'))
2004 = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
2005 ppr (HsVectTypeOut False t Nothing)
2006 = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
2007 ppr (HsVectTypeOut False t (Just t'))
2008 = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
2009 ppr (HsVectTypeOut True t Nothing)
2010 = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
2011 ppr (HsVectTypeOut True t (Just t'))
2012 = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
2013 ppr (HsVectClassIn _ c)
2014 = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
2015 ppr (HsVectClassOut c)
2016 = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
2017 ppr (HsVectInstIn ty)
2018 = sep [text "{-# VECTORISE SCALAR instance" <+> ppr ty <+> text "#-}" ]
2019 ppr (HsVectInstOut i)
2020 = sep [text "{-# VECTORISE SCALAR instance" <+> ppr i <+> text "#-}" ]
2021
2022 {-
2023 ************************************************************************
2024 * *
2025 \subsection[DocDecl]{Document comments}
2026 * *
2027 ************************************************************************
2028 -}
2029
2030 -- | Located Documentation comment Declaration
2031 type LDocDecl = Located (DocDecl)
2032
2033 -- | Documentation comment Declaration
2034 data DocDecl
2035 = DocCommentNext HsDocString
2036 | DocCommentPrev HsDocString
2037 | DocCommentNamed String HsDocString
2038 | DocGroup Int HsDocString
2039 deriving Data
2040
2041 -- Okay, I need to reconstruct the document comments, but for now:
2042 instance Outputable DocDecl where
2043 ppr _ = text "<document comment>"
2044
2045 docDeclDoc :: DocDecl -> HsDocString
2046 docDeclDoc (DocCommentNext d) = d
2047 docDeclDoc (DocCommentPrev d) = d
2048 docDeclDoc (DocCommentNamed _ d) = d
2049 docDeclDoc (DocGroup _ d) = d
2050
2051 {-
2052 ************************************************************************
2053 * *
2054 \subsection[DeprecDecl]{Deprecations}
2055 * *
2056 ************************************************************************
2057
2058 We use exported entities for things to deprecate.
2059 -}
2060
2061 -- | Located Warning Declarations
2062 type LWarnDecls pass = Located (WarnDecls pass)
2063
2064 -- Note [Pragma source text] in BasicTypes
2065 -- | Warning pragma Declarations
2066 data WarnDecls pass = Warnings { wd_src :: SourceText
2067 , wd_warnings :: [LWarnDecl pass]
2068 }
2069 deriving instance (DataId pass) => Data (WarnDecls pass)
2070
2071 -- | Located Warning pragma Declaration
2072 type LWarnDecl pass = Located (WarnDecl pass)
2073
2074 -- | Warning pragma Declaration
2075 data WarnDecl pass = Warning [Located (IdP pass)] WarningTxt
2076 deriving instance (DataId pass) => Data (WarnDecl pass)
2077
2078 instance OutputableBndr (IdP pass) => Outputable (WarnDecls pass) where
2079 ppr (Warnings (SourceText src) decls)
2080 = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
2081 ppr (Warnings NoSourceText _decls) = panic "WarnDecls"
2082
2083 instance OutputableBndr (IdP pass) => Outputable (WarnDecl pass) where
2084 ppr (Warning thing txt)
2085 = hsep ( punctuate comma (map ppr thing))
2086 <+> ppr txt
2087
2088 {-
2089 ************************************************************************
2090 * *
2091 \subsection[AnnDecl]{Annotations}
2092 * *
2093 ************************************************************************
2094 -}
2095
2096 -- | Located Annotation Declaration
2097 type LAnnDecl pass = Located (AnnDecl pass)
2098
2099 -- | Annotation Declaration
2100 data AnnDecl pass = HsAnnotation
2101 SourceText -- Note [Pragma source text] in BasicTypes
2102 (AnnProvenance (IdP pass)) (Located (HsExpr pass))
2103 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
2104 -- 'ApiAnnotation.AnnType'
2105 -- 'ApiAnnotation.AnnModule'
2106 -- 'ApiAnnotation.AnnClose'
2107
2108 -- For details on above see note [Api annotations] in ApiAnnotation
2109 deriving instance (DataIdLR pass pass) => Data (AnnDecl pass)
2110
2111 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
2112 => Outputable (AnnDecl (GhcPass p)) where
2113 ppr (HsAnnotation _ provenance expr)
2114 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
2115
2116 -- | Annotation Provenance
2117 data AnnProvenance name = ValueAnnProvenance (Located name)
2118 | TypeAnnProvenance (Located name)
2119 | ModuleAnnProvenance
2120 deriving instance Functor AnnProvenance
2121 deriving instance Foldable AnnProvenance
2122 deriving instance Traversable AnnProvenance
2123 deriving instance (Data pass) => Data (AnnProvenance pass)
2124
2125 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
2126 annProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name
2127 annProvenanceName_maybe (TypeAnnProvenance (L _ name)) = Just name
2128 annProvenanceName_maybe ModuleAnnProvenance = Nothing
2129
2130 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
2131 pprAnnProvenance ModuleAnnProvenance = text "ANN module"
2132 pprAnnProvenance (ValueAnnProvenance (L _ name))
2133 = text "ANN" <+> ppr name
2134 pprAnnProvenance (TypeAnnProvenance (L _ name))
2135 = text "ANN type" <+> ppr name
2136
2137 {-
2138 ************************************************************************
2139 * *
2140 \subsection[RoleAnnot]{Role annotations}
2141 * *
2142 ************************************************************************
2143 -}
2144
2145 -- | Located Role Annotation Declaration
2146 type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)
2147
2148 -- See #8185 for more info about why role annotations are
2149 -- top-level declarations
2150 -- | Role Annotation Declaration
2151 data RoleAnnotDecl pass
2152 = RoleAnnotDecl (Located (IdP pass)) -- type constructor
2153 [Located (Maybe Role)] -- optional annotations
2154 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
2155 -- 'ApiAnnotation.AnnRole'
2156
2157 -- For details on above see note [Api annotations] in ApiAnnotation
2158 deriving instance (DataId pass) => Data (RoleAnnotDecl pass)
2159
2160 instance OutputableBndr (IdP pass) => Outputable (RoleAnnotDecl pass) where
2161 ppr (RoleAnnotDecl ltycon roles)
2162 = text "type role" <+> ppr ltycon <+>
2163 hsep (map (pp_role . unLoc) roles)
2164 where
2165 pp_role Nothing = underscore
2166 pp_role (Just r) = ppr r
2167
2168 roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
2169 roleAnnotDeclName (RoleAnnotDecl (L _ name) _) = name