sequential implementation of revised semantics of catchSTM
authorRoss Paterson <ross@soi.city.ac.uk>
Mon, 4 Sep 2006 17:29:21 +0000 (17:29 +0000)
committerRoss Paterson <ross@soi.city.ac.uk>
Mon, 4 Sep 2006 17:29:21 +0000 (17:29 +0000)
(This module is not used by GHC)

Control/Sequential/STM.hs

index 9ce7fa0..4817445 100644 (file)
@@ -36,7 +36,19 @@ atomically (STM m) = do
        throw ex
 
 catchSTM :: STM a -> (Exception -> STM a) -> STM a
-catchSTM (STM m) h = STM $ \ r -> m r `catch` \ ex -> unSTM (h ex) r
+catchSTM (STM m) h = STM $ \ r -> do
+    old_rollback <- readIORef r
+    writeIORef r (return ())
+    res <- try (m r)
+    rollback_m <- readIORef r
+    case res of
+       Left ex -> do
+           rollback_m
+           writeIORef r old_rollback
+           unSTM (h ex) r
+       Right a -> do
+           writeIORef r (rollback_m >> old_rollback)
+           return a
 
 newtype TVar a = TVar (IORef a)
     deriving (Eq)