STM and IO

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

STM and IO

emmanuel.delaborde
Hello list

I am trying to use STM for shared access to a file

I first used a TVar to to accumulate the text returned by the threads
and write TVar's content to a file after a delay (how do you ensure  
all threads have terminated by the way, that would be more robust than  
using an arbitrary delay)


-- this works
main = do
     let fname = "store.txt"
     store <- atomically $ newTVar ""
     forkIO $ 10 `replicateM_` (thread store)
     threadDelay 800000
     txt <- atomically (readTVar store)
     writeFile fname txt

thread :: TVar (String) -> IO ()
thread store = atomically ( readTVar store >>= writeTVar store . (++ "  
some text "))


But when I try to concurrently write to the file, I get into troubles.
I keep the file handle in a TMVar, hoping than just one thread at a  
time will be able to use that handle
but nothing gets written to "store.txt" ? Is my IO too lazy ?


-- this does not work
main = do
    let fname = "store.txt"
    fh <- openFile fname ReadWriteMode
    store <- atomically $ newTMVar fh
    forkIO $ 10 `replicateM_` (writeTo store)

writeTo :: TMVar (Handle) -> IO ()
writeTo store = do
    fh <- atomically $ takeTMVar store
    text <- hGetContents fh
    hPutStr fh (text ++ " some text ")
    atomically $ putTMVar store fh


Thank you

--
Emmanuel Delaborde

-----------------------------------------------------------------------------------------------

This e-mail (and any attachments) is confidential and may contain
personal views which are not the views of Cimex Media Ltd and
any affiliated companies, unless specifically stated. It is intended
for the use of the individual or group to whom it is addressed. If
you have received it in error, please delete it from your system,
do not use, copy or disclose the information in any way nor act in
reliance on it and please notify [hidden email]

A company registered in England  Wales. Company Number 03765711
Registered Office : The Olde Bakehouse, 156 Watling Street East, Towcester,
Northants NN12 6DB

This email was scanned by Postini, the leading provider in Managed Email Security.

Reply | Threaded
Open this post in threaded view
|

STM and IO

Quentin Moser
On Thu, 9 Apr 2009 10:33:35 +0100
"emmanuel.delaborde" <[hidden email]> wrote:

> Hello list
>
> I am trying to use STM for shared access to a file
>
> I first used a TVar to to accumulate the text returned by the threads
> and write TVar's content to a file after a delay (how do you ensure  
> all threads have terminated by the way, that would be more robust
> than using an arbitrary delay)
>
>
> -- this works
> main = do
>      let fname = "store.txt"
>      store <- atomically $ newTVar ""
>      forkIO $ 10 `replicateM_` (thread store)
>      threadDelay 800000
>      txt <- atomically (readTVar store)
>      writeFile fname txt
>
> thread :: TVar (String) -> IO ()
> thread store = atomically ( readTVar store >>= writeTVar store . (++
> " some text "))
>
>
> But when I try to concurrently write to the file, I get into troubles.
> I keep the file handle in a TMVar, hoping than just one thread at a  
> time will be able to use that handle
> but nothing gets written to "store.txt" ? Is my IO too lazy ?
>
>
> -- this does not work
> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     forkIO $ 10 `replicateM_` (writeTo store)
>
> writeTo :: TMVar (Handle) -> IO ()
> writeTo store = do
>     fh <- atomically $ takeTMVar store
>     text <- hGetContents fh
>     hPutStr fh (text ++ " some text ")
>     atomically $ putTMVar store fh
>
>
> Thank you
>

Your problem has nothing to do with lazyness; Haskell simply kills all
other threads when the main thread returns from main. You have to
somehow wait for them to complete in main or they won't have time to
run.

As strange as it seems, I don't think the standard libraries provide an
easy way to do this, but you can implement it yourself.

Here's an example inspired by the documentation of Control.Concurrent:

> import Control.Concurrent
> import Control.Exception (finally)
>
> myFork :: IO () -> IO (MVar ())
> myFork a = do v <- newEmptyMVar
>               a `finally` (putMVar v ())
>
> myWait :: MVar () -> IO ()
> myWait = readMVar

With this, you could rewrite your main like this:

> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     waitMe <- myFork $ 10 `replicateM_` (writeTo store)
>     myWait waitMe


Now onto the second problem: ignore me if I'm wrong, but it seems your
intent is to spawn 10 threads that will each try to run (writeTo store)
once. What your current code does is spawn one thread that sequentially
runs writeTo 10 times.

To create 10 threads, you should fork inside the replicateM, not
outside. Here's how you could correct this (again using myFork and
myWait from above):

> main = do
>     let fname = "store.txt"
>     fh <- openFile fname ReadWriteMode
>     store <- atomically $ newTMVar fh
>     waitMes <- 10 `replicateM` (myFork $ writeTo store))
>     mapM_ myWait waitMes

(make sure you use replicateM and not replicateM_ or you'll get a type
error)


Note: I haven't tried running any of this code, but it seems simple
enough to be confident in.
Reply | Threaded
Open this post in threaded view
|

STM and IO

Quentin Moser
On Thu, 9 Apr 2009 12:03:03 +0200
Quentin Moser <[hidden email]> wrote:

> Here's an example inspired by the documentation of Control.Concurrent:
>
> > import Control.Concurrent
> > import Control.Exception (finally)
> >
> > myFork :: IO () -> IO (MVar ())
> > myFork a = do v <- newEmptyMVar
> >               a `finally` (putMVar v ())
> >
> > myWait :: MVar () -> IO ()
> > myWait = readMVar

Oops, my code is completely messed up. Here's a correct version:

> myFork a = do v <- newEmptyMVar
>               forkIO $ a `finally` putMVar v ()
>               return v

> myWait = readMVar >> return ()