X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=7720b84d59e336ecfe566e5f94d735101501ad6d;hp=30096ab3be4fa0e7032e2a6ac0d89f80b2ee45d7;hb=b47555c3c6e7d9b6cbe17714fee9fd22d1779928;hpb=8bbebfe661bdc976965718a2a489515c4929a03f diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 30096ab..7720b84 100644 --- a/compiler/ghci/GhciMonad.hs +++ b/compiler/ghci/GhciMonad.hs @@ -39,6 +39,8 @@ import Data.IORef import Data.List import Data.Typeable import System.CPUTime +import System.Directory +import System.Environment import System.IO import Control.Monad as Monad import GHC.Exts @@ -46,6 +48,8 @@ import GHC.Exts ----------------------------------------------------------------------------- -- GHCi monad +type Command = (String, String -> GHCi Bool, Maybe String, String -> IO [String]) + data GHCiState = GHCiState { progname :: String, @@ -62,9 +66,26 @@ data GHCiState = GHCiState -- tickarrays caches the TickArray for loaded modules, -- so that we don't rebuild it each time the user sets -- a breakpoint. - cmdqueue :: [String] + -- ":" at the GHCi prompt repeats the last command, so we + -- remember is here: + last_command :: Maybe Command, + cmdqueue :: [String], + remembered_ctx :: [(CtxtCmd, [String], [String])], + -- we remember the :module commands between :loads, so that + -- on a :reload we can replay them. See bugs #2049, + -- #1873, #1360. Previously we tried to remember modules that + -- were supposed to be in the context but currently had errors, + -- but this was complicated. Just replaying the :module commands + -- seems to be the right thing. + virtual_path :: FilePath, + ghc_e :: Bool -- True if this is 'ghc -e' (or runghc) } +data CtxtCmd + = SetContext + | AddModules + | RemModules + type TickArray = Array Int [(BreakIndex,SrcSpan)] data GHCiOption @@ -176,6 +197,30 @@ printForUserPartWay doc = do unqual <- io (GHC.getPrintUnqual session) io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc +withVirtualPath :: GHCi a -> GHCi a +withVirtualPath m = do + ghci_wd <- io getCurrentDirectory -- Store the cwd of GHCi + st <- getGHCiState + io$ setCurrentDirectory (virtual_path st) + result <- m -- Evaluate in the virtual wd.. + vwd <- io getCurrentDirectory + setGHCiState (st{ virtual_path = vwd}) -- Update the virtual path + io$ setCurrentDirectory ghci_wd -- ..and restore GHCi wd + return result + +runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult +runStmt expr step = withVirtualPath$ do + session <- getSession + st <- getGHCiState + io$ withProgName (progname st) $ withArgs (args st) $ + GHC.runStmt session expr step + +resume :: GHC.SingleStep -> GHCi GHC.RunResult +resume step = withVirtualPath$ do + session <- getSession + io$ GHC.resume session step + + -- -------------------------------------------------------------------------- -- timing & statistics @@ -207,10 +252,11 @@ printTimes allocs psecs ----------------------------------------------------------------------------- -- reverting CAFs -revertCAFs :: IO () +revertCAFs :: GHCi () revertCAFs = do - rts_revertCAFs - turnOffBuffering + io $ rts_revertCAFs + s <- getGHCiState + when (not (ghc_e s)) $ io turnOffBuffering -- Have to turn off buffering again, because we just -- reverted stdout, stderr & stdin to their defaults.