apecs 0.2.4.2 → 0.2.4.3
raw patch · 5 files changed
+58/−30 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +10/−5
- apecs.cabal +1/−1
- bench/Main.hs +29/−11
- src/Apecs/Stores.hs +10/−9
- src/Apecs/THTuples.hs +8/−4
README.md view
@@ -9,12 +9,17 @@ ### Performance Performance is good.-Running the [ecs-bench](https://github.com/lschmierer/ecs_bench) pos_vel benchmark shows that we can keep up with specs, which was written in Rust:+Running [ecs-bench](https://github.com/lschmierer/ecs_bench) shows that apecs is competitive with the fastest Rust ECS frameworks. -| | specs | apecs |-| ------ | ------ | ------ |-| build | 699 us | 285 us | -| update | 34 us | 46 us |+| | pos_vel build | pos_vel step | parallel build | parallel step |+| ------------- | ------------- | ------------ | -------------- | ------------- |+| apecs | 239 | 34 | 777 | 371 |+| calx | 261 | 21 | 442 | 72 |+| constellation | 306 | 10 | 567 | 256 |+| froggy | 594 | 13 | 1565 | 97 |+| specs | 753 | 38 | 1016 | 205 |++ There is a performance guide [here](https://github.com/jonascarpay/apecs/blob/master/tutorials/GoingFast.md).
apecs.cabal view
@@ -1,5 +1,5 @@ name: apecs-version: 0.2.4.2+version: 0.2.4.3 homepage: https://github.com/jonascarpay/apecs#readme license: BSD3 license-file: LICENSE
bench/Main.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} import Criterion+import Criterion.Types import qualified Criterion.Main as C import Control.Monad import Linear@@ -10,28 +11,45 @@ import Apecs import Apecs.TH import Apecs.Stores-import Apecs.Util import Apecs.Concurrent-import qualified Apecs.Slice as S --- ecs_bench+-- pos_vel newtype ECSPos = ECSPos (V2 Float) deriving (Eq, Show) instance Component ECSPos where type Storage ECSPos = Cache 10000 (Map ECSPos) newtype ECSVel = ECSVel (V2 Float) deriving (Eq, Show) instance Component ECSVel where type Storage ECSVel = Cache 1000 (Map ECSVel) -makeWorld "ECSB" [''ECSPos, ''ECSVel]+makeWorld "PosVel" [''ECSPos, ''ECSVel] -ecsbInit = do replicateM_ 1000 (newEntity (ECSPos 0, ECSVel 1))- replicateM_ 9000 (newEntity (ECSPos 0))+posVelInit = do replicateM_ 1000 (newEntity (ECSPos 0, ECSVel 1))+ replicateM_ 9000 (newEntity (ECSPos 0)) -stepVel (ECSVel v, ECSPos p) = ECSPos (p+v)+posVelStep = rmap $ \(ECSVel v, ECSPos p) -> ECSPos (p+v) +-- parallel+newtype W1 = W1 Float+newtype W2 = W2 Float+newtype R = R Float+instance Component W1 where type Storage W1 = Cache 10000 (Map W1)+instance Component W2 where type Storage W2 = Cache 10000 (Map W2)+instance Component R where type Storage R = Cache 10000 (Map R)++makeWorld "Parallel" [''W1, ''W2, ''R]++parallelInit, parallelStep :: System Parallel ()+parallelInit = replicateM_ 10000 $ newEntity (W1 0, W2 0, R 0)+parallelStep = do rmap $ \(R x) -> W1 x+ rmap $ \(R x) -> W2 x+ main :: IO ()-main = C.defaultMain- [ bgroup "ecs_bench"- [ bench "init" $ whnfIO (initECSB >>= runSystem ecsbInit)- , bench "step" $ whnfIO (initECSB >>= runSystem (ecsbInit >> rmap stepVel))+main = C.defaultMainWith (C.defaultConfig {timeLimit = 10})+ [ bgroup "pos_vel"+ [ bench "init" $ whnfIO (initPosVel >>= runSystem posVelInit)+ , bench "step" $ whnfIO (initPosVel >>= runSystem (posVelInit >> posVelStep))+ ]+ , bgroup "parallel"+ [ bench "init" $ whnfIO (initParallel >>= runSystem parallelInit)+ , bench "step" $ whnfIO (initParallel >>= runSystem (parallelInit >> parallelStep)) ] ]
src/Apecs/Stores.hs view
@@ -117,7 +117,9 @@ initStore = Unique <$> newIORef (-1) <*> newIORef undefined explDestroy (Unique eref _) ety = do e <- readIORef eref; when (e==ety) (writeIORef eref (-1)) - explMembers (Unique eref _) = readIORef eref >>= \e -> return $ if e == -1 then mempty else (U.singleton e)+ explMembers (Unique eref _) = f <$> readIORef eref+ where f (-1) = mempty+ f x = U.singleton x explReset (Unique eref _) = writeIORef eref (-1) explExists (Unique eref _) ety = (==ety) <$> readIORef eref explImapM_ (Unique eref _) ma = do e <- liftIO (readIORef eref); when (e /= -1) (void$ ma e)@@ -168,7 +170,6 @@ {-# INLINE explCmap #-} {-# INLINE explModify #-} - -- | Constant value. Not very practical, but fun to write. -- Contains `mempty` newtype Const c = Const c@@ -227,14 +228,14 @@ {-# INLINE explDestroy #-} explDestroy (Cache n tags _ s) ety = do- tag <- UM.unsafeRead tags (ety `mod` n)+ tag <- UM.unsafeRead tags (ety `rem` n) if tag == ety- then UM.unsafeWrite tags (ety `mod` n) (-1)+ then UM.unsafeWrite tags (ety `rem` n) (-1) else explDestroy s ety {-# INLINE explExists #-} explExists (Cache n tags _ s) ety = do- tag <- UM.unsafeRead tags (ety `mod` n)+ tag <- UM.unsafeRead tags (ety `rem` n) if tag == ety then return True else explExists s ety {-# INLINE explMembers #-}@@ -263,7 +264,7 @@ {-# INLINE explGetUnsafe #-} explGetUnsafe (Cache n tags cache s) ety = do- let index = ety `mod` n+ let index = ety `rem` n tag <- UM.unsafeRead tags index if tag == ety then VM.unsafeRead cache index@@ -271,7 +272,7 @@ {-# INLINE explGet #-} explGet (Cache n tags cache s) ety = do- let index = ety `mod` n+ let index = ety `rem` n tag <- UM.unsafeRead tags index if tag == ety then Just <$> VM.unsafeRead cache index@@ -279,7 +280,7 @@ {-# INLINE explSet #-} explSet (Cache n tags cache s) ety x = do- let index = ety `mod` n+ let index = ety `rem` n tag <- UM.unsafeRead tags index when (tag /= (-1) && tag /= ety) $ do cached <- VM.unsafeRead cache index@@ -299,7 +300,7 @@ {-# INLINE explModify #-} explModify (Cache n tags cache s) ety f = do- let index = ety `mod` n+ let index = ety `rem` n tag <- UM.read tags index if tag == ety then VM.modify cache f ety
src/Apecs/THTuples.hs view
@@ -43,10 +43,14 @@ tupleInstances :: Int -> Q [Dec] tupleInstances n = do let vars = [ VarT . mkName $ "t_" ++ show i | i <- [0..n-1]]+ tupleUpT :: [Type] -> Type tupleUpT = foldl AppT (TupleT n)+ varTuple :: Type varTuple = tupleUpT vars- tuplN = tupleDataName n- tuplE = ConE tuplN+ tupleName :: Name+ tupleName = tupleDataName n+ tuplE :: Exp+ tuplE = ConE tupleName compN = mkName "Component" compT var = ConT compN `AppT` var@@ -82,13 +86,13 @@ safeT var = ConT safeN `AppT` var sNs = [ mkName $ "s_" ++ show i | i <- [0..n-1]]- sPat = ConP tuplN (VarP <$> sNs)+ sPat = ConP tupleName (VarP <$> sNs) sEs = VarE <$> sNs etyN = mkName "ety" etyE = VarE etyN etyPat = VarP etyN wNs = [ mkName $ "w_" ++ show i | i <- [0..n-1]]- wPat = ConP tuplN (VarP <$> wNs)+ wPat = ConP tupleName (VarP <$> wNs) wEs = VarE <$> wNs explGetN = mkName "explGet"