feat(stores): Replace Map backend with O(1) sparse set

apecs/CHANGELOG.md

@@ -1,3 +1,29 @@
+## [0.10.0]
+### Breaking Changes
+- Dropped support for GHC <8.10.4
+- The lower bound for the `vector` library has been increased to `0.12.3.0`.
+
+### Changed
+- Replaced the core `Map` store's `IntMap`-based backend with a sparse-set
+  implementation. This improves the performance of `set`, `get`, `exists`, and
+  `destroy` operations from O(log n) to O(1).
+- The `Map` type is now an alias for `MapWith 16`. For component types with many
+  members, consider using `MapWith` to set a larger initial capacity and avoid
+  runtime allocations.
+- Removed the `Cachable` instance for `Map`. The new sparse-set backend is as
+  fast as the previous `Cache (Map ...)` strategy, making the `Cache` wrapper
+  redundant for this store.
+- The `Cachable` instance for `Map` is now considered obsolete. The new backend
+  is as fast as the previous `Cache (Map ...)` strategy.
+
+### Added
+- Added `MapWith`, `UMapWith`, and `SMapWith` stores, which allow specifying an
+  initial capacity to pre-allocate memory.
+- Added `UMap` for `Unbox`-able components and `SMap` for `Storable` components.
+  These stores offer the highest performance by reducing memory indirection and
+  improving data locality.
+
+
 ## [0.9.6]
 ### Changed
 - (#110) Relax upper bound on `mtl`: 2.3 -> 2.4

apecs/apecs.cabal

@@ -39,14 +39,15 @@ library
   other-modules:    Apecs.THTuples
   default-language: Haskell2010
   build-depends:
-      array             >=0.4    && <0.6
-    , base              >=4.9    && <5
-    , containers        >=0.5    && <0.8
-    , exceptions        >=0.10.0 && <0.11
-    , mtl               >=2.2    && <2.4
-    , template-haskell  >=2.12   && <3
-    , unliftio-core     >=0.2.0.1 && <0.3
-    , vector            >=0.11   && <0.14
+      array             >=0.4      && <0.6
+    , base              >=4.9      && <5
+    , containers        >=0.5      && <0.8
+    , exceptions        >=0.10.0   && <0.11
+    , heph-sparse-set   >=0.1      && <0.2
+    , mtl               >=2.2      && <2.4
+    , template-haskell  >=2.12     && <3
+    , unliftio-core     >=0.2.0.1  && <0.3
+    , vector            >=0.12.3.0 && <0.14
 
   ghc-options:      -Wall
 
@@ -56,11 +57,11 @@ test-suite apecs-test
   hs-source-dirs:   test
   build-depends:
       apecs
-    , base        >=4.9  && <5
-    , containers  >=0.5  && <0.8
-    , linear      >=1.20 && <2
-    , QuickCheck  >=2.10 && <3
-    , vector      >=0.10 && <0.14
+    , base        >=4.9      && <5
+    , containers  >=0.5      && <0.8
+    , linear      >=1.20     && <2
+    , QuickCheck  >=2.10     && <3
+    , vector      >=0.12.3.0 && <0.14
 
   default-language: Haskell2010
   ghc-options:      -Wall
@@ -71,13 +72,13 @@ benchmark apecs-bench
   main-is:          Main.hs
   build-depends:
       apecs
-    , base       >=4.9  && <5
-    , criterion  >=1.3  && <2
-    , linear     >=1.20 && <2
+    , base       >=4.9      && <5
+    , criterion  >=1.3      && <2
+    , linear     >=1.20     && <2
+    , vector     >=0.12.3.0 && <0.14
 
   default-language: Haskell2010
   ghc-options:
     -Wall -O2 -optlo-O3 -threaded -funfolding-use-threshold1000
-    -funfolding-keeness-factor1000
 
 -- -fllvm

apecs/bench/Main.hs

@@ -1,43 +1,149 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE Strict                #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NumericUnderscores         #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE Strict                     #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+
+module Main (main) where
 
 import           Control.Monad
 import           Criterion
-import qualified Criterion.Main  as C
-import           Criterion.Types
+import qualified Criterion.Main              as C
+import           Data.Typeable               (Typeable, showsTypeRep, typeRep)
+import qualified Data.Vector.Generic         as VG
+import qualified Data.Vector.Generic.Mutable as VGM
+import qualified Data.Vector.Unboxed         as VU
+import           Foreign.Storable            (Storable)
 import           Linear
 
 import           Apecs
 
--- pos_vel
-newtype ECSPos = ECSPos (V2 Float) deriving (Eq, Show)
-instance Component ECSPos where type Storage ECSPos = Cache 10000 (Map ECSPos)
+newtype ECSPos = ECSPos (V2 Float) deriving (Typeable, Eq, Show)
+instance Component ECSPos where type Storage ECSPos = Map ECSPos
 
-newtype ECSVel = ECSVel (V2 Float) deriving (Eq, Show)
-instance Component ECSVel where type Storage ECSVel = Cache 1000 (Map ECSVel)
+newtype ECSVel = ECSVel (V2 Float) deriving (Typeable, Eq, Show)
+instance Component ECSVel where type Storage ECSVel = Map ECSVel
 
 makeWorld "PosVel" [''ECSPos, ''ECSVel]
 
-posVelInit :: System PosVel ()
-posVelInit = do
-  replicateM_ 1000 $ newEntity (ECSPos 0, ECSVel 1)
-  replicateM_ 9000 $ newEntity (ECSPos 0)
+deriving instance Typeable PosVel
+
+posVelInit :: Int -> System PosVel ()
+posVelInit n = do
+  replicateM_ n $ newEntity (ECSPos 0, ECSVel 1)
+  replicateM_ (9 * n) $ newEntity (ECSPos 0)
 
 posVelStep :: System PosVel ()
 posVelStep = cmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v)
 
