OpenCLRaw 1.0.1000 → 1.0.1001

raw patch · 3 files changed

+46/−10 lines, 3 files

Files

• OpenCLRaw.cabal +2/−2
• System/OpenCL/Raw/V10/Types.hs +6/−8
• System/OpenCL/Raw/V10/Utils.hs +38/−0

@@ -1,5 +1,5 @@ name: OpenCLRaw-version: 1.0.1000+version: 1.0.1001 cabal-version: >=1.2 build-type: Simple license: BSD3@@ -62,7 +62,7 @@ install-includes: include-dirs: hs-source-dirs: .-other-modules:+other-modules: System.OpenCL.Raw.V10.Utils ghc-prof-options: ghc-shared-options: ghc-options:

@@ -13,12 +13,7 @@ data Kernelc = Kernelc data Eventc = Eventc data Samplerc = Samplerc--newtype ChannelOrder = ChannelOrder CLuint-newtype ChannelType = ChannelType CLuint-newtype DeviceType = DeviceType CLbitfield--newtype ContextInfo = ContextInfo CLuint+data ImageFormatc = ImageFormatc  type ContextProperties = Ptr CLint type PlatformID = Ptr PlatformIDc@@ -37,11 +32,14 @@ type CLbool = CLuint type CLulong = CULong type CLbitfield = CLulong--data ImageFormatc = ImageFormatc type ImageFormatp = Ptr ImageFormat+ type ImageFormat = (ChannelOrder,ChannelType) +newtype ChannelOrder = ChannelOrder CLuint+newtype ChannelType = ChannelType CLuint+newtype DeviceType = DeviceType CLbitfield+newtype ContextInfo = ContextInfo CLuint newtype CommandQueueProperties = CommandQueueProperties CLbitfield newtype CommandQueueInfo = CommandQueueInfo CLuint newtype ErrorCode = ErrorCode CLint deriving (Eq,Ord,Show,Read)

@@ -0,0 +1,38 @@+{-| OpenCL utility functions for improving FFI wrapper code. -}+module System.OpenCL.Raw.V10.Utils where++import Foreign+import Foreign.C+import System.OpenCL.Raw.V10.Errors+import System.OpenCL.Raw.V10.Types+import Control.Applicative+import Data.Maybe+import Control.Monad.Cont++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) -> CLsizei -> IO (Either ErrorCode (ForeignPtr (), CLsizei))+wrapGetInfo raw_infoFn param_size = alloca $ \value_size_ret -> do+    param_data <- (mallocForeignPtrBytes . fromIntegral $ param_size) :: IO (ForeignPtr ())+    ret <- wrapError $ withForeignPtr param_data $ \param_dataP -> raw_infoFn param_size param_dataP value_size_ret+    if ret == Just clSuccess+        then peek value_size_ret >>= \valsz -> return . Right $ (param_data,valsz)+        else return . Left $ fromJust ret        ++++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)