diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,35 @@
+## [Unreleased]
+### Changed
+- `System w a` is now a synonym for `SystemT w IO a`.
+  A variable monad argument allows apecs to be run in monads like ST or STM.
+  Most of the library has been rewritten to be as permissive as possible in its monad argument.
+
+## [0.4.1.2]
+### Changed
+- Either can now be deleted, deleting `Either a b` is the same as deleting `(a,b)`.
+- Some were missing their inline pragma's, now they don't
+
+## [0.4.1.1]
+### Changed
+- Export `Get`, `Set`, `Destroy`, `Members` by default
+- Export `cfold`, `cfoldM`, `cfoldM_` by default
+- Fix () instance
+
+## [0.4.1.0]
+### Added
+- `cfold`, `cfoldM`, `cfoldM_`
+- `Either` instances and `EitherStore`
+
+### Changed
+- Changed MaybeStore implementation to no longer use -1 for missing entities.
+- Fixed some outdated documentation.
+- Change the `global` void entity to -2, just to be sure it won't conflict if accidentally used in a cache.
+
+## [0.4.0.0]
+### Added
+- A changelog
+
+### Changed
+- `Store` is now split into 5 separate type classes; `ExplInit`, `ExplGet`, `ExplSet`, `ExplDestroy`, and `ExplMembers`.
+    This makes it illegal to e.g. iterate over a `Not`.
+- phantom arguments are now given as `Proxy` values, re-exported from `Data.Proxy`. This makes phantom arguments explicit and avoids undefined values.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -4,12 +4,13 @@
 [![Stackage](https://www.stackage.org/package/apecs/badge/lts?label=Stackage)](https://www.stackage.org/package/apecs)
 
 apecs is an _Entity Component System_ (ECS) framework inspired by [specs](https://github.com/slide-rs/specs) and [Entitas](https://github.com/sschmid/Entitas-CSharp).
-The front-end DSL uses a small set of combinators to concisely express game logic, which then translate to fast primitive operations on back-end stores.
-Both the DSL and storage framework can easily be extended to meet any performance/expressivity needs.
+ECS presents a data-driven approach to game development, that elegantly tackles many of the unique issues of game programming.
+The apecs front-end DSL exposes a small number of combinators that allow game logic to be expressive and extremely fast.
 
 #### Links
-- [documentation](https://hackage.haskell.org/package/apecs/docs/Apecs.html)
 - [manual](https://github.com/jonascarpay/apecs/blob/master/prepub.pdf) (see [#19](https://github.com/jonascarpay/apecs/issues/19))
+- [tutorial](https://github.com/jonascarpay/apecs/blob/master/examples/Shmup.md)
+- [documentation](https://hackage.haskell.org/package/apecs/docs/Apecs.html)
 - [apecs-physics](https://github.com/jonascarpay/apecs-physics)
 
 #### Performance
diff --git a/apecs.cabal b/apecs.cabal
--- a/apecs.cabal
+++ b/apecs.cabal
@@ -1,5 +1,5 @@
 name:                apecs
-version:             0.4.1.1
+version:             0.5.0.0
 homepage:            https://github.com/jonascarpay/apecs#readme
 license:             BSD3
 license-file:        LICENSE
@@ -8,11 +8,15 @@
 category:            Game, Control, Data
 build-type:          Simple
 cabal-version:       >=1.10
-extra-source-files:  README.md
 synopsis:            Fast ECS framework for game programming
 description:
-  Apecs is an Entity Component System framework, suitable for high-performance game programming.
+  Entity-Component-System frameworks provide a game programming paradigm that tackles many of the shortcomings of a more OO-oriented approach.
+  apecs is a type-driven ECS, that leverages strong typing for an expressive DSL that turns into fast game code.
 
+extra-source-files:
+  README.md,
+  CHANGELOG.md
+
 source-repository head
   type:     git
   location: git://github.com/jonascarpay/apecs.git
@@ -25,7 +29,6 @@
     Apecs.Core,
     Apecs.Stores,
     Apecs.System,
-    Apecs.Concurrent,
     Apecs.TH,
     Apecs.Util
   other-modules:
@@ -37,7 +40,7 @@
     containers,
     mtl,
     template-haskell,
-    async,
+    stm,
     vector
   ghc-options:
     -Wall
diff --git a/bench/Main.hs b/bench/Main.hs
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -1,14 +1,20 @@
-{-# LANGUAGE Strict, ScopedTypeVariables, DataKinds, TypeFamilies, MultiParamTypeClasses, TypeOperators #-}
-{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE Strict                #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 
-import Criterion
-import Criterion.Types
-import qualified Criterion.Main as C
-import Control.Monad
-import Linear
+import           Control.Monad
+import           Criterion
+import qualified Criterion.Main  as C
+import           Criterion.Types
+import           Linear
 
-import Apecs
+import           Apecs
 
 -- pos_vel
 newtype ECSPos = ECSPos (V2 Float) deriving (Eq, Show)
@@ -20,8 +26,9 @@
 makeWorld "PosVel" [''ECSPos, ''ECSVel]
 
 posVelInit :: System PosVel ()
-posVelInit = do replicateM_ 1000 (newEntity (ECSPos 0, ECSVel 1))
-                replicateM_ 9000 (newEntity (ECSPos 0))
+posVelInit = do
+  mapM_ (`set` ECSPos 0) [0..9999]
+  mapM_ (`set` ECSVel 1) [0..999]
 
 posVelStep :: System PosVel ()
 posVelStep = cmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v)
@@ -33,3 +40,4 @@
     , bench "step" $ whnfIO (initPosVel >>= runSystem (posVelInit >> posVelStep))
     ]
   ]
+
diff --git a/src/Apecs.hs b/src/Apecs.hs
--- a/src/Apecs.hs
+++ b/src/Apecs.hs
@@ -5,7 +5,7 @@
 module Apecs (
   module Data.Proxy,
   -- * Core types
-    System(..), Component(..), Entity(..), Has(..), Not(..),
+    SystemT(..), System, Component(..), Entity(..), Has(..), Not(..),
     Get, Set, Destroy, Members,
 
   -- * Stores
diff --git a/src/Apecs/Concurrent.hs b/src/Apecs/Concurrent.hs
deleted file mode 100644
--- a/src/Apecs/Concurrent.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-
-module Apecs.Concurrent (
-  concurrently,
-  pmap,
-) where
-
-import qualified Control.Concurrent.Async as A
-import           Control.Monad.Reader
-import qualified Data.Vector.Unboxed      as U
-
-import           Apecs.System
-import           Apecs.Core
-
--- | Executes a list of systems concurrently, and blocks until all have finished.
---   Provides zero protection against race conditions and other hazards, so use with caution.
-concurrently :: [System w ()] -> System w ()
-concurrently ss = do w <- System ask
-                     liftIO . A.mapConcurrently_ (runWith w) $ ss
-
--- | Parallel version of @cmap@. 
-{-# INLINE pmap #-}
-pmap :: forall w cx cy. (Get w cx, Members w cx, Set w cy)
-     => Int -- ^ Entities per thread
-     -> (cx -> cy) -> System w ()
-pmap grainSize f =
-  do sr :: Storage cx <- getStore
-     sw :: Storage cy <- getStore
-     liftIO$ do
-       sl <- explMembers sr
-       parallelize grainSize (\e -> explGet sr e >>= explSet sw e . f) sl
-
-  where
-    parallelize grainSize sys vec
-      | U.length vec <= grainSize = U.mapM_ sys vec
-      | otherwise = A.mapConcurrently_ (U.mapM_ sys) vecSplits
-        where
-          vecSplits = go vec
-          go vec
-            | U.null vec = []
-            | otherwise = let (h,t) = U.splitAt grainSize vec in h : go t
-
diff --git a/src/Apecs/Core.hs b/src/Apecs/Core.hs
--- a/src/Apecs/Core.hs
+++ b/src/Apecs/Core.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeFamilies               #-}
 
@@ -18,26 +19,29 @@
 
 -- | An Entity is just an integer, used to index into a component store.
 --   In general, use @newEntity@, @cmap@, and component tags instead of manipulating these directly.
---   
+--
 --   For performance reasons, negative values like (-1) are reserved for stores to represent special values, so avoid using these.
-newtype Entity = Entity {unEntity :: Int} deriving (Num, Eq, Ord, Show)
+newtype Entity = Entity {unEntity :: Int} deriving (Num, Eq, Ord, Show, Enum)
 
--- | A System is a newtype around `ReaderT w IO a`, where `w` is the game world variable.
+-- | A SystemT is a newtype around `ReaderT w IO a`, where `w` is the game world variable.
 --   Systems mainly serve to
---   
+--
 --   * Lift side effects into the IO Monad.
 --
 --   * Allow type-based lookup of a component's store through @getStore@.
-newtype System w a = System {unSystem :: ReaderT w IO a} deriving (Functor, Monad, Applicative, MonadIO)
+newtype SystemT w m a = SystemT {unSystem :: ReaderT w m a} deriving (Functor, Monad, Applicative, MonadTrans, MonadIO)
+type System w a = SystemT w IO a
 
+deriving instance Monad m => MonadReader w (SystemT w m)
+
 -- | A component is defined by specifying how it is stored.
 --   The constraint ensures that stores and components are mapped one-to-one.
 class (Elem (Storage c) ~ c) => Component c where
   type Storage c
 
--- | @Has w c@ means that world @w@ can produce a @Storage c@.
-class Component c => Has w c where
-  getStore :: System w (Storage c)
+-- | @Has w m c@ means that world @w@ can produce a @Storage c@.
+class (Monad m, Component c) => Has w m c where
+  getStore :: SystemT w m (Storage c)
 
 -- | The type of components stored by a store, e.g. @Elem (Map c) = c@.
 type family Elem s
@@ -50,50 +54,56 @@
 
 -- | Stores that we can read using @explGet@ and @explExists@.
 --   For some entity @e@, @eplGet s e@ is only guaranteed to be safe if @explExists s e@ returns @True@.
-class ExplGet s where
+class Monad m => ExplGet m s where
   -- | Reads a component from the store. What happens if the component does not exist is left undefined, and might not necessarily crash.
-  explGet :: s -> Int -> IO (Elem s)
+  explGet :: s -> Int -> m (Elem s)
   -- | Returns whether there is a component for the given index.
-  explExists :: s -> Int -> IO Bool
+  explExists :: s -> Int -> m Bool
 
 -- | Stores that can be written.
-class ExplSet s where
+class Monad m => ExplSet m s where
   -- | Writes a component to the store.
-  explSet :: s -> Int -> Elem s -> IO ()
+  explSet :: s -> Int -> Elem s -> m ()
 
 -- | Stores that components can be removed from.
-class ExplDestroy s where
+class Monad m => ExplDestroy m s where
   -- | Destroys the component for a given index.
-  explDestroy :: s -> Int -> IO ()
+  explDestroy :: s -> Int -> m ()
 
 -- | Stores that we can request a list of member entities for.
-class ExplMembers s where
+class Monad m => ExplMembers m s where
   -- | Returns an unboxed vector of member indices
-  explMembers :: s -> IO (U.Vector Int)
+  explMembers :: s -> m (U.Vector Int)
 
-type Get     w c = (Has w c, ExplGet     (Storage c))
-type Set     w c = (Has w c, ExplSet     (Storage c))
-type Members w c = (Has w c, ExplMembers (Storage c))
-type Destroy w c = (Has w c, ExplDestroy (Storage c))
+type Get     w m c = (Has w m c, ExplGet     m (Storage c))
+type Set     w m c = (Has w m c, ExplSet     m (Storage c))
+type Members w m c = (Has w m c, ExplMembers m (Storage c))
+type Destroy w m c = (Has w m c, ExplDestroy m (Storage c))
 
 -- | Identity component/store. @Identity c@ is equivalent to @c@, so using it is mostly useless.
 instance Component c => Component (Identity c) where
   type Storage (Identity c) = Identity (Storage c)
 
-instance Has w c => Has w (Identity c) where
+instance Has w m c => Has w m (Identity c) where
+  {-# INLINE getStore #-}
   getStore = Identity <$> getStore
 
 type instance Elem (Identity s) = Identity (Elem s)
 
-instance ExplGet s => ExplGet (Identity s) where
+instance ExplGet m s => ExplGet m (Identity s) where
+  {-# INLINE explGet #-}
   explGet (Identity s) e = Identity <$> explGet s e
+  {-# INLINE explExists  #-}
   explExists  (Identity s) = explExists s
 
-instance ExplSet s => ExplSet (Identity s) where
+instance ExplSet m s => ExplSet m (Identity s) where
+  {-# INLINE explSet #-}
   explSet (Identity s) e (Identity x) = explSet s e x
-instance ExplMembers s => ExplMembers (Identity s) where
+instance ExplMembers m s => ExplMembers m (Identity s) where
+  {-# INLINE explMembers #-}
   explMembers (Identity s) = explMembers s
-instance ExplDestroy s => ExplDestroy (Identity s) where
+instance ExplDestroy m s => ExplDestroy m (Identity s) where
+  {-# INLINE explDestroy #-}
   explDestroy (Identity s) = explDestroy s
 
 T.makeInstances [2..8]
@@ -109,16 +119,20 @@
 instance Component c => Component (Not c) where
   type Storage (Not c) = NotStore (Storage c)
 
-instance (Has w c) => Has w (Not c) where
+instance (Has w m c) => Has w m (Not c) where
+  {-# INLINE getStore #-}
   getStore = NotStore <$> getStore
 
 type instance Elem (NotStore s) = Not (Elem s)
 
-instance ExplGet s => ExplGet (NotStore s) where
+instance ExplGet m s => ExplGet m (NotStore s) where
+  {-# INLINE explGet #-}
   explGet _ _ = return Not
+  {-# INLINE explExists #-}
   explExists (NotStore sa) ety = not <$> explExists sa ety
 
-instance ExplDestroy s => ExplSet (NotStore s) where
+instance ExplDestroy m s => ExplSet m (NotStore s) where
+  {-# INLINE explSet #-}
   explSet (NotStore sa) ety _ = explDestroy sa ety
 
 -- | Pseudostore used to produce values of type @Maybe a@.
@@ -128,19 +142,22 @@
 instance Component c => Component (Maybe c) where
   type Storage (Maybe c) = MaybeStore (Storage c)
 
-instance (Has w c) => Has w (Maybe c) where
+instance (Has w m c) => Has w m (Maybe c) where
+  {-# INLINE getStore #-}
   getStore = MaybeStore <$> getStore
 
 type instance Elem (MaybeStore s) = Maybe (Elem s)
 
-instance ExplGet s => ExplGet (MaybeStore s) where
+instance ExplGet m s => ExplGet m (MaybeStore s) where
+  {-# INLINE explGet #-}
   explGet (MaybeStore sa) ety = do
     e <- explExists sa ety
     if e then Just <$> explGet sa ety
          else return Nothing
   explExists _ _ = return True
 
-instance (ExplDestroy s, ExplSet s) => ExplSet (MaybeStore s) where
+instance (ExplDestroy m s, ExplSet m s) => ExplSet m (MaybeStore s) where
+  {-# INLINE explSet #-}
   explSet (MaybeStore sa) ety Nothing  = explDestroy sa ety
   explSet (MaybeStore sa) ety (Just x) = explSet sa ety x
 
@@ -152,36 +169,51 @@
 instance (Component ca, Component cb) => Component (Either ca cb) where
   type Storage (Either ca cb) = EitherStore (Storage ca) (Storage cb)
 
-instance (Has w ca, Has w cb) => Has w (Either ca cb) where
+instance (Has w m ca, Has w m cb) => Has w m (Either ca cb) where
+  {-# INLINE getStore #-}
   getStore = EitherStore <$> getStore <*> getStore
 
 type instance Elem (EitherStore sa sb) = Either (Elem sa) (Elem sb)
 
-instance (ExplGet sa, ExplGet sb) => ExplGet (EitherStore sa sb) where
+instance (ExplGet m sa, ExplGet m sb) => ExplGet m (EitherStore sa sb) where
+  {-# INLINE explGet #-}
   explGet (EitherStore sa sb) ety = do
     e <- explExists sb ety
     if e then Right <$> explGet sb ety
          else Left <$> explGet sa ety
+  {-# INLINE explExists #-}
   explExists (EitherStore sa sb) ety = do
     e <- explExists sb ety
     if e then return True
          else explExists sa ety
 
-instance (ExplSet sa, ExplSet sb) => ExplSet (EitherStore sa sb) where
+instance (ExplSet m sa, ExplSet m sb) => ExplSet m (EitherStore sa sb) where
+  {-# INLINE explSet #-}
   explSet (EitherStore _ sb) ety (Right b) = explSet sb ety b
   explSet (EitherStore sa _) ety (Left a)  = explSet sa ety a
 
-instance Has w () where
+instance (ExplDestroy m sa, ExplDestroy m sb)
+       => ExplDestroy m (EitherStore sa sb) where
+  {-# INLINE explDestroy #-}
+  explDestroy (EitherStore sa sb) ety =
+    explDestroy sa ety >> explDestroy sb ety
+
+instance Monad m => Has w m () where
+  {-# INLINE getStore #-}
   getStore = return ()
 instance Component () where
   type Storage () = ()
 type instance Elem () = ()
-instance ExplGet () where
+instance Monad m => ExplGet m () where
+  {-# INLINE explExists #-}
   explExists _ _ = return True
+  {-# INLINE explGet #-}
   explGet _ _ = return ()
-instance ExplSet () where
+instance Monad m => ExplSet m () where
+  {-# INLINE explSet #-}
   explSet _ _ _ = return ()
-instance ExplDestroy () where
+instance Monad m => ExplDestroy m () where
+  {-# INLINE explDestroy #-}
   explDestroy _ _ = return ()
 
 -- | Pseudocomponent that functions normally for @explExists@ and @explMembers@, but always return @Filter@ for @explGet@.
@@ -196,16 +228,20 @@
 instance Component c => Component (Filter c) where
   type Storage (Filter c) = FilterStore (Storage c)
 
-instance Has w c => Has w (Filter c) where
+instance Has w m c => Has w m (Filter c) where
+  {-# INLINE getStore #-}
   getStore = FilterStore <$> getStore
 
 type instance Elem (FilterStore s) = Filter (Elem s)
 
-instance ExplGet s => ExplGet (FilterStore s) where
+instance ExplGet m s => ExplGet m (FilterStore s) where
+  {-# INLINE explGet #-}
   explGet _ _ = return Filter
+  {-# INLINE explExists #-}
   explExists (FilterStore s) ety = explExists s ety
 
-instance ExplMembers s => ExplMembers (FilterStore s) where
+instance ExplMembers m s => ExplMembers m (FilterStore s) where
+  {-# INLINE explMembers #-}
   explMembers (FilterStore s) = explMembers s
 
 -- | Pseudostore used to produce components of type 'Entity'.
@@ -215,10 +251,13 @@
 instance Component Entity where
   type Storage Entity = EntityStore
 
-instance (Has w Entity) where
+instance Monad m => Has w m Entity where
+  {-# INLINE getStore #-}
   getStore = return EntityStore
 
 type instance Elem EntityStore = Entity
-instance ExplGet EntityStore where
+instance Monad m => ExplGet m EntityStore where
+  {-# INLINE explGet #-}
   explGet _ ety = return $ Entity ety
+  {-# INLINE explExists #-}
   explExists _ _ = return True
diff --git a/src/Apecs/Stores.hs b/src/Apecs/Stores.hs
--- a/src/Apecs/Stores.hs
+++ b/src/Apecs/Stores.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE Strict                #-}
@@ -13,8 +13,12 @@
   ( Map, Cache, Unique,
     Global,
     Cachable,
+    RawGlobal,
   ) where
 
+import           Control.Concurrent.STM      as S
+import           Control.Concurrent.STM.TVar as S
+
 import           Control.Monad.Reader
 import qualified Data.IntMap.Strict          as M
 import           Data.IORef
@@ -27,80 +31,168 @@
 
 import           Apecs.Core
 
--- | A map based on @Data.Intmap.Strict@. O(log(n)) for most operations.
-newtype Map c = Map (IORef (M.IntMap c))
+-- | A map based on @Data.IntMap.Strict@. O(log(n)) for most operations.
+newtype Map c = Map (TVar (M.IntMap (TVar c)))
 
 type instance Elem (Map c) = c
 instance ExplInit (Map c) where
-  explInit = Map <$> newIORef mempty
+  explInit = Map <$> newTVarIO mempty
 
-instance ExplGet (Map c) where
-  explExists (Map ref) ety = M.member ety <$> readIORef ref
-  explGet    (Map ref) ety = fromJust . M.lookup ety <$> readIORef ref
+instance ExplGet IO (Map c) where
+  explExists (Map ref) ety = M.member ety <$> readTVarIO ref
+  explGet    (Map ref) ety =
+    readTVarIO ref >>= readTVarIO . fromJust . M.lookup ety
   {-# INLINE explExists #-}
   {-# INLINE explGet #-}
 
-instance ExplSet (Map c) where
+instance ExplSet IO (Map c) where
   {-# INLINE explSet #-}
-  explSet (Map ref) ety x = modifyIORef' ref $ M.insert ety x
+  explSet (Map ref) ety x = do
+    m <- readTVarIO ref
+    case M.lookup ety m of
+      Nothing -> do
+        rInsert <- newTVarIO x
+        atomically . writeTVar ref $ M.insert ety rInsert m
+      Just cref -> atomically $ writeTVar cref x
 
-instance ExplDestroy (Map c) where
+instance ExplDestroy IO (Map c) where
   {-# INLINE explDestroy #-}
-  explDestroy (Map ref) ety = modifyIORef' ref (M.delete ety)
+  explDestroy (Map ref) ety =
+    readTVarIO ref >>= atomically . writeTVar ref . M.delete ety
 
-instance ExplMembers (Map c) where
+instance ExplMembers IO (Map c) where
   {-# INLINE explMembers #-}
-  explMembers (Map ref) = U.fromList . M.keys <$> readIORef ref
+  explMembers (Map ref) = U.fromList . M.keys <$> readTVarIO ref
 
+instance ExplGet STM (Map c) where
+  explExists (Map ref) ety = M.member ety <$> readTVar ref
+  explGet    (Map ref) ety =
+    readTVar ref >>= readTVar . fromJust . M.lookup ety
+  {-# INLINE explExists #-}
+  {-# INLINE explGet #-}
+
+instance ExplSet STM (Map c) where
+  {-# INLINE explSet #-}
+  explSet (Map ref) ety x = do
+    m <- readTVar ref
+    case M.lookup ety m of
+      Nothing -> do
+        rInsert <- newTVar x
+        writeTVar ref $ M.insert ety rInsert m
+      Just cref -> writeTVar cref x
+
+instance ExplDestroy STM (Map c) where
+  {-# INLINE explDestroy #-}
+  explDestroy (Map ref) ety = do
+    m <- readTVar ref
+    writeTVar ref $ M.delete ety m
+
+instance ExplMembers STM (Map c) where
+  {-# INLINE explMembers #-}
+  explMembers (Map ref) = U.fromList . M.keys <$> readTVar ref
+
 -- | A Unique contains zero or one component.
 --   Writing to it overwrites both the previous component and its owner.
 --   Its main purpose is to be a @Map@ optimized for when only ever one component inhabits it.
-data Unique c = Unique (IORef (Maybe (Int, c)))
+newtype Unique c = Unique (TVar (Maybe (Int, c)))
 type instance Elem (Unique c) = c
 instance ExplInit (Unique c) where
-  explInit = Unique <$> newIORef Nothing
+  explInit = Unique <$> newTVarIO Nothing
 
-instance ExplGet (Unique c) where
+instance ExplGet IO (Unique c) where
   {-# INLINE explGet #-}
-  explGet (Unique ref) _ = flip fmap (readIORef ref) $ \case
+  explGet (Unique ref) _ = flip fmap (readTVarIO ref) $ \case
     Nothing -> error "Reading empty Unique"
     Just (_, c)  -> c
   {-# INLINE explExists #-}
-  explExists (Unique ref) ety = maybe False ((==ety) . fst) <$> readIORef ref
+  explExists (Unique ref) ety = maybe False ((==ety) . fst) <$> readTVarIO ref
 
-instance ExplSet (Unique c) where
+instance ExplSet IO (Unique c) where
   {-# INLINE explSet #-}
-  explSet (Unique ref) ety c = writeIORef ref (Just (ety, c))
+  explSet (Unique ref) ety c = atomically $ writeTVar ref (Just (ety, c))
 
-instance ExplDestroy (Unique c) where
+instance ExplDestroy IO (Unique c) where
   {-# INLINE explDestroy #-}
-  explDestroy (Unique ref) ety = do
-    readIORef ref >>= mapM_ (flip when (writeIORef ref Nothing) . (==ety) . fst)
+  explDestroy (Unique ref) ety = readTVarIO ref >>=
+    mapM_ (flip when (atomically $ writeTVar ref Nothing) . (==ety) . fst)
 
-instance ExplMembers (Unique c) where
+instance ExplMembers IO (Unique c) where
   {-# INLINE explMembers #-}
-  explMembers (Unique ref) = flip fmap (readIORef ref) $ \case
+  explMembers (Unique ref) = flip fmap (readTVarIO ref) $ \case
     Nothing -> mempty
     Just (ety, _) -> U.singleton ety
 
+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
+
 -- | A Global contains exactly one component.
 --   The initial value is 'mempty' from the component's 'Monoid' instance.
+--
 --   When operating on a global, any entity arguments are ignored.
 --   For example, we can get a global component with @get 0@ or @get 1@ or even @get undefined@.
-newtype Global c = Global (IORef c)
+newtype Global c = Global (TVar c)
 type instance Elem (Global c) = c
 instance Monoid c => ExplInit (Global c) where
-  explInit = Global <$> newIORef mempty
+  {-# INLINE explInit #-}
+  explInit = Global <$> newTVarIO mempty
 
-instance ExplGet (Global c) where
-  explGet (Global ref) _ = readIORef ref
+instance ExplGet IO (Global c) where
+  {-# INLINE explGet #-}
+  explGet (Global ref) _ = readTVarIO ref
+  {-# INLINE explExists #-}
   explExists _ _ = return True
 
-instance ExplSet (Global c) where
-  explSet (Global ref) _ c = writeIORef ref c
+instance ExplSet IO (Global c) where
+  {-# INLINE explSet #-}
+  explSet (Global ref) _ c = atomically $ writeTVar ref c
 
+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
+
+newtype RawGlobal c = RawGlobal (IORef c)
+type instance Elem (RawGlobal c) = c
+instance Monoid c => ExplInit (RawGlobal c) where
+  {-# INLINE explInit #-}
+  explInit = RawGlobal <$> newIORef mempty
+
+instance ExplGet IO (RawGlobal c) where
+  {-# INLINE explGet #-}
+  explGet (RawGlobal ref) _ = readIORef ref
+  {-# INLINE explExists #-}
+  explExists _ _ = return True
+
+instance ExplSet IO (RawGlobal c) where
+  {-# INLINE explSet #-}
+  explSet (RawGlobal ref) _ c = writeIORef ref c
+
 -- | An empty type class indicating that the store behaves like a regular map, and can therefore safely be cached.
---   An example of a store that cannot be cached is 'Unique'.
 class Cachable s
 instance Cachable (Map s)
 instance (KnownNat n, Cachable s) => Cachable (Cache n s)
@@ -123,6 +215,7 @@
 type instance Elem (Cache n s) = Elem s
 
 instance (ExplInit s, KnownNat n, Cachable s) => ExplInit (Cache n s) where
+  {-# INLINE explInit #-}
   explInit = do
     let n = fromIntegral$ natVal (Proxy @n)
     tags <- UM.replicate n (-1)
@@ -130,7 +223,8 @@
     child <- explInit
     return (Cache n tags cache child)
 
-instance ExplGet s => ExplGet (Cache n s) where
+instance ExplGet IO s => ExplGet IO (Cache n s) where
+  {-# INLINE explGet #-}
   explGet (Cache n tags cache s) ety = do
     let index = ety `rem` n
     tag <- UM.unsafeRead tags index
@@ -138,11 +232,13 @@
        then VM.unsafeRead cache index
        else explGet s ety
 
+  {-# INLINE explExists #-}
   explExists (Cache n tags _ s) ety = do
     tag <- UM.unsafeRead tags (ety `rem` n)
     if tag == ety then return True else explExists s ety
 
-instance ExplSet s => ExplSet (Cache n s) where
+instance ExplSet IO s => ExplSet IO (Cache n s) where
+  {-# INLINE explSet #-}
   explSet (Cache n tags cache s) ety x = do
     let index = ety `rem` n
     tag <- UM.unsafeRead tags index
@@ -152,7 +248,8 @@
     UM.unsafeWrite tags  index ety
     VM.unsafeWrite cache index x
 
-instance ExplDestroy s => ExplDestroy (Cache n s) where
+instance ExplDestroy IO s => ExplDestroy IO (Cache n s) where
+  {-# INLINE explDestroy #-}
   explDestroy (Cache n tags cache s) ety = do
     let index = ety `rem` n
     tag <- UM.unsafeRead tags (ety `rem` n)
@@ -162,7 +259,8 @@
          VM.unsafeWrite cache index cacheMiss
        else explDestroy s ety
 
-instance ExplMembers s => ExplMembers (Cache n s) where
+instance ExplMembers IO s => ExplMembers IO (Cache n s) where
+  {-# INLINE explMembers #-}
   explMembers (Cache _ tags _ s) = do
     cached <- U.filter (/= (-1)) <$> U.freeze tags
     stored <- explMembers s
diff --git a/src/Apecs/System.hs b/src/Apecs/System.hs
--- a/src/Apecs/System.hs
+++ b/src/Apecs/System.hs
@@ -14,45 +14,45 @@
 
 -- | Run a system with a game world
 {-# INLINE runSystem #-}
-runSystem :: System w a -> w -> IO a
+runSystem :: SystemT w m a -> w -> m a
 runSystem sys = runReaderT (unSystem sys)
 
 -- | Run a system with a game world
 {-# INLINE runWith #-}
-runWith :: w -> System w a -> IO a
+runWith :: w -> SystemT w m a -> m a
 runWith = flip runSystem
 
 {-# INLINE get #-}
-get :: forall w c. Get w c => Entity -> System w c
+get :: forall w m c. Get w m c => Entity -> SystemT w m c
 get (Entity ety) = do
   s :: Storage c <- getStore
-  liftIO$ explGet s ety
+  lift$ explGet s ety
 
 -- | Writes a component to a given entity. Will overwrite existing components.
---   The type was originally 'Entity c -> c -> System w ()', but is relaxed to 'Entity e'
+--   The type was originally 'Entity c -> c -> SystemT w m ()', but is relaxed to 'Entity e'
 --   so you don't always have to write 'set . cast'
 {-# INLINE set #-}
-set :: forall w c. Set w c => Entity -> c -> System w ()
+set :: forall w m c. Set w m c => Entity -> c -> SystemT w m ()
 set (Entity ety) x = do
   s :: Storage c <- getStore
-  liftIO$ explSet s ety x
+  lift$ explSet s ety x
 
 -- | Returns whether the given entity has component @c@
 --   Note that @c@ is a phantom argument, used only to convey the type of the entity to be queried.
 {-# INLINE exists #-}
-exists :: forall w c. Get w c => Entity -> Proxy c -> System w Bool
+exists :: forall w m c. Get w m c => Entity -> Proxy c -> SystemT w m Bool
 exists (Entity ety) _ = do
   s :: Storage c <- getStore
-  liftIO$ explExists s ety
+  lift$ explExists s ety
 
 -- | Maps a function over all entities with a @cx@, and writes their @cy@.
 {-# INLINE cmap #-}
-cmap :: forall w cx cy. (Get w cx, Members w cx, Set w cy)
-     => (cx -> cy) -> System w ()
+cmap :: forall w m cx cy. (Get w m cx, Members w m cx, Set w m cy)
+     => (cx -> cy) -> SystemT w m ()
 cmap f = do
   sx :: Storage cx <- getStore
   sy :: Storage cy <- getStore
-  liftIO$ do
+  lift$ do
     sl <- explMembers sx
     U.forM_ sl $ \ e -> do
       r <- explGet sx e
@@ -60,89 +60,89 @@
 
 -- | Monadically iterates over all entites with a @cx@, and writes their @cy@.
 {-# INLINE cmapM #-}
-cmapM :: forall w cx cy. (Get w cx, Set w cy, Members w cx)
-      => (cx -> System w cy) -> System w ()
+cmapM :: forall w m cx cy. (Get w m cx, Set w m cy, Members w m cx)
+      => (cx -> SystemT w m cy) -> SystemT w m ()
 cmapM sys = do
   sx :: Storage cx <- getStore
   sy :: Storage cy <- getStore
-  sl <- liftIO$ explMembers sx
+  sl <- lift$ explMembers sx
   U.forM_ sl $ \ e -> do
-    x <- liftIO$ explGet sx e
+    x <- lift$ explGet sx e
     y <- sys x
-    liftIO$ explSet sy e y
+    lift$ explSet sy e y
 
 -- | Monadically iterates over all entites with a @cx@
 {-# INLINE cmapM_ #-}
-cmapM_ :: forall w c a. (Get w c, Members w c)
-       => (c -> System w a) -> System w ()
+cmapM_ :: forall w m c a. (Get w m c, Members w m c)
+       => (c -> SystemT w m a) -> SystemT w m ()
 cmapM_ sys = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
+  sl <- lift$ explMembers s
   U.forM_ sl $ \ ety -> do
-    x <- liftIO$ explGet s ety
+    x <- lift$ explGet s ety
     sys x
 
 -- | Fold over the game world; for example, @cfold max (minBound :: Foo)@ will find the maximum value of @Foo@.
 --   Strict in the accumulator.
 {-# INLINE cfold #-}
-cfold :: forall w c a. (Members w c, Get w c)
-      => (a -> c -> a) -> a -> System w a
+cfold :: forall w m c a. (Members w m c, Get w m c)
+      => (a -> c -> a) -> a -> SystemT w m a
 cfold f a0 = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
-  liftIO$ U.foldM' (\a e -> f a <$> explGet s e) a0 sl
+  sl <- lift$ explMembers s
+  lift$ U.foldM' (\a e -> f a <$> explGet s e) a0 sl
 
 -- | Monadically fold over the game world.
 --   Strict in the accumulator.
 {-# INLINE cfoldM #-}
-cfoldM :: forall w c a. (Members w c, Get w c)
-       => (a -> c -> System w a) -> a -> System w a
+cfoldM :: forall w m c a. (Members w m c, Get w m c)
+       => (a -> c -> SystemT w m a) -> a -> SystemT w m a
 cfoldM sys a0 = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
-  U.foldM' (\a e -> liftIO (explGet s e) >>= sys a) a0 sl
+  sl <- lift$ explMembers s
+  U.foldM' (\a e -> lift (explGet s e) >>= sys a) a0 sl
 
 -- | Monadically fold over the game world.
 --   Strict in the accumulator.
 {-# INLINE cfoldM_ #-}
-cfoldM_ :: forall w c a. (Members w c, Get w c)
-       => (a -> c -> System w a) -> a -> System w ()
+cfoldM_ :: forall w m c a. (Members w m c, Get w m c)
+       => (a -> c -> SystemT w m a) -> a -> SystemT w m ()
 cfoldM_ sys a0 = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
-  U.foldM'_ (\a e -> liftIO (explGet s e) >>= sys a) a0 sl
+  sl <- lift$ explMembers s
+  U.foldM'_ (\a e -> lift (explGet s e) >>= sys a) a0 sl
 
 -- | Get all components @c@.
 --   Call as @[(c,Entity)]@ to also read the entity index.
 {-# INLINE getAll #-}
-getAll :: forall w c. (Get w c, Members w c)
-      => System w [c]
+getAll :: forall w m c. (Get w m c, Members w m c)
+      => SystemT w m [c]
 getAll = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
-  forM (U.toList sl) $ liftIO . explGet s
+  sl <- lift$ explMembers s
+  forM (U.toList sl) $ lift . explGet s
 
 -- | Destroys component @c@ for the given entity.
 -- Note that @c@ is a phantom argument, used only to convey the type of the entity to be destroyed.
 {-# INLINE destroy #-}
-destroy :: forall w c. Destroy w c => Entity -> Proxy c -> System w ()
-destroy (Entity ety) _ = do
+destroy :: forall w m c. Destroy w m c => Entity -> Proxy c -> SystemT w m ()
+destroy (Entity ety) ~_ = do
   s :: Storage c <- getStore
-  liftIO$ explDestroy s ety
+  lift$ explDestroy s ety
 
 -- | Applies a function, if possible.
 {-# INLINE modify #-}
-modify :: forall w c. (Get w c, Set w c) => Entity -> (c -> c) -> System w ()
+modify :: forall w m c. (Get w m c, Set w m c) => Entity -> (c -> c) -> SystemT w m ()
 modify (Entity ety) f = do
   s :: Storage c <- getStore
-  liftIO$ do
+  lift$ do
     x <- explGet s ety
     explSet s ety (f x)
 
 -- | Counts the number of entities with a @c@
 {-# INLINE count #-}
-count :: forall w c. Members w c => c -> System w Int
+count :: forall w m c. Members w m c => Proxy c -> SystemT w m Int
 count ~_ = do
   s :: Storage c <- getStore
-  sl <- liftIO$ explMembers s
+  sl <- lift$ explMembers s
   return $ U.length sl
diff --git a/src/Apecs/TH.hs b/src/Apecs/TH.hs
--- a/src/Apecs/TH.hs
+++ b/src/Apecs/TH.hs
@@ -23,14 +23,15 @@
 
   let wld = mkName worldName
       has = mkName "Has"
-      sys = mkName "System"
+      sys = mkName "SystemT"
+      m = VarT $ mkName "m"
       wldDecl = DataD [] wld [] Nothing [RecC wld records] []
 
       makeRecord (t,n) = (n, Bang NoSourceUnpackedness SourceStrict, ConT (mkName "Storage") `AppT` t)
       records = makeRecord <$> cTypesNames
 
       makeInstance (t,n) =
-        InstanceD Nothing [] ((ConT has `AppT` ConT wld) `AppT` t)
+        InstanceD Nothing [ConT (mkName "Monad") `AppT` m] (ConT has `AppT` ConT wld `AppT` m `AppT` t)
           [ FunD (mkName "getStore") [Clause []
               (NormalB$ ConE sys `AppE` (VarE (mkName "asks") `AppE` VarE n))
             [] ]
diff --git a/src/Apecs/THTuples.hs b/src/Apecs/THTuples.hs
--- a/src/Apecs/THTuples.hs
+++ b/src/Apecs/THTuples.hs
@@ -35,9 +35,12 @@
 tupleInstances :: Int -> Q [Dec]
 tupleInstances n = do
   let vars = [ VarT . mkName $ "t_" ++ show i | i <- [0..n-1]]
+      m = VarT $ mkName "m"
 
+      -- [''a,''b] -> ''(a,b)
       tupleUpT :: [Type] -> Type
       tupleUpT = foldl AppT (TupleT n)
+      -- ''(t_0, t_1, .. )
       varTuple :: Type
       varTuple = tupleUpT vars
 
@@ -58,14 +61,14 @@
 
       -- Has
       hasN = mkName "Has"
-      hasT var = ConT hasN `AppT` VarT (mkName "w") `AppT` var
+      hasT var = ConT hasN `AppT` VarT (mkName "w") `AppT` m `AppT` var
       getStoreN = mkName "getStore"
       getStoreE = VarE getStoreN
       apN = mkName "<*>"
       apE = VarE apN
       hasI = InstanceD Nothing (hasT <$> vars) (hasT varTuple)
         [ FunD getStoreN
-          [Clause [] (NormalB$ liftAll tuplE (replicate n $ getStoreE )) [] ]
+          [Clause [] (NormalB$ liftAll tuplE (replicate n getStoreE )) [] ]
         , PragmaD$ InlineP getStoreN Inline FunLike AllPhases
         ]
 
@@ -94,10 +97,10 @@
       membersN = mkName "ExplMembers"
       destroyN = mkName "ExplDestroy"
 
-      getT var     = ConT getN `AppT` var
-      setT var     = ConT setN `AppT` var
-      membersT var = ConT membersN `AppT` var
-      destroyT var = ConT destroyN `AppT` var
+      getT     s = ConT getN     `AppT` m `AppT` s
+      setT     s = ConT setN     `AppT` m `AppT` s
+      membersT s = ConT membersN `AppT` m `AppT` s
+      destroyT s = ConT destroyN `AppT` m `AppT` s
 
       explSetN     = mkName "explSet"
       explDestroyN = mkName "explDestroy"
diff --git a/src/Apecs/Util.hs b/src/Apecs/Util.hs
--- a/src/Apecs/Util.hs
+++ b/src/Apecs/Util.hs
@@ -20,21 +20,26 @@
   -- * Timing
   timeSystem, timeSystem_,
 
+  -- * Concurrency
+  forkSys, atomically, sleep
+
   ) where
 
-import           Control.Applicative  (liftA2)
-import           Control.Monad.Reader (liftIO)
+import qualified Control.Concurrent     as C
+import qualified Control.Concurrent.STM as C
+import           System.CPUTime
+
+import           Control.Applicative    (liftA2)
+import           Control.Monad.Reader
 import           Data.Monoid
 import           Data.Semigroup
-import           System.CPUTime
-import           System.Mem           (performMajorGC)
+import           System.Mem             (performMajorGC)
 
+import           Apecs.Core
 import           Apecs.Stores
 import           Apecs.System
-import           Apecs.Core
 
 -- | Convenience entity, for use in places where the entity value does not matter, i.e. a global store.
--- Its value is -2, to avoid potential conflicts with caches, which reserve -1.
 global :: Entity
 global = Entity (-2)
 
@@ -47,7 +52,7 @@
 
 -- | Bumps the EntityCounter and yields its value
 {-# INLINE nextEntity #-}
-nextEntity :: Has w EntityCounter => System w Entity
+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)
@@ -55,15 +60,15 @@
 -- | Writes the given components to a new entity, and yields that entity.
 -- The return value is often ignored.
 {-# INLINE newEntity #-}
-newEntity :: (Set w c, Get w EntityCounter, Set w EntityCounter)
-          => c -> System w Entity
+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
 
 -- | Explicitly invoke the garbage collector
 runGC :: System w ()
-runGC = liftIO performMajorGC
+runGC = lift performMajorGC
 
 -- $hash
 -- The following are helper functions for spatial hashing.
@@ -119,11 +124,20 @@
 -- | Runs a system and gives its execution time in seconds
 timeSystem :: System w a -> System w (Double, a)
 timeSystem sys = do
-  s <- liftIO getCPUTime
+  s <- lift getCPUTime
   a <- sys
-  t <- liftIO getCPUTime
+  t <- lift getCPUTime
   return (fromIntegral (t-s)/1e12, a)
 
 -- | Runs a system, discards its output, and gives its execution time in seconds
 timeSystem_ :: System w a -> System w Double
 timeSystem_ = fmap fst . timeSystem
+
+forkSys :: System w () -> System w C.ThreadId
+forkSys sys = ask >>= liftIO . C.forkIO . runSystem sys
+
+atomically :: SystemT w C.STM () -> SystemT w IO ()
+atomically sys = ask >>= liftIO . C.atomically . runSystem sys
+
+sleep :: Int -> System w ()
+sleep = liftIO . C.threadDelay