-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Foreign/CUDA/Driver/Stream.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE EmptyCase                #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Stream
-- Copyright : [2009..2018] Trevor L. McDonell
-- License   : BSD
--
-- Stream management for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Stream (

  -- * Stream Management
  Stream(..), StreamPriority, StreamCallback,
  StreamFlag(..), StreamWriteFlag(..), StreamWaitFlag(..), StreamCallbackFlag,

  create, createWithPriority, destroy, finished, block, callback,
  getFlags, getPriority, getContext,
  write, wait,

  defaultStream,
  defaultStreamLegacy,
  defaultStreamPerThread,

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





{-# LINE 36 "src/Foreign/CUDA/Driver/Stream.chs" #-}


-- Friends
import Foreign.CUDA.Ptr
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Driver.Context.Base                   ( Context(..) )
import Foreign.CUDA.Internal.C2HS

-- System
import Control.Exception                                  ( throwIO )
import Control.Monad                                      ( liftM )
import Foreign
import Foreign.C
import Unsafe.Coerce

import GHC.Base
import GHC.Ptr
import GHC.Word


--------------------------------------------------------------------------------
-- Data Types
--------------------------------------------------------------------------------

-- |
-- A processing stream. All operations in a stream are synchronous and executed
-- in sequence, but operations in different non-default streams may happen
-- out-of-order or concurrently with one another.
--
-- Use 'Event's to synchronise operations between streams.
--
newtype Stream = Stream { useStream :: ((C2HSImp.Ptr ()))}
  deriving (Eq, Show)

-- |
-- Priority of an execution stream. Work submitted to a higher priority
-- stream may preempt execution of work already executing in a lower
-- priority stream. Lower numbers represent higher priorities.
--
type StreamPriority = Int

-- |
-- Execution stream creation flags
--
data StreamFlag = Default
                | NonBlocking
  deriving (Eq,Show,Bounded)
instance Enum StreamFlag where
  succ Default = NonBlocking
  succ NonBlocking = error "StreamFlag.succ: NonBlocking has no successor"

  pred NonBlocking = Default
  pred Default = error "StreamFlag.pred: Default has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from NonBlocking

  fromEnum Default = 0
  fromEnum NonBlocking = 1

  toEnum 0 = Default
  toEnum 1 = NonBlocking
  toEnum unmatched = error ("StreamFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 106 "src/Foreign/CUDA/Driver/Stream.chs" #-}


data StreamWriteFlag = WriteValueDefault
                     | WriteValueNoMemoryBarrier
  deriving (Eq,Show,Bounded)
instance Enum StreamWriteFlag where
  succ WriteValueDefault = WriteValueNoMemoryBarrier
  succ WriteValueNoMemoryBarrier = error "StreamWriteFlag.succ: WriteValueNoMemoryBarrier has no successor"

  pred WriteValueNoMemoryBarrier = WriteValueDefault
  pred WriteValueDefault = error "StreamWriteFlag.pred: WriteValueDefault has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from WriteValueNoMemoryBarrier

  fromEnum WriteValueDefault = 0
  fromEnum WriteValueNoMemoryBarrier = 1

  toEnum 0 = WriteValueDefault
  toEnum 1 = WriteValueNoMemoryBarrier
  toEnum unmatched = error ("StreamWriteFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 110 "src/Foreign/CUDA/Driver/Stream.chs" #-}


data StreamWaitFlag = WaitValueGeq
                    | WaitValueEq
                    | WaitValueAnd
                    | WaitValueNor
                    | WaitValueFlush
  deriving (Eq,Show,Bounded)
instance Enum StreamWaitFlag where
  succ WaitValueGeq = WaitValueEq
  succ WaitValueEq = WaitValueAnd
  succ WaitValueAnd = WaitValueNor
  succ WaitValueNor = WaitValueFlush
  succ WaitValueFlush = error "StreamWaitFlag.succ: WaitValueFlush has no successor"

  pred WaitValueEq = WaitValueGeq
  pred WaitValueAnd = WaitValueEq
  pred WaitValueNor = WaitValueAnd
  pred WaitValueFlush = WaitValueNor
  pred WaitValueGeq = error "StreamWaitFlag.pred: WaitValueGeq has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from WaitValueFlush

  fromEnum WaitValueGeq = 0
  fromEnum WaitValueEq = 1
  fromEnum WaitValueAnd = 2
  fromEnum WaitValueNor = 3
  fromEnum WaitValueFlush = 1073741824

  toEnum 0 = WaitValueGeq
  toEnum 1 = WaitValueEq
  toEnum 2 = WaitValueAnd
  toEnum 3 = WaitValueNor
  toEnum 1073741824 = WaitValueFlush
  toEnum unmatched = error ("StreamWaitFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 115 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- | A 'Stream' callback function
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__TYPES.html#group__CUDA__TYPES_1ge5743a8c48527f1040107a68205c5ba9>
--
-- @since 0.10.0.0
--
type StreamCallback = ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))))
{-# LINE 124 "src/Foreign/CUDA/Driver/Stream.chs" #-}


data StreamCallbackFlag
instance Enum StreamCallbackFlag where
  toEnum   x = error ("StreamCallbackFlag.toEnum: Cannot match " ++ show x)
  fromEnum x = case x of {}


--------------------------------------------------------------------------------
-- Stream management
--------------------------------------------------------------------------------

-- |
-- Create a new stream.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1ga581f0c5833e21ded8b5a56594e243f4>
--
{-# INLINEABLE create #-}
create :: [StreamFlag] -> IO Stream
create !flags = resultIfOk =<< cuStreamCreate flags

{-# INLINE cuStreamCreate #-}
cuStreamCreate :: ([StreamFlag]) -> IO ((Status), (Stream))
cuStreamCreate a2 =
  alloca $ \a1' ->
  let {a2' = combineBitMasks a2} in
  cuStreamCreate'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekStream  a1'>>= \a1'' ->
  return (res', a1'')

{-# LINE 150 "src/Foreign/CUDA/Driver/Stream.chs" #-}

  where
    peekStream = liftM Stream . peek


-- |
-- Create a stream with the given priority. Work submitted to
-- a higher-priority stream may preempt work already executing in a lower
-- priority stream.
--
-- The convention is that lower numbers represent higher priorities. The
-- default priority is zero. The range of meaningful numeric priorities can
-- be queried using 'Foreign.CUDA.Driver.Context.Config.getStreamPriorityRange'.
-- If the specified priority is outside the supported numerical range, it
-- will automatically be clamped to the highest or lowest number in the
-- range
--
-- Requires CUDA-5.5.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g95c1a8c7c3dacb13091692dd9c7f7471>
--
{-# INLINEABLE createWithPriority #-}
createWithPriority :: StreamPriority -> [StreamFlag] -> IO Stream
createWithPriority !priority !flags = resultIfOk =<< cuStreamCreateWithPriority flags priority

{-# INLINE cuStreamCreateWithPriority #-}
cuStreamCreateWithPriority :: ([StreamFlag]) -> (StreamPriority) -> IO ((Status), (Stream))
cuStreamCreateWithPriority a2 a3 =
  alloca $ \a1' ->
  let {a2' = combineBitMasks a2} in
  let {a3' = fromIntegral a3} in
  cuStreamCreateWithPriority'_ a1' a2' a3' >>= \res ->
  let {res' = cToEnum res} in
  peekStream  a1'>>= \a1'' ->
  return (res', a1'')

{-# LINE 184 "src/Foreign/CUDA/Driver/Stream.chs" #-}

  where
    peekStream = liftM Stream . peek


-- |
-- Destroy a stream. If the device is still doing work in the stream when
-- 'destroy' is called, the function returns immediately and the resources
-- associated with the stream will be released automatically once the
-- device has completed all work.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g244c8833de4596bcd31a06cdf21ee758>
--
{-# INLINEABLE destroy #-}
destroy :: Stream -> IO ()
destroy !st = nothingIfOk =<< cuStreamDestroy st

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

{-# LINE 204 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- |
-- Check if all operations in the stream have completed.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g1b0d24bbe97fa68e4bc511fb6adfeb0b>
--
{-# INLINEABLE finished #-}
finished :: Stream -> IO Bool
finished !st =
  cuStreamQuery st >>= \rv ->
  case rv of
    Success  -> return True
    NotReady -> return False
    _        -> throwIO (ExitCode rv)

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

{-# LINE 223 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- |
-- Wait until the device has completed all operations in the Stream.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g15e49dd91ec15991eb7c0a741beb7dad>
--
{-# INLINEABLE block #-}
block :: Stream -> IO ()
block !st = nothingIfOk =<< cuStreamSynchronize st

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

{-# LINE 237 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- |
-- Query the priority of a stream.
--
-- Requires CUDA-5.5.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g5bd5cb26915a2ecf1921807339488484>
--
{-# INLINEABLE getPriority #-}
getPriority :: Stream -> IO StreamPriority
getPriority !st = resultIfOk =<< cuStreamGetPriority st

{-# INLINE cuStreamGetPriority #-}
cuStreamGetPriority :: (Stream) -> IO ((Status), (StreamPriority))
cuStreamGetPriority a1 =
  let {a1' = useStream a1} in
  alloca $ \a2' ->
  cuStreamGetPriority'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekIntConv  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 260 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- | Query the flags of a given stream
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g4d39786855a6bed01215c1907fbbfbb7>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getFlags #-}
getFlags :: (Stream) -> IO (([StreamFlag]))
getFlags a1 =
  let {a1' = useStream a1} in
  alloca $ \a2' ->
  getFlags'_ a1' a2' >>= \res ->
  checkStatus res >>
  extract  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 274 "src/Foreign/CUDA/Driver/Stream.chs" #-}

  where
    extract p = extractBitMasks `fmap` peek p


-- |
-- Query the context associated with a stream
--
-- Requires CUDA-9.2.
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g5bd5cb26915a2ecf1921807339488484>
--
-- @since 0.10.0.0
--
{-# INLINEABLE getContext #-}
getContext :: Stream -> IO Context
getContext !st = resultIfOk =<< cuStreamGetCtx st

{-# INLINE cuStreamGetCtx #-}
cuStreamGetCtx :: (Stream) -> IO ((Status), (Context))
cuStreamGetCtx a1 =
  let {a1' = useStream a1} in
  alloca $ \a2' ->
  cuStreamGetCtx'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekCtx  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 302 "src/Foreign/CUDA/Driver/Stream.chs" #-}

  where
    peekCtx = liftM Context . peek


-- | Write a value to memory, (presumably) after all preceding work in the
-- stream has completed. Unless the option 'WriteValueNoMemoryBarrier' is
-- supplied, the write is preceded by a system-wide memory fence.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g091455366d56dc2f1f69726aafa369b0>
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1gc8af1e8b96d7561840affd5217dd6830>
--
-- Requires CUDA-8.0 for 32-bit values.
--
-- Requires CUDA-9.0 for 64-bit values.
--
{-# INLINEABLE write #-}
write :: Storable a => DevicePtr a -> a -> Stream -> [StreamWriteFlag] -> IO ()
write ptr val stream flags =
  case sizeOf val of
    4 -> write32 (castDevPtr ptr) (unsafeCoerce val) stream flags
    8 -> write64 (castDevPtr ptr) (unsafeCoerce val) stream flags
    _ -> cudaErrorIO "Stream.write: can only write 32- and 64-bit values"

{-# INLINE write32 #-}
write32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWriteFlag] -> IO ()
write32 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue32 stream ptr val flags

{-# INLINE cuStreamWriteValue32 #-}
cuStreamWriteValue32 :: (Stream) -> (DevicePtr Word32) -> (Word32) -> ([StreamWriteFlag]) -> IO ((Status))
cuStreamWriteValue32 a1 a2 a3 a4 =
  let {a1' = useStream a1} in
  let {a2' = useDeviceHandle a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = combineBitMasks a4} in
  cuStreamWriteValue32'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 343 "src/Foreign/CUDA/Driver/Stream.chs" #-}


{-# INLINE write64 #-}
write64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWriteFlag] -> IO ()
write64 ptr val stream flags = nothingIfOk =<< cuStreamWriteValue64 stream ptr val flags

{-# INLINE cuStreamWriteValue64 #-}
cuStreamWriteValue64 :: (Stream) -> (DevicePtr Word64) -> (Word64) -> ([StreamWriteFlag]) -> IO ((Status))
cuStreamWriteValue64 a1 a2 a3 a4 =
  let {a1' = useStream a1} in
  let {a2' = useDeviceHandle a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = combineBitMasks a4} in
  cuStreamWriteValue64'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 360 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- | Wait on a memory location. Work ordered after the operation will block
-- until the given condition on the memory is satisfied.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g629856339de7bc6606047385addbb398>
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EVENT.html#group__CUDA__EVENT_1g6910c1258c5f15aa5d699f0fd60d6933>
--
-- Requires CUDA-8.0 for 32-bit values.
--
-- Requires CUDA-9.0 for 64-bit values.
--
{-# INLINEABLE wait #-}
wait :: Storable a => DevicePtr a -> a -> Stream -> [StreamWaitFlag] -> IO ()
wait ptr val stream flags =
  case sizeOf val of
    4 -> wait32 (castDevPtr ptr) (unsafeCoerce val) stream flags
    8 -> wait64 (castDevPtr ptr) (unsafeCoerce val) stream flags
    _ -> cudaErrorIO "Stream.wait: can only wait on 32- and 64-bit values"

{-# INLINE wait32 #-}
wait32 :: DevicePtr Word32 -> Word32 -> Stream -> [StreamWaitFlag] -> IO ()
wait32 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue32 stream ptr val flags

{-# INLINE cuStreamWaitValue32 #-}
cuStreamWaitValue32 :: (Stream) -> (DevicePtr Word32) -> (Word32) -> ([StreamWaitFlag]) -> IO ((Status))
cuStreamWaitValue32 a1 a2 a3 a4 =
  let {a1' = useStream a1} in
  let {a2' = useDeviceHandle a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = combineBitMasks a4} in
  cuStreamWaitValue32'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 396 "src/Foreign/CUDA/Driver/Stream.chs" #-}


{-# INLINE wait64 #-}
wait64 :: DevicePtr Word64 -> Word64 -> Stream -> [StreamWaitFlag] -> IO ()
wait64 ptr val stream flags = nothingIfOk =<< cuStreamWaitValue64 stream ptr val flags

{-# INLINE cuStreamWaitValue64 #-}
cuStreamWaitValue64 :: (Stream) -> (DevicePtr Word64) -> (Word64) -> ([StreamWaitFlag]) -> IO ((Status))
cuStreamWaitValue64 a1 a2 a3 a4 =
  let {a1' = useStream a1} in
  let {a2' = useDeviceHandle a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = combineBitMasks a4} in
  cuStreamWaitValue64'_ a1' a2' a3' a4' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 412 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- | Add a callback to a compute stream. This function will be executed on the
-- host after all currently queued items in the stream have completed.
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__STREAM.html#group__CUDA__STREAM_1g613d97a277d7640f4cb1c03bd51c2483>
--
-- @since 0.10.0.0
--
{-# INLINEABLE callback #-}
callback :: (Stream) -> (StreamCallback) -> (Ptr ()) -> ([StreamCallbackFlag]) -> IO ()
callback a1 a2 a3 a4 =
  let {a1' = useStream a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  let {a4' = combineBitMasks a4} in
  callback'_ a1' a2' a3' a4' >>= \res ->
  checkStatus res >>
  return ()

{-# LINE 428 "src/Foreign/CUDA/Driver/Stream.chs" #-}



-- | The default execution stream. This can be configured to have either
-- 'defaultStreamLegacy' or 'defaultStreamPerThread' synchronisation behaviour.
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>
--
{-# INLINE defaultStream #-}
defaultStream :: Stream
defaultStream = Stream (Ptr (int2Addr# 0#))


-- | The legacy default stream is an implicit stream which synchronises with all
-- other streams in the same 'Context', except for non-blocking streams.
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>
--
-- @since 0.10.0.0
--
{-# INLINE defaultStreamLegacy #-}
defaultStreamLegacy :: Stream
defaultStreamLegacy = Stream (Ptr (int2Addr# 0x1#))


-- | The per-thread default stream is an implicit stream local to both the
-- thread and the calling 'Context', and which does not synchronise with other
-- streams (just like explicitly created streams). The per-thread default stream
-- is not a non-blocking stream and will synchronise with the legacy default
-- stream if both are used in the same program.
--
-- <file:///Developer/NVIDIA/CUDA-9.2/doc/html/cuda-driver-api/stream-sync-behavior.html#stream-sync-behavior__default-stream>
--
-- @since 0.10.0.0
--
{-# INLINE defaultStreamPerThread #-}
defaultStreamPerThread :: Stream
defaultStreamPerThread = Stream (Ptr (int2Addr# 0x2#))


--------------------------------------------------------------------------------
-- Internal
--------------------------------------------------------------------------------

-- Use a device pointer as an opaque handle type
--
{-# INLINE useDeviceHandle #-}
useDeviceHandle :: DevicePtr a -> (C2HSImp.CULLong)
{-# LINE 475 "src/Foreign/CUDA/Driver/Stream.chs" #-}

useDeviceHandle (DevicePtr (Ptr addr#)) =
  CULLong (W64# (int2Word# (addr2Int# addr#)))


foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamCreate"
  cuStreamCreate'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamCreateWithPriority"
  cuStreamCreateWithPriority'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamDestroy"
  cuStreamDestroy'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamQuery"
  cuStreamQuery'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Foreign/CUDA/Driver/Stream.chs.h cuStreamSynchronize"
  cuStreamSynchronize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetPriority"
  cuStreamGetPriority'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetFlags"
  getFlags'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamGetCtx"
  cuStreamGetCtx'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWriteValue32"
  cuStreamWriteValue32'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWriteValue64"
  cuStreamWriteValue64'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWaitValue32"
  cuStreamWaitValue32'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamWaitValue64"
  cuStreamWaitValue64'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULLong -> (C2HSImp.CULLong -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Foreign/CUDA/Driver/Stream.chs.h cuStreamAddCallback"
  callback'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))