[project @ 2003-01-23 17:45:40 by ross]

[ghc-base.git] / Control / Concurrent / MVar.hs

diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index b246bf8..ea037ba 100644 (file)
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -2,18 +2,20 @@
 -- |
 -- Module      :  Control.Concurrent.MVar
 -- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (concurrency)
 --
--- MVars: Synchronising variables
+-- Synchronising variables
 --
 -----------------------------------------------------------------------------
 
 module Control.Concurrent.MVar
-       ( MVar          -- abstract
+       ( 
+         -- * @MVar@s
+         MVar          -- abstract
        , newEmptyMVar  -- :: IO (MVar a)
        , newMVar       -- :: a -> IO (MVar a)
        , takeMVar      -- :: MVar a -> IO a
@@ -26,15 +28,15 @@ module Control.Concurrent.MVar
        , withMVar      -- :: MVar a -> (a -> IO b) -> IO b
        , modifyMVar_   -- :: MVar a -> (a -> IO a) -> IO ()
        , modifyMVar    -- :: MVar a -> (a -> IO (a,b)) -> IO b
+#ifndef __HUGS__
        , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
+#endif
     ) where
 
 #ifdef __HUGS__
-import ConcBase        ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
+import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
                  tryTakeMVar, tryPutMVar, isEmptyMVar,
-                  readMVar, swapMVar,
                )
-import Prelude hiding( catch )
 #endif
 
 #ifdef __GLASGOW_HASKELL__
@@ -43,15 +45,13 @@ import GHC.Conc     ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
                )
 #endif
 
+import Prelude
 import Control.Exception as Exception
 
-#ifdef __HUGS__
--- This is as close as Hugs gets to providing throw
-throw :: Exception -> IO a
-throw = throwIO
-#endif
-
-#ifdef __GLASGOW_HASKELL__
+{-|
+  This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
+  from the 'MVar', puts it back, and also returns it.
+-}
 readMVar :: MVar a -> IO a
 readMVar m =
   block $ do
@@ -59,11 +59,20 @@ readMVar m =
     putMVar m a
     return a
 
+-- |Swap the contents of an 'MVar' for a new value.
 swapMVar :: MVar a -> a -> IO a
-swapMVar mvar new = modifyMVar mvar (\old -> return (new,old))
-#endif
+swapMVar mvar new =
+  block $ do
+    old <- takeMVar mvar
+    putMVar mvar new
+    return old
 
--- put back the same value, return something
+{-|
+  'withMVar' is a safe wrapper for operating on the contents of an
+  'MVar'.  This operation is exception-safe: it will replace the
+  original contents of the 'MVar' if an exception is raised (see
+  "Control.Exception").
+-}
 withMVar :: MVar a -> (a -> IO b) -> IO b
 withMVar m io = 
   block $ do
@@ -73,7 +82,11 @@ withMVar m io =
     putMVar m a
     return b
 
--- put back a new value, return ()
+{-|
+  A safe wrapper for modifying the contents of an 'MVar'.  Like 'withMVar', 
+  'modifyMVar' will replace the original contents of the 'MVar' if an
+  exception is raised during the operation.
+-}
 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
 modifyMVar_ m io = 
   block $ do
@@ -82,7 +95,10 @@ modifyMVar_ m io =
            (\e -> do putMVar m a; throw e)
     putMVar m a'
 
--- put back a new value, return something
+{-|
+  A slight variation on 'modifyMVar_' that allows a value to be
+  returned (@b@) in addition to the modified value of the 'MVar'.
+-}
 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
 modifyMVar m io = 
   block $ do