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