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

module Foreign.CUDA.Driver.Device (

  -- * Device Management
  Device(..),
  DeviceProperties(..), DeviceAttribute(..), Compute(..), ComputeMode(..), InitFlag,
  initialise, capability, device, attribute, count, name, props, uuid, totalMem,

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





{-# LINE 30 "src/Foreign/CUDA/Driver/Device.chs" #-}


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

-- System
import Control.Applicative
import Control.Monad                                    ( liftM )
import Data.Bits
import Data.UUID.Types
import Foreign
import Foreign.C
import Prelude


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

-- |
-- A CUDA device
--
newtype Device = Device { Device -> CInt
useDevice :: (C2HSImp.CInt)}
  deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
/= :: Device -> Device -> Bool
Eq, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Device -> ShowS
showsPrec :: Int -> Device -> ShowS
$cshow :: Device -> String
show :: Device -> String
$cshowList :: [Device] -> ShowS
showList :: [Device] -> ShowS
Show)


-- |
-- Device attributes
--
data DeviceAttribute = MaxThreadsPerBlock
                     | MaxBlockDimX
                     | MaxBlockDimY
                     | MaxBlockDimZ
                     | MaxGridDimX
                     | MaxGridDimY
                     | MaxGridDimZ
                     | MaxSharedMemoryPerBlock
                     | SharedMemoryPerBlock
                     | TotalConstantMemory
                     | WarpSize
                     | MaxPitch
                     | MaxRegistersPerBlock
                     | RegistersPerBlock
                     | ClockRate
                     | TextureAlignment
                     | GpuOverlap
                     | MultiprocessorCount
                     | KernelExecTimeout
                     | Integrated
                     | CanMapHostMemory
                     | ComputeMode
                     | MaximumTexture1dWidth
                     | MaximumTexture2dWidth
                     | MaximumTexture2dHeight
                     | MaximumTexture3dWidth
                     | MaximumTexture3dHeight
                     | MaximumTexture3dDepth
                     | MaximumTexture2dLayeredWidth
                     | MaximumTexture2dArrayWidth
                     | MaximumTexture2dLayeredHeight
                     | MaximumTexture2dArrayHeight
                     | MaximumTexture2dLayeredLayers
                     | MaximumTexture2dArrayNumslices
                     | SurfaceAlignment
                     | ConcurrentKernels
                     | EccEnabled
                     | PciBusId
                     | PciDeviceId
                     | TccDriver
                     | MemoryClockRate
                     | GlobalMemoryBusWidth
                     | L2CacheSize
                     | MaxThreadsPerMultiprocessor
                     | AsyncEngineCount
                     | UnifiedAddressing
                     | MaximumTexture1dLayeredWidth
                     | MaximumTexture1dLayeredLayers
                     | CanTex2dGather
                     | MaximumTexture2dGatherWidth
                     | MaximumTexture2dGatherHeight
                     | MaximumTexture3dWidthAlternate
                     | MaximumTexture3dHeightAlternate
                     | MaximumTexture3dDepthAlternate
                     | PciDomainId
                     | TexturePitchAlignment
                     | MaximumTexturecubemapWidth
                     | MaximumTexturecubemapLayeredWidth
                     | MaximumTexturecubemapLayeredLayers
                     | MaximumSurface1dWidth
                     | MaximumSurface2dWidth
                     | MaximumSurface2dHeight
                     | MaximumSurface3dWidth
                     | MaximumSurface3dHeight
                     | MaximumSurface3dDepth
                     | MaximumSurface1dLayeredWidth
                     | MaximumSurface1dLayeredLayers
                     | MaximumSurface2dLayeredWidth
                     | MaximumSurface2dLayeredHeight
                     | MaximumSurface2dLayeredLayers
                     | MaximumSurfacecubemapWidth
                     | MaximumSurfacecubemapLayeredWidth
                     | MaximumSurfacecubemapLayeredLayers
                     | MaximumTexture1dLinearWidth
                     | MaximumTexture2dLinearWidth
                     | MaximumTexture2dLinearHeight
                     | MaximumTexture2dLinearPitch
                     | MaximumTexture2dMipmappedWidth
                     | MaximumTexture2dMipmappedHeight
                     | ComputeCapabilityMajor
                     | ComputeCapabilityMinor
                     | MaximumTexture1dMipmappedWidth
                     | StreamPrioritiesSupported
                     | GlobalL1CacheSupported
                     | LocalL1CacheSupported
                     | MaxSharedMemoryPerMultiprocessor
                     | MaxRegistersPerMultiprocessor
                     | ManagedMemory
                     | MultiGpuBoard
                     | MultiGpuBoardGroupId
                     | HostNativeAtomicSupported
                     | SingleToDoublePrecisionPerfRatio
                     | PageableMemoryAccess
                     | ConcurrentManagedAccess
                     | ComputePreemptionSupported
                     | CanUseHostPointerForRegisteredMem
                     | CanUseStreamMemOps
                     | CanUse64BitStreamMemOps
                     | CanUseStreamWaitValueNor
                     | CooperativeLaunch
                     | CooperativeMultiDeviceLaunch
                     | MaxSharedMemoryPerBlockOptin
                     | CanFlushRemoteWrites
                     | HostRegisterSupported
                     | PageableMemoryAccessUsesHostPageTables
                     | DirectManagedMemAccessFromHost
                     | VirtualAddressManagementSupported
                     | VirtualMemoryManagementSupported
                     | HandleTypePosixFileDescriptorSupported
                     | HandleTypeWin32HandleSupported
                     | HandleTypeWin32KmtHandleSupported
                     | MaxBlocksPerMultiprocessor
                     | GenericCompressionSupported
                     | MaxPersistingL2CacheSize
                     | MaxAccessPolicyWindowSize
                     | GpuDirectRdmaWithCudaVmmSupported
                     | ReservedSharedMemoryPerBlock
                     | SparseCudaArraySupported
                     | ReadOnlyHostRegisterSupported
                     | TimelineSemaphoreInteropSupported
                     | MemoryPoolsSupported
                     | GpuDirectRdmaSupported
                     | GpuDirectRdmaFlushWritesOptions
                     | GpuDirectRdmaWritesOrdering
                     | MempoolSupportedHandleTypes
                     | ClusterLaunch
                     | DeferredMappingCudaArraySupported
                     | CanUse64BitStreamMemOpsV2
                     | CanUseStreamWaitValueNorV2
                     | DmaBufSupported
                     | CU_DEVICE_ATTRIBUTE_MAX
  deriving (Eq,Show)
instance Enum DeviceAttribute where
  succ MaxThreadsPerBlock = MaxBlockDimX
  succ MaxBlockDimX = MaxBlockDimY
  succ MaxBlockDimY = MaxBlockDimZ
  succ MaxBlockDimZ = MaxGridDimX
  succ MaxGridDimX = MaxGridDimY
  succ MaxGridDimY = MaxGridDimZ
  succ MaxGridDimZ = MaxSharedMemoryPerBlock
  succ MaxSharedMemoryPerBlock = TotalConstantMemory
  succ SharedMemoryPerBlock = TotalConstantMemory
  succ TotalConstantMemory = WarpSize
  succ WarpSize = MaxPitch
  succ MaxPitch = MaxRegistersPerBlock
  succ MaxRegistersPerBlock = ClockRate
  succ RegistersPerBlock = ClockRate
  succ ClockRate = TextureAlignment
  succ TextureAlignment = GpuOverlap
  succ GpuOverlap = MultiprocessorCount
  succ MultiprocessorCount = KernelExecTimeout
  succ KernelExecTimeout = Integrated
  succ Integrated = CanMapHostMemory
  succ CanMapHostMemory = ComputeMode
  succ ComputeMode = MaximumTexture1dWidth
  succ MaximumTexture1dWidth = MaximumTexture2dWidth
  succ MaximumTexture2dWidth = MaximumTexture2dHeight
  succ MaximumTexture2dHeight = MaximumTexture3dWidth
  succ MaximumTexture3dWidth = MaximumTexture3dHeight
  succ MaximumTexture3dHeight = MaximumTexture3dDepth
  succ MaximumTexture3dDepth = MaximumTexture2dLayeredWidth
  succ MaximumTexture2dLayeredWidth = MaximumTexture2dLayeredHeight
  succ MaximumTexture2dArrayWidth = MaximumTexture2dLayeredHeight
  succ MaximumTexture2dLayeredHeight = MaximumTexture2dLayeredLayers
  succ MaximumTexture2dArrayHeight = MaximumTexture2dLayeredLayers
  succ MaximumTexture2dLayeredLayers = SurfaceAlignment
  succ MaximumTexture2dArrayNumslices = SurfaceAlignment
  succ SurfaceAlignment = ConcurrentKernels
  succ ConcurrentKernels = EccEnabled
  succ EccEnabled = PciBusId
  succ PciBusId = PciDeviceId
  succ PciDeviceId = TccDriver
  succ TccDriver = MemoryClockRate
  succ MemoryClockRate = GlobalMemoryBusWidth
  succ GlobalMemoryBusWidth = L2CacheSize
  succ L2CacheSize = MaxThreadsPerMultiprocessor
  succ MaxThreadsPerMultiprocessor = AsyncEngineCount
  succ AsyncEngineCount = UnifiedAddressing
  succ UnifiedAddressing = MaximumTexture1dLayeredWidth
  succ MaximumTexture1dLayeredWidth = MaximumTexture1dLayeredLayers
  succ MaximumTexture1dLayeredLayers = CanTex2dGather
  succ CanTex2dGather = MaximumTexture2dGatherWidth
  succ MaximumTexture2dGatherWidth = MaximumTexture2dGatherHeight
  succ MaximumTexture2dGatherHeight = MaximumTexture3dWidthAlternate
  succ MaximumTexture3dWidthAlternate = MaximumTexture3dHeightAlternate
  succ MaximumTexture3dHeightAlternate = MaximumTexture3dDepthAlternate
  succ MaximumTexture3dDepthAlternate = PciDomainId
  succ PciDomainId = TexturePitchAlignment
  succ TexturePitchAlignment = MaximumTexturecubemapWidth
  succ MaximumTexturecubemapWidth = MaximumTexturecubemapLayeredWidth
  succ MaximumTexturecubemapLayeredWidth = MaximumTexturecubemapLayeredLayers
  succ MaximumTexturecubemapLayeredLayers = MaximumSurface1dWidth
  succ MaximumSurface1dWidth = MaximumSurface2dWidth
  succ MaximumSurface2dWidth = MaximumSurface2dHeight
  succ MaximumSurface2dHeight = MaximumSurface3dWidth
  succ MaximumSurface3dWidth = MaximumSurface3dHeight
  succ MaximumSurface3dHeight = MaximumSurface3dDepth
  succ MaximumSurface3dDepth = MaximumSurface1dLayeredWidth
  succ MaximumSurface1dLayeredWidth = MaximumSurface1dLayeredLayers
  succ MaximumSurface1dLayeredLayers = MaximumSurface2dLayeredWidth
  succ MaximumSurface2dLayeredWidth = MaximumSurface2dLayeredHeight
  succ MaximumSurface2dLayeredHeight = MaximumSurface2dLayeredLayers
  succ MaximumSurface2dLayeredLayers = MaximumSurfacecubemapWidth
  succ MaximumSurfacecubemapWidth = MaximumSurfacecubemapLayeredWidth
  succ MaximumSurfacecubemapLayeredWidth = MaximumSurfacecubemapLayeredLayers
  succ MaximumSurfacecubemapLayeredLayers = MaximumTexture1dLinearWidth
  succ MaximumTexture1dLinearWidth = MaximumTexture2dLinearWidth
  succ MaximumTexture2dLinearWidth = MaximumTexture2dLinearHeight
  succ MaximumTexture2dLinearHeight = MaximumTexture2dLinearPitch
  succ MaximumTexture2dLinearPitch = MaximumTexture2dMipmappedWidth
  succ MaximumTexture2dMipmappedWidth = MaximumTexture2dMipmappedHeight
  succ MaximumTexture2dMipmappedHeight = ComputeCapabilityMajor
  succ ComputeCapabilityMajor = ComputeCapabilityMinor
  succ ComputeCapabilityMinor = MaximumTexture1dMipmappedWidth
  succ MaximumTexture1dMipmappedWidth = StreamPrioritiesSupported
  succ StreamPrioritiesSupported = GlobalL1CacheSupported
  succ GlobalL1CacheSupported = LocalL1CacheSupported
  succ LocalL1CacheSupported = MaxSharedMemoryPerMultiprocessor
  succ MaxSharedMemoryPerMultiprocessor = MaxRegistersPerMultiprocessor
  succ MaxRegistersPerMultiprocessor = ManagedMemory
  succ ManagedMemory = MultiGpuBoard
  succ MultiGpuBoard = MultiGpuBoardGroupId
  succ MultiGpuBoardGroupId = HostNativeAtomicSupported
  succ HostNativeAtomicSupported = SingleToDoublePrecisionPerfRatio
  succ SingleToDoublePrecisionPerfRatio = PageableMemoryAccess
  succ PageableMemoryAccess = ConcurrentManagedAccess
  succ ConcurrentManagedAccess = ComputePreemptionSupported
  succ ComputePreemptionSupported = CanUseHostPointerForRegisteredMem
  succ CanUseHostPointerForRegisteredMem = CanUseStreamMemOps
  succ CanUseStreamMemOps = CanUse64BitStreamMemOps
  succ CanUse64BitStreamMemOps = CanUseStreamWaitValueNor
  succ CanUseStreamWaitValueNor = CooperativeLaunch
  succ CooperativeLaunch = CooperativeMultiDeviceLaunch
  succ CooperativeMultiDeviceLaunch = MaxSharedMemoryPerBlockOptin
  succ MaxSharedMemoryPerBlockOptin = CanFlushRemoteWrites
  succ CanFlushRemoteWrites = HostRegisterSupported
  succ HostRegisterSupported = PageableMemoryAccessUsesHostPageTables
  succ PageableMemoryAccessUsesHostPageTables = DirectManagedMemAccessFromHost
  succ DirectManagedMemAccessFromHost = VirtualAddressManagementSupported
  succ VirtualAddressManagementSupported = HandleTypePosixFileDescriptorSupported
  succ VirtualMemoryManagementSupported = HandleTypePosixFileDescriptorSupported
  succ HandleTypePosixFileDescriptorSupported = HandleTypeWin32HandleSupported
  succ HandleTypeWin32HandleSupported = HandleTypeWin32KmtHandleSupported
  succ HandleTypeWin32KmtHandleSupported = MaxBlocksPerMultiprocessor
  succ MaxBlocksPerMultiprocessor = GenericCompressionSupported
  succ GenericCompressionSupported = MaxPersistingL2CacheSize
  succ MaxPersistingL2CacheSize = MaxAccessPolicyWindowSize
  succ MaxAccessPolicyWindowSize = GpuDirectRdmaWithCudaVmmSupported
  succ GpuDirectRdmaWithCudaVmmSupported = ReservedSharedMemoryPerBlock
  succ ReservedSharedMemoryPerBlock = SparseCudaArraySupported
  succ SparseCudaArraySupported = ReadOnlyHostRegisterSupported
  succ ReadOnlyHostRegisterSupported = TimelineSemaphoreInteropSupported
  succ TimelineSemaphoreInteropSupported = MemoryPoolsSupported
  succ MemoryPoolsSupported = GpuDirectRdmaSupported
  succ GpuDirectRdmaSupported = GpuDirectRdmaFlushWritesOptions
  succ GpuDirectRdmaFlushWritesOptions = GpuDirectRdmaWritesOrdering
  succ GpuDirectRdmaWritesOrdering = MempoolSupportedHandleTypes
  succ MempoolSupportedHandleTypes = ClusterLaunch
  succ ClusterLaunch = DeferredMappingCudaArraySupported
  succ DeferredMappingCudaArraySupported = CanUse64BitStreamMemOpsV2
  succ CanUse64BitStreamMemOpsV2 = CanUseStreamWaitValueNorV2
  succ CanUseStreamWaitValueNorV2 = DmaBufSupported
  succ DmaBufSupported = CU_DEVICE_ATTRIBUTE_MAX
  succ CU_DEVICE_ATTRIBUTE_MAX = error "DeviceAttribute.succ: CU_DEVICE_ATTRIBUTE_MAX has no successor"

  pred MaxBlockDimX = MaxThreadsPerBlock
  pred MaxBlockDimY = MaxBlockDimX
  pred MaxBlockDimZ = MaxBlockDimY
  pred MaxGridDimX = MaxBlockDimZ
  pred MaxGridDimY = MaxGridDimX
  pred MaxGridDimZ = MaxGridDimY
  pred MaxSharedMemoryPerBlock = MaxGridDimZ
  pred SharedMemoryPerBlock = MaxGridDimZ
  pred TotalConstantMemory = MaxSharedMemoryPerBlock
  pred WarpSize = TotalConstantMemory
  pred MaxPitch = WarpSize
  pred MaxRegistersPerBlock = MaxPitch
  pred RegistersPerBlock = MaxPitch
  pred ClockRate = MaxRegistersPerBlock
  pred TextureAlignment = ClockRate
  pred GpuOverlap = TextureAlignment
  pred MultiprocessorCount = GpuOverlap
  pred KernelExecTimeout = MultiprocessorCount
  pred Integrated = KernelExecTimeout
  pred CanMapHostMemory = Integrated
  pred ComputeMode = CanMapHostMemory
  pred MaximumTexture1dWidth = ComputeMode
  pred MaximumTexture2dWidth = MaximumTexture1dWidth
  pred MaximumTexture2dHeight = MaximumTexture2dWidth
  pred MaximumTexture3dWidth = MaximumTexture2dHeight
  pred MaximumTexture3dHeight = MaximumTexture3dWidth
  pred MaximumTexture3dDepth = MaximumTexture3dHeight
  pred MaximumTexture2dLayeredWidth = MaximumTexture3dDepth
  pred MaximumTexture2dArrayWidth = MaximumTexture3dDepth
  pred MaximumTexture2dLayeredHeight = MaximumTexture2dLayeredWidth
  pred MaximumTexture2dArrayHeight = MaximumTexture2dLayeredWidth
  pred MaximumTexture2dLayeredLayers = MaximumTexture2dLayeredHeight
  pred MaximumTexture2dArrayNumslices = MaximumTexture2dLayeredHeight
  pred SurfaceAlignment = MaximumTexture2dLayeredLayers
  pred ConcurrentKernels = SurfaceAlignment
  pred EccEnabled = ConcurrentKernels
  pred PciBusId = EccEnabled
  pred PciDeviceId = PciBusId
  pred TccDriver = PciDeviceId
  pred MemoryClockRate = TccDriver
  pred GlobalMemoryBusWidth = MemoryClockRate
  pred L2CacheSize = GlobalMemoryBusWidth
  pred MaxThreadsPerMultiprocessor = L2CacheSize
  pred AsyncEngineCount = MaxThreadsPerMultiprocessor
  pred UnifiedAddressing = AsyncEngineCount
  pred MaximumTexture1dLayeredWidth = UnifiedAddressing
  pred MaximumTexture1dLayeredLayers = MaximumTexture1dLayeredWidth
  pred CanTex2dGather = MaximumTexture1dLayeredLayers
  pred MaximumTexture2dGatherWidth = CanTex2dGather
  pred MaximumTexture2dGatherHeight = MaximumTexture2dGatherWidth
  pred MaximumTexture3dWidthAlternate = MaximumTexture2dGatherHeight
  pred MaximumTexture3dHeightAlternate = MaximumTexture3dWidthAlternate
  pred MaximumTexture3dDepthAlternate = MaximumTexture3dHeightAlternate
  pred PciDomainId = MaximumTexture3dDepthAlternate
  pred TexturePitchAlignment = PciDomainId
  pred MaximumTexturecubemapWidth = TexturePitchAlignment
  pred MaximumTexturecubemapLayeredWidth = MaximumTexturecubemapWidth
  pred MaximumTexturecubemapLayeredLayers = MaximumTexturecubemapLayeredWidth
  pred MaximumSurface1dWidth = MaximumTexturecubemapLayeredLayers
  pred MaximumSurface2dWidth = MaximumSurface1dWidth
  pred MaximumSurface2dHeight = MaximumSurface2dWidth
  pred MaximumSurface3dWidth = MaximumSurface2dHeight
  pred MaximumSurface3dHeight = MaximumSurface3dWidth
  pred MaximumSurface3dDepth = MaximumSurface3dHeight
  pred MaximumSurface1dLayeredWidth = MaximumSurface3dDepth
  pred MaximumSurface1dLayeredLayers = MaximumSurface1dLayeredWidth
  pred MaximumSurface2dLayeredWidth = MaximumSurface1dLayeredLayers
  pred MaximumSurface2dLayeredHeight = MaximumSurface2dLayeredWidth
  pred MaximumSurface2dLayeredLayers = MaximumSurface2dLayeredHeight
  pred MaximumSurfacecubemapWidth = MaximumSurface2dLayeredLayers
  pred MaximumSurfacecubemapLayeredWidth = MaximumSurfacecubemapWidth
  pred MaximumSurfacecubemapLayeredLayers = MaximumSurfacecubemapLayeredWidth
  pred MaximumTexture1dLinearWidth = MaximumSurfacecubemapLayeredLayers
  pred MaximumTexture2dLinearWidth = MaximumTexture1dLinearWidth
  pred MaximumTexture2dLinearHeight = MaximumTexture2dLinearWidth
  pred MaximumTexture2dLinearPitch = MaximumTexture2dLinearHeight
  pred MaximumTexture2dMipmappedWidth = MaximumTexture2dLinearPitch
  pred MaximumTexture2dMipmappedHeight = MaximumTexture2dMipmappedWidth
  pred ComputeCapabilityMajor = MaximumTexture2dMipmappedHeight
  pred ComputeCapabilityMinor = ComputeCapabilityMajor
  pred MaximumTexture1dMipmappedWidth = ComputeCapabilityMinor
  pred StreamPrioritiesSupported = MaximumTexture1dMipmappedWidth
  pred GlobalL1CacheSupported = StreamPrioritiesSupported
  pred LocalL1CacheSupported = GlobalL1CacheSupported
  pred MaxSharedMemoryPerMultiprocessor = LocalL1CacheSupported
  pred MaxRegistersPerMultiprocessor = MaxSharedMemoryPerMultiprocessor
  pred ManagedMemory = MaxRegistersPerMultiprocessor
  pred MultiGpuBoard = ManagedMemory
  pred MultiGpuBoardGroupId = MultiGpuBoard
  pred HostNativeAtomicSupported = MultiGpuBoardGroupId
  pred SingleToDoublePrecisionPerfRatio = HostNativeAtomicSupported
  pred PageableMemoryAccess = SingleToDoublePrecisionPerfRatio
  pred ConcurrentManagedAccess = PageableMemoryAccess
  pred ComputePreemptionSupported = ConcurrentManagedAccess
  pred CanUseHostPointerForRegisteredMem = ComputePreemptionSupported
  pred CanUseStreamMemOps = CanUseHostPointerForRegisteredMem
  pred CanUse64BitStreamMemOps = CanUseStreamMemOps
  pred CanUseStreamWaitValueNor = CanUse64BitStreamMemOps
  pred CooperativeLaunch = CanUseStreamWaitValueNor
  pred CooperativeMultiDeviceLaunch = CooperativeLaunch
  pred MaxSharedMemoryPerBlockOptin = CooperativeMultiDeviceLaunch
  pred CanFlushRemoteWrites = MaxSharedMemoryPerBlockOptin
  pred HostRegisterSupported = CanFlushRemoteWrites
  pred PageableMemoryAccessUsesHostPageTables = HostRegisterSupported
  pred DirectManagedMemAccessFromHost = PageableMemoryAccessUsesHostPageTables
  pred VirtualAddressManagementSupported = DirectManagedMemAccessFromHost
  pred VirtualMemoryManagementSupported = DirectManagedMemAccessFromHost
  pred HandleTypePosixFileDescriptorSupported = VirtualAddressManagementSupported
  pred HandleTypeWin32HandleSupported = HandleTypePosixFileDescriptorSupported
  pred HandleTypeWin32KmtHandleSupported = HandleTypeWin32HandleSupported
  pred MaxBlocksPerMultiprocessor = HandleTypeWin32KmtHandleSupported
  pred GenericCompressionSupported = MaxBlocksPerMultiprocessor
  pred MaxPersistingL2CacheSize = GenericCompressionSupported
  pred MaxAccessPolicyWindowSize = MaxPersistingL2CacheSize
  pred GpuDirectRdmaWithCudaVmmSupported = MaxAccessPolicyWindowSize
  pred ReservedSharedMemoryPerBlock = GpuDirectRdmaWithCudaVmmSupported
  pred SparseCudaArraySupported = ReservedSharedMemoryPerBlock
  pred ReadOnlyHostRegisterSupported = SparseCudaArraySupported
  pred TimelineSemaphoreInteropSupported = ReadOnlyHostRegisterSupported
  pred MemoryPoolsSupported = TimelineSemaphoreInteropSupported
  pred GpuDirectRdmaSupported = MemoryPoolsSupported
  pred GpuDirectRdmaFlushWritesOptions = GpuDirectRdmaSupported
  pred GpuDirectRdmaWritesOrdering = GpuDirectRdmaFlushWritesOptions
  pred MempoolSupportedHandleTypes = GpuDirectRdmaWritesOrdering
  pred ClusterLaunch = MempoolSupportedHandleTypes
  pred DeferredMappingCudaArraySupported = ClusterLaunch
  pred CanUse64BitStreamMemOpsV2 = DeferredMappingCudaArraySupported
  pred CanUseStreamWaitValueNorV2 = CanUse64BitStreamMemOpsV2
  pred DmaBufSupported = CanUseStreamWaitValueNorV2
  pred CU_DEVICE_ATTRIBUTE_MAX = DmaBufSupported
  pred MaxThreadsPerBlock = error "DeviceAttribute.pred: MaxThreadsPerBlock has no predecessor"

  enumFromTo :: DeviceAttribute -> DeviceAttribute -> [DeviceAttribute]
enumFromTo DeviceAttribute
from DeviceAttribute
to = DeviceAttribute -> [DeviceAttribute]
forall {t}. Enum t => t -> [t]
go DeviceAttribute
from
    where
      end :: Int
end = DeviceAttribute -> Int
forall a. Enum a => a -> Int
fromEnum DeviceAttribute
to
      go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 Ordering
EQ -> [t
v]
                 Ordering
GT -> []

  enumFrom :: DeviceAttribute -> [DeviceAttribute]
enumFrom DeviceAttribute
from = DeviceAttribute -> DeviceAttribute -> [DeviceAttribute]
forall a. Enum a => a -> a -> [a]
enumFromTo DeviceAttribute
from DeviceAttribute
CU_DEVICE_ATTRIBUTE_MAX

  fromEnum :: DeviceAttribute -> Int
fromEnum DeviceAttribute
MaxThreadsPerBlock = Int
1
  fromEnum DeviceAttribute
MaxBlockDimX = Int
2
  fromEnum DeviceAttribute
MaxBlockDimY = Int
3
  fromEnum DeviceAttribute
MaxBlockDimZ = Int
4
  fromEnum DeviceAttribute
MaxGridDimX = Int
5
  fromEnum DeviceAttribute
MaxGridDimY = Int
6
  fromEnum DeviceAttribute
MaxGridDimZ = Int
7
  fromEnum DeviceAttribute
MaxSharedMemoryPerBlock = Int
8
  fromEnum DeviceAttribute
SharedMemoryPerBlock = Int
8
  fromEnum DeviceAttribute
TotalConstantMemory = Int
9
  fromEnum DeviceAttribute
WarpSize = Int
10
  fromEnum DeviceAttribute
MaxPitch = Int
11
  fromEnum DeviceAttribute
MaxRegistersPerBlock = Int
12
  fromEnum DeviceAttribute
RegistersPerBlock = Int
12
  fromEnum DeviceAttribute
ClockRate = Int
13
  fromEnum DeviceAttribute
TextureAlignment = Int
14
  fromEnum DeviceAttribute
GpuOverlap = Int
15
  fromEnum DeviceAttribute
MultiprocessorCount = Int
16
  fromEnum DeviceAttribute
KernelExecTimeout = Int
17
  fromEnum DeviceAttribute
Integrated = Int
18
  fromEnum DeviceAttribute
CanMapHostMemory = Int
19
  fromEnum DeviceAttribute
ComputeMode = Int
20
  fromEnum DeviceAttribute
MaximumTexture1dWidth = Int
21
  fromEnum DeviceAttribute
MaximumTexture2dWidth = Int
22
  fromEnum DeviceAttribute
MaximumTexture2dHeight = Int
23
  fromEnum DeviceAttribute
MaximumTexture3dWidth = Int
24
  fromEnum DeviceAttribute
MaximumTexture3dHeight = Int
25
  fromEnum DeviceAttribute
MaximumTexture3dDepth = Int
26
  fromEnum DeviceAttribute
MaximumTexture2dLayeredWidth = Int
27
  fromEnum DeviceAttribute
MaximumTexture2dArrayWidth = Int
27
  fromEnum DeviceAttribute
MaximumTexture2dLayeredHeight = Int
28
  fromEnum DeviceAttribute
MaximumTexture2dArrayHeight = Int
28
  fromEnum DeviceAttribute
MaximumTexture2dLayeredLayers = Int
29
  fromEnum DeviceAttribute
MaximumTexture2dArrayNumslices = Int
29
  fromEnum DeviceAttribute
SurfaceAlignment = Int
30
  fromEnum DeviceAttribute
ConcurrentKernels = Int
31
  fromEnum DeviceAttribute
EccEnabled = Int
32
  fromEnum DeviceAttribute
PciBusId = Int
33
  fromEnum DeviceAttribute
PciDeviceId = Int
34
  fromEnum DeviceAttribute
TccDriver = Int
35
  fromEnum DeviceAttribute
MemoryClockRate = Int
36
  fromEnum DeviceAttribute
GlobalMemoryBusWidth = Int
37
  fromEnum DeviceAttribute
L2CacheSize = Int
38
  fromEnum DeviceAttribute
MaxThreadsPerMultiprocessor = Int
39
  fromEnum DeviceAttribute
AsyncEngineCount = Int
40
  fromEnum DeviceAttribute
UnifiedAddressing = Int
41
  fromEnum DeviceAttribute
MaximumTexture1dLayeredWidth = Int
42
  fromEnum DeviceAttribute
MaximumTexture1dLayeredLayers = Int
43
  fromEnum DeviceAttribute
CanTex2dGather = Int
44
  fromEnum DeviceAttribute
MaximumTexture2dGatherWidth = Int
45
  fromEnum DeviceAttribute
MaximumTexture2dGatherHeight = Int
46
  fromEnum DeviceAttribute
MaximumTexture3dWidthAlternate = Int
47
  fromEnum DeviceAttribute
MaximumTexture3dHeightAlternate = Int
48
  fromEnum DeviceAttribute
MaximumTexture3dDepthAlternate = Int
49
  fromEnum DeviceAttribute
PciDomainId = Int
50
  fromEnum DeviceAttribute
TexturePitchAlignment = Int
51
  fromEnum DeviceAttribute
MaximumTexturecubemapWidth = Int
52
  fromEnum DeviceAttribute
MaximumTexturecubemapLayeredWidth = Int
53
  fromEnum DeviceAttribute
MaximumTexturecubemapLayeredLayers = Int
54
  fromEnum DeviceAttribute
MaximumSurface1dWidth = Int
55
  fromEnum DeviceAttribute
MaximumSurface2dWidth = Int
56
  fromEnum DeviceAttribute
MaximumSurface2dHeight = Int
57
  fromEnum DeviceAttribute
MaximumSurface3dWidth = Int
58
  fromEnum DeviceAttribute
MaximumSurface3dHeight = Int
59
  fromEnum DeviceAttribute
MaximumSurface3dDepth = Int
60
  fromEnum DeviceAttribute
MaximumSurface1dLayeredWidth = Int
61
  fromEnum DeviceAttribute
MaximumSurface1dLayeredLayers = Int
62
  fromEnum DeviceAttribute
MaximumSurface2dLayeredWidth = Int
63
  fromEnum DeviceAttribute
MaximumSurface2dLayeredHeight = Int
64
  fromEnum DeviceAttribute
MaximumSurface2dLayeredLayers = Int
65
  fromEnum DeviceAttribute
MaximumSurfacecubemapWidth = Int
66
  fromEnum DeviceAttribute
MaximumSurfacecubemapLayeredWidth = Int
67
  fromEnum DeviceAttribute
MaximumSurfacecubemapLayeredLayers = Int
68
  fromEnum DeviceAttribute
MaximumTexture1dLinearWidth = Int
69
  fromEnum DeviceAttribute
MaximumTexture2dLinearWidth = Int
70
  fromEnum DeviceAttribute
MaximumTexture2dLinearHeight = Int
71
  fromEnum DeviceAttribute
MaximumTexture2dLinearPitch = Int
72
  fromEnum DeviceAttribute
MaximumTexture2dMipmappedWidth = Int
73
  fromEnum DeviceAttribute
MaximumTexture2dMipmappedHeight = Int
74
  fromEnum DeviceAttribute
ComputeCapabilityMajor = Int
75
  fromEnum DeviceAttribute
ComputeCapabilityMinor = Int
76
  fromEnum DeviceAttribute
MaximumTexture1dMipmappedWidth = Int
77
  fromEnum DeviceAttribute
StreamPrioritiesSupported = Int
78
  fromEnum DeviceAttribute
GlobalL1CacheSupported = Int
79
  fromEnum DeviceAttribute
LocalL1CacheSupported = Int
80
  fromEnum DeviceAttribute
MaxSharedMemoryPerMultiprocessor = Int
81
  fromEnum DeviceAttribute
MaxRegistersPerMultiprocessor = Int
82
  fromEnum DeviceAttribute
ManagedMemory = Int
83
  fromEnum DeviceAttribute
MultiGpuBoard = Int
84
  fromEnum DeviceAttribute
MultiGpuBoardGroupId = Int
85
  fromEnum DeviceAttribute
HostNativeAtomicSupported = Int
86
  fromEnum DeviceAttribute
SingleToDoublePrecisionPerfRatio = Int
87
  fromEnum DeviceAttribute
PageableMemoryAccess = Int
88
  fromEnum DeviceAttribute
ConcurrentManagedAccess = Int
89
  fromEnum DeviceAttribute
ComputePreemptionSupported = Int
90
  fromEnum DeviceAttribute
CanUseHostPointerForRegisteredMem = Int
91
  fromEnum DeviceAttribute
CanUseStreamMemOps = Int
92
  fromEnum DeviceAttribute
CanUse64BitStreamMemOps = Int
93
  fromEnum DeviceAttribute
CanUseStreamWaitValueNor = Int
94
  fromEnum DeviceAttribute
CooperativeLaunch = Int
95
  fromEnum DeviceAttribute
CooperativeMultiDeviceLaunch = Int
96
  fromEnum DeviceAttribute
MaxSharedMemoryPerBlockOptin = Int
97
  fromEnum DeviceAttribute
CanFlushRemoteWrites = Int
98
  fromEnum DeviceAttribute
HostRegisterSupported = Int
99
  fromEnum DeviceAttribute
PageableMemoryAccessUsesHostPageTables = Int
100
  fromEnum DeviceAttribute
DirectManagedMemAccessFromHost = Int
101
  fromEnum DeviceAttribute
VirtualAddressManagementSupported = Int
102
  fromEnum DeviceAttribute
VirtualMemoryManagementSupported = Int
102
  fromEnum DeviceAttribute
HandleTypePosixFileDescriptorSupported = Int
103
  fromEnum DeviceAttribute
HandleTypeWin32HandleSupported = Int
104
  fromEnum DeviceAttribute
HandleTypeWin32KmtHandleSupported = Int
105
  fromEnum DeviceAttribute
MaxBlocksPerMultiprocessor = Int
106
  fromEnum DeviceAttribute
GenericCompressionSupported = Int
107
  fromEnum DeviceAttribute
MaxPersistingL2CacheSize = Int
108
  fromEnum DeviceAttribute
MaxAccessPolicyWindowSize = Int
109
  fromEnum DeviceAttribute
GpuDirectRdmaWithCudaVmmSupported = Int
110
  fromEnum DeviceAttribute
ReservedSharedMemoryPerBlock = Int
111
  fromEnum DeviceAttribute
SparseCudaArraySupported = Int
112
  fromEnum DeviceAttribute
ReadOnlyHostRegisterSupported = Int
113
  fromEnum DeviceAttribute
TimelineSemaphoreInteropSupported = Int
114
  fromEnum DeviceAttribute
MemoryPoolsSupported = Int
115
  fromEnum DeviceAttribute
GpuDirectRdmaSupported = Int
116
  fromEnum DeviceAttribute
GpuDirectRdmaFlushWritesOptions = Int
117
  fromEnum DeviceAttribute
GpuDirectRdmaWritesOrdering = Int
118
  fromEnum DeviceAttribute
MempoolSupportedHandleTypes = Int
119
  fromEnum DeviceAttribute
ClusterLaunch = Int
120
  fromEnum DeviceAttribute
DeferredMappingCudaArraySupported = Int
121
  fromEnum DeviceAttribute
CanUse64BitStreamMemOpsV2 = Int
122
  fromEnum DeviceAttribute
CanUseStreamWaitValueNorV2 = Int
123
  fromEnum DeviceAttribute
DmaBufSupported = Int
124
  fromEnum DeviceAttribute
CU_DEVICE_ATTRIBUTE_MAX = Int
125

  toEnum :: Int -> DeviceAttribute
toEnum Int
1 = DeviceAttribute
MaxThreadsPerBlock
  toEnum Int
2 = DeviceAttribute
MaxBlockDimX
  toEnum Int
3 = DeviceAttribute
MaxBlockDimY
  toEnum Int
4 = DeviceAttribute
MaxBlockDimZ
  toEnum Int
5 = DeviceAttribute
MaxGridDimX
  toEnum Int
6 = DeviceAttribute
MaxGridDimY
  toEnum Int
7 = DeviceAttribute
MaxGridDimZ
  toEnum Int
8 = DeviceAttribute
MaxSharedMemoryPerBlock
  toEnum Int
9 = DeviceAttribute
TotalConstantMemory
  toEnum Int
10 = DeviceAttribute
WarpSize
  toEnum Int
11 = DeviceAttribute
MaxPitch
  toEnum Int
12 = DeviceAttribute
MaxRegistersPerBlock
  toEnum Int
13 = DeviceAttribute
ClockRate
  toEnum Int
14 = DeviceAttribute
TextureAlignment
  toEnum Int
15 = DeviceAttribute
GpuOverlap
  toEnum Int
16 = DeviceAttribute
MultiprocessorCount
  toEnum Int
17 = DeviceAttribute
KernelExecTimeout
  toEnum Int
18 = DeviceAttribute
Integrated
  toEnum Int
19 = DeviceAttribute
CanMapHostMemory
  toEnum Int
20 = DeviceAttribute
ComputeMode
  toEnum Int
21 = DeviceAttribute
MaximumTexture1dWidth
  toEnum Int
22 = DeviceAttribute
MaximumTexture2dWidth
  toEnum Int
23 = DeviceAttribute
MaximumTexture2dHeight
  toEnum Int
24 = DeviceAttribute
MaximumTexture3dWidth
  toEnum Int
25 = DeviceAttribute
MaximumTexture3dHeight
  toEnum Int
26 = DeviceAttribute
MaximumTexture3dDepth
  toEnum Int
27 = DeviceAttribute
MaximumTexture2dLayeredWidth
  toEnum Int
28 = DeviceAttribute
MaximumTexture2dLayeredHeight
  toEnum Int
29 = DeviceAttribute
MaximumTexture2dLayeredLayers
  toEnum Int
30 = DeviceAttribute
SurfaceAlignment
  toEnum Int
31 = DeviceAttribute
ConcurrentKernels
  toEnum Int
32 = DeviceAttribute
EccEnabled
  toEnum Int
33 = DeviceAttribute
PciBusId
  toEnum Int
34 = DeviceAttribute
PciDeviceId
  toEnum Int
35 = DeviceAttribute
TccDriver
  toEnum Int
36 = DeviceAttribute
MemoryClockRate
  toEnum Int
37 = DeviceAttribute
GlobalMemoryBusWidth
  toEnum Int
38 = DeviceAttribute
L2CacheSize
  toEnum Int
39 = DeviceAttribute
MaxThreadsPerMultiprocessor
  toEnum Int
40 = DeviceAttribute
AsyncEngineCount
  toEnum Int
41 = DeviceAttribute
UnifiedAddressing
  toEnum Int
42 = DeviceAttribute
MaximumTexture1dLayeredWidth
  toEnum Int
43 = DeviceAttribute
MaximumTexture1dLayeredLayers
  toEnum Int
44 = DeviceAttribute
CanTex2dGather
  toEnum Int
45 = DeviceAttribute
MaximumTexture2dGatherWidth
  toEnum Int
46 = DeviceAttribute
MaximumTexture2dGatherHeight
  toEnum Int
47 = DeviceAttribute
MaximumTexture3dWidthAlternate
  toEnum Int
48 = DeviceAttribute
MaximumTexture3dHeightAlternate
  toEnum Int
49 = DeviceAttribute
MaximumTexture3dDepthAlternate
  toEnum Int
50 = DeviceAttribute
PciDomainId
  toEnum Int
51 = DeviceAttribute
TexturePitchAlignment
  toEnum Int
52 = DeviceAttribute
MaximumTexturecubemapWidth
  toEnum Int
53 = DeviceAttribute
MaximumTexturecubemapLayeredWidth
  toEnum Int
54 = DeviceAttribute
MaximumTexturecubemapLayeredLayers
  toEnum Int
55 = DeviceAttribute
MaximumSurface1dWidth
  toEnum Int
56 = DeviceAttribute
MaximumSurface2dWidth
  toEnum Int
57 = DeviceAttribute
MaximumSurface2dHeight
  toEnum Int
58 = DeviceAttribute
MaximumSurface3dWidth
  toEnum Int
59 = DeviceAttribute
MaximumSurface3dHeight
  toEnum Int
60 = DeviceAttribute
MaximumSurface3dDepth
  toEnum Int
61 = DeviceAttribute
MaximumSurface1dLayeredWidth
  toEnum Int
62 = DeviceAttribute
MaximumSurface1dLayeredLayers
  toEnum Int
63 = DeviceAttribute
MaximumSurface2dLayeredWidth
  toEnum Int
64 = DeviceAttribute
MaximumSurface2dLayeredHeight
  toEnum Int
65 = DeviceAttribute
MaximumSurface2dLayeredLayers
  toEnum Int
66 = DeviceAttribute
MaximumSurfacecubemapWidth
  toEnum Int
67 = DeviceAttribute
MaximumSurfacecubemapLayeredWidth
  toEnum Int
68 = DeviceAttribute
MaximumSurfacecubemapLayeredLayers
  toEnum Int
69 = DeviceAttribute
MaximumTexture1dLinearWidth
  toEnum Int
70 = DeviceAttribute
MaximumTexture2dLinearWidth
  toEnum Int
71 = DeviceAttribute
MaximumTexture2dLinearHeight
  toEnum Int
72 = DeviceAttribute
MaximumTexture2dLinearPitch
  toEnum Int
73 = DeviceAttribute
MaximumTexture2dMipmappedWidth
  toEnum Int
74 = DeviceAttribute
MaximumTexture2dMipmappedHeight
  toEnum Int
75 = DeviceAttribute
ComputeCapabilityMajor
  toEnum Int
76 = DeviceAttribute
ComputeCapabilityMinor
  toEnum Int
77 = DeviceAttribute
MaximumTexture1dMipmappedWidth
  toEnum Int
78 = DeviceAttribute
StreamPrioritiesSupported
  toEnum Int
79 = DeviceAttribute
GlobalL1CacheSupported
  toEnum Int
80 = DeviceAttribute
LocalL1CacheSupported
  toEnum Int
81 = DeviceAttribute
MaxSharedMemoryPerMultiprocessor
  toEnum Int
82 = DeviceAttribute
MaxRegistersPerMultiprocessor
  toEnum Int
83 = DeviceAttribute
ManagedMemory
  toEnum Int
84 = DeviceAttribute
MultiGpuBoard
  toEnum Int
85 = DeviceAttribute
MultiGpuBoardGroupId
  toEnum Int
86 = DeviceAttribute
HostNativeAtomicSupported
  toEnum Int
87 = DeviceAttribute
SingleToDoublePrecisionPerfRatio
  toEnum Int
88 = DeviceAttribute
PageableMemoryAccess
  toEnum Int
89 = DeviceAttribute
ConcurrentManagedAccess
  toEnum Int
90 = DeviceAttribute
ComputePreemptionSupported
  toEnum Int
91 = DeviceAttribute
CanUseHostPointerForRegisteredMem
  toEnum Int
92 = DeviceAttribute
CanUseStreamMemOps
  toEnum Int
93 = DeviceAttribute
CanUse64BitStreamMemOps
  toEnum Int
94 = DeviceAttribute
CanUseStreamWaitValueNor
  toEnum Int
95 = DeviceAttribute
CooperativeLaunch
  toEnum Int
96 = DeviceAttribute
CooperativeMultiDeviceLaunch
  toEnum Int
97 = DeviceAttribute
MaxSharedMemoryPerBlockOptin
  toEnum Int
98 = DeviceAttribute
CanFlushRemoteWrites
  toEnum Int
99 = DeviceAttribute
HostRegisterSupported
  toEnum Int
100 = DeviceAttribute
PageableMemoryAccessUsesHostPageTables
  toEnum Int
101 = DeviceAttribute
DirectManagedMemAccessFromHost
  toEnum Int
102 = DeviceAttribute
VirtualAddressManagementSupported
  toEnum Int
103 = DeviceAttribute
HandleTypePosixFileDescriptorSupported
  toEnum Int
104 = DeviceAttribute
HandleTypeWin32HandleSupported
  toEnum Int
105 = DeviceAttribute
HandleTypeWin32KmtHandleSupported
  toEnum Int
106 = DeviceAttribute
MaxBlocksPerMultiprocessor
  toEnum Int
107 = DeviceAttribute
GenericCompressionSupported
  toEnum Int
108 = DeviceAttribute
MaxPersistingL2CacheSize
  toEnum Int
109 = DeviceAttribute
MaxAccessPolicyWindowSize
  toEnum Int
110 = DeviceAttribute
GpuDirectRdmaWithCudaVmmSupported
  toEnum Int
111 = DeviceAttribute
ReservedSharedMemoryPerBlock
  toEnum Int
112 = DeviceAttribute
SparseCudaArraySupported
  toEnum Int
113 = DeviceAttribute
ReadOnlyHostRegisterSupported
  toEnum Int
114 = DeviceAttribute
TimelineSemaphoreInteropSupported
  toEnum Int
115 = DeviceAttribute
MemoryPoolsSupported
  toEnum Int
116 = DeviceAttribute
GpuDirectRdmaSupported
  toEnum Int
117 = DeviceAttribute
GpuDirectRdmaFlushWritesOptions
  toEnum Int
118 = DeviceAttribute
GpuDirectRdmaWritesOrdering
  toEnum Int
119 = DeviceAttribute
MempoolSupportedHandleTypes
  toEnum Int
120 = DeviceAttribute
ClusterLaunch
  toEnum Int
121 = DeviceAttribute
DeferredMappingCudaArraySupported
  toEnum Int
122 = DeviceAttribute
CanUse64BitStreamMemOpsV2
  toEnum Int
123 = DeviceAttribute
CanUseStreamWaitValueNorV2
  toEnum Int
124 = DeviceAttribute
DmaBufSupported
  toEnum Int
125 = DeviceAttribute
CU_DEVICE_ATTRIBUTE_MAX
  toEnum Int
unmatched = String -> DeviceAttribute
forall a. HasCallStack => String -> a
error (String
"DeviceAttribute.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 64 "src/Foreign/CUDA/Driver/Device.chs" #-}





-- |
-- Possible option flags for CUDA initialisation. Dummy instance until the API
-- exports actual option values.
--
data InitFlag
instance Enum InitFlag where
  toEnum   x = error ("InitFlag.toEnum: Cannot match " ++ show x)
  fromEnum x = case x of {}


--------------------------------------------------------------------------------
-- Initialisation
--------------------------------------------------------------------------------

-- |
-- Initialise the CUDA driver API. This must be called before any other
-- driver function.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__INITIALIZE.html#group__CUDA__INITIALIZE_1g0a2f1517e1bd8502c7194c3a8c134bc3>
--
{-# INLINEABLE initialise #-}
initialise :: [InitFlag] -> IO ()
initialise !flags = do
  enable_constructors
  cuInit flags

{-# INLINE enable_constructors #-}
enable_constructors :: IO ()
enable_constructors =
  enable_constructors'_ >>
  return ()

{-# LINE 153 "src/Foreign/CUDA/Driver/Device.chs" #-}


{-# INLINE cuInit #-}
cuInit :: ([InitFlag]) -> IO ()
cuInit a1 =
  let {a1' = combineBitMasks a1} in 
  cuInit'_ a1' >>= \res ->
  checkStatus res >> 
  return ()

{-# LINE 157 "src/Foreign/CUDA/Driver/Device.chs" #-}



--------------------------------------------------------------------------------
-- Device Management
--------------------------------------------------------------------------------

-- |
-- Return the compute compatibility revision supported by the device
--
{-# INLINEABLE capability #-}
capability :: Device -> IO Compute
capability !dev =
  Compute <$> attribute dev ComputeCapabilityMajor
          <*> attribute dev ComputeCapabilityMinor


-- |
-- Return a handle to the compute device at the given ordinal.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g8bdd1cc7201304b01357b8034f6587cb>
--
{-# INLINEABLE device #-}
device :: (Int) -> IO ((Device))
device a2 =
  alloca $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  device'_ a1' a2' >>= \res ->
  checkStatus res >> 
  dev  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 198 "src/Foreign/CUDA/Driver/Device.chs" #-}

  where
    dev = liftM Device . peek


-- |
-- Return the selected attribute for the given device.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g9c3e1414f0ad901d3278a4d6645fc266>
--
{-# INLINEABLE attribute #-}
attribute :: Device -> DeviceAttribute -> IO Int
attribute !d !a = cuDeviceGetAttribute a d
  where
    cuDeviceGetAttribute :: (DeviceAttribute) -> (Device) -> IO ((Int))
    cuDeviceGetAttribute a2 a3 =
      alloca $ \a1' -> 
      let {a2' = cFromEnum a2} in 
      let {a3' = useDevice a3} in 
      cuDeviceGetAttribute'_ a1' a2' a3' >>= \res ->
      checkStatus res >> 
      peekIntConv  a1'>>= \a1'' -> 
      return (a1'')

{-# LINE 217 "src/Foreign/CUDA/Driver/Device.chs" #-}



-- |
-- Return the number of device with compute capability > 1.0.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g52b5ce05cb8c5fb6831b2c0ff2887c74>
--
{-# INLINEABLE count #-}
count :: IO ((Int))
count =
  alloca $ \a1' -> 
  count'_ a1' >>= \res ->
  checkStatus res >> 
  peekIntConv  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 229 "src/Foreign/CUDA/Driver/Device.chs" #-}



-- |
-- The identifying name of the device.
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1gef75aa30df95446a845f2a7b9fffbb7f>
--
{-# INLINEABLE name #-}
name :: (Device) -> IO ((String))
name a2 =
  allocaS $ \(a1'1, a1'2) -> 
  let {a2' = useDevice a2} in 
  name'_ a1'1  a1'2 a2' >>= \res ->
  checkStatus res >> 
  peekS  a1'1  a1'2>>= \a1'' -> 
  return (a1'')

{-# LINE 242 "src/Foreign/CUDA/Driver/Device.chs" #-}

  where
    len       = 512
    allocaS a = allocaBytes len $ \p -> a (p, fromIntegral len)
    peekS s _ = peekCString s


-- | Returns a UUID for the device
--
-- Requires CUDA-9.2
--
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1g987b46b884c101ed5be414ab4d9e60e4>
--
-- @since 0.10.0.0
--
{-# INLINE uuid #-}
uuid :: Device -> IO UUID
uuid !dev =
  allocaBytes 16 $ \ptr -> do
    cuDeviceGetUuid ptr dev
    unpack ptr
  where
    {-# INLINE cuDeviceGetUuid #-}
    cuDeviceGetUuid :: (Ptr ()) -> (Device) -> IO ()
    cuDeviceGetUuid a1 a2 =
      let {a1' = id a1} in 
      let {a2' = useDevice a2} in 
      cuDeviceGetUuid'_ a1' a2' >>= \res ->
      checkStatus res >> 
      return ()

{-# LINE 271 "src/Foreign/CUDA/Driver/Device.chs" #-}


    {-# INLINE unpack #-}
    unpack :: Ptr () -> IO UUID
    unpack !p = do
      let !q = castPtr p
      a <- word <$> peekElemOff q  0 <*> peekElemOff q  1 <*> peekElemOff q  2 <*> peekElemOff q  3
      b <- word <$> peekElemOff q  4 <*> peekElemOff q  5 <*> peekElemOff q  6 <*> peekElemOff q  7
      c <- word <$> peekElemOff q  8 <*> peekElemOff q  9 <*> peekElemOff q 10 <*> peekElemOff q 11
      d <- word <$> peekElemOff q 12 <*> peekElemOff q 13 <*> peekElemOff q 14 <*> peekElemOff q 15
      return $! fromWords a b c d

    {-# INLINE word #-}
    word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
    word !a !b !c !d
      =  (fromIntegral a `shiftL` 24)
     .|. (fromIntegral b `shiftL` 16)
     .|. (fromIntegral c `shiftL`  8)
     .|. (fromIntegral d            )


-- |
-- Return the properties of the selected device
--
{-# INLINEABLE props #-}
props :: Device -> IO DeviceProperties
props !d = do

  totalConstMem         <- fromIntegral <$> attribute d TotalConstantMemory
  sharedMemPerBlock     <- fromIntegral <$> attribute d SharedMemoryPerBlock
  memPitch              <- fromIntegral <$> attribute d MaxPitch
  textureAlignment      <- fromIntegral <$> attribute d TextureAlignment
  clockRate             <- attribute d ClockRate
  warpSize              <- attribute d WarpSize
  regsPerBlock          <- attribute d RegistersPerBlock
  maxThreadsPerBlock    <- attribute d MaxThreadsPerBlock
  maxBlockSize          <- (,,) <$> attribute d MaxBlockDimX <*> attribute d MaxBlockDimY <*> attribute d MaxBlockDimZ
  maxGridSize           <- (,,) <$> attribute d MaxGridDimX <*> attribute d MaxGridDimY <*> attribute d MaxGridDimZ

  -- The rest of the properties.
  --
  deviceName                    <- name d
  computeCapability             <- capability d
  totalGlobalMem                <- totalMem d
  multiProcessorCount           <- attribute d MultiprocessorCount
  computeMode                   <- toEnum <$> attribute d ComputeMode
  deviceOverlap                 <- toBool <$> attribute d GpuOverlap
  kernelExecTimeoutEnabled      <- toBool <$> attribute d KernelExecTimeout
  integrated                    <- toBool <$> attribute d Integrated
  canMapHostMemory              <- toBool <$> attribute d CanMapHostMemory
  concurrentKernels             <- toBool <$> attribute d ConcurrentKernels
  eccEnabled                    <- toBool <$> attribute d EccEnabled
  maxTextureDim1D               <- attribute d MaximumTexture1dWidth
  maxTextureDim2D               <- (,)  <$> attribute d MaximumTexture2dWidth <*> attribute d MaximumTexture2dHeight
  maxTextureDim3D               <- (,,) <$> attribute d MaximumTexture3dWidth <*> attribute d MaximumTexture3dHeight <*> attribute d MaximumTexture3dDepth
  asyncEngineCount              <- attribute d AsyncEngineCount
  cacheMemL2                    <- attribute d L2CacheSize
  maxThreadsPerMultiProcessor   <- attribute d MaxThreadsPerMultiprocessor
  memBusWidth                   <- attribute d GlobalMemoryBusWidth
  memClockRate                  <- attribute d MemoryClockRate
  pciInfo                       <- PCI <$> attribute d PciBusId <*> attribute d PciDeviceId <*> attribute d PciDomainId
  unifiedAddressing             <- toBool <$> attribute d UnifiedAddressing
  tccDriverEnabled              <- toBool <$> attribute d TccDriver
  streamPriorities              <- toBool <$> attribute d StreamPrioritiesSupported
  globalL1Cache                 <- toBool <$> attribute d GlobalL1CacheSupported
  localL1Cache                  <- toBool <$> attribute d LocalL1CacheSupported
  managedMemory                 <- toBool <$> attribute d ManagedMemory
  multiGPUBoard                 <- toBool <$> attribute d MultiGpuBoard
  multiGPUBoardGroupID          <- attribute d MultiGpuBoardGroupId
  preemption                    <- toBool <$> attribute d ComputePreemptionSupported
  singleToDoublePerfRatio       <- attribute d SingleToDoublePrecisionPerfRatio
  cooperativeLaunch             <- toBool <$> attribute d CooperativeLaunch
  cooperativeLaunchMultiDevice  <- toBool <$> attribute d CooperativeMultiDeviceLaunch

  return DeviceProperties{..}




-- |
-- The total memory available on the device (bytes).
--
-- <http://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__DEVICE.html#group__CUDA__DEVICE_1gc6a0d6551335a3780f9f3c967a0fde5d>
--
{-# INLINEABLE totalMem #-}
totalMem :: (Device) -> IO ((Int64))
totalMem a2 =
  alloca $ \a1' -> 
  let {a2' = useDevice a2} in 
  totalMem'_ a1' a2' >>= \res ->
  checkStatus res >> 
  peekIntConv  a1'>>= \a1'' -> 
  return (a1'')

{-# LINE 399 "src/Foreign/CUDA/Driver/Device.chs" #-}



foreign import ccall unsafe "Foreign/CUDA/Driver/Device.chs.h enable_constructors"
  enable_constructors'_ :: (IO ())

foreign import ccall unsafe "Foreign/CUDA/Driver/Device.chs.h cuInit"
  cuInit'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Foreign/CUDA/Driver/Device.chs.h cuDeviceGet"
  device'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

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

foreign import ccall unsafe "Foreign/CUDA/Driver/Device.chs.h cuDeviceGetCount"
  count'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))

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

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

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