{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, Trustworthy #-}
module Control.CUtils.AssociativeFold (assocFold, assocFold_pattern) where
import Control.CUtils.CPUMultiThreading
import Data.List.Extra
import Data.Array.Unsafe
import Data.Array.IO
import Data.Array.Base
import Data.Array
import Control.Monad
import Control.Exception
import System.IO.Unsafe
chunkSize::Int
chunkSize = 10000
assocFold :: forall t. Pool -> (t->t->IO t) -> Int -> (Int -> t) -> IO t
assocFold _ _ n _ | n <= 0 = throwIO$ErrorCall"assocFold: list is empty"
assocFold _ _ n f2 | n == 1 = return(f2 0)
assocFold pool f n f2 = do
let mx = pred n `div` chunkSize
let ls2 =[0.. mx]
let l = succ mx
ar::IOArray Int t <- unsafeInterleaveIO(newArray_(0,mx))
let ls3 = fmap(f3 ar) ls2
simpleConc_ pool ls3()
ar2 :: Array Int t <- unsafeFreeze ar
assocFold pool f l(unsafeAt ar2)
where
f3 ar ii = do
let x:xs= [chunkSize*ii..pred(min n(chunkSize*ii+chunkSize))]
let x2 = f2 x
x3 <- foldM((.f2).f) x2 xs
writeArray ar ii x3
assocFold_pattern :: Pool -> (t->t->IO t) -> Int -> (Int -> IO t) -> IO t
assocFold_pattern pool f = (join.).assocFold pool( \x x2 -> do
x_res <- x
x2_res <- x2
return$!f x_res x2_res)