-- 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/Context/Config.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Context.Config
-- Copyright : [2009..2018] Trevor L. McDonell
-- License   : BSD
--
-- Context configuration for the low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Context.Config (

  -- * Context configuration
  getFlags,

  -- ** Resource limits
  Limit(..),
  getLimit, setLimit,

  -- ** Cache
  Cache(..),
  getCache, setCache,

  -- ** Shared memory
  SharedMem(..),
  getSharedMem, setSharedMem,

  -- ** Streams
  StreamPriority,
  getStreamPriorityRange,

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





{-# LINE 43 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}


-- Friends
import Foreign.CUDA.Driver.Context.Base
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign.CUDA.Driver.Stream                         ( Stream, StreamPriority )

-- System
import Control.Monad
import Foreign
import Foreign.C


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

-- |
-- Device limits flags
--
data Limit = StackSize
           | PrintfFifoSize
           | MallocHeapSize
           | DevRuntimeSyncDepth
           | DevRuntimePendingLaunchCount
           | MaxL2FetchGranularity
           | Max
  deriving (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
Eq,Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
(Int -> Limit -> ShowS)
-> (Limit -> String) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> String
$cshow :: Limit -> String
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> Limit -> ShowS
Show)
instance Enum Limit where
  succ :: Limit -> Limit
succ Limit
StackSize = Limit
PrintfFifoSize
  succ Limit
PrintfFifoSize = Limit
MallocHeapSize
  succ Limit
MallocHeapSize = Limit
DevRuntimeSyncDepth
  succ Limit
DevRuntimeSyncDepth = Limit
DevRuntimePendingLaunchCount
  succ Limit
DevRuntimePendingLaunchCount = Limit
MaxL2FetchGranularity
  succ Limit
MaxL2FetchGranularity = Limit
Max
  succ Limit
Max = String -> Limit
forall a. HasCallStack => String -> a
error String
"Limit.succ: Max has no successor"

  pred PrintfFifoSize = StackSize
  pred MallocHeapSize = PrintfFifoSize
  pred DevRuntimeSyncDepth = MallocHeapSize
  pred DevRuntimePendingLaunchCount = DevRuntimeSyncDepth
  pred MaxL2FetchGranularity = DevRuntimePendingLaunchCount
  pred Max = MaxL2FetchGranularity
  pred StackSize = error "Limit.pred: StackSize 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 Max

  fromEnum StackSize = 0
  fromEnum PrintfFifoSize = 1
  fromEnum MallocHeapSize = 2
  fromEnum DevRuntimeSyncDepth = 3
  fromEnum DevRuntimePendingLaunchCount = 4
  fromEnum MaxL2FetchGranularity = 5
  fromEnum Max = 6

  toEnum 0 = StackSize
  toEnum 1 = PrintfFifoSize
  toEnum 2 = MallocHeapSize
  toEnum 3 = DevRuntimeSyncDepth
  toEnum 4 = DevRuntimePendingLaunchCount
  toEnum 5 = MaxL2FetchGranularity
  toEnum 6 = Max
  toEnum unmatched = error ("Limit.toEnum: Cannot match " ++ show unmatched)

{-# LINE 70 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- Device cache configuration preference
--
data Cache = PreferNone
           | PreferShared
           | PreferL1
           | PreferEqual
  deriving (Eq,Show)
instance Enum Cache where
  succ PreferNone = PreferShared
  succ PreferShared = PreferL1
  succ PreferL1 = PreferEqual
  succ PreferEqual = error "Cache.succ: PreferEqual has no successor"

  pred PreferShared = PreferNone
  pred PreferL1 = PreferShared
  pred PreferEqual = PreferL1
  pred PreferNone = error "Cache.pred: PreferNone 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 PreferEqual

  fromEnum PreferNone = 0
  fromEnum PreferShared = 1
  fromEnum PreferL1 = 2
  fromEnum PreferEqual = 3

  toEnum 0 = PreferNone
  toEnum 1 = PreferShared
  toEnum 2 = PreferL1
  toEnum 3 = PreferEqual
  toEnum unmatched = error ("Cache.toEnum: Cannot match " ++ show unmatched)

{-# LINE 82 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- Device shared memory configuration preference
--
data SharedMem = DefaultBankSize
               | FourByteBankSize
               | EightByteBankSize
  deriving (Eq,Show)
instance Enum SharedMem where
  succ DefaultBankSize = FourByteBankSize
  succ FourByteBankSize = EightByteBankSize
  succ EightByteBankSize = error "SharedMem.succ: EightByteBankSize has no successor"

  pred FourByteBankSize = DefaultBankSize
  pred EightByteBankSize = FourByteBankSize
  pred DefaultBankSize = error "SharedMem.pred: DefaultBankSize 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 EightByteBankSize

  fromEnum DefaultBankSize = 0
  fromEnum FourByteBankSize = 1
  fromEnum EightByteBankSize = 2

  toEnum 0 = DefaultBankSize
  toEnum 1 = FourByteBankSize
  toEnum 2 = EightByteBankSize
  toEnum unmatched = error ("SharedMem.toEnum: Cannot match " ++ show unmatched)

{-# LINE 94 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



--------------------------------------------------------------------------------
-- Context configuration
--------------------------------------------------------------------------------

-- |
-- Return the flags that were used to create the current context.
--
-- Requires CUDA-7.0
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1gf81eef983c1e3b2ef4f166d7a930c86d>
--
{-# INLINEABLE getFlags #-}
getFlags :: IO [ContextFlag]
getFlags = resultIfOk =<< cuCtxGetFlags

{-# INLINE cuCtxGetFlags #-}
cuCtxGetFlags :: IO ((Status), ([ContextFlag]))
cuCtxGetFlags =
  alloca $ \a1' -> 
  cuCtxGetFlags'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  peekFlags  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 117 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}

  where
    peekFlags = liftM extractBitMasks . peek


-- |
-- Query compute 2.0 call stack limits.
--
-- Requires CUDA-3.1.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g9f2d47d1745752aa16da7ed0d111b6a8>
--
{-# INLINEABLE getLimit #-}
getLimit :: Limit -> IO Int
getLimit :: Limit -> IO Int
getLimit !Limit
l = (Status, Int) -> IO Int
forall a. (Status, a) -> IO a
resultIfOk ((Status, Int) -> IO Int) -> IO (Status, Int) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Limit -> IO (Status, Int)
cuCtxGetLimit Limit
l

{-# INLINE cuCtxGetLimit #-}
cuCtxGetLimit :: (Limit) -> IO ((Status), (Int))
cuCtxGetLimit :: Limit -> IO (Status, Int)
cuCtxGetLimit Limit
a2 =
  (Ptr CULong -> IO (Status, Int)) -> IO (Status, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (Status, Int)) -> IO (Status, Int))
-> (Ptr CULong -> IO (Status, Int)) -> IO (Status, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
a1' -> 
  let {a2' :: CInt
a2' = Limit -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Limit
a2} in 
  Ptr CULong -> CInt -> IO CInt
cuCtxGetLimit'_ Ptr CULong
a1' CInt
a2' IO CInt -> (CInt -> IO (Status, Int)) -> IO (Status, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr CULong -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CULong
a1'IO Int -> (Int -> IO (Status, Int)) -> IO (Status, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' -> 
  (Status, Int) -> IO (Status, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'')

{-# LINE 141 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- Specify the size of the call stack, for compute 2.0 devices.
--
-- Requires CUDA-3.1.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g0651954dfb9788173e60a9af7201e65a>
--
{-# INLINEABLE setLimit #-}
setLimit :: Limit -> Int -> IO ()
setLimit :: Limit -> Int -> IO ()
setLimit !Limit
l !Int
n = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Limit -> Int -> IO Status
cuCtxSetLimit Limit
l Int
n

{-# INLINE cuCtxSetLimit #-}
cuCtxSetLimit :: (Limit) -> (Int) -> IO ((Status))
cuCtxSetLimit :: Limit -> Int -> IO Status
cuCtxSetLimit Limit
a1 Int
a2 =
  let {a1' :: CInt
a1' = Limit -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Limit
a1} in 
  let {a2' :: CULong
a2' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  CInt -> CULong -> IO CInt
cuCtxSetLimit'_ CInt
a1' CULong
a2' IO CInt -> (CInt -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 162 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- On devices where the L1 cache and shared memory use the same hardware
-- resources, this function returns the preferred cache configuration for
-- the current context.
--
-- Requires CUDA-3.2.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g40b6b141698f76744dea6e39b9a25360>
--
{-# INLINEABLE getCache #-}
getCache :: IO Cache
getCache :: IO Cache
getCache = (Status, Cache) -> IO Cache
forall a. (Status, a) -> IO a
resultIfOk ((Status, Cache) -> IO Cache) -> IO (Status, Cache) -> IO Cache
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, Cache)
cuCtxGetCacheConfig

{-# INLINE cuCtxGetCacheConfig #-}
cuCtxGetCacheConfig :: IO ((Status), (Cache))
cuCtxGetCacheConfig :: IO (Status, Cache)
cuCtxGetCacheConfig =
  (Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache))
-> (Ptr CInt -> IO (Status, Cache)) -> IO (Status, Cache)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
cuCtxGetCacheConfig'_ Ptr CInt
a1' IO CInt -> (CInt -> IO (Status, Cache)) -> IO (Status, Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr CInt -> IO Cache
forall a b. (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum  Ptr CInt
a1'IO Cache -> (Cache -> IO (Status, Cache)) -> IO (Status, Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Cache
a1'' -> 
  (Status, Cache) -> IO (Status, Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Cache
a1'')

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



-- |
-- On devices where the L1 cache and shared memory use the same hardware
-- resources, this sets the preferred cache configuration for the current
-- context. This is only a preference.
--
-- Any function configuration set via
-- 'Foreign.CUDA.Driver.Exec.setCacheConfigFun' will be preferred over this
-- context-wide setting.
--
-- Requires CUDA-3.2.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g54699acf7e2ef27279d013ca2095f4a3>
--
{-# INLINEABLE setCache #-}
setCache :: Cache -> IO ()
setCache :: Cache -> IO ()
setCache !Cache
c = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cache -> IO Status
cuCtxSetCacheConfig Cache
c

{-# INLINE cuCtxSetCacheConfig #-}
cuCtxSetCacheConfig :: (Cache) -> IO ((Status))
cuCtxSetCacheConfig :: Cache -> IO Status
cuCtxSetCacheConfig Cache
a1 =
  let {a1' :: CInt
a1' = Cache -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum Cache
a1} in 
  CInt -> IO CInt
cuCtxSetCacheConfig'_ CInt
a1' IO CInt -> (CInt -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 210 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- Return the current size of the shared memory banks in the current
-- context. On devices with configurable shared memory banks,
-- 'setSharedMem' can be used to change the configuration, so that
-- subsequent kernel launches will by default us the new bank size. On
-- devices without configurable shared memory, this function returns the
-- fixed bank size of the hardware.
--
-- Requires CUDA-4.2
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g17153a1b8b8c756f7ab8505686a4ad74>
--
{-# INLINEABLE getSharedMem #-}
getSharedMem :: IO SharedMem
getSharedMem :: IO SharedMem
getSharedMem = (Status, SharedMem) -> IO SharedMem
forall a. (Status, a) -> IO a
resultIfOk ((Status, SharedMem) -> IO SharedMem)
-> IO (Status, SharedMem) -> IO SharedMem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Status, SharedMem)
cuCtxGetSharedMemConfig

{-# INLINE cuCtxGetSharedMemConfig #-}
cuCtxGetSharedMemConfig :: IO ((Status), (SharedMem))
cuCtxGetSharedMemConfig :: IO (Status, SharedMem)
cuCtxGetSharedMemConfig =
  (Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem))
-> (Ptr CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  Ptr CInt -> IO CInt
cuCtxGetSharedMemConfig'_ Ptr CInt
a1' IO CInt
-> (CInt -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr CInt -> IO SharedMem
forall a b. (Enum a, Integral b, Storable b) => Ptr b -> IO a
peekEnum  Ptr CInt
a1'IO SharedMem
-> (SharedMem -> IO (Status, SharedMem)) -> IO (Status, SharedMem)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SharedMem
a1'' -> 
  (Status, SharedMem) -> IO (Status, SharedMem)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', SharedMem
a1'')

{-# LINE 236 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



-- |
-- On devices with configurable shared memory banks, this function will set
-- the context's shared memory bank size that will be used by default for
-- subsequent kernel launches.
--
-- Changing the shared memory configuration between launches may insert
-- a device synchronisation.
--
-- Shared memory bank size does not affect shared memory usage or kernel
-- occupancy, but may have major effects on performance. Larger bank sizes
-- allow for greater potential bandwidth to shared memory, but change the
-- kinds of accesses which result in bank conflicts.
--
-- Requires CUDA-4.2
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g2574235fa643f8f251bf7bc28fac3692>
--
{-# INLINEABLE setSharedMem #-}
setSharedMem :: SharedMem -> IO ()
setSharedMem :: SharedMem -> IO ()
setSharedMem !SharedMem
c = Status -> IO ()
nothingIfOk (Status -> IO ()) -> IO Status -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SharedMem -> IO Status
cuCtxSetSharedMemConfig SharedMem
c

{-# INLINE cuCtxSetSharedMemConfig #-}
cuCtxSetSharedMemConfig :: (SharedMem) -> IO ((Status))
cuCtxSetSharedMemConfig :: SharedMem -> IO Status
cuCtxSetSharedMemConfig SharedMem
a1 =
  let {a1' :: CInt
a1' = SharedMem -> CInt
forall e i. (Enum e, Integral i) => e -> i
cFromEnum SharedMem
a1} in 
  CInt -> IO CInt
cuCtxSetSharedMemConfig'_ CInt
a1' IO CInt -> (CInt -> IO Status) -> IO Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Status -> IO Status
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res')

{-# LINE 266 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}




-- |
-- Returns the numerical values that correspond to the greatest and least
-- priority execution streams in the current context respectively. Stream
-- priorities follow the convention that lower numerical numbers correspond
-- to higher priorities. The range of meaningful stream priorities is given
-- by the inclusive range [greatestPriority,leastPriority].
--
-- Requires CUDA-5.5.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__CTX.html#group__CUDA__CTX_1g137920ab61a71be6ce67605b9f294091>
--
{-# INLINEABLE getStreamPriorityRange #-}
getStreamPriorityRange :: IO (StreamPriority, StreamPriority)
getStreamPriorityRange :: IO (Int, Int)
getStreamPriorityRange = do
  (Status
r,Int
l,Int
h) <- IO (Status, Int, Int)
cuCtxGetStreamPriorityRange
  (Status, (Int, Int)) -> IO (Int, Int)
forall a. (Status, a) -> IO a
resultIfOk (Status
r, (Int
h,Int
l))

{-# INLINE cuCtxGetStreamPriorityRange #-}
cuCtxGetStreamPriorityRange :: IO ((Status), (Int), (Int))
cuCtxGetStreamPriorityRange :: IO (Status, Int, Int)
cuCtxGetStreamPriorityRange =
  (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int))
-> (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a1' -> 
  (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int))
-> (Ptr CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
a2' -> 
  Ptr CInt -> Ptr CInt -> IO CInt
cuCtxGetStreamPriorityRange'_ Ptr CInt
a1' Ptr CInt
a2' IO CInt -> (CInt -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Status
res' = CInt -> Status
forall i e. (Integral i, Enum e) => i -> e
cToEnum CInt
res} in
  Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CInt
a1'IO Int -> (Int -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a1'' -> 
  Ptr CInt -> IO Int
forall a b. (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv  Ptr CInt
a2'IO Int -> (Int -> IO (Status, Int, Int)) -> IO (Status, Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
a2'' -> 
  (Status, Int, Int) -> IO (Status, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Status
res', Int
a1'', Int
a2'')

{-# LINE 296 "src/Foreign/CUDA/Driver/Context/Config.chs" #-}



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

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxGetLimit"
  cuCtxGetLimit'_ :: ((C2HSImp.Ptr C2HSImp.CULong) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetLimit"
  cuCtxSetLimit'_ :: (C2HSImp.CInt -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))

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

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetCacheConfig"
  cuCtxSetCacheConfig'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

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

foreign import ccall unsafe "Foreign/CUDA/Driver/Context/Config.chs.h cuCtxSetSharedMemConfig"
  cuCtxSetSharedMemConfig'_ :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

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