[Fix #242] Re-import after resumeExec

Author: Saizan

haskell-debugger/GHC/Debugger/Run.hs

@@ -21,7 +21,26 @@ import Data.Maybe
 import System.FilePath
 import System.Directory
 
-import GHC
+import GHC qualified
+import GHC (
+  ExecOptions (..),
+  ExecResult (..),
+  execStmt',
+  ForeignHValue,
+  GhciLStmt,
+  GhcPs,
+  InteractiveImport (..),
+  mkHsString,
+  ModSummary (..),
+  Name,
+  nlHsLit,
+  nlList,
+  parseImportDecl,
+  SingleStep (..),
+  SrcSpan (..),
+  StmtLR (..),
+  unLoc,
+  )
 import GHC.Plugins (SourceError)
 import GHC.Builtin.Names (gHC_INTERNAL_GHCI_HELPERS)
 import GHC.Unit.Types
@@ -45,7 +64,7 @@ import GHC.Debugger.Interface.Messages
 import Colog.Core as Logger
 import qualified GHC.Debugger.Breakpoint.Map as BM
 import GHC.Debugger.Runtime.Thread
-import GHC.Debugger.Session (setInteractiveDebuggerDynFlags, getInteractiveDebuggerDynFlags)
+import GHC.Debugger.Session (setInteractiveDebuggerDynFlags, getInteractiveDebuggerDynFlags, resumeExec)
 
 --------------------------------------------------------------------------------
 -- * Evaluation
@@ -126,27 +145,27 @@ debugExecution entryFile entry args = do
 -- | Resume execution of the stopped debuggee program
 doContinue :: Debugger EvalResult
 doContinue = do
-  GHC.resumeExec RunToCompletion Nothing
+  resumeExec RunToCompletion Nothing
     >>= handleExecResult
 
 -- | Resume execution but only take a single step.
 doSingleStep :: Debugger EvalResult
 doSingleStep = do
-  GHC.resumeExec SingleStep Nothing
+  resumeExec SingleStep Nothing
     >>= handleExecResult
 
 doStepOut :: Debugger EvalResult
 doStepOut = do
   mb_span <- getCurrentBreakSpan
   case mb_span of
     Nothing ->
-      GHC.resumeExec (GHC.StepOut Nothing) Nothing
+      resumeExec (GHC.StepOut Nothing) Nothing
         >>= handleExecResult
     Just loc -> do
       md <- fromMaybe (error "doStepOut") <$> getCurrentBreakModule
       ticks <- fromMaybe (error "doLocalStep:getTicks") <$> makeModuleLineMap md
       let current_toplevel_decl = enclosingTickSpan ticks loc
-      GHC.resumeExec (GHC.StepOut (Just (RealSrcSpan current_toplevel_decl Strict.Nothing))) Nothing
+      resumeExec (GHC.StepOut (Just (RealSrcSpan current_toplevel_decl Strict.Nothing))) Nothing
         >>= handleExecResult
 
 -- | Resume execution but stop at the next tick within the same function.
@@ -162,13 +181,13 @@ doLocalStep = do
     Nothing -> error "not stopped at a breakpoint?!"
     Just (UnhelpfulSpan _) -> do
       liftIO $ putStrLn "Stopped at an exception. Forcing step into..."
-      GHC.resumeExec SingleStep Nothing >>= handleExecResult
+      resumeExec SingleStep Nothing >>= handleExecResult
     Just loc -> do
       md <- fromMaybe (error "doLocalStep") <$> getCurrentBreakModule
       -- TODO: Cache moduleLineMap?
       ticks <- fromMaybe (error "doLocalStep:getTicks") <$> makeModuleLineMap md
       let current_toplevel_decl = enclosingTickSpan ticks loc
-      GHC.resumeExec (LocalStep (RealSrcSpan current_toplevel_decl mempty)) Nothing >>= handleExecResult
+      resumeExec (LocalStep (RealSrcSpan current_toplevel_decl mempty)) Nothing >>= handleExecResult
 
 -- | Generalized `doEval` that also handles `imports`
 doEvalCommand :: String -> Debugger EvalResult
@@ -226,7 +245,7 @@ doEval expr = withCurrentBreakExtensions $ do
 -- We use this in 'doEval' because we want to ignore breakpoints in expressions given at the prompt.
 continueToCompletion :: Debugger GHC.ExecResult
 continueToCompletion = do
-  execr <- GHC.resumeExec GHC.RunToCompletion Nothing
+  execr <- resumeExec GHC.RunToCompletion Nothing
   case execr of
     GHC.ExecBreak{} -> continueToCompletion
     GHC.ExecComplete{} -> return execr
@@ -324,7 +343,7 @@ handleExecResult = \case
             EvalAbortedWith e -> do
               logSDoc Logger.Warning (evalFailedMsg e)
               resume
-    resume = GHC.resumeExec GHC.RunToCompletion Nothing >>= handleExecResult
+    resume = resumeExec GHC.RunToCompletion Nothing >>= handleExecResult
 
 -- | Get the value and type of a given 'Name' as rendered strings in 'VarInfo'.
 inspectName :: Name -> Debugger (Maybe VarInfo)

haskell-debugger/GHC/Debugger/Session.hs

@@ -27,6 +27,7 @@ module GHC.Debugger.Session (
   setPgmI, addOptI,
   setDynFlagWays,
   makeDynFlagsAbsoluteOverall,
+  resumeExec,
   )
   where
 
@@ -69,6 +70,7 @@ import qualified GHC.Unit.Home.Graph as HUG
 import qualified Data.Set as Set
 import Data.Maybe
 import GHC.Types.Target (InputFileBuffer)
+import GHC (SingleStep, ExecResult)
 
 -- | Throws if package flags are unsatisfiable
 parseHomeUnitArguments :: GhcMonad m
@@ -482,6 +484,41 @@ addWay' w dflags0 =
                        (wayUnsetGeneralFlags platform w)
    in dflags3
 
+-- ----------------------------------------------------------------------------
+-- Wrappers around GHC's odd behavior
+-- ----------------------------------------------------------------------------
+
+resumeExec :: GhcMonad m => SingleStep -> Maybe Int -> m ExecResult
+resumeExec a b = do
+  -- IC's ic_imports field is not kept in sync with ic_gre_cache, so we could do
+  -- this call later, but why rely on that.
+  imports <- GHC.getContext
+
+  v <- GHC.resumeExec a b
+
+  -- To have interactive imports persist after a `continue` command we have to
+  -- work around how GHC.resumeExec handles the InteractiveContext (IC).
+  --
+  -- GHC.resumeExec resets the scope of the IC (i.e. ic_gre_cache) to what it
+  -- was before the last ExecBreak.
+  --
+  -- It makes sense for GHC.resumeExec to remove from the IC scope the
+  -- breakpoint locals and anything that could have been defined with them, in
+  -- fact they are also unloaded.
+  --
+  -- The way it's done though also rollbacks any import statements that were
+  -- executed since the last ExecBreak. The only fix is to reimport everything
+  -- again.
+  --
+  -- Note: GHC.setContext recomputes the scope of the interactive imports from
+  -- scratch everytime. Considering `runDebugger` adds the whole home unit to
+  -- the interactive imports this might become a bottleneck. GHC does not keep
+  -- any reference to the scope containing just the imports, so we would have to
+  -- cache it ourselves (and then extend it with the cached scope of
+  -- ic_tythings, i.e. igre_prompt_env (c.f. replaceImportEnv)).
+  GHC.setContext imports
+  pure v
+
 -- ----------------------------------------------------------------------------
 -- Utils that we need, but don't want to incur an additional dependency for.
 -- ----------------------------------------------------------------------------

test/golden/T242/Main.hs

@@ -0,0 +1,12 @@
+f () = do
+  let xs = [3,2,1]
+  pure ()
+  print xs
+
+main = do
+  let doit = const (pure () :: IO ())
+  let xs = [4,5,6]
+  doit ()
+  f ()
+  print xs
+  putStrLn "done"

test/golden/T242/T242.ghc-914.hdb-stdout

@@ -0,0 +1,14 @@
+[1 of 3] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory]
+[2 of 3] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]
+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 4], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/Main.hs", startLine = 9, endLine = 9, startCol = 3, endCol = 10}}
+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 11], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/Main.hs", startLine = 3, endLine = 3, startCol = 3, endCol = 10}}
+(hdb) Stopped at breakpoint
+(hdb) Aborted: <interactive>:1:8: error: [GHC-88464]
+    Variable not in scope: sort :: [Integer] -> a0
+(hdb) 
+(hdb) [4,5,6]
+()
+(hdb) Stopped at breakpoint
+(hdb) [1,2,3]
+()
+(hdb) Exiting...

test/golden/T242/T242.hdb-stdin

@@ -0,0 +1,8 @@
+break Main.hs 9
+break Main.hs 3
+run
+print print (sort xs)
+print import Data.List
+print print (sort xs)
+continue
+print print (sort xs)

test/golden/T242/T242.hdb-test

@@ -0,0 +1 @@
+$HDB Main.hs -v 0 < T242.hdb-stdin