| ... |
... |
@@ -3,6 +3,7 @@ |
|
3
|
3
|
{-# LANGUAGE MagicHash #-}
|
|
4
|
4
|
{-# LANGUAGE GADTs #-}
|
|
5
|
5
|
{-# LANGUAGE RankNTypes #-}
|
|
|
6
|
+{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
6
|
7
|
{-# OPTIONS_HADDOCK not-home #-}
|
|
7
|
8
|
|
|
8
|
9
|
module GHC.Internal.STM
|
| ... |
... |
@@ -13,6 +14,7 @@ module GHC.Internal.STM |
|
13
|
14
|
, retry
|
|
14
|
15
|
, orElse
|
|
15
|
16
|
, throwSTM
|
|
|
17
|
+ , rethrowSTM
|
|
16
|
18
|
, catchSTM
|
|
17
|
19
|
, unsafeIOToSTM
|
|
18
|
20
|
-- * TVars
|
| ... |
... |
@@ -31,7 +33,9 @@ import GHC.Internal.Base ( |
|
31
|
33
|
import GHC.Internal.Classes (Eq(..))
|
|
32
|
34
|
import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext)
|
|
33
|
35
|
import GHC.Internal.Exception.Context (ExceptionAnnotation)
|
|
34
|
|
-import GHC.Internal.Exception.Type (WhileHandling(..))
|
|
|
36
|
+import GHC.Internal.Exception.Type (
|
|
|
37
|
+ WhileHandling(..), ExceptionWithContext, NoBacktrace (NoBacktrace),
|
|
|
38
|
+ )
|
|
35
|
39
|
import GHC.Internal.Maybe (Maybe(..))
|
|
36
|
40
|
import GHC.Internal.Prim (
|
|
37
|
41
|
RealWorld, State#, TVar#, atomically#, catch#, catchRetry#, catchSTM#,
|
| ... |
... |
@@ -41,6 +45,10 @@ import GHC.Internal.Prim.PtrEq (sameTVar#) |
|
41
|
45
|
import GHC.Internal.Stack (HasCallStack, withFrozenCallStack)
|
|
42
|
46
|
import GHC.Internal.Types (IO(..), isTrue#)
|
|
43
|
47
|
|
|
|
48
|
+-- Imports for documentation hyperlinking
|
|
|
49
|
+import GHC.Internal.Exception (throw)
|
|
|
50
|
+import GHC.Internal.IO (throwIO, rethrowIO)
|
|
|
51
|
+
|
|
44
|
52
|
-- TVars are shared memory locations which support atomic memory
|
|
45
|
53
|
-- transactions.
|
|
46
|
54
|
|
| ... |
... |
@@ -170,7 +178,7 @@ retry = STM $ \s# -> retry# s# |
|
170
|
178
|
orElse :: STM a -> STM a -> STM a
|
|
171
|
179
|
orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
|
|
172
|
180
|
|
|
173
|
|
--- | A variant of 'throw' that can only be used within the 'STM' monad.
|
|
|
181
|
+-- | The 'STM' analog of 'throwIO'.
|
|
174
|
182
|
--
|
|
175
|
183
|
-- Throwing an exception in @STM@ aborts the transaction and propagates the
|
|
176
|
184
|
-- exception. If the exception is caught via 'catchSTM', only the changes
|
| ... |
... |
@@ -180,19 +188,8 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s |
|
180
|
188
|
-- If the exception is not caught inside of the 'STM', it is re-thrown by
|
|
181
|
189
|
-- 'atomically', and the entire 'STM' is rolled back.
|
|
182
|
190
|
--
|
|
183
|
|
--- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
|
|
184
|
|
--- two functions are subtly different:
|
|
185
|
|
---
|
|
186
|
|
--- > throw e `seq` x ===> throw e
|
|
187
|
|
--- > throwSTM e `seq` x ===> x
|
|
188
|
|
---
|
|
189
|
|
--- The first example will cause the exception @e@ to be raised,
|
|
190
|
|
--- whereas the second one won\'t. In fact, 'throwSTM' will only cause
|
|
191
|
|
--- an exception to be raised when it is used within the 'STM' monad.
|
|
192
|
|
--- The 'throwSTM' variant should be used in preference to 'throw' to
|
|
193
|
|
--- raise an exception within the 'STM' monad because it guarantees
|
|
194
|
|
--- ordering with respect to other 'STM' operations, whereas 'throw'
|
|
195
|
|
--- does not.
|
|
|
191
|
+-- Note that 'throwSTM' is preferable to 'throw', for the same reasons that
|
|
|
192
|
+-- 'throwIO' is preferable to 'throw'.
|
|
196
|
193
|
throwSTM :: (HasCallStack, Exception e) => e -> STM a
|
|
197
|
194
|
throwSTM e = do
|
|
198
|
195
|
-- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this
|
| ... |
... |
@@ -201,7 +198,11 @@ throwSTM e = do |
|
201
|
198
|
se <- unsafeIOToSTM (withFrozenCallStack $ toExceptionWithBacktrace e)
|
|
202
|
199
|
STM $ raiseIO# se
|
|
203
|
200
|
|
|
204
|
|
--- | Exception handling within STM actions.
|
|
|
201
|
+-- | The 'STM' analog of 'rethrowIO'.
|
|
|
202
|
+rethrowSTM :: Exception e => ExceptionWithContext e -> STM a
|
|
|
203
|
+rethrowSTM e = throwSTM (NoBacktrace e)
|
|
|
204
|
+
|
|
|
205
|
+-- | The 'STM' analog of 'catch'.
|
|
205
|
206
|
--
|
|
206
|
207
|
-- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
|
|
207
|
208
|
-- using the function @f@ to handle the exception. If an exception is
|