never executed always true always false
1 module GHC.Runtime.Context
2 ( InteractiveContext (..)
3 , InteractiveImport (..)
4 , emptyInteractiveContext
5 , extendInteractiveContext
6 , extendInteractiveContextWithIds
7 , setInteractivePrintName
8 , substInteractiveContext
9 , replaceImportEnv
10 , icReaderEnv
11 , icInteractiveModule
12 , icInScopeTTs
13 , icPrintUnqual
14 )
15 where
16
17 import GHC.Prelude
18
19 import GHC.Hs
20
21 import GHC.Driver.Session
22 import {-# SOURCE #-} GHC.Driver.Plugins
23
24 import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume )
25
26 import GHC.Unit
27 import GHC.Unit.Env
28
29 import GHC.Core.FamInstEnv
30 import GHC.Core.InstEnv ( ClsInst, identicalClsInstHead )
31 import GHC.Core.Type
32
33 import GHC.Types.Avail
34 import GHC.Types.Fixity.Env
35 import GHC.Types.Id ( isRecordSelector )
36 import GHC.Types.Id.Info ( IdDetails(..) )
37 import GHC.Types.Name
38 import GHC.Types.Name.Env
39 import GHC.Types.Name.Reader
40 import GHC.Types.Name.Ppr
41 import GHC.Types.TyThing
42 import GHC.Types.Var
43
44 import GHC.Builtin.Names ( ioTyConName, printName, mkInteractiveModule )
45
46 import GHC.Utils.Outputable
47 import GHC.Utils.Misc
48
49 {-
50 Note [The interactive package]
51 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
52 Type, class, and value declarations at the command prompt are treated
53 as if they were defined in modules
54 interactive:Ghci1
55 interactive:Ghci2
56 ...etc...
57 with each bunch of declarations using a new module, all sharing a
58 common package 'interactive' (see Module.interactiveUnitId, and
59 GHC.Builtin.Names.mkInteractiveModule).
60
61 This scheme deals well with shadowing. For example:
62
63 ghci> data T = A
64 ghci> data T = B
65 ghci> :i A
66 data Ghci1.T = A -- Defined at <interactive>:2:10
67
68 Here we must display info about constructor A, but its type T has been
69 shadowed by the second declaration. But it has a respectable
70 qualified name (Ghci1.T), and its source location says where it was
71 defined.
72
73 So the main invariant continues to hold, that in any session an
74 original name M.T only refers to one unique thing. (In a previous
75 iteration both the T's above were called :Interactive.T, albeit with
76 different uniques, which gave rise to all sorts of trouble.)
77
78 The details are a bit tricky though:
79
80 * The field ic_mod_index counts which Ghci module we've got up to.
81 It is incremented when extending ic_tythings
82
83 * ic_tythings contains only things from the 'interactive' package.
84
85 * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go
86 in the Home Package Table (HPT). When you say :load, that's when we
87 extend the HPT.
88
89 * The 'homeUnitId' field of DynFlags is *not* set to 'interactive'.
90 It stays as 'main' (or whatever -this-unit-id says), and is the
91 package to which :load'ed modules are added to.
92
93 * So how do we arrange that declarations at the command prompt get to
94 be in the 'interactive' package? Simply by setting the tcg_mod
95 field of the TcGblEnv to "interactive:Ghci1". This is done by the
96 call to initTc in initTcInteractive, which in turn get the module
97 from it 'icInteractiveModule' field of the interactive context.
98
99 The 'homeUnitId' field stays as 'main' (or whatever -this-unit-id says.
100
101 * The main trickiness is that the type environment (tcg_type_env) and
102 fixity envt (tcg_fix_env), now contain entities from all the
103 interactive-package modules (Ghci1, Ghci2, ...) together, rather
104 than just a single module as is usually the case. So you can't use
105 "nameIsLocalOrFrom" to decide whether to look in the TcGblEnv vs
106 the HPT/PTE. This is a change, but not a problem provided you
107 know.
108
109 * However, the tcg_binds, tcg_sigs, tcg_insts, tcg_fam_insts, etc fields
110 of the TcGblEnv, which collect "things defined in this module", all
111 refer to stuff define in a single GHCi command, *not* all the commands
112 so far.
113
114 In contrast, tcg_inst_env, tcg_fam_inst_env, have instances from
115 all GhciN modules, which makes sense -- they are all "home package"
116 modules.
117
118
119 Note [Interactively-bound Ids in GHCi]
120 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
121 The Ids bound by previous Stmts in GHCi are currently
122 a) GlobalIds, with
123 b) An External Name, like Ghci4.foo
124 See Note [The interactive package] above
125 c) A tidied type
126
127 (a) They must be GlobalIds (not LocalIds) otherwise when we come to
128 compile an expression using these ids later, the byte code
129 generator will consider the occurrences to be free rather than
130 global.
131
132 (b) Having an External Name is important because of Note
133 [GlobalRdrEnv shadowing] in GHC.Types.Names.RdrName
134
135 (c) Their types are tidied. This is important, because :info may ask
136 to look at them, and :info expects the things it looks up to have
137 tidy types
138
139 Where do interactively-bound Ids come from?
140
141 - GHCi REPL Stmts e.g.
142 ghci> let foo x = x+1
143 These start with an Internal Name because a Stmt is a local
144 construct, so the renamer naturally builds an Internal name for
145 each of its binders. Then in tcRnStmt they are externalised via
146 GHC.Tc.Module.externaliseAndTidyId, so they get Names like Ghic4.foo.
147
148 - Ids bound by the debugger etc have Names constructed by
149 GHC.Iface.Env.newInteractiveBinder; at the call sites it is followed by
150 mkVanillaGlobal or mkVanillaGlobalWithInfo. So again, they are
151 all Global, External.
152
153 - TyCons, Classes, and Ids bound by other top-level declarations in
154 GHCi (eg foreign import, record selectors) also get External
155 Names, with Ghci9 (or 8, or 7, etc) as the module name.
156
157
158 Note [ic_tythings]
159 ~~~~~~~~~~~~~~~~~~
160 The ic_tythings field contains
161 * The TyThings declared by the user at the command prompt
162 (eg Ids, TyCons, Classes)
163
164 * The user-visible Ids that arise from such things, which
165 *don't* come from 'implicitTyThings', notably:
166 - record selectors
167 - class ops
168 The implicitTyThings are readily obtained from the TyThings
169 but record selectors etc are not
170
171 It does *not* contain
172 * DFunIds (they can be gotten from ic_instances)
173 * CoAxioms (ditto)
174
175 See also Note [Interactively-bound Ids in GHCi]
176
177 Note [Override identical instances in GHCi]
178 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
179 If you declare a new instance in GHCi that is identical to a previous one,
180 we simply override the previous one; we don't regard it as overlapping.
181 e.g. Prelude> data T = A | B
182 Prelude> instance Eq T where ...
183 Prelude> instance Eq T where ... -- This one overrides
184
185 It's exactly the same for type-family instances. See #7102
186
187 Note [icReaderEnv recalculation]
188 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
189 The GlobalRdrEnv describing what’s in scope at the prompts consists
190 of all the imported things, followed by all the things defined on the prompt, with
191 shadowing. Defining new things on the prompt is easy: we shadow as needed and then extend the environment. But changing the set of imports, which can happen later as well,
192 is tricky: we need to re-apply the shadowing from all the things defined at the prompt!
193
194 For example:
195
196 ghci> let empty = True
197 ghci> import Data.IntMap.Strict -- Exports 'empty'
198 ghci> empty -- Still gets the 'empty' defined at the prompt
199 True
200
201
202 It would be correct ot re-construct the env from scratch based on
203 `ic_tythings`, but that'd be quite expensive if there are many entires in
204 `ic_tythings` that shadow each other.
205
206 Therefore we keep around a that `GlobalRdrEnv` in `igre_prompt_env` that
207 contians _just_ the things defined at the prompt, and use that in
208 `replaceImportEnv` to rebuild the full env. Conveniently, `shadowNames` takes
209 such an `OccEnv` to denote the set of names to shadow.
210
211 INVARIANT: Every `OccName` in `igre_prompt_env` is present unqualified as well
212 (else it would not be right to use pass `igre_prompt_env` to `shadowNames`.)
213
214 The definition of the IcGlobalRdrEnv type should conceptually be in this module, and
215 made abstract, but it’s used in `Resume`, so it lives in GHC.Runtime.Eval.Type.
216 -
217 -}
218
219 -- | Interactive context, recording information about the state of the
220 -- context in which statements are executed in a GHCi session.
221 data InteractiveContext
222 = InteractiveContext {
223 ic_dflags :: DynFlags,
224 -- ^ The 'DynFlags' used to evaluate interactive expressions
225 -- and statements.
226
227 ic_mod_index :: Int,
228 -- ^ Each GHCi stmt or declaration brings some new things into
229 -- scope. We give them names like interactive:Ghci9.T,
230 -- where the ic_index is the '9'. The ic_mod_index is
231 -- incremented whenever we add something to ic_tythings
232 -- See Note [The interactive package]
233
234 ic_imports :: [InteractiveImport],
235 -- ^ The GHCi top-level scope (icReaderEnv) is extended with
236 -- these imports
237 --
238 -- This field is only stored here so that the client
239 -- can retrieve it with GHC.getContext. GHC itself doesn't
240 -- use it, but does reset it to empty sometimes (such
241 -- as before a GHC.load). The context is set with GHC.setContext.
242
243 ic_tythings :: [TyThing],
244 -- ^ TyThings defined by the user, in reverse order of
245 -- definition (ie most recent at the front)
246 -- See Note [ic_tythings]
247
248 ic_gre_cache :: IcGlobalRdrEnv,
249 -- ^ Essentially the cached 'GlobalRdrEnv'.
250 --
251 -- The GlobalRdrEnv contains everything in scope at the command
252 -- line, both imported and everything in ic_tythings, with the
253 -- correct shadowing.
254 --
255 -- The IcGlobalRdrEnv contains extra data to allow efficient
256 -- recalculation when the set of imports change.
257 -- See Note [icReaderEnv recalculation]
258
259 ic_instances :: ([ClsInst], [FamInst]),
260 -- ^ All instances and family instances created during
261 -- this session. These are grabbed en masse after each
262 -- update to be sure that proper overlapping is retained.
263 -- That is, rather than re-check the overlapping each
264 -- time we update the context, we just take the results
265 -- from the instance code that already does that.
266
267 ic_fix_env :: FixityEnv,
268 -- ^ Fixities declared in let statements
269
270 ic_default :: Maybe [Type],
271 -- ^ The current default types, set by a 'default' declaration
272
273 ic_resume :: [Resume],
274 -- ^ The stack of breakpoint contexts
275
276 ic_monad :: Name,
277 -- ^ The monad that GHCi is executing in
278
279 ic_int_print :: Name,
280 -- ^ The function that is used for printing results
281 -- of expressions in ghci and -e mode.
282
283 ic_cwd :: Maybe FilePath,
284 -- ^ virtual CWD of the program
285
286 ic_plugins :: ![LoadedPlugin]
287 -- ^ Cache of loaded plugins. We store them here to avoid having to
288 -- load them everytime we switch to the interctive context.
289 }
290
291 data InteractiveImport
292 = IIDecl (ImportDecl GhcPs)
293 -- ^ Bring the exports of a particular module
294 -- (filtered by an import decl) into scope
295
296 | IIModule ModuleName
297 -- ^ Bring into scope the entire top-level envt of
298 -- of this module, including the things imported
299 -- into it.
300
301 emptyIcGlobalRdrEnv :: IcGlobalRdrEnv
302 emptyIcGlobalRdrEnv = IcGlobalRdrEnv
303 { igre_env = emptyGlobalRdrEnv
304 , igre_prompt_env = emptyGlobalRdrEnv
305 }
306
307 -- | Constructs an empty InteractiveContext.
308 emptyInteractiveContext :: DynFlags -> InteractiveContext
309 emptyInteractiveContext dflags
310 = InteractiveContext {
311 ic_dflags = dflags,
312 ic_imports = [],
313 ic_gre_cache = emptyIcGlobalRdrEnv,
314 ic_mod_index = 1,
315 ic_tythings = [],
316 ic_instances = ([],[]),
317 ic_fix_env = emptyNameEnv,
318 ic_monad = ioTyConName, -- IO monad by default
319 ic_int_print = printName, -- System.IO.print by default
320 ic_default = Nothing,
321 ic_resume = [],
322 ic_cwd = Nothing,
323 ic_plugins = []
324 }
325
326 icReaderEnv :: InteractiveContext -> GlobalRdrEnv
327 icReaderEnv = igre_env . ic_gre_cache
328
329 icInteractiveModule :: InteractiveContext -> Module
330 icInteractiveModule (InteractiveContext { ic_mod_index = index })
331 = mkInteractiveModule index
332
333 -- | This function returns the list of visible TyThings (useful for
334 -- e.g. showBindings)
335 icInScopeTTs :: InteractiveContext -> [TyThing]
336 icInScopeTTs = ic_tythings
337
338 -- | Get the PrintUnqualified function based on the flags and this InteractiveContext
339 icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
340 icPrintUnqual unit_env ictxt = mkPrintUnqualified unit_env (icReaderEnv ictxt)
341
342 -- | extendInteractiveContext is called with new TyThings recently defined to update the
343 -- InteractiveContext to include them. Ids are easily removed when shadowed,
344 -- but Classes and TyCons are not. Some work could be done to determine
345 -- whether they are entirely shadowed, but as you could still have references
346 -- to them (e.g. instances for classes or values of the type for TyCons), it's
347 -- not clear whether removing them is even the appropriate behavior.
348 extendInteractiveContext :: InteractiveContext
349 -> [TyThing]
350 -> [ClsInst] -> [FamInst]
351 -> Maybe [Type]
352 -> FixityEnv
353 -> InteractiveContext
354 extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env
355 = ictxt { ic_mod_index = ic_mod_index ictxt + 1
356 -- Always bump this; even instances should create
357 -- a new mod_index (#9426)
358 , ic_tythings = new_tythings ++ old_tythings
359 , ic_gre_cache = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
360 , ic_instances = ( new_cls_insts ++ old_cls_insts
361 , new_fam_insts ++ fam_insts )
362 -- we don't shadow old family instances (#7102),
363 -- so don't need to remove them here
364 , ic_default = defaults
365 , ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi]
366 }
367 where
368 new_ids = [id | AnId id <- new_tythings]
369 old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
370
371 -- Discard old instances that have been fully overridden
372 -- See Note [Override identical instances in GHCi]
373 (cls_insts, fam_insts) = ic_instances ictxt
374 old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts
375
376 extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
377 -- Just a specialised version
378 extendInteractiveContextWithIds ictxt new_ids
379 | null new_ids = ictxt
380 | otherwise
381 = ictxt { ic_mod_index = ic_mod_index ictxt + 1
382 , ic_tythings = new_tythings ++ old_tythings
383 , ic_gre_cache = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
384 }
385 where
386 new_tythings = map AnId new_ids
387 old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
388
389 shadowed_by :: [Id] -> TyThing -> Bool
390 shadowed_by ids = shadowed
391 where
392 -- Keep record selectors because they might be needed by HasField (#19322)
393 shadowed (AnId id) | isRecordSelector id = False
394 shadowed tything = getOccName tything `elemOccSet` new_occs
395 new_occs = mkOccSet (map getOccName ids)
396
397 setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
398 setInteractivePrintName ic n = ic{ic_int_print = n}
399
400 icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
401 icExtendIcGblRdrEnv igre tythings = IcGlobalRdrEnv
402 { igre_env = igre_env igre `icExtendGblRdrEnv` tythings
403 , igre_prompt_env = igre_prompt_env igre `icExtendGblRdrEnv` tythings
404 }
405
406 -- This is used by setContext in GHC.Runtime.Eval when the set of imports
407 -- changes, and recalculates the GlobalRdrEnv. See Note [icReaderEnv recalculation]
408 replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
409 replaceImportEnv igre import_env = igre { igre_env = new_env }
410 where
411 import_env_shadowed = import_env `shadowNames` igre_prompt_env igre
412 new_env = import_env_shadowed `plusGlobalRdrEnv` igre_prompt_env igre
413
414 -- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
415 -- later ones, and shadowing existing entries in the GlobalRdrEnv.
416 icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
417 icExtendGblRdrEnv env tythings
418 = foldr add env tythings -- Foldr makes things in the front of
419 -- the list shadow things at the back
420 where
421 -- One at a time, to ensure each shadows the previous ones
422 add thing env
423 | is_sub_bndr thing
424 = env
425 | otherwise
426 = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)
427 where
428 new_gres = concatMap availGreNames avail
429 new_occs = occSetToEnv (mkOccSet (map occName new_gres))
430 env1 = shadowNames env new_occs
431 avail = tyThingAvailInfo thing
432
433 -- Ugh! The new_tythings may include record selectors, since they
434 -- are not implicit-ids, and must appear in the TypeEnv. But they
435 -- will also be brought into scope by the corresponding (ATyCon
436 -- tc). And we want the latter, because that has the correct
437 -- parent (#10520)
438 is_sub_bndr (AnId f) = case idDetails f of
439 RecSelId {} -> True
440 ClassOpId {} -> True
441 _ -> False
442 is_sub_bndr _ = False
443
444 substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
445 substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
446 | isEmptyTCvSubst subst = ictxt
447 | otherwise = ictxt { ic_tythings = map subst_ty tts }
448 where
449 subst_ty (AnId id)
450 = AnId $ updateIdTypeAndMult (substTyAddInScope subst) id
451 -- Variables in the interactive context *can* mention free type variables
452 -- because of the runtime debugger. Otherwise you'd expect all
453 -- variables bound in the interactive context to be closed.
454 subst_ty tt
455 = tt
456
457 instance Outputable InteractiveImport where
458 ppr (IIModule m) = char '*' <> ppr m
459 ppr (IIDecl d) = ppr d