(in-package #:ocl)

(defun create-context (devices &key platform iterop-user-sync-p)
  (let ((properties '(0)))
    (when iterop-user-sync-p
      (push 1 properties)
      (push :context-interop-user-sync properties))
    (when platform
      (push (cffi:pointer-address platform) properties)
      (push :context-platform properties))
    (with-foreign-sequences ((c-properties properties 'cl-context-properties)
                             (c-devices devices 'cl-device-id num-devices))
      (check-error-arg
       (%create-context c-properties num-devices c-devices (cffi:null-pointer)
                        (cffi:null-pointer))))))

(defun create-context-from-type (device-type &key platform iterop-user-sync-p
                                               (pfn-notify (cffi:null-pointer))
                                               (user-data (cffi:null-pointer)))
  (let ((properties '(0)))
    (when iterop-user-sync-p
      (push 1 properties)
      (push :context-interop-user-sync properties))
    (when platform
      (push (cffi:pointer-address platform) properties)
      (push :context-platform properties))
    (with-foreign-sequences ((c-properties properties 'cl-context-properties))
      (check-error-arg
       (%create-context-from-type c-properties device-type pfn-notify user-data)))))

(defun retain-context (context)
  (check-error (%retain-context context)))

(defun release-context (context)
  (check-error (%release-context context)))

(defparameter +context-info-type-alist+
  '((:context-reference-count . cl-uint)
    (:context-num-devices     . cl-uint)
    (:context-devices         . (:pointer cl-device-id))
    (:context-properties      . (:pointer cl-context-properties))))

(wrap-get-info-function get-context-info %get-context-info +context-info-type-alist+)

(defmacro with-context ((context devices &rest options) &body body)
  `(let ((,context (create-context ,devices ,@options)))
     (unwind-protect
          (progn ,@body)
       (release-context ,context))))