diff --git a/acme-timemachine.cabal b/acme-timemachine.cabal
--- a/acme-timemachine.cabal
+++ b/acme-timemachine.cabal
@@ -1,7 +1,7 @@
 name:                acme-timemachine
-version:             0.0.0.0
+version:             0.0.0.1
 synopsis:            An easy way to perform and unperform IO actions.
-description:         When doing some side-effectful computations, one might regret the decision to change the state. This package provides an 'undo' function for such cases, and universe suspension/resuming functions for finer control.
+description:         When doing some computations with side effects, one might regret the decision to change the state of the universe. This package provides an 'undo' function for such cases, and universe suspension/resuming functions for finer control.
 license:             BSD3
 license-file:        LICENSE
 author:              mniip
@@ -11,7 +11,7 @@
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     Acme.TimeMachine, Acme.TimeMachine.Undoable, Acme.TimeMachine.Suspension
+  exposed-modules:     Acme.TimeMachine, Acme.TimeMachine.Undoable, Acme.TimeMachine.Suspension Acme.TimeMachine.STM
   build-depends:       base == 4.*, transformers >= 0.2.0.0, mtl >= 1.1.0.0, ghc-prim
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/src/Acme/TimeMachine.hs b/src/Acme/TimeMachine.hs
--- a/src/Acme/TimeMachine.hs
+++ b/src/Acme/TimeMachine.hs
@@ -44,7 +44,7 @@
 type TimeMachine = Undoable Universe
 
 instance MonadIO TimeMachine where
-    liftIO (IO m) = Undoable $ \l@(Suspension (Universe# i#) _) -> let (u, r) = case m i# of (# i#, r #) -> (Universe# i#, r) in (Suspension u l, r)
+    liftIO (IO m) = Undoable $ \l@(~(Suspension u _)) -> let (v, r) = case m (case u of Universe# i# -> i#) of (# i#, r #) -> (Universe# i#, r) in (Suspension v l, r)
 
 -- | Execute an undo-able computation.
 runTM :: TimeMachine a -> IO a
diff --git a/src/Acme/TimeMachine/STM.hs b/src/Acme/TimeMachine/STM.hs
new file mode 100644
--- /dev/null
+++ b/src/Acme/TimeMachine/STM.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE FlexibleInstances, MagicHash, UnboxedTuples #-}
+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
+
+-- | State of the STM.
+data Entanglement = Entanglement# (State# RealWorld)
+
+-- | Undo-able atomic software transaction monad.
+-- Lets you perform and unperform side-effectful atomic transactions.
+type AtomicTimeMachine = Undoable Entanglement
+
+-- | Run an STM action.
+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)
+
+-- | Embed an undo-able transaction in an undo-able computation.
+atomicallyTM :: AtomicTimeMachine a -> TimeMachine a
+atomicallyTM = liftIO . runATMIO
+
+-- | Execute an undo-able transaction.
+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 #)
+
+-- | Execute an undo-able transaction within the IO monad.
+runATMIO :: AtomicTimeMachine a -> IO a
+runATMIO = atomically . runATM
+