X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=5acb36e57d2329869eadec57f8d3343cbc29441f;hb=aa0c0de94e25aa64139688f8e4c4ba51ddca6f54;hp=82c9aab84c94f400aa208dcbabf7261311c12801;hpb=1c83695b5b9ae3175c18908c1d58aeadb1f225ae;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 82c9aab..5acb36e 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -23,14 +23,14 @@ import Debugger -- The GHC interface import qualified GHC hiding (resume, runStmt) import GHC ( LoadHowMuch(..), Target(..), TargetId(..), - Module, ModuleName, TyThing(..), Phase, - BreakIndex, SrcSpan, Resume, SingleStep, + TyThing(..), Phase, + BreakIndex, Resume, SingleStep, Ghc, handleSourceError ) import PprTyThing import DynFlags import Packages -import PackageConfig +-- import PackageConfig import UniqFM import HscTypes ( implicitTyThings, handleFlagWarnings ) @@ -39,7 +39,6 @@ import Outputable hiding (printForUser, printForUserPartWay) import Module -- for ModuleEnv import Name import SrcLoc -import ObjLink -- Other random utilities import CmdLineParser @@ -54,11 +53,7 @@ import NameSet import Maybes ( orElse, expectJust ) import FastString import Encoding - -#if __GLASGOW_HASKELL__ < 611 import Foreign.C -import Encoding -#endif #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) @@ -73,7 +68,6 @@ import Control.Monad.Trans --import SystemExts import Exception hiding (catch, block, unblock) -import qualified Exception -- import Control.Concurrent @@ -96,6 +90,7 @@ import GHC.Exts ( unsafeCoerce# ) #if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) +import GHC.IO.Handle ( hFlushAll ) #else import GHC.IOBase ( IOErrorType(InvalidArgument) ) #endif @@ -295,14 +290,16 @@ findEditor = do return "" #endif +foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt + interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () interactiveUI srcs maybe_exprs = do -- although GHCi compiles with -prof, it is not usable: the byte-code -- compiler and interpreter don't work with profiling. So we check for -- this up front and emit a helpful error message (#2197) - m <- liftIO $ lookupSymbol "PushCostCentre" - when (isJust m) $ + i <- liftIO $ isProfiled + when (i /= 0) $ ghcError (InstallationError "GHCi cannot be used when compiled with -prof") -- HACK! If we happen to get into an infinite loop (eg the user @@ -313,9 +310,9 @@ interactiveUI srcs maybe_exprs = do -- it refers to might be finalized, including the standard Handles. -- This sounds like a bug, but we don't have a good solution right -- now. - liftIO $ newStablePtr stdin - liftIO $ newStablePtr stdout - liftIO $ newStablePtr stderr + _ <- liftIO $ newStablePtr stdin + _ <- liftIO $ newStablePtr stdout + _ <- liftIO $ newStablePtr stderr -- Initialise buffering for the *interpreted* I/O system initInterpBuffering @@ -622,7 +619,7 @@ runOneCommand eh getCmd = do -- QUESTION: is userError the one to use here? collectError = userError "unterminated multiline command :{ .. :}" doCommand (':' : cmd) = specialCommand cmd - doCommand stmt = do timeIt $ lift $ runStmt stmt GHC.RunToCompletion + doCommand stmt = do _ <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion return False enqueueCommands :: [String] -> GHCi () @@ -636,7 +633,16 @@ runStmt stmt step | null (filter (not.isSpace) stmt) = return False | ["import", mod] <- words stmt = keepGoing' setContext ('+':mod) | otherwise - = do result <- GhciMonad.runStmt stmt step + = do +#if __GLASGOW_HASKELL__ >= 611 + -- In the new IO library, read handles buffer data even if the Handle + -- is set to NoBuffering. This causes problems for GHCi where there + -- are really two stdin Handles. So we flush any bufferred data in + -- GHCi's stdin Handle here (only relevant if stdin is attached to + -- a file, otherwise the read buffer can't be flushed). + _ <- liftIO $ IO.try $ hFlushAll stdin +#endif + result <- GhciMonad.runStmt stmt step afterRunStmt (const True) result --afterRunStmt :: GHC.RunResult -> GHCi Bool @@ -868,7 +874,7 @@ changeDirectory dir = do outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n" prev_context <- GHC.getContext GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets lift $ setContextAfterLoad prev_context False [] GHC.workingDirectoryChanged dir <- expandPath dir @@ -887,7 +893,7 @@ editFile str = let cmd = editor st when (null cmd) $ ghcError (CmdLineError "editor not set, use :set editor") - io $ system (cmd ++ ' ':file) + _ <- io $ system (cmd ++ ' ':file) return () -- The user didn't specify a file so we pick one for them. @@ -982,17 +988,17 @@ loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule fs = timeIt (loadModule' fs) loadModule_ :: [FilePath] -> InputT GHCi () -loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return () +loadModule_ fs = loadModule (zip fs (repeat Nothing)) >> return () loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule' files = do prev_context <- GHC.getContext -- unload first - GHC.abandonAll + _ <- GHC.abandonAll lift discardActiveBreakPoints GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets let (filenames, phases) = unzip files exp_filenames <- mapM expandPath filenames @@ -1029,7 +1035,7 @@ checkModule m = do reloadModule :: String -> InputT GHCi () reloadModule m = do prev_context <- GHC.getContext - doLoad True prev_context $ + _ <- doLoad True prev_context $ if null m then LoadAllTargets else LoadUpTo (GHC.mkModuleName m) return () @@ -1447,7 +1453,7 @@ newDynFlags minus_opts = do when (packageFlags dflags /= pkg_flags) $ do io $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." GHC.setTargets [] - GHC.load LoadAllTargets + _ <- GHC.load LoadAllTargets io (linkPackages dflags new_pkgs) -- package flags changed, we can't re-use any of the old context setContextAfterLoad ([],[]) False [] @@ -1791,7 +1797,7 @@ pprintCommand bind force str = do stepCmd :: String -> GHCi () stepCmd [] = doContinue (const True) GHC.SingleStep -stepCmd expression = do runStmt expression GHC.SingleStep; return () +stepCmd expression = runStmt expression GHC.SingleStep >> return () stepLocalCmd :: String -> GHCi () stepLocalCmd [] = do @@ -1829,7 +1835,7 @@ enclosingTickSpan mod src = do traceCmd :: String -> GHCi () traceCmd [] = doContinue (const True) GHC.RunAndLogSteps -traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return () +traceCmd expression = runStmt expression GHC.RunAndLogSteps >> return () continueCmd :: String -> GHCi () continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion @@ -1838,7 +1844,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi () doContinue pred step = do runResult <- resume pred step - afterRunStmt pred runResult + _ <- afterRunStmt pred runResult return () abandonCmd :: String -> GHCi () @@ -2224,7 +2230,7 @@ lookupModule modName discardActiveBreakPoints :: GHCi () discardActiveBreakPoints = do st <- getGHCiState - mapM (turnOffBreak.snd) (breaks st) + mapM_ (turnOffBreak.snd) (breaks st) setGHCiState $ st { breaks = [] } deleteBreak :: Int -> GHCi () @@ -2236,7 +2242,7 @@ deleteBreak identity = do then printForUser (text "Breakpoint" <+> ppr identity <+> text "does not exist") else do - mapM (turnOffBreak.snd) this + mapM_ (turnOffBreak.snd) this setGHCiState $ st { breaks = rest } turnOffBreak :: BreakLocation -> GHCi Bool