OpenCLWrappers 0.0.1.0 → 0.1.0.0

raw patch · 12 files changed

+97/−33 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• OpenCLWrappers.cabal +1/−1
• System/OpenCL/Wrappers/CommandQueue.hs +2/−1
• System/OpenCL/Wrappers/Context.hs +7/−6
• System/OpenCL/Wrappers/DeviceInfo.hs +2/−1
• System/OpenCL/Wrappers/EventObject.hs +4/−2
• System/OpenCL/Wrappers/Helpers.hs +63/−12
• System/OpenCL/Wrappers/Kernel.hs +4/−2
• System/OpenCL/Wrappers/MemoryObject.hs +5/−2
• System/OpenCL/Wrappers/ProgramObject.hs +2/−1
• System/OpenCL/Wrappers/Raw.hs +1/−1
• System/OpenCL/Wrappers/Sampler.hs +2/−1
• System/OpenCL/Wrappers/Types.hs +4/−3

@@ -1,5 +1,5 @@ name: OpenCLWrappers-version: 0.0.1.0+version: 0.1.0.0 cabal-version: >=1.2 build-type: Simple license: BSD3

@@ -33,7 +33,8 @@             | c == clQueueContext        -> peekOneInfo CommandQueueInfoRetvalContext x             | c == clQueueDevice         -> peekOneInfo CommandQueueInfoRetvalDeviceID x             | c == clQueueReferenceCount -> peekOneInfo CommandQueueInfoRetvalCLuint x-            | c == clQueueProperties     -> peekOneInfo CommandQueueInfoRetvalCommandQueueProperties x)+            | c == clQueueProperties     -> peekOneInfo CommandQueueInfoRetvalCommandQueueProperties x+            | otherwise                  -> undefined)  {-# DEPRECATED clSetCommandQueueProperty "Deprecated in C api" #-} clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO (Either ErrorCode CommandQueueProperties)

@@ -10,19 +10,19 @@ import System.OpenCL.Wrappers.Types import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw-import Foreign.Ptr(Ptr, nullPtr, nullFunPtr)+import Foreign.Ptr(Ptr, nullPtr, nullFunPtr,ptrToIntPtr) import Foreign.Marshal.Array(withArray)   clCreateContext :: [ContextProperties] -> [DeviceID] -> (Maybe ContextCallback) -> Ptr () -> IO (Either ErrorCode Context)-clCreateContext properties devices pfn_notify user_dat =-    withArrayNull0 nullPtr properties $ \propertiesP -> withArray devices $ \devicesP -> do+clCreateContext props devices pfn_notify user_dat =+    withArrayNull0 (ContextProperties$ptrToIntPtr nullPtr) props $ \propertiesP -> withArray devices $ \devicesP -> do         fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify-        wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat             +        wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat      where devicesN = length devices            clCreateContextFromType :: [ContextProperties] -> DeviceType -> (Maybe ContextCallback) -> Ptr () -> IO (Either ErrorCode Context)-clCreateContextFromType properties (DeviceType device_type) pfn_notify user_data = withArrayNull0 nullPtr properties $ \propertiesP -> do+clCreateContextFromType props (DeviceType device_type) pfn_notify user_data = withArrayNull0 (ContextProperties$ptrToIntPtr nullPtr) props $ \propertiesP -> do     fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify     wrapErrorEither $ raw_clCreateContextFromType propertiesP device_type fptr user_data     @@ -38,4 +38,5 @@         ()             | c == clContextReferenceCount -> peekOneInfo ContextInfoRetvalCLuint x             | c == clContextDevices        -> peekManyInfo ContextInfoRetvalDeviceIDList x size-            | c == clContextProperties     -> peekManyInfo ContextInfoRetvalContextPropertiesList x size )+            | c == clContextProperties     -> peekManyInfo ContextInfoRetvalContextPropertiesList x size+            | otherwise                    -> undefined)

@@ -66,4 +66,5 @@             | c == clDeviceVendor                     -> peekStringInfo DeviceInfoRetvalString x             | c == clDeviceVendorID                   -> peekOneInfo DeviceInfoRetvalCLuint x             | c == clDeviceVersion                    -> peekStringInfo DeviceInfoRetvalString x-            | c == clDriverVersion                    -> peekStringInfo DeviceInfoRetvalString x)+            | c == clDriverVersion                    -> peekStringInfo DeviceInfoRetvalString x+            | otherwise                               -> undefined)

