    -- Transactional memory for sequential implementations.
    -- Transactions do not run concurrently, but are atomic in the face
    -- of exceptions.

    {-# LANGUAGE CPP #-}

    #if __GLASGOW_HASKELL__ >= 709
    {-# LANGUAGE Safe #-}
    #elif __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE Trustworthy #-}
    #endif

    -- #hide
    module Control.Sequential.STM (
            STM, atomically, throwSTM, catchSTM,
            TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar
        ) where

    #if __GLASGOW_HASKELL__ < 705
    import Prelude hiding (catch)
    #endif
    #if __GLASGOW_HASKELL__ < 709
    import Control.Applicative (Applicative(pure, (<*>)))
    #endif
    import Control.Exception
    import Data.IORef

    -- The reference contains a rollback action to be executed on exceptions
    newtype STM a = STM (IORef (IO ()) -> IO a)

    unSTM :: STM a -> IORef (IO ()) -> IO a
    unSTM :: forall a. STM a -> IORef (IO ()) -> IO a
    unSTM (STM IORef (IO ()) -> IO a
    f) = IORef (IO ()) -> IO a
    f

    instance Functor STM where
        fmap :: forall a b. (a -> b) -> STM a -> STM b
    fmap a -> b
    f (STM IORef (IO ()) -> IO a
    m) = (IORef (IO ()) -> IO b) -> STM b
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (IO a -> IO b) -> (IORef (IO ()) -> IO a) -> IORef (IO ()) -> IO b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef (IO ()) -> IO a
    m)

    instance Applicative STM where
        pure :: forall a. a -> STM a
    pure = (IORef (IO ()) -> IO a) -> STM a
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO a) -> STM a)
    -> (a -> IORef (IO ()) -> IO a) -> a -> STM a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> IORef (IO ()) -> IO a
    forall a b. a -> b -> a
    const (IO a -> IORef (IO ()) -> IO a)
    -> (a -> IO a) -> a -> IORef (IO ()) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        STM IORef (IO ()) -> IO (a -> b)
    mf <*> :: forall a b. STM (a -> b) -> STM a -> STM b
    <*> STM IORef (IO ()) -> IO a
    mx = (IORef (IO ()) -> IO b) -> STM b
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO b) -> STM b)
    -> (IORef (IO ()) -> IO b) -> STM b
    forall a b. (a -> b) -> a -> b
    $ \ IORef (IO ())
    r -> IORef (IO ()) -> IO (a -> b)
    mf IORef (IO ())
    r IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IORef (IO ()) -> IO a
    mx IORef (IO ())
    r

    instance Monad STM where
        return :: forall a. a -> STM a
    return = a -> STM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        STM IORef (IO ()) -> IO a
    m >>= :: forall a b. STM a -> (a -> STM b) -> STM b
    >>= a -> STM b
    k = (IORef (IO ()) -> IO b) -> STM b
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO b) -> STM b)
    -> (IORef (IO ()) -> IO b) -> STM b
    forall a b. (a -> b) -> a -> b
    $ \ IORef (IO ())
    r -> do
            a
    x <- IORef (IO ()) -> IO a
    m IORef (IO ())
    r
            STM b -> IORef (IO ()) -> IO b
    forall a. STM a -> IORef (IO ()) -> IO a
    unSTM (a -> STM b
    k a
    x) IORef (IO ())
    r

    atomically :: STM a -> IO a
    atomically :: forall a. STM a -> IO a
    atomically (STM IORef (IO ()) -> IO a
    m) = do
        IORef (IO ())
    r <- IO () -> IO (IORef (IO ()))
    forall a. a -> IO (IORef a)
    newIORef (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        IORef (IO ()) -> IO a
    m IORef (IO ())
    r IO a -> IO () -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` do
            IO ()
    rollback <- IORef (IO ()) -> IO (IO ())
    forall a. IORef a -> IO a
    readIORef IORef (IO ())
    r
            IO ()
    rollback

    -- | @since 2.2.0
    throwSTM :: Exception e => e -> STM a
    throwSTM :: forall e a. Exception e => e -> STM a
    throwSTM = (IORef (IO ()) -> IO a) -> STM a
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO a) -> STM a)
    -> (e -> IORef (IO ()) -> IO a) -> e -> STM a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> IORef (IO ()) -> IO a
    forall a b. a -> b -> a
    const (IO a -> IORef (IO ()) -> IO a)
    -> (e -> IO a) -> e -> IORef (IO ()) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> IO a
    forall e a. Exception e => e -> IO a
    throwIO

    catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
    catchSTM :: forall e a. Exception e => STM a -> (e -> STM a) -> STM a
    catchSTM (STM IORef (IO ()) -> IO a
    m) e -> STM a
    h = (IORef (IO ()) -> IO a) -> STM a
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO a) -> STM a)
    -> (IORef (IO ()) -> IO a) -> STM a
    forall a b. (a -> b) -> a -> b
    $ \ IORef (IO ())
    r -> do
        IO ()
    old_rollback <- IORef (IO ()) -> IO (IO ())
    forall a. IORef a -> IO a
    readIORef IORef (IO ())
    r
        IORef (IO ()) -> IO () -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (IO ())
    r (() -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        Either e a
    res <- IO a -> IO (Either e a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IORef (IO ()) -> IO a
    m IORef (IO ())
    r)
        IO ()
    rollback_m <- IORef (IO ()) -> IO (IO ())
    forall a. IORef a -> IO a
    readIORef IORef (IO ())
    r
        case Either e a
    res of
            Left e
    ex -> do
                IO ()
    rollback_m
                IORef (IO ()) -> IO () -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (IO ())
    r IO ()
    old_rollback
                STM a -> IORef (IO ()) -> IO a
    forall a. STM a -> IORef (IO ()) -> IO a
    unSTM (e -> STM a
    h e
    ex) IORef (IO ())
    r
            Right a
    a -> do
                IORef (IO ()) -> IO () -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (IO ())
    r (IO ()
    rollback_m IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    old_rollback)
                a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    newtype TVar a = TVar (IORef a)
        deriving (TVar a -> TVar a -> Bool
    (TVar a -> TVar a -> Bool)
    -> (TVar a -> TVar a -> Bool) -> Eq (TVar a)
    forall a. TVar a -> TVar a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: TVar a -> TVar a -> Bool
    $c/= :: forall a. TVar a -> TVar a -> Bool
    == :: TVar a -> TVar a -> Bool
    $c== :: forall a. TVar a -> TVar a -> Bool
    Eq)

    newTVar :: a -> STM (TVar a)
    newTVar :: forall a. a -> STM (TVar a)
    newTVar a
    a = (IORef (IO ()) -> IO (TVar a)) -> STM (TVar a)
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM (IO (TVar a) -> IORef (IO ()) -> IO (TVar a)
    forall a b. a -> b -> a
    const (a -> IO (TVar a)
    forall a. a -> IO (TVar a)
    newTVarIO a
    a))

    newTVarIO :: a -> IO (TVar a)
    newTVarIO :: forall a. a -> IO (TVar a)
    newTVarIO a
    a = do
        IORef a
    ref <- a -> IO (IORef a)
    forall a. a -> IO (IORef a)
    newIORef a
    a
        TVar a -> IO (TVar a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IORef a -> TVar a
    forall a. IORef a -> TVar a
    TVar IORef a
    ref)

    readTVar :: TVar a -> STM a
    readTVar :: forall a. TVar a -> STM a
    readTVar (TVar IORef a
    ref) = (IORef (IO ()) -> IO a) -> STM a
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM (IO a -> IORef (IO ()) -> IO a
    forall a b. a -> b -> a
    const (IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    ref))

    -- | @since 2.1.2
    readTVarIO :: TVar a -> IO a
    readTVarIO :: forall a. TVar a -> IO a
    readTVarIO (TVar IORef a
    ref) = IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    ref

    writeTVar :: TVar a -> a -> STM ()
    writeTVar :: forall a. TVar a -> a -> STM ()
    writeTVar (TVar IORef a
    ref) a
    a = (IORef (IO ()) -> IO ()) -> STM ()
    forall a. (IORef (IO ()) -> IO a) -> STM a
    STM ((IORef (IO ()) -> IO ()) -> STM ())
    -> (IORef (IO ()) -> IO ()) -> STM ()
    forall a b. (a -> b) -> a -> b
    $ \ IORef (IO ())
    r -> do
        a
    oldval <- IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    ref
        IORef (IO ()) -> (IO () -> IO ()) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef (IO ())
    r (IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    ref a
    oldval IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>)
        IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    ref a
    a