apecs 0.2.4.0 → 0.2.4.1

raw patch · 11 files changed

+66/−47 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +1/−0
• apecs.cabal +1/−2
• bench/Main.hs +0/−7
• src/Apecs/Concurrent.hs +1/−3
• src/Apecs/Slice.hs +2/−0
• src/Apecs/Stores.hs +13/−11
• src/Apecs/System.hs +4/−3
• src/Apecs/TH.hs +6/−5
• src/Apecs/Types.hs +2/−2
• src/Apecs/Util.hs +24/−14
• test/Main.hs +12/−0

@@ -23,6 +23,7 @@ import Apecs import Apecs.TH (makeWorld) import Apecs.Stores (Cache)+import Apecs.Concurrent (prmap) import Linear  newtype Position = Position (V2 Double) deriving Show

@@ -1,5 +1,5 @@ name:                apecs-version:             0.2.4.0+version:             0.2.4.1 homepage:            https://github.com/jonascarpay/apecs#readme license:             BSD3 license-file:        LICENSE@@ -81,6 +81,5 @@     -fllvm     -optlo-O3     -threaded-    -with-rtsopts=-N     -funfolding-use-threshold1000     -funfolding-keeness-factor1000

@@ -33,12 +33,5 @@   [ bgroup "ecs_bench"     [ bench "init" $ whnfIO (initECSB >>= runSystem ecsbInit)     , bench "step" $ whnfIO (initECSB >>= runSystem (ecsbInit >> rmap stepVel))-    , bgroup "concurrent" $-      [ bench "grain 10"  $ whnfIO (initECSB >>= runSystem (ecsbInit >> prmap 10  stepVel))-      , bench "grain 100" $ whnfIO (initECSB >>= runSystem (ecsbInit >> prmap 100 stepVel))-      , bench "grain 125" $ whnfIO (initECSB >>= runSystem (ecsbInit >> prmap 125 stepVel))-      , bench "grain 500" $ whnfIO (initECSB >>= runSystem (ecsbInit >> prmap 500 stepVel))-      , bench "grain 1000" $ whnfIO (initECSB >>= runSystem (ecsbInit >> prmap 1000 stepVel))-      ]     ]   ]

@@ -6,7 +6,6 @@   pcmap, prmap, pwmap, pcmap', prmap', pwmap', ) where - import qualified Control.Concurrent.Async as A import Control.Monad.Reader import qualified Data.Vector.Unboxed as U@@ -15,7 +14,7 @@ import Apecs.System  -- | Executes a list of systems concurrently, and blocks until all have finished.---   Provides zero protection against race conditions, so use with caution.+--   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@@ -89,4 +88,3 @@      sw :: Storage w <- getStore      liftIO$ do sl <- explMembers sr                 parallelize grainSize (\e -> explGet sr e >>= explSetMaybe sw e . getSafe . f . Safe) sl-

@@ -93,3 +93,5 @@ mapMC_ :: forall w c a. Has w c => ((Entity c, Safe c) -> System w a) -> Slice c -> System w () mapMC_ sys vec = forMC_ vec sys +toList :: Slice a -> [Entity a]+toList (Slice sl) = Entity <$> U.toList sl

