diff --git a/aztecs.cabal b/aztecs.cabal
--- a/aztecs.cabal
+++ b/aztecs.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:          aztecs
-version:       0.4.0.1
+version:       0.5.0.0
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me
@@ -26,6 +26,7 @@
         Data.Aztecs.Component
         Data.Aztecs.Entity
         Data.Aztecs.Query
+        Data.Aztecs.Schedule
         Data.Aztecs.Storage
         Data.Aztecs.System
         Data.Aztecs.View
@@ -33,14 +34,14 @@
         Data.Aztecs.World.Archetype
         Data.Aztecs.World.Archetypes
         Data.Aztecs.World.Components
-
     hs-source-dirs:   src
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
-        containers >=0.7,
-        mtl >=2
+        base >=4.6 && <5,
+        containers >=0.6,
+        mtl >=2,
+        parallel-io >=0.3.5
 
 executable ecs
     main-is:          ECS.hs
@@ -48,7 +49,7 @@
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
+        base >=4.6 && <5,
         aztecs
 
 test-suite aztecs-test
@@ -58,7 +59,7 @@
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
+        base >=4.6 && <5,
         aztecs,
         hspec >=2,
         QuickCheck >=2
@@ -70,6 +71,6 @@
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
+        base >=4.6 && <5,
         aztecs,
         criterion >=1
diff --git a/examples/ECS.hs b/examples/ECS.hs
--- a/examples/ECS.hs
+++ b/examples/ECS.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE Arrows #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
@@ -29,7 +27,10 @@
         Position p <- Q.fetch -< ()
         Q.set -< Position $ p + v
     )
-    >>> S.run print
+    >>> S.task print
 
+app :: Schedule IO () ()
+app = schedule setup >>> forever (schedule move)
+
 main :: IO ()
-main = runSystem_ $ setup >>> S.forever move
+main = runSchedule_ $ app
diff --git a/src/Data/Aztecs.hs b/src/Data/Aztecs.hs
--- a/src/Data/Aztecs.hs
+++ b/src/Data/Aztecs.hs
@@ -56,14 +56,17 @@
     bundle,
     Component (..),
     EntityID,
-    System,
-    SystemT (..),
     Query,
     QueryFilter,
     with,
     without,
-    runSystem,
-    runSystem_,
+    System,
+    SystemT,
+    Schedule,
+    schedule,
+    forever,
+    runSchedule,
+    runSchedule_,
     World,
   )
 where
@@ -72,6 +75,7 @@
 import Data.Aztecs.Component (Component (..))
 import Data.Aztecs.Entity (EntityID)
 import Data.Aztecs.Query (Query, QueryFilter, with, without)
-import Data.Aztecs.System (System, SystemT (..), runSystem, runSystem_)
+import Data.Aztecs.Schedule (Schedule, forever, runSchedule, runSchedule_, schedule)
+import Data.Aztecs.System (System, SystemT)
 import Data.Aztecs.World (World)
 import Data.Aztecs.World.Archetype (Bundle, bundle)
diff --git a/src/Data/Aztecs/Access.hs b/src/Data/Aztecs/Access.hs
--- a/src/Data/Aztecs/Access.hs
+++ b/src/Data/Aztecs/Access.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
@@ -16,7 +17,7 @@
 where
 
 import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.State (MonadState (..), StateT (..))
+import Control.Monad.State.Strict (MonadState (..), StateT (..))
 import Data.Aztecs.Component (Component (..))
 import Data.Aztecs.Entity (EntityID (..))
 import Data.Aztecs.World (World (..))
@@ -39,8 +40,8 @@
   Bundle ->
   Access m EntityID
 spawn c = Access $ do
