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 * 500000)
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 fls expr
`catchDyn` (printInterpreterError)
>> putMVar mvar "Done.")
where mdls = if impq then Nothing else Just (modules opts)
expr = expression opts
tout = timeLimit opts
typeprint = printType opts
extend = extensions opts
fls = loadFile opts
impq = noimports opts