From: ross Date: Fri, 18 Oct 2002 12:28:38 +0000 (+0000) Subject: [project @ 2002-10-18 12:28:38 by ross] X-Git-Tag: nhc98-1-18-release~812 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=a5f7dcaa3ebb00c8e6237f62b08ad9c2f65cfda7;p=ghc-base.git [project @ 2002-10-18 12:28:38 by ross] Hugs only: simple version of atomicModifyIORef, relying on the absence of preemption from Hugs. If Hugs gets Haskell finalizers, they'll have to be blocked during this operation. --- diff --git a/Data/IORef.hs b/Data/IORef.hs index 55cb52f..527e20a 100644 --- a/Data/IORef.hs +++ b/Data/IORef.hs @@ -20,7 +20,7 @@ module Data.IORef readIORef, -- :: IORef a -> IO a writeIORef, -- :: IORef a -> a -> IO () modifyIORef, -- :: IORef a -> (a -> a) -> IO () - atomicModifyIORef, -- :: IORef a -> (a -> (a,b)) -> IO () + atomicModifyIORef, -- :: IORef a -> (a -> (a,b)) -> IO b #if !defined(__PARALLEL_HASKELL__) && defined(__GLASGOW_HASKELL__) mkWeakIORef, -- :: IORef a -> IO () -> IO (Weak (IORef a)) @@ -77,7 +77,14 @@ modifyIORef ref f = writeIORef ref . f =<< readIORef ref -- then using 'MVar' instead is a good idea. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b +#if defined(__GLASGOW_HASKELL__) atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s +#elif defined(__HUGS__) +atomicModifyIORef = plainModifyIORef -- Hugs has no preemption + where plainModifyIORef r f = do + a <- readIORef r + case f a of (a',b) -> writeIORef r a' >> return b +#endif #ifndef __NHC__ #include "Dynamic.h"