OpenCLWrappers 0.0.0.1 → 0.0.1.0

raw patch · 13 files changed

+58/−53 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• OpenCLWrappers.cabal +11/−1
• README +6/−3
• System/OpenCL/Wrappers/CommandQueue.hs +6/−5
• System/OpenCL/Wrappers/DeviceInfo.hs +0/−1
• System/OpenCL/Wrappers/Errors.hs +2/−0
• System/OpenCL/Wrappers/EventObject.hs +2/−2
• System/OpenCL/Wrappers/Kernel.hs +2/−2
• System/OpenCL/Wrappers/MemoryObject.hs +10/−10
• System/OpenCL/Wrappers/PlatformInfo.hs +0/−1
• System/OpenCL/Wrappers/ProgramObject.hs +10/−16
• System/OpenCL/Wrappers/Sampler.hs +1/−5
• System/OpenCL/Wrappers/Types.hs +6/−1
• System/OpenCL/Wrappers/Utils.hs +2/−6

@@ -1,5 +1,5 @@ name: OpenCLWrappers-version: 0.0.0.1+version: 0.0.1.0 cabal-version: >=1.2 build-type: Simple license: BSD3@@ -15,6 +15,12 @@ category: FFI author: J.R. Heard, Emil Karlson +Flag Link {+  Description: Link to OpenCL+  Default:     False+  }++ Library   exposed-modules: System.OpenCL.Wrappers.CommandQueue                    System.OpenCL.Wrappers.Context@@ -40,4 +46,8 @@   buildable: True   hs-source-dirs: .   other-modules: System.OpenCL.Wrappers.Utils+  GHC-Options: -Wall+  if flag(link)+    Extra-libraries:+      OpenCL 

@@ -1,8 +1,11 @@-You must link explicitly to opencl library, name of which varies.+You must link explicitly to opencl library, unless you build with the link flag. -eg.+Link library to OpenCL using cabal-install:+	cabal configure --flags="link" && cabal build++Link explicitly user created program when --flags="link" is not used to build the library: 	ghc -lamdocl64 --make opencl.hs 	ghc -lOpenCL --make opencl.hs -Some examples can be found in http://users.tkk.fi/~jkarlson/codes/OpenCLWrappers/examples+Some examples can be found in http://www.iki.fi/jekarl/codes/OpenCLWrappers/examples 

@@ -6,8 +6,9 @@     ,clSetCommandQueueProperty) where +import Data.Bits+import Data.List import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw import Foreign.Marshal.Alloc(alloca)@@ -15,9 +16,9 @@   clCreateCommandQueue :: Context -> DeviceID -> [CommandQueueProperties] -> IO (Either ErrorCode CommandQueue)-clCreateCommandQueue ctx devid props = let-    CommandQueueProperties properties = combineOr props-        in wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties +clCreateCommandQueue ctx devid props =+    wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties+    where properties = foldl' (.|.) 0 [ prop | CommandQueueProperties prop <- props ]  clRetainCommandQueue :: CommandQueue -> IO (Maybe ErrorCode) clRetainCommandQueue queue = wrapError (raw_clRetainCommandQueue queue)@@ -27,7 +28,7 @@  clGetCommandQueueInfo :: CommandQueue -> CommandQueueInfo -> IO (Either ErrorCode CLCommandQueueInfoRetval) clGetCommandQueueInfo ctx (CommandQueueInfo param_name) = wrapGetInfo (raw_clGetCommandQueueInfo ctx param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (CommandQueueInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (CommandQueueInfo param_name) in case () of          ()             | c == clQueueContext        -> peekOneInfo CommandQueueInfoRetvalContext x             | c == clQueueDevice         -> peekOneInfo CommandQueueInfoRetvalDeviceID x

@@ -4,7 +4,6 @@ where  import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw 

@@ -137,6 +137,8 @@ clInvalidBufferSize :: ErrorCode  clInvalidBufferSize = ErrorCode (-61)++clInvalidMipLevel :: ErrorCode clInvalidMipLevel = ErrorCode (-62)  

