-- GENERATED by C->Haskell Compiler, version 0.28.2 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Runtime/Event.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Event
-- Copyright : [2009..2017] Trevor L. McDonell
-- License   : BSD
--
-- Event management for C-for-CUDA runtime environment
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Runtime.Event (

  -- * Event Management
  Event, EventFlag(..), WaitFlag,
  create, destroy, elapsedTime, query, record, wait, block

) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





{-# LINE 25 "src/Foreign/CUDA/Runtime/Event.chs" #-}


-- Friends
import Foreign.CUDA.Types
import Foreign.CUDA.Runtime.Error
import Foreign.CUDA.Internal.C2HS

-- System
import Foreign
import Foreign.C
import Control.Monad                                    ( liftM )
import Control.Exception                                ( throwIO )
import Data.Maybe                                       ( fromMaybe )


--------------------------------------------------------------------------------
-- Event management
--------------------------------------------------------------------------------

-- |
-- Create a new event
--
{-# INLINEABLE create #-}
create :: [EventFlag] -> IO Event
create !flags = resultIfOk =<< cudaEventCreateWithFlags flags

{-# INLINE cudaEventCreateWithFlags #-}
cudaEventCreateWithFlags :: ([EventFlag]) -> IO ((Status), (Event))
cudaEventCreateWithFlags a2 =
  alloca $ \a1' -> 
  let {a2' = combineBitMasks a2} in 
  cudaEventCreateWithFlags'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekEvt  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 54 "src/Foreign/CUDA/Runtime/Event.chs" #-}

  where peekEvt = liftM Event . peek


-- |
-- Destroy an event
--
{-# INLINEABLE destroy #-}
destroy :: Event -> IO ()
destroy !ev = nothingIfOk =<< cudaEventDestroy ev

{-# INLINE cudaEventDestroy #-}
cudaEventDestroy :: (Event) -> IO ((Status))
cudaEventDestroy a1 =
  let {a1' = useEvent a1} in 
  cudaEventDestroy'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 67 "src/Foreign/CUDA/Runtime/Event.chs" #-}



-- |
-- Determine the elapsed time (in milliseconds) between two events
--
{-# INLINEABLE elapsedTime #-}
elapsedTime :: Event -> Event -> IO Float
elapsedTime !ev1 !ev2 = resultIfOk =<< cudaEventElapsedTime ev1 ev2

{-# INLINE cudaEventElapsedTime #-}
cudaEventElapsedTime :: (Event) -> (Event) -> IO ((Status), (Float))
cudaEventElapsedTime a2 a3 =
  alloca $ \a1' -> 
  let {a2' = useEvent a2} in 
  let {a3' = useEvent a3} in 
  cudaEventElapsedTime'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekFloatConv  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 81 "src/Foreign/CUDA/Runtime/Event.chs" #-}



-- |
-- Determines if a event has actually been recorded
--
{-# INLINEABLE query #-}
query :: Event -> IO Bool
query !ev =
  cudaEventQuery ev >>= \rv ->
  case rv of
    Success  -> return True
    NotReady -> return False
    _        -> throwIO (ExitCode rv)

{-# INLINE cudaEventQuery #-}
cudaEventQuery :: (Event) -> IO ((Status))
cudaEventQuery a1 =
  let {a1' = useEvent a1} in 
  cudaEventQuery'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 98 "src/Foreign/CUDA/Runtime/Event.chs" #-}



-- |
-- Record an event once all operations in the current context (or optionally
-- specified stream) have completed. This operation is asynchronous.
--
{-# INLINEABLE record #-}
record :: Event -> Maybe Stream -> IO ()
record !ev !mst =
  nothingIfOk =<< cudaEventRecord ev (maybe defaultStream id mst)

{-# INLINE cudaEventRecord #-}
cudaEventRecord :: (Event) -> (Stream) -> IO ((Status))
cudaEventRecord a1 a2 =
  let {a1' = useEvent a1} in 
  let {a2' = useStream a2} in 
  cudaEventRecord'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 113 "src/Foreign/CUDA/Runtime/Event.chs" #-}



-- |
-- Makes all future work submitted to the (optional) stream wait until the given
-- event reports completion before beginning execution. Synchronisation is
-- performed on the device, including when the event and stream are from
-- different device contexts. Requires cuda-3.2.
--
{-# INLINEABLE wait #-}
wait :: Event -> Maybe Stream -> [WaitFlag] -> IO ()
wait !ev !mst !flags =
  let st = fromMaybe defaultStream mst
  in  nothingIfOk =<< cudaStreamWaitEvent st ev flags

{-# INLINE cudaStreamWaitEvent #-}
cudaStreamWaitEvent :: (Stream) -> (Event) -> ([WaitFlag]) -> IO ((Status))
cudaStreamWaitEvent a1 a2 a3 =
  let {a1' = useStream a1} in 
  let {a2' = useEvent a2} in 
  let {a3' = combineBitMasks a3} in 
  cudaStreamWaitEvent'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 136 "src/Foreign/CUDA/Runtime/Event.chs" #-}


-- |
-- Wait until the event has been recorded
--
{-# INLINEABLE block #-}
block :: Event -> IO ()
block !ev = nothingIfOk =<< cudaEventSynchronize ev

{-# INLINE cudaEventSynchronize #-}
cudaEventSynchronize :: (Event) -> IO ((Status))
cudaEventSynchronize a1 =
  let {a1' = useEvent a1} in 
  cudaEventSynchronize'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 147 "src/Foreign/CUDA/Runtime/Event.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventCreateWithFlags"
  cudaEventCreateWithFlags'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventDestroy"
  cudaEventDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventElapsedTime"
  cudaEventElapsedTime'_ :: ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventQuery"
  cudaEventQuery'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaEventRecord"
  cudaEventRecord'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Runtime/Event.chs.h cudaStreamWaitEvent"
  cudaStreamWaitEvent'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Foreign/CUDA/Runtime/Event.chs.h cudaEventSynchronize"
  cudaEventSynchronize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))