TyCon,
tyConTyVars, tyConDataCons, tyConArity,
isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
- getSynTyConDefn,
+ synTyConDefn, synTyConRhs,
-- ** Type variables
TyVar,
import TysPrim ( alphaTyVars )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
isPrimTyCon, isFunTyCon, tyConArity,
- tyConTyVars, tyConDataCons, getSynTyConDefn )
+ tyConTyVars, tyConDataCons, synTyConDefn, synTyConRhs )
import Class ( Class, classSCTheta, classTvsFds, classMethods )
import FunDeps ( pprFundeps )
import DataCon ( DataCon, dataConWrapId, dataConSig, dataConTyCon,
import SysTools ( cleanTempFilesExcept )
import BasicTypes
import TcType ( tcSplitSigmaTy, isDictTy )
-
-import Directory ( getModificationTime, doesFileExist )
-import Maybe ( isJust, isNothing, fromJust )
import Maybes ( expectJust, mapCatMaybes )
-import List ( partition, nub )
-import qualified List
-import Monad ( unless, when )
-import System ( exitWith, ExitCode(..) )
-import Time ( ClockTime )
-import EXCEPTION as Exception hiding (handle)
-import DATA_IOREF
-import IO
+
+import Control.Concurrent
+import System.Directory ( getModificationTime, doesFileExist )
+import Data.Maybe ( isJust, isNothing, fromJust )
+import Data.List ( partition, nub )
+import qualified Data.List as List
+import Control.Monad ( unless, when )
+import System.Exit ( exitWith, ExitCode(..) )
+import System.Time ( ClockTime )
+import Control.Exception as Exception hiding (handle)
+import Data.IORef
+import System.IO
+import System.IO.Error ( isDoesNotExistError )
+import System.IO.Unsafe ( unsafePerformIO )
import Prelude hiding (init)
+#if __GLASGOW_HASKELL__ < 600
+import System.IO as System.IO.Error ( try )
+#else
+import System.IO.Error ( try )
+#endif
+
-- -----------------------------------------------------------------------------
-- Exception handlers
init :: [String] -> IO [String]
init args = do
-- catch ^C
+ main_thread <- myThreadId
+ putMVar interruptTargetThread [main_thread]
installSignalHandlers
-- Grab the -B option if there is one
case maybe_buf of
Just (_,t) -> check_timestamp old_summary location src_fn t
Nothing -> do
- m <- IO.try (getModificationTime src_fn)
+ m <- System.IO.Error.try (getModificationTime src_fn)
case m of
Right t -> check_timestamp old_summary location src_fn t
Left e | isDoesNotExistError e -> find_it
writeIORef ref new_hsc_env
return (RunOk names)
-
--- We run the statement in a "sandbox" to protect the rest of the
--- system from anything the expression might do. For now, this
--- consists of just wrapping it in an exception handler, but see below
--- for another version.
-
+-- When running a computation, we redirect ^C exceptions to the running
+-- thread. ToDo: we might want a way to continue even if the target
+-- thread doesn't die when it receives the exception... "this thread
+-- is not responding".
sandboxIO :: IO a -> IO (Either Exception a)
-sandboxIO thing = Exception.try thing
+sandboxIO thing = do
+ m <- newEmptyMVar
+ ts <- takeMVar interruptTargetThread
+ child <- forkIO (do res <- Exception.try thing; putMVar m res)
+ putMVar interruptTargetThread (child:ts)
+ takeMVar m `finally` modifyMVar_ interruptTargetThread (return.tail)
{-
-- This version of sandboxIO runs the expression in a completely new