-  w <- get
-  let (e, w') = W.spawn c w
+  !w <- get
+  let !(e, w') = W.spawn c w
   put w'
   return e
 
@@ -52,17 +53,17 @@
 -- | Insert a component into an entity.
 insert :: (Monad m, Component a, Typeable (StorageT a)) => EntityID -> a -> Access m ()
 insert e c = Access $ do
-  w <- get
-  let w' = W.insert e c w
+  !w <- get
+  let !w' = W.insert e c w
   put w'
 
 lookup :: (Monad m, Component a) => EntityID -> Access m (Maybe a)
 lookup e = Access $ do
-  w <- get
+  !w <- get
   return $ W.lookup e w
 
 despawn :: (Monad m) => EntityID -> Access m ()
 despawn e = Access $ do
-  w <- get
-  let (_, w') = W.despawn e w
+  !w <- get
+  let !(_, w') = W.despawn e w
   put w'
diff --git a/src/Data/Aztecs/Component.hs b/src/Data/Aztecs/Component.hs
--- a/src/Data/Aztecs/Component.hs
+++ b/src/Data/Aztecs/Component.hs
@@ -4,7 +4,7 @@
 module Data.Aztecs.Component (Component (..), ComponentID (..)) where
 
 import Data.Aztecs.Storage (Storage)
-import Data.IntMap (IntMap)
+import Data.IntMap.Strict (IntMap)
 import Data.Kind (Type)
 import Data.Typeable (Typeable)
 
diff --git a/src/Data/Aztecs/Query.hs b/src/Data/Aztecs/Query.hs
--- a/src/Data/Aztecs/Query.hs
+++ b/src/Data/Aztecs/Query.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -11,7 +12,7 @@
     fetch,
     fetchMaybe,
     set,
-    run,
+    task,
     all,
 
     -- * Filters
@@ -45,7 +46,7 @@
 import qualified Data.Aztecs.World.Archetypes as AS
 import Data.Aztecs.World.Components (Components)
 import qualified Data.Aztecs.World.Components as CS
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Prelude hiding (all, any, id, lookup, map, mapM, reads, (.))
@@ -113,8 +114,8 @@
    in (ReadsWrites Set.empty (Set.singleton cId), cs', setDyn cId)
 
 -- | Run a monadic task in a `Query`.
-run :: (Monad m) => (i -> m o) -> Query m i o
-run f = Query $ \cs ->
+task :: (Monad m) => (i -> m o) -> Query m i o
+task f = Query $ \cs ->
   ( mempty,
     cs,
     DynamicQuery
@@ -129,7 +130,7 @@
 -- >>> import Data.Aztecs
 -- >>> import qualified Data.Aztecs.World as W
 -- >>>
--- >>> data X = X Int deriving (Show)
+-- >>> newtype X = X Int deriving (Show)
 -- >>> instance Component X
 -- >>>
 -- >>> let (_, w) = W.spawn (bundle $ X 0) W.empty
@@ -146,8 +147,8 @@
   return (concat as, w {components = cs'})
 
 data ReadsWrites = ReadsWrites
-  { reads :: Set ComponentID,
-    writes :: Set ComponentID
+  { reads :: !(Set ComponentID),
+    writes :: !(Set ComponentID)
   }
   deriving (Show)
 
@@ -189,8 +190,8 @@
   let (cId, cs') = CS.insert @a cs in (mempty {filterWithout = Set.singleton cId}, cs')
 
 data DynamicQueryFilter = DynamicQueryFilter
-  { filterWith :: Set ComponentID,
-    filterWithout :: Set ComponentID
+  { filterWith :: !(Set ComponentID),
+    filterWithout :: !(Set ComponentID)
   }
 
 instance Semigroup DynamicQueryFilter where
@@ -202,8 +203,8 @@
 
 -- | Dynamic query for components by ID.
 data DynamicQuery m i o = DynamicQuery
-  { dynQueryAll :: [i] -> [EntityID] -> Archetype -> m ([o], Archetype),
-    dynQueryLookup :: i -> EntityID -> Archetype -> m (Maybe o, Archetype)
+  { dynQueryAll :: !([i] -> [EntityID] -> Archetype -> m ([o], Archetype)),
+    dynQueryLookup :: !(i -> EntityID -> Archetype -> m (Maybe o, Archetype))
   }
 
 instance (Functor m) => Functor (DynamicQuery m i) where
@@ -287,7 +288,7 @@
 fetchDyn :: forall m a. (Applicative m, Component a) => ComponentID -> DynamicQuery m () a
 fetchDyn cId =
   DynamicQuery
-    { dynQueryAll = \_ _ arch -> let as = A.all cId arch in pure (fmap snd as, arch),
+    { dynQueryAll = \_ _ arch -> let !as = A.all cId arch in pure (fmap snd as, arch),
       dynQueryLookup = \_ eId arch -> pure $ (A.lookupComponent eId cId arch, arch)
     }
 
@@ -311,7 +312,7 @@
   DynamicQuery m a a
 setDyn cId =
   DynamicQuery
-    { dynQueryAll = \is _ arch -> pure (is, A.withAscList cId is arch),
+    { dynQueryAll = \is _ arch -> let !arch' = A.withAscList cId is arch in pure (is, arch'),
       dynQueryLookup =
         \i eId arch -> pure (A.lookupComponent eId cId arch, A.insertComponent eId cId i arch)
     }
diff --git a/src/Data/Aztecs/Schedule.hs b/src/Data/Aztecs/Schedule.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aztecs/Schedule.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Data.Aztecs.Schedule
+  ( -- * Schedules
+    Schedule (..),
+    schedule,
+    forever,
+    runSchedule,
+    runSchedule_,
+  )
+where
+
+import Control.Arrow (Arrow (..))
+import Control.Category (Category (..))
+import Control.Monad ((>=>))
+import Control.Monad.State (MonadState (..))
+import Control.Monad.Trans (MonadTrans (..))
+import Data.Aztecs.Access (Access (..), runAccess)
+import Data.Aztecs.System (DynamicSystemT (..), SystemT (..))
+import qualified Data.Aztecs.View as V
+import Data.Aztecs.World (World (..))
+import qualified Data.Aztecs.World as W
+import Data.Aztecs.World.Components (Components)
+
+newtype Schedule m i o = Schedule {runSchedule' :: Components -> (i -> Access m o, Components)}
+
+instance (Monad m) => Category (Schedule m) where
+  id = Schedule $ \cs -> (return, cs)
+  Schedule f . Schedule g = Schedule $ \cs ->
+    let (g', cs') = g cs
+        (f', cs'') = f cs'
+     in (g' >=> f', cs'')
+
+instance Arrow (Schedule IO) where
+  arr f = Schedule $ \cs -> (return Prelude.. f, cs)
+  first (Schedule f) = Schedule $ \cs ->
+    let (g, cs') = f cs
+     in (\(b, d) -> (,) <$> g b <*> return d, cs')
+
+runSchedule :: (Monad m) => Schedule m i o -> World -> i -> m (o, World)
+runSchedule s w i = do
+  let (f, cs) = runSchedule' s (components w)
+  (o, w') <- runAccess (f i) w {components = cs}
+  return (o, w')
+
+runSchedule_ :: (Monad m) => Schedule m () () -> m ()
+runSchedule_ s = const () <$> runSchedule s (W.empty) ()
+
+schedule :: (Monad m) => SystemT m i o -> Schedule m i o
+schedule t = Schedule $ \cs ->
+  let (dynT, _, cs') = runSystemT t cs
+      go i = Access $ do
+        w <- get
+        let f = runSystemTDyn dynT w
+        (o, v, access) <- lift $ f i
+        ((), w') <- lift Prelude.. runAccess access $ V.unview v w
+        put w'
+        return o
+   in (go, cs')
+
+forever :: (Monad m) => Schedule m i () -> Schedule m i ()
+forever s = Schedule $ \cs ->
+  let (f, cs') = runSchedule' s cs
+      go i = Access $ do
+        w <- get
+        let loop wAcc = do
+              ((), wAcc') <- lift $ runAccess (f i) wAcc
+              loop wAcc'
+        loop w
+   in (go, cs')
diff --git a/src/Data/Aztecs/Storage.hs b/src/Data/Aztecs/Storage.hs
--- a/src/Data/Aztecs/Storage.hs
+++ b/src/Data/Aztecs/Storage.hs
@@ -5,8 +5,8 @@
 module Data.Aztecs.Storage (Storage (..)) where
 
 import Data.Data (Typeable)
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
 
 -- | Component storage, containing zero or many components of the same type.
 class (Typeable (s a), Typeable a) => Storage s a where
diff --git a/src/Data/Aztecs/System.hs b/src/Data/Aztecs/System.hs
--- a/src/Data/Aztecs/System.hs
+++ b/src/Data/Aztecs/System.hs
@@ -1,18 +1,14 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RecursiveDo #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
 module Data.Aztecs.System
   ( -- * Systems
     System,
     SystemT (..),
-    forever,
-    run,
     queue,
+    task,
 
     -- ** Queries
 
@@ -24,122 +20,91 @@
     -- *** Writing
     map,
     map_,
-    mapSingle,
     filterMap,
-
-    -- ** Running
-    runSystem,
-    runSystem_,
-    runSystemWithWorld,
+    mapSingle,
 
-    -- * Dynamic systems
-    DynamicSystem,
+    -- * Dynamic SystemTs
     DynamicSystemT (..),
+    queueDyn,
+    raceDyn,
+
+    -- ** Queries
+
+    -- *** Reading
     allDyn,
+    filterDyn,
     singleDyn,
+
+    -- *** Writing
     mapDyn,
-    mapDyn_,
-    queueDyn,
-    runDyn,
+    filterMapDyn,
   )
 where
 
-import Control.Arrow (Arrow (..), ArrowLoop (..))
+import Control.Arrow (Arrow (..))
 import Control.Category (Category (..))
-import Control.Concurrent (forkIO)
-import Data.Aztecs.Access (Access, runAccess)
+import Control.Concurrent.ParallelIO.Global
+import Data.Aztecs.Access (Access (..))
+import Data.Aztecs.Component (ComponentID)
 import Data.Aztecs.Query (DynamicQuery, DynamicQueryFilter (..), Query (..), QueryFilter (..), ReadsWrites)
 import qualified Data.Aztecs.Query as Q
+import Data.Aztecs.View (View)
 import qualified Data.Aztecs.View as V
 import Data.Aztecs.World (World (..))
-import qualified Data.Aztecs.World as W
 import qualified Data.Aztecs.World.Archetype as A
-import Data.Aztecs.World.Archetypes (Node (nodeArchetype))
-import Data.Aztecs.World.Components (ComponentID, Components)
+import Data.Aztecs.World.Archetypes (Node (..))
+import Data.Aztecs.World.Components (Components)
 import qualified Data.Foldable as F
 import Data.Set (Set)
-import GHC.Conc (TVar, atomically, newTVarIO, readTVarIO, writeTVar)
-import Prelude hiding (all, filter, id, map, (.))
+import Prelude hiding (all, filter, map, (.))
+import qualified Prelude hiding (filter, map)
 
-type System = SystemT IO
+type System i o = SystemT IO i o
 
--- | System that can access and alter a `World`.
---
--- Systems can be composed either in sequence or parallel with `Category` and `Arrow` combinators.
--- Using the arrow combinator `&&&`, systems will automatically run in parallel
--- as long as their queries don't intersect.
-newtype SystemT m i o = SystemT
-  { -- | Initialize a system, producing a `DynamicSystem`.
-    runSystem' :: Components -> (Components, ReadsWrites, DynamicSystemT m i o)
-  }
+newtype SystemT m i o = SystemT {runSystemT :: Components -> (DynamicSystemT m i o, ReadsWrites, Components)}
   deriving (Functor)
 
-instance (Monad m) => Applicative (SystemT m i) where
-  pure a = SystemT (,mempty,pure a)
-  f <*> a =
-    SystemT $ \w ->
-      let (w', cIds, f') = runSystem' f w
-          (w'', cIds', a') = runSystem' a w'
-       in (w'', cIds <> cIds', f' <*> a')
-
-instance Category System where
-  id = SystemT (,mempty,id)
-  f . g = SystemT $ \cs ->
-    let (cs', cIds, g') = runSystem' g cs
-        (cs'', cIds', f') = runSystem' f cs'
-     in (cs'', cIds <> cIds', f' . g')
-
-instance Arrow System where
-  arr f = SystemT (,mempty,arr f)
-  first s = SystemT $ \w -> let (w', cIds, dynS) = runSystem' s w in (w', cIds, first dynS)
-  a &&& b = SystemT $ \w ->
-    let (w', aRws, dynA) = runSystem' a w
-        (w'', bRws, dynB) = runSystem' b w'
-        f = if Q.disjoint aRws bRws then (&&&) else joinDyn
-     in (w'', aRws <> bRws, f dynA dynB)
-
-instance ArrowLoop System where
-  loop s = SystemT $ \w -> let (w', cIds, dynS) = runSystem' s w in (w', cIds, loop dynS)
-
--- | Run a system forever.
-forever :: System () () -> System () ()
-forever s = SystemT $ \w -> let (w', cIds, dynS) = runSystem' s w in (w', cIds, foreverDyn dynS)
-
-runSystem_ :: System () () -> IO ()
-runSystem_ s = runSystem s >> pure ()
-
-runSystem :: System () () -> IO World
-runSystem s = runSystemWithWorld s W.empty
+instance (Monad m) => Category (SystemT m) where
+  id = SystemT $ \cs -> (DynamicSystemT $ \_ -> \i -> return (i, mempty, pure ()), mempty, cs)
+  SystemT f . SystemT g = SystemT $ \cs ->
+    let (f', rwsF, cs') = f cs
+        (g', rwsG, cs'') = g cs'
+     in (f' . g', rwsF <> rwsG, cs'')
 
-runSystemWithWorld :: System () () -> World -> IO World
-runSystemWithWorld s w = do
-  let (cs, _, dynS) = runSystem' s (components w)
-      w' = w {components = cs}
-  wVar <- newTVarIO w'
-  ((), access) <- runSystemDyn dynS () wVar
-  w'' <- readTVarIO wVar
-  ((), w''') <- runAccess access w''
-  return w'''
+instance Arrow (SystemT IO) where
+  arr f = SystemT $ \cs -> (DynamicSystemT $ \_ -> \i -> return (f i, mempty, pure ()), mempty, cs)
+  first (SystemT f) = SystemT $ \cs ->
+    let (f', rwsF, cs') = f cs
+     in (first f', rwsF, cs')
+  a &&& b = SystemT $ \cs ->
+    let (dynA, rwsA, cs') = runSystemT a cs
+        (dynB, rwsB, cs'') = runSystemT b cs'
+     in ( if Q.disjoint rwsA rwsB
+            then dynA &&& dynB
+            else raceDyn dynA dynB,
+          rwsA <> rwsB,
+          cs''
+        )
 
 -- | Query all matching entities.
-all :: Query IO () a -> System () [a]
+all :: (Monad m) => Query m i a -> SystemT m i [a]
 all q = SystemT $ \cs ->
-  let (rws, cs', dynQ) = runQuery q cs
-   in (cs', rws, allDyn (Q.reads rws <> Q.writes rws) dynQ)
+  let !(rws, cs', dynQ) = runQuery q cs
+   in (allDyn (Q.reads rws <> Q.writes rws) dynQ, rws, cs')
 
 -- | Query all matching entities with a `QueryFilter`.
-filter :: Query IO () a -> QueryFilter -> System () [a]
+filter :: (Monad m) => Query m () a -> QueryFilter -> SystemT m () [a]
 filter q qf = SystemT $ \cs ->
-  let (rws, cs', dynQ) = runQuery q cs
-      (dynQf, cs'') = runQueryFilter qf cs'
+  let !(rws, cs', dynQ) = runQuery q cs
+      !(dynQf, cs'') = runQueryFilter qf cs'
       qf' n =
         F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynQf)
           && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynQf)
-   in (cs'', rws, filterDyn (Q.reads rws <> Q.writes rws) dynQ qf')
+   in (filterDyn (Q.reads rws <> Q.writes rws) dynQ qf', rws, cs'')
 
 -- | Query a single matching entity.
 -- If there are zero or multiple matching entities, an error will be thrown.
-single :: Query IO () a -> System () a
+single :: (Monad m) => Query m () a -> SystemT m () a
 single q =
   fmap
     ( \as -> case as of
@@ -148,28 +113,28 @@
     )
     (all q)
 
--- | Map all matching entities, storing the updated entities.
-map :: Query IO i a -> System i [a]
+-- | Query all matching entities.
+map :: (Monad m) => Query m i a -> SystemT m i [a]
 map q = SystemT $ \cs ->
-  let (rws, cs', dynS) = runQuery q cs in (cs', rws, mapDyn (Q.reads rws <> Q.writes rws) dynS)
+  let !(rws, cs', dynQ) = runQuery q cs
+   in (mapDyn (Q.reads rws <> Q.writes rws) dynQ, rws, cs')
 
--- | Map all matching entities and ignore the output, storing the updated entities.
-map_ :: Query IO i a -> System i ()
+map_ :: (Monad m) => Query m i o -> SystemT m i ()
 map_ q = const () <$> map q
 
 -- | Map all matching entities with a `QueryFilter`, storing the updated entities.
-filterMap :: Query IO i a -> QueryFilter -> System i [a]
+filterMap :: (Monad m) => Query m i a -> QueryFilter -> SystemT m i [a]
 filterMap q qf = SystemT $ \cs ->
-  let (rws, cs', dynQ) = runQuery q cs
-      (dynQf, cs'') = runQueryFilter qf cs'
+  let !(rws, cs', dynQ) = runQuery q cs
+      !(dynQf, cs'') = runQueryFilter qf cs'
       f' n =
         F.all (\cId -> A.member cId $ nodeArchetype n) (filterWith dynQf)
           && F.all (\cId -> not (A.member cId $ nodeArchetype n)) (filterWithout dynQf)
-   in (cs'', rws, filterMapDyn (Q.reads rws <> Q.writes rws) dynQ f')
+   in (filterMapDyn (Q.reads rws <> Q.writes rws) dynQ f', rws, cs'')
 
 -- | Map a single matching entity, storing the updated components.
 -- If there are zero or multiple matching entities, an error will be thrown.
-mapSingle :: Query IO i a -> System i a
+mapSingle :: (Monad m) => Query m i a -> SystemT m i a
 mapSingle q =
   fmap
     ( \as -> case as of
@@ -178,98 +143,46 @@
     )
     (map q)
 
--- | Queue an `Access` to alter the world after this system is complete.
 queue :: (Monad m) => (i -> Access m ()) -> SystemT m i ()
-queue f = SystemT (,mempty,queueDyn f)
-
--- | Run a monadic task.
-run :: (Monad m) => (i -> m o) -> SystemT m i o
-run f = SystemT (,mempty,runDyn f)
+queue f = SystemT $ \cs -> (queueDyn f, mempty, cs)
 
-type DynamicSystem = DynamicSystemT IO
+task :: (Monad m) => (i -> m o) -> SystemT m i o
+task f = SystemT $ \cs ->
+  ( DynamicSystemT $ \_ -> \i -> do
+      o <- f i
+      return (o, mempty, pure ()),
+    mempty,
+    cs
+  )
 
--- | Dynamic system that can access and alter a `World`.
-newtype DynamicSystemT m i o = DynamicSystemT
-  {runSystemDyn :: i -> TVar World -> m (o, Access m ())}
+newtype DynamicSystemT m i o = DynamicSystemT {runSystemTDyn :: World -> (i -> m (o, View, Access m ()))}
   deriving (Functor)
 
-instance (Monad m) => Applicative (DynamicSystemT m i) where
-  pure a = DynamicSystemT $ \_ _ -> pure (a, pure ())
-  f <*> a =
-    DynamicSystemT $ \i w -> do
-      (f'', access) <- runSystemDyn f i w
-      (a'', access') <- runSystemDyn a i w
-      return (f'' a'', access >> access')
-
-instance Category DynamicSystem where
-  id = DynamicSystemT $ \i _ -> pure (i, pure ())
-  f . g = DynamicSystemT $ \i wVar -> do
-    (a, access) <- runSystemDyn g i wVar
-    w <- readTVarIO wVar
-    ((), w') <- runAccess access w
-    atomically $ writeTVar wVar w'
-    (b, access') <- runSystemDyn f a wVar
-    return (b, access')
-
-instance Arrow DynamicSystem where
-  arr f = DynamicSystemT $ \i _ -> pure (f i, pure ())
-  first s =
-    DynamicSystemT $ \(i, x) w -> do
-      (o, access) <- runSystemDyn s i w
-      return ((o, x), access)
-
-instance ArrowLoop DynamicSystem where
-  loop s = DynamicSystemT $ \b w -> mdo
-    ((c, d), access) <- runSystemDyn s (b, d) w
-    return (c, access)
-
--- | Combine two dynamic systems in parallel.
-joinDyn :: DynamicSystem i a -> DynamicSystem i b -> DynamicSystem i (a, b)
-joinDyn f g = DynamicSystemT $ \i w -> do
-  fVar <- newTVarIO Nothing
-  gVar <- newTVarIO Nothing
-  _ <- forkIO $ do
-    result <- runSystemDyn f i w
-    atomically $ writeTVar fVar (Just result)
-  _ <- forkIO $ do
-    result <- runSystemDyn g i w
-    atomically $ writeTVar gVar (Just result)
-  let go = do
-        maybeA <- readTVarIO fVar
-        maybeB <- readTVarIO gVar
-        case (maybeA, maybeB) of
-          (Just (a, accessA), Just (b, accessB)) -> return ((a, b), accessA >> accessB)
-          _ -> go
-  go
+instance (Monad m) => Category (DynamicSystemT m) where
+  id = DynamicSystemT $ \_ -> \i -> return (i, mempty, pure ())
+  DynamicSystemT f . DynamicSystemT g = DynamicSystemT $ \w -> \i -> do
+    (b, gView, gAccess) <- g w i
+    (a, fView, fAccess) <- f w b
+    return (a, gView <> fView, gAccess >> fAccess)
 
--- | Run a dynamic system forever.
-foreverDyn :: DynamicSystem () () -> DynamicSystem () ()
-foreverDyn s = DynamicSystemT $ \_ w -> do
-  let go w' = do
-        ((), access) <- runSystemDyn s () w'
-        wAcc' <- readTVarIO w'
-        ((), wAcc'') <- runAccess access wAcc'
-        atomically $ writeTVar w' wAcc''
-        go w'
-  go w
+instance (Monad m) => Arrow (DynamicSystemT m) where
+  arr f = DynamicSystemT $ \_ -> \i -> return (f i, mempty, pure ())
+  first (DynamicSystemT f) = DynamicSystemT $ \w -> \(i, x) -> do
+    (a, v, access) <- f w i
+    return ((a, x), v, access)
 
 -- | Query all matching entities.
-allDyn :: Set ComponentID -> DynamicQuery IO () a -> DynamicSystem () [a]
-allDyn cIds q = DynamicSystemT $ \_ w -> do
-  w' <- readTVarIO w
-  let v = V.view cIds (archetypes w')
-  fmap (\(a, _) -> (a, pure ())) (V.allDyn () q v)
+allDyn :: (Monad m) => Set ComponentID -> DynamicQuery m i o -> DynamicSystemT m i [o]
+allDyn cIds q = DynamicSystemT $ \w ->
+  let !v = V.view cIds $ archetypes w
+   in \i -> fmap (\(a, _) -> (a, mempty, pure ())) (V.allDyn i q v)
 
-filterDyn :: Set ComponentID -> DynamicQuery IO i a -> (Node -> Bool) -> DynamicSystemT IO i [a]
-filterDyn cIds q f = DynamicSystemT $ \i wVar -> do
-  w <- readTVarIO wVar
-  let v = V.filterView cIds f (archetypes w)
-  (as, _) <- V.allDyn i q v
-  return (as, pure ())
+filterDyn :: (Monad m) => Set ComponentID -> DynamicQuery m i o -> (Node -> Bool) -> DynamicSystemT m i [o]
+filterDyn cIds q f = DynamicSystemT $ \w ->
+  let !v = V.filterView cIds f $ archetypes w
+   in \i -> fmap (\(a, _) -> (a, mempty, pure ())) (V.allDyn i q v)
 
--- | Query a single matching entity.
--- If there are zero or multiple matching entities, an error will be thrown.
-singleDyn :: Set ComponentID -> DynamicQuery IO () a -> DynamicSystem () a
+singleDyn :: (Monad m) => Set ComponentID -> DynamicQuery m () a -> DynamicSystemT m () a
 singleDyn cIds q =
   fmap
     ( \as -> case as of
@@ -279,30 +192,23 @@
     (allDyn cIds q)
 
 -- | Map all matching entities, storing the updated entities.
-mapDyn :: Set ComponentID -> DynamicQuery IO i a -> DynamicSystem i [a]
-mapDyn cIds q = DynamicSystemT $ \i wVar -> do
-  w <- readTVarIO wVar
-  let v = V.view cIds (archetypes w)
-  (as, v') <- V.allDyn i q v
-  atomically $ writeTVar wVar $ V.unview v' w
-  return (as, pure ())
-
-filterMapDyn :: Set ComponentID -> DynamicQuery IO i a -> (Node -> Bool) -> DynamicSystemT IO i [a]
-filterMapDyn cIds q f = DynamicSystemT $ \i wVar -> do
-  w <- readTVarIO wVar
-  let v = V.filterView cIds f (archetypes w)
-  (as, v') <- V.allDyn i q v
-  atomically $ writeTVar wVar $ V.unview v' w
-  return (as, pure ())
+mapDyn :: (Monad m) => Set ComponentID -> DynamicQuery m i o -> DynamicSystemT m i [o]
+mapDyn cIds q = DynamicSystemT $ \w ->
+  let !v = V.view cIds $ archetypes w
+   in \i -> fmap (\(a, v') -> (a, v', pure ())) (V.allDyn i q v)
 
--- | Map all matching entities and ignore the output, storing the updated entities.
-mapDyn_ :: Set ComponentID -> DynamicQuery IO () a -> DynamicSystem () ()
-mapDyn_ cIds q = const () <$> mapDyn cIds q
+filterMapDyn :: (Monad m) => Set ComponentID -> DynamicQuery m i o -> (Node -> Bool) -> DynamicSystemT m i [o]
+filterMapDyn cIds q f = DynamicSystemT $ \w ->
+  let !v = V.filterView cIds f $ archetypes w
+   in \i -> fmap (\(a, v') -> (a, v', pure ())) (V.allDyn i q v)
 
--- | Queue an `Access` to alter the world after this system is complete.
-queueDyn :: (Applicative m) => (i -> Access m ()) -> DynamicSystemT m i ()
-queueDyn f = DynamicSystemT $ \i _ -> pure ((), f i)
+queueDyn :: (Monad m) => (i -> Access m ()) -> DynamicSystemT m i ()
+queueDyn f = DynamicSystemT $ \_ -> \i -> return ((), mempty, f i)
 
--- | Run a monadic task.
-runDyn :: (Monad m) => (i -> m o) -> DynamicSystemT m i o
-runDyn f = DynamicSystemT $ \i _ -> fmap (,pure ()) (f i)
+raceDyn :: DynamicSystemT IO i a -> DynamicSystemT IO i b -> DynamicSystemT IO i (a, b)
+raceDyn (DynamicSystemT f) (DynamicSystemT g) = DynamicSystemT $ \w -> \i -> do
+  results <- parallel [fmap (\a -> (Just a, Nothing)) $ f w i, fmap (\b -> (Nothing, Just b)) $ g w i]
+  ((a, v, fAccess), (b, v', gAccess)) <- case results of
+    [(Just a, _), (_, Just b)] -> return (a, b)
+    _ -> error "joinDyn: exception"
+  return ((a, b), v <> v', fAccess >> gAccess)
diff --git a/src/Data/Aztecs/View.hs b/src/Data/Aztecs/View.hs
--- a/src/Data/Aztecs/View.hs
+++ b/src/Data/Aztecs/View.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
@@ -20,11 +21,15 @@
 import Data.Aztecs.World.Archetypes (ArchetypeID, Archetypes, Node (..))
 import qualified Data.Aztecs.World.Archetypes as AS
 import Data.Aztecs.World.Components (ComponentID)
-import Data.Foldable (foldrM)
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Foldable (foldlM)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 
+#if !MIN_VERSION_base(4,20,0)
+import Data.Foldable (foldl')
+#endif
+
 -- | View into a `World`, containing a subset of archetypes.
 newtype View = View {viewArchetypes :: Map ArchetypeID Node}
   deriving (Show, Semigroup, Monoid)
@@ -46,8 +51,8 @@
 unview v w =
   w
     { W.archetypes =
-        foldr
-          (\(aId, n) as -> as {AS.nodes = Map.insert aId n (AS.nodes as)})
+        foldl'
+          (\as (aId, n) -> as {AS.nodes = Map.insert aId n (AS.nodes as)})
           (W.archetypes w)
           (Map.toList $ viewArchetypes v)
     }
@@ -56,8 +61,8 @@
 allDyn :: (Monad m) => i -> DynamicQuery m i a -> View -> m ([a], View)
 allDyn i q v =
   fmap (\(as, arches) -> (as, View arches)) $
-    foldrM
-      ( \(aId, n) (acc, archAcc) -> do
+    foldlM
+      ( \(acc, archAcc) (aId, n) -> do
           (as, arch') <- dynQueryAll q (repeat i) (A.entities (nodeArchetype n)) (nodeArchetype n)
           return (as ++ acc, Map.insert aId (n {nodeArchetype = arch'}) archAcc)
       )
diff --git a/src/Data/Aztecs/World.hs b/src/Data/Aztecs/World.hs
--- a/src/Data/Aztecs/World.hs
+++ b/src/Data/Aztecs/World.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Data.Aztecs.World
   ( World (..),
@@ -38,12 +40,16 @@
 import Data.Typeable (Proxy (..), Typeable, typeOf)
 import Prelude hiding (lookup)
 
+#if !MIN_VERSION_base(4,20,0)
+import Data.Foldable (foldl')
+#endif
+
 -- | World of entities and their components.
 data World = World
-  { archetypes :: Archetypes,
-    components :: Components,
-    entities :: Map EntityID ArchetypeID,
-    nextEntityId :: EntityID
+  { archetypes :: !Archetypes,
+    components :: !Components,
+    entities :: !(Map EntityID ArchetypeID),
+    nextEntityId :: !EntityID
   }
   deriving (Show)
 
@@ -115,11 +121,11 @@
   World ->
   (EntityID, World)
 spawnWithId cId c w =
-  let (e, w') = spawnEmpty w
+  let !(e, w') = spawnEmpty w
    in case AS.lookupArchetypeId (Set.singleton cId) (archetypes w) of
         Just aId -> (e, spawnWithArchetypeId' e aId cId c w')
         Nothing ->
-          let (aId, arches) =
+          let !(aId, arches) =
                 AS.insertArchetype
                   (Set.singleton cId)
                   ( Node
@@ -142,7 +148,7 @@
   World ->
   (EntityID, World)
 spawnWithArchetypeId c cId aId w =
-  let (e, w') = spawnEmpty w
+  let !(e, w') = spawnEmpty w
    in (e, spawnWithArchetypeId' e aId cId c w')
 
 spawnWithArchetypeId' ::
@@ -164,7 +170,7 @@
 -- | Insert a component into an entity.
 insert :: forall a. (Component a, Typeable (StorageT a)) => EntityID -> a -> World -> World
 insert e c w =
-  let (cId, components') = CS.insert @a (components w)
+  let !(cId, components') = CS.insert @a (components w)
    in insertWithId e cId c w {components = components'}
 
 -- | Insert a component into an entity with its `ComponentID`.
@@ -176,9 +182,9 @@
         then w {archetypes = (archetypes w) {AS.nodes = Map.adjust (\n -> n {nodeArchetype = A.insertComponent e cId c (nodeArchetype n)}) aId (AS.nodes $ archetypes w)}}
         else case AS.lookupArchetypeId (Set.insert cId (nodeComponentIds node)) (archetypes w) of
           Just nextAId ->
-            let (cs, arch') = A.remove e (nodeArchetype node)
-                w' = w {archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)}}
-                f (itemCId, dyn) archAcc =
+            let !(cs, arch') = A.remove e (nodeArchetype node)
+                !w' = w {archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)}}
+                f archAcc (itemCId, dyn) =
                   archAcc
                     { A.storages =
                         Map.adjust
@@ -195,7 +201,7 @@
                                   nextNode
                                     { nodeArchetype =
                                         A.insertComponent e cId c $
-                                          foldr
+                                          foldl'
                                             f
                                             (nodeArchetype nextNode)
                                             (Map.toList cs)
@@ -207,15 +213,15 @@
                     entities = Map.insert e nextAId (entities w')
                   }
           Nothing ->
-            let (s, arch') = A.removeStorages e (nodeArchetype node)
-                n =
+            let !(s, arch') = A.removeStorages e (nodeArchetype node)
+                !n =
                   Node
                     { nodeComponentIds = Set.insert cId (nodeComponentIds node),
                       nodeArchetype = A.insertComponent e cId c (Archetype {A.storages = s}),
                       nodeAdd = Map.empty,
                       nodeRemove = Map.singleton cId aId
                     }
-                (nextAId, arches) = AS.insertArchetype (Set.insert cId (nodeComponentIds node)) n (archetypes w)
+                !(nextAId, arches) = AS.insertArchetype (Set.insert cId (nodeComponentIds node)) n (archetypes w)
              in w
                   { archetypes =
                       arches
@@ -249,21 +255,21 @@
 
 lookup :: forall a. (Component a) => EntityID -> World -> Maybe a
 lookup e w = do
-  cId <- CS.lookup @a (components w)
-  aId <- Map.lookup e (entities w)
-  node <- AS.lookupNode aId (archetypes w)
+  !cId <- CS.lookup @a (components w)
+  !aId <- Map.lookup e (entities w)
+  !node <- AS.lookupNode aId (archetypes w)
   A.lookupComponent e cId (nodeArchetype node)
 
 -- | Despawn an entity, returning its components.
 despawn :: EntityID -> World -> (Map ComponentID Dynamic, World)
 despawn e w =
   let res = do
-        aId <- Map.lookup e (entities w)
-        node <- AS.lookupNode aId (archetypes w)
+        !aId <- Map.lookup e (entities w)
+        !node <- AS.lookupNode aId (archetypes w)
         return (aId, node)
    in case res of
         Just (aId, node) ->
-          let (dynAcc, arch') = A.remove e (nodeArchetype node)
+          let !(dynAcc, arch') = A.remove e (nodeArchetype node)
            in ( dynAcc,
                 w
                   { archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
diff --git a/src/Data/Aztecs/World/Archetype.hs b/src/Data/Aztecs/World/Archetype.hs
--- a/src/Data/Aztecs/World/Archetype.hs
+++ b/src/Data/Aztecs/World/Archetype.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -39,19 +41,23 @@
 import qualified Data.Aztecs.World.Components as CS
 import Data.Bifunctor (Bifunctor (..))
 import Data.Dynamic (Dynamic, Typeable, fromDynamic, toDyn)
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Prelude hiding (all, lookup)
 
+#if !MIN_VERSION_base(4,20,0)
+import Data.Foldable (foldl')
+#endif
+
 data AnyStorage = AnyStorage
-  { storageDyn :: Dynamic,
-    insertDyn :: Int -> Dynamic -> Dynamic -> Dynamic,
-    removeDyn :: Int -> Dynamic -> (Maybe Dynamic, Dynamic),
-    removeAny :: Int -> Dynamic -> (Maybe AnyStorage, Dynamic),
-    entitiesDyn :: Dynamic -> [Int]
+  { storageDyn :: !Dynamic,
+    insertDyn :: !(Int -> Dynamic -> Dynamic -> Dynamic),
+    removeDyn :: !(Int -> Dynamic -> (Maybe Dynamic, Dynamic)),
+    removeAny :: !(Int -> Dynamic -> (Maybe AnyStorage, Dynamic)),
+    entitiesDyn :: !(Dynamic -> [Int])
   }
 
 instance Show AnyStorage where
@@ -63,14 +69,14 @@
     { storageDyn = toDyn s,
       insertDyn = \i cDyn sDyn ->
         fromMaybe sDyn $ do
-          s' <- fromDynamic @(s a) sDyn
-          c <- fromDynamic cDyn
+          !s' <- fromDynamic @(s a) sDyn
+          !c <- fromDynamic cDyn
           return . toDyn $ S.insert i c s',
       removeDyn = \i dyn -> case fromDynamic @(s a) dyn of
-        Just s' -> let (a, b) = S.remove i s' in (fmap toDyn a, toDyn b)
+        Just s' -> let !(a, b) = S.remove i s' in (fmap toDyn a, toDyn b)
         Nothing -> (Nothing, dyn),
       removeAny = \i dyn -> case fromDynamic @(s a) dyn of
-        Just s' -> let (a, b) = S.remove i s' in (fmap (anyStorage . S.singleton @s i) a, toDyn b)
+        Just s' -> let !(a, b) = S.remove i s' in (fmap (anyStorage . S.singleton @s i) a, toDyn b)
         Nothing -> (Nothing, dyn),
       entitiesDyn = \dyn -> case fromDynamic @(s a) dyn of
         Just s' -> map fst $ S.all s'
@@ -90,7 +96,7 @@
 
 insertComponent :: forall a. (Component a) => EntityID -> ComponentID -> a -> Archetype -> Archetype
 insertComponent e cId c arch =
-  let storage = case lookupStorage cId arch of
+  let !storage = case lookupStorage cId arch of
         Just s -> S.insert (unEntityId e) c s
         Nothing -> S.singleton @(StorageT a) @a (unEntityId e) c
    in arch {storages = Map.insert cId (anyStorage storage) (storages arch)}
@@ -120,32 +126,30 @@
 
 insertAscList :: forall a. (Component a) => ComponentID -> [(EntityID, a)] -> Archetype -> Archetype
 insertAscList cId as arch =
-  arch
-    { storages =
+  let !storages' =
         Map.insert
           cId
           (anyStorage $ S.fromAscList @(StorageT a) (map (first unEntityId) as))
           (storages arch)
-    }
+   in arch {storages = storages'}
 
 withAscList :: forall a. (Component a) => ComponentID -> [a] -> Archetype -> Archetype
 withAscList cId as arch =
-  arch
-    { storages =
+  let !storages' =
         Map.adjust
           ( \s ->
               (anyStorage $ S.fromAscList @(StorageT a) (zip (entitiesDyn s (storageDyn s)) as))
           )
           cId
           (storages arch)
-    }
+   in arch {storages = storages'}
 
 remove :: EntityID -> Archetype -> (Map ComponentID Dynamic, Archetype)
 remove e arch =
-  foldr
-    ( \(cId, s) (dynAcc, archAcc) ->
-        let (dynA, dynS) = removeDyn s (unEntityId e) (storageDyn s)
-            dynAcc' = case dynA of
+  foldl'
+    ( \(dynAcc, archAcc) (cId, s) ->
+        let !(dynA, dynS) = removeDyn s (unEntityId e) (storageDyn s)
+            !dynAcc' = case dynA of
               Just d -> Map.insert cId d dynAcc
               Nothing -> dynAcc
          in ( dynAcc',
@@ -157,8 +161,8 @@
 
 removeStorages :: EntityID -> Archetype -> (Map ComponentID AnyStorage, Archetype)
 removeStorages e arch =
-  foldr
-    ( \(cId, s) (dynAcc, archAcc) ->
+  foldl'
+    ( \(dynAcc, archAcc) (cId, s) ->
         let (dynA, dynS) = removeAny s (unEntityId e) (storageDyn s)
             dynAcc' = case dynA of
               Just d -> Map.insert cId d dynAcc
@@ -198,6 +202,6 @@
 
 runBundle :: Bundle -> Components -> EntityID -> Archetype -> (Components, Archetype)
 runBundle b cs eId arch =
-  let (_, cs', d) = unBundle b cs
-      arch' = runDynamicBundle d eId arch
+  let !(_, cs', d) = unBundle b cs
+      !arch' = runDynamicBundle d eId arch
    in (cs', arch')
diff --git a/src/Data/Aztecs/World/Archetypes.hs b/src/Data/Aztecs/World/Archetypes.hs
--- a/src/Data/Aztecs/World/Archetypes.hs
+++ b/src/Data/Aztecs/World/Archetypes.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -22,13 +24,17 @@
 
 import Data.Aztecs.Component (ComponentID)
 import Data.Aztecs.World.Archetype hiding (empty)
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Maybe (mapMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Prelude hiding (all, lookup, map)
 
+#if !MIN_VERSION_base(4,20,0)
+import Data.Foldable (foldl')
+#endif
+
 -- | `Archetype` ID.
 newtype ArchetypeID = ArchetypeID {unArchetypeId :: Int}
   deriving (Eq, Ord, Show)
@@ -36,26 +42,26 @@
 -- | Node in `Archetypes`.
 data Node = Node
   { -- | Unique set of `ComponentID`s of this `Node`.
-    nodeComponentIds :: Set ComponentID,
+    nodeComponentIds :: !(Set ComponentID),
     -- | `Archetype` of this `Node`.
-    nodeArchetype :: Archetype,
+    nodeArchetype :: !Archetype,
     -- | Edges to other `Archetype`s by adding a `ComponentID`.
-    nodeAdd :: Map ComponentID ArchetypeID,
+    nodeAdd :: !(Map ComponentID ArchetypeID),
     -- | Edges to other `Archetype`s by removing a `ComponentID`.
-    nodeRemove :: Map ComponentID ArchetypeID
+    nodeRemove :: !(Map ComponentID ArchetypeID)
   }
   deriving (Show)
 
 -- | `Archetype` graph.
 data Archetypes = Archetypes
   { -- | Archetype nodes in the graph.
-    nodes :: Map ArchetypeID Node,
+    nodes :: !(Map ArchetypeID Node),
     -- | Mapping of unique `ComponentID` sets to `ArchetypeID`s.
-    archetypeIds :: Map (Set ComponentID) ArchetypeID,
+    archetypeIds :: !(Map (Set ComponentID) ArchetypeID),
     -- | Next unique `ArchetypeID`.
-    nextArchetypeId :: ArchetypeID,
+    nextArchetypeId :: !ArchetypeID,
     -- | Mapping of `ComponentID`s to `ArchetypeID`s of `Archetypes` that contain them.
-    componentIds :: Map ComponentID (Set ArchetypeID)
+    componentIds :: !(Map ComponentID (Set ArchetypeID))
   }
   deriving (Show)
 
@@ -88,7 +94,7 @@
 -- | Find `ArchetypeID`s containing a set of `ComponentID`s.
 findArchetypeIds :: Set ComponentID -> Archetypes -> Set ArchetypeID
 findArchetypeIds cIds arches = case mapMaybe (\cId -> Map.lookup cId (componentIds arches)) (Set.elems cIds) of
-  (aId : aIds') -> foldr Set.intersection aId aIds'
+  (aId : aIds') -> foldl' Set.intersection aId aIds'
   [] -> Set.empty
 
 -- | Lookup `Archetype`s containing a set of `ComponentID`s.
@@ -101,10 +107,10 @@
 -- | Map over `Archetype`s containing a set of `ComponentID`s.
 map :: Set ComponentID -> (Archetype -> (a, Archetype)) -> Archetypes -> ([a], Archetypes)
 map cIds f arches =
-  foldr
-    ( \aId (acc, archAcc) ->
-        let node = nodes archAcc Map.! aId
-            (a, arch') = f (nodeArchetype node)
+  foldl'
+    ( \(acc, archAcc) aId ->
+        let !node = nodes archAcc Map.! aId
+            !(a, arch') = f (nodeArchetype node)
          in (a : acc, archAcc {nodes = Map.insert aId (node {nodeArchetype = arch'}) (nodes archAcc)})
     )
     ([], arches)
diff --git a/src/Data/Aztecs/World/Components.hs b/src/Data/Aztecs/World/Components.hs
--- a/src/Data/Aztecs/World/Components.hs
+++ b/src/Data/Aztecs/World/Components.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -13,15 +14,15 @@
 where
 
 import Data.Aztecs.Component (Component, ComponentID (..))
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Typeable (Proxy (..), TypeRep, Typeable, typeOf)
 import Prelude hiding (lookup)
 
 -- | Component ID map.
 data Components = Components
-  { componentIds :: Map TypeRep ComponentID,
-    nextComponentId :: ComponentID
+  { componentIds :: !(Map TypeRep ComponentID),
+    nextComponentId :: !ComponentID
   }
   deriving (Show)
 
@@ -46,7 +47,7 @@
 -- | Insert a component ID by type.
 insert' :: forall c. (Component c) => Components -> (ComponentID, Components)
 insert' cs =
-  let cId = nextComponentId cs
+  let !cId = nextComponentId cs
    in ( cId,
         cs
           { componentIds = Map.insert (typeOf (Proxy @c)) cId (componentIds cs),