@@ -23,7 +23,8 @@             | c == clEventCommandQueue           -> peekOneInfo EventInfoRetvalCommandQueue x             | c == clEventCommandType            -> peekOneInfo EventInfoRetvalCommandType x             | c == clEventCommandExecutionStatus -> peekOneInfo EventInfoRetvalCLint x-            | c == clEventReferenceCount         -> peekOneInfo EventInfoRetvalCLuint x )+            | c == clEventReferenceCount         -> peekOneInfo EventInfoRetvalCLuint x+            | otherwise                          -> undefined)  clRetainEvent :: Event -> IO (Maybe ErrorCode) clRetainEvent evt = wrapError $ raw_clRetainEvent evt@@ -38,4 +39,5 @@             | c == clProfilingCommandQueued -> peekOneInfo EventProfilingInfoRetvalCLulong x             | c == clProfilingCommandSubmit -> peekOneInfo EventProfilingInfoRetvalCLulong x             | c == clProfilingCommandStart  -> peekOneInfo EventProfilingInfoRetvalCLulong x-            | c == clProfilingCommandEnd    -> peekOneInfo EventProfilingInfoRetvalCLulong x )+            | c == clProfilingCommandEnd    -> peekOneInfo EventProfilingInfoRetvalCLulong x+            | otherwise                     -> undefined)