+newtype CachedECSPos = CachedECSPos (V2 Float) deriving (Typeable, Eq, Show)
+instance Component CachedECSPos where type Storage CachedECSPos = Cache 10_000 (Map CachedECSPos)
+
+newtype CachedECSVel = CachedECSVel (V2 Float) deriving (Typeable, Eq, Show)
+instance Component CachedECSVel where type Storage CachedECSVel = Cache 10_000 (Map CachedECSVel)
+
+makeWorld "CachedPosVel" [''CachedECSPos, ''CachedECSVel]
+
+deriving instance Typeable CachedPosVel
+
+cachedPosVelInit :: Int -> System CachedPosVel ()
+cachedPosVelInit n = do
+  replicateM_ n $ newEntity (CachedECSPos 0, CachedECSVel 1)
+  replicateM_ (9 * n) $ newEntity (CachedECSPos 0)
+
+cachedPosVelStep :: System CachedPosVel ()
+cachedPosVelStep = cmap $ \(CachedECSVel v, CachedECSPos p) -> CachedECSPos (p+v)
+
+newtype PreallocatedECSPos = PreallocatedECSPos (V2 Float) deriving (Typeable, Eq, Show)
+instance Component PreallocatedECSPos where type Storage PreallocatedECSPos = MapWith 5_000 PreallocatedECSPos
+
+newtype PreallocatedECSVel = PreallocatedECSVel (V2 Float) deriving (Typeable, Eq, Show)
+instance Component PreallocatedECSVel where type Storage PreallocatedECSVel = MapWith 5_000 PreallocatedECSVel
+
+makeWorld "PreallocatedPosVel" [''PreallocatedECSPos, ''PreallocatedECSVel]
+
+deriving instance Typeable PreallocatedPosVel
+
+preallocatedPosVelInit :: Int -> System PreallocatedPosVel ()
+preallocatedPosVelInit n = do
+  replicateM_ n $ newEntity (PreallocatedECSPos 0, PreallocatedECSVel 1)
+  replicateM_ (9 * n) $ newEntity (PreallocatedECSPos 0)
+
+preallocatedPosVelStep :: System PreallocatedPosVel ()
+preallocatedPosVelStep = cmap $ \(PreallocatedECSVel v, PreallocatedECSPos p) -> PreallocatedECSPos (p+v)
+
+newtype UECSPos = UECSPos (V2 Float) deriving (Typeable, Eq, Show)
+instance Component UECSPos where type Storage UECSPos = UMap UECSPos
+
+newtype instance VU.MVector s UECSPos = MV_UECSPos (VU.MVector s (V2 Float))
+newtype instance VU.Vector    UECSPos = V_UECSPos  (VU.Vector    (V2 Float))
+deriving instance VGM.MVector VU.MVector UECSPos
+deriving instance VG.Vector   VU.Vector  UECSPos
+instance VU.Unbox UECSPos
+
+newtype UECSVel = UECSVel (V2 Float) deriving (Typeable, Eq, Show)
+instance Component UECSVel where type Storage UECSVel = UMap UECSVel
+
+newtype instance VU.MVector s UECSVel = MV_UECSVel (VU.MVector s (V2 Float))
+newtype instance VU.Vector    UECSVel = V_UECSVel  (VU.Vector    (V2 Float))
+deriving instance VGM.MVector VU.MVector UECSVel
+deriving instance VG.Vector   VU.Vector  UECSVel
+instance VU.Unbox UECSVel
+
+makeWorld "UPosVel" [''UECSPos, ''UECSVel]
+
+deriving instance Typeable UPosVel
+
+uPosVelInit :: Int -> System UPosVel ()
+uPosVelInit n = do
+  replicateM_ n $ newEntity (UECSPos 0, UECSVel 1)
+  replicateM_ (9 * n) $ newEntity (UECSPos 0)
+
+uPosVelStep :: System UPosVel ()
+uPosVelStep = cmap $ \(UECSVel v, UECSPos p) -> UECSPos (p+v)
+
+newtype SECSPos = SECSPos (V2 Float) deriving (Typeable, Storable, Eq, Show)
+instance Component SECSPos where type Storage SECSPos = SMap SECSPos
+
+newtype SECSVel = SECSVel (V2 Float) deriving (Typeable, Storable, Eq, Show)
+instance Component SECSVel where type Storage SECSVel = SMap SECSVel
+
+makeWorld "SPosVel" [''SECSPos, ''SECSVel]
+
+deriving instance Typeable SPosVel
+
+sPosVelInit :: Int -> System SPosVel ()
+sPosVelInit n = do
+  replicateM_ n $ newEntity (SECSPos 0, SECSVel 1)
+  replicateM_ (9 * n) $ newEntity (SECSPos 0)
+
+sPosVelStep :: System SPosVel ()
+sPosVelStep = cmap $ \(SECSVel v, SECSPos p) -> SECSPos (p+v)
+
+benchWith :: forall w. (Typeable w) => IO w -> (Int -> System w ()) -> System w () -> Benchmark
+benchWith initWorld initEntities stepEntities =
+  let gName = showsTypeRep (typeRep (Proxy :: Proxy w)) ""
+      n = 10_000
+   in bgroup gName
+        [ bench "init world" $ whnfIO (initWorld >>= runSystem (pure ()))
+        , bench "init" $ whnfIO (initWorld >>= runSystem (initEntities n))
+        , bench "step" $ whnfIO (initWorld >>= runSystem (initEntities n >> replicateM_ 1_000 stepEntities))
+        ]
+
 main :: IO ()
