Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Exception Improvements and other changes #5

Merged
merged 5 commits into from

2 participants

@dagit

Hello,

Thanks for creating the OpenCLRaw bindings. They make an excellent starting point for me to experiment with OpenCL using Haskell. This is a pull request based on some improvements that I made. I realize that my "improvements" may not be seen as such by everyone, so allow me to justify them.

I tried using OpenCLRaw but I kept running into heavily nested exception checking like this:

case foo of
  Left err -> ...
  Right val -> ...

I talked the design over with a bunch of Haskell programmers at work and we came to the conclusion that throwing extensible exceptions would be the best approach for FFI wrappers such as this. Two guys commented that they tried the IO (Either Error a) style in the past and that switching it to extensible exceptions made coding easier and safer (with the exception style the API forces the check on the return code of each C function and the code is shorter with less emphasis on the exceptional/rare execution paths).

I started a branch to do the conversion and while I was at it I also cleaned up all the warnings, found a few typos (functions that weren't exported, calling the wrong C function inside the Haskell wrapper, cabal syntax tweaks, see the diffs for details).

I also noticed that in some cases I could remove explicit alloca/peek usages by adding the function fetchPtr. I probably haven't found all the places to start using it, but in the few places I did add it I think it simplifies things a bit. I also made the wrap* functions more general.

Are you still actively maintaining OpenCLRaw? If so, are you interested in the changes in my exceptions branch? If you're not actively maintaining it, would it be okay with you if I uploaded newer versions of the package to Hackage? I'm okay with uploading my changes as a different package, but my preference would be to reuse the existing OpenCLRaw name, assuming you are okay with that. If I don't hear from you within a few weeks I'll just upload my own OpenCLRaw based on your code base.

Thanks for writing this package, it makes it possible for me to learn OpenCL while sticking with my favorite host programming language (Haskell!).

Please let me know if you have any questions and I look forward to collaborating with you.

Thank you,
Jason

@JeffHeard JeffHeard merged commit 107f02a into JeffHeard:master
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
This page is out of date. Refresh to see the latest.
View
1  .gitignore
@@ -0,0 +1 @@
+*.swp
View
79 OpenCLRaw.cabal
@@ -6,7 +6,6 @@ license: BSD3
license-file: LICENSE
copyright: Renaissance Computing Institute
maintainer: J.R. Heard
-build-depends: base <= 4.1.0.0, bytestring -any, mtl -any
stability: Experimental
homepage: http://vis.renci.org/jeff/opencl
package-url:
@@ -31,41 +30,43 @@ data-files:
data-dir: ""
extra-source-files:
extra-tmp-files:
-exposed-modules: System.OpenCL.Raw.V10.CommandQueue
- System.OpenCL.Raw.V10.Context
- System.OpenCL.Raw.V10.DeviceInfo
- System.OpenCL.Raw.V10.Errors
- System.OpenCL.Raw.V10.Etc
- System.OpenCL.Raw.V10.EventObject
- System.OpenCL.Raw.V10.FlushFinish
- System.OpenCL.Raw.V10.Kernel
- System.OpenCL.Raw.V10.MemoryObject
- System.OpenCL.Raw.V10.OutOfOrder
- System.OpenCL.Raw.V10.PlatformInfo
- System.OpenCL.Raw.V10.ProgramObject
- System.OpenCL.Raw.V10.Sampler
- System.OpenCL.Raw.V10.Types
- System.OpenCL.Raw.V10
-exposed: True
-buildable: True
-build-tools:
-cpp-options:
-cc-options:
-ld-options:
-pkgconfig-depends:
-frameworks:
-c-sources:
-extensions:
-extra-libraries:
-extra-lib-dirs:
-includes:
-install-includes:
-include-dirs:
-hs-source-dirs: .
-other-modules: System.OpenCL.Raw.V10.Utils
-ghc-prof-options:
-ghc-shared-options:
-ghc-options:
-hugs-options:
-nhc98-options:
-jhc-options:
+library
+ build-depends: base < 5, bytestring -any, mtl -any
+ exposed-modules: System.OpenCL.Raw.V10.CommandQueue
+ System.OpenCL.Raw.V10.Context
+ System.OpenCL.Raw.V10.DeviceInfo
+ System.OpenCL.Raw.V10.Errors
+ System.OpenCL.Raw.V10.Etc
+ System.OpenCL.Raw.V10.EventObject
+ System.OpenCL.Raw.V10.FlushFinish
+ System.OpenCL.Raw.V10.Kernel
+ System.OpenCL.Raw.V10.MemoryObject
+ System.OpenCL.Raw.V10.OutOfOrder
+ System.OpenCL.Raw.V10.PlatformInfo
+ System.OpenCL.Raw.V10.ProgramObject
+ System.OpenCL.Raw.V10.Sampler
+ System.OpenCL.Raw.V10.Types
+ System.OpenCL.Raw.V10
+ exposed: True
+ buildable: True
+ build-tools:
+ cpp-options:
+ cc-options:
+ ld-options:
+ pkgconfig-depends:
+ frameworks:
+ c-sources:
+ extensions:
+ extra-libraries:
+ extra-lib-dirs:
+ includes:
+ install-includes:
+ include-dirs:
+ hs-source-dirs: .
+ other-modules: System.OpenCL.Raw.V10.Utils
+ ghc-prof-options:
+ ghc-shared-options:
+ ghc-options: -Wall
+ hugs-options:
+ nhc98-options:
+ jhc-options:
View
22 System/OpenCL/Raw/V10/CommandQueue.hs
@@ -5,6 +5,7 @@
module System.OpenCL.Raw.V10.CommandQueue
(clCreateCommandQueue
,clRetainCommandQueue
+ ,clReleaseCommandQueue
,clGetCommandQueueInfo
,clSetCommandQueueProperty)
where
@@ -14,33 +15,30 @@ import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Control.Applicative
-import Data.Bits
-import Data.Maybe
+import Control.Exception ( throw )
foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue :: Context -> DeviceID -> CLbitfield -> Ptr CLint -> IO CommandQueue
-clCreateCommandQueue :: Context -> DeviceID -> CommandQueueProperties -> IO (Either ErrorCode CommandQueue)
+clCreateCommandQueue :: Context -> DeviceID -> CommandQueueProperties -> IO CommandQueue
clCreateCommandQueue ctx devid (CommandQueueProperties properties) =
- wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties
+ wrapErrorPtr $ raw_clCreateCommandQueue ctx devid properties
foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: CommandQueue -> IO CLint
-clRetainCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)
+clRetainCommandQueue :: CommandQueue -> IO ()
clRetainCommandQueue queue = wrapError (raw_clRetainCommandQueue queue)
foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CommandQueue -> IO CLint
-clReleaseCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)
+clReleaseCommandQueue :: CommandQueue -> IO ()
clReleaseCommandQueue queue = wrapError (raw_clReleaseCommandQueue queue)
foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CommandQueue -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetCommandQueueInfo ctx (CommandQueueInfo param_name) param_size = wrapGetInfo (raw_clGetCommandQueueInfo ctx param_name) param_size
foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CommandQueue -> CLbitfield -> CLbool -> Ptr CLbitfield -> IO CLint
-clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO (Either ErrorCode CommandQueueProperties)
+clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO CommandQueueProperties
clSetCommandQueueProperty queue (CommandQueueProperties properties) enable = alloca $ \old_properties -> do
err <- ErrorCode <$> raw_clSetCommandQueueProperty queue properties (if enable then clTrue else clFalse) old_properties
if err == clSuccess
- then Right . CommandQueueProperties <$> peek old_properties
- else return . Left $ err
-
-
+ then CommandQueueProperties <$> peek old_properties
+ else throw err
View
18 System/OpenCL/Raw/V10/Context.hs
@@ -13,49 +13,45 @@ module System.OpenCL.Raw.V10.Context
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
-import Control.Applicative
-import Data.Bits
-import Data.Maybe
type ContextCallback = (CString -> Ptr () -> CLsizei -> Ptr () -> IO ())
foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr (Ptr CLint) -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context
foreign import ccall "wrapper" wrapCreateContextCallback :: ContextCallback -> IO (FunPtr ContextCallback)
-clCreateContext :: [ContextProperties] -> [DeviceID] -> ContextCallback -> Ptr () -> IO (Either ErrorCode Context)
+clCreateContext :: [ContextProperties] -> [DeviceID] -> ContextCallback -> Ptr () -> IO Context
clCreateContext properties devices pfn_notify user_dat =
allocaArray (propertiesN+1) $ \propertiesP -> allocaArray devicesN $ \devicesP -> do
pokeArray0 nullPtr propertiesP properties
pokeArray devicesP devices
fptr <- wrapCreateContextCallback pfn_notify
- wrapErrorEither $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
+ wrapErrorPtr $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
where propertiesN = length properties
devicesN = length devices
foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: Ptr ContextProperties -> CLbitfield -> FunPtr ContextCallback -> Ptr a -> Ptr CLint -> IO Context
-clCreateContextFromType :: [ContextProperties] -> DeviceType -> ContextCallback -> Ptr () -> IO (Either ErrorCode Context)
+clCreateContextFromType :: [ContextProperties] -> DeviceType -> ContextCallback -> Ptr () -> IO Context
clCreateContextFromType properties (DeviceType device_type) pfn_notify user_data = allocaArray (propertiesN+1) $ \propertiesP -> do
pokeArray0 nullPtr propertiesP properties
fptr <- wrapCreateContextCallback pfn_notify
- wrapErrorEither $ raw_clCreateContextFromType propertiesP device_type fptr user_data
+ wrapErrorPtr $ raw_clCreateContextFromType propertiesP device_type fptr user_data
where propertiesN = length properties
foreign import ccall "clRetainContext" raw_clRetainContext :: Context -> IO CLint
-clRetainContext :: Context -> IO (Maybe ErrorCode)
+clRetainContext :: Context -> IO ()
clRetainContext ctx = wrapError (raw_clRetainContext ctx)
foreign import ccall "clReleaseContext" raw_clReleaseContext :: Context -> IO CLint
-clReleaseContext :: Context -> IO (Maybe ErrorCode)
+clReleaseContext :: Context -> IO ()
clReleaseContext ctx = wrapError (raw_clReleaseContext ctx)
foreign import ccall "clGetContextInfo" raw_clGetContextInfo :: Context -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetContextInfo :: Context -> ContextInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetContextInfo :: Context -> ContextInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetContextInfo ctx (ContextInfo param_name) param_size = wrapGetInfo (raw_clGetContextInfo ctx param_name) param_size
View
16 System/OpenCL/Raw/V10/DeviceInfo.hs
@@ -10,19 +10,17 @@ import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
import Control.Applicative
-import Data.Bits
+import Control.Exception ( throw )
foreign import ccall "clGetDeviceIDs" raw_clGetDeviceIDs :: PlatformID -> CLbitfield -> CLuint -> Ptr DeviceID -> Ptr CLuint -> IO CLint
-clGetDeviceIDs :: PlatformID -> DeviceType -> CLuint -> IO (Either ErrorCode [DeviceID])
-clGetDeviceIDs platform (DeviceType device_type) num_entries = alloca $ \(devices::Ptr DeviceID) -> alloca $ \(num_devices::Ptr CLuint) -> do
+clGetDeviceIDs :: PlatformID -> DeviceType -> CLuint -> IO [DeviceID]
+clGetDeviceIDs platform (DeviceType device_type) num_entries = alloca $ \devices -> alloca $ \num_devices -> do
errcode <- ErrorCode <$> raw_clGetDeviceIDs platform device_type num_entries devices num_devices
if errcode == clSuccess
- then Right <$> (peek num_devices >>= \num_devicesN -> peekArray (fromIntegral num_devicesN) devices)
- else return $ Left errcode
-
+ then peek num_devices >>= \num_devicesN -> peekArray (fromIntegral num_devicesN) devices
+ else throw errcode
+
foreign import ccall "clGetDeviceInfo" raw_clGetDeviceInfo :: DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetDeviceInfo :: DeviceID -> DeviceInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetDeviceInfo :: DeviceID -> DeviceInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetDeviceInfo obj (DeviceInfo param_name) param_size = wrapGetInfo (raw_clGetDeviceInfo obj param_name) param_size
-
-
View
14 System/OpenCL/Raw/V10/Errors.hs
@@ -116,26 +116,26 @@ clInvalidWorkDimension = ErrorCode (-53)
clInvalidWorkGroupSize :: ErrorCode
clInvalidWorkGroupSize = ErrorCode (-54)
-clInvalidWorkItemSize :: ErrorCode
+clInvalidWorkItemSize :: ErrorCode
clInvalidWorkItemSize = ErrorCode (-55)
-clInvalidGlobalOffset :: ErrorCode
+clInvalidGlobalOffset :: ErrorCode
clInvalidGlobalOffset = ErrorCode (-56)
-clInvalidEventWaitList :: ErrorCode
+clInvalidEventWaitList :: ErrorCode
clInvalidEventWaitList = ErrorCode (-57)
-clInvalidEvent :: ErrorCode
+clInvalidEvent :: ErrorCode
clInvalidEvent = ErrorCode (-58)
-clInvalidOperation :: ErrorCode
+clInvalidOperation :: ErrorCode
clInvalidOperation = ErrorCode (-59)
-clInvalidGLObject :: ErrorCode
+clInvalidGLObject :: ErrorCode
clInvalidGLObject = ErrorCode (-60)
-clInvalidBufferSize :: ErrorCode
+clInvalidBufferSize, clInvalidMipLevel :: ErrorCode
clInvalidBufferSize = ErrorCode (-61)
clInvalidMipLevel = ErrorCode (-62)
View
4 System/OpenCL/Raw/V10/Etc.hs
@@ -4,12 +4,8 @@ module System.OpenCL.Raw.V10.Etc
(clGetExtensionFunctionAddress)
where
-import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
-import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
-import Control.Applicative
foreign import ccall "clGetExtensionFunctionAddress" raw_clGetExtensionFunctionAddress :: CString -> IO (Ptr ())
clGetExtensionFunctionAddress :: String -> IO (Ptr ())
View
13 System/OpenCL/Raw/V10/EventObject.hs
@@ -9,30 +9,27 @@ module System.OpenCL.Raw.V10.EventObject
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
-import System.OpenCL.Raw.V10.Utils
import System.OpenCL.Raw.V10.Utils
import Foreign
-import Control.Applicative
foreign import ccall "clWaitForEvents" raw_clWaitForEvents :: CLuint -> Ptr Event -> IO CLint
-clWaitForEvents :: [Event] -> IO (Maybe ErrorCode)
+clWaitForEvents :: [Event] -> IO ()
clWaitForEvents evts = allocaArray nEvents $ \eventP -> pokeArray eventP evts >> (wrapError $ raw_clWaitForEvents (fromIntegral nEvents) eventP)
where nEvents = length evts
foreign import ccall "clGetEventInfo" raw_clGetEventInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetEventInfo :: Event -> EventInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetEventInfo :: Event -> EventInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetEventInfo obj (EventInfo param_name) param_size = wrapGetInfo (raw_clGetEventInfo obj param_name) param_size
foreign import ccall "clRetainEvent" raw_clRetainEvent :: Event -> IO CLint
-clRetainEvent :: Event -> IO (Maybe ErrorCode)
+clRetainEvent :: Event -> IO ()
clRetainEvent evt = wrapError $ raw_clRetainEvent evt
foreign import ccall "clReleaseEvent" raw_clReleaseEvent :: Event -> IO CLint
-clReleaseEvent :: Event -> IO (Maybe ErrorCode)
+clReleaseEvent :: Event -> IO ()
clReleaseEvent evt = wrapError $ raw_clReleaseEvent evt
foreign import ccall "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetEventProfilingInfo :: Event -> ProfilingInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetEventProfilingInfo :: Event -> ProfilingInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetEventProfilingInfo obj (ProfilingInfo param_name) param_size = wrapGetInfo (raw_clGetEventProfilingInfo obj param_name) param_size
View
7 System/OpenCL/Raw/V10/FlushFinish.hs
@@ -6,16 +6,13 @@ module System.OpenCL.Raw.V10.FlushFinish
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
-import Foreign
-import Control.Applicative
foreign import ccall "clFlush" raw_clFlush :: CommandQueue -> IO CLint
-clFlush :: CommandQueue -> IO (Maybe ErrorCode)
+clFlush :: CommandQueue -> IO ()
clFlush queue = wrapError $ raw_clFlush queue
foreign import ccall "clFinish" raw_clFinish :: CommandQueue -> IO CLint
-clFinish :: CommandQueue -> IO (Maybe ErrorCode)
+clFinish :: CommandQueue -> IO ()
clFinish queue = wrapError $ raw_clFinish queue
View
68 System/OpenCL/Raw/V10/Kernel.hs
@@ -5,6 +5,7 @@ module System.OpenCL.Raw.V10.Kernel
,clCreateKernelsInProgram
,clRetainKernel
,clReleaseKernel
+ ,clSetKernelArg
,clGetKernelInfo
,clGetKernelWorkGroupInfo
,clEnqueueNDRangeKernel
@@ -18,46 +19,42 @@ import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
import Control.Applicative
-import Data.Maybe
+import Control.Exception ( throw )
foreign import ccall "clCreateKernel" raw_clCreateKernel :: Program -> CString -> Ptr CLint -> IO Kernel
-clCreateKernel program kernel_name = wrapErrorEither $ raw_clCreateKernel program kernel_name
+clCreateKernel :: Program -> CString -> IO Kernel
+clCreateKernel program kernel_name = wrapErrorPtr $ raw_clCreateKernel program kernel_name
foreign import ccall "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: Program -> CLuint -> Ptr Kernel -> Ptr CLuint -> IO CLint
-clCreateKernelsInProgram :: Program -> CLuint -> IO (Either ErrorCode [Kernel])
-clCreateKernelsInProgram program num_kernels = allocaArray (fromIntegral num_kernels) $ \kernels -> alloca $ \num_kernels_ret -> do
- err <- wrapError $ raw_clCreateKernelsInProgram program num_kernels kernels num_kernels_ret
- if err== Nothing
- then do
- nkr <- peek num_kernels_ret
- Right <$> peekArray (fromIntegral nkr) kernels
- else
- return $ Left . fromJust $ err
+clCreateKernelsInProgram :: Program -> CLuint -> IO [Kernel]
+clCreateKernelsInProgram program num_kernels = allocaArray (fromIntegral num_kernels) $ \kernels -> do
+ nkr <- fetchPtr $ raw_clCreateKernelsInProgram program num_kernels kernels
+ peekArray (fromIntegral nkr) kernels
foreign import ccall "clRetainKernel" raw_clRetainKernel :: Kernel -> IO CLint
-clRetainKernel :: Kernel -> IO (Maybe ErrorCode)
+clRetainKernel :: Kernel -> IO ()
clRetainKernel kernel = wrapError $ raw_clRetainKernel kernel
foreign import ccall "clReleaseKernel" raw_clReleaseKernel :: Kernel -> IO CLint
-clReleaseKernel :: Kernel -> IO (Maybe ErrorCode)
-clReleaseKernel kernel = wrapError $ raw_clRetainKernel kernel
+clReleaseKernel :: Kernel -> IO ()
+clReleaseKernel kernel = wrapError $ raw_clReleaseKernel kernel
foreign import ccall "clSetKernelArg" raw_clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO CLint
-clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO (Maybe ErrorCode)
+clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO ()
clSetKernelArg kernel arg_index arg_size arg_value =
wrapError $ raw_clSetKernelArg kernel arg_index arg_size arg_value
foreign import ccall "clGetKernelInfo" raw_clGetKernelInfo :: Kernel -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetKernelInfo :: Kernel -> KernelInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetKernelInfo :: Kernel -> KernelInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetKernelInfo kernel (KernelInfo param_name) param_value_size = wrapGetInfo (raw_clGetKernelInfo kernel param_name) param_value_size
foreign import ccall "clGetKernelWorkGroupInfo" raw_clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> KernelWorkGroupInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> KernelWorkGroupInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetKernelWorkGroupInfo kernel device (KernelWorkGroupInfo param_name) param_value_size = wrapGetInfo (raw_clGetKernelWorkGroupInfo kernel device param_name) param_value_size
foreign import ccall "clEnqueueNDRangeKernel" raw_clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> CLuint -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> [CLsizei] -> [CLsizei] -> [Event] -> IO (Either ErrorCode Event)
+clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> [CLsizei] -> [CLsizei] -> [Event] -> IO Event
clEnqueueNDRangeKernel queue kernel global_work_sizeL local_work_sizeL event_wait_listL =
allocaArray work_dim $ \global_work_size ->
allocaArray work_dim $ \local_work_size ->
@@ -66,44 +63,41 @@ clEnqueueNDRangeKernel queue kernel global_work_sizeL local_work_sizeL event_wai
pokeArray global_work_size global_work_sizeL
pokeArray local_work_size local_work_sizeL
pokeArray event_wait_list event_wait_listL
- err <- wrapError $ raw_clEnqueueNDRangeKernel queue kernel (fromIntegral work_dim) nullPtr global_work_size local_work_size (fromIntegral num_events_in_wait_list) event_wait_list event
- if err == Nothing
- then Right <$> peek event
- else return $ Left . fromJust $ err
+ err <- ErrorCode <$> raw_clEnqueueNDRangeKernel queue kernel (fromIntegral work_dim) nullPtr global_work_size local_work_size (fromIntegral num_events_in_wait_list) event_wait_list event
+ if err == clSuccess
+ then peek event
+ else throw err
where work_dim = length global_work_sizeL
num_events_in_wait_list = length event_wait_listL
foreign import ccall "clEnqueueTask" raw_clEnqueueTask :: CommandQueue -> Kernel -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueTask :: CommandQueue -> Kernel -> [Event] -> IO (Either ErrorCode Event)
-clEnqueueTask queue kernel event_wait_listL =
+clEnqueueTask :: CommandQueue -> Kernel -> [Event] -> IO Event
+clEnqueueTask queue kernel event_wait_listL =
allocaArray num_events_in_wait_list $ \event_wait_list ->
alloca $ \event -> do
pokeArray event_wait_list event_wait_listL
- err <- wrapError $ raw_clEnqueueTask queue kernel (fromIntegral num_events_in_wait_list) event_wait_list event
- if err == Nothing
- then Right <$> peek event
- else return $ Left . fromJust $ err
+ err <- ErrorCode <$> raw_clEnqueueTask queue kernel (fromIntegral num_events_in_wait_list) event_wait_list event
+ if err == clSuccess
+ then peek event
+ else throw err
where num_events_in_wait_list = length event_wait_listL
type NKCallbackFunction = Ptr () -> IO ()
foreign import ccall "wrapper" wrapNativeKernelCallback :: NKCallbackFunction -> IO (FunPtr NKCallbackFunction)
foreign import ccall "clEnqueueNativeKernel" raw_clEnqueueNativeKernel :: FunPtr NKCallbackFunction -> Ptr () -> CLsizei -> CLuint -> Ptr Mem -> Ptr (Ptr ()) -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueNativeKernel :: NKCallbackFunction -> Ptr () -> CLsizei -> [Mem] -> [Ptr ()] -> [Event] -> IO (Either ErrorCode Event)
+clEnqueueNativeKernel :: NKCallbackFunction -> Ptr () -> CLsizei -> [Mem] -> [Ptr ()] -> [Event] -> IO Event
clEnqueueNativeKernel user_funcF args cb_args mem_listL args_mem_locL event_wait_listL =
allocaArray num_events_in_wait_list $ \event_wait_list ->
allocaArray num_mem_objects $ \mem_list ->
- allocaArray (length args_mem_locL) $ \args_mem_loc ->
+ allocaArray (length args_mem_locL) $ \args_mem_loc ->
alloca $ \event -> do
user_func <- wrapNativeKernelCallback user_funcF
pokeArray event_wait_list event_wait_listL
pokeArray mem_list mem_listL
pokeArray args_mem_loc args_mem_locL
- err <- wrapError $ raw_clEnqueueNativeKernel user_func args cb_args (fromIntegral num_mem_objects) mem_list args_mem_loc (fromIntegral num_events_in_wait_list) event_wait_list event
- if err == Nothing
- then Right <$> peek event
- else return $ Left . fromJust $ err
+ err <- ErrorCode <$> raw_clEnqueueNativeKernel user_func args cb_args (fromIntegral num_mem_objects) mem_list args_mem_loc (fromIntegral num_events_in_wait_list) event_wait_list event
+ if err == clSuccess
+ then peek event
+ else throw err
where num_events_in_wait_list = length event_wait_listL
num_mem_objects = length mem_listL
-
-
-
View
87 System/OpenCL/Raw/V10/MemoryObject.hs
@@ -23,69 +23,61 @@ module System.OpenCL.Raw.V10.MemoryObject
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
-import Control.Applicative
-import Data.Maybe
-import Data.Bits
foreign import ccall "clCreateBuffer" raw_clCreateBuffer :: Context -> CLbitfield -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
-clCreateBuffer :: Context -> MemFlags -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
-clCreateBuffer ctx (MemFlags flags) size host_ptr = wrapErrorEither $ raw_clCreateBuffer ctx flags size host_ptr
+clCreateBuffer :: Context -> MemFlags -> CLsizei -> Ptr () -> IO Mem
+clCreateBuffer ctx (MemFlags flags) size host_ptr = wrapErrorPtr $ raw_clCreateBuffer ctx flags size host_ptr
foreign import ccall "clCreateImage2D" raw_clCreateImage2D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
-clCreateImage2D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
+clCreateImage2D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO Mem
clCreateImage2D ctx (MemFlags memflags) (ChannelOrder corder, ChannelType ctype) image_width image_height image_row_pitch host_ptr = allocaArray 2 $ \image_format -> do
pokeArray image_format [corder,ctype]
- wrapErrorEither $ raw_clCreateImage2D ctx memflags image_format image_width image_height image_row_pitch host_ptr
+ wrapErrorPtr $ raw_clCreateImage2D ctx memflags image_format image_width image_height image_row_pitch host_ptr
foreign import ccall "clCreateImage3D" raw_clCreateImage3D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem
-clCreateImage3D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)
+clCreateImage3D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO Mem
clCreateImage3D ctx (MemFlags memflags) (ChannelOrder corder, ChannelType ctype) image_width image_height image_depth image_row_pitch image_slice_pitch host_ptr = allocaArray 2 $ \image_format -> do
pokeArray image_format [corder,ctype]
- wrapErrorEither $ raw_clCreateImage3D ctx memflags image_format image_width image_height image_depth image_row_pitch image_slice_pitch host_ptr
+ wrapErrorPtr $ raw_clCreateImage3D ctx memflags image_format image_width image_height image_depth image_row_pitch image_slice_pitch host_ptr
foreign import ccall "clRetainMemObject" raw_clRetainMemObject :: Mem -> IO CLint
-clRetainMemObject :: Mem -> IO (Maybe ErrorCode)
+clRetainMemObject :: Mem -> IO ()
clRetainMemObject mem = wrapError $ raw_clRetainMemObject mem
foreign import ccall "clReleaseMemObject" raw_clReleaseMemObject :: Mem -> IO CLint
-clReleaseMemObject :: Mem -> IO (Maybe ErrorCode)
+clReleaseMemObject :: Mem -> IO ()
clReleaseMemObject mem = wrapError $ raw_clReleaseMemObject mem
foreign import ccall "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: Context -> CLbitfield -> CLuint -> CLuint -> Ptr CLuint -> Ptr CLuint -> IO CLint
-clGetSupportedImageFormats :: Context -> MemFlags -> MemObjectType -> IO (Either ErrorCode [ImageFormat])
-clGetSupportedImageFormats ctx (MemFlags flags) (MemObjectType image_type) = allocaArray 512 $ \image_formats -> alloca $ \num_image_formats -> do
- err <- wrapError $ raw_clGetSupportedImageFormats ctx flags image_type 512 image_formats num_image_formats
- maybe (do num_image_formatsN <- peek num_image_formats
- image_formatsN <- peekArray (fromIntegral num_image_formatsN*2) image_formats
- let sift (a:b:cs) = (ChannelOrder a,ChannelType b) : sift cs
- sift [] = []
- return . Right $ sift image_formatsN )
- (return . Left)
- err
+clGetSupportedImageFormats :: Context -> MemFlags -> MemObjectType -> IO [ImageFormat]
+clGetSupportedImageFormats ctx (MemFlags flags) (MemObjectType image_type) =
+ allocaArray 512 $ \image_formats -> do
+ num_image_formats <- fetchPtr $ raw_clGetSupportedImageFormats ctx flags image_type 512 image_formats
+ image_formatsN <- peekArray (fromIntegral num_image_formats*2) image_formats
+ let sift (a:b:cs) = (ChannelOrder a, ChannelType b) : sift cs
+ sift [] = []
+ return $ sift image_formatsN
foreign import ccall "clGetMemObjectInfo" raw_clGetMemObjectInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetMemObjectInfo :: Mem -> MemInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetMemObjectInfo :: Mem -> MemInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetMemObjectInfo mem (MemInfo param_name) param_value_size = wrapGetInfo (raw_clGetMemObjectInfo mem param_name) param_value_size
foreign import ccall "clGetImageInfo" raw_clGetImageInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetImageInfo :: Mem -> MemInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetImageInfo :: Mem -> MemInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetImageInfo mem (MemInfo param_name) param_value_size = wrapGetInfo (raw_clGetImageInfo mem param_name) param_value_size
-enqueue :: (CommandQueue -> CLuint -> Ptr Event -> Ptr Event -> IO CLint) -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
-enqueue fn queue events = alloca $ \event -> allocaArray events_in_wait_list $ \event_wait_list -> do
+enqueue :: (CommandQueue -> CLuint -> Ptr Event -> Ptr Event -> IO CLint) -> CommandQueue -> [Event] -> IO Event
+enqueue fn queue events = allocaArray events_in_wait_list $ \event_wait_list -> do
pokeArray event_wait_list events
- err <- wrapError $ fn queue (fromIntegral events_in_wait_list) event_wait_list event
- if err == Nothing
- then Right <$> peek event
- else return (Left . fromJust $ err)
+ fetchPtr $ fn queue (fromIntegral events_in_wait_list) event_wait_list
where events_in_wait_list = length events
foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueReadBuffer :: Mem -> Bool -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO Event
clEnqueueReadBuffer buffer blocking_read offset cb ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueReadBuffer
@@ -101,18 +93,21 @@ clEnqueueReadBuffer buffer blocking_read offset cb ptr =
foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueWriteBuffer :: Mem -> Bool -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO Event
clEnqueueWriteBuffer buffer blocking_write offset cb ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueWriteBuffer command_queue buffer (if blocking_write then clTrue else clFalse) offset cb ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueCopyBuffer" raw_clEnqueueCopyBuffer :: CommandQueue -> Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueCopyBuffer :: Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO Event
clEnqueueCopyBuffer src_buffer dst_buffer src_offset dst_offset cb =
enqueue (\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueCopyBuffer command_queue src_buffer dst_buffer src_offset dst_offset cb num_events_in_wait_list event_wait_list event)
type ImageDims = (CLsizei,CLsizei,CLsizei)
foreign import ccall "clEnqueueReadImage" raw_clEnqueueReadImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueReadImage :: Mem -> Bool -> (CLsizei, CLsizei, CLsizei) -> (CLsizei, CLsizei, CLsizei) -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO Event
clEnqueueReadImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pitch ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
@@ -120,6 +115,7 @@ clEnqueueReadImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pit
raw_clEnqueueReadImage command_queue image (if blocking_read then clTrue else clFalse) origin region row_pitch slice_pitch ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueWriteImage" raw_clEnqueueWriteImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueWriteImage :: Mem -> Bool -> (CLsizei, CLsizei, CLsizei) -> (CLsizei, CLsizei, CLsizei) -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO Event
clEnqueueWriteImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pitch ptr =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
@@ -127,7 +123,7 @@ clEnqueueWriteImage image blocking_read (oa,ob,oc) (ra,rb,rc) row_pitch slice_pi
raw_clEnqueueWriteImage command_queue image (if blocking_read then clTrue else clFalse) origin region row_pitch slice_pitch ptr num_events_in_wait_list event_wait_list event)
foreign import ccall "clEnqueueCopyImage" raw_clEnqueueCopyImage :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueCopyImage :: Mem -> Mem -> ImageDims -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
+clEnqueueCopyImage :: Mem -> Mem -> ImageDims -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO Event
clEnqueueCopyImage src_image dst_image (soa,sob,soc) (doa,dob,doc) (ra,rb,rc) =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \src_origin -> allocaArray 3 $ \dst_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
@@ -137,7 +133,7 @@ clEnqueueCopyImage src_image dst_image (soa,sob,soc) (doa,dob,doc) (ra,rb,rc) =
foreign import ccall "clEnqueueCopyImageToBuffer" raw_clEnqueueCopyImageToBuffer :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueCopyImageToBuffer :: Mem -> Mem -> ImageDims -> ImageDims -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
+clEnqueueCopyImageToBuffer :: Mem -> Mem -> ImageDims -> ImageDims -> CLsizei -> CommandQueue -> [Event] -> IO Event
clEnqueueCopyImageToBuffer src_image dst_buffer (soa,sob,soc) (ra,rb,rc) dst_offset =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \src_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
@@ -155,7 +151,7 @@ clEnqueueCopyImageToBuffer src_image dst_buffer (soa,sob,soc) (ra,rb,rc) dst_off
foreign import ccall "clEnqueueCopyBufferToImage" raw_clEnqueueCopyBufferToImage :: CommandQueue -> Mem -> Mem -> CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
-clEnqueueCopyBufferToImage :: Mem -> Mem -> CLsizei -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)
+clEnqueueCopyBufferToImage :: Mem -> Mem -> CLsizei -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO Event
clEnqueueCopyBufferToImage src_buffer dst_image src_offset (soa,sob,soc) (ra,rb,rc) =
enqueue (\command_queue num_events_in_wait_list event_wait_list event -> allocaArray 3 $ \dst_origin -> allocaArray 3 $ \region -> do
pokeArray region [ra,rb,rc]
@@ -173,10 +169,10 @@ clEnqueueCopyBufferToImage src_buffer dst_image src_offset (soa,sob,soc) (ra,rb,
foreign import ccall "clEnqueueMapBuffer" raw_clEnqueueMapBuffer :: CommandQueue -> Mem -> CLbool -> CLbitfield -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ())
-clEnqueueMapBuffer :: Mem -> Bool -> MapFlags -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode (Ptr (),Event))
+clEnqueueMapBuffer :: Mem -> Bool -> MapFlags -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO (Ptr (),Event)
clEnqueueMapBuffer buffer blocking_map (MapFlags map_flags) offset cb command_queue events =
allocaArray num_events_in_wait_list $ \event_wait_list -> alloca $ \event -> do
- ret <- wrapErrorEither $ raw_clEnqueueMapBuffer
+ ptr <- wrapErrorPtr $ raw_clEnqueueMapBuffer
command_queue
buffer
(if blocking_map then clTrue else clFalse)
@@ -186,13 +182,12 @@ clEnqueueMapBuffer buffer blocking_map (MapFlags map_flags) offset cb command_qu
(fromIntegral num_events_in_wait_list)
event_wait_list
event
- case ret of
- Left err -> return (Left err)
- Right ptr -> peek event >>= \event -> return $ Right (ptr,event)
+ e <- peek event
+ return (ptr, e)
where num_events_in_wait_list = length events
foreign import ccall "clEnqueueMapImage" raw_clEnqueueMapImage :: CommandQueue -> Mem -> CLbool -> CLbitfield -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ())
-clEnqueueMapImage :: Mem -> Bool -> MapFlags -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode (Ptr (),CLsizei,CLsizei,Event))
+clEnqueueMapImage :: Mem -> Bool -> MapFlags -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Ptr (),CLsizei,CLsizei,Event)
clEnqueueMapImage buffer blocking_map (MapFlags map_flags) (oa,ob,oc) (ra,rb,rc) command_queue events =
allocaArray num_events_in_wait_list $ \event_wait_list ->
alloca $ \event ->
@@ -202,7 +197,7 @@ clEnqueueMapImage buffer blocking_map (MapFlags map_flags) (oa,ob,oc) (ra,rb,rc)
alloca $ \image_slice_pitch -> do
pokeArray origin [oa,ob,oc]
pokeArray region [ra,rb,rc]
- ret <- wrapErrorEither $ raw_clEnqueueMapImage
+ ptr <- wrapErrorPtr $ raw_clEnqueueMapImage
command_queue
buffer
(if blocking_map then clTrue else clFalse)
@@ -214,17 +209,15 @@ clEnqueueMapImage buffer blocking_map (MapFlags map_flags) (oa,ob,oc) (ra,rb,rc)
(fromIntegral num_events_in_wait_list)
event_wait_list
event
- case ret of
- Left err -> return (Left err)
- Right ptr -> do
- event' <- peek event
- image_row_pitch' <- peek image_row_pitch
- image_slice_pitch' <- peek image_slice_pitch
- return $ Right (ptr,image_row_pitch',image_slice_pitch', event')
+ event' <- peek event
+ image_row_patch' <- peek image_row_pitch
+ image_slice_pitch' <- peek image_slice_pitch
+ return (ptr, image_row_patch', image_slice_pitch', event')
where num_events_in_wait_list = length events
foreign import ccall "clEnqueueUnmapMemObject" raw_clEnqueueUnmapMemObject :: CommandQueue -> Mem -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint
+clEnqueueUnmapMemObject :: Mem -> Ptr () -> CommandQueue -> [Event] -> IO Event
clEnqueueUnmapMemObject mem mapped_ptr = enqueue
(\command_queue num_events_in_wait_list event_wait_list event ->
raw_clEnqueueUnmapMemObject command_queue mem mapped_ptr num_events_in_wait_list event_wait_list event)
View
15 System/OpenCL/Raw/V10/OutOfOrder.hs
@@ -7,22 +7,15 @@ module System.OpenCL.Raw.V10.OutOfOrder
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
-import Control.Applicative
-import Data.Maybe
foreign import ccall "clEnqueueMarker" raw_clEnqueueMarker :: CommandQueue -> Ptr Event -> IO CLint
-clEnqueueMarker :: CommandQueue -> IO (Either ErrorCode Event)
-clEnqueueMarker queue = alloca $ \eventP -> do
- err <- wrapError $ raw_clEnqueueMarker queue eventP
- if err == Nothing
- then Right <$> peek eventP
- else return $ Left . fromJust $ err
+clEnqueueMarker :: CommandQueue -> IO Event
+clEnqueueMarker queue = fetchPtr $ raw_clEnqueueMarker queue
foreign import ccall "clEnqueueWaitForEvents" raw_clEnqueueWaitForEvents :: CommandQueue -> CLuint -> Ptr Event -> IO CLint
-clEnqueueWaitForEvents :: CommandQueue -> [Event] -> IO (Maybe ErrorCode)
+clEnqueueWaitForEvents :: CommandQueue -> [Event] -> IO ()
clEnqueueWaitForEvents queue events =
allocaArray num_events $ \eventsP -> do
pokeArray eventsP events
@@ -30,7 +23,7 @@ clEnqueueWaitForEvents queue events =
where num_events = length events
foreign import ccall "clEnqueueBarrier" raw_clEnqueueBarrier :: CommandQueue -> IO CLint
-clEnqueueBarrier :: CommandQueue -> IO (Maybe ErrorCode)
+clEnqueueBarrier :: CommandQueue -> IO ()
clEnqueueBarrier queue = wrapError $ raw_clEnqueueBarrier queue
View
20 System/OpenCL/Raw/V10/PlatformInfo.hs
@@ -11,25 +11,21 @@ import System.OpenCL.Raw.V10.Utils
import Foreign
import Foreign.C
import Control.Applicative
-import Data.Maybe
+import Control.Exception ( throw )
foreign import ccall "clGetPlatformIDs" raw_clGetPlatformIDs :: CLuint -> Ptr PlatformID -> Ptr CLuint -> IO CLint
-clGetPlatformIDs :: CLuint -> IO (Either ErrorCode [PlatformID])
+clGetPlatformIDs :: CLuint -> IO [PlatformID]
clGetPlatformIDs num_entries = alloca $ \(platforms::Ptr PlatformID) -> alloca $ \(num_platforms::Ptr CLuint) -> do
errcode <- ErrorCode <$> raw_clGetPlatformIDs (fromIntegral num_entries) platforms num_platforms
if errcode == clSuccess
- then Right <$> (peek num_platforms >>= \num_platformsN -> peekArray (fromIntegral num_platformsN) platforms)
- else return $ Left errcode
-
-
+ then peek num_platforms >>= \num_platformsN -> peekArray (fromIntegral num_platformsN) platforms
+ else throw errcode
+
foreign import ccall "clGetPlatformInfo" raw_clGetPlatformInfo :: PlatformID -> CLuint -> CSize -> Ptr () -> Ptr CSize -> IO CLint
-clGetPlatformInfo :: PlatformID -> PlatformInfo -> CLsizei -> Ptr () -> IO (Either ErrorCode CLsizei)
-clGetPlatformInfo mem (PlatformInfo param_name) param_value_size param_value = alloca $ \param_value_size_ret -> do
- err <- wrapError $ raw_clGetPlatformInfo mem param_name param_value_size param_value param_value_size_ret
- if err == Nothing
- then peek param_value_size_ret >>= return . Right
- else return . Left . fromJust $ err
+clGetPlatformInfo :: PlatformID -> PlatformInfo -> CLsizei -> Ptr () -> IO CLsizei
+clGetPlatformInfo mem (PlatformInfo param_name) param_value_size param_value =
+ fetchPtr $ raw_clGetPlatformInfo mem param_name param_value_size param_value
View
26 System/OpenCL/Raw/V10/ProgramObject.hs
@@ -11,7 +11,6 @@ module System.OpenCL.Raw.V10.ProgramObject
,clGetProgramBuildInfo)
where
-import Control.Monad.Cont
import System.OpenCL.Raw.V10.Types
import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
@@ -20,19 +19,20 @@ import Foreign.C
import Control.Applicative
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Internal as SBS
+import Control.Exception ( throw )
foreign import ccall "clCreateProgramWithSource" raw_clCreateProgramWithSource :: Context -> CLuint -> Ptr CString -> Ptr CLsizei -> Ptr CLint -> IO Program
-clCreateProgramWithSource :: Context -> String -> IO (Either ErrorCode Program)
+clCreateProgramWithSource :: Context -> String -> IO Program
clCreateProgramWithSource ctx source_code = do
let count = length strings
strings = lines source_code
lengths = (fromIntegral . length) <$> strings
withArray lengths $ (\lengthsP ->
withCStringArray0 strings $ (\stringsP ->
- wrapErrorEither $ raw_clCreateProgramWithSource ctx (fromIntegral count) stringsP lengthsP))
+ wrapErrorPtr $ raw_clCreateProgramWithSource ctx (fromIntegral count) stringsP lengthsP))
foreign import ccall "clCreateProgramWithBinary" raw_clCreateProgramWithBinary :: Context -> CLuint -> Ptr DeviceID -> Ptr CLsizei -> Ptr (Ptr Word8) -> Ptr CLint -> Ptr CLint -> IO Program
-clCreateProgramWithBinary :: Context -> [(DeviceID,SBS.ByteString)] -> IO (Either ErrorCode Program)
+clCreateProgramWithBinary :: Context -> [(DeviceID,SBS.ByteString)] -> IO Program
clCreateProgramWithBinary context devbin_pair =
allocaArray num_devices $ \lengths ->
allocaArray num_devices $ \binaries ->
@@ -46,24 +46,24 @@ clCreateProgramWithBinary context devbin_pair =
errcode <- ErrorCode <$> peek errcode_ret
binstatus <- ErrorCode <$> peek binary_status
if errcode == clSuccess && binstatus == clSuccess
- then return $ Right program
- else return $ Left (if errcode == clSuccess then binstatus else errcode)
+ then return program
+ else throw (if errcode == clSuccess then binstatus else errcode)
where bsPtr (SBS.PS p _ _) = p
num_devices = length device_list
(device_list,bins) = unzip devbin_pair
foreign import ccall "clRetainProgram" raw_clRetainProgram :: Program -> IO CLint
-clRetainProgram :: Program -> IO (Maybe ErrorCode)
+clRetainProgram :: Program -> IO ()
clRetainProgram prog = wrapError $ raw_clRetainProgram prog
foreign import ccall "clReleaseProgram" raw_clReleaseProgram :: Program -> IO CLint
-clReleaseProgram :: Program -> IO (Maybe ErrorCode)
+clReleaseProgram :: Program -> IO ()
clReleaseProgram prog = wrapError $ raw_clReleaseProgram prog
type BuildProgramCallback = Program -> Ptr () -> IO ()
foreign import ccall "wrapper" wrapBuildProgramCallback :: BuildProgramCallback -> IO (FunPtr BuildProgramCallback)
foreign import ccall "clBuildProgram" raw_clBuildProgram :: Program -> CLuint -> Ptr DeviceID -> CString -> FunPtr BuildProgramCallback -> Ptr () -> IO CLint
-clBuildProgram :: Program -> [DeviceID] -> String -> BuildProgramCallback -> Ptr () -> IO (Maybe ErrorCode)
+clBuildProgram :: Program -> [DeviceID] -> String -> BuildProgramCallback -> Ptr () -> IO ()
clBuildProgram program devices ops pfn_notifyF user_data =
allocaArray num_devices $ \device_list ->
withCString ops $ \options -> do
@@ -73,14 +73,14 @@ clBuildProgram program devices ops pfn_notifyF user_data =
where num_devices = length devices
foreign import ccall "clUnloadCompiler" raw_clUnloadCompiler :: IO CLint
-clUnloadCompiler :: IO (Maybe ErrorCode)
+clUnloadCompiler :: IO ()
clUnloadCompiler = wrapError $ raw_clUnloadCompiler
foreign import ccall "clGetProgramInfo" raw_clGetProgramInfo :: Program -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetProgramInfo :: Program -> ProgramInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
+clGetProgramInfo :: Program -> ProgramInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
clGetProgramInfo program (ProgramInfo param_name) param_value_size = wrapGetInfo (raw_clGetProgramInfo program param_name) param_value_size
foreign import ccall "clGetProgramBuildInfo" raw_clGetProgramBuildInfo :: Program -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetProgramBuildInfo :: Program -> ProgramBuildInfo -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
-clGetProgramBuildInfo program (ProgramBuildInfo param_name) param_value_size = wrapGetInfo (raw_clGetProgramInfo program param_name) param_value_size
+clGetProgramBuildInfo :: Program -> ProgramBuildInfo -> CLsizei -> IO (ForeignPtr (), CLsizei)
+clGetProgramBuildInfo program (ProgramBuildInfo param_name) param_value_size = wrapGetInfo (raw_clGetProgramBuildInfo program param_name) param_value_size
View
32 System/OpenCL/Raw/V10/Sampler.hs
@@ -8,44 +8,26 @@ module System.OpenCL.Raw.V10.Sampler
where
import System.OpenCL.Raw.V10.Types
-import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Utils
import Foreign
-import Foreign.C
-import Control.Applicative
-import Data.Maybe
foreign import ccall "clCreateSampler" raw_clCreateSampler :: Context -> CLbool -> CLuint -> CLuint -> Ptr CLint -> IO Sampler
-clCreateSampler :: Context -> Bool -> AddressingMode -> FilterMode -> IO (Either ErrorCode Sampler)
+clCreateSampler :: Context -> Bool -> AddressingMode -> FilterMode -> IO Sampler
clCreateSampler ctx normalized_coords (AddressingMode addressing_mode) (FilterMode filter_mode) =
- wrapErrorEither $ raw_clCreateSampler ctx (if normalized_coords then clTrue else clFalse) addressing_mode filter_mode
+ wrapErrorPtr $ raw_clCreateSampler ctx (if normalized_coords then clTrue else clFalse) addressing_mode filter_mode
foreign import ccall "clRetainSampler" raw_clRetainSampler :: Sampler -> IO CLint
-clRetainSampler :: Sampler -> IO (Maybe ErrorCode)
+clRetainSampler :: Sampler -> IO ()
clRetainSampler sampler = wrapError $ raw_clRetainSampler sampler
foreign import ccall "clReleaseSampler" raw_clReleaseSampler :: Sampler -> IO CLint
-clReleaseSampler :: Sampler -> IO (Maybe ErrorCode)
+clReleaseSampler :: Sampler -> IO ()
clReleaseSampler sampler = wrapError $ raw_clReleaseSampler sampler
foreign import ccall "clGetSamplerInfo" raw_clGetSamplerInfo :: Sampler -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
-clGetSamplerInfo :: Sampler -> SamplerInfo -> CLsizei -> Ptr () -> IO (Either ErrorCode CLsizei)
+clGetSamplerInfo :: Sampler -> SamplerInfo -> CLsizei -> Ptr () -> IO CLsizei
clGetSamplerInfo mem (SamplerInfo param_name) param_value_size param_value = alloca $ \param_value_size_ret -> do
- err <- wrapError $ raw_clGetSamplerInfo mem param_name param_value_size param_value param_value_size_ret
- if err == Nothing
- then peek param_value_size_ret >>= return . Right
- else return . Left . fromJust $ err
-
-
-
-
-
-
-
-
-
-
-
-
+ wrapError $ raw_clGetSamplerInfo mem param_name param_value_size param_value param_value_size_ret
+ peek param_value_size_ret
View
14 System/OpenCL/Raw/V10/Types.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
{-| Declaration of types, bounds and constants for OpenCL 1.0 -}
module System.OpenCL.Raw.V10.Types where
import Foreign.C.Types
import Foreign
+import Control.Exception
+import Data.Typeable
data PlatformIDc = PlatformIDc
data DeviceIDc = DeviceIDc
@@ -42,7 +45,8 @@ newtype DeviceType = DeviceType CLbitfield
newtype ContextInfo = ContextInfo CLuint
newtype CommandQueueProperties = CommandQueueProperties CLbitfield
newtype CommandQueueInfo = CommandQueueInfo CLuint
-newtype ErrorCode = ErrorCode CLint deriving (Eq,Ord,Show,Read)
+newtype ErrorCode = ErrorCode CLint deriving (Eq,Ord,Show,Read,Typeable)
+instance Exception ErrorCode
newtype EventInfo = EventInfo CLuint
newtype ProfilingInfo = ProfilingInfo CLuint
newtype KernelInfo = KernelInfo CLuint
@@ -277,9 +281,9 @@ clProfilingCommandStart = ProfilingInfo 0x1282
clProfilingCommandEnd :: ProfilingInfo
clProfilingCommandEnd = ProfilingInfo 0x1283
-
-clFalse = 0 :: CLbool
-clTrue = 1 :: CLbool
+clFalse, clTrue :: CLbool
+clFalse = 0
+clTrue = 1
clDeviceTypeDefault :: DeviceType
@@ -307,6 +311,7 @@ clContextDevices = ContextInfo 0x1081
clContextProperties :: ContextInfo
clContextProperties = ContextInfo 0x1082
+clContextPlatform :: Integer
clContextPlatform = 0x1084
@@ -569,6 +574,7 @@ clAddressClamp = AddressingMode 0x1132
clAddressRepeat :: AddressingMode
clAddressRepeat = AddressingMode 0x1133
+clFilterNearest, clFilterLinear :: FilterMode
clFilterNearest = FilterMode 0x1140
clFilterLinear = FilterMode 0x1141
View
45 System/OpenCL/Raw/V10/Utils.hs
@@ -6,32 +6,39 @@ import Foreign.C
import System.OpenCL.Raw.V10.Errors
import System.OpenCL.Raw.V10.Types
import Control.Applicative
-import Data.Maybe
import Control.Monad.Cont
+import Control.Exception ( throw )
-wrapError :: IO CLint -> IO (Maybe ErrorCode)
-wrapError thunk = thunk >>= \errcode -> if ErrorCode errcode == clSuccess then return Nothing else return . Just . ErrorCode $ errcode
+wrapError :: Integral a => IO a -> IO ()
+wrapError thunk = do
+ err <- (ErrorCode . fromIntegral) <$> thunk
+ if err == clSuccess
+ then return ()
+ else throw err
-wrapErrorEither :: (Ptr CLint -> IO a) -> IO (Either ErrorCode a)
-wrapErrorEither thunk = alloca $ \errorP -> do
- ret <- thunk errorP
- err <- ErrorCode <$> peek errorP
- if err == clSuccess
- then return . Right $ ret
- else return . Left $ err
-
-wrapGetInfo :: (CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint) -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))
-wrapGetInfo raw_infoFn param_size = alloca $ \value_size_ret -> do
- param_data <- (mallocForeignPtrBytes . fromIntegral $ param_size) :: IO (ForeignPtr ())
- ret <- wrapError $ withForeignPtr param_data $ \param_dataP -> raw_infoFn param_size param_dataP value_size_ret
- if ret == Just clSuccess
- then peek value_size_ret >>= \valsz -> return . Right $ (param_data,valsz)
- else return . Left $ fromJust ret
+wrapErrorPtr :: (Storable a, Integral a) => (Ptr a -> IO b) -> IO b
+wrapErrorPtr thunk = alloca $ \errorP -> do
+ ret <- thunk errorP
+ err <- (ErrorCode . fromIntegral) <$> peek errorP
+ if err == clSuccess
+ then return ret
+ else throw err
+fetchPtr :: (Storable a, Integral b) => (Ptr a -> IO b) -> IO a
+fetchPtr thunk = alloca $ \ptr -> do
+ err <- (ErrorCode . fromIntegral) <$> thunk ptr
+ if err == clSuccess
+ then peek ptr
+ else throw err
+wrapGetInfo :: (CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint) -> CLsizei -> IO (ForeignPtr (), CLsizei)
+wrapGetInfo raw_infoFn param_size = do
+ param_data <- mallocForeignPtrBytes . fromIntegral $ param_size
+ valsz <- withForeignPtr param_data $ \param_dataP -> fetchPtr (raw_infoFn param_size param_dataP)
+ return (param_data, valsz)
nest :: [(r -> a) -> a] -> ([r] -> a) -> a
-nest xs = runCont (sequence (map Cont xs))
+nest xs = runCont (sequence (map cont xs))
withCStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a
withCStringArray0 strings act = nest (map withCString strings)
Something went wrong with that request. Please try again.