{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, FlexibleContexts, Trustworthy #-}
-- |  Compatibility shims for old version
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)

-- | Runs several computations concurrently, and returns their results as an array. Waits for all threads to end before returning.
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 #-}