Wolfgang Jeltsch pushed to branch wip/jeltsch/stm-exception-improvements at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • changelog.d/rethrow-stm
    1
    +section: ghc-internal
    
    2
    +synopsis: Add `rethrowSTM`, an `STM` analog of `rethrowIO`
    
    3
    +issues: #26758
    
    4
    +mrs: !16501

  • libraries/base/src/GHC/Conc.hs
    ... ... @@ -79,6 +79,9 @@ module GHC.Conc
    79 79
             , retry
    
    80 80
             , orElse
    
    81 81
             , throwSTM
    
    82
    +#if __GLASGOW_HASKELL__ >= 1000
    
    83
    +        , rethrowSTM
    
    84
    +#endif
    
    82 85
             , catchSTM
    
    83 86
             , TVar(..)
    
    84 87
             , newTVar
    

  • libraries/ghc-internal/src/GHC/Internal/STM.hs
    ... ... @@ -13,6 +13,7 @@ module GHC.Internal.STM
    13 13
             , retry
    
    14 14
             , orElse
    
    15 15
             , throwSTM
    
    16
    +        , rethrowSTM
    
    16 17
             , catchSTM
    
    17 18
             , unsafeIOToSTM
    
    18 19
               -- * TVars
    
    ... ... @@ -31,7 +32,9 @@ import GHC.Internal.Base (
    31 32
     import GHC.Internal.Classes (Eq(..))
    
    32 33
     import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext)
    
    33 34
     import GHC.Internal.Exception.Context (ExceptionAnnotation)
    
    34
    -import GHC.Internal.Exception.Type (WhileHandling(..))
    
    35
    +import GHC.Internal.Exception.Type (
    
    36
    +    WhileHandling(..), ExceptionWithContext, NoBacktrace (NoBacktrace),
    
    37
    +  )
    
    35 38
     import GHC.Internal.Maybe (Maybe(..))
    
    36 39
     import GHC.Internal.Prim (
    
    37 40
         RealWorld, State#, TVar#, atomically#, catch#, catchRetry#, catchSTM#,
    
    ... ... @@ -170,7 +173,7 @@ retry = STM $ \s# -> retry# s#
    170 173
     orElse :: STM a -> STM a -> STM a
    
    171 174
     orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
    
    172 175
     
    
    173
    --- | A variant of 'throw' that can only be used within the 'STM' monad.
    
    176
    +-- | The 'STM' analog of 'throwIO'.
    
    174 177
     --
    
    175 178
     -- Throwing an exception in @STM@ aborts the transaction and propagates the
    
    176 179
     -- exception. If the exception is caught via 'catchSTM', only the changes
    
    ... ... @@ -180,19 +183,8 @@ orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
    180 183
     -- If the exception is not caught inside of the 'STM', it is re-thrown by
    
    181 184
     -- 'atomically', and the entire 'STM' is rolled back.
    
    182 185
     --
    
    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.
    
    186
    +-- Note that 'throwSTM' is preferable to 'throw', for the same
    
    187
    +-- [reasons]('throwIO') that 'throwIO' is preferable to 'throw'.
    
    196 188
     throwSTM :: (HasCallStack, Exception e) => e -> STM a
    
    197 189
     throwSTM e = do
    
    198 190
         -- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this
    
    ... ... @@ -201,7 +193,11 @@ throwSTM e = do
    201 193
         se <- unsafeIOToSTM (withFrozenCallStack $ toExceptionWithBacktrace e)
    
    202 194
         STM $ raiseIO# se
    
    203 195
     
    
    204
    --- | Exception handling within STM actions.
    
    196
    +-- | The 'STM' analog of 'rethrowIO'.
    
    197
    +rethrowSTM :: Exception e => ExceptionWithContext e -> STM a
    
    198
    +rethrowSTM e = throwSTM (NoBacktrace e)
    
    199
    +
    
    200
    +-- | The 'STM' analog of 'catchIO'.
    
    205 201
     --
    
    206 202
     -- @'catchSTM' m f@ catches any exception thrown by @m@ using 'throwSTM',
    
    207 203
     -- using the function @f@ to handle the exception. If an exception is
    

  • testsuite/tests/interface-stability/base-exports.stdout
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    No preview for this file type