OpenCLWrappers (empty) → 0.0.0

raw patch · 21 files changed

+1969/−0 lines, 21 filesdep +basedep +bytestringdep +mtlsetup-changed

Dependencies added: base, bytestring, mtl

Files

LICENSE +49/−0
OpenCLWrappers.cabal +43/−0
Setup.lhs +6/−0
System/OpenCL/Wrappers.hs +77/−0
System/OpenCL/Wrappers/CommandQueue.hs +41/−0
System/OpenCL/Wrappers/Context.hs +41/−0
System/OpenCL/Wrappers/DeviceInfo.hs +70/−0
System/OpenCL/Wrappers/Errors.hs +142/−0
System/OpenCL/Wrappers/Etc.hs +12/−0
System/OpenCL/Wrappers/EventObject.hs +41/−0
System/OpenCL/Wrappers/FlushFinish.hs +15/−0
System/OpenCL/Wrappers/Helpers.hs +57/−0
System/OpenCL/Wrappers/Kernel.hs +103/−0
System/OpenCL/Wrappers/MemoryObject.hs +226/−0
System/OpenCL/Wrappers/OutOfOrder.hs +24/−0
System/OpenCL/Wrappers/PlatformInfo.hs +17/−0
System/OpenCL/Wrappers/ProgramObject.hs +87/−0
System/OpenCL/Wrappers/Raw.hs +151/−0
System/OpenCL/Wrappers/Sampler.hs +37/−0
System/OpenCL/Wrappers/Types.hs +658/−0
System/OpenCL/Wrappers/Utils.hs +72/−0

+ LICENSE view

@@ -0,0 +1,49 @@+RENCI Open Source Software License+The University of North Carolina at Chapel Hill++The University of North Carolina at Chapel Hill (the "Licensor") through +its Renaissance Computing Institute (RENCI) is making an original work of +authorship (the "Software") available through RENCI upon the terms set +forth in this Open Source Software License (this "License").  This License +applies to any Software that has placed the following notice immediately +following the copyright notice for the Software:  Licensed under the RENCI +Open Source Software License v. 1.0.++Licensor grants You, free of charge, a world-wide, royalty-free, +non-exclusive, perpetual, sublicenseable license to do the following to +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions:++. Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimers.++. Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimers in the +documentation and/or other materials provided with the distribution.++. Neither You nor any sublicensor of the Software may use the names of +Licensor (or any derivative thereof), of RENCI, or of contributors to the +Software without explicit prior written permission.  Nothing in this +License shall be deemed to grant any rights to trademarks, copyrights, +patents, trade secrets or any other intellectual property of Licensor +except as expressly stated herein.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE CONTIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE.++You may use the Software in all ways not otherwise restricted or +conditioned by this License or by law, and Licensor promises not to +interfere with or be responsible for such uses by You.  This Software may +be subject to U.S. law dealing with export controls.  If you are in the +U.S., please do not mirror this Software unless you fully understand the +U.S. export regulations.  Licensees in other countries may face similar +restrictions.  In all cases, it is licensee's responsibility to comply +with any export regulations applicable in licensee's jurisdiction.+

+ OpenCLWrappers.cabal view

@@ -0,0 +1,43 @@+name: OpenCLWrappers+version: 0.0.0+cabal-version: >=1.2+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Renaissance Computing Institute, Emil Karlson+maintainer: Emil Karlson <jekarlson@gmail.com>+stability: Experimental+homepage: https://github.com/jkarlson/OpenCLWrappers+package-url:+bug-reports: https://github.com/jkarlson/OpenCLWrappers/issues+synopsis: The OpenCL Standard for heterogenous data-parallel computing+description: Light opencl wrappers, a fork of the OpenCLRaw package.+category: FFI+author: J.R. Heard, Emil Karlson++Library+  exposed-modules: System.OpenCL.Wrappers.CommandQueue+                   System.OpenCL.Wrappers.Context+                   System.OpenCL.Wrappers.DeviceInfo+                   System.OpenCL.Wrappers.Errors+                   System.OpenCL.Wrappers.Etc+                   System.OpenCL.Wrappers.EventObject+                   System.OpenCL.Wrappers.FlushFinish+                   System.OpenCL.Wrappers.Kernel+                   System.OpenCL.Wrappers.MemoryObject+                   System.OpenCL.Wrappers.OutOfOrder+                   System.OpenCL.Wrappers.PlatformInfo+                   System.OpenCL.Wrappers.ProgramObject+                   System.OpenCL.Wrappers.Sampler+                   System.OpenCL.Wrappers.Types+                   System.OpenCL.Wrappers.Helpers+                   System.OpenCL.Wrappers.Raw+                   System.OpenCL.Wrappers+  build-depends: base <= 4.4,+                 bytestring -any,+                 mtl >= 2 && < 2.1+  exposed: True+  buildable: True+  hs-source-dirs: .+  other-modules: System.OpenCL.Wrappers.Utils+

+ Setup.lhs view

@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+

+ System/OpenCL/Wrappers.hs view

@@ -0,0 +1,77 @@+{-|+    The OpenCL system for open heterogenous data parallel supercomputing.+    +    A fork of the FFI wrapper OpenCLRaw by Jeff Heard of the Renaissance Computing Institute.+    +    From the introduction: +    +    OpenCL (Open Computing Language) is an open royalty-free standard for general purpose +    parallel programming across CPUs, GPUs and other processors, giving software developers +    portable and efficient access to the power of these heterogeneous processing platforms.   ++    OpenCL supports a wide range of applications, ranging from embedded and consumer software +    to HPC solutions, through a low-level, high-performance, portable abstraction.  By creating an +    efficient, close-to-the-metal programming interface, OpenCL will form the foundation layer of a +    parallel computing ecosystem of platform-independent tools, middleware and applications.  +    OpenCL is particularly suited to play an increasingly significant role in emerging interactive +    graphics applications that combine general parallel compute algorithms with graphics rendering +    pipelines. ++    OpenCL consists of an API for coordinating parallel computation across+    heterogeneous processors; and a cross-platform programming language with a well- +    specified computation environment.  The OpenCL standard: ++    * Supports both data- and task-based parallel programming models +    +    * Utilizes a subset of ISO C99 with extensions for parallelism +    +    * Defines consistent numerical requirements based on IEEE 754 +    +    * Defines a configuration profile for handheld and embedded devices +    +    * Efficiently interoperates with OpenGL, OpenGL ES and other graphics APIs+    +    _General Notes on the differences between Haskell and the OpenCL-C implementation_+    +    * Side-effectful procedures capable of returning an error code only return a Maybe ErrorCode, with Nothing returned upon success+    +    * Procedures which follow the pattern of returning a pointer to an object and taking a final parameter as an error code instead+      return Either ErrorCode @ObjectType@ +      +    * Enumerations and constants are replaced by newtypes for the sake of type-safety.+-}+module System.OpenCL.Wrappers+    (module System.OpenCL.Wrappers.CommandQueue+    ,module System.OpenCL.Wrappers.Context+    ,module System.OpenCL.Wrappers.DeviceInfo+    ,module System.OpenCL.Wrappers.Errors+    ,module System.OpenCL.Wrappers.Etc+    ,module System.OpenCL.Wrappers.EventObject+    ,module System.OpenCL.Wrappers.FlushFinish+    ,module System.OpenCL.Wrappers.Kernel+    ,module System.OpenCL.Wrappers.MemoryObject+    ,module System.OpenCL.Wrappers.OutOfOrder+    ,module System.OpenCL.Wrappers.PlatformInfo+    ,module System.OpenCL.Wrappers.ProgramObject+    ,module System.OpenCL.Wrappers.Sampler+    ,module System.OpenCL.Wrappers.Types+    ,module System.OpenCL.Wrappers.Helpers+    ,module System.OpenCL.Wrappers.Raw) +where++import System.OpenCL.Wrappers.CommandQueue+import System.OpenCL.Wrappers.Context+import System.OpenCL.Wrappers.DeviceInfo+import System.OpenCL.Wrappers.Errors+import System.OpenCL.Wrappers.Etc+import System.OpenCL.Wrappers.EventObject+import System.OpenCL.Wrappers.FlushFinish+import System.OpenCL.Wrappers.Kernel+import System.OpenCL.Wrappers.MemoryObject+import System.OpenCL.Wrappers.OutOfOrder+import System.OpenCL.Wrappers.PlatformInfo+import System.OpenCL.Wrappers.ProgramObject+import System.OpenCL.Wrappers.Sampler+import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Helpers+import System.OpenCL.Wrappers.Raw

+ System/OpenCL/Wrappers/CommandQueue.hs view

