{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Foreign.FAI
( Pf
, Buffer(..)
, Context(..)
, Accelerate(..)
, FAI(..)
, FAICopy(..)
, FinalizerContextPtr
, accelerate
, newBuffer
, newBufferIO
, dupBuffer
, dupBufferIO
, dupBufferD
, liftIO
) where
import Control.Monad
import Foreign.FAI.Internal
import Foreign.FAI.Types
import Foreign.Ptr
accelerate :: Context p -> Accelerate p a -> IO a
accelerate cc = (fst <$>) . flip doAccelerate cc
newBufferIO :: (FAI p, Storable b, (Pf p a) ~ b)
=> Int
-> Context p
-> IO (Buffer p a, Context p)
newBufferIO n cc = do
fin <- faiMemReleaseP cc
(ptr, size) <- alloc cc undefined
when (nullPtr == ptr) $ error "Can not allocate memory."
buf <- autoNewForeignPtr fin cc ptr size
return (buf, cc)
where alloc :: (FAI p, Storable b) => Context p -> b -> IO (Ptr b, Int)
alloc c' u =
let size = n * sizeOf u
in (\p -> (p, size)) <$> faiMemAllocate c' (n * sizeOf u)
newBuffer :: (FAI p, Storable b, (Pf p a) ~ b)
=> Int
-> Accelerate p (Buffer p a)
newBuffer = Accelerate .newBufferIO
dupBufferIO :: ( FAICopy p1 p2, FAI p1, FAI p2
, Storable b, Pf p2 a ~ b, Pf p1 a ~ b)
=> Bool
-> Buffer p1 a
-> Context p2
-> IO (Buffer p2 a, Context p2)
dupBufferIO is buf cc = dup cc is buf
dupBuffer :: ( FAICopy p1 p2, FAI p1, FAI p2
, Storable b, Pf p2 a ~ b, Pf p1 a ~ b)
=> Bool
-> Buffer p1 a
-> Accelerate p2 (Buffer p2 a)
dupBuffer is buf = Accelerate (dupBufferIO is buf)
dupBufferD :: ( FAICopy p2 p1, FAI p1, FAI p2
, Storable b, Pf p2 a ~ b, Pf p1 a ~ b)
=> Bool
-> Buffer p2 a
-> Accelerate p2 (Buffer p1 a)
dupBufferD is buf = Accelerate $ \cc -> replaceContext cc <$> dup undefined is buf