+-- | Run a statement in the current interactive context. Statement
+-- may bind multple values.
+runStmt :: GhcMonad m => String -> SingleStep -> m RunResult
+runStmt expr step =
+ do
+ hsc_env <- getSession
+
+ breakMVar <- liftIO $ newEmptyMVar -- wait on this when we hit a breakpoint
+ statusMVar <- liftIO $ newEmptyMVar -- wait on this when a computation is running
+
+ -- Turn off -fwarn-unused-bindings when running a statement, to hide
+ -- warnings about the implicit bindings we introduce.
+ let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
+ hsc_env' = hsc_env{ hsc_dflags = dflags' }
+
+ r <- liftIO $ hscStmt hsc_env' expr
+
+ case r of
+ Nothing -> return RunFailed -- empty statement / comment
+
+ Just (ids, hval) -> do
+ status <-
+ withVirtualCWD $
+ withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
+ let thing_to_run = unsafeCoerce# hval :: IO [HValue]
+ liftIO $ sandboxIO dflags' statusMVar thing_to_run
+
+ let ic = hsc_IC hsc_env
+ bindings = ic_tmp_ids ic
+
+ case step of
+ RunAndLogSteps ->
+ traceRunStatus expr bindings ids
+ breakMVar statusMVar status emptyHistory
+ _other ->
+ handleRunStatus expr bindings ids
+ breakMVar statusMVar status emptyHistory
+
+withVirtualCWD :: GhcMonad m => m a -> m a
+withVirtualCWD m = do
+ hsc_env <- getSession
+ let ic = hsc_IC hsc_env
+
+ let set_cwd = do
+ dir <- liftIO $ getCurrentDirectory
+ case ic_cwd ic of
+ Just dir -> liftIO $ setCurrentDirectory dir
+ Nothing -> return ()
+ return dir
+
+ reset_cwd orig_dir = do
+ virt_dir <- liftIO $ getCurrentDirectory
+ hsc_env <- getSession
+ let old_IC = hsc_IC hsc_env
+ setSession hsc_env{ hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
+ liftIO $ setCurrentDirectory orig_dir
+
+ gbracket set_cwd reset_cwd $ \_ -> m
+
+parseImportDecl :: GhcMonad m => String -> m (ImportDecl RdrName)
+parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
+
+emptyHistory :: BoundedList History