{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
module ForeignC (
module ForeignC
, module Data.Int, module Data.Word
, module Foreign.C
, module Foreign.Ptr, module Foreign.StablePtr, module Foreign.ForeignPtr
, module Foreign.Marshal.Alloc, module Foreign.Marshal.Utils
) where
import Data.Int
import Data.Word
import qualified Foreign
import Foreign.C
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
( allocaBytes, allocaBytesAligned, mallocBytes, reallocBytes, free
, finalizerFree
)
import Foreign.Marshal.Utils hiding (with, new)
import GHC.Base
class CStorable a where
sizeOf :: a -> Int
alignment :: a -> Int
peekElemOff :: Ptr a -> Int -> IO a
pokeElemOff :: Ptr a -> Int -> a -> IO ()
peekByteOff :: Ptr b -> Int -> IO a
pokeByteOff :: Ptr b -> Int -> a -> IO ()
peek :: Ptr a -> IO a
poke :: Ptr a -> a -> IO ()
peekElemOff = peekElemOff_ undefined
where
peekElemOff_ :: a -> Ptr a -> Int -> IO a
peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
peekByteOff ptr off = peek (ptr `plusPtr` off)
pokeByteOff ptr off = poke (ptr `plusPtr` off)
peek ptr = peekElemOff ptr 0
poke ptr = pokeElemOff ptr 0
instance CStorable CDouble where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable CFloat where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable CInt where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable CChar where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable CUChar where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Word8 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Word16 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Word32 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Word64 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Int8 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Int16 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Int32 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable Int64 where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable (Ptr a) where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable (FunPtr a) where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
instance CStorable (StablePtr a) where
sizeOf = Foreign.sizeOf
alignment = Foreign.alignment
peek = Foreign.peek
poke = Foreign.poke
alloca :: forall a b. (CStorable a) => (Ptr a -> IO b) -> IO b
alloca = allocaBytesAligned (sizeOf dummy) (alignment dummy)
where
dummy :: a
dummy = undefined
malloc :: (CStorable a) => IO (Ptr a)
malloc = doMalloc undefined
where
doMalloc :: (CStorable b) => b -> IO (Ptr b)
doMalloc dummy = mallocBytes (sizeOf dummy)
mallocArray :: (CStorable a) => Int -> IO (Ptr a)
mallocArray = doMalloc undefined
where
doMalloc :: (CStorable a') => a' -> Int -> IO (Ptr a')
doMalloc dummy size = mallocBytes (size * sizeOf dummy)
allocaArray :: (CStorable a) => Int -> (Ptr a -> IO b) -> IO b
allocaArray = doAlloca undefined
where
doAlloca :: (CStorable a') => a' -> Int -> (Ptr a' -> IO b') -> IO b'
doAlloca dummy size =
allocaBytesAligned (size * sizeOf dummy) (alignment dummy)
pokeArray :: (CStorable a) => Ptr a -> [a] -> IO ()
pokeArray ptr vals0 = go vals0 0#
where
go [] _ = return ()
go (val:vals) n# = do
pokeElemOff ptr (I# n#) val
go vals (n# +# 1#)
peekArray :: (CStorable a) => Int -> Ptr a -> IO [a]
peekArray size ptr
| size <= 0 = return []
| otherwise = f (size-1) []
where
f 0 acc = do
e <- peekElemOff ptr 0
return (e:acc)
f n acc = do
e <- peekElemOff ptr n
f (n-1) (e:acc)
newArray :: (CStorable a) => [a] -> IO (Ptr a)
newArray vals = do
ptr <- mallocArray (length vals)
pokeArray ptr vals
return ptr
withArray :: (CStorable a) => [a] -> (Ptr a -> IO b) -> IO b
withArray vals f = withArrayLen vals (const f)
withArrayLen :: (CStorable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen vals f = allocaArray len $ \ptr -> do
pokeArray ptr vals
f len ptr
where len = length vals
withArrayLenNull :: CStorable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLenNull vals f
| null vals = f 0 nullPtr
| otherwise = withArrayLen vals f
copyArray :: (CStorable a) => Ptr a -> Ptr a -> Int -> IO ()
copyArray = doCopy undefined
where
doCopy :: (CStorable a') => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy)
with :: (CStorable a) => a -> (Ptr a -> IO b) -> IO b
with val f = alloca $ \ptr -> do
poke ptr val
f ptr
new :: (CStorable a) => a -> IO (Ptr a)
new val = do
ptr <- malloc
poke ptr val
return ptr