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