primitive-extras 0.1.4 → 0.1.5

raw patch · 3 files changed

+48/−1 lines, 3 files

Files

• library/PrimitiveExtras/IO.hs +40/−0
• library/PrimitiveExtras/Prelude.hs +7/−0
• primitive-extras.cabal +1/−1

@@ -67,3 +67,43 @@             loop (succ index)           else unsafeFreezePrimArray array       in loop 0++traversePrimArrayWithIndexInRange :: Prim a => PrimArray a -> Int -> Int -> (Int -> a -> IO ()) -> IO ()+traversePrimArrayWithIndexInRange primArray from to action =+  let iterate index = if index < to+        then do+          action index $! indexPrimArray primArray index+          iterate (succ index)+        else return ()+      in iterate from++traversePrimArrayWithIndexConcurrently ::+  Prim a =>+  PrimArray a ->+  Int ->+  (Int -> a -> IO ()) ->+  IO (IO ()) {-^ An action, which blocks until the concurrent computation is finished. -}+traversePrimArrayWithIndexConcurrently primArray threadsAmount action =+  let size = sizeofPrimArray primArray+      maxIndex = pred size+      step = div size threadsAmount+      in case step of+        0 -> itraversePrimArray_ action primArray $> return ()+        _ -> do+          semaphore <- newTVarIO threadsAmount+          let+            startThreads index = if index >= size+              then return ()+              else let+                !nextIndex = step + index+                in do+                  forkIO $ do+                    traversePrimArrayWithIndexInRange primArray index (min nextIndex size) action+                    atomically (modifyTVar' semaphore pred)+                  startThreads nextIndex+            in do+              startThreads 0+              return $ atomically $ do+                activeThreads <- readTVar semaphore+                guard (activeThreads == 0)+

@@ -2,6 +2,7 @@ (   module Exports,   Product2(..),+  modifyTVar',   forMToZero_,   forMFromZero_, )@@ -93,6 +94,12 @@   data Product2 a b = Product2 !a !b++{-# INLINE modifyTVar' #-}+modifyTVar' :: TVar a -> (a -> a) -> STM ()+modifyTVar' var f = do+    x <- readTVar var+    writeTVar var $! f x  {-# INLINE forMToZero_ #-} forMToZero_ :: Applicative m => Int -> (Int -> m a) -> m ()

@@ -1,7 +1,7 @@ name:   primitive-extras version:-  0.1.4+  0.1.5 category:   Primitive synopsis: