module Acme.TimeMachine.STM
(
Entanglement,
AtomicTimeMachine,
doSTM,
atomicallyTM,
runATM,
runATMIO
)
where
import Control.Monad.IO.Class (MonadIO(..))
import GHC.Conc (STM(..), atomically)
import GHC.Prim (State#, RealWorld)
import Acme.TimeMachine
import Acme.TimeMachine.Suspension
import Acme.TimeMachine.Undoable
data Entanglement = Entanglement# (State# RealWorld)
type AtomicTimeMachine = Undoable Entanglement
doSTM :: STM a -> AtomicTimeMachine a
doSTM (STM m) = Undoable $ \l@(~(Suspension u _)) -> let (v, r) = case m (case u of Entanglement# e# -> e#) of (# e#, r #) -> (Entanglement# e#, r) in (Suspension v l, r)
atomicallyTM :: AtomicTimeMachine a -> TimeMachine a
atomicallyTM = liftIO . runATMIO
runATM :: AtomicTimeMachine a -> STM a
runATM (Undoable f) = STM $ \i# -> case f (mkSuspension $ Entanglement# i#) of ~(Suspension s _, r) -> case s of Entanglement# i# -> (# i#, r #)
runATMIO :: AtomicTimeMachine a -> IO a
runATMIO = atomically . runATM