[Ecls-list] Easy way to bind c++ class instances in lisp?

[Juan Jose Garcia-Ripoll]

On Fri, Dec 7, 2012 at 12:32 AM, Peter Enerccio <enerccio at gmail.com> wrote:

> I am looking for easy way of wrapping around class instances of c++. I can
> wrap it in lisp with classes with slot containing fixnum of the pointer and
> then recast it in c++ but its cumberstone and has lot of boiler plate on
> both lisp and c++ side. Any other way of doing that? Could be even in lisp
> altogether, because then I could generate c code out of it or something.
>

This is a nice exercise for the MOP, but I will try to keep it simpler:

* C++ classes are instances of a CLOS class that keeps the list of slot
names and accessor names (C++ ones).

* C++ objects are mapped into a CLOS class (one that stores the C++ class
and a single pointer (via FFI) to the class.

* struct/class statements are manually translated to a lisp form of the
type (DEFCLASS (LISP-NAME C++-NAME) ((SLOT-NAME [ :READER READER ] [
:WRITER WRITER ] [ :ACCESSOR ACCESSOR ]) ..))

* The previous form expands through macros into these other forms:
- A defclass form for this object
- A constructor
- A set of lisp functions with c-inline forms to access the slot values

A sketch follows. It is not working, but gives you an idea

(defpackage :c++
  (:use :cl :clos))

(defclass c++-object ()
  ((pointer :initarg :pointer :reader c++-object-pointer)
   (definition :reader c++-object-definition)))

(defun parse-slot-definition (list)
  (let ((name (pop list))
lisp-name
c++-name
 c-type
readers
writers)
    (if (atom name)
(setf lisp-name name
      c++-name (string-downcase name))
 (setf lisp-name (first name)
      c++-name (second name)))
    (loop for option = (pop list)
       for value = (pop list)
       while option
       do (case option
    (:c-type (setf c-type value))
    (:reader (push value readers))
    (:writer (push `(setf ,value) writers))
    (:accessor (push value readers)
       (push `(setf ,value) writers))))
    (unless c-type
      (error "In DEFC++CLASS definition, no value was supplied for the slot
type."))
    (list lisp-name c++-name c++-type readers writers)))

(defun c++-type-to-ffi-tag (c++-type)
  (or (second (assoc c++-type
     '((:float "ECL_FFI_DOUBLE"
:int "ECL_FFI_INT"))))
      (error "Unknown C++ type in DEFC++CLASS")))

(defun build-readers (class-name lisp-name c++-name readers writers)
  (let* ((slot-value (format nil "((~A *)(#0))->~A" class-c++-name
c++-name))
 (slot-pointer (format nil "&(~A)" slot-value))
 (tag (c++-type-to-ffi-tag c++-type)))
    (loop for reader in readers
       for c-form = (format nil "ecl_foregin_data_ref(~A, ~A)"
    slot-pointer value-c-tag)
       collect `(defmethod ,reader ((o ,class-name))
  (ffi:c-inline ((c++-object-pointer o))
 (:pointer-void) :object
,c-form :one-liner t)))))


(defmacro defc++class ((lisp-class-name c++-class-name) parents
slot-definitions)
  (let ((parse-definitions (mapcar #'parse-slot-definition
slot-definitions)))
    `(progn
       (defclass ,lisp-class-name ,(append parents '(c++-object))
 (definition :initform ',slot-definitions))
       ,@(loop for d in parsed-definitions
    nconc (apply #'build-readers lisp-name c++-class-name d)))))

#|
Assuming

struct foo {
  int a;
};

|#

(defc++class (foo "foo") ()
  ((a :c-type :int :reader foo-a)))


-- 
Instituto de Física Fundamental, CSIC
c/ Serrano, 113b, Madrid 28006 (Spain)
http://juanjose.garciaripoll.googlepages.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/ecl-devel/attachments/20121207/e47ea887/attachment.html>