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