(in-package #:ocl)

(defun create-program-with-source (context list-of-strings)
  (setf list-of-strings (alexandria:ensure-list list-of-strings))
  (let ((num-strings (length list-of-strings)))
    (cffi:with-foreign-object (c-strings :pointer num-strings)
      (dotimes (i num-strings)
        (setf (cffi:mem-aref c-strings :pointer i)
              (cffi:foreign-string-alloc (elt list-of-strings i))))
      (unwind-protect
           (check-error-arg (%create-program-with-source context num-strings c-strings (cffi:null-pointer)))
        (dotimes (i num-strings)
          (cffi:foreign-string-free (cffi:mem-aref c-strings :pointer i)))))))

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

(defun release-program (program)
  (%release-program program))

(defun build-program (program device-list &key (options (cffi:null-pointer))
                                            (pfn-notify (cffi:null-pointer))
                                            (user-data (cffi:null-pointer)))
  (setf device-list (alexandria:ensure-list device-list))
  (with-foreign-sequence (c-devices device-list 'cl-device-id num-devices)
    (check-error (%build-program program num-devices c-devices options
                                 pfn-notify user-data))))

;; (defun compile-program (program device-list
;;                         &key (options (cffi:null-pointer))
;;                           input-headers
;;                           header-include-names
;;                           (pfn-notify (cffi:null-pointer))
;;                           (user-data (cffi:null-pointer)))
;;   (with-foreign-sequence ((c-device-list device-list 'cl-device-id num-devices)
;;                           (c-input-headers input-headers 'cl-program num-input-headers))
;;     (check-error (%compile-program program num-devices c-device-list options
;;                                    num-input-headers c-input-headers
;;                                    pfn-notify user-data))))

(defun link-program (context device-list input-programs &key (options (cffi:null-pointer))
                                                          (pfn-notify (cffi:null-pointer))
                                                          (user-data (cffi:null-pointer)))
  (assert (not (emptyp input-programs)))
  (with-foreign-sequences ((c-device-list device-list 'cl-device-id num-devices)
                           (c-input-programs input-programs 'cl-program num-input-programs))
    (check-error-arg (%link-program context num-devices c-device-list options
                                    num-input-programs c-input-programs
                                    pfn-notify user-data))))

(defun unload-platform-compiler (platform)
  (check-error (%unload-platform-compiler platform)))

(defparameter +program-info-type-alist+
  '((:program-reference-count            . cl-uint)
    (:program-context                    . cl-context)
    (:program-num-devices                . cl-uint)
    (:program-devices                    . (:pointer cl-device-id))
    (:program-source                     . :string)
    (:program-il                         . (:pointer :char))
    (:program-binary-sizes               . (:pointer :size))
    (:program-binaries                   . (:pointer (:pointer :char)))
    (:program-num-kernels                . :size)
    (:program-kernel-names               . (:pointer :char))
    (:program-scope-global-ctors-present . cl-bool)
    (:program-scope-global-dtors-present . cl-bool)))

;; %get-program-info

(defparameter +program-build-info-type-alist+
  '((:program-build-status                     . cl-build-status)
    (:program-build-options                    . :string)
    (:program-build-log                        . :string)
    (:program-binary-type                      . cl-program-binary-type)
    (:program-build-global-variable-total-size . :size)))

;; %get-program-build-info

(defmacro with-program-from-source ((program context list-of-strings) &body body)
  `(let ((,program (create-program-with-source ,context ,list-of-strings)))
     (unwind-protect
          (progn ,@body)
       (release-program ,program))))