X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=dc16f25549b2957a27e1f09ddf50f8a0dda09acf;hb=3d5970436af5ab73957278671059e00d1a52c616;hp=8de9d386085657da1473606c523ea90c7f3bcb29;hpb=c2fd45f3496040a6bc7ce8110ffe9e14bad6564f;p=ghc-hetmet.git diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs index 8de9d38..dc16f25 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 @@ -68,11 +70,21 @@ data GHCiState = GHCiState -- remember is here: last_command :: Maybe Command, cmdqueue :: [String], - remembered_ctx :: Maybe ([Module],[Module]) - -- modules we want to add to the context, but can't - -- because they currently have errors. Set by :reload. + 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 } +data CtxtCmd + = SetContext + | AddModules + | RemModules + type TickArray = Array Int [(BreakIndex,SrcSpan)] data GHCiOption @@ -184,6 +196,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