important news: refocusing discussion

[Ross Paterson]

On Tue, Mar 28, 2006 at 10:25:04AM +0100, Simon Marlow wrote:
> On 28 March 2006 00:24, Ross Paterson wrote:
> > How about STM (minus retry/orElse) and TVars as the portable
> > interface? They're trivial for a single-threaded implementation, and
> > provide a comfortable interface for everyone.
> 
> It just occurred to me that STM isn't completely trivial in a
> single-threaded implementation, because exceptions have to abort a
> transaction in progress.

Almost trivial, though:

import Prelude hiding (catch)
import Control.Exception
import Data.IORef

-- The reference contains a rollback action to be executed on exceptions
newtype STM a = STM (IORef (IO ()) -> IO a)
unSTM (STM f) = f

instance Functor STM where
	fmap f (STM m) = STM (fmap f . m)

instance Monad STM where
	return x = STM (const (return x))
	STM m >>= k = STM $ \ r -> do
		x <- m r
		unSTM (k x) r

atomically :: STM a -> IO a
atomically (STM m) = do
	r <- newIORef (return ())
	m r `catch` \ ex -> do
		rollback <- readIORef r
		rollback
		throw ex

catchSTM :: STM a -> (Exception -> STM a) -> STM a
catchSTM (STM m) h = STM $ \ r -> m r `catch` \ ex -> unSTM (h ex) r

newtype TVar a = TVar (IORef a)

newTVar :: a -> STM (TVar a)
newTVar a = STM $ const $ do
	ref <- newIORef a
	return (TVar ref)

readTVar :: TVar a -> STM a
readTVar (TVar ref) = STM (const (readIORef ref))

writeTVar :: TVar a -> a -> STM ()
writeTVar (TVar ref) a = STM $ \ r -> do
	oldval <- readIORef ref
	modifyIORef r (writeIORef ref oldval >>)
	writeIORef ref a