More accurate allocation stats for :set +s

The point of this commit is to make the memory allocation statistic
from :set +s in GHCi a lot more accurate.  Currently it uses the total
allocation figure calculated by the RTS, which is only updated during
GC, so can be wrong by an arbitrary amount.  The fix is to the the
per-thread allocation counter that was introduced for allocation
limits.

This required changes to the GHC API, because we now have to return
the allocation value from each evaluation.  Rather than just change
the API, I introduced a new API and deprecated the old one.  The new
one is simpler and more extensible, so hopefully we won't need to make
this transition in the future.  See GHC.hs for details.

8 files changed, 234 insertions, 118 deletions

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 197a71973b..a0a0262bcc 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -87,47 +87,68 @@ module GHC (
         PrintUnqualified, alwaysQualify,
 
         -- * Interactive evaluation
+
+#ifdef GHCI
+        -- ** Executing statements
+        execStmt, ExecOptions(..), execOptions, ExecResult(..),
+        resumeExec,
+
+        -- ** Adding new declarations
+        runDecls, runDeclsWithLocation,
+
+        -- ** Get/set the current context
+        parseImportDecl,
+        setContext, getContext,
+        setGHCiMonad,
+#endif
+        -- ** Inspecting the current context
         getBindings, getInsts, getPrintUnqual,
         findModule, lookupModule,
 #ifdef GHCI
-        isModuleTrusted,
-        moduleTrustReqs,
-        setContext, getContext, 
+        isModuleTrusted, moduleTrustReqs,
         getNamesInScope,
         getRdrNamesInScope,
         getGRE,
         moduleIsInterpreted,
         getInfo,
+        showModule,
+        isModuleInterpreted,
+
+        -- ** Inspecting types and kinds
         exprType,
         typeKind,
+
+        -- ** Looking up a Name
         parseName,
-        RunResult(..),  
-        runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
+#endif
+        lookupName,
+#ifdef GHCI
+        -- ** Compiling expressions
+        InteractiveEval.compileExpr, HValue, dynCompileExpr,
+
+        -- ** Other
         runTcInteractive,   -- Desired by some clients (Trac #8878)
-        parseImportDecl, SingleStep(..),
-        resume,
+
+        -- ** The debugger
+        SingleStep(..),
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
         History(historyBreakInfo, historyEnclosingDecls), 
         GHC.getHistorySpan, getHistoryModule,
-        getResumeContext,
         abandon, abandonAll,
-        InteractiveEval.back,
-        InteractiveEval.forward,
-        showModule,
-        isModuleInterpreted,
-        InteractiveEval.compileExpr, HValue, dynCompileExpr,
+        getResumeContext,
         GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
         BreakInfo(breakInfo_number, breakInfo_module),
         BreakArray, setBreakOn, setBreakOff, getBreak,
-#endif
-        lookupName,
+        InteractiveEval.back,
+        InteractiveEval.forward,
 
-#ifdef GHCI
-        -- ** EXPERIMENTAL
-        setGHCiMonad,
+        -- ** Deprecated API
+        RunResult(..),
+        runStmt, runStmtWithLocation,
+        resume,
 #endif
 
         -- * Abstract syntax elements
@@ -1416,14 +1437,11 @@ moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageKey])
 moduleTrustReqs m = withSession $ \hsc_env ->
     liftIO $ hscGetSafe hsc_env m noSrcSpan
 
--- | EXPERIMENTAL: DO NOT USE.
--- 
--- Set the monad GHCi lifts user statements into.
+-- | Set the monad GHCi lifts user statements into.
 --
 -- Checks that a type (in string form) is an instance of the
 -- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,
 -- throws an error otherwise.
