{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.Storable.ChunkIterator where
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector.Base as SVB
import qualified LLVM.Core as LLVM
import Data.Word (Word)
import Foreign.Storable (Storable, poke)
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Control.Monad (liftM2)
import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
data T a = (Storable a) => Cons (IORef [SVB.Vector a]) (IORef (SVB.Vector a))
foreign import ccall "&nextChunk"
nextCallBack :: FunPtr (StablePtr (T a) -> LLVM.Ptr Word -> IO (Ptr a))
foreign export ccall "nextChunk"
next :: StablePtr (T a) -> Ptr Word -> IO (Ptr a)
new :: (Storable a) => SVL.Vector a -> IO (StablePtr (T a))
new :: forall a. Storable a => Vector a -> IO (StablePtr (T a))
new Vector a
sig =
T a -> IO (StablePtr (T a))
forall a. a -> IO (StablePtr a)
newStablePtr (T a -> IO (StablePtr (T a))) -> IO (T a) -> IO (StablePtr (T a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(IORef [Vector a] -> IORef (Vector a) -> T a)
-> IO (IORef [Vector a]) -> IO (IORef (Vector a)) -> IO (T a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 IORef [Vector a] -> IORef (Vector a) -> T a
forall a. Storable a => IORef [Vector a] -> IORef (Vector a) -> T a
Cons
([Vector a] -> IO (IORef [Vector a])
forall a. a -> IO (IORef a)
newIORef (Vector a -> [Vector a]
forall a. Vector a -> [Vector a]
SVL.chunks Vector a
sig))
(Vector a -> IO (IORef (Vector a))
forall a. a -> IO (IORef a)
newIORef ([Char] -> Vector a
forall a. HasCallStack => [Char] -> a
error [Char]
"first chunk must be fetched with nextChunk"))
dispose :: StablePtr (T a) -> IO ()
dispose :: forall a. StablePtr (T a) -> IO ()
dispose = StablePtr (T a) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr
next :: StablePtr (T a) -> Ptr Word -> IO (Ptr a)
next :: forall a. StablePtr (T a) -> Ptr Word -> IO (Ptr a)
next StablePtr (T a)
stable Ptr Word
lenPtr =
StablePtr (T a) -> IO (T a)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (T a)
stable IO (T a) -> (T a -> IO (Ptr a)) -> IO (Ptr a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \T a
state ->
case T a
state of
Cons IORef [Vector a]
listRef IORef (Vector a)
chunkRef -> do
[Vector a]
xt <- IORef [Vector a] -> IO [Vector a]
forall a. IORef a -> IO a
readIORef IORef [Vector a]
listRef
case [Vector a]
xt of
[] -> Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
forall a. Ptr a
nullPtr
(Vector a
x:[Vector a]
xs) ->
IORef (Vector a) -> Vector a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Vector a)
chunkRef Vector a
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IORef [Vector a] -> [Vector a] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Vector a]
listRef [Vector a]
xs IO () -> IO (Ptr a) -> IO (Ptr a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Vector a -> (Ptr a -> Int -> IO (Ptr a)) -> IO (Ptr a)
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector a
x
(\Ptr a
p Int
l -> Ptr Word -> Word -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word
lenPtr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) IO () -> IO (Ptr a) -> IO (Ptr a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
p)