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


{-# LINE 1 "src/Foreign/CUDA/Types.chs" #-}
{-# LANGUAGE BangPatterns   #-}
{-# LANGUAGE CPP            #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE EmptyCase      #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Types
-- Copyright : [2009..2017] Trevor L. McDonell
-- License   : BSD
--
-- Data types that are equivalent and can be shared freely between the CUDA
-- Runtime and Driver APIs.
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Types (

  -- * Pointers
  DevicePtr(..), HostPtr(..),

  -- * Events
  Event(..), EventFlag(..), WaitFlag,

  -- * Streams
  Stream(..), StreamFlag(..), StreamPriority,
  defaultStream,

) where
import qualified Foreign.Ptr as C2HSImp



-- system
import Foreign.Ptr
import Foreign.Storable



{-# LINE 37 "src/Foreign/CUDA/Types.chs" #-}



--------------------------------------------------------------------------------
-- Data pointers
--------------------------------------------------------------------------------

-- |
-- A reference to data stored on the device.
--
newtype DevicePtr a = DevicePtr { useDevicePtr :: Ptr a }
  deriving (Eq,Ord)

instance Show (DevicePtr a) where
  showsPrec n (DevicePtr p) = showsPrec n p

instance Storable (DevicePtr a) where
  sizeOf _    = sizeOf    (undefined :: Ptr a)
  alignment _ = alignment (undefined :: Ptr a)
  peek p      = DevicePtr `fmap` peek (castPtr p)
  poke p v    = poke (castPtr p) (useDevicePtr v)


-- |
-- A reference to page-locked host memory.
--
-- A 'HostPtr' is just a plain 'Ptr', but the memory has been allocated by CUDA
-- into page locked memory. This means that the data can be copied to the GPU
-- via DMA (direct memory access). Note that the use of the system function
-- `mlock` is not sufficient here --- the CUDA version ensures that the
-- /physical/ address stays this same, not just the virtual address.
--
-- To copy data into a 'HostPtr' array, you may use for example 'withHostPtr'
-- together with 'Foreign.Marshal.Array.copyArray' or
-- 'Foreign.Marshal.Array.moveArray'.
--
newtype HostPtr a = HostPtr { useHostPtr :: Ptr a }
  deriving (Eq,Ord)

instance Show (HostPtr a) where
  showsPrec n (HostPtr p) = showsPrec n p

instance Storable (HostPtr a) where
  sizeOf _    = sizeOf    (undefined :: Ptr a)
  alignment _ = alignment (undefined :: Ptr a)
  peek p      = HostPtr `fmap` peek (castPtr p)
  poke p v    = poke (castPtr p) (useHostPtr v)


--------------------------------------------------------------------------------
-- Events
--------------------------------------------------------------------------------

-- |
-- Events are markers that can be inserted into the CUDA execution stream and
-- later queried.
--
newtype Event = Event { useEvent :: ((C2HSImp.Ptr ()))}
  deriving (Eq, Show)

-- |
-- Event creation flags
--
data EventFlag = EventDefault
               | BlockingSync
               | DisableTiming
               | Interprocess
  deriving (Eq,Show,Bounded)
instance Enum EventFlag where
  succ EventDefault = BlockingSync
  succ BlockingSync = DisableTiming
  succ DisableTiming = Interprocess
  succ Interprocess = error "EventFlag.succ: Interprocess has no successor"

  pred BlockingSync = EventDefault
  pred DisableTiming = BlockingSync
  pred Interprocess = DisableTiming
  pred EventDefault = error "EventFlag.pred: EventDefault 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 Interprocess

  fromEnum EventDefault = 0
  fromEnum BlockingSync = 1
  fromEnum DisableTiming = 2
  fromEnum Interprocess = 4

  toEnum 0 = EventDefault
  toEnum 1 = BlockingSync
  toEnum 2 = DisableTiming
  toEnum 4 = Interprocess
  toEnum unmatched = error ("EventFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 104 "src/Foreign/CUDA/Types.chs" #-}


-- |
-- Possible option flags for waiting for events
--
data WaitFlag
instance Enum WaitFlag where
  toEnum   x = case x of {}
  fromEnum x = case x of {}


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

-- |
-- 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 = StreamDefault
                | NonBlocking
  deriving (Eq,Show,Bounded)
instance Enum StreamFlag where
  succ StreamDefault = NonBlocking
  succ NonBlocking = error "StreamFlag.succ: NonBlocking has no successor"

  pred NonBlocking = StreamDefault
  pred StreamDefault = error "StreamFlag.pred: StreamDefault 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 StreamDefault = 0
  fromEnum NonBlocking = 1

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

{-# LINE 155 "src/Foreign/CUDA/Types.chs" #-}



-- |
-- The main execution stream. No operations overlap with operations in the
-- default stream.
--
{-# INLINE defaultStream #-}
defaultStream :: Stream
defaultStream = Stream nullPtr