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
concurrently :: [System w ()] -> System w ()
concurrently ss = do w <- System ask
liftIO . A.mapConcurrently_ (runWith w) $ ss
pmap :: forall w x y. (Has w y, Has w x)
=> Int
-> (x -> y) -> System w ()
pmap grainSize f =
do sr :: Storage x <- getStore
sw :: Storage y <- 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