-main = C.defaultMainWith (C.defaultConfig {timeLimit = 10})
-  [ bgroup "pos_vel"
-    [ bench "init" $ whnfIO (initPosVel >>= runSystem posVelInit)
-    , bench "step" $ whnfIO (initPosVel >>= runSystem (posVelInit >> posVelStep))
-    ]
+main = C.defaultMain
+  [ benchWith initPosVel posVelInit posVelStep
+  , benchWith initCachedPosVel cachedPosVelInit cachedPosVelStep
+  , benchWith initPreallocatedPosVel preallocatedPosVelInit preallocatedPosVelStep
+  , benchWith initUPosVel uPosVelInit uPosVelStep
+  , benchWith initSPosVel sPosVelInit sPosVelStep
   ]
 

apecs/src/Apecs.hs

@@ -8,7 +8,7 @@ module Apecs (
     Get, Set, Destroy, Members,
 
   -- * Stores
-    Map, Unique, Global, Cache,
+    Map, MapWith, UMap, UMapWith, SMap, SMapWith, Unique, Global, Cache,
     explInit,
 
   -- * Systems
@@ -30,7 +30,7 @@ module Apecs (
 ) where
 
 import           Control.Monad.IO.Class (liftIO)
-import           Control.Monad.Reader (ask, asks, lift)
+import           Control.Monad.Reader   (ask, asks, lift)
 import           Data.Proxy
 
 import           Apecs.Components
@@ -81,3 +81,26 @@ import           Apecs.Util
 -- get the best possible performance, always consider how maps and folds are
 -- executed under the hood, and how you can order your components to optimize
 -- that process.
+--
+-- === Storage Strategies
+--
+-- Apecs offers several storage options for components, allowing you to tune for
+-- performance.
+--
+-- * 'Map' (Default): The default store is now a high-performance sparse set
+--   providing O(1) (amortized constant time) for nearly all operations. It is
+--   suitable for the vast majority of component types.
+--
+-- * 'UMap' and 'SMap': For performance-critical components, you can achieve
+--   even greater speed by using these specialized stores. If your component can
+--   be given an instance of 'Data.Vector.Unboxed.Unbox', use 'UMap'. If it has
+--   a 'Foreign.Storable.Storable' instance, use 'SMap'. These stores lay out
+--   data in contiguous memory blocks, which significantly improves cache
+--   performance.
+--
+-- * 'Cache': Previously, the `Cache` was the primary tool for achieving high
+--   performance. With the new sparse-set backend for `Map`, `UMap`, and `SMap`,
+--   the `Cache` is no longer necessary for these stores and is considered
+--   obsolete for this purpose. It remains available for use with custom stores
+--   that may have different performance characteristics.
+