never executed always true always false
1 -- | A global typecheckable-thing, essentially anything that has a name.
2 module GHC.Types.TyThing
3 ( TyThing (..)
4 , MonadThings (..)
5 , mkATyCon
6 , mkAnId
7 , pprShortTyThing
8 , pprTyThingCategory
9 , tyThingCategory
10 , implicitTyThings
11 , implicitConLikeThings
12 , implicitClassThings
13 , implicitTyConThings
14 , implicitCoTyCon
15 , isImplicitTyThing
16 , tyThingParent_maybe
17 , tyThingsTyCoVars
18 , tyThingAvailInfo
19 , tyThingTyCon
20 , tyThingCoAxiom
21 , tyThingDataCon
22 , tyThingConLike
23 , tyThingId
24 )
25 where
26
27 import GHC.Prelude
28
29 import GHC.Types.Name
30 import GHC.Types.Var
31 import GHC.Types.Var.Set
32 import GHC.Types.Id
33 import GHC.Types.Id.Info
34 import GHC.Types.Avail
35
36 import GHC.Core.Class
37 import GHC.Core.DataCon
38 import GHC.Core.ConLike
39 import GHC.Core.PatSyn
40 import GHC.Core.TyCo.FVs
41 import GHC.Core.TyCon
42 import GHC.Core.Coercion.Axiom
43
44 import GHC.Utils.Outputable
45 import GHC.Utils.Misc
46 import GHC.Utils.Panic
47
48 import Control.Monad ( liftM )
49 import Control.Monad.Trans.Reader
50 import Control.Monad.Trans.Class
51
52 {-
53 Note [ATyCon for classes]
54 ~~~~~~~~~~~~~~~~~~~~~~~~~
55 Both classes and type constructors are represented in the type environment
56 as ATyCon. You can tell the difference, and get to the class, with
57 isClassTyCon :: TyCon -> Bool
58 tyConClass_maybe :: TyCon -> Maybe Class
59 The Class and its associated TyCon have the same Name.
60 -}
61
62 -- | A global typecheckable-thing, essentially anything that has a name.
63 -- Not to be confused with a 'TcTyThing', which is also a typecheckable
64 -- thing but in the *local* context. See "GHC.Tc.Utils.Env" for how to retrieve
65 -- a 'TyThing' given a 'Name'.
66 data TyThing
67 = AnId Id
68 | AConLike ConLike
69 | ATyCon TyCon -- TyCons and classes; see Note [ATyCon for classes]
70 | ACoAxiom (CoAxiom Branched)
71
72 instance Outputable TyThing where
73 ppr = pprShortTyThing
74
75 instance NamedThing TyThing where -- Can't put this with the type
76 getName (AnId id) = getName id -- decl, because the DataCon instance
77 getName (ATyCon tc) = getName tc -- isn't visible there
78 getName (ACoAxiom cc) = getName cc
79 getName (AConLike cl) = conLikeName cl
80
81 mkATyCon :: TyCon -> TyThing
82 mkATyCon = ATyCon
83
84 mkAnId :: Id -> TyThing
85 mkAnId = AnId
86
87 pprShortTyThing :: TyThing -> SDoc
88 -- c.f. GHC.Types.TyThing.Ppr.pprTyThing, which prints all the details
89 pprShortTyThing thing
90 = pprTyThingCategory thing <+> quotes (ppr (getName thing))
91
92 pprTyThingCategory :: TyThing -> SDoc
93 pprTyThingCategory = text . capitalise . tyThingCategory
94
95 tyThingCategory :: TyThing -> String
96 tyThingCategory (ATyCon tc)
97 | isClassTyCon tc = "class"
98 | otherwise = "type constructor"
99 tyThingCategory (ACoAxiom _) = "coercion axiom"
100 tyThingCategory (AnId _) = "identifier"
101 tyThingCategory (AConLike (RealDataCon _)) = "data constructor"
102 tyThingCategory (AConLike (PatSynCon _)) = "pattern synonym"
103
104
105
106 {-
107 Note [Implicit TyThings]
108 ~~~~~~~~~~~~~~~~~~~~~~~~
109 DEFINITION: An "implicit" TyThing is one that does not have its own
110 IfaceDecl in an interface file. Instead, its binding in the type
111 environment is created as part of typechecking the IfaceDecl for
112 some other thing.
113
114 Examples:
115 * All DataCons are implicit, because they are generated from the
116 IfaceDecl for the data/newtype. Ditto class methods.
117
118 * Record selectors are *not* implicit, because they get their own
119 free-standing IfaceDecl.
120
121 * Associated data/type families are implicit because they are
122 included in the IfaceDecl of the parent class. (NB: the
123 IfaceClass decl happens to use IfaceDecl recursively for the
124 associated types, but that's irrelevant here.)
125
126 * Dictionary function Ids are not implicit.
127
128 * Axioms for newtypes are implicit (same as above), but axioms
129 for data/type family instances are *not* implicit (like DFunIds).
130 -}
131
132 -- | Determine the 'TyThing's brought into scope by another 'TyThing'
133 -- /other/ than itself. For example, Id's don't have any implicit TyThings
134 -- as they just bring themselves into scope, but classes bring their
135 -- dictionary datatype, type constructor and some selector functions into
136 -- scope, just for a start!
137
138 -- N.B. the set of TyThings returned here *must* match the set of
139 -- names returned by 'GHC.Iface.Load.ifaceDeclImplicitBndrs', in the sense that
140 -- TyThing.getOccName should define a bijection between the two lists.
141 -- This invariant is used in 'GHC.IfaceToCore.tc_iface_decl_fingerprint' (see
142 -- note [Tricky iface loop])
143 -- The order of the list does not matter.
144 implicitTyThings :: TyThing -> [TyThing]
145 implicitTyThings (AnId _) = []
146 implicitTyThings (ACoAxiom _cc) = []
147 implicitTyThings (ATyCon tc) = implicitTyConThings tc
148 implicitTyThings (AConLike cl) = implicitConLikeThings cl
149
150 implicitConLikeThings :: ConLike -> [TyThing]
151 implicitConLikeThings (RealDataCon dc)
152 = dataConImplicitTyThings dc
153
154 implicitConLikeThings (PatSynCon {})
155 = [] -- Pattern synonyms have no implicit Ids; the wrapper and matcher
156 -- are not "implicit"; they are simply new top-level bindings,
157 -- and they have their own declaration in an interface file
158 -- Unless a record pat syn when there are implicit selectors
159 -- They are still not included here as `implicitConLikeThings` is
160 -- used by `tcTyClsDecls` whilst pattern synonyms are typed checked
161 -- by `tcTopValBinds`.
162
163 implicitClassThings :: Class -> [TyThing]
164 implicitClassThings cl
165 = -- Does not include default methods, because those Ids may have
166 -- their own pragmas, unfoldings etc, not derived from the Class object
167
168 -- associated types
169 -- No recursive call for the classATs, because they
170 -- are only the family decls; they have no implicit things
171 map ATyCon (classATs cl) ++
172
173 -- superclass and operation selectors
174 map AnId (classAllSelIds cl)
175
176 implicitTyConThings :: TyCon -> [TyThing]
177 implicitTyConThings tc
178 = class_stuff ++
179 -- fields (names of selectors)
180
181 -- (possibly) implicit newtype axioms
182 -- or type family axioms
183 implicitCoTyCon tc ++
184
185 -- for each data constructor in order,
186 -- the constructor, worker, and (possibly) wrapper
187 [ thing | dc <- tyConDataCons tc
188 , thing <- AConLike (RealDataCon dc) : dataConImplicitTyThings dc ]
189 -- NB. record selectors are *not* implicit, they have fully-fledged
190 -- bindings that pass through the compilation pipeline as normal.
191 where
192 class_stuff = case tyConClass_maybe tc of
193 Nothing -> []
194 Just cl -> implicitClassThings cl
195
196 -- For newtypes and closed type families (only) add the implicit coercion tycon
197 implicitCoTyCon :: TyCon -> [TyThing]
198 implicitCoTyCon tc
199 | Just co <- newTyConCo_maybe tc = [ACoAxiom $ toBranchedAxiom co]
200 | Just co <- isClosedSynFamilyTyConWithAxiom_maybe tc
201 = [ACoAxiom co]
202 | otherwise = []
203
204 -- | Returns @True@ if there should be no interface-file declaration
205 -- for this thing on its own: either it is built-in, or it is part
206 -- of some other declaration, or it is generated implicitly by some
207 -- other declaration.
208 isImplicitTyThing :: TyThing -> Bool
209 isImplicitTyThing (AConLike cl) = case cl of
210 RealDataCon {} -> True
211 PatSynCon {} -> False
212 isImplicitTyThing (AnId id) = isImplicitId id
213 isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
214 isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
215
216 -- | tyThingParent_maybe x returns (Just p)
217 -- when pprTyThingInContext should print a declaration for p
218 -- (albeit with some "..." in it) when asked to show x
219 -- It returns the *immediate* parent. So a datacon returns its tycon
220 -- but the tycon could be the associated type of a class, so it in turn
221 -- might have a parent.
222 tyThingParent_maybe :: TyThing -> Maybe TyThing
223 tyThingParent_maybe (AConLike cl) = case cl of
224 RealDataCon dc -> Just (ATyCon (dataConTyCon dc))
225 PatSynCon{} -> Nothing
226 tyThingParent_maybe (ATyCon tc) = case tyConAssoc_maybe tc of
227 Just tc -> Just (ATyCon tc)
228 Nothing -> Nothing
229 tyThingParent_maybe (AnId id) = case idDetails id of
230 RecSelId { sel_tycon = RecSelData tc } ->
231 Just (ATyCon tc)
232 RecSelId { sel_tycon = RecSelPatSyn ps } ->
233 Just (AConLike (PatSynCon ps))
234 ClassOpId cls ->
235 Just (ATyCon (classTyCon cls))
236 _other -> Nothing
237 tyThingParent_maybe _other = Nothing
238
239 tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
240 tyThingsTyCoVars tts =
241 unionVarSets $ map ttToVarSet tts
242 where
243 ttToVarSet (AnId id) = tyCoVarsOfType $ idType id
244 ttToVarSet (AConLike cl) = case cl of
245 RealDataCon dc -> tyCoVarsOfType $ dataConRepType dc
246 PatSynCon{} -> emptyVarSet
247 ttToVarSet (ATyCon tc)
248 = case tyConClass_maybe tc of
249 Just cls -> (mkVarSet . fst . classTvsFds) cls
250 Nothing -> tyCoVarsOfType $ tyConKind tc
251 ttToVarSet (ACoAxiom _) = emptyVarSet
252
253 -- | The Names that a TyThing should bring into scope. Used to build
254 -- the GlobalRdrEnv for the InteractiveContext.
255 tyThingAvailInfo :: TyThing -> [AvailInfo]
256 tyThingAvailInfo (ATyCon t)
257 = case tyConClass_maybe t of
258 Just c -> [availTC n ((n : map getName (classMethods c)
259 ++ map getName (classATs c))) [] ]
260 where n = getName c
261 Nothing -> [availTC n (n : map getName dcs) flds]
262 where n = getName t
263 dcs = tyConDataCons t
264 flds = tyConFieldLabels t
265 tyThingAvailInfo (AConLike (PatSynCon p))
266 = avail (getName p) : map availField (patSynFieldLabels p)
267 tyThingAvailInfo t
268 = [avail (getName t)]
269
270 -- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
271 tyThingTyCon :: HasDebugCallStack => TyThing -> TyCon
272 tyThingTyCon (ATyCon tc) = tc
273 tyThingTyCon other = pprPanic "tyThingTyCon" (ppr other)
274
275 -- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
276 tyThingCoAxiom :: HasDebugCallStack => TyThing -> CoAxiom Branched
277 tyThingCoAxiom (ACoAxiom ax) = ax
278 tyThingCoAxiom other = pprPanic "tyThingCoAxiom" (ppr other)
279
280 -- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
281 tyThingDataCon :: HasDebugCallStack => TyThing -> DataCon
282 tyThingDataCon (AConLike (RealDataCon dc)) = dc
283 tyThingDataCon other = pprPanic "tyThingDataCon" (ppr other)
284
285 -- | Get the 'ConLike' from a 'TyThing' if it is a data constructor thing.
286 -- Panics otherwise
287 tyThingConLike :: HasDebugCallStack => TyThing -> ConLike
288 tyThingConLike (AConLike dc) = dc
289 tyThingConLike other = pprPanic "tyThingConLike" (ppr other)
290
291 -- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
292 tyThingId :: HasDebugCallStack => TyThing -> Id
293 tyThingId (AnId id) = id
294 tyThingId (AConLike (RealDataCon dc)) = dataConWrapId dc
295 tyThingId other = pprPanic "tyThingId" (ppr other)
296
297 -- | Class that abstracts out the common ability of the monads in GHC
298 -- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides
299 -- a number of related convenience functions for accessing particular
300 -- kinds of 'TyThing'
301 class Monad m => MonadThings m where
302 lookupThing :: Name -> m TyThing
303
304 lookupId :: Name -> m Id
305 lookupId = liftM tyThingId . lookupThing
306
307 lookupDataCon :: Name -> m DataCon
308 lookupDataCon = liftM tyThingDataCon . lookupThing
309
310 lookupTyCon :: Name -> m TyCon
311 lookupTyCon = liftM tyThingTyCon . lookupThing
312
313 -- Instance used in GHC.HsToCore.Quote
314 instance MonadThings m => MonadThings (ReaderT s m) where
315 lookupThing = lift . lookupThing