On Thu, 9 Apr 2009 10:33:35 +0100
"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
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.