From 0b899bbe17a448fa5f96d2c24ff198bd29ef6e61 Mon Sep 17 00:00:00 2001 From: Bas van Dijk Date: Sun, 26 Sep 2010 19:21:06 +0000 Subject: [PATCH] Generalize catchSTM --- GHC/Conc.lhs | 2 +- GHC/Conc/Sync.lhs | 10 +++++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index 2e3247f..d08ccf2 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -58,7 +58,7 @@ module GHC.Conc , atomically -- :: STM a -> IO a , retry -- :: STM a , orElse -- :: STM a -> STM a -> STM a - , catchSTM -- :: STM a -> (Exception -> STM a) -> STM a + , catchSTM -- :: Exception e => STM a -> (e -> STM a) -> STM a , alwaysSucceeds -- :: STM a -> STM () , always -- :: STM Bool -> STM () , TVar(..) diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs index 9b7415d..38717e6 100644 --- a/GHC/Conc/Sync.lhs +++ b/GHC/Conc/Sync.lhs @@ -52,7 +52,7 @@ module GHC.Conc.Sync , atomically -- :: STM a -> IO a , retry -- :: STM a , orElse -- :: STM a -> STM a -> STM a - , catchSTM -- :: STM a -> (Exception -> STM a) -> STM a + , catchSTM -- :: Exception e => STM a -> (e -> STM a) -> STM a , alwaysSucceeds -- :: STM a -> STM () , always -- :: STM Bool -> STM () , TVar(..) @@ -510,8 +510,12 @@ orElse :: STM a -> STM a -> STM a orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s -- |Exception handling within STM actions. -catchSTM :: STM a -> (SomeException -> STM a) -> STM a -catchSTM (STM m) k = STM $ \s -> catchSTM# m (\ex -> unSTM (k ex)) s +catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a +catchSTM (STM m) handler = STM $ catchSTM# m handler' + where + handler' e = case fromException e of + Just e' -> unSTM (handler e') + Nothing -> raiseIO# e -- | Low-level primitive on which always and alwaysSucceeds are built. -- checkInv differs form these in that (i) the invariant is not -- 1.7.10.4