@@ -75,6 +75,7 @@ newtype Set c = Set (IORef S.IntSet) instance Flag c => Store (Set c) where   type Stores (Set c) = c+  type SafeRW (Set c) = Bool   initStore = Set <$> newIORef mempty   explDestroy (Set ref) ety = modifyIORef' ref (S.delete ety)   explMembers (Set ref) = U.fromList . S.toList <$> readIORef ref@@ -88,7 +89,7 @@   {-# INLINE explReset #-}   {-# INLINE explImapM_ #-}   {-# INLINE explImapM #-}-  type SafeRW (Set c) = Bool+   explGetUnsafe _ _ = return flag   explGet (Set ref) ety = S.member ety <$> readIORef ref   explSet (Set ref) ety _ = modifyIORef' ref $ S.insert ety@@ -96,10 +97,10 @@   explSetMaybe s ety True  = explSet s ety flag   explCmap _ _ = return ()   explModify _ _ _ = return ()-  explCmapM   = error "Iterating over set"-  explCmapM_  = error "Iterating over set"-  explCimapM  = error "Iterating over set"-  explCimapM_ = error "Iterating over set"+  explCmapM   s m = explImapM  s (m . const flag)+  explCmapM_  s m = explImapM_ s (m . const flag)+  explCimapM  s m = explImapM  s (m . flip  (,) flag)+  explCimapM_ s m = explImapM_ s (m . flip  (,) flag)   {-# INLINE explGetUnsafe #-}   {-# INLINE explGet #-}   {-# INLINE explSet #-}@@ -107,14 +108,16 @@   {-# INLINE explCmap #-}   {-# INLINE explModify #-} --- | A Unique contains exactly one component belonging to some entity.+-- | A Unique contains at most one component. --   Writing to it overwrites both the previous component and its owner. data Unique c = Unique (IORef Int) (IORef c) instance Store (Unique c) where   type Stores (Unique c) = c+  type SafeRW (Unique c) = Maybe c   initStore = Unique <$> newIORef (-1) <*> newIORef undefined   explDestroy (Unique eref _) ety = do e <- readIORef eref; when (e==ety) (writeIORef eref (-1))-  explMembers (Unique eref _) = U.singleton <$> readIORef eref++  explMembers (Unique eref _) = readIORef eref >>= \e -> return $ if e == -1 then mempty else (U.singleton e)   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)@@ -128,18 +131,17 @@   {-# INLINE explImapM_ #-}   {-# INLINE explImapM #-} -  type SafeRW (Unique c) = Maybe c   explGetUnsafe (Unique _ cref) _ = readIORef cref   explGet       (Unique eref cref) ety = do     e <- readIORef eref-    if e == ety then Just <$> readIORef cref else return Nothing+    if e == ety && e /= -1 then Just <$> readIORef cref else return Nothing    explSet       (Unique eref cref) ety x = writeIORef eref ety >> writeIORef cref x   explSetMaybe = defaultSetMaybe-  explCmap      (Unique _    cref) f = modifyIORef' cref f+  explCmap      (Unique eref cref) f = readIORef eref >>= \e -> unless (e == -1) $ modifyIORef' cref f   explModify    (Unique eref cref) ety f = do     e <- readIORef eref-    when (e==ety) (modifyIORef' cref f)+    when (e==ety && e /= -1) (modifyIORef' cref f)    explCmapM (Unique eref cref) ma = do     e <- liftIO$ readIORef eref

@@ -95,25 +95,26 @@ cmap f = do s :: Storage c <- getStore             liftIO$ explCmap s f --- | mapM_ version of cmap+-- | 'mapM_' version of 'cmap' {-# INLINE cmapM_ #-} cmapM_ :: forall w c. Has w c => (c -> System w ()) -> System w () cmapM_ sys = do s :: Storage c <- getStore                 explCmapM_ s sys --- | indexed cmapM_, also gives the current entity.+-- | indexed 'cmapM_', also gives the current entity. {-# INLINE cimapM_ #-} cimapM_ :: forall w c. Has w c => ((Entity c, c) -> System w ()) -> System w () cimapM_ sys = do s :: Storage c <- getStore                  explCimapM_ s (\(e,c) -> sys (Entity e,c))  -- | mapM version of cmap. Can be used to get a list of entities+--   As the type signature implies, and unlike 'cmap', the return value is not written to the component store. {-# INLINE cmapM #-} cmapM :: forall w c a. Has w c => (c -> System w a) -> System w [a] cmapM sys = do s :: Storage c <- getStore                explCmapM s sys --- | indexed cmapM, also gives the current entity.+-- | indexed 'cmapM', also gives the current entity. {-# INLINE cimapM #-} cimapM :: forall w c a. Has w c => ((Entity c, c) -> System w a) -> System w [a] cimapM sys = do s :: Storage c <- getStore

@@ -31,13 +31,15 @@             [] ]           ] -      initDecl = FunD (mkName $ "init" ++ worldName) [Clause []+      initWorldName = mkName $ "init" ++ worldName+      initSig = SigD initWorldName (AppT (ConT (mkName "IO")) (ConT wld))+      initDecl = FunD initWorldName [Clause []         (NormalB$ iterate (\wE -> AppE (AppE (VarE $ mkName "<*>") wE) (VarE $ mkName "initStore")) (AppE (VarE $ mkName "return") (ConE wld)) !! length records)         [] ]        hasDecl = makeInstance <$> cTypesNames -  return $ wldDecl : initDecl : hasDecl+  return $ wldDecl : initSig : initDecl : hasDecl  {-| @@ -45,15 +47,14 @@  turns into -> data WorldName = WorldName ...+> data WorldName = WorldName Component1 Component2 ... EntityCounter > instance WorldName `Has` Component1 where ... > instance WorldName `Has` Component2 where ... > ...-> > instance WorldName `Has` EntityCounter where ... > > initWorldName :: IO WorldName-> initWorldName = WorldName <$> initStore <*> ...+> initWorldName = WorldName <$> initStore <*> initStore <*> ... <*> initCounter  |-} makeWorld :: String -> [Name] -> Q [Dec]

@@ -14,7 +14,7 @@ import qualified Apecs.THTuples as T  -- | An Entity is really just an Int. The type variable is used to keep track of reads and writes, but can be freely cast.-newtype Entity c = Entity Int deriving (Eq, Ord, Show)+newtype Entity c = Entity {unEntity :: Int} deriving (Eq, Ord, Show)  -- | A slice is a list of entities, represented by a Data.Unbox.Vector of Ints. newtype Slice c = Slice {unSlice :: U.Vector Int} deriving (Show, Monoid)@@ -53,7 +53,7 @@   -- | Returns an unboxed vector of member indices   explMembers :: s -> IO (U.Vector Int) -  -- | Unsafe index to the store. Undefined if the component does not exist+  -- | Unsafe index to the store. What happens if the component does not exist is left undefined.   explGetUnsafe :: s -> Int -> IO (Stores s)   -- | Either writes or deletes a component   explSetMaybe  :: s -> Int -> SafeRW s -> IO ()

@@ -4,18 +4,21 @@  module Apecs.Util (   -- * Utility-  initStore, runGC, unEntity,+  initStore, runGC,    -- * EntityCounter   EntityCounter, nextEntity, newEntity,    -- * Spatial hashing   -- $hash-  quantize, flatten, inbounds, region, unsafeFlatten,+  quantize, flatten, inbounds, region, flatten',    -- * Timing   timeSystem, timeSystem_, +  -- * List functions+  listAllE, listAllC, listAllEC,+   ) where  import System.Mem (performMajorGC)@@ -28,9 +31,6 @@ import Apecs.Stores import Apecs.System -unEntity :: Entity a -> Int-unEntity (Entity e) = e- -- | Secretly just an int in a newtype newtype EntityCounter = EntityCounter {getCounter :: Sum Int} deriving (Monoid, Num, Eq, Show) @@ -56,6 +56,18 @@ runGC :: System w () runGC = liftIO performMajorGC +-- | imapM return+listAllE :: Has w c => System w [Entity c]+listAllE = imapM return++-- | cmapM return+listAllC :: Has w c => System w [c]+listAllC = cmapM return++-- | cimapM return+listAllEC :: Has w c => System w [(Entity c, c)]+listAllEC = cimapM return+ -- $hash -- The following functions are for spatial hashing. -- The idea is that your spatial hash is defined by two vectors;@@ -86,7 +98,7 @@ flatten :: (Applicative v, Integral a, Foldable v)         => v a -- Field size vector         -> v a -> Maybe a-flatten size vec = if inbounds size vec then Just (unsafeFlatten size vec) else Nothing+flatten size vec = if inbounds size vec then Just (flatten' size vec) else Nothing  -- | Tests whether a vector is in the region given by 0 and the size vector (inclusive) {-# INLINE inbounds #-}@@ -104,15 +116,14 @@        -> [v a] region a b = sequence $ liftA2 enumFromTo a b --- | Unsafe version of flatten. Yields garbage for out-of-bounds queries.-{-# INLINE unsafeFlatten #-}-unsafeFlatten :: (Applicative v, Integral a, Foldable v)-              => v a -- Field size vector-              -> v a -> a-unsafeFlatten size vec = foldr (\(n,x) acc -> n*acc + x) 0 (liftA2 (,) size vec)+-- | flatten, but yields garbage for out-of-bounds vectors.+{-# INLINE flatten' #-}+flatten' :: (Applicative v, Integral a, Foldable v)+            => v a -- Field size vector+            -> v a -> a+flatten' size vec = foldr (\(n,x) acc -> n*acc + x) 0 (liftA2 (,) size vec)  -- | Runs a system and gives its execution time in seconds-{-# INLINE timeSystem #-} timeSystem :: System w a -> System w (Double, a) timeSystem sys = do   s <- liftIO getCPUTime@@ -120,7 +131,6 @@   t <- liftIO getCPUTime   return (fromIntegral (t-s)/1e12, a) -{-# INLINE timeSystem_ #-} -- | Runs a system, discards its output, and gives its execution time in seconds timeSystem_ :: System w a -> System w Double timeSystem_ = fmap fst . timeSystem

@@ -20,6 +20,8 @@ import Apecs.TH import Apecs.Stores import Apecs.Logs+import Apecs.Util+import qualified Apecs.Slice as Sl  type Vec = (Double, Double) @@ -69,6 +71,14 @@   Safe r :: Safe CacheInt <- get re   return (r == Just rw) +listMembersIsSlice :: Scramble CacheInt -> Property+listMembersIsSlice scr = assertSys initSetGetCI $ do+  scramble scr+  es :: [Entity CacheInt] <- listAllE+  sl :: Slice CacheInt <- owners+  return (S.fromList (unEntity <$> es) == S.fromList (unEntity <$> Sl.toList sl))++ -- Tests basic tuple functionality newtype T1 = T1 Int deriving (Eq, Show, Arbitrary) newtype T2 = T2 Int deriving (Eq, Show, Arbitrary)@@ -109,8 +119,10 @@   return (sl == U.fromList (S.toList set))  + main = do   quickCheck setGetProp   quickCheck setGetTuple   quickCheck setGetPropC   quickCheck loggerProp+  quickCheck listMembersIsSlice