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


{-# LINE 1 "./Foreign/CUDA/FFT/Execute.chs" #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |
-- Module      : Foreign.CUDA.FFT.Execute
-- Copyright   : [2013..2018] Robert Clifton-Everest, Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Foreign.CUDA.FFT.Execute (

  Mode(..),

  execC2C, execZ2Z,
  execR2C, execD2Z,
  execC2R, execZ2D,

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



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

import Foreign.CUDA.Ptr

-- system
import Foreign
import Foreign.C
import Data.Complex



{-# LINE 36 "./Foreign/CUDA/FFT/Execute.chs" #-}


-- | FFT transform direction
--
data Mode = Forward
          | Inverse
  deriving (Eq,Show,Bounded)
instance Enum Mode where
  succ Forward = Inverse
  succ Inverse = error "Mode.succ: Inverse has no successor"

  pred Inverse = Forward
  pred Forward = error "Mode.pred: Forward 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 Inverse

  fromEnum Forward = (-1)
  fromEnum Inverse = 1

  toEnum (-1) = Forward
  toEnum 1 = Inverse
  toEnum unmatched = error ("Mode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 48 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a single-precision complex-to-complex transform.
--
-- If the input and output device pointers are the same, an in-place transform
-- is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecc2c-cufftexecz2z>
--
{-# INLINEABLE execC2C #-}
execC2C
    :: Handle                     -- ^ plan handle, of type 'C2C'
    -> Mode                       -- ^ transform direction
    -> DevicePtr (Complex Float)  -- ^ input data
    -> DevicePtr (Complex Float)  -- ^ output data
    -> IO ()
execC2C hdl dir i o = cufftExecC2C hdl i o dir
  where
    cufftExecC2C :: (Handle) -> (DevicePtr (Complex Float)) -> (DevicePtr (Complex Float)) -> (Mode) -> IO ()
    cufftExecC2C a1 a2 a3 a4 =
      let {a1' = useHandle a1} in 
      let {a2' = useDevicePtr' a2} in 
      let {a3' = useDevicePtr' a3} in 
      let {a4' = cFromEnum a4} in 
      cufftExecC2C'_ a1' a2' a3' a4' >>= \res ->
      checkStatus res >> 
      return ()

{-# LINE 73 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a double-precision complex-to-complex transform.
--
-- If the input and output device pointers are the same, an in-place transform
-- is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecc2c-cufftexecz2z>
--
{-# INLINEABLE execZ2Z #-}
execZ2Z
    :: Handle                     -- ^ plan handle, of type 'Z2Z'
    -> Mode                       -- ^ transform direction
    -> DevicePtr (Complex Double) -- ^ input data
    -> DevicePtr (Complex Double) -- ^ output data
    -> IO ()
execZ2Z hdl dir i o = cufftExecZ2Z hdl i o dir
  where
    cufftExecZ2Z :: (Handle) -> (DevicePtr (Complex Double)) -> (DevicePtr (Complex Double)) -> (Mode) -> IO ()
    cufftExecZ2Z a1 a2 a3 a4 =
      let {a1' = useHandle a1} in 
      let {a2' = useDevicePtr' a2} in 
      let {a3' = useDevicePtr' a3} in 
      let {a4' = cFromEnum a4} in 
      cufftExecZ2Z'_ a1' a2' a3' a4' >>= \res ->
      checkStatus res >> 
      return ()

{-# LINE 98 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a single-precision real-to-complex, implicitly forward, transform.
--
-- If the input and output device pointers refer to the same address, an
-- in-place transform is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecr2c-cufftexecd2z>
--
{-# INLINEABLE execR2C #-}
execR2C :: (Handle) -- ^ plan handle, of type 'R2C'
 -> (DevicePtr Float) -- ^ input data
 -> (DevicePtr (Complex Float)) -- ^ output data
 -> IO ()
execR2C a1 a2 a3 =
  let {a1' = useHandle a1} in 
  let {a2' = useDevicePtr' a2} in 
  let {a3' = useDevicePtr' a3} in 
  execR2C'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 114 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a double-precision real-to-complex, implicitly forward, transform.
--
-- If the input and output device pointers refer to the same address, an
-- in-place transform is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecr2c-cufftexecd2z>
--
{-# INLINEABLE execD2Z #-}
execD2Z :: (Handle) -- ^ plan handle, of type 'D2Z'
 -> (DevicePtr Double) -- ^ input data
 -> (DevicePtr (Complex Double)) -- ^ output data
 -> IO ()
execD2Z a1 a2 a3 =
  let {a1' = useHandle a1} in 
  let {a2' = useDevicePtr' a2} in 
  let {a3' = useDevicePtr' a3} in 
  execD2Z'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 130 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a single-precision complex-to-real, implicitly forward, transform.
--
-- If the input and output device pointers refer to the same address, an
-- in-place transform is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecc2r-cufftexecz2d>
--
{-# INLINEABLE execC2R #-}
execC2R :: (Handle) -- ^ plan handle, of type 'C2R'
 -> (DevicePtr (Complex Float)) -- ^ input data
 -> (DevicePtr Float) -- ^ output data
 -> IO ()
execC2R a1 a2 a3 =
  let {a1' = useHandle a1} in 
  let {a2' = useDevicePtr' a2} in 
  let {a3' = useDevicePtr' a3} in 
  execC2R'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 146 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- | Executes a double-precision complex-to-real, implicitly forward, transform.
--
-- If the input and output device pointers refer to the same address, an
-- in-place transform is executed.
--
-- <http://docs.nvidia.com/cuda/cufft/index.html#function-cufftexecc2r-cufftexecz2d>
--
{-# INLINEABLE execZ2D #-}
execZ2D :: (Handle) -- ^ plan handle, of type 'Z2D'
 -> (DevicePtr (Complex Double)) -- ^ input data
 -> (DevicePtr Double) -- ^ output data
 -> IO ()
execZ2D a1 a2 a3 =
  let {a1' = useHandle a1} in 
  let {a2' = useDevicePtr' a2} in 
  let {a3' = useDevicePtr' a3} in 
  execZ2D'_ a1' a2' a3' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 162 "./Foreign/CUDA/FFT/Execute.chs" #-}



-- c2hs treats pointers to complex values as 'Ptr ()' (they are structs on the
-- C side) and uses 'CFloat' instead of 'Float', etc.
--
{-# INLINE useDevicePtr' #-}
useDevicePtr' :: DevicePtr a -> Ptr b
useDevicePtr' = castPtr . useDevicePtr


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

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

foreign import ccall unsafe "Foreign/CUDA/FFT/Execute.chs.h cufftExecR2C"
  execR2C'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Execute.chs.h cufftExecD2Z"
  execD2Z'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Execute.chs.h cufftExecC2R"
  execC2R'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Foreign/CUDA/FFT/Execute.chs.h cufftExecZ2D"
  execZ2D'_ :: (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (IO C2HSImp.CInt))))