diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+## [Unreleased]
+
+## [0.1.0]
+### Added
+- Split out the STM parts of the main apecs package
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Jonas Carpay (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Jonas Carpay nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,6 @@
+# apecs-stm
+Experimental STM stores, allow apecs to be run in the STM monad.
+```haskell
+atomically . cmap $ \(Position p, Velocity v) -> Position (v+p)
+```
+Not included in the stack project until stm-containers (or similar) makes it into stackage.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/apecs-stm.cabal b/apecs-stm.cabal
new file mode 100644
--- /dev/null
+++ b/apecs-stm.cabal
@@ -0,0 +1,40 @@
+name:                apecs-stm
+version:             0.1.0
+homepage:            https://github.com/jonascarpay/apecs-stm#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Jonas Carpay
+maintainer:          jonascarpay@gmail.com
+category:            Game, Control, Data
+build-type:          Simple
+cabal-version:       >=1.10
+synopsis:            STM Stores for apecs
+description:
+  Apecs stores that live in the STM monad. These support easy concurrency without race conditions.
+
+extra-source-files:
+  README.md,
+  CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: git://github.com/jonascarpay/apecs-stm.git
+
+library
+  hs-source-dirs:
+    src
+  exposed-modules:
+    Apecs.STM, Apecs.STM.Prelude
+  default-language:
+    Haskell2010
+  build-depends:
+    base >= 4.7 && < 5,
+    containers,
+    stm,
+    list-t,
+    vector,
+    template-haskell,
+    stm-containers,
+    apecs >= 0.7
+  ghc-options:
+    -Wall
diff --git a/src/Apecs/STM.hs b/src/Apecs/STM.hs
new file mode 100644
--- /dev/null
+++ b/src/Apecs/STM.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+-- | This module contains STM-supporting versions of regular apecs stores, and some convenience functions.
+-- It is designed to be imported qualified, since it shadows both apecs and STM names.
+-- There is also an @Apecs.STM.Prelude@ module, which can be imported by itself.
+--
+-- Note that if you want to be able to create entities in STM, you will also need to use a STM-supported @EntityCounter@, typically done through this module's @makeWorld@.
+
+module Apecs.STM
+  ( -- * Stores
+    Map (..)
+  , Unique (..)
+  , Global (..)
+    -- * EntityCounter
+  , EntityCounter (..)
+  , nextEntity, newEntity, makeWorld
+    -- * STM conveniences
+  , atomically, retry, check, forkSys, threadDelay, STM
+  ) where
+
+import qualified Control.Concurrent          as S
+import           Control.Concurrent.STM      (STM)
+import qualified Control.Concurrent.STM      as S
+import           Control.Concurrent.STM.TVar as S
+import           Control.Monad
+import           Data.Maybe
+import           Data.Monoid                 (Sum (..))
+import           Data.Semigroup
+import qualified Data.Vector.Unboxed         as U
+import           Language.Haskell.TH
+import qualified ListT                       as L
+import qualified StmContainers.Map           as M
+
+import           Apecs                       (ask, get, global, lift, liftIO,
+                                              runSystem, set)
+import           Apecs.Core
+import           Apecs.TH                    (makeWorldNoEC)
+
+newtype Map c = Map (M.Map Int c)
+type instance Elem (Map c) = c
+
+instance ExplInit STM (Map c) where
+  explInit = Map <$> M.new
+instance ExplGet STM (Map c) where
+  {-# INLINE explExists #-}
+  explExists (Map m) ety = isJust   <$> M.lookup ety m
+  {-# INLINE explGet #-}
+  explGet    (Map m) ety = fromJust <$> M.lookup ety m
+instance ExplSet STM (Map c) where
+  {-# INLINE explSet #-}
+  explSet (Map m) ety x = M.insert x ety m
+instance ExplDestroy STM (Map c) where
+  {-# INLINE explDestroy #-}
+  explDestroy (Map m) ety = M.delete ety m
+instance ExplMembers STM (Map c) where
+  {-# INLINE explMembers #-}
+  explMembers (Map m) = U.unfoldrM L.uncons $ fst <$> M.listT m
+
+instance ExplInit IO (Map c) where
+  {-# INLINE explInit #-}
+  explInit = S.atomically explInit
+instance ExplGet IO (Map c) where
+  {-# INLINE explExists #-}
+  explExists m e = S.atomically $ explExists m e
+  {-# INLINE explGet #-}
+  explGet m e = S.atomically $ explGet m e
+instance ExplSet IO (Map c) where
+  {-# INLINE explSet #-}
+  explSet m e x = S.atomically $ explSet m e x
+instance ExplDestroy IO (Map c) where
+  {-# INLINE explDestroy #-}
+  explDestroy m e = S.atomically $ explDestroy m e
+instance ExplMembers IO (Map c) where
+  {-# INLINE explMembers #-}
+  explMembers m = S.atomically $ explMembers m
+
+newtype Unique c = Unique (TVar (Maybe (Int, c)))
+type instance Elem (Unique c) = c
+instance ExplInit STM (Unique c) where
+  explInit = Unique <$> newTVar Nothing
+
+instance ExplGet STM (Unique c) where
+  {-# INLINE explGet #-}
+  explGet (Unique ref) _ = flip fmap (readTVar ref) $ \case
+    Nothing -> error "Reading empty Unique"
+    Just (_, c)  -> c
+  {-# INLINE explExists #-}
+  explExists (Unique ref) ety = maybe False ((==ety) . fst) <$> readTVar ref
+
+instance ExplSet STM (Unique c) where
+  {-# INLINE explSet #-}
+  explSet (Unique ref) ety c = writeTVar ref (Just (ety, c))
+
+instance ExplDestroy STM (Unique c) where
+  {-# INLINE explDestroy #-}
+  explDestroy (Unique ref) ety = readTVar ref >>=
+    mapM_ (flip when (writeTVar ref Nothing) . (==ety) . fst)
+
+instance ExplMembers STM (Unique c) where
+  {-# INLINE explMembers #-}
+  explMembers (Unique ref) = flip fmap (readTVar ref) $ \case
+    Nothing -> mempty
+    Just (ety, _) -> U.singleton ety
+
+instance ExplInit IO (Unique c) where
+  {-# INLINE explInit #-}
+  explInit = S.atomically explInit
+instance ExplGet IO (Unique c) where
+  {-# INLINE explExists #-}
+  explExists m e = S.atomically $ explExists m e
+  {-# INLINE explGet #-}
+  explGet m e = S.atomically $ explGet m e
+instance ExplSet IO (Unique c) where
+  {-# INLINE explSet #-}
+  explSet m e x = S.atomically $ explSet m e x
+instance ExplDestroy IO (Unique c) where
+  {-# INLINE explDestroy #-}
+  explDestroy m e = S.atomically $ explDestroy m e
+instance ExplMembers IO (Unique c) where
+  {-# INLINE explMembers #-}
+  explMembers m = S.atomically $ explMembers m
+
+newtype Global c = Global (TVar c)
+type instance Elem (Global c) = c
+instance Monoid c => ExplInit STM (Global c) where
+  {-# INLINE explInit #-}
+  explInit = Global <$> newTVar mempty
+instance ExplGet STM (Global c) where
+  {-# INLINE explGet #-}
+  explGet (Global ref) _ = readTVar ref
+  {-# INLINE explExists #-}
+  explExists _ _ = return True
+instance ExplSet STM (Global c) where
+  {-# INLINE explSet #-}
+  explSet (Global ref) _ c = writeTVar ref c
+
+instance Monoid c => ExplInit IO (Global c) where
+  {-# INLINE explInit #-}
+  explInit = S.atomically explInit
+instance ExplGet IO (Global c) where
+  {-# INLINE explExists #-}
+  explExists m e = S.atomically $ explExists m e
+  {-# INLINE explGet #-}
+  explGet m e = S.atomically $ explGet m e
+instance ExplSet IO (Global c) where
+  {-# INLINE explSet #-}
+  explSet m e x = S.atomically $ explSet m e x
+
+newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Semigroup, Monoid, Eq, Show)
+
+instance Component EntityCounter where
+  type Storage EntityCounter = Global EntityCounter
+
+{-# INLINE nextEntity #-}
+nextEntity :: (Get w m EntityCounter, Set w m EntityCounter) => SystemT w m Entity
+nextEntity = do EntityCounter n <- get global
+                set global (EntityCounter $ n+1)
+                return (Entity . getSum $ n)
+
+{-# INLINE newEntity #-}
+newEntity :: (Set w m c, Get w m EntityCounter, Set w m EntityCounter)
+          => c -> SystemT w m Entity
+newEntity c = do ety <- nextEntity
+                 set ety c
+                 return ety
+
+-- | Like @makeWorld@ from @Apecs@, but uses the STM @EntityCounter@
+makeWorld :: String -> [Name] -> Q [Dec]
+makeWorld worldName cTypes = makeWorldNoEC worldName (cTypes ++ [''EntityCounter])
+
+-- | @atomically@ from STM, lifted to the System level.
+atomically :: SystemT w STM a -> SystemT w IO a
+atomically sys = ask >>= liftIO . S.atomically . runSystem sys
+
+-- | @retry@ from STM, lifted to the System level.
+retry :: SystemT w STM a
+retry = lift S.retry
+
+-- | @check@ from STM, lifted to the System level.
+check :: Bool -> SystemT w STM ()
+check = lift . S.check
+
+-- | Runs a system on a new thread.
+forkSys :: SystemT w IO () -> SystemT w IO S.ThreadId
+forkSys sys = ask >>= liftIO . S.forkIO . runSystem sys
+
+-- | Suspends the current thread for a number of microseconds.
+threadDelay :: Int -> SystemT w IO ()
+threadDelay = liftIO . S.threadDelay
diff --git a/src/Apecs/STM/Prelude.hs b/src/Apecs/STM/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/Apecs/STM/Prelude.hs
@@ -0,0 +1,13 @@
+-- | This module re-exports the apecs prelude with STM versions.
+
+module Apecs.STM.Prelude
+  ( System
+  , module Apecs.STM
+  , module Apecs
+  ) where
+
+import           Apecs     hiding (EntityCounter, Global, Map, System, Unique,
+                            makeWorld, newEntity)
+import           Apecs.STM
+
+type System w a = SystemT w STM a