module Mueval.Parallel where
import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, ThreadId)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar)
import Control.Exception.Extensible as E (ErrorCall(..),SomeException,catch)
import Control.Monad (void)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))
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 = void (block forkedMain' opts)
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.")
`E.catch` \e -> throwTo mainId (e::SomeException)
where checkImport x = if noImports x then x{modules=Nothing} else x