X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FGhciMonad.hs;h=7720b84d59e336ecfe566e5f94d735101501ad6d;hp=c92c4e0d0d3f26e3dc9ff97a0e58fe6031f3293b;hb=b47555c3c6e7d9b6cbe17714fee9fd22d1779928;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index c92c4e0..7720b84 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -6,11 +6,11 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module GhciMonad where
@@ -18,7 +18,7 @@ module GhciMonad where
 #include "HsVersions.h"
 
 import qualified GHC
-import Outputable       hiding (printForUser)
+import Outputable       hiding (printForUser, printForUserPartWay)
 import qualified Outputable
 import Panic            hiding (showException)
 import Util
@@ -27,6 +27,7 @@ import HscTypes
 import SrcLoc
 import Module
 import ObjLink
+import StaticFlags
 
 import Data.Maybe
 import Numeric
@@ -38,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
@@ -45,6 +48,8 @@ import GHC.Exts
 -----------------------------------------------------------------------------
 -- GHCi monad
 
+type Command = (String, String -> GHCi Bool, Maybe String, String -> IO [String])
+
 data GHCiState = GHCiState
      { 
 	progname       :: String,
@@ -61,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 
@@ -169,6 +191,36 @@ printForUser doc = do
   unqual <- io (GHC.getPrintUnqual session)
   io $ Outputable.printForUser stdout unqual doc
 
+printForUserPartWay :: SDoc -> GHCi ()
+printForUserPartWay doc = do
+  session <- getSession
+  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
 
@@ -200,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.