{-# LINE 1 "src/ArrayFire/Internal/Defines.hsc" #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} module ArrayFire.Internal.Defines where import Foreign.Ptr import Foreign.C.Types import Foreign.Storable afVersion :: Integer afVersion = 38 {-# LINE 17 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFErr = AFErr { afError :: CInt } deriving (Show, Eq) afSuccess :: AFErr afSuccess = AFErr 0 afErrNoMem :: AFErr afErrNoMem = AFErr 101 afErrDriver :: AFErr afErrDriver = AFErr 102 afErrRuntime :: AFErr afErrRuntime = AFErr 103 afErrInvalidArray :: AFErr afErrInvalidArray = AFErr 201 afErrArg :: AFErr afErrArg = AFErr 202 afErrSize :: AFErr afErrSize = AFErr 203 afErrType :: AFErr afErrType = AFErr 204 afErrDiffType :: AFErr afErrDiffType = AFErr 205 afErrBatch :: AFErr afErrBatch = AFErr 207 afErrDevice :: AFErr afErrDevice = AFErr 208 afErrNotSupported :: AFErr afErrNotSupported = AFErr 301 afErrNotConfigured :: AFErr afErrNotConfigured = AFErr 302 afErrNonFree :: AFErr afErrNonFree = AFErr 303 afErrNoDbl :: AFErr afErrNoDbl = AFErr 401 afErrNoGfx :: AFErr afErrNoGfx = AFErr 402 afErrLoadLib :: AFErr afErrLoadLib = AFErr 501 afErrLoadSym :: AFErr afErrLoadSym = AFErr 502 afErrArrBkndMismatch :: AFErr afErrArrBkndMismatch = AFErr 503 afErrInternal :: AFErr afErrInternal = AFErr 998 afErrUnknown :: AFErr afErrUnknown = AFErr 999 {-# LINE 44 "src/ArrayFire/Internal/Defines.hsc" #-} -- | Low-level for representation of ArrayFire types -- | AFDType -- Newtype over ArrayFire's internal type tag newtype AFDtype = AFDtype { afDType :: CInt -- ^ Value corresponding to ArrayFire type } deriving (Show, Eq, Storable) -- | Enums for AFDtype f32 :: AFDtype f32 = AFDtype 0 c32 :: AFDtype c32 = AFDtype 1 f64 :: AFDtype f64 = AFDtype 2 c64 :: AFDtype c64 = AFDtype 3 b8 :: AFDtype b8 = AFDtype 4 s32 :: AFDtype s32 = AFDtype 5 u32 :: AFDtype u32 = AFDtype 6 u8 :: AFDtype u8 = AFDtype 7 s64 :: AFDtype s64 = AFDtype 8 u64 :: AFDtype u64 = AFDtype 9 s16 :: AFDtype s16 = AFDtype 10 u16 :: AFDtype u16 = AFDtype 11 {-# LINE 69 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFSource = AFSource CInt deriving (Ord, Show, Eq) afDevice :: AFSource afDevice = AFSource 0 afHost :: AFSource afHost = AFSource 1 {-# LINE 77 "src/ArrayFire/Internal/Defines.hsc" #-} afMaxDims :: Integer afMaxDims = 4 {-# LINE 80 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFSomeEnum = AFSomeEnum Int deriving (Ord, Show, Eq, Storable) afSomeEnum :: AFSomeEnum afSomeEnum = AFSomeEnum 0 {-# LINE 87 "src/ArrayFire/Internal/Defines.hsc" #-} -- // A handle for an internal array object type AFArray = Ptr () type AFFeatures = Ptr () type AFRandomEngine = Ptr () -- // A handle for an internal array object type AFWindow = Ptr () newtype AFInterpType = AFInterpType CInt deriving (Ord, Show, Eq, Storable) afInterpNearest :: AFInterpType afInterpNearest = AFInterpType 0 afInterpLinear :: AFInterpType afInterpLinear = AFInterpType 1 afInterpBilinear :: AFInterpType afInterpBilinear = AFInterpType 2 afInterpCubic :: AFInterpType afInterpCubic = AFInterpType 3 afInterpLower :: AFInterpType afInterpLower = AFInterpType 4 afInterpLinearCosine :: AFInterpType afInterpLinearCosine = AFInterpType 5 afInterpBilinearCosine :: AFInterpType afInterpBilinearCosine = AFInterpType 6 afInterpBicubic :: AFInterpType afInterpBicubic = AFInterpType 7 afInterpCubicSpline :: AFInterpType afInterpCubicSpline = AFInterpType 8 afInterpBicubicSpline :: AFInterpType afInterpBicubicSpline = AFInterpType 9 {-# LINE 112 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFBorderType = AFBorderType CInt deriving (Ord, Show, Eq, Storable) afBorderPadZero :: AFBorderType afBorderPadZero = AFBorderType 0 afPadSym :: AFBorderType afPadSym = AFBorderType 1 {-# LINE 120 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFConnectivity = AFConnectivity CInt deriving (Ord, Show, Eq, Storable) afConnectivity4 :: AFConnectivity afConnectivity4 = AFConnectivity 4 afConnectivity8 :: AFConnectivity afConnectivity8 = AFConnectivity 8 {-# LINE 128 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFConvMode = AFConvMode CInt deriving (Ord, Show, Eq, Storable) afConvDefault :: AFConvMode afConvDefault = AFConvMode 0 afConvExpand :: AFConvMode afConvExpand = AFConvMode 1 {-# LINE 136 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFConvDomain = AFConvDomain CInt deriving (Ord, Show, Eq, Storable) afConvAuto :: AFConvDomain afConvAuto = AFConvDomain 0 afConvSpatial :: AFConvDomain afConvSpatial = AFConvDomain 1 afConvFreq :: AFConvDomain afConvFreq = AFConvDomain 2 {-# LINE 145 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFMatchType = AFMatchType CInt deriving (Ord, Show, Eq, Storable) afSAD :: AFMatchType afSAD = AFMatchType 0 afZSAD :: AFMatchType afZSAD = AFMatchType 1 afLSAD :: AFMatchType afLSAD = AFMatchType 2 afSSD :: AFMatchType afSSD = AFMatchType 3 afZSSD :: AFMatchType afZSSD = AFMatchType 4 afLSSD :: AFMatchType afLSSD = AFMatchType 5 afNCC :: AFMatchType afNCC = AFMatchType 6 afZNCC :: AFMatchType afZNCC = AFMatchType 7 afSHD :: AFMatchType afSHD = AFMatchType 8 {-# LINE 160 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFYccStd = AFYccStd Int deriving (Ord, Show, Eq, Storable) afYcc601 :: AFYccStd afYcc601 = AFYccStd 601 afYcc709 :: AFYccStd afYcc709 = AFYccStd 709 afYcc2020 :: AFYccStd afYcc2020 = AFYccStd 2020 {-# LINE 169 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFCSpace = AFCSpace Int deriving (Ord, Show, Eq, Storable) afGray :: AFCSpace afGray = AFCSpace 0 afRgb :: AFCSpace afRgb = AFCSpace 1 afHsv :: AFCSpace afHsv = AFCSpace 2 afYCbCr :: AFCSpace afYCbCr = AFCSpace 3 {-# LINE 179 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFMatProp = AFMatProp Int deriving (Ord, Show, Eq, Storable) afMatNone :: AFMatProp afMatNone = AFMatProp 0 afMatTrans :: AFMatProp afMatTrans = AFMatProp 1 afMatCtrans :: AFMatProp afMatCtrans = AFMatProp 2 afMatConj :: AFMatProp afMatConj = AFMatProp 4 afMatUpper :: AFMatProp afMatUpper = AFMatProp 32 afMatLower :: AFMatProp afMatLower = AFMatProp 64 afMatDiagUnit :: AFMatProp afMatDiagUnit = AFMatProp 128 afMatSym :: AFMatProp afMatSym = AFMatProp 512 afMatPosdef :: AFMatProp afMatPosdef = AFMatProp 1024 afMatOrthog :: AFMatProp afMatOrthog = AFMatProp 2048 afMatTriDiag :: AFMatProp afMatTriDiag = AFMatProp 4096 afMatBlockDiag :: AFMatProp afMatBlockDiag = AFMatProp 8192 {-# LINE 197 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFNormType = AFNormType Int deriving (Ord, Show, Eq, Storable) afNormVector1 :: AFNormType afNormVector1 = AFNormType 0 afNormVectorInf :: AFNormType afNormVectorInf = AFNormType 1 afNormVector2 :: AFNormType afNormVector2 = AFNormType 2 afNormVectorP :: AFNormType afNormVectorP = AFNormType 3 afNormMatrix1 :: AFNormType afNormMatrix1 = AFNormType 4 afNormMatrixInf :: AFNormType afNormMatrixInf = AFNormType 5 afNormMatrix2 :: AFNormType afNormMatrix2 = AFNormType 6 afNormMatrixLPq :: AFNormType afNormMatrixLPq = AFNormType 7 afNormEuclid :: AFNormType afNormEuclid = AFNormType 2 {-# LINE 212 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFImageFormat = AFImageFormat Int deriving (Ord, Show, Eq, Storable) afFIFBmp :: AFImageFormat afFIFBmp = AFImageFormat 0 afFIFIco :: AFImageFormat afFIFIco = AFImageFormat 1 afFIFJpeg :: AFImageFormat afFIFJpeg = AFImageFormat 2 afFIFJng :: AFImageFormat afFIFJng = AFImageFormat 3 afFIFPng :: AFImageFormat afFIFPng = AFImageFormat 13 afFIFPpm :: AFImageFormat afFIFPpm = AFImageFormat 14 afFIFPpmraw :: AFImageFormat afFIFPpmraw = AFImageFormat 15 afFIFTiff :: AFImageFormat afFIFTiff = AFImageFormat 18 afFIFPsd :: AFImageFormat afFIFPsd = AFImageFormat 20 afFIFHdr :: AFImageFormat afFIFHdr = AFImageFormat 26 afFIFExr :: AFImageFormat afFIFExr = AFImageFormat 29 afFIFJp2 :: AFImageFormat afFIFJp2 = AFImageFormat 31 afFIFRaw :: AFImageFormat afFIFRaw = AFImageFormat 34 {-# LINE 231 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFMomentType = AFMomentType Int deriving (Ord, Show, Eq, Storable) afMomentM00 :: AFMomentType afMomentM00 = AFMomentType 1 afMomentM01 :: AFMomentType afMomentM01 = AFMomentType 2 afMomentM10 :: AFMomentType afMomentM10 = AFMomentType 4 afMomentM11 :: AFMomentType afMomentM11 = AFMomentType 8 afMomentFirstOrder :: AFMomentType afMomentFirstOrder = AFMomentType 15 {-# LINE 242 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFHomographyType = AFHomographyType CInt deriving (Ord, Show, Eq, Storable) afHomographyRansac :: AFHomographyType afHomographyRansac = AFHomographyType 0 afHomographyLmeds :: AFHomographyType afHomographyLmeds = AFHomographyType 1 {-# LINE 250 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFBackend = AFBackend CInt deriving (Ord, Show, Eq, Storable) afBackendDefault :: AFBackend afBackendDefault = AFBackend 0 afBackendCpu :: AFBackend afBackendCpu = AFBackend 0 afBackendCuda :: AFBackend afBackendCuda = AFBackend 2 afBackendOpencl :: AFBackend afBackendOpencl = AFBackend 4 {-# LINE 260 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFID = AFID CInt deriving (Ord, Show, Eq, Storable) {-# LINE 267 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFBinaryOp = AFBinaryOp CInt deriving (Ord, Show, Eq, Storable) afBinaryAdd :: AFBinaryOp afBinaryAdd = AFBinaryOp 0 afBinaryMul :: AFBinaryOp afBinaryMul = AFBinaryOp 1 afBinaryMin :: AFBinaryOp afBinaryMin = AFBinaryOp 2 afBinaryMax :: AFBinaryOp afBinaryMax = AFBinaryOp 3 {-# LINE 277 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFRandomEngineType = AFRandomEngineType CInt deriving (Ord, Show, Eq, Storable) afRandomEnginePhilox4X3210 :: AFRandomEngineType afRandomEnginePhilox4X3210 = AFRandomEngineType 100 afRandomEngineThreefry2X3216 :: AFRandomEngineType afRandomEngineThreefry2X3216 = AFRandomEngineType 200 afRandomEngineMersenneGp11213 :: AFRandomEngineType afRandomEngineMersenneGp11213 = AFRandomEngineType 300 afRandomEnginePhilox :: AFRandomEngineType afRandomEnginePhilox = AFRandomEngineType 100 afRandomEngineThreefry :: AFRandomEngineType afRandomEngineThreefry = AFRandomEngineType 200 afRandomEngineMersenne :: AFRandomEngineType afRandomEngineMersenne = AFRandomEngineType 300 afRandomEngineDefault :: AFRandomEngineType afRandomEngineDefault = AFRandomEngineType 100 {-# LINE 290 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFColorMap = AFColorMap CInt deriving (Ord, Show, Eq, Storable) afColormapDefault :: AFColorMap afColormapDefault = AFColorMap 0 afColormapSpectrum :: AFColorMap afColormapSpectrum = AFColorMap 1 afColormapColors :: AFColorMap afColormapColors = AFColorMap 2 afColormapRed :: AFColorMap afColormapRed = AFColorMap 3 afColormapMood :: AFColorMap afColormapMood = AFColorMap 4 afColormapHeat :: AFColorMap afColormapHeat = AFColorMap 5 afColormapBlue :: AFColorMap afColormapBlue = AFColorMap 6 afColormapInferno :: AFColorMap afColormapInferno = AFColorMap 7 afColormapMagma :: AFColorMap afColormapMagma = AFColorMap 8 afColormapPlasma :: AFColorMap afColormapPlasma = AFColorMap 9 afColormapViridis :: AFColorMap afColormapViridis = AFColorMap 10 {-# LINE 307 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFMarkerType = AFMarkerType CInt deriving (Ord, Show, Eq, Storable) afMarkerNone :: AFMarkerType afMarkerNone = AFMarkerType 0 afMarkerPoint :: AFMarkerType afMarkerPoint = AFMarkerType 1 afMarkerCircle :: AFMarkerType afMarkerCircle = AFMarkerType 2 afMarkerSquare :: AFMarkerType afMarkerSquare = AFMarkerType 3 afMarkerTriangle :: AFMarkerType afMarkerTriangle = AFMarkerType 4 afMarkerCross :: AFMarkerType afMarkerCross = AFMarkerType 5 afMarkerPlus :: AFMarkerType afMarkerPlus = AFMarkerType 6 afMarkerStar :: AFMarkerType afMarkerStar = AFMarkerType 7 {-# LINE 321 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFCannyThreshold = AFCannyThreshold CInt deriving (Ord, Show, Eq, Storable) afCannyThresholdManual :: AFCannyThreshold afCannyThresholdManual = AFCannyThreshold 0 afCannyThresholdAutoOtsu :: AFCannyThreshold afCannyThresholdAutoOtsu = AFCannyThreshold 1 {-# LINE 329 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFStorage = AFStorage CInt deriving (Ord, Show, Eq, Storable) afStorageDense :: AFStorage afStorageDense = AFStorage 0 afStorageCsr :: AFStorage afStorageCsr = AFStorage 1 afStorageCsc :: AFStorage afStorageCsc = AFStorage 2 afStorageCoo :: AFStorage afStorageCoo = AFStorage 3 {-# LINE 339 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFFluxFunction = AFFluxFunction CInt deriving (Ord, Show, Eq, Storable) afFluxQuadratic :: AFFluxFunction afFluxQuadratic = AFFluxFunction 1 afFluxExponential :: AFFluxFunction afFluxExponential = AFFluxFunction 2 afFluxDefault :: AFFluxFunction afFluxDefault = AFFluxFunction 0 {-# LINE 348 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFDiffusionEq = AFDiffusionEq CInt deriving (Ord, Show, Eq, Storable) afDiffusionGrad :: AFDiffusionEq afDiffusionGrad = AFDiffusionEq 1 afDiffusionMcde :: AFDiffusionEq afDiffusionMcde = AFDiffusionEq 2 afDiffusionDefault :: AFDiffusionEq afDiffusionDefault = AFDiffusionEq 0 {-# LINE 357 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFTopkFunction = AFTopkFunction CInt deriving (Ord, Show, Eq, Storable) afTopkMin :: AFTopkFunction afTopkMin = AFTopkFunction 1 afTopkMax :: AFTopkFunction afTopkMax = AFTopkFunction 2 afTopkDefault :: AFTopkFunction afTopkDefault = AFTopkFunction 0 {-# LINE 366 "src/ArrayFire/Internal/Defines.hsc" #-} newtype AFIterativeDeconvAlgo = AFIterativeDeconvAlgo CInt deriving (Ord, Show, Eq, Storable) -- #{enum AFIterativeDeconvAlgo, AFIterativeDeconvAlgo -- , afIterativeDeconvLandweber = AF_ITERATIVE_DECONV_LANDWEBER -- , afIterativeDeconvRichardsonlucy = AF_ITERATIVE_DECONV_RICHARDSONLUCY -- , afIterativeDeconvDefault = AF_ITERATIVE_DECONV_DEFAULT -- } newtype AFInverseDeconvAlgo = AFInverseDeconvAlgo CInt deriving (Ord, Show, Eq, Storable) {-# LINE 383 "src/ArrayFire/Internal/Defines.hsc" #-} -- newtype AFVarBias = AFVarBias Int -- deriving (Ord, Show, Eq) -- #{enum AFVarBias, AFVarBias -- , afVarianceDefault = AF_VARIANCE_DEFAULT -- , afVarianceSample = AF_VARIANCE_SAMPLE -- , afVariancePopulation = AF_VARIANCE_POPULATION -- } newtype DimT = DimT CLLong deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) newtype UIntL = UIntL CULLong deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) newtype IntL = IntL CLLong deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) -- static const af_seq af_span = {1, 1, 0}; -- newtype AFCLPlatform = AFCLPlatform Int -- deriving (Show, Eq) -- #{enum AFCLPlatform, AFCLPlatform -- , afclPlatformAMD = AFCL_PLATFORM_AMD -- , afclPlatformApple = AFCL_PLATFORM_APPLE -- , afclPlatformIntel = AFCL_PLATFORM_INTEL -- , afclPlatformNVIDIA = AFCL_PLATFORM_NVIDIA -- , afclPlatformBEIGNET = AFCL_PLATFORM_BEIGNET -- , afclPlatformPOCL = AFCL_PLATFORM_POCL -- , afclPlatformUnknown = AFCL_PLATFORM_UNKNOWN -- } -- newtype DeviceType = DeviceType Int -- deriving (Show, Eq) -- #{enum DeviceType, DeviceType -- , afCLDeviceTypeCPU = AFCL_DEVICE_TYPE_CPU -- , afCLDeviceTypeGPU = AFCL_DEVICE_TYPE_GPU -- , afCLDeviceTypeAccel = AFCL_DEVICE_TYPE_ACCEL -- , afCLDeviceTypeUnknown = AFCL_DEVICE_TYPE_UNKNOWN -- }