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