Embrace -XTypeInType, add -XStarIsType
[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; for an
522 -- associated type
523 -- these include outer binders
524 -- Eg class T a where
525 -- type F a :: *
526 -- type F a = a -> a
527 -- Here the type decl for 'f'
528 -- includes 'a' in its tcdTyVars
529 , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
530 , tcdDataDefn :: HsDataDefn pass }
531
532 | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs
533 tcdCtxt :: LHsContext pass, -- ^ Context...
534 tcdLName :: Located (IdP pass), -- ^ Name of the class
535 tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
536 tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration
537 tcdFDs :: [Located (FunDep (Located (IdP pass)))],
538 -- ^ Functional deps
539 tcdSigs :: [LSig pass], -- ^ Methods' signatures
540 tcdMeths :: LHsBinds pass, -- ^ Default methods
541 tcdATs :: [LFamilyDecl pass], -- ^ Associated types;
542 tcdATDefs :: [LTyFamDefltEqn pass],
543 -- ^ Associated type defaults
544 tcdDocs :: [LDocDecl] -- ^ Haddock docs
545 }
546 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
547 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
548 -- 'ApiAnnotation.AnnClose'
549 -- - The tcdFDs will have 'ApiAnnotation.AnnVbar',
550 -- 'ApiAnnotation.AnnComma'
551 -- 'ApiAnnotation.AnnRarrow'
552
553 -- For details on above see note [Api annotations] in ApiAnnotation
554 | XTyClDecl (XXTyClDecl pass)
555
556 data DataDeclRn = DataDeclRn
557 { tcdDataCusk :: Bool -- ^ does this have a CUSK?
558 , tcdFVs :: NameSet }
559 deriving Data
560
561 type instance XFamDecl (GhcPass _) = NoExt
562
563 type instance XSynDecl GhcPs = NoExt
564 type instance XSynDecl GhcRn = NameSet -- FVs
565 type instance XSynDecl GhcTc = NameSet -- FVs
566
567 type instance XDataDecl GhcPs = NoExt
568 type instance XDataDecl GhcRn = DataDeclRn
569 type instance XDataDecl GhcTc = DataDeclRn
570
571 type instance XClassDecl GhcPs = NoExt
572 type instance XClassDecl GhcRn = NameSet -- FVs
573 type instance XClassDecl GhcTc = NameSet -- FVs
574
575 type instance XXTyClDecl (GhcPass _) = NoExt
576
577 -- Simple classifiers for TyClDecl
578 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
579
580 -- | @True@ <=> argument is a @data@\/@newtype@
581 -- declaration.
582 isDataDecl :: TyClDecl pass -> Bool
583 isDataDecl (DataDecl {}) = True
584 isDataDecl _other = False
585
586 -- | type or type instance declaration
587 isSynDecl :: TyClDecl pass -> Bool
588 isSynDecl (SynDecl {}) = True
589 isSynDecl _other = False
590
591 -- | type class
592 isClassDecl :: TyClDecl pass -> Bool
593 isClassDecl (ClassDecl {}) = True
594 isClassDecl _ = False
595
596 -- | type/data family declaration
597 isFamilyDecl :: TyClDecl pass -> Bool
598 isFamilyDecl (FamDecl {}) = True
599 isFamilyDecl _other = False
600
601 -- | type family declaration
602 isTypeFamilyDecl :: TyClDecl pass -> Bool
603 isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of
604 OpenTypeFamily -> True
605 ClosedTypeFamily {} -> True
606 _ -> False
607 isTypeFamilyDecl _ = False
608
609 -- | open type family info
610 isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
611 isOpenTypeFamilyInfo OpenTypeFamily = True
612 isOpenTypeFamilyInfo _ = False
613
614 -- | closed type family info
615 isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
616 isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
617 isClosedTypeFamilyInfo _ = False
618
619 -- | data family declaration
620 isDataFamilyDecl :: TyClDecl pass -> Bool
621 isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True
622 isDataFamilyDecl _other = False
623
624 -- Dealing with names
625
626 tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
627 tyFamInstDeclName = unLoc . tyFamInstDeclLName
628
629 tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
630 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
631 (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
632 = ln
633 tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
634 = panic "tyFamInstDeclLName"
635 tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
636 = panic "tyFamInstDeclLName"
637
638 tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
639 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
640 tyClDeclLName decl = tcdLName decl
641
642 tcdName :: TyClDecl pass -> (IdP pass)
643 tcdName = unLoc . tyClDeclLName
644
645 tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
646 tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
647 tyClDeclTyVars d = tcdTyVars d
648
649 countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
650 -- class, synonym decls, data, newtype, family decls
651 countTyClDecls decls
652 = (count isClassDecl decls,
653 count isSynDecl decls, -- excluding...
654 count isDataTy decls, -- ...family...
655 count isNewTy decls, -- ...instances
656 count isFamilyDecl decls)
657 where
658 isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
659 isDataTy _ = False
660
661 isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
662 isNewTy _ = False
663
664 -- | Does this declaration have a complete, user-supplied kind signature?
665 -- See Note [Complete user-supplied kind signatures]
666 hsDeclHasCusk :: TyClDecl GhcRn -> Bool
667 hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
668 hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
669 -- NB: Keep this synchronized with 'getInitialKind'
670 = hsTvbAllKinded tyvars && rhs_annotated rhs
671 where
672 rhs_annotated (L _ ty) = case ty of
673 HsParTy _ lty -> rhs_annotated lty
674 HsKindSig {} -> True
675 _ -> False
676 hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
677 hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
678 hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"
679
680 -- Pretty-printing TyClDecl
681 -- ~~~~~~~~~~~~~~~~~~~~~~~~
682
683 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
684
685 ppr (FamDecl { tcdFam = decl }) = ppr decl
686 ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
687 , tcdRhs = rhs })
688 = hang (text "type" <+>
689 pp_vanilla_decl_head ltycon tyvars fixity [] <+> equals)
690 4 (ppr rhs)
691
692 ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
693 , tcdDataDefn = defn })
694 = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
695
696 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
697 tcdFixity = fixity,
698 tcdFDs = fds,
699 tcdSigs = sigs, tcdMeths = methods,
700 tcdATs = ats, tcdATDefs = at_defs})
701 | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
702 = top_matter
703
704 | otherwise -- Laid out
705 = vcat [ top_matter <+> text "where"
706 , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
707 map ppr_fam_deflt_eqn at_defs ++
708 pprLHsBindsForUser methods sigs) ]
709 where
710 top_matter = text "class"
711 <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
712 <+> pprFundeps (map unLoc fds)
713 ppr (XTyClDecl x) = ppr x
714
715 instance (p ~ GhcPass pass, OutputableBndrId p)
716 => Outputable (TyClGroup p) where
717 ppr (TyClGroup { group_tyclds = tyclds
718 , group_roles = roles
719 , group_instds = instds
720 }
721 )
722 = ppr tyclds $$
723 ppr roles $$
724 ppr instds
725 ppr (XTyClGroup x) = ppr x
726
727 pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
728 => Located (IdP (GhcPass p))
729 -> LHsQTyVars (GhcPass p)
730 -> LexicalFixity
731 -> HsContext (GhcPass p)
732 -> SDoc
733 pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
734 = hsep [pprHsContext context, pp_tyvars tyvars]
735 where
736 pp_tyvars (varl:varsr)
737 | fixity == Infix && length varsr > 1
738 = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
739 , (ppr.unLoc) (head varsr), char ')'
740 , hsep (map (ppr.unLoc) (tail varsr))]
741 | fixity == Infix
742 = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
743 , hsep (map (ppr.unLoc) varsr)]
744 | otherwise = hsep [ pprPrefixOcc (unLoc thing)
745 , hsep (map (ppr.unLoc) (varl:varsr))]
746 pp_tyvars [] = ppr thing
747 pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
748
749 pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
750 pprTyClDeclFlavour (ClassDecl {}) = text "class"
751 pprTyClDeclFlavour (SynDecl {}) = text "type"
752 pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
753 = pprFlavour info <+> text "family"
754 pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
755 = ppr x
756 pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
757 = ppr nd
758 pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
759 = ppr x
760 pprTyClDeclFlavour (XTyClDecl x) = ppr x
761
762
763 {- Note [Complete user-supplied kind signatures]
764 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765 We kind-check declarations differently if they have a complete, user-supplied
766 kind signature (CUSK). This is because we can safely generalise a CUSKed
767 declaration before checking all of the others, supporting polymorphic recursion.
768 See ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy
769 and #9200 for lots of discussion of how we got here.
770
771 A declaration has a CUSK if we can know its complete kind without doing any
772 inference, at all. Here are the rules:
773
774 - A class or datatype is said to have a CUSK if and only if all of its type
775 variables are annotated. Its result kind is, by construction, Constraint or *
776 respectively.
777
778 - A type synonym has a CUSK if and only if all of its type variables and its
779 RHS are annotated with kinds.
780
781 - A closed type family is said to have a CUSK if and only if all of its type
782 variables and its return type are annotated.
783
784 - An open type family always has a CUSK -- unannotated type variables (and
785 return type) default to *.
786
787 - A data definition with a top-level :: must explicitly bind all kind variables
788 to the right of the ::. See test dependent/should_compile/KindLevels, which
789 requires this case. (Naturally, any kind variable mentioned before the :: should
790 not be bound after it.)
791 -}
792
793
794 {- *********************************************************************
795 * *
796 TyClGroup
797 Strongly connected components of
798 type, class, instance, and role declarations
799 * *
800 ********************************************************************* -}
801
802 {- Note [TyClGroups and dependency analysis]
803 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
804 A TyClGroup represents a strongly connected components of type/class/instance
805 decls, together with the role annotations for the type/class declarations.
806
807 The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order
808 sequence of strongly-connected components.
809
810 Invariants
811 * The type and class declarations, group_tyclds, may depend on each
812 other, or earlier TyClGroups, but not on later ones
813
814 * The role annotations, group_roles, are role-annotations for some or
815 all of the types and classes in group_tyclds (only).
816
817 * The instance declarations, group_instds, may (and usually will)
818 depend on group_tyclds, or on earlier TyClGroups, but not on later
819 ones.
820
821 See Note [Dependency analsis of type, class, and instance decls]
822 in RnSource for more info.
823 -}
824
825 -- | Type or Class Group
826 data TyClGroup pass -- See Note [TyClGroups and dependency analysis]
827 = TyClGroup { group_ext :: XCTyClGroup pass
828 , group_tyclds :: [LTyClDecl pass]
829 , group_roles :: [LRoleAnnotDecl pass]
830 , group_instds :: [LInstDecl pass] }
831 | XTyClGroup (XXTyClGroup pass)
832
833 type instance XCTyClGroup (GhcPass _) = NoExt
834 type instance XXTyClGroup (GhcPass _) = NoExt
835
836
837 emptyTyClGroup :: TyClGroup (GhcPass p)
838 emptyTyClGroup = TyClGroup noExt [] [] []
839
840 tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
841 tyClGroupTyClDecls = concatMap group_tyclds
842
843 tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
844 tyClGroupInstDecls = concatMap group_instds
845
846 tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
847 tyClGroupRoleDecls = concatMap group_roles
848
849 mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
850 -> TyClGroup (GhcPass p)
851 mkTyClGroup decls instds = TyClGroup
852 { group_ext = noExt
853 , group_tyclds = decls
854 , group_roles = []
855 , group_instds = instds
856 }
857
858
859
860 {- *********************************************************************
861 * *
862 Data and type family declarations
863 * *
864 ********************************************************************* -}
865
866 {- Note [FamilyResultSig]
867 ~~~~~~~~~~~~~~~~~~~~~~~~~
868
869 This data type represents the return signature of a type family. Possible
870 values are:
871
872 * NoSig - the user supplied no return signature:
873 type family Id a where ...
874
875 * KindSig - the user supplied the return kind:
876 type family Id a :: * where ...
877
878 * TyVarSig - user named the result with a type variable and possibly
879 provided a kind signature for that variable:
880 type family Id a = r where ...
881 type family Id a = (r :: *) where ...
882
883 Naming result of a type family is required if we want to provide
884 injectivity annotation for a type family:
885 type family Id a = r | r -> a where ...
886
887 See also: Note [Injectivity annotation]
888
889 Note [Injectivity annotation]
890 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
891
892 A user can declare a type family to be injective:
893
894 type family Id a = r | r -> a where ...
895
896 * The part after the "|" is called "injectivity annotation".
897 * "r -> a" part is called "injectivity condition"; at the moment terms
898 "injectivity annotation" and "injectivity condition" are synonymous
899 because we only allow a single injectivity condition.
900 * "r" is the "LHS of injectivity condition". LHS can only contain the
901 variable naming the result of a type family.
902
903 * "a" is the "RHS of injectivity condition". RHS contains space-separated
904 type and kind variables representing the arguments of a type
905 family. Variables can be omitted if a type family is not injective in
906 these arguments. Example:
907 type family Foo a b c = d | d -> a c where ...
908
909 Note that:
910 (a) naming of type family result is required to provide injectivity
911 annotation
912 (b) for associated types if the result was named then injectivity annotation
913 is mandatory. Otherwise result type variable is indistinguishable from
914 associated type default.
915
916 It is possible that in the future this syntax will be extended to support
917 more complicated injectivity annotations. For example we could declare that
918 if we know the result of Plus and one of its arguments we can determine the
919 other argument:
920
921 type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...
922
923 Here injectivity annotation would consist of two comma-separated injectivity
924 conditions.
925
926 See also Note [Injective type families] in TyCon
927 -}
928
929 -- | Located type Family Result Signature
930 type LFamilyResultSig pass = Located (FamilyResultSig pass)
931
932 -- | type Family Result Signature
933 data FamilyResultSig pass = -- see Note [FamilyResultSig]
934 NoSig (XNoSig pass)
935 -- ^ - 'ApiAnnotation.AnnKeywordId' :
936
937 -- For details on above see note [Api annotations] in ApiAnnotation
938
939 | KindSig (XCKindSig pass) (LHsKind pass)
940 -- ^ - 'ApiAnnotation.AnnKeywordId' :
941 -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
942 -- 'ApiAnnotation.AnnCloseP'
943
944 -- For details on above see note [Api annotations] in ApiAnnotation
945
946 | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
947 -- ^ - 'ApiAnnotation.AnnKeywordId' :
948 -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
949 -- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
950 | XFamilyResultSig (XXFamilyResultSig pass)
951
952 -- For details on above see note [Api annotations] in ApiAnnotation
953
954 type instance XNoSig (GhcPass _) = NoExt
955 type instance XCKindSig (GhcPass _) = NoExt
956 type instance XTyVarSig (GhcPass _) = NoExt
957 type instance XXFamilyResultSig (GhcPass _) = NoExt
958
959
960 -- | Located type Family Declaration
961 type LFamilyDecl pass = Located (FamilyDecl pass)
962
963 -- | type Family Declaration
964 data FamilyDecl pass = FamilyDecl
965 { fdExt :: XCFamilyDecl pass
966 , fdInfo :: FamilyInfo pass -- type/data, closed/open
967 , fdLName :: Located (IdP pass) -- type constructor
968 , fdTyVars :: LHsQTyVars pass -- type variables
969 , fdFixity :: LexicalFixity -- Fixity used in the declaration
970 , fdResultSig :: LFamilyResultSig pass -- result signature
971 , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
972 }
973 | XFamilyDecl (XXFamilyDecl pass)
974 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
975 -- 'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
976 -- 'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
977 -- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',
978 -- 'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
979 -- 'ApiAnnotation.AnnVbar'
980
981 -- For details on above see note [Api annotations] in ApiAnnotation
982
983 type instance XCFamilyDecl (GhcPass _) = NoExt
984 type instance XXFamilyDecl (GhcPass _) = NoExt
985
986
987 -- | Located Injectivity Annotation
988 type LInjectivityAnn pass = Located (InjectivityAnn pass)
989
990 -- | If the user supplied an injectivity annotation it is represented using
991 -- InjectivityAnn. At the moment this is a single injectivity condition - see
992 -- Note [Injectivity annotation]. `Located name` stores the LHS of injectivity
993 -- condition. `[Located name]` stores the RHS of injectivity condition. Example:
994 --
995 -- type family Foo a b c = r | r -> a c where ...
996 --
997 -- This will be represented as "InjectivityAnn `r` [`a`, `c`]"
998 data InjectivityAnn pass
999 = InjectivityAnn (Located (IdP pass)) [Located (IdP pass)]
1000 -- ^ - 'ApiAnnotation.AnnKeywordId' :
1001 -- 'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar'
1002
1003 -- For details on above see note [Api annotations] in ApiAnnotation
1004
1005 data FamilyInfo pass
1006 = DataFamily
1007 | OpenTypeFamily
1008 -- | 'Nothing' if we're in an hs-boot file and the user
1009 -- said "type family Foo x where .."
1010 | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
1011
1012 -- | Does this family declaration have a complete, user-supplied kind signature?
1013 famDeclHasCusk :: Maybe Bool
1014 -- ^ if associated, does the enclosing class have a CUSK?
1015 -> FamilyDecl pass -> Bool
1016 famDeclHasCusk _ (FamilyDecl { fdInfo = ClosedTypeFamily _
1017 , fdTyVars = tyvars
1018 , fdResultSig = L _ resultSig })
1019 = hsTvbAllKinded tyvars && hasReturnKindSignature resultSig
1020 famDeclHasCusk mb_class_cusk _ = mb_class_cusk `orElse` True
1021 -- all un-associated open families have CUSKs
1022
1023 -- | Does this family declaration have user-supplied return kind signature?
1024 hasReturnKindSignature :: FamilyResultSig a -> Bool
1025 hasReturnKindSignature (NoSig _) = False
1026 hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False
1027 hasReturnKindSignature _ = True
1028
1029 -- | Maybe return name of the result type variable
1030 resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
1031 resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
1032 resultVariableName _ = Nothing
1033
1034 instance (p ~ GhcPass pass, OutputableBndrId p)
1035 => Outputable (FamilyDecl p) where
1036 ppr = pprFamilyDecl TopLevel
1037
1038 pprFamilyDecl :: (OutputableBndrId (GhcPass p))
1039 => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
1040 pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
1041 , fdTyVars = tyvars
1042 , fdFixity = fixity
1043 , fdResultSig = L _ result
1044 , fdInjectivityAnn = mb_inj })
1045 = vcat [ pprFlavour info <+> pp_top_level <+>
1046 pp_vanilla_decl_head ltycon tyvars fixity [] <+>
1047 pp_kind <+> pp_inj <+> pp_where
1048 , nest 2 $ pp_eqns ]
1049 where
1050 pp_top_level = case top_level of
1051 TopLevel -> text "family"
1052 NotTopLevel -> empty
1053
1054 pp_kind = case result of
1055 NoSig _ -> empty
1056 KindSig _ kind -> dcolon <+> ppr kind
1057 TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
1058 XFamilyResultSig x -> ppr x
1059 pp_inj = case mb_inj of
1060 Just (L _ (InjectivityAnn lhs rhs)) ->
1061 hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
1062 Nothing -> empty
1063 (pp_where, pp_eqns) = case info of
1064 ClosedTypeFamily mb_eqns ->
1065 ( text "where"
1066 , case mb_eqns of
1067 Nothing -> text ".."
1068 Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
1069 _ -> (empty, empty)
1070 pprFamilyDecl _ (XFamilyDecl x) = ppr x
1071
1072 pprFlavour :: FamilyInfo pass -> SDoc
1073 pprFlavour DataFamily = text "data"
1074 pprFlavour OpenTypeFamily = text "type"
1075 pprFlavour (ClosedTypeFamily {}) = text "type"
1076
1077 instance Outputable (FamilyInfo pass) where
1078 ppr info = pprFlavour info <+> text "family"
1079
1080
1081
1082 {- *********************************************************************
1083 * *
1084 Data types and data constructors
1085 * *
1086 ********************************************************************* -}
1087
1088 -- | Haskell Data type Definition
1089 data HsDataDefn pass -- The payload of a data type defn
1090 -- Used *both* for vanilla data declarations,
1091 -- *and* for data family instances
1092 = -- | Declares a data type or newtype, giving its constructors
1093 -- @
1094 -- data/newtype T a = <constrs>
1095 -- data/newtype instance T [a] = <constrs>
1096 -- @
1097 HsDataDefn { dd_ext :: XCHsDataDefn pass,
1098 dd_ND :: NewOrData,
1099 dd_ctxt :: LHsContext pass, -- ^ Context
1100 dd_cType :: Maybe (Located CType),
1101 dd_kindSig:: Maybe (LHsKind pass),
1102 -- ^ Optional kind signature.
1103 --
1104 -- @(Just k)@ for a GADT-style @data@,
1105 -- or @data instance@ decl, with explicit kind sig
1106 --
1107 -- Always @Nothing@ for H98-syntax decls
1108
1109 dd_cons :: [LConDecl pass],
1110 -- ^ Data constructors
1111 --
1112 -- For @data T a = T1 | T2 a@
1113 -- the 'LConDecl's all have 'ConDeclH98'.
1114 -- For @data T a where { T1 :: T a }@
1115 -- the 'LConDecls' all have 'ConDeclGADT'.
1116
1117 dd_derivs :: HsDeriving pass -- ^ Optional 'deriving' claues
1118
1119 -- For details on above see note [Api annotations] in ApiAnnotation
1120 }
1121 | XHsDataDefn (XXHsDataDefn pass)
1122
1123 type instance XCHsDataDefn (GhcPass _) = NoExt
1124 type instance XXHsDataDefn (GhcPass _) = NoExt
1125
1126 -- | Haskell Deriving clause
1127 type HsDeriving pass = Located [LHsDerivingClause pass]
1128 -- ^ The optional @deriving@ clauses of a data declaration. "Clauses" is
1129 -- plural because one can specify multiple deriving clauses using the
1130 -- @-XDerivingStrategies@ language extension.
1131 --
1132 -- The list of 'LHsDerivingClause's corresponds to exactly what the user
1133 -- requested to derive, in order. If no deriving clauses were specified,
1134 -- the list is empty.
1135
1136 type LHsDerivingClause pass = Located (HsDerivingClause pass)
1137
1138 -- | A single @deriving@ clause of a data declaration.
1139 --
1140 -- - 'ApiAnnotation.AnnKeywordId' :
1141 -- 'ApiAnnotation.AnnDeriving', 'ApiAnnotation.AnnStock',
1142 -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
1143 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1144 data HsDerivingClause pass
1145 -- See Note [Deriving strategies] in TcDeriv
1146 = HsDerivingClause
1147 { deriv_clause_ext :: XCHsDerivingClause pass
1148 , deriv_clause_strategy :: Maybe (LDerivStrategy pass)
1149 -- ^ The user-specified strategy (if any) to use when deriving
1150 -- 'deriv_clause_tys'.
1151 , deriv_clause_tys :: Located [LHsSigType pass]
1152 -- ^ The types to derive.
1153 --
1154 -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
1155 -- we can mention type variables that aren't bound by the datatype, e.g.
1156 --
1157 -- > data T b = ... deriving (C [a])
1158 --
1159 -- should produce a derived instance for @C [a] (T b)@.
1160 }
1161 | XHsDerivingClause (XXHsDerivingClause pass)
1162
1163 type instance XCHsDerivingClause (GhcPass _) = NoExt
1164 type instance XXHsDerivingClause (GhcPass _) = NoExt
1165
1166 instance (p ~ GhcPass pass, OutputableBndrId p)
1167 => Outputable (HsDerivingClause p) where
1168 ppr (HsDerivingClause { deriv_clause_strategy = dcs
1169 , deriv_clause_tys = L _ dct })
1170 = hsep [ text "deriving"
1171 , pp_strat_before
1172 , pp_dct dct
1173 , pp_strat_after ]
1174 where
1175 -- This complexity is to distinguish between
1176 -- deriving Show
1177 -- deriving (Show)
1178 pp_dct [HsIB { hsib_body = ty }]
1179 = ppr (parenthesizeHsType appPrec ty)
1180 pp_dct _ = parens (interpp'SP dct)
1181
1182 -- @via@ is unique in that in comes /after/ the class being derived,
1183 -- so we must special-case it.
1184 (pp_strat_before, pp_strat_after) =
1185 case dcs of
1186 Just (L _ via@ViaStrategy{}) -> (empty, ppr via)
1187 _ -> (ppDerivStrategy dcs, empty)
1188 ppr (XHsDerivingClause x) = ppr x
1189
1190 data NewOrData
1191 = NewType -- ^ @newtype Blah ...@
1192 | DataType -- ^ @data Blah ...@
1193 deriving( Eq, Data ) -- Needed because Demand derives Eq
1194
1195 -- | Convert a 'NewOrData' to a 'TyConFlavour'
1196 newOrDataToFlavour :: NewOrData -> TyConFlavour
1197 newOrDataToFlavour NewType = NewtypeFlavour
1198 newOrDataToFlavour DataType = DataTypeFlavour
1199
1200 -- | Located data Constructor Declaration
1201 type LConDecl pass = Located (ConDecl pass)
1202 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when
1203 -- in a GADT constructor list
1204
1205 -- For details on above see note [Api annotations] in ApiAnnotation
1206
1207 -- |
1208 --
1209 -- @
1210 -- data T b = forall a. Eq a => MkT a b
1211 -- MkT :: forall b a. Eq a => MkT a b
1212 --
1213 -- data T b where
1214 -- MkT1 :: Int -> T Int
1215 --
1216 -- data T = Int `MkT` Int
1217 -- | MkT2
1218 --
1219 -- data T a where
1220 -- Int `MkT` Int :: T Int
1221 -- @
1222 --
1223 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
1224 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnCLose',
1225 -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnVbar',
1226 -- 'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow',
1227 -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot'
1228
1229 -- For details on above see note [Api annotations] in ApiAnnotation
1230
1231 -- | data Constructor Declaration
1232 data ConDecl pass
1233 = ConDeclGADT
1234 { con_g_ext :: XConDeclGADT pass
1235 , con_names :: [Located (IdP pass)]
1236
1237 -- The next four fields describe the type after the '::'
1238 -- See Note [GADT abstract syntax]
1239 , con_forall :: Bool -- ^ True <=> explicit forall
1240 -- False => hsq_explicit is empty
1241 , con_qvars :: LHsQTyVars pass
1242 -- Whether or not there is an /explicit/ forall, we still
1243 -- need to capture the implicitly-bound type/kind variables
1244
1245 , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
1246 , con_args :: HsConDeclDetails pass -- ^ Arguments; never InfixCon
1247 , con_res_ty :: LHsType pass -- ^ Result type
1248
1249 , con_doc :: Maybe LHsDocString
1250 -- ^ A possible Haddock comment.
1251 }
1252
1253 | ConDeclH98
1254 { con_ext :: XConDeclH98 pass
1255 , con_name :: Located (IdP pass)
1256
1257 , con_forall :: Bool -- ^ True <=> explicit user-written forall
1258 -- e.g. data T a = forall b. MkT b (b->a)
1259 -- con_ex_tvs = {b}
1260 -- False => con_ex_tvs is empty
1261 , con_ex_tvs :: [LHsTyVarBndr pass] -- ^ Existentials only
1262 , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
1263 , con_args :: HsConDeclDetails pass -- ^ Arguments; can be InfixCon
1264
1265 , con_doc :: Maybe LHsDocString
1266 -- ^ A possible Haddock comment.
1267 }
1268 | XConDecl (XXConDecl pass)
1269
1270 type instance XConDeclGADT (GhcPass _) = NoExt
1271 type instance XConDeclH98 (GhcPass _) = NoExt
1272 type instance XXConDecl (GhcPass _) = NoExt
1273
1274 {- Note [GADT abstract syntax]
1275 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1276 There's a wrinkle in ConDeclGADT
1277
1278 * For record syntax, it's all uniform. Given:
1279 data T a where
1280 K :: forall a. Ord a => { x :: [a], ... } -> T a
1281 we make the a ConDeclGADT for K with
1282 con_qvars = {a}
1283 con_mb_cxt = Just [Ord a]
1284 con_args = RecCon <the record fields>
1285 con_res_ty = T a
1286
1287 We need the RecCon before the reanmer, so we can find the record field
1288 binders in HsUtils.hsConDeclsBinders.
1289
1290 * However for a GADT constr declaration which is not a record, it can
1291 be hard parse until we know operator fixities. Consider for example
1292 C :: a :*: b -> a :*: b -> a :+: b
1293 Initially this type will parse as
1294 a :*: (b -> (a :*: (b -> (a :+: b))))
1295 so it's hard to split up the arguments until we've done the precedence
1296 resolution (in the renamer).
1297
1298 So: - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr
1299 type into the res_ty for a ConDeclGADT for now, and use
1300 PrefixCon []
1301 con_args = PrefixCon []
1302 con_res_ty = a :*: (b -> (a :*: (b -> (a :+: b))))
1303
1304 - In the renamer (RnSource.rnConDecl), we unravel it afer
1305 operator fixities are sorted. So we generate. So we end
1306 up with
1307 con_args = PrefixCon [ a :*: b, a :*: b ]
1308 con_res_ty = a :+: b
1309 -}
1310
1311 -- | Haskell data Constructor Declaration Details
1312 type HsConDeclDetails pass
1313 = HsConDetails (LBangType pass) (Located [LConDeclField pass])
1314
1315 getConNames :: ConDecl pass -> [Located (IdP pass)]
1316 getConNames ConDeclH98 {con_name = name} = [name]
1317 getConNames ConDeclGADT {con_names = names} = names
1318 getConNames XConDecl {} = panic "getConNames"
1319
1320 getConArgs :: ConDecl pass -> HsConDeclDetails pass
1321 getConArgs d = con_args d
1322
1323 hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]
1324 hsConDeclArgTys (PrefixCon tys) = tys
1325 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
1326 hsConDeclArgTys (RecCon flds) = map (cd_fld_type . unLoc) (unLoc flds)
1327
1328 hsConDeclTheta :: Maybe (LHsContext pass) -> [LHsType pass]
1329 hsConDeclTheta Nothing = []
1330 hsConDeclTheta (Just (L _ theta)) = theta
1331
1332 pp_data_defn :: (OutputableBndrId (GhcPass p))
1333 => (HsContext (GhcPass p) -> SDoc) -- Printing the header
1334 -> HsDataDefn (GhcPass p)
1335 -> SDoc
1336 pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
1337 , dd_cType = mb_ct
1338 , dd_kindSig = mb_sig
1339 , dd_cons = condecls, dd_derivs = derivings })
1340 | null condecls
1341 = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig
1342 <+> pp_derivings derivings
1343
1344 | otherwise
1345 = hang (ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig)
1346 2 (pp_condecls condecls $$ pp_derivings derivings)
1347 where
1348 pp_ct = case mb_ct of
1349 Nothing -> empty
1350 Just ct -> ppr ct
1351 pp_sig = case mb_sig of
1352 Nothing -> empty
1353 Just kind -> dcolon <+> ppr kind
1354 pp_derivings (L _ ds) = vcat (map ppr ds)
1355 pp_data_defn _ (XHsDataDefn x) = ppr x
1356
1357 instance (p ~ GhcPass pass, OutputableBndrId p)
1358 => Outputable (HsDataDefn p) where
1359 ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
1360
1361 instance Outputable NewOrData where
1362 ppr NewType = text "newtype"
1363 ppr DataType = text "data"
1364
1365 pp_condecls :: (OutputableBndrId (GhcPass p)) => [LConDecl (GhcPass p)] -> SDoc
1366 pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
1367 = hang (text "where") 2 (vcat (map ppr cs))
1368 pp_condecls cs -- In H98 syntax
1369 = equals <+> sep (punctuate (text " |") (map ppr cs))
1370
1371 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDecl p) where
1372 ppr = pprConDecl
1373
1374 pprConDecl :: (OutputableBndrId (GhcPass p)) => ConDecl (GhcPass p) -> SDoc
1375 pprConDecl (ConDeclH98 { con_name = L _ con
1376 , con_ex_tvs = ex_tvs
1377 , con_mb_cxt = mcxt
1378 , con_args = args
1379 , con_doc = doc })
1380 = sep [ppr_mbDoc doc, pprHsForAll ex_tvs cxt, ppr_details args]
1381 where
1382 ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2]
1383 ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con
1384 : map (pprHsType . unLoc) tys)
1385 ppr_details (RecCon fields) = pprPrefixOcc con
1386 <+> pprConDeclFields (unLoc fields)
1387 cxt = fromMaybe (noLoc []) mcxt
1388
1389 pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
1390 , con_mb_cxt = mcxt, con_args = args
1391 , con_res_ty = res_ty, con_doc = doc })
1392 = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
1393 <+> (sep [pprHsForAll (hsq_explicit qvars) cxt,
1394 ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])
1395 where
1396 get_args (PrefixCon args) = map ppr args
1397 get_args (RecCon fields) = [pprConDeclFields (unLoc fields)]
1398 get_args (InfixCon {}) = pprPanic "pprConDecl:GADT" (ppr cons)
1399
1400 cxt = fromMaybe (noLoc []) mcxt
1401
1402 ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
1403 ppr_arrow_chain [] = empty
1404
1405 pprConDecl (XConDecl x) = ppr x
1406
1407 ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
1408 ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
1409
1410 {-
1411 ************************************************************************
1412 * *
1413 Instance declarations
1414 * *
1415 ************************************************************************
1416
1417 Note [Type family instance declarations in HsSyn]
1418 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1419 The data type FamEqn represents one equation of a type family instance.
1420 Aside from the pass, it is also parameterised over two fields:
1421 feqn_pats and feqn_rhs.
1422
1423 feqn_pats is either LHsTypes (for ordinary data/type family instances) or
1424 LHsQTyVars (for associated type family default instances). In particular:
1425
1426 * An ordinary type family instance declaration looks like this in source Haskell
1427 type instance T [a] Int = a -> a
1428 (or something similar for a closed family)
1429 It is represented by a FamInstEqn, with a *type* (LHsType) in the feqn_pats
1430 field.
1431
1432 * On the other hand, the *default instance* of an associated type looks like
1433 this in source Haskell
1434 class C a where
1435 type T a b
1436 type T a b = a -> b -- The default instance
1437 It is represented by a TyFamDefltEqn, with *type variables* (LHsQTyVars) in
1438 the feqn_pats field.
1439
1440 feqn_rhs is either an HsDataDefn (for data family instances) or an LHsType
1441 (for type family instances).
1442 -}
1443
1444 ----------------- Type synonym family instances -------------
1445
1446 -- | Located Type Family Instance Equation
1447 type LTyFamInstEqn pass = Located (TyFamInstEqn pass)
1448 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
1449 -- when in a list
1450
1451 -- For details on above see note [Api annotations] in ApiAnnotation
1452
1453 -- | Located Type Family Default Equation
1454 type LTyFamDefltEqn pass = Located (TyFamDefltEqn pass)
1455
1456 -- | Haskell Type Patterns
1457 type HsTyPats pass = [LHsType pass]
1458
1459 {- Note [Family instance declaration binders]
1460 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1461 For ordinary data/type family instances, the feqn_pats field of FamEqn stores
1462 the LHS type (and kind) patterns. These type patterns can of course contain
1463 type (and kind) variables, which are bound in the hsib_vars field of the
1464 HsImplicitBndrs in FamInstEqn. Note in particular
1465
1466 * The hsib_vars *includes* any anonymous wildcards. For example
1467 type instance F a _ = a
1468 The hsib_vars will be {a, _}. Remember that each separate wildcard
1469 '_' gets its own unique. In this context wildcards behave just like
1470 an ordinary type variable, only anonymous.
1471
1472 * The hsib_vars *includes* type variables that are already in scope
1473
1474 Eg class C s t where
1475 type F t p :: *
1476 instance C w (a,b) where
1477 type F (a,b) x = x->a
1478 The hsib_vars of the F decl are {a,b,x}, even though the F decl
1479 is nested inside the 'instance' decl.
1480
1481 However after the renamer, the uniques will match up:
1482 instance C w7 (a8,b9) where
1483 type F (a8,b9) x10 = x10->a8
1484 so that we can compare the type pattern in the 'instance' decl and
1485 in the associated 'type' decl
1486
1487 For associated type family default instances (TyFamDefltEqn), instead of using
1488 type patterns with binders in a surrounding HsImplicitBndrs, we use raw type
1489 variables (LHsQTyVars) in the feqn_pats field of FamEqn.
1490 -}
1491
1492 -- | Type Family Instance Equation
1493 type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)
1494
1495 -- | Type Family Default Equation
1496 type TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)
1497 -- See Note [Type family instance declarations in HsSyn]
1498
1499 -- | Located Type Family Instance Declaration
1500 type LTyFamInstDecl pass = Located (TyFamInstDecl pass)
1501
1502 -- | Type Family Instance Declaration
1503 newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
1504 -- ^
1505 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
1506 -- 'ApiAnnotation.AnnInstance',
1507
1508 -- For details on above see note [Api annotations] in ApiAnnotation
1509
1510 ----------------- Data family instances -------------
1511
1512 -- | Located Data Family Instance Declaration
1513 type LDataFamInstDecl pass = Located (DataFamInstDecl pass)
1514
1515 -- | Data Family Instance Declaration
1516 newtype DataFamInstDecl pass
1517 = DataFamInstDecl { dfid_eqn :: FamInstEqn pass (HsDataDefn pass) }
1518 -- ^
1519 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
1520 -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
1521 -- 'ApiAnnotation.AnnDcolon'
1522 -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
1523 -- 'ApiAnnotation.AnnClose'
1524
1525 -- For details on above see note [Api annotations] in ApiAnnotation
1526
1527 ----------------- Family instances (common types) -------------
1528
1529 -- | Located Family Instance Equation
1530 type LFamInstEqn pass rhs = Located (FamInstEqn pass rhs)
1531
1532 -- | Family Instance Equation
1533 type FamInstEqn pass rhs
1534 = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)
1535 -- ^ Here, the @pats@ are type patterns (with kind and type bndrs).
1536 -- See Note [Family instance declaration binders]
1537
1538 -- | Family Equation
1539 --
1540 -- One equation in a type family instance declaration, data family instance
1541 -- declaration, or type family default.
1542 -- See Note [Type family instance declarations in HsSyn]
1543 -- See Note [Family instance declaration binders]
1544 data FamEqn pass pats rhs
1545 = FamEqn
1546 { feqn_ext :: XCFamEqn pass pats rhs
1547 , feqn_tycon :: Located (IdP pass)
1548 , feqn_pats :: pats
1549 , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
1550 , feqn_rhs :: rhs
1551 }
1552 -- ^
1553 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
1554 | XFamEqn (XXFamEqn pass pats rhs)
1555
1556 -- For details on above see note [Api annotations] in ApiAnnotation
1557
1558 type instance XCFamEqn (GhcPass _) p r = NoExt
1559 type instance XXFamEqn (GhcPass _) p r = NoExt
1560
1561 ----------------- Class instances -------------
1562
1563 -- | Located Class Instance Declaration
1564 type LClsInstDecl pass = Located (ClsInstDecl pass)
1565
1566 -- | Class Instance Declaration
1567 data ClsInstDecl pass
1568 = ClsInstDecl
1569 { cid_ext :: XCClsInstDecl pass
1570 , cid_poly_ty :: LHsSigType pass -- Context => Class Instance-type
1571 -- Using a polytype means that the renamer conveniently
1572 -- figures out the quantified type variables for us.
1573 , cid_binds :: LHsBinds pass -- Class methods
1574 , cid_sigs :: [LSig pass] -- User-supplied pragmatic info
1575 , cid_tyfam_insts :: [LTyFamInstDecl pass] -- Type family instances
1576 , cid_datafam_insts :: [LDataFamInstDecl pass] -- Data family instances
1577 , cid_overlap_mode :: Maybe (Located OverlapMode)
1578 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
1579 -- 'ApiAnnotation.AnnClose',
1580
1581 -- For details on above see note [Api annotations] in ApiAnnotation
1582 }
1583 -- ^
1584 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance',
1585 -- 'ApiAnnotation.AnnWhere',
1586 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
1587
1588 -- For details on above see note [Api annotations] in ApiAnnotation
1589 | XClsInstDecl (XXClsInstDecl pass)
1590
1591 type instance XCClsInstDecl (GhcPass _) = NoExt
1592 type instance XXClsInstDecl (GhcPass _) = NoExt
1593
1594 ----------------- Instances of all kinds -------------
1595
1596 -- | Located Instance Declaration
1597 type LInstDecl pass = Located (InstDecl pass)
1598
1599 -- | Instance Declaration
1600 data InstDecl pass -- Both class and family instances
1601 = ClsInstD
1602 { cid_d_ext :: XClsInstD pass
1603 , cid_inst :: ClsInstDecl pass }
1604 | DataFamInstD -- data family instance
1605 { dfid_ext :: XDataFamInstD pass
1606 , dfid_inst :: DataFamInstDecl pass }
1607 | TyFamInstD -- type family instance
1608 { tfid_ext :: XTyFamInstD pass
1609 , tfid_inst :: TyFamInstDecl pass }
1610 | XInstDecl (XXInstDecl pass)
1611
1612 type instance XClsInstD (GhcPass _) = NoExt
1613 type instance XDataFamInstD (GhcPass _) = NoExt
1614 type instance XTyFamInstD (GhcPass _) = NoExt
1615 type instance XXInstDecl (GhcPass _) = NoExt
1616
1617 instance (p ~ GhcPass pass, OutputableBndrId p)
1618 => Outputable (TyFamInstDecl p) where
1619 ppr = pprTyFamInstDecl TopLevel
1620
1621 pprTyFamInstDecl :: (OutputableBndrId (GhcPass p))
1622 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
1623 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
1624 = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
1625
1626 ppr_instance_keyword :: TopLevelFlag -> SDoc
1627 ppr_instance_keyword TopLevel = text "instance"
1628 ppr_instance_keyword NotTopLevel = empty
1629
1630 ppr_fam_inst_eqn :: (OutputableBndrId (GhcPass p))
1631 => TyFamInstEqn (GhcPass p) -> SDoc
1632 ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = tycon
1633 , feqn_pats = pats
1634 , feqn_fixity = fixity
1635 , feqn_rhs = rhs }})
1636 = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
1637 ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x
1638 ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x
1639
1640 ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))
1641 => LTyFamDefltEqn (GhcPass p) -> SDoc
1642 ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon = tycon
1643 , feqn_pats = tvs
1644 , feqn_fixity = fixity
1645 , feqn_rhs = rhs }))
1646 = text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
1647 <+> equals <+> ppr rhs
1648 ppr_fam_deflt_eqn (L _ (XFamEqn x)) = ppr x
1649
1650 instance (p ~ GhcPass pass, OutputableBndrId p)
1651 => Outputable (DataFamInstDecl p) where
1652 ppr = pprDataFamInstDecl TopLevel
1653
1654 pprDataFamInstDecl :: (OutputableBndrId (GhcPass p))
1655 => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
1656 pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
1657 FamEqn { feqn_tycon = tycon
1658 , feqn_pats = pats
1659 , feqn_fixity = fixity
1660 , feqn_rhs = defn }}})
1661 = pp_data_defn pp_hdr defn
1662 where
1663 pp_hdr ctxt = ppr_instance_keyword top_lvl
1664 <+> pprFamInstLHS tycon pats fixity ctxt Nothing
1665 -- No need to pass an explicit kind signature to
1666 -- pprFamInstLHS here, since pp_data_defn already
1667 -- pretty-prints that. See #14817.
1668 pprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x)))
1669 = ppr x
1670 pprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x))
1671 = ppr x
1672
1673 pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc
1674 pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
1675 FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
1676 = ppr nd
1677 pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
1678 FamEqn { feqn_rhs = XHsDataDefn x}}})
1679 = ppr x
1680 pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))
1681 = ppr x
1682 pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))
1683 = ppr x
1684
1685 pprFamInstLHS :: (OutputableBndrId (GhcPass p))
1686 => Located (IdP (GhcPass p))
1687 -> HsTyPats (GhcPass p)
1688 -> LexicalFixity
1689 -> HsContext (GhcPass p)
1690 -> Maybe (LHsKind (GhcPass p))
1691 -> SDoc
1692 pprFamInstLHS thing typats fixity context mb_kind_sig
1693 -- explicit type patterns
1694 = hsep [ pprHsContext context, pp_pats typats, pp_kind_sig ]
1695 where
1696 pp_pats (patl:patsr)
1697 | fixity == Infix
1698 = hsep [pprHsType (unLoc patl), pprInfixOcc (unLoc thing)
1699 , hsep (map (pprHsType.unLoc) patsr)]
1700 | otherwise = hsep [ pprPrefixOcc (unLoc thing)
1701 , hsep (map (pprHsType.unLoc) (patl:patsr))]
1702 pp_pats [] = pprPrefixOcc (unLoc thing)
1703
1704 pp_kind_sig
1705 | Just k <- mb_kind_sig
1706 = dcolon <+> ppr k
1707 | otherwise
1708 = empty
1709
1710 instance (p ~ GhcPass pass, OutputableBndrId p)
1711 => Outputable (ClsInstDecl p) where
1712 ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
1713 , cid_sigs = sigs, cid_tyfam_insts = ats
1714 , cid_overlap_mode = mbOverlap
1715 , cid_datafam_insts = adts })
1716 | null sigs, null ats, null adts, isEmptyBag binds -- No "where" part
1717 = top_matter
1718
1719 | otherwise -- Laid out
1720 = vcat [ top_matter <+> text "where"
1721 , nest 2 $ pprDeclList $
1722 map (pprTyFamInstDecl NotTopLevel . unLoc) ats ++
1723 map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
1724 pprLHsBindsForUser binds sigs ]
1725 where
1726 top_matter = text "instance" <+> ppOverlapPragma mbOverlap
1727 <+> ppr inst_ty
1728 ppr (XClsInstDecl x) = ppr x
1729
1730 ppDerivStrategy :: (p ~ GhcPass pass, OutputableBndrId p)
1731 => Maybe (LDerivStrategy p) -> SDoc
1732 ppDerivStrategy mb =
1733 case mb of
1734 Nothing -> empty
1735 Just (L _ ds) -> ppr ds
1736
1737 ppOverlapPragma :: Maybe (Located OverlapMode) -> SDoc
1738 ppOverlapPragma mb =
1739 case mb of
1740 Nothing -> empty
1741 Just (L _ (NoOverlap s)) -> maybe_stext s "{-# NO_OVERLAP #-}"
1742 Just (L _ (Overlappable s)) -> maybe_stext s "{-# OVERLAPPABLE #-}"
1743 Just (L _ (Overlapping s)) -> maybe_stext s "{-# OVERLAPPING #-}"
1744 Just (L _ (Overlaps s)) -> maybe_stext s "{-# OVERLAPS #-}"
1745 Just (L _ (Incoherent s)) -> maybe_stext s "{-# INCOHERENT #-}"
1746 where
1747 maybe_stext NoSourceText alt = text alt
1748 maybe_stext (SourceText src) _ = text src <+> text "#-}"
1749
1750
1751 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
1752 ppr (ClsInstD { cid_inst = decl }) = ppr decl
1753 ppr (TyFamInstD { tfid_inst = decl }) = ppr decl
1754 ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
1755 ppr (XInstDecl x) = ppr x
1756
1757 -- Extract the declarations of associated data types from an instance
1758
1759 instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]
1760 instDeclDataFamInsts inst_decls
1761 = concatMap do_one inst_decls
1762 where
1763 do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))
1764 = map unLoc fam_insts
1765 do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst]
1766 do_one (L _ (TyFamInstD {})) = []
1767 do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"
1768 do_one (L _ (XInstDecl _)) = panic "instDeclDataFamInsts"
1769
1770 {-
1771 ************************************************************************
1772 * *
1773 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
1774 * *
1775 ************************************************************************
1776 -}
1777
1778 -- | Located Deriving Declaration
1779 type LDerivDecl pass = Located (DerivDecl pass)
1780
1781 -- | Deriving Declaration
1782 data DerivDecl pass = DerivDecl
1783 { deriv_ext :: XCDerivDecl pass
1784 , deriv_type :: LHsSigWcType pass
1785 -- ^ The instance type to derive.
1786 --
1787 -- It uses an 'LHsSigWcType' because the context is allowed to be a
1788 -- single wildcard:
1789 --
1790 -- > deriving instance _ => Eq (Foo a)
1791 --
1792 -- Which signifies that the context should be inferred.
1793
1794 -- See Note [Inferring the instance context] in TcDerivInfer.
1795
1796 , deriv_strategy :: Maybe (LDerivStrategy pass)
1797 , deriv_overlap_mode :: Maybe (Located OverlapMode)
1798 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',
1799 -- 'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',
1800 -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',
1801 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1802
1803 -- For details on above see note [Api annotations] in ApiAnnotation
1804 }
1805 | XDerivDecl (XXDerivDecl pass)
1806
1807 type instance XCDerivDecl (GhcPass _) = NoExt
1808 type instance XXDerivDecl (GhcPass _) = NoExt
1809
1810 instance (p ~ GhcPass pass, OutputableBndrId p)
1811 => Outputable (DerivDecl p) where
1812 ppr (DerivDecl { deriv_type = ty
1813 , deriv_strategy = ds
1814 , deriv_overlap_mode = o })
1815 = hsep [ text "deriving"
1816 , ppDerivStrategy ds
1817 , text "instance"
1818 , ppOverlapPragma o
1819 , ppr ty ]
1820 ppr (XDerivDecl x) = ppr x
1821
1822 {-
1823 ************************************************************************
1824 * *
1825 Deriving strategies
1826 * *
1827 ************************************************************************
1828 -}
1829
1830 -- | A 'Located' 'DerivStrategy'.
1831 type LDerivStrategy pass = Located (DerivStrategy pass)
1832
1833 -- | Which technique the user explicitly requested when deriving an instance.
1834 data DerivStrategy pass
1835 -- See Note [Deriving strategies] in TcDeriv
1836 = StockStrategy -- ^ GHC's \"standard\" strategy, which is to implement a
1837 -- custom instance for the data type. This only works
1838 -- for certain types that GHC knows about (e.g., 'Eq',
1839 -- 'Show', 'Functor' when @-XDeriveFunctor@ is enabled,
1840 -- etc.)
1841 | AnyclassStrategy -- ^ @-XDeriveAnyClass@
1842 | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@
1843 | ViaStrategy (XViaStrategy pass)
1844 -- ^ @-XDerivingVia@
1845
1846 type instance XViaStrategy GhcPs = LHsSigType GhcPs
1847 type instance XViaStrategy GhcRn = LHsSigType GhcRn
1848 type instance XViaStrategy GhcTc = Type
1849
1850 instance (p ~ GhcPass pass, OutputableBndrId p)
1851 => Outputable (DerivStrategy p) where
1852 ppr StockStrategy = text "stock"
1853 ppr AnyclassStrategy = text "anyclass"
1854 ppr NewtypeStrategy = text "newtype"
1855 ppr (ViaStrategy ty) = text "via" <+> ppr ty
1856
1857 -- | A short description of a @DerivStrategy'@.
1858 derivStrategyName :: DerivStrategy a -> SDoc
1859 derivStrategyName = text . go
1860 where
1861 go StockStrategy = "stock"
1862 go AnyclassStrategy = "anyclass"
1863 go NewtypeStrategy = "newtype"
1864 go (ViaStrategy {}) = "via"
1865
1866 {-
1867 ************************************************************************
1868 * *
1869 \subsection[DefaultDecl]{A @default@ declaration}
1870 * *
1871 ************************************************************************
1872
1873 There can only be one default declaration per module, but it is hard
1874 for the parser to check that; we pass them all through in the abstract
1875 syntax, and that restriction must be checked in the front end.
1876 -}
1877
1878 -- | Located Default Declaration
1879 type LDefaultDecl pass = Located (DefaultDecl pass)
1880
1881 -- | Default Declaration
1882 data DefaultDecl pass
1883 = DefaultDecl (XCDefaultDecl pass) [LHsType pass]
1884 -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
1885 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
1886
1887 -- For details on above see note [Api annotations] in ApiAnnotation
1888 | XDefaultDecl (XXDefaultDecl pass)
1889
1890 type instance XCDefaultDecl (GhcPass _) = NoExt
1891 type instance XXDefaultDecl (GhcPass _) = NoExt
1892
1893 instance (p ~ GhcPass pass, OutputableBndrId p)
1894 => Outputable (DefaultDecl p) where
1895 ppr (DefaultDecl _ tys)
1896 = text "default" <+> parens (interpp'SP tys)
1897 ppr (XDefaultDecl x) = ppr x
1898
1899 {-
1900 ************************************************************************
1901 * *
1902 \subsection{Foreign function interface declaration}
1903 * *
1904 ************************************************************************
1905 -}
1906
1907 -- foreign declarations are distinguished as to whether they define or use a
1908 -- Haskell name
1909 --
1910 -- * the Boolean value indicates whether the pre-standard deprecated syntax
1911 -- has been used
1912
1913 -- | Located Foreign Declaration
1914 type LForeignDecl pass = Located (ForeignDecl pass)
1915
1916 -- | Foreign Declaration
1917 data ForeignDecl pass
1918 = ForeignImport
1919 { fd_i_ext :: XForeignImport pass -- Post typechecker, rep_ty ~ sig_ty
1920 , fd_name :: Located (IdP pass) -- defines this name
1921 , fd_sig_ty :: LHsSigType pass -- sig_ty
1922 , fd_fi :: ForeignImport }
1923
1924 | ForeignExport
1925 { fd_e_ext :: XForeignExport pass -- Post typechecker, rep_ty ~ sig_ty
1926 , fd_name :: Located (IdP pass) -- uses this name
1927 , fd_sig_ty :: LHsSigType pass -- sig_ty
1928 , fd_fe :: ForeignExport }
1929 -- ^
1930 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
1931 -- 'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport',
1932 -- 'ApiAnnotation.AnnDcolon'
1933
1934 -- For details on above see note [Api annotations] in ApiAnnotation
1935 | XForeignDecl (XXForeignDecl pass)
1936
1937 {-
1938 In both ForeignImport and ForeignExport:
1939 sig_ty is the type given in the Haskell code
1940 rep_ty is the representation for this type, i.e. with newtypes
1941 coerced away and type functions evaluated.
1942 Thus if the declaration is valid, then rep_ty will only use types
1943 such as Int and IO that we know how to make foreign calls with.
1944 -}
1945
1946 type instance XForeignImport GhcPs = NoExt
1947 type instance XForeignImport GhcRn = NoExt
1948 type instance XForeignImport GhcTc = Coercion
1949
1950 type instance XForeignExport GhcPs = NoExt
1951 type instance XForeignExport GhcRn = NoExt
1952 type instance XForeignExport GhcTc = Coercion
1953
1954 type instance XXForeignDecl (GhcPass _) = NoExt
1955
1956 -- Specification Of an imported external entity in dependence on the calling
1957 -- convention
1958 --
1959 data ForeignImport = -- import of a C entity
1960 --
1961 -- * the two strings specifying a header file or library
1962 -- may be empty, which indicates the absence of a
1963 -- header or object specification (both are not used
1964 -- in the case of `CWrapper' and when `CFunction'
1965 -- has a dynamic target)
1966 --
1967 -- * the calling convention is irrelevant for code
1968 -- generation in the case of `CLabel', but is needed
1969 -- for pretty printing
1970 --
1971 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
1972 --
1973 CImport (Located CCallConv) -- ccall or stdcall
1974 (Located Safety) -- interruptible, safe or unsafe
1975 (Maybe Header) -- name of C header
1976 CImportSpec -- details of the C entity
1977 (Located SourceText) -- original source text for
1978 -- the C entity
1979 deriving Data
1980
1981 -- details of an external C entity
1982 --
1983 data CImportSpec = CLabel CLabelString -- import address of a C label
1984 | CFunction CCallTarget -- static or dynamic function
1985 | CWrapper -- wrapper to expose closures
1986 -- (former f.e.d.)
1987 deriving Data
1988
1989 -- specification of an externally exported entity in dependence on the calling
1990 -- convention
1991 --
1992 data ForeignExport = CExport (Located CExportSpec) -- contains the calling
1993 -- convention
1994 (Located SourceText) -- original source text for
1995 -- the C entity
1996 deriving Data
1997
1998 -- pretty printing of foreign declarations
1999 --
2000
2001 instance (p ~ GhcPass pass, OutputableBndrId p)
2002 => Outputable (ForeignDecl p) where
2003 ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
2004 = hang (text "foreign import" <+> ppr fimport <+> ppr n)
2005 2 (dcolon <+> ppr ty)
2006 ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
2007 hang (text "foreign export" <+> ppr fexport <+> ppr n)
2008 2 (dcolon <+> ppr ty)
2009 ppr (XForeignDecl x) = ppr x
2010
2011 instance Outputable ForeignImport where
2012 ppr (CImport cconv safety mHeader spec (L _ srcText)) =
2013 ppr cconv <+> ppr safety
2014 <+> pprWithSourceText srcText (pprCEntity spec "")
2015 where
2016 pp_hdr = case mHeader of
2017 Nothing -> empty
2018 Just (Header _ header) -> ftext header
2019
2020 pprCEntity (CLabel lbl) _ =
2021 doubleQuotes $ text "static" <+> pp_hdr <+> char '&' <> ppr lbl
2022 pprCEntity (CFunction (StaticTarget st _lbl _ isFun)) src =
2023 if dqNeeded then doubleQuotes ce else empty
2024 where
2025 dqNeeded = (take 6 src == "static")
2026 || isJust mHeader
2027 || not isFun
2028 || st /= NoSourceText
2029 ce =
2030 -- We may need to drop leading spaces first
2031 (if take 6 src == "static" then text "static" else empty)
2032 <+> pp_hdr
2033 <+> (if isFun then empty else text "value")
2034 <+> (pprWithSourceText st empty)
2035 pprCEntity (CFunction DynamicTarget) _ =
2036 doubleQuotes $ text "dynamic"
2037 pprCEntity CWrapper _ = doubleQuotes $ text "wrapper"
2038
2039 instance Outputable ForeignExport where
2040 ppr (CExport (L _ (CExportStatic _ lbl cconv)) _) =
2041 ppr cconv <+> char '"' <> ppr lbl <> char '"'
2042
2043 {-
2044 ************************************************************************
2045 * *
2046 \subsection{Transformation rules}
2047 * *
2048 ************************************************************************
2049 -}
2050
2051 -- | Located Rule Declarations
2052 type LRuleDecls pass = Located (RuleDecls pass)
2053
2054 -- Note [Pragma source text] in BasicTypes
2055 -- | Rule Declarations
2056 data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass
2057 , rds_src :: SourceText
2058 , rds_rules :: [LRuleDecl pass] }
2059 | XRuleDecls (XXRuleDecls pass)
2060
2061 type instance XCRuleDecls (GhcPass _) = NoExt
2062 type instance XXRuleDecls (GhcPass _) = NoExt
2063
2064 -- | Located Rule Declaration
2065 type LRuleDecl pass = Located (RuleDecl pass)
2066
2067 -- | Rule Declaration
2068 data RuleDecl pass
2069 = HsRule -- Source rule
2070 (XHsRule pass) -- After renamer, free-vars from the LHS and RHS
2071 (Located (SourceText,RuleName)) -- Rule name
2072 -- Note [Pragma source text] in BasicTypes
2073 Activation
2074 [LRuleBndr pass] -- Forall'd vars; after typechecking this
2075 -- includes tyvars
2076 (Located (HsExpr pass)) -- LHS
2077 (Located (HsExpr pass)) -- RHS
2078 -- ^
2079 -- - 'ApiAnnotation.AnnKeywordId' :
2080 -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
2081 -- 'ApiAnnotation.AnnVal',
2082 -- 'ApiAnnotation.AnnClose',
2083 -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot',
2084 -- 'ApiAnnotation.AnnEqual',
2085
2086 -- For details on above see note [Api annotations] in ApiAnnotation
2087 | XRuleDecl (XXRuleDecl pass)
2088
2089 data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
2090 deriving Data
2091
2092 type instance XHsRule GhcPs = NoExt
2093 type instance XHsRule GhcRn = HsRuleRn
2094 type instance XHsRule GhcTc = HsRuleRn
2095
2096 type instance XXRuleDecl (GhcPass _) = NoExt
2097
2098 flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
2099 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
2100
2101 -- | Located Rule Binder
2102 type LRuleBndr pass = Located (RuleBndr pass)
2103
2104 -- | Rule Binder
2105 data RuleBndr pass
2106 = RuleBndr (XCRuleBndr pass) (Located (IdP pass))
2107 | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)
2108 | XRuleBndr (XXRuleBndr pass)
2109 -- ^
2110 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
2111 -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
2112
2113 -- For details on above see note [Api annotations] in ApiAnnotation
2114
2115 type instance XCRuleBndr (GhcPass _) = NoExt
2116 type instance XRuleBndrSig (GhcPass _) = NoExt
2117 type instance XXRuleBndr (GhcPass _) = NoExt
2118
2119 collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
2120 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
2121
2122 pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
2123 pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
2124
2125 instance (p ~ GhcPass pass, OutputableBndrId p)
2126 => Outputable (RuleDecls p) where
2127 ppr (HsRules _ st rules)
2128 = pprWithSourceText st (text "{-# RULES")
2129 <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
2130 ppr (XRuleDecls x) = ppr x
2131
2132 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
2133 ppr (HsRule _ name act ns lhs rhs)
2134 = sep [pprFullRuleName name <+> ppr act,
2135 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
2136 nest 6 (equals <+> pprExpr (unLoc rhs)) ]
2137 where
2138 pp_forall | null ns = empty
2139 | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
2140 ppr (XRuleDecl x) = ppr x
2141
2142 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
2143 ppr (RuleBndr _ name) = ppr name
2144 ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)
2145 ppr (XRuleBndr x) = ppr x
2146
2147 {-
2148 ************************************************************************
2149 * *
2150 \subsection[DocDecl]{Document comments}
2151 * *
2152 ************************************************************************
2153 -}
2154
2155 -- | Located Documentation comment Declaration
2156 type LDocDecl = Located (DocDecl)
2157
2158 -- | Documentation comment Declaration
2159 data DocDecl
2160 = DocCommentNext HsDocString
2161 | DocCommentPrev HsDocString
2162 | DocCommentNamed String HsDocString
2163 | DocGroup Int HsDocString
2164 deriving Data
2165
2166 -- Okay, I need to reconstruct the document comments, but for now:
2167 instance Outputable DocDecl where
2168 ppr _ = text "<document comment>"
2169
2170 docDeclDoc :: DocDecl -> HsDocString
2171 docDeclDoc (DocCommentNext d) = d
2172 docDeclDoc (DocCommentPrev d) = d
2173 docDeclDoc (DocCommentNamed _ d) = d
2174 docDeclDoc (DocGroup _ d) = d
2175
2176 {-
2177 ************************************************************************
2178 * *
2179 \subsection[DeprecDecl]{Deprecations}
2180 * *
2181 ************************************************************************
2182
2183 We use exported entities for things to deprecate.
2184 -}
2185
2186 -- | Located Warning Declarations
2187 type LWarnDecls pass = Located (WarnDecls pass)
2188
2189 -- Note [Pragma source text] in BasicTypes
2190 -- | Warning pragma Declarations
2191 data WarnDecls pass = Warnings { wd_ext :: XWarnings pass
2192 , wd_src :: SourceText
2193 , wd_warnings :: [LWarnDecl pass]
2194 }
2195 | XWarnDecls (XXWarnDecls pass)
2196
2197 type instance XWarnings (GhcPass _) = NoExt
2198 type instance XXWarnDecls (GhcPass _) = NoExt
2199
2200 -- | Located Warning pragma Declaration
2201 type LWarnDecl pass = Located (WarnDecl pass)
2202
2203 -- | Warning pragma Declaration
2204 data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt
2205 | XWarnDecl (XXWarnDecl pass)
2206
2207 type instance XWarning (GhcPass _) = NoExt
2208 type instance XXWarnDecl (GhcPass _) = NoExt
2209
2210
2211 instance (p ~ GhcPass pass,OutputableBndr (IdP p))
2212 => Outputable (WarnDecls p) where
2213 ppr (Warnings _ (SourceText src) decls)
2214 = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
2215 ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"
2216 ppr (XWarnDecls x) = ppr x
2217
2218 instance (p ~ GhcPass pass, OutputableBndr (IdP p))
2219 => Outputable (WarnDecl p) where
2220 ppr (Warning _ thing txt)
2221 = hsep ( punctuate comma (map ppr thing))
2222 <+> ppr txt
2223 ppr (XWarnDecl x) = ppr x
2224
2225 {-
2226 ************************************************************************
2227 * *
2228 \subsection[AnnDecl]{Annotations}
2229 * *
2230 ************************************************************************
2231 -}
2232
2233 -- | Located Annotation Declaration
2234 type LAnnDecl pass = Located (AnnDecl pass)
2235
2236 -- | Annotation Declaration
2237 data AnnDecl pass = HsAnnotation
2238 (XHsAnnotation pass)
2239 SourceText -- Note [Pragma source text] in BasicTypes
2240 (AnnProvenance (IdP pass)) (Located (HsExpr pass))
2241 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
2242 -- 'ApiAnnotation.AnnType'
2243 -- 'ApiAnnotation.AnnModule'
2244 -- 'ApiAnnotation.AnnClose'
2245
2246 -- For details on above see note [Api annotations] in ApiAnnotation
2247 | XAnnDecl (XXAnnDecl pass)
2248
2249 type instance XHsAnnotation (GhcPass _) = NoExt
2250 type instance XXAnnDecl (GhcPass _) = NoExt
2251
2252 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
2253 ppr (HsAnnotation _ _ provenance expr)
2254 = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
2255 ppr (XAnnDecl x) = ppr x
2256
2257 -- | Annotation Provenance
2258 data AnnProvenance name = ValueAnnProvenance (Located name)
2259 | TypeAnnProvenance (Located name)
2260 | ModuleAnnProvenance
2261 deriving instance Functor AnnProvenance
2262 deriving instance Foldable AnnProvenance
2263 deriving instance Traversable AnnProvenance
2264 deriving instance (Data pass) => Data (AnnProvenance pass)
2265
2266 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
2267 annProvenanceName_maybe (ValueAnnProvenance (L _ name)) = Just name
2268 annProvenanceName_maybe (TypeAnnProvenance (L _ name)) = Just name
2269 annProvenanceName_maybe ModuleAnnProvenance = Nothing
2270
2271 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
2272 pprAnnProvenance ModuleAnnProvenance = text "ANN module"
2273 pprAnnProvenance (ValueAnnProvenance (L _ name))
2274 = text "ANN" <+> ppr name
2275 pprAnnProvenance (TypeAnnProvenance (L _ name))
2276 = text "ANN type" <+> ppr name
2277
2278 {-
2279 ************************************************************************
2280 * *
2281 \subsection[RoleAnnot]{Role annotations}
2282 * *
2283 ************************************************************************
2284 -}
2285
2286 -- | Located Role Annotation Declaration
2287 type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)
2288
2289 -- See #8185 for more info about why role annotations are
2290 -- top-level declarations
2291 -- | Role Annotation Declaration
2292 data RoleAnnotDecl pass
2293 = RoleAnnotDecl (XCRoleAnnotDecl pass)
2294 (Located (IdP pass)) -- type constructor
2295 [Located (Maybe Role)] -- optional annotations
2296 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
2297 -- 'ApiAnnotation.AnnRole'
2298
2299 -- For details on above see note [Api annotations] in ApiAnnotation
2300 | XRoleAnnotDecl (XXRoleAnnotDecl pass)
2301
2302 type instance XCRoleAnnotDecl (GhcPass _) = NoExt
2303 type instance XXRoleAnnotDecl (GhcPass _) = NoExt
2304
2305 instance (p ~ GhcPass pass, OutputableBndr (IdP p))
2306 => Outputable (RoleAnnotDecl p) where
2307 ppr (RoleAnnotDecl _ ltycon roles)
2308 = text "type role" <+> ppr ltycon <+>
2309 hsep (map (pp_role . unLoc) roles)
2310 where
2311 pp_role Nothing = underscore
2312 pp_role (Just r) = ppr r
2313 ppr (XRoleAnnotDecl x) = ppr x
2314
2315 roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
2316 roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name
2317 roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"