@@ -18,7 +18,7 @@                              clGetEventInfo :: Event -> EventInfo -> IO (Either ErrorCode CLEventInfoRetval) clGetEventInfo obj (EventInfo param_name) = wrapGetInfo (raw_clGetEventInfo obj param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (EventInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (EventInfo param_name) in case () of          ()             | c == clEventCommandQueue           -> peekOneInfo EventInfoRetvalCommandQueue x             | c == clEventCommandType            -> peekOneInfo EventInfoRetvalCommandType x@@ -33,7 +33,7 @@  clGetEventProfilingInfo :: Event -> ProfilingInfo -> IO (Either ErrorCode CLEventProfilingInfoRetval) clGetEventProfilingInfo obj (ProfilingInfo param_name) = wrapGetInfo (raw_clGetEventProfilingInfo obj param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (ProfilingInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (ProfilingInfo param_name) in case () of          ()             | c == clProfilingCommandQueued -> peekOneInfo EventProfilingInfoRetvalCLulong x             | c == clProfilingCommandSubmit -> peekOneInfo EventProfilingInfoRetvalCLulong x

@@ -12,7 +12,6 @@ where  import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw import Foreign@@ -21,6 +20,7 @@ import Data.Maybe  +clCreateKernel :: Program -> String -> IO (Either ErrorCode Kernel) clCreateKernel program init_name = withCString init_name (\x -> wrapErrorEither $ raw_clCreateKernel program x)  clCreateKernelsInProgram :: Program -> CLuint -> IO (Either ErrorCode [Kernel])@@ -45,7 +45,7 @@  clGetKernelInfo :: Kernel -> KernelInfo -> IO (Either ErrorCode CLKernelInfoRetval) clGetKernelInfo kernel (KernelInfo param_name) = (wrapGetInfo $ raw_clGetKernelInfo kernel param_name) >>= -    either (return.Left) (\(x,size) -> fmap Right $ let c = (KernelInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (KernelInfo param_name) in case () of          ()             | c == clKernelFunctionName   -> peekStringInfo KernelInfoRetvalString x             | c == clKernelNumArgs        -> peekOneInfo KernelInfoRetvalCLuint x

@@ -21,13 +21,11 @@ where  import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw import Foreign import Control.Applicative import Data.Maybe-import Data.Bits   clCreateBuffer :: Context -> MemFlags -> CLsizei -> Ptr () -> IO (Either ErrorCode Mem)@@ -62,7 +60,7 @@  clGetMemObjectInfo :: Mem -> MemInfo -> IO (Either ErrorCode CLMemObjectInfoRetval) clGetMemObjectInfo mem (MemInfo param_name) = (wrapGetInfo $ raw_clGetMemObjectInfo mem param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (MemInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (MemInfo param_name) in case () of          ()             | c == clMemType           -> peekOneInfo MemObjectInfoRetvalMemObjectType x             | c == clMemFlags          -> peekOneInfo MemObjectInfoRetvalMemFlags x@@ -74,7 +72,7 @@  clGetImageInfo :: Mem -> MemInfo -> IO (Either ErrorCode CLImageInfoRetval) clGetImageInfo mem (MemInfo param_name) = (wrapGetInfo $ raw_clGetImageInfo mem param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (MemInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (MemInfo param_name) in case () of          ()             | c == clImageElementSize -> peekOneInfo ImageInfoRetvalCLsizei x             | c == clImageRowPitch    -> peekOneInfo ImageInfoRetvalCLsizei x@@ -91,7 +89,7 @@         else return (Left . fromJust $ err)     where events_in_wait_list = length events     -    +clEnqueueReadBuffer :: Mem -> Bool -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO (Either ErrorCode Event)     clEnqueueReadBuffer buffer blocking_read offset cb ptr =      enqueue (\command_queue num_events_in_wait_list event_wait_list event ->                  raw_clEnqueueReadBuffer @@ -105,22 +103,24 @@                     event_wait_list                      event)                             -+clEnqueueWriteBuffer :: Mem -> Bool -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO (Either ErrorCode 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)   -+clEnqueueCopyBuffer :: Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode 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)                        +clEnqueueReadImage :: Mem -> Bool -> (CLsizei, CLsizei, CLsizei) -> (CLsizei, CLsizei, CLsizei) -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO (Either ErrorCode 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]                 pokeArray origin [oa,ob,oc]                 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) -                    ++clEnqueueWriteImage :: Mem -> Bool -> (CLsizei, CLsizei, CLsizei) -> (CLsizei, CLsizei, CLsizei) -> CLsizei -> CLsizei -> Ptr () -> CommandQueue -> [Event] -> IO (Either ErrorCode 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]@@ -185,7 +185,7 @@             event         case ret of              Left err -> return (Left err)-            Right ptr -> peek event >>= \event -> return $ Right (ptr,event)+            Right ptr -> peek event >>= \event' -> return $ Right (ptr,event')     where num_events_in_wait_list = length events  clEnqueueMapImage :: Mem -> Bool -> MapFlags -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode (Ptr (),CLsizei,CLsizei,Event))@@ -219,7 +219,7 @@                 return  $ Right (ptr,image_row_pitch',image_slice_pitch', event')          where num_events_in_wait_list = length events                   -+clEnqueueUnmapMemObject :: Mem -> Ptr () -> CommandQueue -> [Event] -> IO (Either ErrorCode 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)

@@ -4,7 +4,6 @@   ) where  import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw 

@@ -14,31 +14,26 @@ import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw-import Foreign+import Foreign(alloca,peek,withArray,Ptr,nullFunPtr,nullPtr)+import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) import Foreign.C import Control.Applicative import qualified Data.ByteString as SBS import qualified Data.ByteString.Internal as SBS  clCreateProgramWithSource :: Context -> String -> IO (Either ErrorCode 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))   +clCreateProgramWithSource ctx source =+    withCString source $ \cSource ->+        withArray [cSource] $ \sourcesP ->+            wrapErrorEither $ raw_clCreateProgramWithSource ctx 1 sourcesP nullPtr  clCreateProgramWithBinary :: Context -> [(DeviceID,SBS.ByteString)] ->  IO (Either ErrorCode Program) clCreateProgramWithBinary context devbin_pair = -    allocaArray num_devices $ \lengths -> -    allocaArray num_devices $ \binaries ->-    allocaArray num_devices $ \devices -> +    withArray (map (fromIntegral . SBS.length) bins) $ \lengths -> +    withArray (map (unsafeForeignPtrToPtr . bsPtr) bins) $ \binaries ->+    withArray device_list $ \devices ->      alloca $ \binary_status ->     alloca $ \errcode_ret -> do-        pokeArray lengths (map (fromIntegral . SBS.length) bins)-        pokeArray devices device_list-        pokeArray binaries ((unsafeForeignPtrToPtr . bsPtr) `map` bins)          program <- raw_clCreateProgramWithBinary context (fromIntegral num_devices) devices lengths binaries binary_status errcode_ret         errcode <- ErrorCode <$> peek errcode_ret         binstatus <- ErrorCode <$> peek binary_status@@ -57,9 +52,8 @@  clBuildProgram :: Program -> [DeviceID] -> String -> (Maybe BuildProgramCallback) -> Ptr () -> IO (Maybe ErrorCode) clBuildProgram program devices ops pfn_notifyF user_data = -    allocaArray num_devices $ \device_list -> +    withArray devices $ \device_list ->      withCString ops $ \options -> do -        pokeArray device_list devices         pfn_notify <- maybe (return nullFunPtr) wrapBuildProgramCallback pfn_notifyF         wrapError $ raw_clBuildProgram program (fromIntegral num_devices) device_list options pfn_notify user_data     where num_devices = length devices   

@@ -6,12 +6,8 @@ where  import System.OpenCL.Wrappers.Types-import System.OpenCL.Wrappers.Errors import System.OpenCL.Wrappers.Utils import System.OpenCL.Wrappers.Raw-import Foreign-import Foreign.C-import Control.Applicative import Data.Maybe  @@ -27,7 +23,7 @@  clGetSamplerInfo :: Sampler -> SamplerInfo -> IO (Either ErrorCode CLSamplerInfoRetval) clGetSamplerInfo sampler (SamplerInfo param_name) = (wrapGetInfo $ raw_clGetSamplerInfo sampler param_name) >>=-    either (return.Left) (\(x,size) -> fmap Right $ let c = (SamplerInfo param_name) in case () of +    either (return.Left) (\(x,_) -> fmap Right $ let c = (SamplerInfo param_name) in case () of          ()             | c == clSamplerReferenceCount   -> peekOneInfo SamplerInfoRetvalCLuint x             | c == clSamplerContext          -> peekOneInfo SamplerInfoRetvalContext x

@@ -345,8 +345,10 @@ clProfilingCommandEnd  :: ProfilingInfo  clProfilingCommandEnd  = ProfilingInfo 0x1283 -+clFalse :: CLbool clFalse = 0 :: CLbool++clTrue :: CLbool clTrue = 1 :: CLbool  @@ -637,7 +639,10 @@ clAddressRepeat :: AddressingMode  clAddressRepeat = AddressingMode 0x1133 +clFilterNearest :: FilterMode clFilterNearest = FilterMode 0x1140++clFilterLinear :: FilterMode clFilterLinear = FilterMode 0x1141  

@@ -8,8 +8,6 @@ import Control.Applicative import Data.Maybe import Control.Monad.Cont-import Data.Bits((.|.))-import Unsafe.Coerce(unsafeCoerce)  wrapError :: IO CLint -> IO (Maybe ErrorCode) wrapError thunk = thunk >>= \errcode -> if ErrorCode errcode == clSuccess then return Nothing else return . Just . ErrorCode $ errcode@@ -41,6 +39,7 @@                     maybe (fmap Right $ peekArray (fromIntegral retsize) param_dataP) (return.Left)))             (return.Left)) +withArrayNull0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b withArrayNull0 a as = withArrayNull $ as ++ [a]  withArrayNull :: Storable a => [a] -> (Ptr a -> IO b) -> IO b@@ -62,11 +61,8 @@ peekManyInfo f x size = do     c <- return undefined     a <- withForeignPtr x (\y -> (peekArray ( div (fromIntegral size) $ sizeOf c) $ castPtr y))-    return (c:a)+    _ <- return (c:a)     return $ f a  peekStringInfo :: (String -> b) -> ForeignPtr () -> IO b peekStringInfo f x = withForeignPtr x (\y -> fmap f (peekCString $ castPtr y))--combineOr :: [a] -> a-combineOr x = unsafeCoerce $ foldl (\x y -> x .|. unsafeCoerce y) (0 :: CLuint) x