remove the ITBL_SIZE constants which were wrong, but fortunately unused
[ghc-hetmet.git] / compiler / ghci / GhciMonad.hs
index d95fc59..eaea844 100644 (file)
@@ -1,3 +1,11 @@
+-----------------------------------------------------------------------------
+--
+-- Monadery code used in InteractiveUI
+--
+-- (c) The GHC Team 2005-2006
+--
+-----------------------------------------------------------------------------
+
 module GhciMonad where
 
 #include "HsVersions.h"
@@ -8,6 +16,7 @@ import Breakpoints
 import Outputable
 import Panic hiding (showException)
 import Util
+import DynFlags
 
 import Numeric
 import Control.Exception as Exception
@@ -15,6 +24,7 @@ import Data.Char
 import Data.Dynamic
 import Data.Int         ( Int64 )
 import Data.IORef
+import Data.List
 import Data.Typeable
 import System.CPUTime
 import System.IO
@@ -123,6 +133,8 @@ showForUser doc = do
 
 data InfSessionException = 
              StopChildSession -- A child session requests to be stopped
+           | StopParentSession -- A child session requests to be stopped 
+                               -- AND that the parent session quits after that
            | ChildSessionStopped String  -- A child session has stopped
   deriving Typeable
 
@@ -175,14 +187,33 @@ foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
 GLOBAL_VAR(flush_interp,       error "no flush_interp", IO ())
 GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ())
 
-no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
-            " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
-flush_cmd  = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush System.IO.stderr"
+command_sequence :: [String] -> String
+command_sequence = unwords . intersperse "Prelude.>>"
+
+no_buffer :: String -> String
+no_buffer h = unwords ["System.IO.hSetBuffering",
+                       "System.IO." ++ h,
+                       "System.IO.NoBuffering"]
+
+no_buf_cmd :: String
+no_buf_cmd = command_sequence $ map no_buffer ["stdout", "stderr", "stdin"]
+
+flush_buffer :: String -> String
+flush_buffer h = unwords ["System.IO.hFlush", "System.IO." ++ h]
+
+flush_cmd :: String
+flush_cmd = command_sequence [flush_buffer "stdout", flush_buffer "stderr"]
 
 initInterpBuffering :: GHC.Session -> IO ()
 initInterpBuffering session
- = do maybe_hval <- GHC.compileExpr session no_buf_cmd
-       
+ = do -- we don't want to be fooled by any modules lying around in the current
+      -- directory when we compile these code fragments, so set the import
+      -- path to be empty while we compile them.
+      dflags <- GHC.getSessionDynFlags session
+      GHC.setSessionDynFlags session dflags{importPaths=[]}
+
+      maybe_hval <- GHC.compileExpr session no_buf_cmd
+
       case maybe_hval of
        Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
        other     -> panic "interactiveUI:setBuffering"
@@ -192,6 +223,8 @@ initInterpBuffering session
        Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
        _         -> panic "interactiveUI:flush"
 
+      GHC.setSessionDynFlags session dflags
+      GHC.workingDirectoryChanged session
       return ()