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