@@ -0,0 +1,41 @@+module System.OpenCL.Wrappers.CommandQueue +    (clCreateCommandQueue+    ,clRetainCommandQueue+    ,clReleaseCommandQueue+    ,clGetCommandQueueInfo+    ,clSetCommandQueueProperty)+where++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)+import Foreign.Storable(peek)+++clCreateCommandQueue :: Context -> DeviceID -> [CommandQueueProperties] -> IO (Either ErrorCode CommandQueue)+clCreateCommandQueue ctx devid props = let+    CommandQueueProperties properties = combineOr props+        in wrapErrorEither $ raw_clCreateCommandQueue ctx devid properties ++clRetainCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)+clRetainCommandQueue queue = wrapError (raw_clRetainCommandQueue queue)++clReleaseCommandQueue :: CommandQueue -> IO (Maybe ErrorCode)+clReleaseCommandQueue queue = wrapError (raw_clReleaseCommandQueue queue)++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 +        ()+            | c == clQueueContext        -> peekOneInfo CommandQueueInfoRetvalContext x+            | c == clQueueDevice         -> peekOneInfo CommandQueueInfoRetvalDeviceID x+            | c == clQueueReferenceCount -> peekOneInfo CommandQueueInfoRetvalCLuint x+            | c == clQueueProperties     -> peekOneInfo CommandQueueInfoRetvalCommandQueueProperties x)++{-# DEPRECATED clSetCommandQueueProperty "Deprecated in C api" #-}+clSetCommandQueueProperty :: CommandQueue -> CommandQueueProperties -> Bool -> IO (Either ErrorCode CommandQueueProperties)+clSetCommandQueueProperty queue (CommandQueueProperties properties) enable = alloca $ \old_properties ->+    wrapError (raw_clSetCommandQueueProperty queue properties (if enable then clTrue else clFalse) old_properties) >>=+        maybe (fmap (Right . CommandQueueProperties) $ peek old_properties) (return . Left)

+ System/OpenCL/Wrappers/Context.hs view

@@ -0,0 +1,41 @@+module System.OpenCL.Wrappers.Context +    (clCreateContext+    ,clCreateContextFromType+    ,clRetainContext+    ,clReleaseContext+    ,clGetContextInfo+    )+where++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+import Foreign.Ptr(Ptr, nullPtr, nullFunPtr)+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+        fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify+        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+    fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify+    wrapErrorEither $ raw_clCreateContextFromType propertiesP device_type fptr user_data+    +clRetainContext :: Context -> IO (Maybe ErrorCode)+clRetainContext ctx = wrapError (raw_clRetainContext ctx)++clReleaseContext :: Context -> IO (Maybe ErrorCode)+clReleaseContext ctx = wrapError (raw_clReleaseContext ctx)++clGetContextInfo :: Context -> ContextInfo -> IO (Either ErrorCode CLContextInfoRetval)+clGetContextInfo ctx (ContextInfo param_name) = wrapGetInfo (raw_clGetContextInfo ctx param_name) >>=+        either (return.Left) (\(x,size) -> fmap Right $ let c = (ContextInfo param_name) in case () of +        ()+            | c == clContextReferenceCount -> peekOneInfo ContextInfoRetvalCLuint x+            | c == clContextDevices        -> peekManyInfo ContextInfoRetvalDeviceIDList x size+            | c == clContextProperties     -> peekManyInfo ContextInfoRetvalContextPropertiesList x size )

+ System/OpenCL/Wrappers/DeviceInfo.hs view

@@ -0,0 +1,70 @@+module System.OpenCL.Wrappers.DeviceInfo+    (clGetDeviceIDs+    ,clGetDeviceInfo)+where++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Errors+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+++clGetDeviceIDs :: PlatformID -> DeviceType -> IO (Either ErrorCode [DeviceID])+clGetDeviceIDs platform (DeviceType device_type) = wrapGetNumElements $ raw_clGetDeviceIDs platform device_type+      +clGetDeviceInfo :: DeviceID -> DeviceInfo -> IO (Either ErrorCode CLDeviceInfoRetval)+clGetDeviceInfo obj (DeviceInfo param_name) = wrapGetInfo (raw_clGetDeviceInfo obj param_name) >>=+    either (return.Left) (\(x,size) -> fmap Right $ let c = (DeviceInfo param_name) in case () of +        ()+            | c == clDeviceAddressBits                -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceAvailable                  -> peekOneInfo DeviceInfoRetvalCLbool x+            | c == clDeviceCompilerAvailable          -> peekOneInfo DeviceInfoRetvalCLbool x+            | c == clDeviceDoubleFPConfig             -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x+            | c == clDeviceEndianLittle               -> peekOneInfo DeviceInfoRetvalCLbool x+            | c == clDeviceErrorCorrectionSupport     -> peekOneInfo DeviceInfoRetvalCLbool x+            | c == clDeviceExecutionCapabilities      -> peekOneInfo DeviceInfoRetvalDeviceExecCapabilities x+            | c == clDeviceExtensions                 -> peekStringInfo DeviceInfoRetvalString x+            | c == clDeviceGlobalMemCacheSize         -> peekOneInfo DeviceInfoRetvalCLulong x+            | c == clDeviceGlobalMemCacheType         -> peekOneInfo DeviceInfoRetvalDeviceMemCacheType x+            | c == clDeviceGlobalMemCacheLineSize     -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceGlobalMemSize              -> peekOneInfo DeviceInfoRetvalCLulong x+            | c == clDeviceHalfFPConfig               -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x+            | c == clDeviceImageSupport               -> peekOneInfo DeviceInfoRetvalCLbool x+            | c == clDeviceImage2DMaxHeight           -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceImage2DMaxWidth            -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceImage3DMaxDepth            -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceImage3DMaxHeight           -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceImage3DMaxWidth            -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceLocalMemSize               -> peekOneInfo DeviceInfoRetvalCLulong x+            | c == clDeviceLocalMemType               -> peekOneInfo DeviceInfoRetvalDeviceLocalMemType x+            | c == clDeviceMaxClockFrequency          -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxComputeUnits            -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxConstantArgs            -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxConstantBufferSize      -> peekOneInfo DeviceInfoRetvalCLulong x+            | c == clDeviceMaxMemAllocSize            -> peekOneInfo DeviceInfoRetvalCLulong x+            | c == clDeviceMaxParameterSize           -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceMaxReadImageArgs           -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxSamplers                -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxWorkGroupSize           -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceMaxWorkItemDimensions      -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMaxWorkItemSizes           -> peekManyInfo DeviceInfoRetvalCLsizeiList x size+            | c == clDeviceMaxWriteImageArgs          -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMemBaseAddrAlign           -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceMinDataTypeAlignSize       -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceName                       -> peekStringInfo DeviceInfoRetvalString x+            | c == clDevicePlatform                   -> peekOneInfo DeviceInfoRetvalPlatformID x+            | c == clDevicePreferredVectorWidthChar   -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDevicePreferredVectorWidthShort  -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDevicePreferredVectorWidthInt    -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDevicePreferredVectorWidthLong   -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDevicePreferredVectorWidthFloat  -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDevicePreferredVectorWidthDouble -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceProfile                    -> peekStringInfo DeviceInfoRetvalString x+            | c == clDeviceProfilingTimerResolution   -> peekOneInfo DeviceInfoRetvalCLsizei x+            | c == clDeviceQueueProperties            -> peekOneInfo DeviceInfoRetvalCommandQueueProperties x+            | c == clDeviceSingleFPConfig             -> peekOneInfo DeviceInfoRetvalDeviceFPConfig x+            | c == clDeviceType                       -> peekOneInfo DeviceInfoRetvalDeviceType x+            | c == clDeviceVendor                     -> peekStringInfo DeviceInfoRetvalString x+            | c == clDeviceVendorID                   -> peekOneInfo DeviceInfoRetvalCLuint x+            | c == clDeviceVersion                    -> peekStringInfo DeviceInfoRetvalString x+            | c == clDriverVersion                    -> peekStringInfo DeviceInfoRetvalString x)

+ System/OpenCL/Wrappers/Errors.hs view

@@ -0,0 +1,142 @@+{-| A collection of all the error codes that OpenCL functions return -}+module System.OpenCL.Wrappers.Errors where++import System.OpenCL.Wrappers.Types++clSuccess :: ErrorCode+clSuccess = ErrorCode (0)++clDeviceNotFound :: ErrorCode+clDeviceNotFound = ErrorCode (-1)++clDeviceNotAvailable :: ErrorCode+clDeviceNotAvailable = ErrorCode (-2)++clCompilerNotAvailable :: ErrorCode+clCompilerNotAvailable = ErrorCode (-3)++clMemObjectAllocationFailure :: ErrorCode+clMemObjectAllocationFailure = ErrorCode (-4)++clOutOfResources :: ErrorCode+clOutOfResources = ErrorCode (-5)++clOutOfHostMemory :: ErrorCode+clOutOfHostMemory = ErrorCode (-6)++clProfilingInfoNotAvailable :: ErrorCode+clProfilingInfoNotAvailable = ErrorCode (-7)++clMemCopyOverlap :: ErrorCode+clMemCopyOverlap = ErrorCode (-8)++clImageFormatMismatch :: ErrorCode+clImageFormatMismatch = ErrorCode (-9)++clImageFormatNotSupported :: ErrorCode+clImageFormatNotSupported = ErrorCode (-10)++clBuildProgramFailure :: ErrorCode+clBuildProgramFailure = ErrorCode (-11)++clMapFailure :: ErrorCode+clMapFailure = ErrorCode (-12)++clInvalidValue :: ErrorCode+clInvalidValue = ErrorCode (-30)++clInvalidDeviceType :: ErrorCode+clInvalidDeviceType = ErrorCode (-31)++clInvalidPlatform :: ErrorCode+clInvalidPlatform = ErrorCode (-32)++clInvalidDevice :: ErrorCode+clInvalidDevice = ErrorCode (-33)++clInvalidContext :: ErrorCode+clInvalidContext = ErrorCode (-34)++clInvalidQueueProperties :: ErrorCode+clInvalidQueueProperties = ErrorCode (-35)++clInvalidCommandQueue :: ErrorCode+clInvalidCommandQueue = ErrorCode (-36)++clInvalidHostPtr :: ErrorCode+clInvalidHostPtr = ErrorCode (-37)++clInvalidMemObject :: ErrorCode+clInvalidMemObject = ErrorCode (-38)++clInvalidImageFormatDescriptor :: ErrorCode+clInvalidImageFormatDescriptor = ErrorCode (-39)++clInvalidImageSize :: ErrorCode+clInvalidImageSize = ErrorCode (-40)++clInvalidSampler :: ErrorCode+clInvalidSampler = ErrorCode (-41)++clInvalidBinary :: ErrorCode+clInvalidBinary = ErrorCode (-42)++clInvalidBuildOptions :: ErrorCode+clInvalidBuildOptions = ErrorCode (-43)++clInvalidProgram :: ErrorCode+clInvalidProgram = ErrorCode (-44)++clInvalidProgramExecutable :: ErrorCode+clInvalidProgramExecutable = ErrorCode (-45)++clInvalidKernelName :: ErrorCode+clInvalidKernelName = ErrorCode (-46)++clInvalidKernelDefinition :: ErrorCode+clInvalidKernelDefinition = ErrorCode (-47)++clInvalidKernel :: ErrorCode+clInvalidKernel = ErrorCode (-48)++clInvalidArgIndex :: ErrorCode+clInvalidArgIndex = ErrorCode (-49)++clInvalidArgValue :: ErrorCode+clInvalidArgValue = ErrorCode (-50)++clInvalidArgSize :: ErrorCode+clInvalidArgSize = ErrorCode (-51)++clInvalidKernelArgs :: ErrorCode+clInvalidKernelArgs = ErrorCode (-52)++clInvalidWorkDimension :: ErrorCode+clInvalidWorkDimension = ErrorCode (-53)++clInvalidWorkGroupSize :: ErrorCode+clInvalidWorkGroupSize = ErrorCode (-54)+clInvalidWorkItemSize :: ErrorCode++clInvalidWorkItemSize = ErrorCode (-55)+clInvalidGlobalOffset :: ErrorCode++clInvalidGlobalOffset = ErrorCode (-56)+clInvalidEventWaitList :: ErrorCode++clInvalidEventWaitList = ErrorCode (-57)+clInvalidEvent :: ErrorCode++clInvalidEvent = ErrorCode (-58)+clInvalidOperation :: ErrorCode++clInvalidOperation = ErrorCode (-59)+clInvalidGLObject :: ErrorCode++clInvalidGLObject = ErrorCode (-60)+clInvalidBufferSize :: ErrorCode++clInvalidBufferSize = ErrorCode (-61)+clInvalidMipLevel = ErrorCode (-62)++

+ System/OpenCL/Wrappers/Etc.hs view

@@ -0,0 +1,12 @@+{-| Module for querying extensions -}+module System.OpenCL.Wrappers.Etc +    (clGetExtensionFunctionAddress)+where++import System.OpenCL.Wrappers.Raw+import Foreign.Ptr(Ptr)+import Foreign.C.String(withCString)+++clGetExtensionFunctionAddress :: String -> IO (Ptr ())+clGetExtensionFunctionAddress str = withCString str raw_clGetExtensionFunctionAddress

+ System/OpenCL/Wrappers/EventObject.hs view

@@ -0,0 +1,41 @@+module System.OpenCL.Wrappers.EventObject +    (clWaitForEvents+    ,clGetEventInfo+    ,clRetainEvent+    ,clReleaseEvent+    ,clGetEventProfilingInfo)+where ++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+import Foreign.Marshal.Array(withArray)+++clWaitForEvents :: [Event] -> IO (Maybe ErrorCode)+clWaitForEvents evts = withArray evts (\eventP -> wrapError $ raw_clWaitForEvents (fromIntegral nEvents) eventP)+    where nEvents = length evts+                            +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 +        ()+            | c == clEventCommandQueue           -> peekOneInfo EventInfoRetvalCommandQueue x+            | c == clEventCommandType            -> peekOneInfo EventInfoRetvalCommandType x+            | c == clEventCommandExecutionStatus -> peekOneInfo EventInfoRetvalCLint x+            | c == clEventReferenceCount         -> peekOneInfo EventInfoRetvalCLuint x )++clRetainEvent :: Event -> IO (Maybe ErrorCode)+clRetainEvent evt = wrapError $ raw_clRetainEvent evt++clReleaseEvent :: Event -> IO (Maybe ErrorCode)+clReleaseEvent evt = wrapError $ raw_clReleaseEvent evt ++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 +        ()+            | c == clProfilingCommandQueued -> peekOneInfo EventProfilingInfoRetvalCLulong x+            | c == clProfilingCommandSubmit -> peekOneInfo EventProfilingInfoRetvalCLulong x+            | c == clProfilingCommandStart  -> peekOneInfo EventProfilingInfoRetvalCLulong x+            | c == clProfilingCommandEnd    -> peekOneInfo EventProfilingInfoRetvalCLulong x )

