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