{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Foreign.FAI.Platform.Host
( Host(..)
, Pf
, nullHostContext
) where
import Control.Monad
import Foreign.C.Types
import Foreign.FAI.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import qualified Language.C.Inline as C
C.include "<string.h>"
C.include "<stdlib.h>"
data Host = Host
type instance Pf Host Float = Float
type instance Pf Host Double = Double
type instance Pf Host Int = Int
type instance Pf Host Word = Word
hostMemAllocate :: CInt -> IO (Ptr a)
hostMemAllocate n = castPtr <$> [C.exp| void* { malloc($(int n))}|]
hostMemRelease :: Ptr a -> IO ()
hostMemRelease n' = [C.exp| void { free($(void *n)) }|]
where n = castPtr n'
hostMemReleaseP :: IO (FinalizerPtr a)
hostMemReleaseP = castPtrToFunPtr <$> [C.exp| void* {*free}|]
hostMemCopy :: ForeignPtr a -> ForeignPtr a -> CInt -> IO ()
hostMemCopy fdst fsrc size =
withForeignPtr fdst $ \dst' ->
withForeignPtr fsrc $ \src' ->
let dst = castPtr dst'
src = castPtr src'
in void $ [C.exp| void* {memcpy($(void *dst), $(void *src), $(int size))} |]
instance FAI Host where
faiMemAllocate _ = hostMemAllocate . fromIntegral
faiMemRelease _ = hostMemRelease
faiMemReleaseP _ = Right <$> hostMemReleaseP
instance FAICopy Host Host where
faiMemCopy dst src = do
when (bufSize dst /= bufSize src) $ error "Different size."
hostMemCopy (bufPtr dst) (bufPtr src) $ fromIntegral $ bufSize dst
nullHostContext :: IO (Context Host)
nullHostContext = Context <$> newForeignPtr_ nullPtr