-{-# WARNING setGHCiMonad "This is experimental! Don't use." #-}
 setGHCiMonad :: GhcMonad m => String -> m ()
 setGHCiMonad name = withSession $ \hsc_env -> do
     ty <- liftIO $ hscIsGHCiMonad hsc_env name
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index ff588e1276..44b207a293 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples #-}
+{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples,
+    RecordWildCards #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -10,8 +11,9 @@
 
 module InteractiveEval (
 #ifdef GHCI
-        RunResult(..), Status(..), Resume(..), History(..),
-        runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
+        Status(..), Resume(..), History(..),
+        execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec,
+        runDecls, runDeclsWithLocation,
         parseImportDecl, SingleStep(..),
         resume,
         abandon, abandonAll,
@@ -32,7 +34,9 @@ module InteractiveEval (
         showModule,
         isModuleInterpreted,
         compileExpr, dynCompileExpr,
-        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType
+        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType,
+        -- * Depcreated API (remove in GHC 7.14)
+        RunResult(..), runStmt, runStmtWithLocation,
 #endif
         ) where
 
@@ -93,6 +97,7 @@ import Data.Array
 import Exception
 import Control.Concurrent
 import System.IO.Unsafe
+import GHC.Conc         ( setAllocationCounter, getAllocationCounter )
 
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
@@ -100,15 +105,6 @@ import System.IO.Unsafe
 getResumeContext :: GhcMonad m => m [Resume]
 getResumeContext = withSession (return . ic_resume . hsc_IC)
 
-data SingleStep
-   = RunToCompletion
-   | SingleStep
-   | RunAndLogSteps
-
-isStep :: SingleStep -> Bool
-isStep RunToCompletion = False
-isStep _ = True
-
 mkHistory :: HscEnv -> HValue -> BreakInfo -> History
 mkHistory hsc_env hval bi = let
     decls = findEnclosingDecls hsc_env bi
@@ -152,21 +148,30 @@ updateFixityEnv fix_env = do
   let ic = hsc_IC hsc_env
   setSession $ hsc_env { hsc_IC = ic { ic_fix_env = fix_env } }
 
--- | Run a statement in the current interactive context.  Statement
--- may bind multple values.
-runStmt :: GhcMonad m => String -> SingleStep -> m RunResult
-runStmt = runStmtWithLocation "<interactive>" 1
-
--- | Run a statement in the current interactive context.  Passing debug information
---   Statement may bind multple values.
-runStmtWithLocation :: GhcMonad m => String -> Int ->
-                       String -> SingleStep -> m RunResult
-runStmtWithLocation source linenumber expr step =
-  do
+-- -----------------------------------------------------------------------------
+-- execStmt
+
+-- | default ExecOptions
+execOptions :: ExecOptions
+execOptions = ExecOptions
+  { execSingleStep = RunToCompletion
+  , execSourceFile = "<interactive>"
+  , execLineNumber = 1
+  }
+
+-- | Run a statement in the current interactive context.
+execStmt
+  :: GhcMonad m
+  => String             -- ^ a statement (bind or expression)
+  -> ExecOptions
+  -> m ExecResult
+execStmt stmt ExecOptions{..} = 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
+    -- wait on this when we hit a breakpoint
+    breakMVar  <- liftIO $ newEmptyMVar
+    -- wait on this when a computation is running
+    statusMVar <- liftIO $ newEmptyMVar
 
     -- Turn off -fwarn-unused-local-binds when running a statement, to hide
     -- warnings about the implicit bindings we introduce.
@@ -175,28 +180,63 @@ runStmtWithLocation source linenumber expr step =
         hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }
 
     -- compile to value (IO [HValue]), don't run
-    r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber
+    r <- liftIO $ hscStmtWithLocation hsc_env' stmt
+                    execSourceFile execLineNumber
 
     case r of
       -- empty statement / comment
-      Nothing -> return (RunOk [])
+      Nothing -> return (ExecComplete (Right []) 0)
 
       Just (tyThings, hval, fix_env) -> do
         updateFixityEnv fix_env
 
         status <-
           withVirtualCWD $
-            withBreakAction (isStep step) idflags' breakMVar statusMVar $ do
-                liftIO $ sandboxIO idflags' statusMVar hval
+            withBreakAction (isStep execSingleStep) idflags'
+               breakMVar statusMVar $ do
+                 liftIO $ sandboxIO idflags' statusMVar hval
 
         let ic = hsc_IC hsc_env
             bindings = (ic_tythings ic, ic_rn_gbl_env ic)
 
             size = ghciHistSize idflags'
 
-        handleRunStatus step expr bindings tyThings
+        handleRunStatus execSingleStep stmt bindings tyThings
                         breakMVar statusMVar status (emptyHistory size)
 
+-- | The type returned by the deprecated 'runStmt' and
+-- 'runStmtWithLocation' API
+data RunResult
+  = RunOk [Name]                -- ^ names bound by this evaluation
+  | RunException SomeException  -- ^ statement raised an exception
+  | RunBreak ThreadId [Name] (Maybe BreakInfo)
+
+-- | Conver the old result type to the new result type
+execResultToRunResult :: ExecResult -> RunResult
+execResultToRunResult r =
+  case r of
+    ExecComplete{ execResult = Left ex } -> RunException ex
+    ExecComplete{ execResult = Right names } -> RunOk names
+    ExecBreak{..} -> RunBreak breakThreadId breakNames breakInfo
+
+-- Remove in GHC 7.14
+{-# DEPRECATED runStmt "use execStmt" #-}
+-- | Run a statement in the current interactive context.  Statement
+-- may bind multple values.
+runStmt :: GhcMonad m => String -> SingleStep -> m RunResult
+runStmt stmt step =
+  execResultToRunResult <$> execStmt stmt execOptions { execSingleStep = step }
+
+-- Remove in GHC 7.14
+{-# DEPRECATED runStmtWithLocation "use execStmtWithLocation" #-}
+runStmtWithLocation :: GhcMonad m => String -> Int ->
+                       String -> SingleStep -> m RunResult
+runStmtWithLocation source linenumber expr step = do
+  execResultToRunResult <$>
+     execStmt expr execOptions { execSingleStep = step
+                               , execSourceFile = source
+                               , execLineNumber = linenumber }
+
 runDecls :: GhcMonad m => String -> m [Name]
 runDecls = runDeclsWithLocation "<interactive>" 1
 
@@ -243,7 +283,7 @@ emptyHistory size = nilBL size
 handleRunStatus :: GhcMonad m
                 => SingleStep -> String-> ([TyThing],GlobalRdrEnv) -> [Id]
                 -> MVar () -> MVar Status -> Status -> BoundedList History
-                -> m RunResult
+                -> m ExecResult
 
 handleRunStatus step expr bindings final_ids
                breakMVar statusMVar status history
@@ -296,21 +336,21 @@ handleRunStatus step expr bindings final_ids
            hsc_env2 = pushResume hsc_env1 resume
   
          modifySession (\_ -> hsc_env2)
-         return (RunBreak tid names mb_info)
+         return (ExecBreak tid names mb_info)
   
     -- Completed with an exception
-    | Complete (Left e) <- status
-    = return (RunException e)
+    | Complete (Left e) alloc <- status
+    = return (ExecComplete (Left e) alloc)
   
     -- Completed successfully
-    | Complete (Right hvals) <- status
+    | Complete (Right hvals) allocs <- status
     = do hsc_env <- getSession
          let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids
              final_names = map getName final_ids
          liftIO $ Linker.extendLinkEnv (zip final_names hvals)
          hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
          modifySession (\_ -> hsc_env')
-         return (RunOk final_names)
+         return (ExecComplete (Right final_names) allocs)
   
     | otherwise
     = panic "handleRunStatus"  -- The above cases are in fact exhaustive
@@ -351,7 +391,10 @@ foreign import ccall "&rts_breakpoint_io_action"
 sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
 sandboxIO dflags statusMVar thing =
    mask $ \restore -> -- fork starts blocked
-     let runIt = liftM Complete $ try (restore $ rethrow dflags thing)
+     let runIt =
+           liftM (uncurry Complete) $
+           measureAlloc $
+           try $ restore $ rethrow dflags $ thing
      in if gopt Opt_GhciSandbox dflags
         then do tid <- forkIO $ do res <- runIt
                                    putMVar statusMVar res -- empty: can't block
@@ -398,6 +441,13 @@ redirectInterrupts target wait
             Nothing -> wait
             Just target -> do throwTo target (e :: SomeException); wait
 
+measureAlloc :: IO a -> IO (a,Word64)
+measureAlloc io = do
+  setAllocationCounter maxBound
+  a <- io
+  allocs <- getAllocationCounter
+  return (a, fromIntegral (maxBound::Int64) - fromIntegral allocs)
+
 -- We want to turn ^C into a break when -fbreak-on-exception is on,
 -- but it's an async exception and we only break for sync exceptions.
 -- Idea: if we catch and re-throw it, then the re-throw will trigger
@@ -460,7 +510,10 @@ noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
 noBreakAction True  _ _ = return () -- exception: just continue
 
 resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
-resume canLogSpan step
+resume canLogSpan step = execResultToRunResult <$> resumeExec canLogSpan step
+
+resumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m ExecResult
+resumeExec canLogSpan step
  = do
    hsc_env <- getSession
    let ic = hsc_IC hsc_env
diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs
index 6ea1a25648..7aaf5f2cd8 100644
--- a/compiler/main/InteractiveEvalTypes.hs
+++ b/compiler/main/InteractiveEvalTypes.hs
@@ -10,7 +10,8 @@
 
 module InteractiveEvalTypes (
 #ifdef GHCI
-        RunResult(..), Status(..), Resume(..), History(..),
+        Status(..), Resume(..), History(..), ExecResult(..),
+        SingleStep(..), isStep, ExecOptions(..)
 #endif
         ) where
 
@@ -26,15 +27,39 @@ import SrcLoc
 import Exception
 import Control.Concurrent
 
-data RunResult
-  = RunOk [Name]                -- ^ names bound by this evaluation
-  | RunException SomeException  -- ^ statement raised an exception
-  | RunBreak ThreadId [Name] (Maybe BreakInfo)
+import Data.Word
+
+data ExecOptions
+ = ExecOptions
+     { execSingleStep :: SingleStep         -- ^ stepping mode
+     , execSourceFile :: String             -- ^ filename (for errors)
+     , execLineNumber :: Int                -- ^ line number (for errors)
+     }
+
+data SingleStep
+   = RunToCompletion
+   | SingleStep
+   | RunAndLogSteps
+
+isStep :: SingleStep -> Bool
+isStep RunToCompletion = False
+isStep _ = True
+
+data ExecResult
+  = ExecComplete
+       { execResult :: Either SomeException [Name]
+       , execAllocation :: Word64
+       }
+  | ExecBreak
+       { breakThreadId :: ThreadId
+       , breakNames :: [Name]
+       , breakInfo :: Maybe BreakInfo
+       }
 
 data Status
    = Break Bool HValue BreakInfo ThreadId
           -- ^ the computation hit a breakpoint (Bool <=> was an exception)
-   | Complete (Either SomeException [HValue])
+   | Complete (Either SomeException [HValue]) Word64
           -- ^ the computation completed with either an exception or a value
 
 data Resume
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index cf82161bff..8c755be930 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -43,7 +43,6 @@ import Linker
 import Exception
 import Numeric
 import Data.Array
-import Data.Int         ( Int64 )
 import Data.IORef
 import System.CPUTime
 import System.Environment
@@ -265,7 +264,7 @@ printForUserPartWay doc = do
   liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc
 
 -- | Run a single Haskell expression
-runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.RunResult)
+runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
 runStmt expr step = do
   st <- getGHCiState
   reifyGHCi $ \x ->
@@ -274,7 +273,11 @@ runStmt expr step = do
       reflectGHCi x $ do
         GHC.handleSourceError (\e -> do GHC.printException e;
                                         return Nothing) $ do
-          r <- GHC.runStmtWithLocation (progname st) (line_number st) expr step
+          let opts = GHC.execOptions
+                { GHC.execSourceFile = progname st
+                , GHC.execLineNumber = line_number st
+                , GHC.execSingleStep = step }
+          r <- GHC.execStmt expr opts
           return (Just r)
 
 runDecls :: String -> GHCi (Maybe [GHC.Name])
@@ -289,43 +292,41 @@ runDecls decls = do
           r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
           return (Just r)
 
-resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
+resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.ExecResult
 resume canLogSpan step = do
   st <- getGHCiState
   reifyGHCi $ \x ->
     withProgName (progname st) $
     withArgs (args st) $
       reflectGHCi x $ do
-        GHC.resume canLogSpan step
+        GHC.resumeExec canLogSpan step
 
 -- --------------------------------------------------------------------------
 -- timing & statistics
 
-timeIt :: InputT GHCi a -> InputT GHCi a
-timeIt action
+timeIt :: (a -> Maybe Integer) -> InputT GHCi a -> InputT GHCi a
+timeIt getAllocs action
   = do b <- lift $ isOptionSet ShowTiming
        if not b
           then action
-          else do allocs1 <- liftIO $ getAllocations
-                  time1   <- liftIO $ getCPUTime
+          else do time1   <- liftIO $ getCPUTime
                   a <- action
-                  allocs2 <- liftIO $ getAllocations
+                  let allocs = getAllocs a
                   time2   <- liftIO $ getCPUTime
                   dflags  <- getDynFlags
-                  liftIO $ printTimes dflags (fromIntegral (allocs2 - allocs1))
-                                  (time2 - time1)
+                  liftIO $ printTimes dflags allocs (time2 - time1)
                   return a
 
-foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
-        -- defined in ghc/rts/Stats.c
-
-printTimes :: DynFlags -> Integer -> Integer -> IO ()
-printTimes dflags allocs psecs
+printTimes :: DynFlags -> Maybe Integer -> Integer -> IO ()
+printTimes dflags mallocs psecs
    = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float
             secs_str = showFFloat (Just 2) secs
         putStrLn (showSDoc dflags (
                  parens (text (secs_str "") <+> text "secs" <> comma <+>
-                         text (separateThousands allocs) <+> text "bytes")))
+                         case mallocs of
+                           Nothing -> empty
+                           Just allocs ->
+                             text (separateThousands allocs) <+> text "bytes")))
   where
     separateThousands n = reverse . sep . reverse . show $ n
       where sep n'
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index f5b69ae089..c1283b5ac2 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections #-}
+{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections,
+             RecordWildCards #-}
 {-# OPTIONS -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
@@ -807,9 +808,10 @@ runOneCommand eh gCmd = do
             Nothing      -> return $ Just True
             Just ml_stmt -> do
               -- temporarily compensate line-number for multi-line input
-              result <- timeIt $ lift $ runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
-              return $ Just result
-        else do -- single line input and :{-multiline input
+              result <- timeIt runAllocs $ lift $
+                runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
+              return $ Just (runSuccess result)
+        else do -- single line input and :{ - multiline input
           last_line_num <- lift (line_number <$> getGHCiState)
           -- reconstruct first line num from last line num and stmt
           let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1)
@@ -817,11 +819,13 @@ runOneCommand eh gCmd = do
               stmt_nl_cnt2 = length [ () | '\n' <- stmt' ]
               stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines
           -- temporarily compensate line-number for multi-line input
-          result <- timeIt $ lift $ runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
-          return $ Just result
+          result <- timeIt runAllocs $ lift $
+            runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
+          return $ Just (runSuccess result)
 
     -- runStmt wrapper for temporarily overridden line-number
-    runStmtWithLineNum :: Int -> String -> SingleStep -> GHCi Bool
+    runStmtWithLineNum :: Int -> String -> SingleStep
+                       -> GHCi (Maybe GHC.ExecResult)
     runStmtWithLineNum lnum stmt step = do
         st0 <- getGHCiState
         setGHCiState st0 { line_number = lnum }
@@ -899,16 +903,16 @@ declPrefixes dflags = keywords ++ concat opt_keywords
 
 -- | Entry point to execute some haskell code from user.
 -- The return value True indicates success, as in `runOneCommand`.
-runStmt :: String -> SingleStep -> GHCi Bool
+runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult)
 runStmt stmt step
  -- empty; this should be impossible anyways since we filtered out
  -- whitespace-only input in runOneCommand's noSpace
  | null (filter (not.isSpace) stmt)
- = return True
+ = return Nothing
 
  -- import
  | stmt `looks_like` "import "
- = do addImportToContext stmt; return True
+ = do addImportToContext stmt; return (Just (GHC.ExecComplete (Right []) 0))
 
  | otherwise
  = do dflags <- getDynFlags
@@ -920,8 +924,10 @@ runStmt stmt step
         do _ <- liftIO $ tryIO $ hFlushAll stdin
            m_result <- GhciMonad.runDecls stmt
            case m_result of
-               Nothing     -> return False
-               Just result -> afterRunStmt (const True) (GHC.RunOk result)
+               Nothing     -> return Nothing
+               Just result ->
+                 Just <$> afterRunStmt (const True)
+                            (GHC.ExecComplete (Right result) 0)
 
     run_stmt =
         do -- In the new IO library, read handles buffer data even if the Handle
@@ -932,8 +938,8 @@ runStmt stmt step
            _ <- liftIO $ tryIO $ hFlushAll stdin
            m_result <- GhciMonad.runStmt stmt step
            case m_result of
-               Nothing     -> return False
-               Just result -> afterRunStmt (const True) result
+               Nothing     -> return Nothing
+               Just result -> Just <$> afterRunStmt (const True) result
 
     s `looks_like` prefix = prefix `isPrefixOf` dropWhile isSpace s
        -- Ignore leading spaces (see Trac #9914), so that
@@ -941,15 +947,17 @@ runStmt stmt step
        -- (note leading spaces) works properly
 
 -- | Clean up the GHCi environment after a statement has run
-afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
-afterRunStmt _ (GHC.RunException e) = liftIO $ Exception.throwIO e
+afterRunStmt :: (SrcSpan -> Bool) -> GHC.ExecResult -> GHCi GHC.ExecResult
 afterRunStmt step_here run_result = do
   resumes <- GHC.getResumeContext
   case run_result of
-     GHC.RunOk names -> do
-        show_types <- isOptionSet ShowType
-        when show_types $ printTypeOfNames names
-     GHC.RunBreak _ names mb_info
+     GHC.ExecComplete{..} ->
+       case execResult of
+          Left ex -> liftIO $ Exception.throwIO ex
+          Right names -> do
+            show_types <- isOptionSet ShowType
+            when show_types $ printTypeOfNames names
+     GHC.ExecBreak _ names mb_info
          | isNothing  mb_info ||
            step_here (GHC.resumeSpan $ head resumes) -> do
                mb_id_loc <- toBreakIdAndLocation mb_info
@@ -963,14 +971,25 @@ afterRunStmt step_here run_result = do
                return ()
          | otherwise -> resume step_here GHC.SingleStep >>=
                         afterRunStmt step_here >> return ()
-     _ -> return ()
 
   flushInterpBuffers
   liftIO installSignalHandlers
   b <- isOptionSet RevertCAFs
   when b revertCAFs
 
-  return (case run_result of GHC.RunOk _ -> True; _ -> False)
+  return run_result
+
+runSuccess :: Maybe GHC.ExecResult -> Bool
+runSuccess run_result
+  | Just (GHC.ExecComplete { execResult = Right _ }) <- run_result = True
+  | otherwise = False
+
+runAllocs :: Maybe GHC.ExecResult -> Maybe Integer
+runAllocs m = do
+  res <- m
+  case res of
+    GHC.ExecComplete{..} -> Just (fromIntegral execAllocation)
+    _ -> Nothing
 
 toBreakIdAndLocation ::
   Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
@@ -1369,7 +1388,7 @@ checkModule m = do
 -- :load, :add, :reload
 
 loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag
-loadModule fs = timeIt (loadModule' fs)
+loadModule fs = timeIt (const Nothing) (loadModule' fs)
 
 loadModule_ :: [FilePath] -> InputT GHCi ()
 loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return ()
diff --git a/testsuite/tests/ghc-api/T8628.hs b/testsuite/tests/ghc-api/T8628.hs
index 203d3282ab..d3b05a9f86 100644
--- a/testsuite/tests/ghc-api/T8628.hs
+++ b/testsuite/tests/ghc-api/T8628.hs
@@ -24,10 +24,10 @@ main
           setContext [ IIDecl (simpleImportDecl pRELUDE_NAME)
                      , IIDecl (simpleImportDecl (mkModuleNameFS (fsLit "System.IO")))]
           runDecls "data X = Y ()"
-          runStmt "print True" RunToCompletion
-          gtry $ runStmt "print (Y ())" RunToCompletion :: GhcMonad m => m (Either SomeException RunResult)
+          execStmt "print True" execOptions
+          gtry $ execStmt "print (Y ())" execOptions :: GhcMonad m => m (Either SomeException ExecResult)
           runDecls "data X = Y () deriving Show"
           _ <- dynCompileExpr "'x'"
-          runStmt "print (Y ())" RunToCompletion
-          runStmt "System.IO.hFlush System.IO.stdout" RunToCompletion
+          execStmt "print (Y ())" execOptions
+          execStmt "System.IO.hFlush System.IO.stdout" execOptions
         print "done"
diff --git a/testsuite/tests/ghc-api/T8639_api.hs b/testsuite/tests/ghc-api/T8639_api.hs
index 2ddfb4919e..36458b8eca 100644
--- a/testsuite/tests/ghc-api/T8639_api.hs
+++ b/testsuite/tests/ghc-api/T8639_api.hs
@@ -19,8 +19,8 @@ main
 
            -- With the next line, you get an "Not in scope" exception.
            -- If you comment out this runStmt, it runs without error and prints the  type.
-           runStmt "putStrLn (show 3)" RunToCompletion
-           runStmt "hFlush stdout" RunToCompletion
+           execStmt "putStrLn (show 3)" execOptions
+           execStmt "hFlush stdout" execOptions
 
            ty <- exprType "T8639_api_a.it"
            liftIO (putStrLn (showPpr flags ty))
diff --git a/testsuite/tests/ghc-api/apirecomp001/myghc.hs b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
index 39545c937d..a21aa47fa6 100644
--- a/testsuite/tests/ghc-api/apirecomp001/myghc.hs
+++ b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
@@ -44,11 +44,11 @@ main = do
     setContext [IIModule mod]
     liftIO $ hFlush stdout  -- make sure things above are printed before
                             -- interactive output
-    r <- runStmt "main" RunToCompletion
+    r <- execStmt "main" execOptions
     case r of
-      RunOk _        -> prn "ok"
-      RunException _ -> prn "exception"
-      RunBreak _ _ _ -> prn "breakpoint"
+      ExecComplete { execResult = Right _ } -> prn "ok"
+      ExecComplete { execResult = Left _ } -> prn "exception"
+      ExecBreak{} -> prn "breakpoint"
     liftIO $ hFlush stdout
     return ()