{-# 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])

{-
For problems about Storable constraint, see ChunkIterator.
-}
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

{- |
Zero pieces are filtered out.
If 'next' returns 0 then the end of the lazy size is reached.
-}
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))