-- GENERATED by C->Haskell Compiler, version 0.16.6 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}
 {-# LANGUAGE EmptyDataDecls, DeriveDataTypeable #-}
-- |
-- Module      : Foreign.OpenCL.Bindings.Internal.Types
-- Copyright   : (c) 2011, Martin Dybdal
-- License     : BSD3
-- 
-- Maintainer  : Martin Dybdal <dybber@dybber.dk>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Foreign.OpenCL.Bindings.Internal.Types (
  CPlatformID, CDeviceID, CContext, CCommandQueue, CProgram, CKernel, CEvent, CSampler,
  ClContext, ClCommandQueue, ClProgram, ClKernel, ClEvent, ClSampler, ClMem,

  PlatformID, DeviceID, Context, CommandQueue, Program, Kernel, Event, Sampler, MemObject(..),

  ClChar, ClUChar, ClShort, ClUShort, ClInt, ClUInt, ClLong, ClULong, ClHalf,
  ClFloat, ClDouble,

  ClBitfield, ClBool, ClSize,

  clFalse, clTrue, toOCLBool,
  
  ClException(..), ClError(..),

  PlatformInfo(..), ContextProperties(..), ClContextProperties(..), ContextInfo(..),
  DeviceType(..), DeviceInfo(..), DeviceFPConfig(..), DeviceMemCacheType(..),
  DeviceLocalMemType(..), DeviceExecCapabilities(..),
  CommandQueueProperties(..), CommandQueueInfo(..), CommandExecStatus(..),
  ProgramInfo(..), ProgramBuildInfo(..), KernelInfo(..), KernelWorkGroupInfo(..),
  EventInfo(..), CommandType(..),
  MemFlags(..), MemInfo(..), MemObjectType(..),
)
where



  
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types

import Control.Exception hiding (assert)
import Data.Typeable

-- Abstract types
data CPlatformID
data CDeviceID
data CContext
data CCommandQueue
data CMem
data CProgram
data CKernel
data CEvent
data CSampler

-- | Type representing OpenCL memory objects
data MemObject a = MemObject
   { memobjPtr :: ClMem -- ^Pointer to the underlying memory object
   }

type PlatformID = Ptr (CPlatformID)
{-# LINE 63 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type DeviceID = Ptr (CDeviceID)
{-# LINE 64 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClContext = Ptr (CContext)
{-# LINE 65 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClCommandQueue = Ptr (CCommandQueue)
{-# LINE 66 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClMem = Ptr (CMem)
{-# LINE 67 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClProgram = Ptr (CProgram)
{-# LINE 68 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClKernel = Ptr (CKernel)
{-# LINE 69 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClEvent = Ptr (CEvent)
{-# LINE 70 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClSampler = Ptr (CSampler)
{-# LINE 71 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


type Context = ForeignPtr (CContext)
{-# LINE 73 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type CommandQueue = ForeignPtr (CCommandQueue)
{-# LINE 74 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type Program = ForeignPtr (CProgram)
{-# LINE 75 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type Kernel = ForeignPtr (CKernel)
{-# LINE 76 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type Event = ForeignPtr (CEvent)
{-# LINE 77 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type Sampler = ForeignPtr (CSampler)
{-# LINE 78 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}



-- Integral types
type ClChar = (CSChar)
{-# LINE 82 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClUChar = (CUChar)
{-# LINE 83 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClShort = (CShort)
{-# LINE 84 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClUShort = (CUShort)
{-# LINE 85 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClInt = (CInt)
{-# LINE 86 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClUInt = (CUInt)
{-# LINE 87 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClLong = (CLLong)
{-# LINE 88 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClULong = (CULLong)
{-# LINE 89 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClHalf = (CUShort)
{-# LINE 90 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Floating points
type ClFloat = (CFloat)
{-# LINE 93 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClDouble = (CDouble)
{-# LINE 94 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Other
type ClSize = (CULong)
{-# LINE 97 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

type ClBitfield = (CULLong)
{-# LINE 98 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Boolean values
data ClBool = ClFalse
            | ClTrue
            deriving (Show,Eq)
instance Enum ClBool where
  fromEnum ClFalse = 0
  fromEnum ClTrue = 1

  toEnum 0 = ClFalse
  toEnum 1 = ClTrue
  toEnum unmatched = error ("ClBool.toEnum: Cannot match " ++ show unmatched)

{-# LINE 101 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

clFalse, clTrue :: ClUInt
clFalse = fromIntegral $ fromEnum ClFalse
clTrue = fromIntegral $ fromEnum ClTrue

toOCLBool :: Bool -> ClUInt
toOCLBool True = clTrue
toOCLBool False = clFalse

-- Errors
data ClError = Success
             | DeviceNotFound
             | DeviceNotAvailable
             | CompilerNotAvailable
             | MemObjectAllocationFailure
             | OutOfResources
             | OutOfHostMemory
             | ProfilingInfoNotAvailable
             | MemCopyOverlap
             | ImageFormatMismatch
             | ImageFormatNotSupported
             | BuildProgramFailure
             | MapFailure
             | MisalignedSubBufferOffset
             | ExecStatusErrorForEventsInWaitList
             | InvalidValue
             | InvalidDeviceType
             | InvalidPlatform
             | InvalidDevice
             | InvalidContext
             | InvalidQueueProperties
             | InvalidCommandQueue
             | InvalidHostPtr
             | InvalidMemObject
             | InvalidImageFormatDescriptor
             | InvalidImageSize
             | InvalidSampler
             | InvalidBinary
             | InvalidBuildOptions
             | InvalidProgram
             | InvalidProgramExecutable
             | InvalidKernelName
             | InvalidKernelDefinition
             | InvalidKernel
             | InvalidArgIndex
             | InvalidArgValue
             | InvalidArgSize
             | InvalidKernelArgs
             | InvalidWorkDimension
             | InvalidWorkGroupSize
             | InvalidWorkItemSize
             | InvalidGlobalOffset
             | InvalidEventWaitList
             | InvalidEvent
             | InvalidOperation
             | InvalidGlObject
             | InvalidBufferSize
             | InvalidMipLevel
             | InvalidGlobalWorkSize
             | InvalidProperty
             deriving (Show,Eq)
instance Enum ClError where
  fromEnum Success = 0
  fromEnum DeviceNotFound = (-1)
  fromEnum DeviceNotAvailable = (-2)
  fromEnum CompilerNotAvailable = (-3)
  fromEnum MemObjectAllocationFailure = (-4)
  fromEnum OutOfResources = (-5)
  fromEnum OutOfHostMemory = (-6)
  fromEnum ProfilingInfoNotAvailable = (-7)
  fromEnum MemCopyOverlap = (-8)
  fromEnum ImageFormatMismatch = (-9)
  fromEnum ImageFormatNotSupported = (-10)
  fromEnum BuildProgramFailure = (-11)
  fromEnum MapFailure = (-12)
  fromEnum MisalignedSubBufferOffset = (-13)
  fromEnum ExecStatusErrorForEventsInWaitList = (-14)
  fromEnum InvalidValue = (-30)
  fromEnum InvalidDeviceType = (-31)
  fromEnum InvalidPlatform = (-32)
  fromEnum InvalidDevice = (-33)
  fromEnum InvalidContext = (-34)
  fromEnum InvalidQueueProperties = (-35)
  fromEnum InvalidCommandQueue = (-36)
  fromEnum InvalidHostPtr = (-37)
  fromEnum InvalidMemObject = (-38)
  fromEnum InvalidImageFormatDescriptor = (-39)
  fromEnum InvalidImageSize = (-40)
  fromEnum InvalidSampler = (-41)
  fromEnum InvalidBinary = (-42)
  fromEnum InvalidBuildOptions = (-43)
  fromEnum InvalidProgram = (-44)
  fromEnum InvalidProgramExecutable = (-45)
  fromEnum InvalidKernelName = (-46)
  fromEnum InvalidKernelDefinition = (-47)
  fromEnum InvalidKernel = (-48)
  fromEnum InvalidArgIndex = (-49)
  fromEnum InvalidArgValue = (-50)
  fromEnum InvalidArgSize = (-51)
  fromEnum InvalidKernelArgs = (-52)
  fromEnum InvalidWorkDimension = (-53)
  fromEnum InvalidWorkGroupSize = (-54)
  fromEnum InvalidWorkItemSize = (-55)
  fromEnum InvalidGlobalOffset = (-56)
  fromEnum InvalidEventWaitList = (-57)
  fromEnum InvalidEvent = (-58)
  fromEnum InvalidOperation = (-59)
  fromEnum InvalidGlObject = (-60)
  fromEnum InvalidBufferSize = (-61)
  fromEnum InvalidMipLevel = (-62)
  fromEnum InvalidGlobalWorkSize = (-63)
  fromEnum InvalidProperty = (-64)

  toEnum 0 = Success
  toEnum (-1) = DeviceNotFound
  toEnum (-2) = DeviceNotAvailable
  toEnum (-3) = CompilerNotAvailable
  toEnum (-4) = MemObjectAllocationFailure
  toEnum (-5) = OutOfResources
  toEnum (-6) = OutOfHostMemory
  toEnum (-7) = ProfilingInfoNotAvailable
  toEnum (-8) = MemCopyOverlap
  toEnum (-9) = ImageFormatMismatch
  toEnum (-10) = ImageFormatNotSupported
  toEnum (-11) = BuildProgramFailure
  toEnum (-12) = MapFailure
  toEnum (-13) = MisalignedSubBufferOffset
  toEnum (-14) = ExecStatusErrorForEventsInWaitList
  toEnum (-30) = InvalidValue
  toEnum (-31) = InvalidDeviceType
  toEnum (-32) = InvalidPlatform
  toEnum (-33) = InvalidDevice
  toEnum (-34) = InvalidContext
  toEnum (-35) = InvalidQueueProperties
  toEnum (-36) = InvalidCommandQueue
  toEnum (-37) = InvalidHostPtr
  toEnum (-38) = InvalidMemObject
  toEnum (-39) = InvalidImageFormatDescriptor
  toEnum (-40) = InvalidImageSize
  toEnum (-41) = InvalidSampler
  toEnum (-42) = InvalidBinary
  toEnum (-43) = InvalidBuildOptions
  toEnum (-44) = InvalidProgram
  toEnum (-45) = InvalidProgramExecutable
  toEnum (-46) = InvalidKernelName
  toEnum (-47) = InvalidKernelDefinition
  toEnum (-48) = InvalidKernel
  toEnum (-49) = InvalidArgIndex
  toEnum (-50) = InvalidArgValue
  toEnum (-51) = InvalidArgSize
  toEnum (-52) = InvalidKernelArgs
  toEnum (-53) = InvalidWorkDimension
  toEnum (-54) = InvalidWorkGroupSize
  toEnum (-55) = InvalidWorkItemSize
  toEnum (-56) = InvalidGlobalOffset
  toEnum (-57) = InvalidEventWaitList
  toEnum (-58) = InvalidEvent
  toEnum (-59) = InvalidOperation
  toEnum (-60) = InvalidGlObject
  toEnum (-61) = InvalidBufferSize
  toEnum (-62) = InvalidMipLevel
  toEnum (-63) = InvalidGlobalWorkSize
  toEnum (-64) = InvalidProperty
  toEnum unmatched = error ("ClError.toEnum: Cannot match " ++ show unmatched)

{-# LINE 111 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


data ClException = ClException ClError (Maybe String)
     deriving Typeable

instance Exception ClException

instance Show ClException where
  show (ClException err (Just loc)) =
    "OpenCL Exception: " ++ show err ++ " occurred in call to: " ++ loc
  show (ClException err Nothing) =
    "OpenCL Exception: " ++ show err



-- Platform
data PlatformInfo = PlatformProfile
                  | PlatformVersion
                  | PlatformName
                  | PlatformVendor
                  | PlatformExtensions
                  deriving (Show,Eq)
instance Enum PlatformInfo where
  fromEnum PlatformProfile = 2304
  fromEnum PlatformVersion = 2305
  fromEnum PlatformName = 2306
  fromEnum PlatformVendor = 2307
  fromEnum PlatformExtensions = 2308

  toEnum 2304 = PlatformProfile
  toEnum 2305 = PlatformVersion
  toEnum 2306 = PlatformName
  toEnum 2307 = PlatformVendor
  toEnum 2308 = PlatformExtensions
  toEnum unmatched = error ("PlatformInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 127 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Contexts
data ClContextProperties = ClContextPlatform
                         deriving (Show,Eq)
instance Enum ClContextProperties where
  fromEnum ClContextPlatform = 4228

  toEnum 4228 = ClContextPlatform
  toEnum unmatched = error ("ClContextProperties.toEnum: Cannot match " ++ show unmatched)

{-# LINE 130 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- wrapper that contains the actual PlatformID
data ContextProperties = ContextPlatform PlatformID
                         deriving (Show,Eq)

data ContextInfo = ContextReferenceCount
                 | ContextDevices
                 | ContextProperties
                 | ContextNumDevices
                 deriving (Show,Eq)
instance Enum ContextInfo where
  fromEnum ContextReferenceCount = 4224
  fromEnum ContextDevices = 4225
  fromEnum ContextProperties = 4226
  fromEnum ContextNumDevices = 4227

  toEnum 4224 = ContextReferenceCount
  toEnum 4225 = ContextDevices
  toEnum 4226 = ContextProperties
  toEnum 4227 = ContextNumDevices
  toEnum unmatched = error ("ContextInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 136 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Devices
data DeviceType = DeviceTypeDefault
                | DeviceTypeCpu
                | DeviceTypeGpu
                | DeviceTypeAccelerator
                | DeviceTypeAll
                deriving (Show,Eq)
instance Enum DeviceType where
  fromEnum DeviceTypeDefault = 1
  fromEnum DeviceTypeCpu = 2
  fromEnum DeviceTypeGpu = 4
  fromEnum DeviceTypeAccelerator = 8
  fromEnum DeviceTypeAll = 4294967295

  toEnum 1 = DeviceTypeDefault
  toEnum 2 = DeviceTypeCpu
  toEnum 4 = DeviceTypeGpu
  toEnum 8 = DeviceTypeAccelerator
  toEnum 4294967295 = DeviceTypeAll
  toEnum unmatched = error ("DeviceType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 139 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data DeviceInfo = DeviceType
                | DeviceVendorID
                | DeviceMaxComputeUnits
                | DeviceMaxWorkItemDimensions
                | DeviceMaxWorkGroupSize
                | DeviceMaxWorkItemSizes
                | DevicePreferredVectorWidthChar
                | DevicePreferredVectorWidthShort
                | DevicePreferredVectorWidthInt
                | DevicePreferredVectorWidthLong
                | DevicePreferredVectorWidthFloat
                | DevicePreferredVectorWidthDouble
                | DeviceMaxClockFrequency
                | DeviceAddressBits
                | DeviceMaxReadImageArgs
                | DeviceMaxWriteImageArgs
                | DeviceMaxMemAllocSize
                | DeviceImage2DMaxWidth
                | DeviceImage2DMaxHeight
                | DeviceImage3DMaxWidth
                | DeviceImage3DMaxHeight
                | DeviceImage3DMaxDepth
                | DeviceImageSupport
                | DeviceMaxParameterSize
                | DeviceMaxSamplers
                | DeviceMemBaseAddrAlign
                | DeviceMinDataTypeAlignSize
                | DeviceSingleFPConfig
                | DeviceGlobalMemCacheType
                | DeviceGlobalMemCachelineSize
                | DeviceGlobalMemCacheSize
                | DeviceGlobalMemSize
                | DeviceMaxConstantBufferSize
                | DeviceMaxConstantArgs
                | DeviceLocalMemType
                | DeviceLocalMemSize
                | DeviceErrorCorrectionSupport
                | DeviceProfilingTimerResolution
                | DeviceEndianLittle
                | DeviceAvailable
                | DeviceCompilerAvailable
                | DeviceExecutionCapabilities
                | DeviceQueueProperties
                | DeviceName
                | DeviceVendor
                | DriverVersion
                | DeviceProfile
                | DeviceVersion
                | DeviceExtensions
                | DevicePlatform
                | DevicePreferredVectorWidthHalf
                | DeviceHostUnifiedMemory
                | DeviceNativeVectorWidthChar
                | DeviceNativeVectorWidthShort
                | DeviceNativeVectorWidthInt
                | DeviceNativeVectorWidthLong
                | DeviceNativeVectorWidthFloat
                | DeviceNativeVectorWidthDouble
                | DeviceNativeVectorWidthHalf
                | DeviceOpenclCVersion
                deriving (Show,Eq)
instance Enum DeviceInfo where
  fromEnum DeviceType = 4096
  fromEnum DeviceVendorID = 4097
  fromEnum DeviceMaxComputeUnits = 4098
  fromEnum DeviceMaxWorkItemDimensions = 4099
  fromEnum DeviceMaxWorkGroupSize = 4100
  fromEnum DeviceMaxWorkItemSizes = 4101
  fromEnum DevicePreferredVectorWidthChar = 4102
  fromEnum DevicePreferredVectorWidthShort = 4103
  fromEnum DevicePreferredVectorWidthInt = 4104
  fromEnum DevicePreferredVectorWidthLong = 4105
  fromEnum DevicePreferredVectorWidthFloat = 4106
  fromEnum DevicePreferredVectorWidthDouble = 4107
  fromEnum DeviceMaxClockFrequency = 4108
  fromEnum DeviceAddressBits = 4109
  fromEnum DeviceMaxReadImageArgs = 4110
  fromEnum DeviceMaxWriteImageArgs = 4111
  fromEnum DeviceMaxMemAllocSize = 4112
  fromEnum DeviceImage2DMaxWidth = 4113
  fromEnum DeviceImage2DMaxHeight = 4114
  fromEnum DeviceImage3DMaxWidth = 4115
  fromEnum DeviceImage3DMaxHeight = 4116
  fromEnum DeviceImage3DMaxDepth = 4117
  fromEnum DeviceImageSupport = 4118
  fromEnum DeviceMaxParameterSize = 4119
  fromEnum DeviceMaxSamplers = 4120
  fromEnum DeviceMemBaseAddrAlign = 4121
  fromEnum DeviceMinDataTypeAlignSize = 4122
  fromEnum DeviceSingleFPConfig = 4123
  fromEnum DeviceGlobalMemCacheType = 4124
  fromEnum DeviceGlobalMemCachelineSize = 4125
  fromEnum DeviceGlobalMemCacheSize = 4126
  fromEnum DeviceGlobalMemSize = 4127
  fromEnum DeviceMaxConstantBufferSize = 4128
  fromEnum DeviceMaxConstantArgs = 4129
  fromEnum DeviceLocalMemType = 4130
  fromEnum DeviceLocalMemSize = 4131
  fromEnum DeviceErrorCorrectionSupport = 4132
  fromEnum DeviceProfilingTimerResolution = 4133
  fromEnum DeviceEndianLittle = 4134
  fromEnum DeviceAvailable = 4135
  fromEnum DeviceCompilerAvailable = 4136
  fromEnum DeviceExecutionCapabilities = 4137
  fromEnum DeviceQueueProperties = 4138
  fromEnum DeviceName = 4139
  fromEnum DeviceVendor = 4140
  fromEnum DriverVersion = 4141
  fromEnum DeviceProfile = 4142
  fromEnum DeviceVersion = 4143
  fromEnum DeviceExtensions = 4144
  fromEnum DevicePlatform = 4145
  fromEnum DevicePreferredVectorWidthHalf = 4148
  fromEnum DeviceHostUnifiedMemory = 4149
  fromEnum DeviceNativeVectorWidthChar = 4150
  fromEnum DeviceNativeVectorWidthShort = 4151
  fromEnum DeviceNativeVectorWidthInt = 4152
  fromEnum DeviceNativeVectorWidthLong = 4153
  fromEnum DeviceNativeVectorWidthFloat = 4154
  fromEnum DeviceNativeVectorWidthDouble = 4155
  fromEnum DeviceNativeVectorWidthHalf = 4156
  fromEnum DeviceOpenclCVersion = 4157

  toEnum 4096 = DeviceType
  toEnum 4097 = DeviceVendorID
  toEnum 4098 = DeviceMaxComputeUnits
  toEnum 4099 = DeviceMaxWorkItemDimensions
  toEnum 4100 = DeviceMaxWorkGroupSize
  toEnum 4101 = DeviceMaxWorkItemSizes
  toEnum 4102 = DevicePreferredVectorWidthChar
  toEnum 4103 = DevicePreferredVectorWidthShort
  toEnum 4104 = DevicePreferredVectorWidthInt
  toEnum 4105 = DevicePreferredVectorWidthLong
  toEnum 4106 = DevicePreferredVectorWidthFloat
  toEnum 4107 = DevicePreferredVectorWidthDouble
  toEnum 4108 = DeviceMaxClockFrequency
  toEnum 4109 = DeviceAddressBits
  toEnum 4110 = DeviceMaxReadImageArgs
  toEnum 4111 = DeviceMaxWriteImageArgs
  toEnum 4112 = DeviceMaxMemAllocSize
  toEnum 4113 = DeviceImage2DMaxWidth
  toEnum 4114 = DeviceImage2DMaxHeight
  toEnum 4115 = DeviceImage3DMaxWidth
  toEnum 4116 = DeviceImage3DMaxHeight
  toEnum 4117 = DeviceImage3DMaxDepth
  toEnum 4118 = DeviceImageSupport
  toEnum 4119 = DeviceMaxParameterSize
  toEnum 4120 = DeviceMaxSamplers
  toEnum 4121 = DeviceMemBaseAddrAlign
  toEnum 4122 = DeviceMinDataTypeAlignSize
  toEnum 4123 = DeviceSingleFPConfig
  toEnum 4124 = DeviceGlobalMemCacheType
  toEnum 4125 = DeviceGlobalMemCachelineSize
  toEnum 4126 = DeviceGlobalMemCacheSize
  toEnum 4127 = DeviceGlobalMemSize
  toEnum 4128 = DeviceMaxConstantBufferSize
  toEnum 4129 = DeviceMaxConstantArgs
  toEnum 4130 = DeviceLocalMemType
  toEnum 4131 = DeviceLocalMemSize
  toEnum 4132 = DeviceErrorCorrectionSupport
  toEnum 4133 = DeviceProfilingTimerResolution
  toEnum 4134 = DeviceEndianLittle
  toEnum 4135 = DeviceAvailable
  toEnum 4136 = DeviceCompilerAvailable
  toEnum 4137 = DeviceExecutionCapabilities
  toEnum 4138 = DeviceQueueProperties
  toEnum 4139 = DeviceName
  toEnum 4140 = DeviceVendor
  toEnum 4141 = DriverVersion
  toEnum 4142 = DeviceProfile
  toEnum 4143 = DeviceVersion
  toEnum 4144 = DeviceExtensions
  toEnum 4145 = DevicePlatform
  toEnum 4148 = DevicePreferredVectorWidthHalf
  toEnum 4149 = DeviceHostUnifiedMemory
  toEnum 4150 = DeviceNativeVectorWidthChar
  toEnum 4151 = DeviceNativeVectorWidthShort
  toEnum 4152 = DeviceNativeVectorWidthInt
  toEnum 4153 = DeviceNativeVectorWidthLong
  toEnum 4154 = DeviceNativeVectorWidthFloat
  toEnum 4155 = DeviceNativeVectorWidthDouble
  toEnum 4156 = DeviceNativeVectorWidthHalf
  toEnum 4157 = DeviceOpenclCVersion
  toEnum unmatched = error ("DeviceInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 140 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data DeviceFPConfig = FpDenorm
                    | FpInfNan
                    | FpRoundToNearest
                    | FpRoundToZero
                    | FpRoundToInf
                    | FpFma
                    | FpSoftFloat
                    deriving (Show,Eq)
instance Enum DeviceFPConfig where
  fromEnum FpDenorm = 1
  fromEnum FpInfNan = 2
  fromEnum FpRoundToNearest = 4
  fromEnum FpRoundToZero = 8
  fromEnum FpRoundToInf = 16
  fromEnum FpFma = 32
  fromEnum FpSoftFloat = 64

  toEnum 1 = FpDenorm
  toEnum 2 = FpInfNan
  toEnum 4 = FpRoundToNearest
  toEnum 8 = FpRoundToZero
  toEnum 16 = FpRoundToInf
  toEnum 32 = FpFma
  toEnum 64 = FpSoftFloat
  toEnum unmatched = error ("DeviceFPConfig.toEnum: Cannot match " ++ show unmatched)

{-# LINE 141 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data DeviceMemCacheType = None
                        | ReadOnlyCache
                        | ReadWriteCache
                        deriving (Show,Eq)
instance Enum DeviceMemCacheType where
  fromEnum None = 0
  fromEnum ReadOnlyCache = 1
  fromEnum ReadWriteCache = 2

  toEnum 0 = None
  toEnum 1 = ReadOnlyCache
  toEnum 2 = ReadWriteCache
  toEnum unmatched = error ("DeviceMemCacheType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 142 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data DeviceLocalMemType = Local
                        | Global
                        deriving (Show,Eq)
instance Enum DeviceLocalMemType where
  fromEnum Local = 1
  fromEnum Global = 2

  toEnum 1 = Local
  toEnum 2 = Global
  toEnum unmatched = error ("DeviceLocalMemType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 143 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data DeviceExecCapabilities = ExecKernel
                            | ExecNativeKernel
                            deriving (Show,Eq)
instance Enum DeviceExecCapabilities where
  fromEnum ExecKernel = 1
  fromEnum ExecNativeKernel = 2

  toEnum 1 = ExecKernel
  toEnum 2 = ExecNativeKernel
  toEnum unmatched = error ("DeviceExecCapabilities.toEnum: Cannot match " ++ show unmatched)

{-# LINE 144 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Command Queue
data CommandQueueInfo = QueueContext
                      | QueueDevice
                      | QueueReferenceCount
                      | QueueProperties
                      deriving (Show,Eq)
instance Enum CommandQueueInfo where
  fromEnum QueueContext = 4240
  fromEnum QueueDevice = 4241
  fromEnum QueueReferenceCount = 4242
  fromEnum QueueProperties = 4243

  toEnum 4240 = QueueContext
  toEnum 4241 = QueueDevice
  toEnum 4242 = QueueReferenceCount
  toEnum 4243 = QueueProperties
  toEnum unmatched = error ("CommandQueueInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 147 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data CommandQueueProperties = QueueOutOfOrderExecModeEnable
                            | QueueProfilingEnable
                            deriving (Show,Eq)
instance Enum CommandQueueProperties where
  fromEnum QueueOutOfOrderExecModeEnable = 1
  fromEnum QueueProfilingEnable = 2

  toEnum 1 = QueueOutOfOrderExecModeEnable
  toEnum 2 = QueueProfilingEnable
  toEnum unmatched = error ("CommandQueueProperties.toEnum: Cannot match " ++ show unmatched)

{-# LINE 148 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data ClCommandExecStatus = ClComplete
                         | ClRunning
                         | ClSubmitted
                         | ClQueued
                         deriving (Show,Eq)
instance Enum ClCommandExecStatus where
  fromEnum ClComplete = 0
  fromEnum ClRunning = 1
  fromEnum ClSubmitted = 2
  fromEnum ClQueued = 3

  toEnum 0 = ClComplete
  toEnum 1 = ClRunning
  toEnum 2 = ClSubmitted
  toEnum 3 = ClQueued
  toEnum unmatched = error ("ClCommandExecStatus.toEnum: Cannot match " ++ show unmatched)

{-# LINE 149 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- wrapper that supports errornous states 
-- See page 145 in the OpenCL specification, v1.1

data CommandExecStatus = Complete
                       | Running
                       | Submitted
                       | Queued
                       | Error Int
                       deriving (Show,Eq)
instance Enum CommandExecStatus where
  fromEnum Complete = fromEnum ClComplete
  fromEnum Running = fromEnum ClRunning
  fromEnum Submitted = fromEnum ClSubmitted
  fromEnum Queued = fromEnum ClQueued
  fromEnum (Error n) = n

  toEnum 0 = Complete
  toEnum 1 = Running
  toEnum 2 = Submitted
  toEnum 3 = Queued
  toEnum n | n < 0 = Error n
           | otherwise = error ("CommandExecStatus.toEnum: Cannot match " ++ show n)

-- Program objects
data ProgramInfo = ProgramReferenceCount
                 | ProgramContext
                 | ProgramNumDevices
                 | ProgramDevices
                 | ProgramSource
                 | ProgramBinarySizes
                 | ProgramBinaries
                 deriving (Show,Eq)
instance Enum ProgramInfo where
  fromEnum ProgramReferenceCount = 4448
  fromEnum ProgramContext = 4449
  fromEnum ProgramNumDevices = 4450
  fromEnum ProgramDevices = 4451
  fromEnum ProgramSource = 4452
  fromEnum ProgramBinarySizes = 4453
  fromEnum ProgramBinaries = 4454

  toEnum 4448 = ProgramReferenceCount
  toEnum 4449 = ProgramContext
  toEnum 4450 = ProgramNumDevices
  toEnum 4451 = ProgramDevices
  toEnum 4452 = ProgramSource
  toEnum 4453 = ProgramBinarySizes
  toEnum 4454 = ProgramBinaries
  toEnum unmatched = error ("ProgramInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 175 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data ProgramBuildInfo = ProgramBuildStatus
                      | ProgramBuildOptions
                      | ProgramBuildLog
                      deriving (Show,Eq)
instance Enum ProgramBuildInfo where
  fromEnum ProgramBuildStatus = 4481
  fromEnum ProgramBuildOptions = 4482
  fromEnum ProgramBuildLog = 4483

  toEnum 4481 = ProgramBuildStatus
  toEnum 4482 = ProgramBuildOptions
  toEnum 4483 = ProgramBuildLog
  toEnum unmatched = error ("ProgramBuildInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 176 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data BuildStatus = BuildSuccess
                 | BuildNone
                 | BuildError
                 | BuildInProgress
                 deriving (Show,Eq)
instance Enum BuildStatus where
  fromEnum BuildSuccess = 0
  fromEnum BuildNone = (-1)
  fromEnum BuildError = (-2)
  fromEnum BuildInProgress = (-3)

  toEnum 0 = BuildSuccess
  toEnum (-1) = BuildNone
  toEnum (-2) = BuildError
  toEnum (-3) = BuildInProgress
  toEnum unmatched = error ("BuildStatus.toEnum: Cannot match " ++ show unmatched)

{-# LINE 177 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Kernels
data KernelInfo = KernelFunctionName
                | KernelNumArgs
                | KernelReferenceCount
                | KernelContext
                | KernelProgram
                deriving (Show,Eq)
instance Enum KernelInfo where
  fromEnum KernelFunctionName = 4496
  fromEnum KernelNumArgs = 4497
  fromEnum KernelReferenceCount = 4498
  fromEnum KernelContext = 4499
  fromEnum KernelProgram = 4500

  toEnum 4496 = KernelFunctionName
  toEnum 4497 = KernelNumArgs
  toEnum 4498 = KernelReferenceCount
  toEnum 4499 = KernelContext
  toEnum 4500 = KernelProgram
  toEnum unmatched = error ("KernelInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 180 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data KernelWorkGroupInfo = KernelWorkGroupSize
                         | KernelCompileWorkGroupSize
                         | KernelLocalMemSize
                         | KernelPreferredWorkGroupSizeMultiple
                         | KernelPrivateMemSize
                         deriving (Show,Eq)
instance Enum KernelWorkGroupInfo where
  fromEnum KernelWorkGroupSize = 4528
  fromEnum KernelCompileWorkGroupSize = 4529
  fromEnum KernelLocalMemSize = 4530
  fromEnum KernelPreferredWorkGroupSizeMultiple = 4531
  fromEnum KernelPrivateMemSize = 4532

  toEnum 4528 = KernelWorkGroupSize
  toEnum 4529 = KernelCompileWorkGroupSize
  toEnum 4530 = KernelLocalMemSize
  toEnum 4531 = KernelPreferredWorkGroupSizeMultiple
  toEnum 4532 = KernelPrivateMemSize
  toEnum unmatched = error ("KernelWorkGroupInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 181 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Memory Objects
data MemFlags = MemReadWrite
              | MemWriteOnly
              | MemReadOnly
              | MemUseHostPtr
              | MemAllocHostPtr
              | MemCopyHostPtr
              deriving (Show,Eq)
instance Enum MemFlags where
  fromEnum MemReadWrite = 1
  fromEnum MemWriteOnly = 2
  fromEnum MemReadOnly = 4
  fromEnum MemUseHostPtr = 8
  fromEnum MemAllocHostPtr = 16
  fromEnum MemCopyHostPtr = 32

  toEnum 1 = MemReadWrite
  toEnum 2 = MemWriteOnly
  toEnum 4 = MemReadOnly
  toEnum 8 = MemUseHostPtr
  toEnum 16 = MemAllocHostPtr
  toEnum 32 = MemCopyHostPtr
  toEnum unmatched = error ("MemFlags.toEnum: Cannot match " ++ show unmatched)

{-# LINE 184 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data MemObjectType = MemObjectBuffer
                   | MemObjectImage2D
                   | MemObjectImage3D
                   deriving (Show,Eq)
instance Enum MemObjectType where
  fromEnum MemObjectBuffer = 4336
  fromEnum MemObjectImage2D = 4337
  fromEnum MemObjectImage3D = 4338

  toEnum 4336 = MemObjectBuffer
  toEnum 4337 = MemObjectImage2D
  toEnum 4338 = MemObjectImage3D
  toEnum unmatched = error ("MemObjectType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 185 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data MemInfo = MemType
             | MemFlags
             | MemSize
             | MemHostPtr
             | MemMapCount
             | MemReferenceCount
             | MemContext
             | MemAssociatedMemobject
             | MemOffset
             deriving (Show,Eq)
instance Enum MemInfo where
  fromEnum MemType = 4352
  fromEnum MemFlags = 4353
  fromEnum MemSize = 4354
  fromEnum MemHostPtr = 4355
  fromEnum MemMapCount = 4356
  fromEnum MemReferenceCount = 4357
  fromEnum MemContext = 4358
  fromEnum MemAssociatedMemobject = 4359
  fromEnum MemOffset = 4360

  toEnum 4352 = MemType
  toEnum 4353 = MemFlags
  toEnum 4354 = MemSize
  toEnum 4355 = MemHostPtr
  toEnum 4356 = MemMapCount
  toEnum 4357 = MemReferenceCount
  toEnum 4358 = MemContext
  toEnum 4359 = MemAssociatedMemobject
  toEnum 4360 = MemOffset
  toEnum unmatched = error ("MemInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 186 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data BufferCreateType = BufferCreateTypeRegion
                      deriving (Show,Eq)
instance Enum BufferCreateType where
  fromEnum BufferCreateTypeRegion = 4640

  toEnum 4640 = BufferCreateTypeRegion
  toEnum unmatched = error ("BufferCreateType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 187 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Events
data EventInfo = EventCommandQueue
               | EventCommandType
               | EventReferenceCount
               | EventCommandExecutionStatus
               | EventContext
               deriving (Show,Eq)
instance Enum EventInfo where
  fromEnum EventCommandQueue = 4560
  fromEnum EventCommandType = 4561
  fromEnum EventReferenceCount = 4562
  fromEnum EventCommandExecutionStatus = 4563
  fromEnum EventContext = 4564

  toEnum 4560 = EventCommandQueue
  toEnum 4561 = EventCommandType
  toEnum 4562 = EventReferenceCount
  toEnum 4563 = EventCommandExecutionStatus
  toEnum 4564 = EventContext
  toEnum unmatched = error ("EventInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 190 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data CommandType = CommandNdrangeKernel
                 | CommandTask
                 | CommandNativeKernel
                 | CommandReadBuffer
                 | CommandWriteBuffer
                 | CommandCopyBuffer
                 | CommandReadImage
                 | CommandWriteImage
                 | CommandCopyImage
                 | CommandCopyImageToBuffer
                 | CommandCopyBufferToImage
                 | CommandMapBuffer
                 | CommandMapImage
                 | CommandUnmapMemObject
                 | CommandMarker
                 | CommandAcquireGlObjects
                 | CommandReleaseGlObjects
                 | CommandReadBufferRect
                 | CommandWriteBufferRect
                 | CommandCopyBufferRect
                 | CommandUser
                 deriving (Show,Eq)
instance Enum CommandType where
  fromEnum CommandNdrangeKernel = 4592
  fromEnum CommandTask = 4593
  fromEnum CommandNativeKernel = 4594
  fromEnum CommandReadBuffer = 4595
  fromEnum CommandWriteBuffer = 4596
  fromEnum CommandCopyBuffer = 4597
  fromEnum CommandReadImage = 4598
  fromEnum CommandWriteImage = 4599
  fromEnum CommandCopyImage = 4600
  fromEnum CommandCopyImageToBuffer = 4601
  fromEnum CommandCopyBufferToImage = 4602
  fromEnum CommandMapBuffer = 4603
  fromEnum CommandMapImage = 4604
  fromEnum CommandUnmapMemObject = 4605
  fromEnum CommandMarker = 4606
  fromEnum CommandAcquireGlObjects = 4607
  fromEnum CommandReleaseGlObjects = 4608
  fromEnum CommandReadBufferRect = 4609
  fromEnum CommandWriteBufferRect = 4610
  fromEnum CommandCopyBufferRect = 4611
  fromEnum CommandUser = 4612

  toEnum 4592 = CommandNdrangeKernel
  toEnum 4593 = CommandTask
  toEnum 4594 = CommandNativeKernel
  toEnum 4595 = CommandReadBuffer
  toEnum 4596 = CommandWriteBuffer
  toEnum 4597 = CommandCopyBuffer
  toEnum 4598 = CommandReadImage
  toEnum 4599 = CommandWriteImage
  toEnum 4600 = CommandCopyImage
  toEnum 4601 = CommandCopyImageToBuffer
  toEnum 4602 = CommandCopyBufferToImage
  toEnum 4603 = CommandMapBuffer
  toEnum 4604 = CommandMapImage
  toEnum 4605 = CommandUnmapMemObject
  toEnum 4606 = CommandMarker
  toEnum 4607 = CommandAcquireGlObjects
  toEnum 4608 = CommandReleaseGlObjects
  toEnum 4609 = CommandReadBufferRect
  toEnum 4610 = CommandWriteBufferRect
  toEnum 4611 = CommandCopyBufferRect
  toEnum 4612 = CommandUser
  toEnum unmatched = error ("CommandType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 191 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Images
data ClChannelOrder = ClR
                    | ClA
                    | ClRg
                    | ClRa
                    | ClRgb
                    | ClRgba
                    | ClBgra
                    | ClArgb
                    | ClIntensity
                    | ClLuminance
                    | ClRx
                    | ClRgx
                    | ClRgbx
                    deriving (Show,Eq)
instance Enum ClChannelOrder where
  fromEnum ClR = 4272
  fromEnum ClA = 4273
  fromEnum ClRg = 4274
  fromEnum ClRa = 4275
  fromEnum ClRgb = 4276
  fromEnum ClRgba = 4277
  fromEnum ClBgra = 4278
  fromEnum ClArgb = 4279
  fromEnum ClIntensity = 4280
  fromEnum ClLuminance = 4281
  fromEnum ClRx = 4282
  fromEnum ClRgx = 4283
  fromEnum ClRgbx = 4284

  toEnum 4272 = ClR
  toEnum 4273 = ClA
  toEnum 4274 = ClRg
  toEnum 4275 = ClRa
  toEnum 4276 = ClRgb
  toEnum 4277 = ClRgba
  toEnum 4278 = ClBgra
  toEnum 4279 = ClArgb
  toEnum 4280 = ClIntensity
  toEnum 4281 = ClLuminance
  toEnum 4282 = ClRx
  toEnum 4283 = ClRgx
  toEnum 4284 = ClRgbx
  toEnum unmatched = error ("ClChannelOrder.toEnum: Cannot match " ++ show unmatched)

{-# LINE 194 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data ClChannelType = ClSnormInt8
                   | ClSnormInt16
                   | ClUnormInt8
                   | ClUnormInt16
                   | ClUnormShort565
                   | ClUnormShort555
                   | ClUnormInt101010
                   | ClSignedInt8
                   | ClSignedInt16
                   | ClSignedInt32
                   | ClUnsignedInt8
                   | ClUnsignedInt16
                   | ClUnsignedInt32
                   | ClHalfFloat
                   | ClFloat
                   deriving (Show,Eq)
instance Enum ClChannelType where
  fromEnum ClSnormInt8 = 4304
  fromEnum ClSnormInt16 = 4305
  fromEnum ClUnormInt8 = 4306
  fromEnum ClUnormInt16 = 4307
  fromEnum ClUnormShort565 = 4308
  fromEnum ClUnormShort555 = 4309
  fromEnum ClUnormInt101010 = 4310
  fromEnum ClSignedInt8 = 4311
  fromEnum ClSignedInt16 = 4312
  fromEnum ClSignedInt32 = 4313
  fromEnum ClUnsignedInt8 = 4314
  fromEnum ClUnsignedInt16 = 4315
  fromEnum ClUnsignedInt32 = 4316
  fromEnum ClHalfFloat = 4317
  fromEnum ClFloat = 4318

  toEnum 4304 = ClSnormInt8
  toEnum 4305 = ClSnormInt16
  toEnum 4306 = ClUnormInt8
  toEnum 4307 = ClUnormInt16
  toEnum 4308 = ClUnormShort565
  toEnum 4309 = ClUnormShort555
  toEnum 4310 = ClUnormInt101010
  toEnum 4311 = ClSignedInt8
  toEnum 4312 = ClSignedInt16
  toEnum 4313 = ClSignedInt32
  toEnum 4314 = ClUnsignedInt8
  toEnum 4315 = ClUnsignedInt16
  toEnum 4316 = ClUnsignedInt32
  toEnum 4317 = ClHalfFloat
  toEnum 4318 = ClFloat
  toEnum unmatched = error ("ClChannelType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 195 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data ImageInfo = ImageFormat
               | ImageElementSize
               | ImageRowPitch
               | ImageSlicePitch
               | ImageWidth
               | ImageHeight
               | ImageDepth
               deriving (Show,Eq)
instance Enum ImageInfo where
  fromEnum ImageFormat = 4368
  fromEnum ImageElementSize = 4369
  fromEnum ImageRowPitch = 4370
  fromEnum ImageSlicePitch = 4371
  fromEnum ImageWidth = 4372
  fromEnum ImageHeight = 4373
  fromEnum ImageDepth = 4374

  toEnum 4368 = ImageFormat
  toEnum 4369 = ImageElementSize
  toEnum 4370 = ImageRowPitch
  toEnum 4371 = ImageSlicePitch
  toEnum 4372 = ImageWidth
  toEnum 4373 = ImageHeight
  toEnum 4374 = ImageDepth
  toEnum unmatched = error ("ImageInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 196 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Sampler
data SamplerInfo = SamplerReferenceCount
                 | SamplerContext
                 | SamplerNormalizedCoords
                 | SamplerAddressingMode
                 | SamplerFilterMode
                 deriving (Show,Eq)
instance Enum SamplerInfo where
  fromEnum SamplerReferenceCount = 4432
  fromEnum SamplerContext = 4433
  fromEnum SamplerNormalizedCoords = 4434
  fromEnum SamplerAddressingMode = 4435
  fromEnum SamplerFilterMode = 4436

  toEnum 4432 = SamplerReferenceCount
  toEnum 4433 = SamplerContext
  toEnum 4434 = SamplerNormalizedCoords
  toEnum 4435 = SamplerAddressingMode
  toEnum 4436 = SamplerFilterMode
  toEnum unmatched = error ("SamplerInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 199 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data FilterMode = FilterNearest
                | FilterLinear
                deriving (Show,Eq)
instance Enum FilterMode where
  fromEnum FilterNearest = 4416
  fromEnum FilterLinear = 4417

  toEnum 4416 = FilterNearest
  toEnum 4417 = FilterLinear
  toEnum unmatched = error ("FilterMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 200 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data AddressingMode = AddressNone
                    | AddressClampToEdge
                    | AddressClamp
                    | AddressRepeat
                    | AddressMirroredRepeat
                    deriving (Show,Eq)
instance Enum AddressingMode where
  fromEnum AddressNone = 4400
  fromEnum AddressClampToEdge = 4401
  fromEnum AddressClamp = 4402
  fromEnum AddressRepeat = 4403
  fromEnum AddressMirroredRepeat = 4404

  toEnum 4400 = AddressNone
  toEnum 4401 = AddressClampToEdge
  toEnum 4402 = AddressClamp
  toEnum 4403 = AddressRepeat
  toEnum 4404 = AddressMirroredRepeat
  toEnum unmatched = error ("AddressingMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 201 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}


-- Other
data MapFlags = MapRead
              | MapWrite
              deriving (Show,Eq)
instance Enum MapFlags where
  fromEnum MapRead = 1
  fromEnum MapWrite = 2

  toEnum 1 = MapRead
  toEnum 2 = MapWrite
  toEnum unmatched = error ("MapFlags.toEnum: Cannot match " ++ show unmatched)

{-# LINE 204 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}

data ProfilingInfo = ProfilingCommandQueued
                   | ProfilingCommandSubmit
                   | ProfilingCommandStart
                   | ProfilingCommandEnd
                   deriving (Show,Eq)
instance Enum ProfilingInfo where
  fromEnum ProfilingCommandQueued = 4736
  fromEnum ProfilingCommandSubmit = 4737
  fromEnum ProfilingCommandStart = 4738
  fromEnum ProfilingCommandEnd = 4739

  toEnum 4736 = ProfilingCommandQueued
  toEnum 4737 = ProfilingCommandSubmit
  toEnum 4738 = ProfilingCommandStart
  toEnum 4739 = ProfilingCommandEnd
  toEnum unmatched = error ("ProfilingInfo.toEnum: Cannot match " ++ show unmatched)

{-# LINE 205 "Foreign/OpenCL/Bindings/Internal/Types.chs" #-}