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