| ... |
... |
@@ -136,7 +136,6 @@ import Data.List.NonEmpty (NonEmpty) |
|
136
|
136
|
import Unsafe.Coerce ( unsafeCoerce )
|
|
137
|
137
|
import qualified GHC.Unit.Home.Graph as HUG
|
|
138
|
138
|
import GHCi.BreakArray (BreakArray)
|
|
139
|
|
-import Data.Either (fromRight)
|
|
140
|
139
|
|
|
141
|
140
|
-- -----------------------------------------------------------------------------
|
|
142
|
141
|
-- running a statement interactively
|
| ... |
... |
@@ -315,8 +314,10 @@ handleRunStatus step isolateMode expr bindings final_ids status history0 = do |
|
315
|
314
|
final_names = map getName final_ids
|
|
316
|
315
|
liftIO $ Loader.extendLoadedEnv interp modifyHomePackageBytecodeState (zip final_names hvals)
|
|
317
|
316
|
hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
|
|
|
317
|
+ let improved_final_ids = -- the final_ids are at the head of hsc_IC
|
|
|
318
|
+ take (length final_ids) [ i | AnId i <- ic_tythings (hsc_IC hsc_env') ]
|
|
318
|
319
|
setSession hsc_env'
|
|
319
|
|
- return (ExecComplete (Right final_ids {- TODO: THESE MUST BE IMPROVED BEFORE RETURNED -}) allocs)
|
|
|
320
|
+ return (ExecComplete (Right improved_final_ids) allocs)
|
|
320
|
321
|
|
|
321
|
322
|
-- Completed with an exception
|
|
322
|
323
|
EvalComplete alloc (EvalException e) ->
|
| ... |
... |
@@ -327,7 +328,7 @@ handleRunStatus step isolateMode expr bindings final_ids status history0 = do |
|
327
|
328
|
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
|
|
328
|
329
|
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
|
|
329
|
330
|
let span = mkGeneralSrcSpan (fsLit "<unknown>")
|
|
330
|
|
- (hsc_env1, names) <- liftIO $
|
|
|
331
|
+ (hsc_env1, break_ids) <- liftIO $
|
|
331
|
332
|
bindLocalsAtBreakpoint hsc_env apStack_fhv span Nothing
|
|
332
|
333
|
let
|
|
333
|
334
|
resume = Resume
|
| ... |
... |
@@ -346,7 +347,7 @@ handleRunStatus step isolateMode expr bindings final_ids status history0 = do |
|
346
|
347
|
hsc_env2 = pushResume hsc_env1 resume
|
|
347
|
348
|
|
|
348
|
349
|
setSession hsc_env2
|
|
349
|
|
- return (ExecBreak final_ids Nothing resume)
|
|
|
350
|
+ return (ExecBreak break_ids Nothing resume)
|
|
350
|
351
|
|
|
351
|
352
|
-- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint
|
|
352
|
353
|
--
|
| ... |
... |
@@ -374,7 +375,7 @@ handleRunStatus step isolateMode expr bindings final_ids status history0 = do |
|
374
|
375
|
-- This function only returns control to ghci with 'ExecBreak' when it is really meant to break.
|
|
375
|
376
|
-- Specifically, for :steplocal or :stepmodule, don't return control
|
|
376
|
377
|
-- and simply resume execution from here until we hit a breakpoint we do want to stop at.
|
|
377
|
|
- (hsc_env1, final_ids) <- liftIO $
|
|
|
378
|
+ (hsc_env1, break_ids) <- liftIO $
|
|
378
|
379
|
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi)
|
|
379
|
380
|
let
|
|
380
|
381
|
resume = Resume
|
| ... |
... |
@@ -392,7 +393,7 @@ handleRunStatus step isolateMode expr bindings final_ids status history0 = do |
|
392
|
393
|
}
|
|
393
|
394
|
hsc_env2 = pushResume hsc_env1 resume
|
|
394
|
395
|
setSession hsc_env2
|
|
395
|
|
- return (ExecBreak final_ids (Just ibi) resume)
|
|
|
396
|
+ return (ExecBreak break_ids (Just ibi) resume)
|
|
396
|
397
|
else do
|
|
397
|
398
|
-- resume with the same step type
|
|
398
|
399
|
let eval_opts = (initEvalOpts dflags (enableGhcStepMode step))
|
| ... |
... |
@@ -645,7 +646,9 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do |
|
645
|
646
|
Loader.extendLoadedEnv interp modifyHomePackageBytecodeState (zip names fhvs)
|
|
646
|
647
|
when result_ok $ Loader.extendLoadedEnv interp modifyHomePackageBytecodeState [(result_name, apStack_fhv)]
|
|
647
|
648
|
hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
|
|
648
|
|
- return (hsc_env1, final_ids {-TODO: IMPROVE RTTI -})
|
|
|
649
|
+ let improved_final_ids = -- the final_ids are at the head of hsc_IC
|
|
|
650
|
+ take (length final_ids) [ i | AnId i <- ic_tythings (hsc_IC hsc_env1) ]
|
|
|
651
|
+ return (hsc_env1, improved_final_ids)
|
|
649
|
652
|
where
|
|
650
|
653
|
-- We need a fresh Unique for each Id we bind, because the linker
|
|
651
|
654
|
-- state is single-threaded and otherwise we'd spam old bindings
|