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