Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Fix ContextProperties to proper type.
Conflicts:

	System/OpenCL/Wrappers/Context.hs
	System/OpenCL/Wrappers/Types.hs
  • Loading branch information
Emil Karlson committed Dec 29, 2011
1 parent a88a987 commit 54ea6dc
Show file tree
Hide file tree
Showing 3 changed files with 10 additions and 10 deletions.
10 changes: 5 additions & 5 deletions System/OpenCL/Wrappers/Context.hs
Expand Up @@ -10,19 +10,19 @@ where
import System.OpenCL.Wrappers.Types
import System.OpenCL.Wrappers.Utils
import System.OpenCL.Wrappers.Raw
import Foreign.Ptr(Ptr, nullPtr, nullFunPtr)
import Foreign.Ptr(Ptr, nullPtr, nullFunPtr,ptrToIntPtr)
import Foreign.Marshal.Array(withArray)


clCreateContext :: [ContextProperties] -> [DeviceID] -> Maybe ContextCallback -> Ptr () -> IO Context
clCreateContext properties devices pfn_notify user_dat =
withArrayNull0 nullPtr properties $ \propertiesP -> withArray devices $ \devicesP -> do
clCreateContext props devices pfn_notify user_dat =
withArrayNull0 (ContextProperties$ptrToIntPtr nullPtr) props $ \propertiesP -> withArray devices $ \devicesP -> do
fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify
wrapErrorResult $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
wrapErrorResult $ raw_clCreateContext propertiesP (fromIntegral devicesN) devicesP fptr user_dat
where devicesN = length devices

clCreateContextFromType :: [ContextProperties] -> DeviceType -> Maybe ContextCallback -> Ptr () -> IO Context
clCreateContextFromType properties (DeviceType device_type) pfn_notify user_data = withArrayNull0 nullPtr properties $ \propertiesP -> do
clCreateContextFromType props (DeviceType device_type) pfn_notify user_data = withArrayNull0(ContextProperties$ptrToIntPtr nullPtr) props $ \propertiesP -> do
fptr <- maybe (return nullFunPtr) wrapContextCallback pfn_notify
wrapErrorResult $ raw_clCreateContextFromType propertiesP device_type fptr user_data

Expand Down
2 changes: 1 addition & 1 deletion System/OpenCL/Wrappers/Raw.hs
Expand Up @@ -88,7 +88,7 @@ foreign import ccall "clRetainCommandQueue" raw_clRetainCommandQueue :: CommandQ
foreign import ccall "clReleaseCommandQueue" raw_clReleaseCommandQueue :: CommandQueue -> IO CLint
foreign import ccall "clGetCommandQueueInfo" raw_clGetCommandQueueInfo :: CommandQueue -> CLuint -> CLsizei -> Ptr () -> Ptr CLsizei -> IO CLint
foreign import ccall "clSetCommandQueueProperty" raw_clSetCommandQueueProperty :: CommandQueue -> CLbitfield -> CLbool -> Ptr CLbitfield -> IO CLint
foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr (Ptr CLint) -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context
foreign import ccall "clCreateContext" raw_clCreateContext :: Ptr ContextProperties -> CLuint -> Ptr DeviceID -> FunPtr ContextCallback -> Ptr () -> Ptr CLint -> IO Context
foreign import ccall "clCreateContextFromType" raw_clCreateContextFromType :: Ptr ContextProperties -> CLbitfield -> FunPtr ContextCallback -> Ptr a -> Ptr CLint -> IO Context
foreign import ccall "clRetainContext" raw_clRetainContext :: Context -> IO CLint
foreign import ccall "clReleaseContext" raw_clReleaseContext :: Context -> IO CLint
Expand Down
8 changes: 4 additions & 4 deletions System/OpenCL/Wrappers/Types.hs
Expand Up @@ -20,7 +20,6 @@ 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
Expand All @@ -42,6 +41,8 @@ type ImageFormatp = Ptr ImageFormat
type ImageFormat = (ChannelOrder,ChannelType)
type ImageDims = (CLsizei,CLsizei,CLsizei)

newtype ContextProperties = ContextProperties IntPtr
deriving (Eq,Storable,Show)
newtype ChannelOrder = ChannelOrder CLuint
deriving (Eq,Show)
newtype ChannelType = ChannelType CLuint
Expand Down Expand Up @@ -603,9 +604,8 @@ clContextDevices = ContextInfo 0x1081
clContextProperties :: ContextInfo
clContextProperties = ContextInfo 0x1082

clContextPlatform :: ContextInfo
clContextPlatform = ContextInfo 0x1084

clContextPlatform :: ContextProperties
clContextPlatform = ContextProperties 0x1084


clKernelFunctionName :: KernelInfo
Expand Down

0 comments on commit 54ea6dc

Please sign in to comment.