diff options
| -rw-r--r-- | compiler/main/GHC.hs | 62 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 131 | ||||
| -rw-r--r-- | compiler/main/InteractiveEvalTypes.hs | 37 | ||||
| -rw-r--r-- | ghc/GhciMonad.hs | 37 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 65 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/T8628.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/T8639_api.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/apirecomp001/myghc.hs | 8 |
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 () |