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