[Progress on ch25 Bryan O'Sullivan **20080523063929] { addfile ./examples/ch25/Chan.hs addfile ./examples/ch25/niceFork.ghci hunk ./en/ch15-monads.xml 1587 - + hunk ./en/ch25-concurrent.xml 101 - Communication between threads + Simple communication between threads hunk ./en/ch25-concurrent.xml 147 + + If you're coming from a background of concurrent programming + in a traditional language, you can think of an MVar + as being useful for two familiar purposes. + + + + Sending a message from one thread to another, e.g. a + notification. + + + Providing mutual exclusion for a + piece of mutable data that is shared among threads. We put + the data into the MVar when it is not being + used by any thread, and one thread takes it out temporarily + to read or modify it. + + + hunk ./en/ch25-concurrent.xml 185 - the usual recipe: we wrapping it in a &newtype; and retain - control over the means for creating a value of this type. Among - our module's exports, we list the type constructor and the - IO action that constructs a manager, but we do not - export the data constructor. + the usual recipe: we wrap it in a &newtype;, and prevent clients + from creating values of this type. Among our module's exports, + we list the type constructor and the IO action that + constructs a manager, but we do not export the data + constructor. hunk ./en/ch25-concurrent.xml 219 - The modifyMVar function that we use - in this example is very useful: it's a - safe combination of - takeMVar and + The modifyMVar function that we used + in forkManaged above is very useful: it's + a safe combination of takeMVar and hunk ./en/ch25-concurrent.xml 227 - it to a function. This function can both modify the value and - return a result. If the function throws an exception, + it to a function. This function can both generate a new value + and return a result. If the function throws an exception, hunk ./en/ch25-concurrent.xml 264 - Safe resource management: not just a good idea + Safe resource management: a good idea, and easy besides hunk ./en/ch25-concurrent.xml 268 - other resource management situations. + other resource management situations. Here are the steps of + the pattern. hunk ./en/ch25-concurrent.xml 280 - Always release the resource, even if an exception - occurs. If the function threw an exception, rethrow - it. + Always release the resource, even if the function + throws an exception. If that occurs, rethrow the exception + so it can be caught by application code. hunk ./en/ch25-concurrent.xml 290 - this pattern visually unobtrusive. + this style of coding visually unobtrusive. hunk ./en/ch25-concurrent.xml 293 - so that you can see the general form of this pattern. + so that you can see a specific form of this pattern. hunk ./en/ch25-concurrent.xml 297 - It should be easy to adapt this code to your specific + You should easily be able to adapt this to your particular hunk ./en/ch25-concurrent.xml 301 + + + Finding the status of a thread + + Our getStatus function tells us the + current state of a thread. If the thread is no longer managed + (or was never managed in the first place), it returns + Nothing. + + &NiceFork.hs:getStatus; + + If the thread is still running, it returns Just + Running. Otherwise, it indicates why the thread + terminated, and stops managing the + thread. + + If the tryTakeMVar function finds + that the MVar is empty, it returns + Nothing immediately instead of blocking. + + &mvar.ghci:tryTakeMVar; + + Otherwise, it extracts the value from the + MVar as usual. + + The waitFor function behaves + similarly, but instead of returning immediately, it blocks + until the given thread terminates before returning. + + &NiceFork.hs:waitFor; + + It first extracts the MVar that holds the + thread's state, if it exists. The Map type's + updateLookupWithKey function is useful: + it combines looking up a key with modifying or removing the + value. + + &niceFork.ghci:updateLookupWithKey; + + In this case, we want to always remove the + MVar holding the thread's state if it is present, + so that our thread manager will no longer be managing the + thread. If there was a value to extract, we take the thread's + exit status from the MVar and return it. + + Our final useful function simply waits for all currently + managed threads to complete, and ignores their exit + statuses. + + &NiceFork.hs:waitAll; + + + + Writing tighter code + + Our definition of waitFor above is a + little unsatisfactory, because we're performing more or less + the same case analysis in two places: inside the function + called by modifyMVar, and again on its + return value. + + Sure enough, we can apply a function that we came across + earlier to eliminate this duplication. The function in + question is join, from the + Control.Monad module. + + &niceFork.ghci:join; + + The trick here is to see that we can get rid of the second + &case; expression by having the first one return the + IO action that we should perform once we return + from modifyMVar. We'll use + join to execute the action. + + &NiceFork.hs:waitFor2; + + This is an interesting idea: we can create a monadic + function or action in pure code, then pass it around until we + end up in a monad where we can use it. This can be a nimble + way to write code, once we develop an eye for when it makes + sense. + hunk ./en/ch25-concurrent.xml 385 + + Communicating over channels + + For one-shot communications between threads, an + MVar is perfectly good. Another type, + Chan, provides a one-way communication channel. + Here is a simple example of its use. + + &Chan.hs:chanExample; + + If a Chan is empty, + readChan blocks until there is a value to + read. The writeChan function never blocks: + it writes a new value into a Chan + immediately. + + + Chan is unbounded + + Because writeChan always succeeds + immediately, there is a potential risk to using a + Chan. If one thread continually writes to the + Chan more often than another thread reads from + it, the Chan will grow in an unchecked + manner. + + + + Exercises + + + + + The Chan type is implemented using + MVars. Use MVars to develop a + BoundedChan library. + + + + + + Your newBoundedChan function + should accept an Int parameter, limiting + the number of unread items that can be present in a + BoundedChan at once. + + + + + + If this limit is hit, a call to your + writeBoundedChan function must + block until a reader uses + readBoundedChan to consume a + value. + + + + + + + + MVar and Chan are non-strict + + Like most Haskell container types, both MVar + and Chan are non-strict: neither one evaluates its + contents. + hunk ./examples/ch25/Chan.hs 1 +{-- snippet chanExample --} +import Control.Concurrent +import Control.Concurrent.Chan + +chanExample = do + ch <- newChan + forkIO $ do + writeChan ch "hello world" + writeChan ch "now i quit" + readChan ch >>= print + readChan ch >>= print +{-- /snippet chanExample --} hunk ./examples/ch25/ModifyMVar.hs 10 - (a',b) <- unblock (io a) `catch` \e -> - putMVar m a >> throw e - putMVar m a' - return b + (b,r) <- unblock (io a) `catch` \e -> + putMVar m a >> throw e + putMVar m b + return r hunk ./examples/ch25/NiceFork.hs 13 +import Control.Monad (join) hunk ./examples/ch25/NiceFork.hs 88 - (Just done, m') -> (m', Just done) + (done, m') -> (m', done) hunk ./examples/ch25/NiceFork.hs 94 +{-- snippet waitFor2 --} +waitFor2 (Mgr mgr) tid = + join . modifyMVar mgr $ \m -> + return $ case M.updateLookupWithKey (\_ _ -> Nothing) tid m of + (Nothing, _) -> (m, return Nothing) + (Just st, m') -> (m', Just `fmap` takeMVar st) +{-- /snippet waitFor2 --} + hunk ./examples/ch25/NiceFork.hs 103 -waitAll (Mgr mgr) = do - m <- takeMVar mgr - putMVar mgr M.empty - mapM_ takeMVar (M.elems m) +waitAll (Mgr mgr) = modifyMVar mgr elems >>= mapM_ takeMVar + where elems m = return (M.empty, M.elems m) hunk ./examples/ch25/mvar.ghci 18 +--# tryTakeMVar +:t tryTakeMVar + hunk ./examples/ch25/niceFork.ghci 1 +--# join +:m +Control.Monad +:t join + +--# updateLookupWithKey +:m +Data.Map +:t updateLookupWithKey + +--# +:load NiceFork }