TTG3 Combined Step 1 and 3 for Trees That Grow
[ghc.git] / compiler / hsSyn / HsExtension.hs
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE FunctionalDependencies #-}
6 {-# LANGUAGE MultiParamTypeClasses #-}
7 {-# LANGUAGE TypeFamilies #-}
8 {-# LANGUAGE DataKinds #-}
9 {-# LANGUAGE StandaloneDeriving #-}
10 {-# LANGUAGE PatternSynonyms #-}
11 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
12 -- in module PlaceHolder
13
14 module HsExtension where
15
16 -- This module captures the type families to precisely identify the extension
17 -- points for HsSyn
18
19 import GhcPrelude
20
21 import GHC.Exts (Constraint)
22 import Data.Data hiding ( Fixity )
23 import PlaceHolder
24 import BasicTypes
25 import ConLike
26 import NameSet
27 import Name
28 import RdrName
29 import Var
30 import Type ( Type )
31 import Outputable
32 import SrcLoc (Located)
33 import Coercion
34 import TcEvidence
35
36 {-
37 Note [Trees that grow]
38 ~~~~~~~~~~~~~~~~~~~~~~
39
40 See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
41
42 The hsSyn AST is reused across multiple compiler passes. We also have the
43 Template Haskell AST, and the haskell-src-exts one (outside of GHC)
44
45 Supporting multiple passes means the AST has various warts on it to cope with
46 the specifics for the phases, such as the 'ValBindsOut', 'ConPatOut',
47 'SigPatOut' etc.
48
49 The growable AST will allow each of these variants to be captured explicitly,
50 such that they only exist in the given compiler pass AST, as selected by the
51 type parameter to the AST.
52
53 In addition it will allow tool writers to define their own extensions to capture
54 additional information for the tool, in a natural way.
55
56 A further goal is to provide a means to harmonise the Template Haskell and
57 haskell-src-exts ASTs as well.
58
59 -}
60
61 -- | Used when constructing a term with an unused extension point.
62 noExt :: PlaceHolder
63 noExt = PlaceHolder
64
65 -- | Used as a data type index for the hsSyn AST
66 data GhcPass (c :: Pass)
67 deriving instance Eq (GhcPass c)
68 deriving instance Typeable c => Data (GhcPass c)
69
70 data Pass = Parsed | Renamed | Typechecked
71 deriving (Data)
72
73 -- Type synonyms as a shorthand for tagging
74 type GhcPs = GhcPass 'Parsed -- Old 'RdrName' type param
75 type GhcRn = GhcPass 'Renamed -- Old 'Name' type param
76 type GhcTc = GhcPass 'Typechecked -- Old 'Id' type para,
77 type GhcTcId = GhcTc -- Old 'TcId' type param
78
79
80 -- | Types that are not defined until after type checking
81 type family PostTc x ty -- Note [Pass sensitive types] in PlaceHolder
82 type instance PostTc GhcPs ty = PlaceHolder
83 type instance PostTc GhcRn ty = PlaceHolder
84 type instance PostTc GhcTc ty = ty
85
86 -- deriving instance (Data ty) => Data (PostTc (GhcPass 'Parsed) ty)
87
88 -- | Types that are not defined until after renaming
89 type family PostRn x ty -- Note [Pass sensitive types] in PlaceHolder
90 type instance PostRn GhcPs ty = PlaceHolder
91 type instance PostRn GhcRn ty = ty
92 type instance PostRn GhcTc ty = ty
93
94 -- | Maps the "normal" id type for a given pass
95 type family IdP p
96 type instance IdP GhcPs = RdrName
97 type instance IdP GhcRn = Name
98 type instance IdP GhcTc = Id
99 -- type instance IdP (GHC x) = IdP x
100
101 type LIdP p = Located (IdP p)
102
103 -- ---------------------------------------------------------------------
104 -- type families for the Pat extension points
105 type family XWildPat x
106 type family XVarPat x
107 type family XLazyPat x
108 type family XAsPat x
109 type family XParPat x
110 type family XBangPat x
111 type family XListPat x
112 type family XTuplePat x
113 type family XSumPat x
114 type family XPArrPat x
115 type family XConPat x
116 type family XViewPat x
117 type family XSplicePat x
118 type family XLitPat x
119 type family XNPat x
120 type family XNPlusKPat x
121 type family XSigPat x
122 type family XCoPat x
123 type family XXPat x
124
125
126 type ForallXPat (c :: * -> Constraint) (x :: *) =
127 ( c (XWildPat x)
128 , c (XVarPat x)
129 , c (XLazyPat x)
130 , c (XAsPat x)
131 , c (XParPat x)
132 , c (XBangPat x)
133 , c (XListPat x)
134 , c (XTuplePat x)
135 , c (XSumPat x)
136 , c (XPArrPat x)
137 , c (XViewPat x)
138 , c (XSplicePat x)
139 , c (XLitPat x)
140 , c (XNPat x)
141 , c (XNPlusKPat x)
142 , c (XSigPat x)
143 , c (XCoPat x)
144 , c (XXPat x)
145 )
146 -- ---------------------------------------------------------------------
147 -- ValBindsLR type families
148
149 type family XValBinds x x'
150 type family XXValBindsLR x x'
151
152 type ForallXValBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =
153 ( c (XValBinds x x')
154 , c (XXValBindsLR x x')
155 )
156
157 -- We define a type family for each HsLit extension point. This is based on
158 -- prepending 'X' to the constructor name, for ease of reference.
159 type family XHsChar x
160 type family XHsCharPrim x
161 type family XHsString x
162 type family XHsStringPrim x
163 type family XHsInt x
164 type family XHsIntPrim x
165 type family XHsWordPrim x
166 type family XHsInt64Prim x
167 type family XHsWord64Prim x
168 type family XHsInteger x
169 type family XHsRat x
170 type family XHsFloatPrim x
171 type family XHsDoublePrim x
172 type family XXLit x
173
174 -- | Helper to apply a constraint to all HsLit extension points. It has one
175 -- entry per extension point type family.
176 type ForallXHsLit (c :: * -> Constraint) (x :: *) =
177 ( c (XHsChar x)
178 , c (XHsCharPrim x)
179 , c (XHsString x)
180 , c (XHsStringPrim x)
181 , c (XHsInt x)
182 , c (XHsIntPrim x)
183 , c (XHsWordPrim x)
184 , c (XHsInt64Prim x)
185 , c (XHsWord64Prim x)
186 , c (XHsInteger x)
187 , c (XHsRat x)
188 , c (XHsFloatPrim x)
189 , c (XHsDoublePrim x)
190 , c (XXLit x)
191 )
192
193
194 type family XOverLit x
195 type family XXOverLit x
196
197 type ForallXOverLit (c :: * -> Constraint) (x :: *) =
198 ( c (XOverLit x)
199 , c (XXOverLit x)
200 )
201
202 -- ---------------------------------------------------------------------
203 -- Type families for the Type type families
204
205 type family XForAllTy x
206 type family XQualTy x
207 type family XTyVar x
208 type family XAppsTy x
209 type family XAppTy x
210 type family XFunTy x
211 type family XListTy x
212 type family XPArrTy x
213 type family XTupleTy x
214 type family XSumTy x
215 type family XOpTy x
216 type family XParTy x
217 type family XIParamTy x
218 type family XEqTy x
219 type family XKindSig x
220 type family XSpliceTy x
221 type family XDocTy x
222 type family XBangTy x
223 type family XRecTy x
224 type family XExplicitListTy x
225 type family XExplicitTupleTy x
226 type family XTyLit x
227 type family XWildCardTy x
228 type family XXType x
229
230 -- | Helper to apply a constraint to all extension points. It has one
231 -- entry per extension point type family.
232 type ForallXType (c :: * -> Constraint) (x :: *) =
233 ( c (XForAllTy x)
234 , c (XQualTy x)
235 , c (XTyVar x)
236 , c (XAppsTy x)
237 , c (XAppTy x)
238 , c (XFunTy x)
239 , c (XListTy x)
240 , c (XPArrTy x)
241 , c (XTupleTy x)
242 , c (XSumTy x)
243 , c (XOpTy x)
244 , c (XParTy x)
245 , c (XIParamTy x)
246 , c (XEqTy x)
247 , c (XKindSig x)
248 , c (XSpliceTy x)
249 , c (XDocTy x)
250 , c (XBangTy x)
251 , c (XRecTy x)
252 , c (XExplicitListTy x)
253 , c (XExplicitTupleTy x)
254 , c (XTyLit x)
255 , c (XWildCardTy x)
256 , c (XXType x)
257 )
258
259 -- ---------------------------------------------------------------------
260
261 type family XUserTyVar x
262 type family XKindedTyVar x
263 type family XXTyVarBndr x
264
265 type ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =
266 ( c (XUserTyVar x)
267 , c (XKindedTyVar x)
268 , c (XXTyVarBndr x)
269 )
270
271 -- ---------------------------------------------------------------------
272
273 type family XAppInfix x
274 type family XAppPrefix x
275 type family XXAppType x
276
277 type ForallXAppType (c :: * -> Constraint) (x :: *) =
278 ( c (XAppInfix x)
279 , c (XAppPrefix x)
280 , c (XXAppType x)
281 )
282
283 -- ---------------------------------------------------------------------
284
285 type family XFieldOcc x
286 type family XXFieldOcc x
287
288 type ForallXFieldOcc (c :: * -> Constraint) (x :: *) =
289 ( c (XFieldOcc x)
290 , c (XXFieldOcc x)
291 )
292
293 -- ---------------------------------------------------------------------
294
295 type family XUnambiguous x
296 type family XAmbiguous x
297 type family XXAmbiguousFieldOcc x
298
299 type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =
300 ( c (XUnambiguous x)
301 , c (XAmbiguous x)
302 , c (XXAmbiguousFieldOcc x)
303 )
304
305 -- ---------------------------------------------------------------------
306 -- Type families for the HsExpr type families
307
308 type family XVar x
309 type family XUnboundVar x
310 type family XConLikeOut x
311 type family XRecFld x
312 type family XOverLabel x
313 type family XIPVar x
314 type family XOverLitE x
315 type family XLitE x
316 type family XLam x
317 type family XLamCase x
318 type family XApp x
319 type family XAppTypeE x
320 type family XOpApp x
321 type family XNegApp x
322 type family XPar x
323 type family XSectionL x
324 type family XSectionR x
325 type family XExplicitTuple x
326 type family XExplicitSum x
327 type family XCase x
328 type family XIf x
329 type family XMultiIf x
330 type family XLet x
331 type family XDo x
332 type family XExplicitList x
333 type family XExplicitPArr x
334 type family XRecordCon x
335 type family XRecordUpd x
336 type family XExprWithTySig x
337 type family XArithSeq x
338 type family XPArrSeq x
339 type family XSCC x
340 type family XCoreAnn x
341 type family XBracket x
342 type family XRnBracketOut x
343 type family XTcBracketOut x
344 type family XSpliceE x
345 type family XProc x
346 type family XStatic x
347 type family XArrApp x
348 type family XArrForm x
349 type family XTick x
350 type family XBinTick x
351 type family XTickPragma x
352 type family XEWildPat x
353 type family XEAsPat x
354 type family XEViewPat x
355 type family XELazyPat x
356 type family XWrap x
357 type family XXExpr x
358
359 type ForallXExpr (c :: * -> Constraint) (x :: *) =
360 ( c (XVar x)
361 , c (XUnboundVar x)
362 , c (XConLikeOut x)
363 , c (XRecFld x)
364 , c (XOverLabel x)
365 , c (XIPVar x)
366 , c (XOverLitE x)
367 , c (XLitE x)
368 , c (XLam x)
369 , c (XLamCase x)
370 , c (XApp x)
371 , c (XAppTypeE x)
372 , c (XOpApp x)
373 , c (XNegApp x)
374 , c (XPar x)
375 , c (XSectionL x)
376 , c (XSectionR x)
377 , c (XExplicitTuple x)
378 , c (XExplicitSum x)
379 , c (XCase x)
380 , c (XIf x)
381 , c (XMultiIf x)
382 , c (XLet x)
383 , c (XDo x)
384 , c (XExplicitList x)
385 , c (XExplicitPArr x)
386 , c (XRecordCon x)
387 , c (XRecordUpd x)
388 , c (XExprWithTySig x)
389 , c (XArithSeq x)
390 , c (XPArrSeq x)
391 , c (XSCC x)
392 , c (XCoreAnn x)
393 , c (XBracket x)
394 , c (XRnBracketOut x)
395 , c (XTcBracketOut x)
396 , c (XSpliceE x)
397 , c (XProc x)
398 , c (XStatic x)
399 , c (XArrApp x)
400 , c (XArrForm x)
401 , c (XTick x)
402 , c (XBinTick x)
403 , c (XTickPragma x)
404 , c (XEWildPat x)
405 , c (XEAsPat x)
406 , c (XEViewPat x)
407 , c (XELazyPat x)
408 , c (XWrap x)
409 , c (XXExpr x)
410 )
411 -- ---------------------------------------------------------------------
412
413 type family XPresent x
414 type family XMissing x
415 type family XXTupArg x
416
417 type ForallXTupArg (c :: * -> Constraint) (x :: *) =
418 ( c (XPresent x)
419 , c (XMissing x)
420 , c (XXTupArg x)
421 )
422
423 -- ---------------------------------------------------------------------
424
425 type family XTypedSplice x
426 type family XUntypedSplice x
427 type family XQuasiQuote x
428 type family XSpliced x
429 type family XXSplice x
430
431 type ForallXSplice (c :: * -> Constraint) (x :: *) =
432 ( c (XTypedSplice x)
433 , c (XUntypedSplice x)
434 , c (XQuasiQuote x)
435 , c (XSpliced x)
436 , c (XXSplice x)
437 )
438
439 -- ---------------------------------------------------------------------
440
441 type family XExpBr x
442 type family XPatBr x
443 type family XDecBrL x
444 type family XDecBrG x
445 type family XTypBr x
446 type family XVarBr x
447 type family XTExpBr x
448 type family XXBracket x
449
450 type ForallXBracket (c :: * -> Constraint) (x :: *) =
451 ( c (XExpBr x)
452 , c (XPatBr x)
453 , c (XDecBrL x)
454 , c (XDecBrG x)
455 , c (XTypBr x)
456 , c (XVarBr x)
457 , c (XTExpBr x)
458 , c (XXBracket x)
459 )
460
461 -- ---------------------------------------------------------------------
462
463 type family XCmdTop x
464 type family XXCmdTop x
465
466 type ForallXCmdTop (c :: * -> Constraint) (x :: *) =
467 ( c (XCmdTop x)
468 , c (XXCmdTop x)
469 )
470
471 -- ---------------------------------------------------------------------
472
473 type family XCmdArrApp x
474 type family XCmdArrForm x
475 type family XCmdApp x
476 type family XCmdLam x
477 type family XCmdPar x
478 type family XCmdCase x
479 type family XCmdIf x
480 type family XCmdLet x
481 type family XCmdDo x
482 type family XCmdWrap x
483 type family XXCmd x
484
485 type ForallXCmd (c :: * -> Constraint) (x :: *) =
486 ( c (XCmdArrApp x)
487 , c (XCmdArrForm x)
488 , c (XCmdApp x)
489 , c (XCmdLam x)
490 , c (XCmdPar x)
491 , c (XCmdCase x)
492 , c (XCmdIf x)
493 , c (XCmdLet x)
494 , c (XCmdDo x)
495 , c (XCmdWrap x)
496 , c (XXCmd x)
497 )
498
499 -- ---------------------------------------------------------------------
500
501 type family XParStmtBlock x x'
502 type family XXParStmtBlock x x'
503
504 type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =
505 ( c (XParStmtBlock x x')
506 , c (XXParStmtBlock x x')
507 )
508
509 -- ---------------------------------------------------------------------
510
511 -- | The 'SourceText' fields have been moved into the extension fields, thus
512 -- placing a requirement in the extension field to contain a 'SourceText' so
513 -- that the pretty printing and round tripping of source can continue to
514 -- operate.
515 --
516 -- The 'HasSourceText' class captures this requirement for the relevant fields.
517 class HasSourceText a where
518 -- Provide setters to mimic existing constructors
519 noSourceText :: a
520 sourceText :: String -> a
521
522 setSourceText :: SourceText -> a
523 getSourceText :: a -> SourceText
524
525 -- | Provide a summary constraint that lists all the extension points requiring
526 -- the 'HasSourceText' class, so that it can be changed in one place as the
527 -- named extensions change throughout the AST.
528 type SourceTextX x =
529 ( HasSourceText (XHsChar x)
530 , HasSourceText (XHsCharPrim x)
531 , HasSourceText (XHsString x)
532 , HasSourceText (XHsStringPrim x)
533 , HasSourceText (XHsIntPrim x)
534 , HasSourceText (XHsWordPrim x)
535 , HasSourceText (XHsInt64Prim x)
536 , HasSourceText (XHsWord64Prim x)
537 , HasSourceText (XHsInteger x)
538 )
539
540
541 -- | 'SourceText' trivially implements 'HasSourceText'
542 instance HasSourceText SourceText where
543 noSourceText = NoSourceText
544 sourceText s = SourceText s
545
546 setSourceText s = s
547 getSourceText a = a
548
549
550 -- ----------------------------------------------------------------------
551 -- | Conversion of annotations from one type index to another. This is required
552 -- where the AST is converted from one pass to another, and the extension values
553 -- need to be brought along if possible. So for example a 'SourceText' is
554 -- converted via 'id', but needs a type signature to keep the type checker
555 -- happy.
556 class Convertable a b | a -> b where
557 convert :: a -> b
558
559 instance Convertable a a where
560 convert = id
561
562 -- | A constraint capturing all the extension points that can be converted via
563 -- @instance Convertable a a@
564 type ConvertIdX a b =
565 (XHsDoublePrim a ~ XHsDoublePrim b,
566 XHsFloatPrim a ~ XHsFloatPrim b,
567 XHsRat a ~ XHsRat b,
568 XHsInteger a ~ XHsInteger b,
569 XHsWord64Prim a ~ XHsWord64Prim b,
570 XHsInt64Prim a ~ XHsInt64Prim b,
571 XHsWordPrim a ~ XHsWordPrim b,
572 XHsIntPrim a ~ XHsIntPrim b,
573 XHsInt a ~ XHsInt b,
574 XHsStringPrim a ~ XHsStringPrim b,
575 XHsString a ~ XHsString b,
576 XHsCharPrim a ~ XHsCharPrim b,
577 XHsChar a ~ XHsChar b,
578 XXLit a ~ XXLit b)
579
580 -- ----------------------------------------------------------------------
581
582 -- | Provide a summary constraint that gives all am Outputable constraint to
583 -- extension points needing one
584 type OutputableX p =
585 ( Outputable (XXPat p)
586 , Outputable (XXPat GhcRn)
587
588 , Outputable (XSigPat p)
589 , Outputable (XSigPat GhcRn)
590
591 , Outputable (XXLit p)
592
593 , Outputable (XXOverLit p)
594
595 , Outputable (XXType p)
596
597 , Outputable (XExprWithTySig p)
598 , Outputable (XExprWithTySig GhcRn)
599
600 , Outputable (XAppTypeE p)
601 , Outputable (XAppTypeE GhcRn)
602
603 -- , Outputable (XXParStmtBlock (GhcPass idL) idR)
604 )
605 -- TODO: Should OutputableX be included in OutputableBndrId?
606
607 -- ----------------------------------------------------------------------
608
609 --
610 type DataId p =
611 ( Data p
612
613 , ForallXHsLit Data p
614 , ForallXPat Data p
615
616 -- Th following GhcRn constraints should go away once TTG is fully implemented
617 , ForallXPat Data GhcRn
618 , ForallXType Data GhcRn
619 , ForallXExpr Data GhcRn
620 , ForallXTupArg Data GhcRn
621 , ForallXSplice Data GhcRn
622 , ForallXBracket Data GhcRn
623 , ForallXCmdTop Data GhcRn
624 , ForallXCmd Data GhcRn
625
626 , ForallXOverLit Data p
627 , ForallXType Data p
628 , ForallXTyVarBndr Data p
629 , ForallXAppType Data p
630 , ForallXFieldOcc Data p
631 , ForallXAmbiguousFieldOcc Data p
632
633 , ForallXExpr Data p
634 , ForallXTupArg Data p
635 , ForallXSplice Data p
636 , ForallXBracket Data p
637 , ForallXCmdTop Data p
638 , ForallXCmd Data p
639
640 , Data (NameOrRdrName (IdP p))
641
642 , Data (IdP p)
643 , Data (PostRn p (IdP p))
644 , Data (PostRn p (Located Name))
645 , Data (PostRn p Bool)
646 , Data (PostRn p Fixity)
647 , Data (PostRn p NameSet)
648 , Data (PostRn p [Name])
649
650 , Data (PostTc p (IdP p))
651 , Data (PostTc p Coercion)
652 , Data (PostTc p ConLike)
653 , Data (PostTc p HsWrapper)
654 , Data (PostTc p Type)
655 , Data (PostTc p [ConLike])
656 , Data (PostTc p [Type])
657 )
658
659 type DataIdLR pL pR =
660 ( DataId pL
661 , DataId pR
662 , ForallXValBindsLR Data pL pR
663 , ForallXValBindsLR Data pL pL
664 , ForallXValBindsLR Data pR pR
665
666 , ForallXParStmtBlock Data pL pR
667 , ForallXParStmtBlock Data pL pL
668 , ForallXParStmtBlock Data pR pR
669 , ForallXParStmtBlock Data GhcRn GhcRn
670 )
671
672 -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
673 -- the @id@ and the 'NameOrRdrName' type for it
674 type OutputableBndrId id =
675 ( OutputableBndr (NameOrRdrName (IdP id))
676 , OutputableBndr (IdP id)
677 , OutputableX id
678 )