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