module Mueval.Concurrent where
import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, yield, ThreadId)
import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))
import Control.Exception (catchDyn, Exception(ErrorCall))
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
import Mueval.Interpreter
import Mueval.ParseArgs
watchDog :: Int -> ThreadId -> IO ()
watchDog tout tid = do installHandler sigXCPU
(CatchOnce
$ throwTo tid $ ErrorCall "Time limit exceeded.") Nothing
forkIO $ do threadDelay (tout * 1000000)
throwTo tid (ErrorCall "Time limit exceeded")
yield
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 [Char] -> IO ThreadId
forkedMain' opts mvar = do myThreadId >>= watchDog tout
hSetBuffering stdout NoBuffering
forkIO (interpreterSession typeprint extend mdls expr
`catchDyn` (printInterpreterError)
>> putMVar mvar "Done.")
where mdls = modules opts
expr = expression opts
tout = timeLimit opts
typeprint = printType opts
extend = extensions opts