@@ -4,37 +4,42 @@     (createSyncKernel     ,createAsyncKernelWithParams     ,buildProgram-    ,pushKernelParams)+    ,pushKernelParams+    ,errorCodeToString+    ,KernelParameter(..)) where  import System.OpenCL.Wrappers.Kernel import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.ProgramObject+import System.OpenCL.Wrappers.EventObject import System.OpenCL.Wrappers.FlushFinish import Foreign.Marshal import Foreign.Storable import Foreign.Ptr -pushKernelParams :: forall b. Storable b => Kernel -> CLuint -> [b] -> IO (Maybe ErrorCode)-pushKernelParams kernel argNum (x:xs) = +data KernelParameter = forall s. Storable s => KParam s++pushKernelParams :: Kernel -> CLuint -> [KernelParameter] -> IO (Maybe ErrorCode)+pushKernelParams kernel argNum ((KParam x):xs) =      withArray [x] (\y -> clSetKernelArg kernel argNum (fromIntegral.sizeOf $ x) (castPtr y)) >>=         maybe (pushKernelParams kernel (argNum + 1) xs) (return.Just) pushKernelParams _ _ _ = return Nothing -syncKernelFun :: forall b. Storable b => CLuint -> Kernel -> CommandQueue -> [CLsizei] -> [CLsizei] -> [b] -> IO (Maybe ErrorCode)-syncKernelFun _ kernel queue a b [] =-        clEnqueueNDRangeKernel queue kernel a b [] >>=-            either (return.Just) (\_ -> clFinish queue >>= maybe (return Nothing) (return.Just))-syncKernelFun argNum kernel queue a b (x:xs) =-        withArray [x] (\y -> clSetKernelArg kernel argNum (fromIntegral.sizeOf $ x) (castPtr y)) >>=-            maybe (syncKernelFun (argNum + 1) kernel queue a b xs) (return.Just)+syncKernelFun :: CLuint -> Kernel -> CommandQueue -> [CLsizei] -> [CLsizei] -> [KernelParameter] -> IO (Maybe ErrorCode)+syncKernelFun argNum kernel queue a b xs =+    pushKernelParams kernel argNum xs >>=+        maybe (clEnqueueNDRangeKernel queue kernel a b [] >>=+            either (return.Just) (\ev -> clReleaseEvent ev >>=+                maybe (clFinish queue >>= maybe (return Nothing) (return.Just)) (return.Just))) (return.Just) -createSyncKernel :: forall b. Storable b => Program -> CommandQueue -> String -> [Int] -> [Int] -> IO (Either ErrorCode ([b] -> IO (Maybe ErrorCode)))+createSyncKernel :: Program -> CommandQueue -> String -> [Int] -> [Int] -> IO (Either ErrorCode ([KernelParameter] -> IO (Maybe ErrorCode))) createSyncKernel program queue initFun globalWorkRange localWorkRange =         clCreateKernel program initFun >>=             either (return.Left) (\k -> return.Right $ syncKernelFun 0 k queue (map fromIntegral globalWorkRange) (map fromIntegral localWorkRange)) -createAsyncKernelWithParams :: forall b. Storable b => Program -> CommandQueue -> String -> [Int] -> [Int] -> [b] -> IO (Either ErrorCode ([Event] -> IO (Either ErrorCode Event)))+createAsyncKernelWithParams :: Program -> CommandQueue -> String -> [Int] -> [Int] -> [KernelParameter] -> IO (Either ErrorCode ([Event] -> IO (Either ErrorCode Event))) createAsyncKernelWithParams program queue initFun globalWorkRange localWorkRange params =         clCreateKernel program initFun >>=             either (return.Left) (\k -> pushKernelParams k 0 params >>=@@ -54,4 +59,50 @@         either (\x -> return (x,"")) (\x -> case x of             (ProgramBuildInfoRetvalString s) -> return (eCode,s)             _                                -> undefined) ++errorCodeToString :: ErrorCode -> String+errorCodeToString e+  | e == clSuccess = "Success"+  | e == clDeviceNotFound = "Device not found"+  | e == clDeviceNotAvailable = "Device not available"+  | e == clCompilerNotAvailable = "Compiler not available"+  | e == clMemObjectAllocationFailure = "Memory object allocation failure"+  | e == clOutOfResources = "Out of resources"+  | e == clOutOfHostMemory = "Out of host memory"+  | e == clProfilingInfoNotAvailable = "Profiling information not available"+  | e == clMemCopyOverlap = "Memory copy overlap"+  | e == clImageFormatMismatch = "Image format mismatch"+  | e == clImageFormatNotSupported = "Image format not supported"+  | e == clMapFailure = "Map failure"+  | e == clInvalidValue = "Invalid value"+  | e == clInvalidDeviceType = "Invalid device type"+  | e == clInvalidPlatform = "Invalid platform"+  | e == clInvalidDevice = "Invalid device"+  | e == clInvalidContext = "Invalid context"+  | e == clInvalidQueueProperties = "Invalid queue properties"+  | e == clInvalidCommandQueue = "Invalid command queue"+  | e == clInvalidHostPtr = "Invalid host pointer"+  | e == clInvalidImageFormatDescriptor = "Invalid image format descriptor"+  | e == clInvalidImageSize = "Invalid image size"+  | e == clInvalidSampler = "Invalid sampler"+  | e == clInvalidBinary = "Invalid binary"+  | e == clInvalidBuildOptions = "Invalid build options"+  | e == clInvalidProgram = "Invalid program"+  | e == clInvalidProgramExecutable = "Invalid program executable"+  | e == clInvalidKernelName = "Invalid kernel name"+  | e == clInvalidArgIndex = "Invalid argument index"+  | e == clInvalidArgValue = "Invalid argument value"+  | e == clInvalidArgSize = "Invalid argument size"+  | e == clInvalidKernelArgs = "Invalid kernel arguments"+  | e == clInvalidWorkDimension = "Invalid work dimension"+  | e == clInvalidWorkGroupSize = "Invalid work group size"+  | e == clInvalidWorkItemSize = "Invalid work item size"+  | e == clInvalidGlobalOffset = "Invalid global offset"+  | e == clInvalidEventWaitList = "Invalid event wait list"+  | e == clInvalidEvent = "Invalid event"+  | e == clInvalidOperation = "Invalid operation"+  | e == clInvalidGLObject = "Invalid OpenGL object"+  | e == clInvalidBufferSize = "Invalid buffer size"+  | e == clInvalidMipLevel = "Invalid MIP level"+  | otherwise = "Unknown error" 

@@ -51,7 +51,8 @@             | c == clKernelNumArgs        -> peekOneInfo KernelInfoRetvalCLuint x             | c == clKernelReferenceCount -> peekOneInfo KernelInfoRetvalCLuint x             | c == clKernelContext        -> peekOneInfo KernelInfoRetvalContext x-            | c == clKernelProgram        -> peekOneInfo KernelInfoRetvalProgram x)+            | c == clKernelProgram        -> peekOneInfo KernelInfoRetvalProgram x+            | otherwise                   -> undefined)  clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> KernelWorkGroupInfo -> IO (Either ErrorCode CLKernelWorkGroupInfoRetval) clGetKernelWorkGroupInfo kernel device (KernelWorkGroupInfo param_name) = (wrapGetInfo $ raw_clGetKernelWorkGroupInfo kernel device param_name) >>=@@ -59,7 +60,8 @@         ()             | c == clKernelWorkGroupSize        -> peekOneInfo KernelWorkGroupInfoRetvalCLsizei x             | c == clKernelCompileWorkGroupSize -> peekManyInfo KernelWorkGroupInfoRetvalCLsizeiList x size-            | c == clKernelLocalMemSize         -> peekOneInfo KernelWorkGroupInfoRetvalCLulong x)+            | c == clKernelLocalMemSize         -> peekOneInfo KernelWorkGroupInfoRetvalCLulong x+            | otherwise                         -> undefined)  clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> [CLsizei] -> [CLsizei] -> [Event] -> IO (Either ErrorCode Event)  clEnqueueNDRangeKernel queue kernel global_work_sizeL local_work_sizeL event_wait_listL = 

