{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.Storable.LazySizeIterator where
import qualified Numeric.NonNegative.Chunky as Chunky
import qualified Data.StorableVector.Lazy.Pattern as SVP
import qualified Data.StorableVector.Lazy as SVL
import Data.Word (Word)
import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)
import Foreign.Ptr (FunPtr)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.List.HT as ListHT
newtype T = Cons (IORef [SVL.ChunkSize])
foreign import ccall "&nextSize"
nextCallBack :: FunPtr (StablePtr T -> IO Word)
foreign export ccall "nextSize"
next :: StablePtr T -> IO Word
new :: SVP.LazySize -> IO (StablePtr T)
new :: LazySize -> IO (StablePtr T)
new LazySize
ls =
T -> IO (StablePtr T)
forall a. a -> IO (StablePtr a)
newStablePtr (T -> IO (StablePtr T))
-> (IORef [ChunkSize] -> T)
-> IORef [ChunkSize]
-> IO (StablePtr T)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef [ChunkSize] -> T
Cons (IORef [ChunkSize] -> IO (StablePtr T))
-> IO (IORef [ChunkSize]) -> IO (StablePtr T)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ChunkSize] -> IO (IORef [ChunkSize])
forall a. a -> IO (IORef a)
newIORef (LazySize -> [ChunkSize]
forall a. T a -> [a]
Chunky.toChunks (LazySize -> LazySize
forall a. C a => T a -> T a
Chunky.normalize LazySize
ls))
dispose :: StablePtr T -> IO ()
dispose :: StablePtr T -> IO ()
dispose = StablePtr T -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr
next :: StablePtr T -> IO Word
next :: StablePtr T -> IO Word
next StablePtr T
stable =
StablePtr T -> IO T
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr T
stable IO T -> (T -> IO Word) -> IO Word
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \T
state ->
case T
state of
Cons IORef [ChunkSize]
listRef ->
IORef [ChunkSize] -> IO [ChunkSize]
forall a. IORef a -> IO a
readIORef IORef [ChunkSize]
listRef IO [ChunkSize] -> ([ChunkSize] -> IO Word) -> IO Word
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO Word
-> (ChunkSize -> [ChunkSize] -> IO Word) -> [ChunkSize] -> IO Word
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL
(Word -> IO Word
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word
0)
(\(SVL.ChunkSize Int
time) [ChunkSize]
xs ->
IORef [ChunkSize] -> [ChunkSize] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [ChunkSize]
listRef [ChunkSize]
xs IO () -> IO Word -> IO Word
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Word -> IO Word
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
time))