never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-} -- for pprIfTc, etc.
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE DeriveDataTypeable #-}
5 {-# LANGUAGE EmptyDataDeriving #-}
6 {-# LANGUAGE FlexibleContexts #-}
7 {-# LANGUAGE FlexibleInstances #-}
8 {-# LANGUAGE GADTs #-}
9 {-# LANGUAGE MultiParamTypeClasses #-}
10 {-# LANGUAGE RankNTypes #-}
11 {-# LANGUAGE ScopedTypeVariables #-}
12 {-# LANGUAGE TypeApplications #-}
13 {-# LANGUAGE TypeFamilyDependencies #-}
14 {-# LANGUAGE UndecidableSuperClasses #-} -- for IsPass; see Note [NoGhcTc]
15 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
16 -- in module Language.Haskell.Syntax.Extension
17
18 module GHC.Hs.Extension where
19
20 -- This module captures the type families to precisely identify the extension
21 -- points for GHC.Hs syntax
22
23 import GHC.Prelude
24
25 import Data.Data hiding ( Fixity )
26 import Language.Haskell.Syntax.Extension
27 import GHC.Types.Name
28 import GHC.Types.Name.Reader
29 import GHC.Types.Var
30 import GHC.Utils.Outputable hiding ((<>))
31 import GHC.Types.SrcLoc (GenLocated(..), unLoc)
32 import GHC.Utils.Panic
33 import GHC.Parser.Annotation
34
35 import Data.Void
36
37 {-
38 Note [IsPass]
39 ~~~~~~~~~~~~~
40 One challenge with the Trees That Grow approach
41 is that we sometimes have different information in different passes.
42 For example, we have
43
44 type instance XViaStrategy GhcPs = LHsSigType GhcPs
45 type instance XViaStrategy GhcRn = LHsSigType GhcRn
46 type instance XViaStrategy GhcTc = Type
47
48 This means that printing a DerivStrategy (which contains an XViaStrategy)
49 might need to print a LHsSigType, or it might need to print a type. Yet we
50 want one Outputable instance for a DerivStrategy, instead of one per pass. We
51 could have a large constraint, including e.g. (Outputable (XViaStrategy p),
52 Outputable (XViaStrategy GhcTc)), and pass that around in every context where
53 we might output a DerivStrategy. But a simpler alternative is to pass a
54 witness to whichever pass we're in. When we pattern-match on that (GADT)
55 witness, we learn the pass identity and can then print away. To wit, we get
56 the definition of GhcPass and the functions isPass. These allow us to do away
57 with big constraints, passing around all manner of dictionaries we might or
58 might not use. It does mean that we have to manually use isPass when printing,
59 but these places are few.
60
61 See Note [NoGhcTc] about the superclass constraint to IsPass.
62
63 Note [NoGhcTc]
64 ~~~~~~~~~~~~~~
65 An expression is parsed into HsExpr GhcPs, renamed into HsExpr GhcRn, and
66 then type-checked into HsExpr GhcTc. Not so for types! These get parsed
67 into HsType GhcPs, renamed into HsType GhcRn, and then type-checked into
68 Type. We never build an HsType GhcTc. Why do this? Because we need to be
69 able to compare type-checked types for equality, and we don't want to do
70 this with HsType.
71
72 This causes wrinkles within the AST, where we normally think that the whole
73 AST travels through the GhcPs --> GhcRn --> GhcTc pipeline as one. So we
74 have the NoGhcTc type family, which just replaces GhcTc with GhcRn, so that
75 user-written types can be preserved (as HsType GhcRn) even in e.g. HsExpr GhcTc.
76
77 For example, this is used in ExprWithTySig:
78 | ExprWithTySig
79 (XExprWithTySig p)
80
81 (LHsExpr p)
82 (LHsSigWcType (NoGhcTc p))
83
84 If we have (e :: ty), we still want to be able to print that (with the :: ty)
85 after type-checking. So we retain the LHsSigWcType GhcRn, even in an
86 HsExpr GhcTc. That's what NoGhcTc does.
87
88 When we're printing the type annotation, we need to know
89 (Outputable (LHsSigWcType GhcRn)), even though we've assumed only that
90 (OutputableBndrId GhcTc). We thus must be able to prove OutputableBndrId (NoGhcTc p)
91 from OutputableBndrId p. The extra constraints in OutputableBndrId and
92 the superclass constraints of IsPass allow this. Note that the superclass
93 constraint of IsPass is *recursive*: it asserts that IsPass (NoGhcTcPass p) holds.
94 For this to make sense, we need -XUndecidableSuperClasses and the other constraint,
95 saying that NoGhcTcPass is idempotent.
96
97 -}
98
99 -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
100 type instance XRec (GhcPass p) a = GenLocated (Anno a) a
101
102 type instance Anno RdrName = SrcSpanAnnN
103 type instance Anno Name = SrcSpanAnnN
104 type instance Anno Id = SrcSpanAnnN
105
106 type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn a),
107 IsPass p)
108
109 instance UnXRec (GhcPass p) where
110 unXRec = unLoc
111 instance MapXRec (GhcPass p) where
112 mapXRec = fmap
113
114 -- instance WrapXRec (GhcPass p) a where
115 -- wrapXRec = noLocA
116
117 {-
118 Note [NoExtCon and strict fields]
119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
120 Currently, any unused TTG extension constructor will generally look like the
121 following:
122
123 type instance XXHsDecl (GhcPass _) = NoExtCon
124 data HsDecl p
125 = ...
126 | XHsDecl !(XXHsDecl p)
127
128 The field of type `XXHsDecl p` is strict for a good reason: it allows the
129 pattern-match coverage checker to conclude that any matches against XHsDecl
130 are unreachable whenever `p ~ GhcPass _`. To see why this is the case, consider
131 the following function which consumes an HsDecl:
132
133 ex :: HsDecl GhcPs -> HsDecl GhcRn
134 ...
135 ex (XHsDecl nec) = noExtCon nec
136
137 Because `p` equals GhcPs (i.e., GhcPass 'Parsed), XHsDecl's field has the type
138 NoExtCon. But since (1) the field is strict and (2) NoExtCon is an empty data
139 type, there is no possible way to reach the right-hand side of the XHsDecl
140 case. As a result, the coverage checker concludes that the XHsDecl case is
141 inaccessible, so it can be removed.
142 (See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for
143 more on how this works.)
144
145 Bottom line: if you add a TTG extension constructor that uses NoExtCon, make
146 sure that any uses of it as a field are strict.
147 -}
148
149 -- | Used as a data type index for the hsSyn AST; also serves
150 -- as a singleton type for Pass
151 data GhcPass (c :: Pass) where
152 GhcPs :: GhcPass 'Parsed
153 GhcRn :: GhcPass 'Renamed
154 GhcTc :: GhcPass 'Typechecked
155
156 -- This really should never be entered, but the data-deriving machinery
157 -- needs the instance to exist.
158 instance Typeable p => Data (GhcPass p) where
159 gunfold _ _ _ = panic "instance Data GhcPass"
160 toConstr _ = panic "instance Data GhcPass"
161 dataTypeOf _ = panic "instance Data GhcPass"
162
163 data Pass = Parsed | Renamed | Typechecked
164 deriving (Data)
165
166 -- Type synonyms as a shorthand for tagging
167 type GhcPs = GhcPass 'Parsed -- Output of parser
168 type GhcRn = GhcPass 'Renamed -- Output of renamer
169 type GhcTc = GhcPass 'Typechecked -- Output of typechecker
170
171 -- | Allows us to check what phase we're in at GHC's runtime.
172 -- For example, this class allows us to write
173 -- > f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah
174 -- > f e = case ghcPass @p of
175 -- > GhcPs -> ... in this RHS we have HsExpr GhcPs...
176 -- > GhcRn -> ... in this RHS we have HsExpr GhcRn...
177 -- > GhcTc -> ... in this RHS we have HsExpr GhcTc...
178 -- which is very useful, for example, when pretty-printing.
179 -- See Note [IsPass].
180 class ( NoGhcTcPass (NoGhcTcPass p) ~ NoGhcTcPass p
181 , IsPass (NoGhcTcPass p)
182 ) => IsPass p where
183 ghcPass :: GhcPass p
184
185 instance IsPass 'Parsed where
186 ghcPass = GhcPs
187 instance IsPass 'Renamed where
188 ghcPass = GhcRn
189 instance IsPass 'Typechecked where
190 ghcPass = GhcTc
191
192 type instance IdP (GhcPass p) = IdGhcP p
193
194 -- | Maps the "normal" id type for a given GHC pass
195 type family IdGhcP pass where
196 IdGhcP 'Parsed = RdrName
197 IdGhcP 'Renamed = Name
198 IdGhcP 'Typechecked = Id
199
200 -- | Marks that a field uses the GhcRn variant even when the pass
201 -- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because
202 -- HsType GhcTc should never occur.
203 -- See Note [NoGhcTc]
204
205 -- Breaking it up this way, GHC can figure out that the result is a GhcPass
206 type instance NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)
207
208 type family NoGhcTcPass (p :: Pass) :: Pass where
209 NoGhcTcPass 'Typechecked = 'Renamed
210 NoGhcTcPass other = other
211
212 -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
213 -- the @id@ and the 'NoGhcTc' of it. See Note [NoGhcTc].
214 type OutputableBndrId pass =
215 ( OutputableBndr (IdGhcP pass)
216 , OutputableBndr (IdGhcP (NoGhcTcPass pass))
217 , Outputable (GenLocated (Anno (IdGhcP pass)) (IdGhcP pass))
218 , Outputable (GenLocated (Anno (IdGhcP (NoGhcTcPass pass))) (IdGhcP (NoGhcTcPass pass)))
219 , IsPass pass
220 )
221
222 -- | See Note [Constructor cannot occur]
223 dataConCantHappen :: Void -> a
224 dataConCantHappen = absurd
225
226 -- useful helper functions:
227 pprIfPs :: forall p. IsPass p => (p ~ 'Parsed => SDoc) -> SDoc
228 pprIfPs pp = case ghcPass @p of GhcPs -> pp
229 _ -> empty
230
231 pprIfRn :: forall p. IsPass p => (p ~ 'Renamed => SDoc) -> SDoc
232 pprIfRn pp = case ghcPass @p of GhcRn -> pp
233 _ -> empty
234
235 pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
236 pprIfTc pp = case ghcPass @p of GhcTc -> pp
237 _ -> empty
238
239 type instance Anno (HsToken tok) = TokenLocation
240
241 noHsTok :: GenLocated TokenLocation (HsToken tok)
242 noHsTok = L NoTokenLoc HsTok
243
244 type instance Anno (HsUniToken tok utok) = TokenLocation
245
246 noHsUniTok :: GenLocated TokenLocation (HsUniToken tok utok)
247 noHsUniTok = L NoTokenLoc HsNormalTok