{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleContexts, Trustworthy #-}
module Control.CUtils.Conc (ExceptionList(..), ConcException(..), concF_, conc_, concF, conc, arr_assocFold) where
import Data.Array.IO
import Data.Array (Array)
import Data.Array.Base
import Data.Array.Unsafe
import Control.Arrow
import System.IO.Unsafe
import Control.CUtils.CPUMultiThreading
import Control.CUtils.AssociativeFold
import Control.CUtils.ThreadPool
concF_ :: (?pool :: Pool) => Int -> ConcurrentMethod() ()
concF_ = let pool = ?pool in throwToCallerAdapter_ pool(concurrent_ pool)
{-# INLINE partConc_ #-}
partConc_ :: (IArray ar e, Ix i, ?pool :: Pool) => ar i e-> Kleisli((->) Int) () (IO()) -> () -> IO()
partConc_ mnds = concF_(rangeSize(bounds mnds))
conc_ :: (IArray ar(IO()), Ix i, ?pool :: Pool) =>
ar i(IO()) -> IO()
conc_ mnds = partConc_ mnds(Kleisli(const$ unsafeAt mnds)) ()
unsafeFreeze' :: (Ix i) => IOArray i e -> IO(Array i e)
unsafeFreeze' = unsafeFreeze
{-# INLINE partConcF #-}
partConcF :: (Ix i) => (i,i) -> ConcurrentMethod() () -> ConcurrentMethod(Array i e ) e
partConcF bnds f mnds unit = do
res <- unsafeInterleaveIO(newArray_ bnds)
_ <- f(Kleisli$ const$ \i -> do
x <- runKleisli mnds unit i
unsafeWrite res i x)
unit
unsafeFreeze' res
concF :: (?pool :: Pool) => Int -> ConcurrentMethod(Array Int t) t
concF n = partConcF(0,n-1) (concF_ n)
conc :: (IArray ar(IO e), Ix i, ?pool :: Pool) =>
ar i(IO e) -> IO(Array i e)
conc mnds = partConcF(bounds mnds) (partConc_ mnds) (Kleisli$const$ unsafeAt mnds) ()
arr_assocFold :: (IArray ar t, Ix i, ?pool :: Pool) => Kleisli IO(u,u) u ->
(t -> u) ->
Kleisli IO(t,ar i t) u
arr_assocFold f g= Kleisli$ \ (_,ar) ->
let pool = ?pool in
assocFold pool(curry(runKleisli f)) (rangeSize(bounds ar)) (g.unsafeAt ar)
{-# SPECIALIZE conc_ :: (?pool :: Pool) => Array Int(IO()) -> IO() #-}
{-# SPECIALIZE conc :: (?pool :: Pool) => Array Int(IO e) -> IO(Array Int e) #-}
{-# SPECIALIZE arr_assocFold :: (?pool :: Pool) => Kleisli IO(u,u) u ->
(t -> u) ->
Kleisli IO(t,Array Int t) u #-}