[Haskell-cafe] multi-thread and lazy evaluation

Corentin Dupont corentin.dupont at gmail.com
Mon Dec 24 14:45:47 CET 2012


Sorry, I'm thinking my example program wasn't maybe too explicit.
In it, the line *"let (a::String) = a"* represents the program submitted by
the user, that is faulty.
The objective is to stop it after some time, and set the (TVar MyData) to
its previous value.
As you can see, it works only if I put a "putStrLn" in the same thread to
force the evaluation....

*{-# LANGUAGE ScopedTypeVariables #-}

import Control.Concurrent.STM.TVar
import Control.Concurrent.MVar
import Control.Concurrent
import Control.Monad.STM

data MyData = MyData { a :: String, b :: String } deriving (Show)

main = do
   tv <- atomically $ newTVar $ MyData "a" "b"
   protectedExecCommand tv
   myNewData <- atomically $ readTVar tv
   putStrLn $ show myNewData


protectedExecCommand :: (TVar MyData) -> IO ()
protectedExecCommand tv = do
    mv <- newEmptyMVar
    before <- atomically $ readTVar tv
    id <- forkIO $ execBlocking mv
    forkIO $ watchDog' 5 id mv
    res <- takeMVar mv
    case res of
       Nothing -> (atomically $ writeTVar tv before)
       Just after -> (atomically $ writeTVar tv after)

watchDog' :: Int -> ThreadId -> MVar (Maybe x) -> IO ()
watchDog' t tid mv = do
   threadDelay $ t * 1000000
   killThread tid
   putStrLn $ "process timeout "
   tryPutMVar mv Nothing
   return ()

execBlocking :: MVar (Maybe MyData) -> IO ()
execBlocking mv = do
   let (a::String) = a
   --If you uncomment the next line, it will work
   --putStrLn $ show a
   putMVar mv (Just $ MyData a "toto")*

On Mon, Dec 24, 2012 at 1:17 PM, Corentin Dupont
<corentin.dupont at gmail.com>wrote:

> Hi all,
> I have a program where the user can submit his own little programs, which
> are interpreted using Hint. The user-submitted programs are used to modify
> a state held in a TVar.
> As of course those user-submitted programs can't be trusted, I'm trying to
> protect them, like in Mueval.
> I installed a watchdog to monitor and kill the user's thread if it doesn't
> finish. However it doesn't work properly, due to lazy evaluation I believe.
> I made a little exemple to illustrate the problem.
>
> -> The following program doesn't terminate, but if you uncomment the
> "putStrLn" at the end, it will.
> Could someone explain me this and how to do it properly??
>
> Merry Christmas to all!!!!
> Corentin
> *
> {-# LANGUAGE ScopedTypeVariables #-}
>
> import Control.Concurrent.STM.TVar
> import Control.Concurrent.MVar
> import Control.Concurrent
> import Control.Monad.STM
>
> data MyData = MyData { a :: String, b :: String } deriving (Show)
>
> main = do
>    tv <- atomically $ newTVar $ MyData "a" "b"
>    protectedExecCommand tv
>    myNewData <- atomically $ readTVar tv
>    putStrLn $ show myNewData
>
>
> protectedExecCommand :: (TVar MyData) -> IO ()
> protectedExecCommand tv = do
>     mv <- newEmptyMVar
>     before <- atomically $ readTVar tv
>     id <- forkIO $ execBlocking mv
>     forkIO $ watchDog' 5 id mv
>     res <- takeMVar mv
>     case res of
>        Nothing -> (atomically $ writeTVar tv before)
>        Just after -> (atomically $ writeTVar tv after)
>
> watchDog' :: Int -> ThreadId -> MVar (Maybe x) -> IO ()
> watchDog' t tid mv = do
>    threadDelay $ t * 1000000
>    killThread tid
>    putStrLn $ "process timeout "
>    tryPutMVar mv Nothing
>    return ()
>
> execBlocking :: MVar (Maybe MyData) -> IO ()
> execBlocking mv = do
>    let (a::String) = a
>    --If you uncomment the next line, it will work
>    --putStrLn $ show a
>    putMVar mv (Just $ MyData a "toto")*
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20121224/584c90b4/attachment.htm>


More information about the Haskell-Cafe mailing list