{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.EventIterator where

import qualified Data.EventList.Relative.BodyTime as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg

import Data.Word (Word32, )
import Foreign.Storable (Storable, poke, )
import Foreign.Ptr (Ptr, castPtr, )

import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )
import Foreign.Ptr (FunPtr, )
import Data.IORef (IORef, newIORef, readIORef, writeIORef, )

import Control.Monad ((<=<), )

import qualified Synthesizer.LLVM.Debug.StablePtr as DebugStable


data T =
   forall a. Storable a =>
   Cons (IORef (EventList.T NonNeg.Int a))

{-
For problems about Storable constraint, see ChunkIterator.
-}
foreign import ccall "&nextConstant"
   nextCallBack ::
      FunPtr (
         StablePtr T ->
         Ptr a -> IO Word32
      )

foreign export ccall "nextConstant"
   next ::
      StablePtr T ->
      Ptr a -> IO Word32


{- |
Events with subsequent duration 0 are ignored
(and for performance reasons it should not contain too many small values,
say below 100).
-}
new ::
   Storable a =>
   EventList.T NonNeg.Int a -> IO (StablePtr T)
new evs =
   DebugStable.trace "new" =<<
   newStablePtr . Cons
    =<< newIORef
      (EventList.fromPairList $
       filter ((/=0) . snd) $
       EventList.toPairList evs)

dispose ::
   StablePtr T -> IO ()
dispose = freeStablePtr <=< DebugStable.trace "dispose"

next ::
   StablePtr T ->
   Ptr a -> IO Word32
next stable eventPtr =
   DebugStable.trace "next" stable >>=
   deRefStablePtr >>= \state ->
   case state of
      Cons listRef ->
         readIORef listRef >>=
         EventList.switchL
            (return 0)
            (\body time xs ->
               writeIORef listRef xs >>
               poke (castPtr eventPtr) body >>
               return (fromIntegral time))