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