module Mueval.Parallel where
import Prelude hiding (catch)
import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, ThreadId)
import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))
import Control.Exception.Extensible (ErrorCall(..),SomeException,catch)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
import Mueval.Interpreter
import Mueval.ArgsParse
watchDog :: Int -> ThreadId -> IO ()
watchDog tout tid = do _ <- installHandler sigXCPU
(CatchOnce
$ throwTo tid $ ErrorCall "Time limit exceeded.") Nothing
_ <- forkIO $ do
threadDelay (tout * 700000)
throwTo tid (ErrorCall "Time limit exceeded")
killThread tid
error "Time expired"
return ()
block :: (t -> MVar a -> IO t1) -> t -> IO a
block f opts = do mvar <- newEmptyMVar
_ <- f opts mvar
takeMVar mvar
forkedMain :: Options -> IO ()
forkedMain opts = block forkedMain' opts >> return ()
forkedMain' :: Options -> MVar String -> IO ThreadId
forkedMain' opts mvar = do mainId <- myThreadId
watchDog (timeLimit opts) mainId
hSetBuffering stdout NoBuffering
forkIO $ (interpreterSession (checkImport opts)
>> putMVar mvar "Done.")
`catch` \e -> throwTo mainId (e::SomeException)
where checkImport x = if noImports x then x{modules=Nothing} else x