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