| ... |
... |
@@ -413,65 +413,58 @@ resumeExec :: GhcMonad m |
|
413
|
413
|
=> SingleStep
|
|
414
|
414
|
-> ThreadBreaksIsolationMode
|
|
415
|
415
|
-> Maybe Int
|
|
|
416
|
+ -> Resume
|
|
416
|
417
|
-> m ExecResult
|
|
417
|
|
-resumeExec step isolateMode mbCnt
|
|
418
|
|
- = do
|
|
419
|
|
- hsc_env <- getSession
|
|
420
|
|
- let ic = hsc_IC hsc_env
|
|
421
|
|
- resume = ic_resume ic
|
|
422
|
|
-
|
|
423
|
|
- case resume of
|
|
424
|
|
- [] -> liftIO $
|
|
425
|
|
- throwGhcExceptionIO (ProgramError "not stopped at a breakpoint")
|
|
426
|
|
- (r:rs) -> do
|
|
427
|
|
- -- unbind the temporary locals by restoring the TypeEnv from
|
|
428
|
|
- -- before the breakpoint, and drop this Resume from the
|
|
429
|
|
- -- InteractiveContext.
|
|
430
|
|
- let (resume_tmp_te,resume_gre_cache) = resumeBindings r
|
|
431
|
|
- ic' = ic { ic_tythings = resume_tmp_te,
|
|
432
|
|
- ic_gre_cache = resume_gre_cache,
|
|
433
|
|
- ic_resume = rs }
|
|
434
|
|
- setSession hsc_env{ hsc_IC = ic' }
|
|
435
|
|
-
|
|
436
|
|
- -- remove any bindings created since the breakpoint from the
|
|
437
|
|
- -- linker's environment
|
|
438
|
|
- let old_names = map getName resume_tmp_te
|
|
439
|
|
- new_names = [ n | thing <- ic_tythings ic
|
|
440
|
|
- , let n = getName thing
|
|
441
|
|
- , not (n `elem` old_names) ]
|
|
442
|
|
- interp = hscInterp hsc_env
|
|
443
|
|
- dflags = hsc_dflags hsc_env
|
|
444
|
|
- liftIO $ Loader.deleteFromLoadedHomeEnv interp new_names
|
|
445
|
|
-
|
|
446
|
|
- case r of
|
|
447
|
|
- Resume { resumeStmt = expr
|
|
448
|
|
- , resumeContext = fhv
|
|
449
|
|
- , resumeBindings = bindings
|
|
450
|
|
- , resumeFinalIds = final_ids
|
|
451
|
|
- , resumeApStack = apStack
|
|
452
|
|
- , resumeBreakpointId = mb_brkpt
|
|
453
|
|
- , resumeSpan = span
|
|
454
|
|
- , resumeHistory = hist } ->
|
|
455
|
|
- do
|
|
456
|
|
- -- When the user specified a break ignore count, set it
|
|
457
|
|
- -- in the interpreter
|
|
458
|
|
- case (mb_brkpt, mbCnt) of
|
|
459
|
|
- (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
|
|
460
|
|
- _ -> return ()
|
|
461
|
|
-
|
|
462
|
|
- let eval_opts = (initEvalOpts dflags (enableGhcStepMode step))
|
|
463
|
|
- { isolateThreadBreaks = enableIsolateThreadBreaks isolateMode }
|
|
464
|
|
- status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv
|
|
465
|
|
- let prevHistoryLst = fromListBL 50 hist
|
|
466
|
|
- hug = hsc_HUG hsc_env
|
|
467
|
|
- hist' = case mb_brkpt of
|
|
468
|
|
- Nothing -> pure prevHistoryLst
|
|
469
|
|
- Just bi
|
|
470
|
|
- | breakHere False step span -> do
|
|
471
|
|
- hist1 <- liftIO (mkHistory hug apStack bi)
|
|
472
|
|
- return $ hist1 `consBL` fromListBL 50 hist
|
|
473
|
|
- | otherwise -> pure prevHistoryLst
|
|
474
|
|
- handleRunStatus step isolateMode expr bindings final_ids status =<< hist'
|
|
|
418
|
+resumeExec step isolateMode mbCnt r = do
|
|
|
419
|
+ hsc_env <- getSession
|
|
|
420
|
+ let ic = hsc_IC hsc_env
|
|
|
421
|
+ -- unbind the temporary locals by restoring the TypeEnv from
|
|
|
422
|
+ -- before the breakpoint, and drop this Resume from the
|
|
|
423
|
+ -- InteractiveContext.
|
|
|
424
|
+ let (resume_tmp_te,resume_gre_cache) = resumeBindings r
|
|
|
425
|
+ ic' = ic { ic_tythings = resume_tmp_te,
|
|
|
426
|
+ ic_gre_cache = resume_gre_cache }
|
|
|
427
|
+ setSession hsc_env{ hsc_IC = ic' }
|
|
|
428
|
+
|
|
|
429
|
+ -- remove any bindings created since the breakpoint from the
|
|
|
430
|
+ -- linker's environment
|
|
|
431
|
+ let old_names = map getName resume_tmp_te
|
|
|
432
|
+ new_names = [ n | thing <- ic_tythings ic
|
|
|
433
|
+ , let n = getName thing
|
|
|
434
|
+ , not (n `elem` old_names) ]
|
|
|
435
|
+ interp = hscInterp hsc_env
|
|
|
436
|
+ dflags = hsc_dflags hsc_env
|
|
|
437
|
+ liftIO $ Loader.deleteFromLoadedHomeEnv interp new_names
|
|
|
438
|
+
|
|
|
439
|
+ case r of
|
|
|
440
|
+ Resume { resumeStmt = expr
|
|
|
441
|
+ , resumeContext = fhv
|
|
|
442
|
+ , resumeBindings = bindings
|
|
|
443
|
+ , resumeFinalIds = final_ids
|
|
|
444
|
+ , resumeApStack = apStack
|
|
|
445
|
+ , resumeBreakpointId = mb_brkpt
|
|
|
446
|
+ , resumeSpan = span
|
|
|
447
|
+ , resumeHistory = hist } ->
|
|
|
448
|
+ do
|
|
|
449
|
+ -- When the user specified a break ignore count, set it
|
|
|
450
|
+ -- in the interpreter
|
|
|
451
|
+ case (mb_brkpt, mbCnt) of
|
|
|
452
|
+ (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt
|
|
|
453
|
+ _ -> return ()
|
|
|
454
|
+
|
|
|
455
|
+ let eval_opts = (initEvalOpts dflags (enableGhcStepMode step))
|
|
|
456
|
+ { isolateThreadBreaks = enableIsolateThreadBreaks isolateMode }
|
|
|
457
|
+ status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv
|
|
|
458
|
+ let prevHistoryLst = fromListBL 50 hist
|
|
|
459
|
+ hug = hsc_HUG hsc_env
|
|
|
460
|
+ hist' = case mb_brkpt of
|
|
|
461
|
+ Nothing -> pure prevHistoryLst
|
|
|
462
|
+ Just bi
|
|
|
463
|
+ | breakHere False step span -> do
|
|
|
464
|
+ hist1 <- liftIO (mkHistory hug apStack bi)
|
|
|
465
|
+ return $ hist1 `consBL` fromListBL 50 hist
|
|
|
466
|
+ | otherwise -> pure prevHistoryLst
|
|
|
467
|
+ handleRunStatus step isolateMode expr bindings final_ids status =<< hist'
|
|
475
|
468
|
|
|
476
|
469
|
setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
|
|
477
|
470
|
setupBreakpoint interp ibi cnt = do
|