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