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


{-# LINE 1 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# OPTIONS_HADDOCK prune #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Module.Base
-- Copyright : [2009..2023] Trevor L. McDonell
-- License   : BSD
--
-- Module loading for low-level driver interface
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Module.Base (

  -- * Module Management
  Module(..),
  JITOption(..), JITTarget(..), JITResult(..), JITFallback(..), JITInputType(..),
  JITOptionInternal(..),

  -- ** Loading and unloading modules
  loadFile,
  loadData,   loadDataFromPtr,
  loadDataEx, loadDataFromPtrEx,
  unload,

  -- Internal
  jitOptionUnpack, jitTargetOfCompute,

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





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


-- Friends
import Foreign.CUDA.Analysis.Device
import Foreign.CUDA.Driver.Error
import Foreign.CUDA.Internal.C2HS
import Foreign.C.Extra

-- System
import Foreign
import Foreign.C
import Unsafe.Coerce

import Control.Monad                                    ( liftM )
import Data.ByteString.Char8                            ( ByteString )
import qualified Data.ByteString.Char8                  as B
import qualified Data.ByteString.Internal               as B


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

-- |
-- A reference to a Module object, containing collections of device functions
--
newtype Module = Module { Module -> Ptr ()
useModule :: ((C2HSImp.Ptr ()))}
  deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
/= :: Module -> Module -> Bool
Eq, Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Module -> ShowS
showsPrec :: Int -> Module -> ShowS
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> ShowS
showList :: [Module] -> ShowS
Show)

-- |
-- Just-in-time compilation and linking options
--
data JITOption
  = MaxRegisters       !Int             -- ^ maximum number of registers per thread
  | ThreadsPerBlock    !Int             -- ^ number of threads per block to target for
  | OptimisationLevel  !Int             -- ^ level of optimisation to apply (1-4, default 4)
  | Target             !Compute         -- ^ compilation target, otherwise determined from context
  | FallbackStrategy   !JITFallback     -- ^ fallback strategy if matching cubin not found
  | GenerateDebugInfo                   -- ^ generate debug info (-g) (requires cuda >= 5.5)
  | GenerateLineInfo                    -- ^ generate line number information (-lineinfo) (requires cuda >= 5.5)
  | Verbose                             -- ^ verbose log messages (requires cuda >= 5.5)
  deriving (Int -> JITOption -> ShowS
[JITOption] -> ShowS
JITOption -> String
(Int -> JITOption -> ShowS)
-> (JITOption -> String)
-> ([JITOption] -> ShowS)
-> Show JITOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JITOption -> ShowS
showsPrec :: Int -> JITOption -> ShowS
$cshow :: JITOption -> String
show :: JITOption -> String
$cshowList :: [JITOption] -> ShowS
showList :: [JITOption] -> ShowS
Show)

-- |
-- Results of online compilation
--
data JITResult = JITResult
  {
    JITResult -> Float
jitTime     :: !Float,              -- ^ milliseconds spent compiling PTX
    JITResult -> ByteString
jitInfoLog  :: !ByteString,         -- ^ information about PTX assembly
    JITResult -> Module
jitModule   :: !Module              -- ^ the compiled module
  }
  deriving (Int -> JITResult -> ShowS
[JITResult] -> ShowS
JITResult -> String
(Int -> JITResult -> ShowS)
-> (JITResult -> String)
-> ([JITResult] -> ShowS)
-> Show JITResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JITResult -> ShowS
showsPrec :: Int -> JITResult -> ShowS
$cshow :: JITResult -> String
show :: JITResult -> String
$cshowList :: [JITResult] -> ShowS
showList :: [JITResult] -> ShowS
Show)


-- |
-- Online compilation target architecture
--
data JITTarget = Compute20
               | Compute21
               | Compute30
               | Compute32
               | Compute35
               | Compute37
               | Compute50
               | Compute52
               | Compute53
               | Compute60
               | Compute61
               | Compute62
               | Compute70
               | Compute72
               | Compute75
               | Compute80
               | Compute86
               | Compute87
               | Compute89
               | Compute90
  deriving (Eq,Show)
instance Enum JITTarget where
  succ Compute20 = Compute21
  succ Compute21 = Compute30
  succ :: JITInputType -> JITInputType
succ Compute30 = Compute32
  succ Compute32 = Compute35
  succ JITInputType
Compute35 = Compute37
  succ Compute37 = Compute50
  succ Compute50 = Compute52
  succ Compute52 = Compute53
  succ Compute53 = Compute60
  succ Compute60 = Compute61
  pred :: JITInputType -> JITInputType
succ Compute61 = Compute62
  succ JITInputType
Compute62 = Compute70
  succ Compute70 = Compute72
  succ Compute72 = Compute75
  succ Compute75 = Compute80
  succ Compute80 = Compute86
  succ Compute86 = Compute87
  succ Compute87 = Compute89
  succ Compute89 = Compute90
  succ Compute90 = error "JITTarget.succ: Compute90 has no successor"

  pred Compute21 = Compute20
  pred Compute30 = Compute21
  pred Compute32 = Compute30
  pred Compute35 = Compute32
  pred Compute37 = Compute35
  pred Compute50 = Compute37
  pred Compute52 = Compute50
  pred Compute53 = Compute52
  pred Compute60 = Compute53
  pred Compute61 = Compute60
  pred Compute62 = Compute61
  pred Compute70 = Compute62
  pred Compute72 = Compute70
  pred Compute75 = Compute72
  succ :: JITOptionInternal -> JITOptionInternal
pred Compute80 = Compute75
  pred Compute86 = Compute80
  pred Compute87 = Compute86
  pred Compute89 = Compute87
  pred Compute90 = Compute89
  pred Compute20 = error "JITTarget.pred: Compute20 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 Compute90

  fromEnum Compute20 = 20
  fromEnum Compute21 = 21
  fromEnum Compute30 = 30
  fromEnum Compute32 = 32
  fromEnum Compute35 = 35
  fromEnum Compute37 = 37
  fromEnum Compute50 = 50
  fromEnum Compute52 = 52
  fromEnum Compute53 = 53
  fromEnum Compute60 = 60
  fromEnum Compute61 = 61
  fromEnum Compute62 = 62
  fromEnum Compute70 = 70
  fromEnum Compute72 = 72
  fromEnum Compute75 = 75
  fromEnum Compute80 = 80
  fromEnum Compute86 = 86
  fromEnum Compute87 = 87
  fromEnum Compute89 = 89
  fromEnum Compute90 = 90

  toEnum :: Int -> JITTarget
toEnum Int
20 = JITTarget
Compute20
  toEnum Int
21 = JITTarget
Compute21
  toEnum 30 = JITTarget
Compute30
  toEnum Int
32 = JITTarget
Compute32
  toEnum Int
35 = JITTarget
Compute35
  toEnum 37 = JITTarget
Compute37
  toEnum Int
50 = JITTarget
Compute50
  toEnum 52 = JITTarget
Compute52
  toEnum 53 = Compute53
  toEnum 60 = Compute60
  toEnum Int
61 = JITTarget
Compute61
  toEnum Int
62 = JITTarget
Compute62
  toEnum Int
70 = JITTarget
Compute70
  toEnum 72 = JITTarget
Compute72
  toEnum 75 = JITTarget
Compute75
  toEnum 80 = JITTarget
Compute80
  toEnum 86 = JITTarget
Compute86
  toEnum 87 = JITTarget
Compute87
  toEnum Int
89 = JITTarget
Compute89
  toEnum Int
90 = JITTarget
Compute90
  toEnum unmatched = error ("JITTarget.toEnum: Cannot match " ++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 96 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}


-- |
-- Online compilation fallback strategy
--
data JITFallback = PreferPTX
                 | PreferBinary
  deriving (Eq,Show)
instance Enum JITFallback where
  succ PreferPTX = PreferBinary
  succ PreferBinary = error "JITFallback.succ: PreferBinary has no successor"

  pred PreferBinary = PreferPTX
  pred PreferPTX = error "JITFallback.pred: PreferPTX 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 PreferBinary

  fromEnum PreferPTX = 0
  fromEnum PreferBinary = 1

  toEnum 0 = PreferPTX
  toEnum 1 = PreferBinary
  toEnum unmatched = error ("JITFallback.toEnum: Cannot match " ++ show unmatched)

{-# LINE 104 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}


-- |
-- Device code formats that can be used for online linking
--
data JITInputType = Cubin
                  | PTX
                  | Fatbinary
                  | Object
                  | Library
                  | Nvvm
                  | CuJitNumInputTypes
  deriving (Eq,Show)
instance Enum JITInputType where
  succ Cubin = PTX
  succ PTX = Fatbinary
  succ Fatbinary = Object
  succ Object = Library
  succ Library = Nvvm
  succ Nvvm = CuJitNumInputTypes
  succ CuJitNumInputTypes = error "JITInputType.succ: CuJitNumInputTypes has no successor"

  pred PTX = Cubin
  pred Fatbinary = PTX
  pred Object = Fatbinary
  pred Library = Object
  pred Nvvm = Library
  pred CuJitNumInputTypes = Nvvm
  pred Cubin = error "JITInputType.pred: Cubin 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 CuJitNumInputTypes

  fromEnum Cubin = 0
  fromEnum PTX = 1
  fromEnum Fatbinary = 2
  fromEnum Object = 3
  fromEnum Library = 4
  fromEnum Nvvm = 5
  fromEnum CuJitNumInputTypes = 6

  toEnum 0 = Cubin
  toEnum 1 = PTX
  toEnum 2 = Fatbinary
  toEnum 3 = Object
  toEnum 4 = Library
  toEnum 5 = Nvvm
  toEnum 6 = CuJitNumInputTypes
  toEnum unmatched = error ("JITInputType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 116 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}


data JITOptionInternal = JIT_MAX_REGISTERS
                       | JIT_THREADS_PER_BLOCK
                       | JIT_WALL_TIME
                       | JIT_INFO_LOG_BUFFER
                       | JIT_INFO_LOG_BUFFER_SIZE_BYTES
                       | JIT_ERROR_LOG_BUFFER
                       | JIT_ERROR_LOG_BUFFER_SIZE_BYTES
                       | JIT_OPTIMIZATION_LEVEL
                       | JIT_TARGET_FROM_CUCONTEXT
                       | JIT_TARGET
                       | JIT_FALLBACK_STRATEGY
                       | JIT_GENERATE_DEBUG_INFO
                       | JIT_LOG_VERBOSE
                       | JIT_GENERATE_LINE_INFO
                       | JIT_CACHE_MODE
                       | JIT_NEW_SM3X_OPT
                       | JIT_FAST_COMPILE
                       | JIT_GLOBAL_SYMBOL_NAMES
                       | JIT_GLOBAL_SYMBOL_ADDRESSES
                       | JIT_GLOBAL_SYMBOL_COUNT
                       | JIT_LTO
                       | JIT_FTZ
                       | JIT_PREC_DIV
                       | JIT_PREC_SQRT
                       | JIT_FMA
                       | JIT_REFERENCED_KERNEL_NAMES
                       | JIT_REFERENCED_KERNEL_COUNT
                       | JIT_REFERENCED_VARIABLE_NAMES
                       | JIT_REFERENCED_VARIABLE_COUNT
                       | JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES
                       | JIT_NUM_OPTIONS
  deriving (Eq,Show)
instance Enum JITOptionInternal where
  succ JIT_MAX_REGISTERS = JIT_THREADS_PER_BLOCK
  succ JIT_THREADS_PER_BLOCK = JIT_WALL_TIME
  succ JIT_WALL_TIME = JIT_INFO_LOG_BUFFER
  succ JIT_INFO_LOG_BUFFER = JIT_INFO_LOG_BUFFER_SIZE_BYTES
  succ JIT_INFO_LOG_BUFFER_SIZE_BYTES = JIT_ERROR_LOG_BUFFER
  succ JIT_ERROR_LOG_BUFFER = JIT_ERROR_LOG_BUFFER_SIZE_BYTES
  succ JIT_ERROR_LOG_BUFFER_SIZE_BYTES = JIT_OPTIMIZATION_LEVEL
  succ JIT_OPTIMIZATION_LEVEL = JIT_TARGET_FROM_CUCONTEXT
  succ JIT_TARGET_FROM_CUCONTEXT = JIT_TARGET
  succ JIT_TARGET = JIT_FALLBACK_STRATEGY
  succ JIT_FALLBACK_STRATEGY = JIT_GENERATE_DEBUG_INFO
  succ JIT_GENERATE_DEBUG_INFO = JIT_LOG_VERBOSE
  succ JIT_LOG_VERBOSE = JIT_GENERATE_LINE_INFO
  succ JIT_GENERATE_LINE_INFO = JIT_CACHE_MODE
  succ JIT_CACHE_MODE = JIT_NEW_SM3X_OPT
  succ JIT_NEW_SM3X_OPT = JIT_FAST_COMPILE
  succ JIT_FAST_COMPILE = JIT_GLOBAL_SYMBOL_NAMES
  succ JIT_GLOBAL_SYMBOL_NAMES = JIT_GLOBAL_SYMBOL_ADDRESSES
  succ JIT_GLOBAL_SYMBOL_ADDRESSES = JIT_GLOBAL_SYMBOL_COUNT
  succ JIT_GLOBAL_SYMBOL_COUNT = JIT_LTO
  succ JIT_LTO = JIT_FTZ
  succ JIT_FTZ = JIT_PREC_DIV
  succ JIT_PREC_DIV = JIT_PREC_SQRT
  succ JIT_PREC_SQRT = JIT_FMA
  succ JIT_FMA = JIT_REFERENCED_KERNEL_NAMES
  succ JIT_REFERENCED_KERNEL_NAMES = JIT_REFERENCED_KERNEL_COUNT
  succ JIT_REFERENCED_KERNEL_COUNT = JIT_REFERENCED_VARIABLE_NAMES
  succ JIT_REFERENCED_VARIABLE_NAMES = JIT_REFERENCED_VARIABLE_COUNT
  succ JIT_REFERENCED_VARIABLE_COUNT = JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES
  succ JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES = JIT_NUM_OPTIONS
  succ JIT_NUM_OPTIONS = error "JITOptionInternal.succ: JIT_NUM_OPTIONS has no successor"

  pred :: JITOptionInternal -> JITOptionInternal
pred JITOptionInternal
JIT_THREADS_PER_BLOCK = JITOptionInternal
JIT_MAX_REGISTERS
  pred JITOptionInternal
JIT_WALL_TIME = JITOptionInternal
JIT_THREADS_PER_BLOCK
  pred JIT_INFO_LOG_BUFFER = JIT_WALL_TIME
  pred JIT_INFO_LOG_BUFFER_SIZE_BYTES = JIT_INFO_LOG_BUFFER
  pred JITOptionInternal
JIT_ERROR_LOG_BUFFER = JITOptionInternal
JIT_INFO_LOG_BUFFER_SIZE_BYTES
  pred JITOptionInternal
JIT_ERROR_LOG_BUFFER_SIZE_BYTES = JITOptionInternal
JIT_ERROR_LOG_BUFFER
  pred JITOptionInternal
JIT_OPTIMIZATION_LEVEL = JITOptionInternal
JIT_ERROR_LOG_BUFFER_SIZE_BYTES
  pred JITOptionInternal
JIT_TARGET_FROM_CUCONTEXT = JITOptionInternal
JIT_OPTIMIZATION_LEVEL
  pred JITOptionInternal
JIT_TARGET = JITOptionInternal
JIT_TARGET_FROM_CUCONTEXT
  pred JITOptionInternal
JIT_FALLBACK_STRATEGY = JITOptionInternal
JIT_TARGET
  pred JITOptionInternal
JIT_GENERATE_DEBUG_INFO = JITOptionInternal
JIT_FALLBACK_STRATEGY
  pred JITOptionInternal
JIT_LOG_VERBOSE = JITOptionInternal
JIT_GENERATE_DEBUG_INFO
  pred JITOptionInternal
JIT_GENERATE_LINE_INFO = JITOptionInternal
JIT_LOG_VERBOSE
  pred JITOptionInternal
JIT_CACHE_MODE = JITOptionInternal
JIT_GENERATE_LINE_INFO
  pred JITOptionInternal
JIT_NEW_SM3X_OPT = JITOptionInternal
JIT_CACHE_MODE
  pred JITOptionInternal
JIT_FAST_COMPILE = JITOptionInternal
JIT_NEW_SM3X_OPT
  pred JITOptionInternal
JIT_GLOBAL_SYMBOL_NAMES = JITOptionInternal
JIT_FAST_COMPILE
  pred JITOptionInternal
JIT_GLOBAL_SYMBOL_ADDRESSES = JITOptionInternal
JIT_GLOBAL_SYMBOL_NAMES
  pred JITOptionInternal
JIT_GLOBAL_SYMBOL_COUNT = JITOptionInternal
JIT_GLOBAL_SYMBOL_ADDRESSES
  pred JITOptionInternal
JIT_LTO = JITOptionInternal
JIT_GLOBAL_SYMBOL_COUNT
  pred JITOptionInternal
JIT_FTZ = JITOptionInternal
JIT_LTO
  pred JITOptionInternal
JIT_PREC_DIV = JITOptionInternal
JIT_FTZ
  pred JITOptionInternal
JIT_PREC_SQRT = JITOptionInternal
JIT_PREC_DIV
  pred JITOptionInternal
JIT_FMA = JITOptionInternal
JIT_PREC_SQRT
  pred JITOptionInternal
JIT_REFERENCED_KERNEL_NAMES = JITOptionInternal
JIT_FMA
  pred JITOptionInternal
JIT_REFERENCED_KERNEL_COUNT = JITOptionInternal
JIT_REFERENCED_KERNEL_NAMES
  pred JITOptionInternal
JIT_REFERENCED_VARIABLE_NAMES = JITOptionInternal
JIT_REFERENCED_KERNEL_COUNT
  pred JITOptionInternal
JIT_REFERENCED_VARIABLE_COUNT = JITOptionInternal
JIT_REFERENCED_VARIABLE_NAMES
  pred JITOptionInternal
JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES = JITOptionInternal
JIT_REFERENCED_VARIABLE_COUNT
  pred JITOptionInternal
JIT_NUM_OPTIONS = JITOptionInternal
JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES
  pred JITOptionInternal
JIT_MAX_REGISTERS = String -> JITOptionInternal
forall a. HasCallStack => String -> a
error String
"JITOptionInternal.pred: JIT_MAX_REGISTERS 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 JIT_NUM_OPTIONS

  fromEnum JIT_MAX_REGISTERS = 0
  fromEnum JIT_THREADS_PER_BLOCK = 1
  fromEnum JIT_WALL_TIME = 2
  fromEnum JIT_INFO_LOG_BUFFER = 3
  fromEnum JIT_INFO_LOG_BUFFER_SIZE_BYTES = 4
  fromEnum JIT_ERROR_LOG_BUFFER = 5
  fromEnum JIT_ERROR_LOG_BUFFER_SIZE_BYTES = 6
  fromEnum JIT_OPTIMIZATION_LEVEL = 7
  fromEnum JIT_TARGET_FROM_CUCONTEXT = 8
  fromEnum JIT_TARGET = 9
  fromEnum JIT_FALLBACK_STRATEGY = 10
  fromEnum JIT_GENERATE_DEBUG_INFO = 11
  fromEnum JIT_LOG_VERBOSE = 12
  fromEnum JIT_GENERATE_LINE_INFO = 13
  fromEnum JIT_CACHE_MODE = 14
  fromEnum JIT_NEW_SM3X_OPT = 15
  fromEnum JIT_FAST_COMPILE = 16
  fromEnum JIT_GLOBAL_SYMBOL_NAMES = 17
  fromEnum JIT_GLOBAL_SYMBOL_ADDRESSES = 18
  fromEnum JIT_GLOBAL_SYMBOL_COUNT = 19
  fromEnum JIT_LTO = 20
  fromEnum JIT_FTZ = 21
  fromEnum JIT_PREC_DIV = 22
  fromEnum JIT_PREC_SQRT = 23
  fromEnum JIT_FMA = 24
  fromEnum JIT_REFERENCED_KERNEL_NAMES = 25
  fromEnum JIT_REFERENCED_KERNEL_COUNT = 26
  fromEnum JIT_REFERENCED_VARIABLE_NAMES = 27
  fromEnum JIT_REFERENCED_VARIABLE_COUNT = 28
  fromEnum JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES = 29
  fromEnum JIT_NUM_OPTIONS = 30

  toEnum 0 = JIT_MAX_REGISTERS
  toEnum 1 = JIT_THREADS_PER_BLOCK
  toEnum 2 = JIT_WALL_TIME
  toEnum 3 = JIT_INFO_LOG_BUFFER
  toEnum 4 = JIT_INFO_LOG_BUFFER_SIZE_BYTES
  toEnum 5 = JIT_ERROR_LOG_BUFFER
  toEnum 6 = JIT_ERROR_LOG_BUFFER_SIZE_BYTES
  toEnum 7 = JIT_OPTIMIZATION_LEVEL
  toEnum 8 = JIT_TARGET_FROM_CUCONTEXT
  toEnum 9 = JIT_TARGET
  toEnum 10 = JIT_FALLBACK_STRATEGY
  toEnum 11 = JIT_GENERATE_DEBUG_INFO
  toEnum 12 = JIT_LOG_VERBOSE
  toEnum 13 = JIT_GENERATE_LINE_INFO
  toEnum 14 = JIT_CACHE_MODE
  toEnum 15 = JIT_NEW_SM3X_OPT
  toEnum 16 = JIT_FAST_COMPILE
  toEnum 17 = JIT_GLOBAL_SYMBOL_NAMES
  toEnum 18 = JIT_GLOBAL_SYMBOL_ADDRESSES
  toEnum 19 = JIT_GLOBAL_SYMBOL_COUNT
  toEnum 20 = JIT_LTO
  toEnum 21 = JIT_FTZ
  toEnum 22 = JIT_PREC_DIV
  toEnum 23 = JIT_PREC_SQRT
  toEnum 24 = JIT_FMA
  toEnum 25 = JIT_REFERENCED_KERNEL_NAMES
  toEnum 26 = JIT_REFERENCED_KERNEL_COUNT
  toEnum 27 = JIT_REFERENCED_VARIABLE_NAMES
  toEnum 28 = JIT_REFERENCED_VARIABLE_COUNT
  toEnum 29 = JIT_OPTIMIZE_UNUSED_DEVICE_VARIABLES
  toEnum 30 = JIT_NUM_OPTIONS
  toEnum unmatched = error ("JITOptionInternal.toEnum: Cannot match " ++ show unmatched)

{-# LINE 120 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}



--------------------------------------------------------------------------------
-- Module management
--------------------------------------------------------------------------------

-- |
-- Load the contents of the specified file (either a ptx or cubin file) to
-- create a new module, and load that module into the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g366093bd269dafd0af21f1c7d18115d3>
--
{-# INLINEABLE loadFile #-}
loadFile :: FilePath -> IO Module
loadFile !ptx = resultIfOk =<< cuModuleLoad ptx

{-# INLINE cuModuleLoad #-}
cuModuleLoad :: (FilePath) -> IO ((Status), (Module))
cuModuleLoad a2 =
  alloca $ \a1' -> 
  withCString a2 $ \a2' -> 
  cuModuleLoad'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekMod  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 140 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}



-- |
-- Load the contents of the given image into a new module, and load that module
-- into the current context. The image is (typically) the contents of a cubin or
-- PTX file.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g04ce266ce03720f479eab76136b90c0b>
--
{-# INLINEABLE loadData #-}
loadData :: ByteString -> IO Module
loadData !img =
  B.useAsCString img (\p -> loadDataFromPtr (castPtr p))

-- |
-- As 'loadData', but read the image data from the given pointer. The image is a
-- NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtr #-}
loadDataFromPtr :: Ptr Word8 -> IO Module
loadDataFromPtr !img = resultIfOk =<< cuModuleLoadData img

{-# INLINE cuModuleLoadData #-}
cuModuleLoadData :: (Ptr Word8) -> IO (( Status), (Module))
cuModuleLoadData a2 =
  alloca $ \a1' -> 
  let {a2' = castPtr a2} in 
  cuModuleLoadData'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  peekMod  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 169 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}



-- |
-- Load the contents of the given image into a module with online compiler
-- options, and load the module into the current context. The image is
-- (typically) the contents of a cubin or PTX file. The actual attributes of the
-- compiled kernel can be probed using 'requires'.
--
-- Note that the 'ByteString' will be copied into a temporary staging area so
-- that it can be passed to C.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g9e8047e9dbf725f0cd7cafd18bfd4d12>
--
{-# INLINEABLE loadDataEx #-}
loadDataEx :: ByteString -> [JITOption] -> IO JITResult
loadDataEx !img !options =
  B.useAsCString img (\p -> loadDataFromPtrEx (castPtr p) options)

-- |
-- As 'loadDataEx', but read the image data from the given pointer. The image is
-- a NULL-terminated sequence of bytes.
--
{-# INLINEABLE loadDataFromPtrEx #-}
loadDataFromPtrEx :: Ptr Word8 -> [JITOption] -> IO JITResult
loadDataFromPtrEx !img !options = do
  let logSize = 2048

  fp_ilog <- B.mallocByteString logSize

  allocaArray logSize    $ \p_elog -> do
  withForeignPtr fp_ilog $ \p_ilog -> do

  let (opt,val) = unzip $
        [ (JIT_WALL_TIME, 0) -- must be first, this is extracted below
        , (JIT_INFO_LOG_BUFFER_SIZE_BYTES,  logSize)
        , (JIT_ERROR_LOG_BUFFER_SIZE_BYTES, logSize)
        , (JIT_INFO_LOG_BUFFER,  unsafeCoerce (p_ilog :: CString))
        , (JIT_ERROR_LOG_BUFFER, unsafeCoerce (p_elog :: CString))
        ]
        ++
        map jitOptionUnpack options

  withArrayLen (map cFromEnum opt)    $ \i p_opts -> do
  withArray    (map unsafeCoerce val) $ \  p_vals -> do

  (s,mdl) <- cuModuleLoadDataEx img i p_opts p_vals

  case s of
    Success -> do
      time    <- peek (castPtr p_vals)
      bytes   <- c_strnlen p_ilog logSize
      let infoLog | bytes == 0 = B.empty
                  | otherwise  = B.fromForeignPtr (castForeignPtr fp_ilog) 0 bytes
      return  $! JITResult time infoLog mdl

    _       -> do
      errLog  <- peekCString p_elog
      cudaErrorIO (unlines [describe s, errLog])


{-# INLINE cuModuleLoadDataEx #-}
cuModuleLoadDataEx :: (Ptr Word8) -> (Int) -> (Ptr CInt) -> (Ptr (Ptr ())) -> IO ((Status), (Module))
cuModuleLoadDataEx a2 a3 a4 a5 =
  alloca $ \a1' -> 
  let {a2' = castPtr a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  cuModuleLoadDataEx'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = cToEnum res} in
  peekMod  a1'>>= \a1'' -> 
  return (res', a1'')

{-# LINE 236 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}



-- |
-- Unload a module from the current context.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__MODULE.html#group__CUDA__MODULE_1g8ea3d716524369de3763104ced4ea57b>
--
{-# INLINEABLE unload #-}
unload :: Module -> IO ()
unload !m = nothingIfOk =<< cuModuleUnload m

{-# INLINE cuModuleUnload #-}
cuModuleUnload :: (Module) -> IO ((Status))
cuModuleUnload a1 =
  let {a1' = useModule a1} in 
  cuModuleUnload'_ a1' >>= \res ->
  let {res' = cToEnum res} in
  return (res')

{-# LINE 250 "src/Foreign/CUDA/Driver/Module/Base.chs" #-}



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

{-# INLINE peekMod #-}
peekMod :: Ptr ((C2HSImp.Ptr ())) -> IO Module
peekMod = liftM Module . peek


{-# INLINE jitOptionUnpack #-}
jitOptionUnpack :: JITOption -> (JITOptionInternal, Int)
jitOptionUnpack (MaxRegisters x)      = (JIT_MAX_REGISTERS,       x)
jitOptionUnpack (ThreadsPerBlock x)   = (JIT_THREADS_PER_BLOCK,   x)
jitOptionUnpack (OptimisationLevel x) = (JIT_OPTIMIZATION_LEVEL,  x)
jitOptionUnpack (Target x)            = (JIT_TARGET,              fromEnum (jitTargetOfCompute x))
jitOptionUnpack (FallbackStrategy x)  = (JIT_FALLBACK_STRATEGY,   fromEnum x)
jitOptionUnpack GenerateDebugInfo     = (JIT_GENERATE_DEBUG_INFO, fromEnum True)
jitOptionUnpack GenerateLineInfo      = (JIT_GENERATE_LINE_INFO,  fromEnum True)
jitOptionUnpack Verbose               = (JIT_LOG_VERBOSE,         fromEnum True)


{-# INLINE jitTargetOfCompute #-}
jitTargetOfCompute :: Compute -> JITTarget
jitTargetOfCompute (Compute x y) = toEnum (10*x + y)


foreign import ccall unsafe "Foreign/CUDA/Driver/Module/Base.chs.h cuModuleLoad"
  cuModuleLoad'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

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

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

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