X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=13267bd118ce430a002b3118e174ebb3da2378a6;hb=b3b2e825335fdf98b42e4facfc1ddd3c5feb31bd;hp=db1fd418c6a52ea82ed2579ee1a91853514f0854;hpb=de1a1f9f882cf1a5c81c4a152edc001aafd3f8a3;p=ghc-hetmet.git

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index db1fd41..13267bd 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -29,7 +29,6 @@ module InteractiveEval (
 	showModule,
         isModuleInterpreted,
 	compileExpr, dynCompileExpr,
-	lookupName,
         Term(..), obtainTermFromId, obtainTermFromVal, reconstructType,
         skolemiseSubst, skolemiseTy
 #endif
@@ -79,7 +78,7 @@ import System.Directory
 import Data.Dynamic
 import Data.List (find, partition)
 import Control.Monad
-import Foreign
+import Foreign hiding (unsafePerformIO)
 import Foreign.C
 import GHC.Exts
 import Data.Array
@@ -88,6 +87,7 @@ import Control.Concurrent
 import Data.List (sortBy)
 -- import Foreign.StablePtr
 import System.IO
+import System.IO.Unsafe
 
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
@@ -359,13 +359,13 @@ foreign import ccall "&rts_breakpoint_io_action"
 -- is not responding".
 -- 
 -- Careful here: there may be ^C exceptions flying around, so we start the new
--- thread blocked (forkIO inherits block from the parent, #1048), and unblock
+-- thread blocked (forkIO inherits mask from the parent, #1048), and unblock
 -- only while we execute the user's code.  We can't afford to lose the final
 -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946)
 sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
 sandboxIO dflags statusMVar thing =
-   block $ do  -- fork starts blocked
-     id <- forkIO $ do res <- Exception.try (unblock $ rethrow dflags thing)
+   mask $ \restore -> do  -- fork starts blocked
+     id <- forkIO $ do res <- Exception.try (restore $ rethrow dflags thing)
                        putMVar statusMVar (Complete res) -- empty: can't block
      withInterruptsSentTo id $ takeMVar statusMVar
 
@@ -933,14 +933,6 @@ parseName str = withSession $ \hsc_env -> do
    (L _ rdr_name) <- hscParseIdentifier (hsc_dflags hsc_env) str
    ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name
 
--- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
--- entity known to GHC, including 'Name's defined using 'runStmt'.
-lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
-lookupName name = withSession $ \hsc_env -> do
-  mb_tything <- ioMsg $ tcRnLookupName hsc_env name
-  return mb_tything
-  -- XXX: calls panic in some circumstances;  is that ok?
-
 -- -----------------------------------------------------------------------------
 -- Getting the type of an expression