[cffi-devel] swig - cffi module

[Vasilis M]

On  Sunday, December 18, 2005 6:04 AM Luís Oliveira wrote:
> What is it that you want to do with arrays that CFFI doesn't support?
I want a handy way to access multidimensional c arrays.
After some hacking i find it, here is the code:

(defun indexes-to-row-major-index (dimensions &rest subscripts)
  (apply #'+ (maplist #'(lambda (x y)
     (* (car x) (apply #'* (cdr y))))
        subscripts
        dimensions)))

(defun row-major-index-to-indexes (index dimensions)
  (loop with idx = index
 with rank = (length dimensions)
 with indexes = (make-list rank)
 for dim-index from (- rank 1) downto 0 do
 (setf (values idx (nth dim-index indexes)) (floor idx (nth dim-index
dimensions)))
 finally (return indexes)))

(defun lisp-array-to-foreign (array ptr cffi-type dimensions)
  "Copy elements from a Lisp array to ptr."
  (loop with foreign-type-size = (foreign-type-size cffi-type)
 with size = (reduce #'* dimensions)
 for i from 0 below size
 for offset = (* i foreign-type-size)
 for element = (apply #'aref array (row-major-index-to-indexes i
dimensions))
        do (setf (%mem-ref ptr cffi-type offset) element)))

(defun foreign-array-to-lisp (ptr cffi-type dimensions)
  "Copy elements from ptr into a Lisp array.
If ptr is a null pointer, returns nil."
  (unless (null-pointer-p ptr)
    (let ((array (make-array dimensions)))
      (loop with foreign-type-size = (foreign-type-size cffi-type)
     with size = (reduce #'* dimensions)
     for i from 0 below size
     for offset = (* i foreign-type-size)
            for element = (mem-ref ptr cffi-type offset)
            do (setf (apply #'aref array (row-major-index-to-indexes i
dimensions)) element))
      array)))

(defun foreign-array-alloc (array cffi-type dimensions)
  "Allocate a foreign array containing the elements of lisp array.
The foreign array must be freed with foreign-array-free."
  (check-type array array)
  (let ((ptr (foreign-alloc cffi-type :count (reduce #'* dimensions))))
    (lisp-array-to-foreign array ptr cffi-type dimensions)
    ptr))

(defun foreign-array-free (ptr)
  "Free a foreign array allocated by foreign-array-alloc."
  (foreign-free ptr))

(defmacro with-foreign-array ((var lisp-array cffi-type dimensions) &body
body)
  "Bind var to a foreign array containing lisp-array elements in body."
  `(with-foreign-pointer (,var (* (reduce #'* ,dimensions)
    (foreign-type-size ,cffi-type)))
    (lisp-array-to-foreign ,lisp-array ,var ,cffi-type ,dimensions)
    , at body))

(defun foreign-aref (ptr cffi-type dimensions &rest indexes)
  (let ((offset (* (foreign-type-size cffi-type)
     (apply #'indexes-to-row-major-index dimensions indexes))))
    (mem-ref ptr cffi-type offset)))

(defun (setf foreign-aref) (value ptr cffi-type dimensions &rest indexes)
  (let ((offset (* (foreign-type-size cffi-type)
     (apply #'indexes-to-row-major-index dimensions indexes))))
    (setf (%mem-ref ptr cffi-type offset) value)))