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