X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FMVar.hs;h=7213cf14c5ff15e178c78795c7961c0037d6744c;hb=afe7ed8026edd943550b05f4895c99601207fea5;hp=ef1a2e650b60e3e53202c42e4842cae446c7f3f2;hpb=86a17d42a36c3272e993854b9bfa2276ae669324;p=haskell-directory.git

diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index ef1a2e6..7213cf1 100644
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -28,13 +28,14 @@ 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,
 		)
 #endif
 
@@ -47,13 +48,6 @@ import GHC.Conc	( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
 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.
@@ -67,8 +61,11 @@ readMVar m =
 
 -- |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
 
 {-|
   'withMVar' is a safe wrapper for operating on the contents of an
@@ -76,6 +73,9 @@ swapMVar mvar new = modifyMVar mvar (\old -> return (new,old))
   original contents of the 'MVar' if an exception is raised (see
   "Control.Exception").
 -}
+{-# INLINE withMVar #-}
+-- inlining has been reported to have dramatic effects; see
+-- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
 withMVar :: MVar a -> (a -> IO b) -> IO b
 withMVar m io = 
   block $ do
@@ -90,6 +90,7 @@ withMVar m io =
   'modifyMVar' will replace the original contents of the 'MVar' if an
   exception is raised during the operation.
 -}
+{-# INLINE modifyMVar_ #-}
 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
 modifyMVar_ m io = 
   block $ do
@@ -102,6 +103,7 @@ modifyMVar_ m io =
   A slight variation on 'modifyMVar_' that allows a value to be
   returned (@b@) in addition to the modified value of the 'MVar'.
 -}
+{-# INLINE modifyMVar #-}
 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
 modifyMVar m io = 
   block $ do