@@ -54,6 +54,7 @@               image_formatsN <- peekArray (fromIntegral num_image_formatsN*2) image_formats               let sift (a:b:cs) = (ChannelOrder a,ChannelType b) : sift cs                   sift [] = [] +                  sift _  = undefined --peekArray returned a list of uneven length               return . Right $ sift image_formatsN )           (return . Left)            err@@ -68,7 +69,8 @@             | c == clMemHostPtr        -> peekOneInfo MemObjectInfoRetvalPtr x             | c == clMemMapCount       -> peekOneInfo MemObjectInfoRetvalCLuint x             | c == clMemReferenceCount -> peekOneInfo MemObjectInfoRetvalCLuint x-            | c == clMemContext        -> peekOneInfo MemObjectInfoRetvalContext x)+            | c == clMemContext        -> peekOneInfo MemObjectInfoRetvalContext x+            | otherwise                -> undefined)  clGetImageInfo :: Mem -> MemInfo -> IO (Either ErrorCode CLImageInfoRetval) clGetImageInfo mem (MemInfo param_name) = (wrapGetInfo $ raw_clGetImageInfo mem param_name) >>=@@ -79,7 +81,8 @@             | c == clImageSlicePitch  -> peekOneInfo ImageInfoRetvalCLsizei x             | c == clImageWidth       -> peekOneInfo ImageInfoRetvalCLsizei x             | c == clImageHeight      -> peekOneInfo ImageInfoRetvalCLsizei x-            | c == clImageDepth       -> peekOneInfo ImageInfoRetvalCLsizei x)+            | c == clImageDepth       -> peekOneInfo ImageInfoRetvalCLsizei x+            | otherwise               -> undefined)          enqueue :: (CommandQueue -> CLuint -> Ptr Event -> Ptr Event -> IO CLint) -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)       enqueue fn queue events = alloca $ \event -> withArrayNull events $ \event_wait_list -> do

@@ -71,7 +71,8 @@             | c == clProgramDevices        -> peekManyInfo ProgramInfoRetvalDeviceIDList x size             | c == clProgramSource         -> peekStringInfo ProgramInfoRetvalString x             | c == clProgramBinarySizes    -> peekManyInfo ProgramInfoRetvalCLsizeiList x size-            | c == clProgramBinaries       -> peekManyInfo ProgramInfoRetvalPtrList x size )+            | c == clProgramBinaries       -> peekManyInfo ProgramInfoRetvalPtrList x size+            | otherwise                    -> undefined)  clGetProgramBuildInfo :: Program -> DeviceID -> ProgramBuildInfo -> IO (Either ErrorCode CLProgramBuildInfoRetval) clGetProgramBuildInfo program devID (ProgramBuildInfo param_name) = (wrapGetInfo $ raw_clGetProgramBuildInfo program devID param_name) >>=

@@ -88,7 +88,7 @@ foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CommandQueue -> IO CLint foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CommandQueue -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CommandQueue -> CLbitfield -> CLbool -> Ptr CLbitfield -> IO CLint-foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr (Ptr CLint) -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context+foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr ContextProperties -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: Ptr ContextProperties -> CLbitfield -> FunPtr ContextCallback -> Ptr a -> Ptr CLint -> IO Context foreign import ccall "clRetainContext" raw_clRetainContext :: Context -> IO CLint foreign import ccall "clReleaseContext" raw_clReleaseContext :: Context -> IO CLint

@@ -29,5 +29,6 @@             | c == clSamplerContext          -> peekOneInfo SamplerInfoRetvalContext x             | c == clSamplerAddressingMode   -> peekOneInfo SamplerInfoRetvalAddressingMode x             | c == clSamplerFilterMode       -> peekOneInfo SamplerInfoRetvalFilterMode x-            | c == clSamplerNormalizedCoords -> peekOneInfo SamplerInfoRetvalCLbool x)+            | c == clSamplerNormalizedCoords -> peekOneInfo SamplerInfoRetvalCLbool x+            | otherwise                      -> undefined) 

@@ -17,7 +17,6 @@ data Samplerc = Samplerc data ImageFormatc = ImageFormatc -type ContextProperties = Ptr CLint type PlatformID = Ptr PlatformIDc type DeviceID = Ptr DeviceIDc type Context = Ptr Contextc@@ -39,6 +38,8 @@ type ImageFormat = (ChannelOrder,ChannelType) type ImageDims = (CLsizei,CLsizei,CLsizei) +newtype ContextProperties = ContextProperties IntPtr+    deriving (Eq,Storable) newtype ChannelOrder = ChannelOrder CLuint     deriving (Eq) newtype ChannelType = ChannelType CLuint@@ -377,8 +378,8 @@ clContextProperties :: ContextInfo  clContextProperties = ContextInfo 0x1082 -clContextPlatform = 0x1084-+clContextPlatform :: ContextProperties+clContextPlatform = ContextProperties 0x1084   clKernelFunctionName  :: KernelInfo