+ System/OpenCL/Wrappers/FlushFinish.hs view

@@ -0,0 +1,15 @@+module System.OpenCL.Wrappers.FlushFinish +    (clFlush+    ,clFinish)+where++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+++clFlush :: CommandQueue -> IO (Maybe ErrorCode)+clFlush queue = wrapError $ raw_clFlush queue++clFinish :: CommandQueue -> IO (Maybe ErrorCode)+clFinish queue = wrapError $ raw_clFinish queue

+ System/OpenCL/Wrappers/Helpers.hs view

@@ -0,0 +1,57 @@+{-# LANGUAGE ExistentialQuantification #-}+{-| Some helper functions that may or may not be useful to anyone. -}+module System.OpenCL.Wrappers.Helpers+    (createSyncKernel+    ,createAsyncKernelWithParams+    ,buildProgram+    ,pushKernelParams)+where++import System.OpenCL.Wrappers.Kernel+import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.ProgramObject+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) = +    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)++createSyncKernel :: forall b. Storable b => Program -> CommandQueue -> String -> [Int] -> [Int] -> IO (Either ErrorCode ([b] -> 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 queue initFun globalWorkRange localWorkRange params =+        clCreateKernel program initFun >>=+            either (return.Left) (\k -> pushKernelParams k 0 params >>=+                maybe (return.Right $ clEnqueueNDRangeKernel queue k (map fromIntegral globalWorkRange) (map fromIntegral localWorkRange)) (return.Left)) ++buildProgram :: String -> String -> Context -> DeviceID -> IO (Either (ErrorCode, String) Program)+buildProgram source opts context dID =+    clCreateProgramWithSource context source >>=+        either (\x -> return $ Left (x, "")) (\program -> clBuildProgram program [dID] opts Nothing nullPtr >>=+            maybe (return $ Right program) (\x -> do+                y <- fmap Left $ reportBuildFailure program dID x+                _ <- clReleaseProgram program+                return y))++reportBuildFailure :: Program -> DeviceID -> ErrorCode -> IO (ErrorCode,String)+reportBuildFailure program dID eCode = clGetProgramBuildInfo program dID clProgramBuildLog >>=+        either (\x -> return (x,"")) (\x -> case x of+            (ProgramBuildInfoRetvalString s) -> return (eCode,s)+            _                                -> undefined) +

+ System/OpenCL/Wrappers/Kernel.hs view

@@ -0,0 +1,103 @@+module System.OpenCL.Wrappers.Kernel +    (clCreateKernel+    ,clCreateKernelsInProgram+    ,clRetainKernel+    ,clReleaseKernel+    ,clGetKernelInfo+    ,clSetKernelArg+    ,clGetKernelWorkGroupInfo+    ,clEnqueueNDRangeKernel+    ,clEnqueueTask+    ,clEnqueueNativeKernel)+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+++clCreateKernel program init_name = withCString init_name (\x -> wrapErrorEither $ raw_clCreateKernel program x)++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++clRetainKernel :: Kernel -> IO (Maybe ErrorCode)+clRetainKernel kernel = wrapError $ raw_clRetainKernel kernel++clReleaseKernel :: Kernel -> IO (Maybe ErrorCode)+clReleaseKernel kernel = wrapError $ raw_clRetainKernel kernel++clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO (Maybe ErrorCode)+clSetKernelArg kernel arg_index arg_size arg_value = +    wrapError $ raw_clSetKernelArg kernel arg_index arg_size arg_value++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 +        ()+            | c == clKernelFunctionName   -> peekStringInfo KernelInfoRetvalString x+            | c == clKernelNumArgs        -> peekOneInfo KernelInfoRetvalCLuint x+            | c == clKernelReferenceCount -> peekOneInfo KernelInfoRetvalCLuint x+            | c == clKernelContext        -> peekOneInfo KernelInfoRetvalContext x+            | c == clKernelProgram        -> peekOneInfo KernelInfoRetvalProgram x)++clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> KernelWorkGroupInfo -> IO (Either ErrorCode CLKernelWorkGroupInfoRetval)+clGetKernelWorkGroupInfo kernel device (KernelWorkGroupInfo param_name) = (wrapGetInfo $ raw_clGetKernelWorkGroupInfo kernel device param_name) >>=+    either (return.Left) (\(x,size) -> fmap Right $ let c = (KernelWorkGroupInfo param_name) in case () of +        ()+            | c == clKernelWorkGroupSize        -> peekOneInfo KernelWorkGroupInfoRetvalCLsizei x+            | c == clKernelCompileWorkGroupSize -> peekManyInfo KernelWorkGroupInfoRetvalCLsizeiList x size+            | c == clKernelLocalMemSize         -> peekOneInfo KernelWorkGroupInfoRetvalCLulong x)++clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> [CLsizei] -> [CLsizei] -> [Event] -> IO (Either ErrorCode Event) +clEnqueueNDRangeKernel queue kernel global_work_sizeL local_work_sizeL event_wait_listL = +    withArray global_work_sizeL $ \global_work_size ->+    withArrayNull local_work_sizeL $ \local_work_size ->+    withArrayNull event_wait_listL $ \event_wait_list ->+    alloca $ \event -> do+        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+    where work_dim = length global_work_sizeL+          num_events_in_wait_list = length event_wait_listL+        +clEnqueueTask :: CommandQueue -> Kernel -> [Event] -> IO (Either ErrorCode 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+    where num_events_in_wait_list = length event_wait_listL++clEnqueueNativeKernel :: NativeKernelCallback -> Ptr () -> CLsizei -> [Mem] -> [Ptr ()] -> [Event] -> IO (Either ErrorCode 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 -> +    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+    where num_events_in_wait_list = length event_wait_listL+          num_mem_objects = length mem_listL

+ System/OpenCL/Wrappers/MemoryObject.hs view

@@ -0,0 +1,226 @@+module System.OpenCL.Wrappers.MemoryObject +    (clCreateBuffer+    ,clCreateImage2D+    ,clCreateImage3D+    ,clRetainMemObject+    ,clReleaseMemObject+    ,clGetSupportedImageFormats+    ,clGetMemObjectInfo+    ,clGetImageInfo+    ,clEnqueueReadBuffer+    ,clEnqueueWriteBuffer+    ,clEnqueueCopyBuffer+    ,clEnqueueReadImage+    ,clEnqueueWriteImage+    ,clEnqueueCopyImage+    ,clEnqueueCopyImageToBuffer+    ,clEnqueueCopyBufferToImage+    ,clEnqueueMapBuffer+    ,clEnqueueMapImage+    ,clEnqueueUnmapMemObject)+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)+clCreateBuffer ctx (MemFlags flags) size host_ptr = wrapErrorEither $ raw_clCreateBuffer ctx flags size host_ptr +              +clCreateImage2D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode 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+                        +clCreateImage3D :: Context -> MemFlags -> ImageFormat -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> IO (Either ErrorCode 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 +                        +clRetainMemObject :: Mem -> IO (Maybe ErrorCode) +clRetainMemObject mem = wrapError $ raw_clRetainMemObject mem++clReleaseMemObject :: Mem -> IO (Maybe ErrorCode) +clReleaseMemObject mem = wrapError $ raw_clReleaseMemObject mem+                                    +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++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 +        ()+            | c == clMemType           -> peekOneInfo MemObjectInfoRetvalMemObjectType x+            | c == clMemFlags          -> peekOneInfo MemObjectInfoRetvalMemFlags x+            | c == clMemSize           -> peekOneInfo MemObjectInfoRetvalCLsizei x+            | c == clMemHostPtr        -> peekOneInfo MemObjectInfoRetvalPtr x+            | c == clMemMapCount       -> peekOneInfo MemObjectInfoRetvalCLuint x+            | c == clMemReferenceCount -> peekOneInfo MemObjectInfoRetvalCLuint x+            | c == clMemContext        -> peekOneInfo MemObjectInfoRetvalContext x)++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 +        ()+            | c == clImageElementSize -> peekOneInfo ImageInfoRetvalCLsizei x+            | c == clImageRowPitch    -> peekOneInfo ImageInfoRetvalCLsizei x+            | c == clImageSlicePitch  -> peekOneInfo ImageInfoRetvalCLsizei x+            | c == clImageWidth       -> peekOneInfo ImageInfoRetvalCLsizei x+            | c == clImageHeight      -> peekOneInfo ImageInfoRetvalCLsizei x+            | c == clImageDepth       -> peekOneInfo ImageInfoRetvalCLsizei x)+        +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+    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)+    where events_in_wait_list = length events+    +    +clEnqueueReadBuffer buffer blocking_read offset cb ptr = +    enqueue (\command_queue num_events_in_wait_list event_wait_list event -> +                raw_clEnqueueReadBuffer +                    command_queue +                    buffer +                    (if blocking_read then clTrue else clFalse) +                    offset +                    cb +                    ptr +                    num_events_in_wait_list +                    event_wait_list +                    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 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 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 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_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)                 ++clEnqueueCopyImage :: Mem -> Mem -> ImageDims -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode 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]+                pokeArray src_origin [soa,sob,soc]+                pokeArray dst_origin [doa,dob,doc]+                raw_clEnqueueCopyImage command_queue src_image dst_image src_origin dst_origin region num_events_in_wait_list event_wait_list event)++                           +clEnqueueCopyImageToBuffer :: Mem -> Mem -> ImageDims -> ImageDims -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode 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]+                pokeArray src_origin [soa,sob,soc]+                raw_clEnqueueCopyImageToBuffer +                    command_queue +                    src_image +                    dst_buffer +                    src_origin +                    region +                    dst_offset +                    num_events_in_wait_list +                    event_wait_list +                    event)+++clEnqueueCopyBufferToImage :: Mem -> Mem -> CLsizei -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode 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]+                pokeArray dst_origin [soa,sob,soc]+                raw_clEnqueueCopyBufferToImage +                    command_queue +                    src_buffer +                    dst_image +                    src_offset +                    dst_origin +                    region +                    num_events_in_wait_list +                    event_wait_list +                    event)+++clEnqueueMapBuffer :: Mem -> Bool -> MapFlags -> CLsizei -> CLsizei -> CommandQueue -> [Event] -> IO (Either ErrorCode (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 +            command_queue +            buffer +            (if blocking_map then clTrue else clFalse) +            map_flags +            offset +            cb +            (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)+    where num_events_in_wait_list = length events++clEnqueueMapImage :: Mem -> Bool -> MapFlags -> ImageDims -> ImageDims -> CommandQueue -> [Event] -> IO (Either ErrorCode (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 -> +    allocaArray 3 $ \region -> +    allocaArray 3 $ \origin -> +    alloca $ \image_row_pitch -> +    alloca $ \image_slice_pitch -> do+        pokeArray origin [oa,ob,oc]+        pokeArray region [ra,rb,rc]        +        ret <- wrapErrorEither $ raw_clEnqueueMapImage+            command_queue +            buffer +            (if blocking_map then clTrue else clFalse) +            map_flags +            origin +            region +            image_row_pitch +            image_slice_pitch +            (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') +        where num_events_in_wait_list = length events+                  ++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)+

+ System/OpenCL/Wrappers/OutOfOrder.hs view

@@ -0,0 +1,24 @@+module System.OpenCL.Wrappers.OutOfOrder+    (clEnqueueMarker+    ,clEnqueueWaitForEvents+    ,clEnqueueBarrier)+where ++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+import Foreign(withArray,peek,alloca)++clEnqueueMarker :: CommandQueue -> IO (Either ErrorCode Event)+clEnqueueMarker queue = alloca (\eventP ->+    wrapError (raw_clEnqueueMarker queue eventP) >>=+        maybe (fmap Right $ peek eventP) (return.Left))+    +clEnqueueWaitForEvents :: CommandQueue -> [Event] -> IO (Maybe ErrorCode)+clEnqueueWaitForEvents queue events =+    withArray events (\eventsP ->+        wrapError $ raw_clEnqueueWaitForEvents queue (fromIntegral num_events) eventsP)+    where num_events = length events++clEnqueueBarrier :: CommandQueue -> IO (Maybe ErrorCode) +clEnqueueBarrier queue = wrapError $ raw_clEnqueueBarrier queue

+ System/OpenCL/Wrappers/PlatformInfo.hs view

@@ -0,0 +1,17 @@+module System.OpenCL.Wrappers.PlatformInfo (+    clGetPlatformIDs+  , clGetPlatformInfo+  ) where++import System.OpenCL.Wrappers.Types+import System.OpenCL.Wrappers.Errors+import System.OpenCL.Wrappers.Utils+import System.OpenCL.Wrappers.Raw+++clGetPlatformIDs :: IO (Either ErrorCode [PlatformID])+clGetPlatformIDs = wrapGetNumElements raw_clGetPlatformIDs++clGetPlatformInfo :: PlatformID -> PlatformInfo -> IO (Either ErrorCode CLPlatformInfoRetval)+clGetPlatformInfo mem (PlatformInfo param_name) = wrapGetInfo (raw_clGetPlatformInfo mem param_name) >>=+    either (return.Left) (\(x,_) -> fmap Right $ peekStringInfo PlatformInfoRetvalString x)

+ System/OpenCL/Wrappers/ProgramObject.hs view

@@ -0,0 +1,87 @@+module System.OpenCL.Wrappers.ProgramObject +    (clCreateProgramWithSource+    ,clCreateProgramWithBinary+    ,clRetainProgram+    ,clReleaseProgram+    ,clBuildProgram+    ,clUnloadCompiler+    ,clGetProgramInfo+    ,clGetProgramBuildInfo)+where++import Control.Monad.Cont+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 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))   ++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 -> +    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+        if errcode == clSuccess && binstatus == clSuccess+            then return $ Right program+            else return $ Left (if errcode == clSuccess then binstatus else errcode)+    where bsPtr (SBS.PS p _ _) = p+          num_devices = length device_list+          (device_list,bins) = unzip devbin_pair+        +clRetainProgram :: Program -> IO (Maybe ErrorCode) +clRetainProgram prog = wrapError $ raw_clRetainProgram prog++clReleaseProgram :: Program -> IO (Maybe ErrorCode) +clReleaseProgram prog = wrapError $ raw_clReleaseProgram prog++clBuildProgram :: Program -> [DeviceID] -> String -> (Maybe BuildProgramCallback) -> Ptr () -> IO (Maybe ErrorCode)+clBuildProgram program devices ops pfn_notifyF user_data = +    allocaArray num_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   ++clUnloadCompiler :: IO (Maybe ErrorCode)+clUnloadCompiler = wrapError $ raw_clUnloadCompiler++clGetProgramInfo :: Program -> ProgramInfo -> IO (Either ErrorCode CLProgramInfoRetval)+clGetProgramInfo program (ProgramInfo param_name) = (wrapGetInfo $ raw_clGetProgramInfo program param_name) >>=+    either (return.Left) (\(x,size) -> fmap Right $ let c = (ProgramInfo param_name) in case () of +        ()+            | c == clProgramReferenceCount -> peekOneInfo ProgramInfoRetvalCLUint x+            | c == clProgramContext        -> peekOneInfo ProgramInfoRetvalContext x+            | c == clProgramNumDevices     -> peekOneInfo ProgramInfoRetvalCLUint x+            | c == clProgramDevices        -> peekManyInfo ProgramInfoRetvalDeviceIDList x size+            | c == clProgramSource         -> peekStringInfo ProgramInfoRetvalString x+            | c == clProgramBinarySizes    -> peekManyInfo ProgramInfoRetvalCLsizeiList x size+            | c == clProgramBinaries       -> peekManyInfo ProgramInfoRetvalPtrList x size )++clGetProgramBuildInfo :: Program -> DeviceID -> ProgramBuildInfo -> IO (Either ErrorCode CLProgramBuildInfoRetval)+clGetProgramBuildInfo program devID (ProgramBuildInfo param_name) = (wrapGetInfo $ raw_clGetProgramBuildInfo program devID param_name) >>=+    either (return.Left) (\(x,_) -> fmap Right $ let c = (ProgramBuildInfo param_name) in case () of+        ()+            | c == clProgramBuildStatus -> peekOneInfo (ProgramBuildInfoRetvalBuildStatus . BuildStatus) x+            | True                      -> peekStringInfo (ProgramBuildInfoRetvalString) x )

+ System/OpenCL/Wrappers/Raw.hs view

@@ -0,0 +1,151 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.OpenCL.Wrappers.Raw+    (raw_clCreateCommandQueue+    ,raw_clRetainCommandQueue+    ,raw_clReleaseCommandQueue+    ,raw_clGetCommandQueueInfo+    ,raw_clSetCommandQueueProperty+    ,raw_clCreateContext+    ,raw_clCreateContextFromType+    ,raw_clRetainContext+    ,raw_clReleaseContext+    ,raw_clGetContextInfo+    ,raw_clGetDeviceIDs+    ,raw_clGetDeviceInfo+    ,raw_clGetExtensionFunctionAddress+    ,raw_clWaitForEvents+    ,raw_clGetEventInfo+    ,raw_clRetainEvent+    ,raw_clReleaseEvent+    ,raw_clGetEventProfilingInfo+    ,raw_clFlush+    ,raw_clFinish+    ,raw_clCreateKernel+    ,raw_clCreateKernelsInProgram+    ,raw_clRetainKernel+    ,raw_clReleaseKernel+    ,raw_clSetKernelArg+    ,raw_clGetKernelInfo+    ,raw_clGetKernelWorkGroupInfo+    ,raw_clEnqueueNDRangeKernel+    ,raw_clEnqueueTask+    ,raw_clEnqueueNativeKernel+    ,raw_clCreateBuffer+    ,raw_clCreateImage2D+    ,raw_clCreateImage3D+    ,raw_clRetainMemObject+    ,raw_clReleaseMemObject+    ,raw_clGetSupportedImageFormats+    ,raw_clGetMemObjectInfo+    ,raw_clGetImageInfo+    ,raw_clEnqueueReadBuffer+    ,raw_clEnqueueWriteBuffer+    ,raw_clEnqueueCopyBuffer+    ,raw_clEnqueueReadImage+    ,raw_clEnqueueWriteImage+    ,raw_clEnqueueCopyImage+    ,raw_clEnqueueCopyImageToBuffer+    ,raw_clEnqueueCopyBufferToImage+    ,raw_clEnqueueMapBuffer+    ,raw_clEnqueueMapImage+    ,raw_clEnqueueUnmapMemObject+    ,raw_clEnqueueMarker+    ,raw_clEnqueueWaitForEvents+    ,raw_clEnqueueBarrier+    ,raw_clGetPlatformIDs+    ,raw_clGetPlatformInfo+    ,raw_clCreateProgramWithSource+    ,raw_clCreateProgramWithBinary+    ,raw_clRetainProgram+    ,raw_clReleaseProgram+    ,raw_clBuildProgram+    ,raw_clUnloadCompiler+    ,raw_clGetProgramInfo+    ,raw_clGetProgramBuildInfo+    ,raw_clCreateSampler+    ,raw_clRetainSampler+    ,raw_clReleaseSampler+    ,raw_clGetSamplerInfo+    --Callback functions+    ,wrapContextCallback+    ,wrapNativeKernelCallback+    ,wrapBuildProgramCallback+    )+where++import System.OpenCL.Wrappers.Types+--import System.OpenCL.Wrappers.Errors+import Foreign+import Foreign.C++foreign import ccall "wrapper" wrapContextCallback :: ContextCallback -> IO (FunPtr ContextCallback)+foreign import ccall "wrapper" wrapNativeKernelCallback :: NativeKernelCallback -> IO (FunPtr NativeKernelCallback)+foreign import ccall "wrapper" wrapBuildProgramCallback :: BuildProgramCallback -> IO (FunPtr BuildProgramCallback)+++foreign import ccall "clCreateCommandQueue" raw_clCreateCommandQueue :: Context -> DeviceID -> CLbitfield -> Ptr CLint -> IO CommandQueue+foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: CommandQueue -> IO CLint+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 "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+foreign import ccall "clGetContextInfo" raw_clGetContextInfo :: Context -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clGetDeviceIDs" raw_clGetDeviceIDs :: PlatformID -> CLbitfield -> CLuint -> Ptr DeviceID -> Ptr CLuint -> IO CLint+foreign import ccall "clGetDeviceInfo" raw_clGetDeviceInfo :: DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clGetExtensionFunctionAddress" raw_clGetExtensionFunctionAddress :: CString -> IO (Ptr ())+foreign import ccall "clWaitForEvents" raw_clWaitForEvents :: CLuint -> Ptr Event -> IO CLint+foreign import ccall "clGetEventInfo" raw_clGetEventInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clRetainEvent" raw_clRetainEvent :: Event -> IO CLint +foreign import ccall "clReleaseEvent" raw_clReleaseEvent :: Event -> IO CLint +foreign import ccall "clGetEventProfilingInfo" raw_clGetEventProfilingInfo :: Event -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clFlush" raw_clFlush :: CommandQueue -> IO CLint+foreign import ccall "clFinish" raw_clFinish :: CommandQueue -> IO CLint+foreign import ccall "clCreateKernel" raw_clCreateKernel :: Program -> CString -> Ptr CLint -> IO Kernel +foreign import ccall "clCreateKernelsInProgram" raw_clCreateKernelsInProgram :: Program -> CLuint -> Ptr Kernel -> Ptr CLuint -> IO CLint +foreign import ccall "clRetainKernel" raw_clRetainKernel :: Kernel -> IO CLint +foreign import ccall "clReleaseKernel" raw_clReleaseKernel :: Kernel -> IO CLint +foreign import ccall "clSetKernelArg" raw_clSetKernelArg :: Kernel -> CLuint -> CLsizei -> Ptr () -> IO CLint+foreign import ccall "clGetKernelInfo" raw_clGetKernelInfo :: Kernel -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clGetKernelWorkGroupInfo" raw_clGetKernelWorkGroupInfo :: Kernel -> DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clEnqueueNDRangeKernel" raw_clEnqueueNDRangeKernel :: CommandQueue -> Kernel -> CLuint -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event  -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueTask" raw_clEnqueueTask :: CommandQueue -> Kernel -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueNativeKernel" raw_clEnqueueNativeKernel :: FunPtr NativeKernelCallback -> Ptr () -> CLsizei -> CLuint -> Ptr Mem -> Ptr (Ptr ()) -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clCreateBuffer" raw_clCreateBuffer :: Context -> CLbitfield -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem+foreign import ccall "clCreateImage2D" raw_clCreateImage2D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem+foreign import ccall "clCreateImage3D" raw_clCreateImage3D :: Context -> CLbitfield -> Ptr CLuint -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> CLsizei -> Ptr () -> Ptr CLint -> IO Mem+foreign import ccall "clRetainMemObject" raw_clRetainMemObject :: Mem -> IO CLint+foreign import ccall "clReleaseMemObject" raw_clReleaseMemObject :: Mem -> IO CLint+foreign import ccall "clGetSupportedImageFormats" raw_clGetSupportedImageFormats :: Context -> CLbitfield -> CLuint -> CLuint -> Ptr CLuint -> Ptr CLuint -> IO CLint+foreign import ccall "clGetMemObjectInfo" raw_clGetMemObjectInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clGetImageInfo" raw_clGetImageInfo :: Mem -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clEnqueueReadBuffer" raw_clEnqueueReadBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueWriteBuffer" raw_clEnqueueWriteBuffer :: CommandQueue -> Mem -> CLbool -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueCopyBuffer" raw_clEnqueueCopyBuffer :: CommandQueue -> Mem -> Mem -> CLsizei -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueReadImage" raw_clEnqueueReadImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueWriteImage" raw_clEnqueueWriteImage :: CommandQueue -> Mem -> CLbool -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLsizei -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueCopyImage" raw_clEnqueueCopyImage :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueCopyImageToBuffer" raw_clEnqueueCopyImageToBuffer :: CommandQueue -> Mem -> Mem -> Ptr CLsizei -> Ptr CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueCopyBufferToImage" raw_clEnqueueCopyBufferToImage :: CommandQueue -> Mem -> Mem -> CLsizei -> Ptr CLsizei -> Ptr CLsizei -> CLuint -> Ptr Event -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueMapBuffer" raw_clEnqueueMapBuffer :: CommandQueue -> Mem -> CLbool -> CLbitfield -> CLsizei -> CLsizei -> CLuint -> Ptr Event -> Ptr Event -> Ptr CLint -> IO (Ptr ())+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 ())+foreign import ccall "clEnqueueUnmapMemObject" raw_clEnqueueUnmapMemObject :: CommandQueue -> Mem -> Ptr () -> CLuint -> Ptr Event -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueMarker" raw_clEnqueueMarker :: CommandQueue -> Ptr Event -> IO CLint +foreign import ccall "clEnqueueWaitForEvents" raw_clEnqueueWaitForEvents :: CommandQueue -> CLuint -> Ptr Event -> IO CLint+foreign import ccall "clEnqueueBarrier" raw_clEnqueueBarrier :: CommandQueue -> IO CLint +foreign import ccall "clGetPlatformIDs" raw_clGetPlatformIDs :: CLuint -> Ptr PlatformID -> Ptr CLuint -> IO CLint+foreign import ccall "clGetPlatformInfo" raw_clGetPlatformInfo :: PlatformID -> CLuint -> CSize -> Ptr () -> Ptr CSize -> IO CLint +foreign import ccall "clCreateProgramWithSource" raw_clCreateProgramWithSource :: Context -> CLuint -> Ptr CString -> Ptr CLsizei -> Ptr CLint -> IO Program+foreign import ccall "clCreateProgramWithBinary" raw_clCreateProgramWithBinary :: Context -> CLuint -> Ptr DeviceID -> Ptr CLsizei -> Ptr (Ptr Word8) -> Ptr CLint -> Ptr CLint -> IO Program+foreign import ccall "clRetainProgram" raw_clRetainProgram :: Program -> IO CLint+foreign import ccall "clReleaseProgram" raw_clReleaseProgram :: Program -> IO CLint+foreign import ccall "clBuildProgram" raw_clBuildProgram :: Program -> CLuint -> Ptr DeviceID -> CString -> FunPtr BuildProgramCallback -> Ptr () -> IO CLint+foreign import ccall "clUnloadCompiler" raw_clUnloadCompiler :: IO CLint+foreign import ccall "clGetProgramInfo" raw_clGetProgramInfo :: Program -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clGetProgramBuildInfo" raw_clGetProgramBuildInfo :: Program -> DeviceID -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint+foreign import ccall "clCreateSampler" raw_clCreateSampler :: Context -> CLbool -> CLuint -> CLuint -> Ptr CLint -> IO Sampler+foreign import ccall "clRetainSampler" raw_clRetainSampler :: Sampler -> IO CLint+foreign import ccall "clReleaseSampler" raw_clReleaseSampler :: Sampler -> IO CLint+foreign import ccall "clGetSamplerInfo" raw_clGetSamplerInfo :: Sampler -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint

+ System/OpenCL/Wrappers/Sampler.hs view

@@ -0,0 +1,37 @@+module System.OpenCL.Wrappers.Sampler+    (clCreateSampler+    ,clRetainSampler+    ,clReleaseSampler+    ,clGetSamplerInfo)+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+++clCreateSampler :: Context -> Bool -> AddressingMode -> FilterMode -> IO (Either ErrorCode 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++clRetainSampler :: Sampler -> IO (Maybe ErrorCode) +clRetainSampler sampler = wrapError $ raw_clRetainSampler sampler++clReleaseSampler :: Sampler -> IO (Maybe ErrorCode) +clReleaseSampler sampler = wrapError $ raw_clReleaseSampler sampler++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 +        ()+            | c == clSamplerReferenceCount   -> peekOneInfo SamplerInfoRetvalCLuint x+            | c == clSamplerContext          -> peekOneInfo SamplerInfoRetvalContext x+            | c == clSamplerAddressingMode   -> peekOneInfo SamplerInfoRetvalAddressingMode x+            | c == clSamplerFilterMode       -> peekOneInfo SamplerInfoRetvalFilterMode x+            | c == clSamplerNormalizedCoords -> peekOneInfo SamplerInfoRetvalCLbool x)+

+ System/OpenCL/Wrappers/Types.hs view

@@ -0,0 +1,658 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-| Declaration of types, bounds and constants -}+module System.OpenCL.Wrappers.Types where++import Foreign.C.Types+import Foreign.C.String(CString)+import Foreign++data PlatformIDc = PlatformIDc+data DeviceIDc = DeviceIDc+data Contextc = Contextc+data CommandQueuec = CommandQueuec+data Memc = Memc+data Programc = Programc+data Kernelc = Kernelc+data Eventc = Eventc+data Samplerc = Samplerc+data ImageFormatc = ImageFormatc++type ContextProperties = Ptr CLint+type PlatformID = Ptr PlatformIDc+type DeviceID = Ptr DeviceIDc+type Context = Ptr Contextc+type CommandQueue = Ptr CommandQueuec+type Mem = Ptr Memc+type Program = Ptr Programc+type Event = Ptr Eventc+type Sampler = Ptr Samplerc+type Kernel = Ptr Kernelc++type CLsizei = CSize+type CLint = CInt+type CLuint = CUInt+type CLbool = CLuint+type CLulong = CULong+type CLbitfield = CLulong+type ImageFormatp = Ptr ImageFormat++type ImageFormat = (ChannelOrder,ChannelType)+type ImageDims = (CLsizei,CLsizei,CLsizei)++newtype ChannelOrder = ChannelOrder CLuint+    deriving (Eq)+newtype ChannelType = ChannelType CLuint+    deriving (Eq)+newtype DeviceType = DeviceType CLbitfield+    deriving (Eq,Storable)+newtype ContextInfo = ContextInfo CLuint+    deriving (Eq)+newtype CommandQueueProperties = CommandQueueProperties CLbitfield+    deriving (Eq,Storable)+newtype CommandQueueInfo = CommandQueueInfo CLuint+    deriving (Eq)+newtype ErrorCode = ErrorCode CLint deriving (Eq,Ord,Show,Read)+newtype EventInfo = EventInfo CLuint+    deriving (Eq)+newtype ProfilingInfo = ProfilingInfo CLuint+    deriving (Eq)+newtype KernelInfo = KernelInfo CLuint+    deriving (Eq)+newtype KernelWorkGroupInfo = KernelWorkGroupInfo CLuint+    deriving (Eq)+newtype MapFlags = MapFlags CLbitfield+newtype MemFlags = MemFlags CLbitfield+    deriving (Eq,Storable)+newtype MemObjectType = MemObjectType CLuint+    deriving (Eq,Storable)+newtype MemInfo = MemInfo CLuint+    deriving (Eq)+newtype PlatformInfo = PlatformInfo CLuint+    deriving (Eq)+newtype SamplerInfo = SamplerInfo CLuint+    deriving (Eq)+newtype AddressingMode = AddressingMode CLuint+    deriving (Eq,Storable)+newtype FilterMode = FilterMode CLuint+    deriving (Eq,Storable)+newtype ProgramInfo = ProgramInfo CLuint+    deriving (Eq)+newtype ProgramBuildInfo = ProgramBuildInfo CLuint+    deriving (Eq)+newtype BuildStatus = BuildStatus CLint+    deriving (Eq)+newtype DeviceInfo = DeviceInfo CLuint+    deriving (Eq)+newtype DeviceFPConfig = DeviceFPConfig CLbitfield+    deriving (Eq,Storable)+newtype CommandType = CommandType CLuint+    deriving (Eq,Storable)+newtype DeviceExecCapabilities = DeviceExecCapabilities CLbitfield+    deriving (Eq,Storable)+newtype DeviceMemCacheType = DeviceMemCacheType CLuint+    deriving (Eq,Storable)+newtype DeviceLocalMemType = DeviceLocalMemType CLuint+    deriving (Eq,Storable)++data CLKernelInfoRetval = KernelInfoRetvalString String | KernelInfoRetvalCLuint CLuint | KernelInfoRetvalContext Context | KernelInfoRetvalProgram Program+    deriving(Eq)+data CLKernelWorkGroupInfoRetval = KernelWorkGroupInfoRetvalCLsizei CLsizei | KernelWorkGroupInfoRetvalCLsizeiList [CLsizei] | KernelWorkGroupInfoRetvalCLulong CLulong+    deriving(Eq)+data CLImageInfoRetval = ImageInfoRetvalCLsizei CLsizei | ImageInfoRetvalImageFormat ImageFormat | ImageInfoRetvalPtr (Ptr ())+    deriving(Eq)+data CLMemObjectInfoRetval = MemObjectInfoRetvalMemObjectType MemObjectType | MemObjectInfoRetvalMemFlags MemFlags | MemObjectInfoRetvalCLsizei CLsizei | MemObjectInfoRetvalPtr (Ptr ()) | MemObjectInfoRetvalCLuint CLuint | MemObjectInfoRetvalContext Context | MemObjectInfoRetvalMem Mem+    deriving(Eq)+data CLEventInfoRetval = EventInfoRetvalCommandQueue CommandQueue | EventInfoRetvalContext Context| EventInfoRetvalCommandType CommandType | EventInfoRetvalCLint CLint | EventInfoRetvalCLuint CLuint+    deriving(Eq)+data CLEventProfilingInfoRetval = EventProfilingInfoRetvalCLulong CLulong+    deriving(Eq)+data CLContextInfoRetval = ContextInfoRetvalCLuint CLuint | ContextInfoRetvalDeviceIDList [DeviceID] | ContextInfoRetvalContextPropertiesList [ContextProperties]+    deriving(Eq)+data CLCommandQueueInfoRetval = CommandQueueInfoRetvalContext Context | CommandQueueInfoRetvalDeviceID DeviceID | CommandQueueInfoRetvalCLuint CLuint | CommandQueueInfoRetvalCommandQueueProperties CommandQueueProperties+    deriving(Eq)+data CLDeviceInfoRetval = DeviceInfoRetvalString String | DeviceInfoRetvalCLuint CLuint | DeviceInfoRetvalCLbool CLbool | DeviceInfoRetvalDeviceFPConfig DeviceFPConfig | DeviceInfoRetvalDeviceExecCapabilities DeviceExecCapabilities | DeviceInfoRetvalCLulong CLulong | DeviceInfoRetvalDeviceMemCacheType DeviceMemCacheType | DeviceInfoRetvalCLsizei CLsizei | DeviceInfoRetvalDeviceLocalMemType DeviceLocalMemType | DeviceInfoRetvalCLsizeiList [CLsizei] | DeviceInfoRetvalPlatformID PlatformID | DeviceInfoRetvalCommandQueueProperties CommandQueueProperties | DeviceInfoRetvalDeviceType DeviceType+    deriving(Eq)+data CLProgramInfoRetval = ProgramInfoRetvalCLUint CLuint | ProgramInfoRetvalContext Context | ProgramInfoRetvalDeviceIDList [DeviceID] | ProgramInfoRetvalString String | ProgramInfoRetvalPtrList [Ptr ()] | ProgramInfoRetvalCLsizeiList [CLsizei]+    deriving(Eq)+data CLProgramBuildInfoRetval = ProgramBuildInfoRetvalBuildStatus BuildStatus | ProgramBuildInfoRetvalString String+    deriving(Eq)+data CLPlatformInfoRetval = PlatformInfoRetvalString String+    deriving(Eq)+data CLSamplerInfoRetval = SamplerInfoRetvalCLuint CLuint | SamplerInfoRetvalContext Context | SamplerInfoRetvalAddressingMode AddressingMode | SamplerInfoRetvalFilterMode FilterMode | SamplerInfoRetvalCLbool CLbool+    deriving(Eq)++type ContextCallback = (CString -> Ptr () -> CLsizei -> Ptr () -> IO ())+type NativeKernelCallback = Ptr () -> IO ()+type BuildProgramCallback = Program -> Ptr () -> IO ()++clQueueOutOfOrderExecModeEnable :: CommandQueueProperties +clQueueOutOfOrderExecModeEnable = CommandQueueProperties (1`shiftL`0)++clQueueProfilingEnable :: CommandQueueProperties +clQueueProfilingEnable = CommandQueueProperties (1`shiftL`1)++clQueueContext :: CommandQueueInfo +clQueueContext = CommandQueueInfo 0x1090++clQueueDevice :: CommandQueueInfo +clQueueDevice = CommandQueueInfo 0x1091++clQueueReferenceCount :: CommandQueueInfo +clQueueReferenceCount = CommandQueueInfo 0x1092++clQueueProperties :: CommandQueueInfo +clQueueProperties = CommandQueueInfo 0x1093++clDeviceType :: DeviceInfo +clDeviceType = DeviceInfo 0x1000 ++clDeviceVendorID :: DeviceInfo +clDeviceVendorID = DeviceInfo 0x1001++clDeviceMaxComputeUnits :: DeviceInfo +clDeviceMaxComputeUnits = DeviceInfo 0x1002++clDeviceMaxWorkItemDimensions :: DeviceInfo +clDeviceMaxWorkItemDimensions = DeviceInfo 0x1003++clDeviceMaxWorkGroupSize :: DeviceInfo +clDeviceMaxWorkGroupSize = DeviceInfo 0x1004++clDeviceMaxWorkItemSizes :: DeviceInfo +clDeviceMaxWorkItemSizes = DeviceInfo 0x1005++clDevicePreferredVectorWidthChar :: DeviceInfo +clDevicePreferredVectorWidthChar = DeviceInfo 0x1006++clDevicePreferredVectorWidthShort :: DeviceInfo +clDevicePreferredVectorWidthShort = DeviceInfo 0x1007++clDevicePreferredVectorWidthInt :: DeviceInfo +clDevicePreferredVectorWidthInt = DeviceInfo 0x1008++clDevicePreferredVectorWidthLong :: DeviceInfo +clDevicePreferredVectorWidthLong = DeviceInfo 0x1009++clDevicePreferredVectorWidthFloat :: DeviceInfo +clDevicePreferredVectorWidthFloat = DeviceInfo 0x100A++clDevicePreferredVectorWidthDouble :: DeviceInfo +clDevicePreferredVectorWidthDouble = DeviceInfo 0x100B++clDeviceMaxClockFrequency :: DeviceInfo +clDeviceMaxClockFrequency = DeviceInfo 0x100C++clDeviceAddressBits :: DeviceInfo +clDeviceAddressBits = DeviceInfo 0x100D++clDeviceMaxReadImageArgs :: DeviceInfo +clDeviceMaxReadImageArgs = DeviceInfo 0x100E ++clDeviceMaxWriteImageArgs :: DeviceInfo +clDeviceMaxWriteImageArgs = DeviceInfo 0x100F++clDeviceMaxMemAllocSize :: DeviceInfo +clDeviceMaxMemAllocSize = DeviceInfo 0x1010++clDeviceImage2DMaxWidth :: DeviceInfo +clDeviceImage2DMaxWidth = DeviceInfo 0x1011++clDeviceImage2DMaxHeight :: DeviceInfo +clDeviceImage2DMaxHeight = DeviceInfo 0x1012++clDeviceImage3DMaxWidth :: DeviceInfo +clDeviceImage3DMaxWidth = DeviceInfo 0x1013++clDeviceImage3DMaxHeight :: DeviceInfo +clDeviceImage3DMaxHeight = DeviceInfo 0x1014++clDeviceImage3DMaxDepth :: DeviceInfo +clDeviceImage3DMaxDepth = DeviceInfo 0x1015++clDeviceImageSupport :: DeviceInfo +clDeviceImageSupport = DeviceInfo 0x1016++clDeviceMaxParameterSize :: DeviceInfo +clDeviceMaxParameterSize = DeviceInfo 0x1017++clDeviceMaxSamplers :: DeviceInfo +clDeviceMaxSamplers = DeviceInfo 0x1018++clDeviceMemBaseAddrAlign :: DeviceInfo +clDeviceMemBaseAddrAlign = DeviceInfo 0x1019++clDeviceMinDataTypeAlignSize :: DeviceInfo +clDeviceMinDataTypeAlignSize = DeviceInfo 0x101A++clDeviceSingleFPConfig :: DeviceInfo +clDeviceSingleFPConfig = DeviceInfo 0x101B++clDeviceGlobalMemCacheType :: DeviceInfo +clDeviceGlobalMemCacheType = DeviceInfo 0x101C++clDeviceGlobalMemCacheLineSize :: DeviceInfo +clDeviceGlobalMemCacheLineSize = DeviceInfo 0x101D++clDeviceGlobalMemCacheSize :: DeviceInfo +clDeviceGlobalMemCacheSize = DeviceInfo 0x101E++clDeviceGlobalMemSize :: DeviceInfo +clDeviceGlobalMemSize = DeviceInfo 0x101F++clDeviceMaxConstantBufferSize :: DeviceInfo +clDeviceMaxConstantBufferSize = DeviceInfo 0x1020++clDeviceMaxConstantArgs :: DeviceInfo +clDeviceMaxConstantArgs = DeviceInfo 0x1021++clDeviceLocalMemType :: DeviceInfo +clDeviceLocalMemType = DeviceInfo 0x1022++clDeviceLocalMemSize :: DeviceInfo +clDeviceLocalMemSize = DeviceInfo 0x1023++clDeviceErrorCorrectionSupport :: DeviceInfo +clDeviceErrorCorrectionSupport = DeviceInfo 0x1024++clDeviceProfilingTimerResolution :: DeviceInfo +clDeviceProfilingTimerResolution = DeviceInfo 0x1025++clDeviceEndianLittle :: DeviceInfo +clDeviceEndianLittle = DeviceInfo 0x1026++clDeviceAvailable :: DeviceInfo +clDeviceAvailable = DeviceInfo 0x1027++clDeviceCompilerAvailable :: DeviceInfo +clDeviceCompilerAvailable = DeviceInfo 0x1028++clDeviceExecutionCapabilities :: DeviceInfo +clDeviceExecutionCapabilities = DeviceInfo 0x1029++clDeviceQueueProperties :: DeviceInfo +clDeviceQueueProperties = DeviceInfo 0x102A++clDeviceName :: DeviceInfo +clDeviceName = DeviceInfo 0x102B++clDeviceVendor :: DeviceInfo +clDeviceVendor = DeviceInfo 0x102C++clDriverVersion :: DeviceInfo +clDriverVersion = DeviceInfo 0x102D++clDeviceProfile :: DeviceInfo +clDeviceProfile = DeviceInfo 0x102E++clDeviceVersion :: DeviceInfo +clDeviceVersion = DeviceInfo 0x102F++clDeviceExtensions :: DeviceInfo +clDeviceExtensions = DeviceInfo 0x1030++clDevicePlatform :: DeviceInfo +clDevicePlatform = DeviceInfo 0x1031++clDeviceDoubleFPConfig :: DeviceInfo+clDeviceDoubleFPConfig = DeviceInfo 0x1032++clDeviceHalfFPConfig :: DeviceInfo+clDeviceHalfFPConfig = DeviceInfo 0x1033+++clFPDenorm :: DeviceFPConfig +clFPDenorm = DeviceFPConfig (1`shiftL`0)++clFPInfNan :: DeviceFPConfig +clFPInfNan = DeviceFPConfig (1`shiftL`1)++clFPRoundToNearest :: DeviceFPConfig +clFPRoundToNearest = DeviceFPConfig (1`shiftL`2)++clFPRoundToZero :: DeviceFPConfig +clFPRoundToZero = DeviceFPConfig (1`shiftL`3)++clFPRoundToInf :: DeviceFPConfig +clFPRoundToInf = DeviceFPConfig (1`shiftL`4)++clFPFMA :: DeviceFPConfig +clFPFMA = DeviceFPConfig (1`shiftL`5)++++clEventCommandQueue  :: EventInfo +clEventCommandQueue  = EventInfo 0x11D0++clEventCommandType :: EventInfo +clEventCommandType = EventInfo 0x11D1++clEventReferenceCount :: EventInfo +clEventReferenceCount = EventInfo 0x11D2++clEventCommandExecutionStatus :: EventInfo +clEventCommandExecutionStatus = EventInfo 0x11D3+++clProfilingCommandQueued :: ProfilingInfo +clProfilingCommandQueued = ProfilingInfo 0x1280++clProfilingCommandSubmit :: ProfilingInfo +clProfilingCommandSubmit = ProfilingInfo 0x1281++clProfilingCommandStart :: ProfilingInfo +clProfilingCommandStart = ProfilingInfo 0x1282++clProfilingCommandEnd  :: ProfilingInfo +clProfilingCommandEnd  = ProfilingInfo 0x1283+++clFalse = 0 :: CLbool+clTrue = 1 :: CLbool+++clDeviceTypeDefault :: DeviceType +clDeviceTypeDefault = DeviceType (1`shiftL`0)++clDeviceTypeCPU :: DeviceType +clDeviceTypeCPU = DeviceType (1`shiftL`1)++clDeviceTypeGPU :: DeviceType +clDeviceTypeGPU = DeviceType (1`shiftL`2)++clDeviceTypeAccelerator :: DeviceType +clDeviceTypeAccelerator = DeviceType (1`shiftL`3)++clDeviceTypeAll :: DeviceType +clDeviceTypeAll = DeviceType 0xFFFFFFFF+++clContextReferenceCount :: ContextInfo +clContextReferenceCount = ContextInfo 0x1080++clContextDevices :: ContextInfo +clContextDevices = ContextInfo 0x1081++clContextProperties :: ContextInfo +clContextProperties = ContextInfo 0x1082++clContextPlatform = 0x1084++++clKernelFunctionName  :: KernelInfo +clKernelFunctionName  = KernelInfo 0x1190++clKernelNumArgs :: KernelInfo +clKernelNumArgs = KernelInfo 0x1191++clKernelReferenceCount :: KernelInfo +clKernelReferenceCount = KernelInfo 0x1192++clKernelContext :: KernelInfo +clKernelContext = KernelInfo 0x1193++clKernelProgram :: KernelInfo +clKernelProgram = KernelInfo 0x1194+++clKernelWorkGroupSize :: KernelWorkGroupInfo +clKernelWorkGroupSize = KernelWorkGroupInfo 0x11B0++clKernelCompileWorkGroupSize :: KernelWorkGroupInfo +clKernelCompileWorkGroupSize = KernelWorkGroupInfo 0x11B1++clKernelLocalMemSize :: KernelWorkGroupInfo +clKernelLocalMemSize = KernelWorkGroupInfo 0x11B2++++clMemReadWrite :: MemFlags +clMemReadWrite = MemFlags (1 `shiftL` 0)++clMemWriteOnly :: MemFlags +clMemWriteOnly = MemFlags (1 `shiftL` 1)++clMemReadOnly :: MemFlags +clMemReadOnly = MemFlags (1 `shiftL` 2)++clMemUseHostPtr :: MemFlags +clMemUseHostPtr = MemFlags (1 `shiftL` 3)++clMemAllocHostPtr :: MemFlags +clMemAllocHostPtr = MemFlags (1 `shiftL` 4)++clMemCopyHostPtr :: MemFlags +clMemCopyHostPtr = MemFlags (1 `shiftL` 5)+++clR :: ChannelOrder +clR = ChannelOrder 0x10B0++clA :: ChannelOrder +clA = ChannelOrder 0x10B1++clRG :: ChannelOrder +clRG = ChannelOrder 0x10B2++clRA :: ChannelOrder +clRA = ChannelOrder 0x10B3++clRGB :: ChannelOrder +clRGB = ChannelOrder 0x10B4++clRGBA :: ChannelOrder +clRGBA = ChannelOrder 0x10B5++clBGRA :: ChannelOrder +clBGRA = ChannelOrder 0x10B6++clARGB :: ChannelOrder +clARGB = ChannelOrder 0x10B7++clIntensity :: ChannelOrder +clIntensity = ChannelOrder 0x10B8++clLuminance :: ChannelOrder +clLuminance = ChannelOrder 0x10B9+++clSNormInt8  :: ChannelType +clSNormInt8  = ChannelType 0x10D0++clSNormInt16 :: ChannelType +clSNormInt16 = ChannelType 0x10D1++clUNormInt8 :: ChannelType +clUNormInt8 = ChannelType 0x10D2++clUNormInt16 :: ChannelType +clUNormInt16 = ChannelType 0x10D3++clUNormShort565 :: ChannelType +clUNormShort565 = ChannelType 0x10D4++clUNormShort555 :: ChannelType +clUNormShort555 = ChannelType 0x10D5++clUNormInt101010 :: ChannelType +clUNormInt101010 = ChannelType 0x10D6++clSignedInt8 :: ChannelType +clSignedInt8 = ChannelType 0x10D7++clSignedInt16 :: ChannelType +clSignedInt16 = ChannelType 0x10D8++clSignedInt32 :: ChannelType +clSignedInt32 = ChannelType 0x10D9++clUnsignedInt8 :: ChannelType +clUnsignedInt8 = ChannelType 0x10DA++clUnsignedInt16 :: ChannelType +clUnsignedInt16 = ChannelType 0x10DB++clUnsignedInt32 :: ChannelType +clUnsignedInt32 = ChannelType 0x10DC++clHalfFloat :: ChannelType +clHalfFloat = ChannelType 0x10DD++clFloat  :: ChannelType +clFloat  = ChannelType 0x10DE+++clMemObjectBuffer :: MemObjectType +clMemObjectBuffer = MemObjectType 0x10F0++clMemObjectImage2D :: MemObjectType +clMemObjectImage2D = MemObjectType 0x10F1++clMemObjectImage3D :: MemObjectType +clMemObjectImage3D = MemObjectType 0x10F2+++clMemType :: MemInfo +clMemType = MemInfo 0x1100++clMemFlags :: MemInfo +clMemFlags = MemInfo 0x1101++clMemSize :: MemInfo +clMemSize = MemInfo 0x1102++clMemHostPtr :: MemInfo +clMemHostPtr = MemInfo 0x1103++clMemMapCount :: MemInfo +clMemMapCount = MemInfo 0x1104++clMemReferenceCount :: MemInfo +clMemReferenceCount = MemInfo 0x1105++clMemContext :: MemInfo +clMemContext = MemInfo 0x1106+++clImageFormat :: MemInfo +clImageFormat = MemInfo 0x1110++clImageElementSize :: MemInfo +clImageElementSize = MemInfo 0x1111++clImageRowPitch :: MemInfo +clImageRowPitch = MemInfo 0x1112++clImageSlicePitch :: MemInfo +clImageSlicePitch = MemInfo 0x1113++clImageWidth :: MemInfo +clImageWidth = MemInfo 0x1114++clImageHeight :: MemInfo +clImageHeight = MemInfo 0x1115++clImageDepth :: MemInfo +clImageDepth = MemInfo 0x1116+++clMapRead :: MapFlags +clMapRead = MapFlags (1 `shiftL` 0)++clMapWrite :: MapFlags +clMapWrite = MapFlags (1 `shiftL` 1)+++clPlatformProfile :: PlatformInfo+clPlatformProfile = PlatformInfo 0x0900 ++clPlatformVersion :: PlatformInfo+clPlatformVersion = PlatformInfo 0x0901++clPlatformName :: PlatformInfo+clPlatformName = PlatformInfo 0x0902++clPlatformVendor :: PlatformInfo+clPlatformVendor = PlatformInfo 0x0903+++clPlatformExtensions :: PlatformInfo+clPlatformExtensions = PlatformInfo 0x0904++clProgramReferenceCount :: ProgramInfo +clProgramReferenceCount = ProgramInfo 0x1160++clProgramContext :: ProgramInfo +clProgramContext = ProgramInfo 0x1161++clProgramNumDevices :: ProgramInfo +clProgramNumDevices = ProgramInfo 0x1162++clProgramDevices :: ProgramInfo +clProgramDevices = ProgramInfo 0x1163++clProgramSource :: ProgramInfo +clProgramSource = ProgramInfo 0x1164++clProgramBinarySizes :: ProgramInfo +clProgramBinarySizes = ProgramInfo 0x1165++clProgramBinaries :: ProgramInfo +clProgramBinaries = ProgramInfo 0x1166+++clProgramBuildStatus :: ProgramBuildInfo +clProgramBuildStatus = ProgramBuildInfo 0x1181++clProgramBuildOptions :: ProgramBuildInfo +clProgramBuildOptions = ProgramBuildInfo 0x1182++clProgramBuildLog :: ProgramBuildInfo +clProgramBuildLog = ProgramBuildInfo 0x1183                    +++clBuildSuccess :: BuildStatus +clBuildSuccess = BuildStatus 0++clBuildNone :: BuildStatus +clBuildNone = BuildStatus (-1)++clBuildError :: BuildStatus +clBuildError = BuildStatus (-2)++clBuildInProgress :: BuildStatus +clBuildInProgress = BuildStatus (-3) ++++clAddressNone :: AddressingMode +clAddressNone = AddressingMode 0x1130++clAddressClampToEdge :: AddressingMode +clAddressClampToEdge = AddressingMode 0x1131++clAddressClamp :: AddressingMode +clAddressClamp = AddressingMode 0x1132++clAddressRepeat :: AddressingMode +clAddressRepeat = AddressingMode 0x1133++clFilterNearest = FilterMode 0x1140+clFilterLinear = FilterMode 0x1141+++clSamplerReferenceCount :: SamplerInfo +clSamplerReferenceCount = SamplerInfo 0x1150++clSamplerContext :: SamplerInfo +clSamplerContext = SamplerInfo 0x1151++clSamplerNormalizedCoords :: SamplerInfo +clSamplerNormalizedCoords = SamplerInfo 0x1152++clSamplerAddressingMode :: SamplerInfo +clSamplerAddressingMode = SamplerInfo 0x1153++clSamplerFilterMode :: SamplerInfo +clSamplerFilterMode = SamplerInfo 0x1154+

+ System/OpenCL/Wrappers/Utils.hs view

@@ -0,0 +1,72 @@+{-| OpenCL utility functions for improving FFI wrapper code. -}+module System.OpenCL.Wrappers.Utils where++import Foreign+import Foreign.C+import System.OpenCL.Wrappers.Errors+import System.OpenCL.Wrappers.Types+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++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) -> IO (Either ErrorCode (ForeignPtr (), CLsizei))+wrapGetInfo raw_infoFn = alloca $ \value_size_ret ->+    wrapError (raw_infoFn 0 nullPtr value_size_ret) >>=+        maybe (do retsize <- peek value_size_ret+                  param_data <- (mallocForeignPtrBytes . fromIntegral $ retsize) :: IO (ForeignPtr ())+                  wrapError (withForeignPtr param_data $ \param_dataP -> raw_infoFn retsize param_dataP nullPtr) >>=+                      maybe (return (Right (param_data,retsize))) (return.Left))+                  (return.Left)++wrapGetNumElements :: Storable a => (CLuint -> Ptr a -> Ptr CLuint -> IO CLint) -> IO (Either ErrorCode [a])+wrapGetNumElements raw_Fn = alloca (\value_size_ret ->+    wrapError (raw_Fn 0 nullPtr value_size_ret) >>=+        maybe (do+            retsize <- peek value_size_ret+            allocaArray (fromIntegral retsize)+                (\param_dataP -> wrapError (raw_Fn retsize param_dataP nullPtr) >>=+                    maybe (fmap Right $ peekArray (fromIntegral retsize) param_dataP) (return.Left)))+            (return.Left))++withArrayNull0 a as = withArrayNull $ as ++ [a]++withArrayNull :: Storable a => [a] -> (Ptr a -> IO b) -> IO b+withArrayNull as f = if null as+                           then f nullPtr+                           else withArray as f++nest :: [(r -> a) -> a] -> ([r] -> a) -> a+nest xs = runCont (sequence (map cont xs))++withCStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a+withCStringArray0 strings act = nest (map withCString strings)+                                     (\rs -> withArray0 nullPtr rs act)++peekOneInfo :: Storable a => (a -> b) -> ForeignPtr () -> IO b+peekOneInfo f x = withForeignPtr x (\y -> fmap f (peek $ castPtr y))++peekManyInfo :: Storable a => ([a] -> b) -> ForeignPtr () -> CLsizei -> IO b+peekManyInfo f x size = do+    c <- return undefined+    a <- withForeignPtr x (\y -> (peekArray ( div (fromIntegral size) $ sizeOf c) $ castPtr y))+    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