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


{-# LINE 1 "./Foreign/CUDA/FFT/Stream.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.FFT.Stream (

  -- * Streamed transforms
  setStream,

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



-- friends
import Foreign.CUDA.Types
import Foreign.CUDA.FFT.Plan
import Foreign.CUDA.FFT.Error
import Foreign.CUDA.FFT.Internal.C2HS

-- system
import Foreign
import Foreign.C



{-# LINE 22 "./Foreign/CUDA/FFT/Stream.chs" #-}


-- | Associates a CUDA stream with a CUFFT plan. All kernel launches made during
-- plan execution are now done through the associated stream, enabling overlap
-- with activity in other streams (e.g. data copying). The association remains
-- until the plan is destroyed or the stream is changed.
--
setStream :: Handle -> Stream -> IO ()
setStream ctx st = nothingIfOk =<< cufftSetStream ctx st

cufftSetStream :: (Handle) -> (Stream) -> IO ((Result))
cufftSetStream a1 a2 =
  let {a1' = useHandle a1} in 
  let {a2' = useStream a2} in 
  cufftSetStream'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 34 "./Foreign/CUDA/FFT/Stream.chs" #-}



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