<div class="gmail_extra">On Fri, Dec 7, 2012 at 12:32 AM, Peter Enerccio <span dir="ltr"><<a href="mailto:enerccio@gmail.com" target="_blank">enerccio@gmail.com</a>></span> wrote:<br><div class="gmail_quote"><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">
<div id=":1lp">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.<br>
</div></blockquote></div><br>This is a nice exercise for the MOP, but I will try to keep it simpler:</div><div class="gmail_extra"><br></div><div class="gmail_extra">* C++ classes are instances of a CLOS class that keeps the list of slot names and accessor names (C++ ones).</div>
<div class="gmail_extra"><br></div><div class="gmail_extra">* C++ objects are mapped into a CLOS class (one that stores the C++ class and a single pointer (via FFI) to the class.</div><div class="gmail_extra"><br></div><div class="gmail_extra">
* 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 ]) ..))</div><div class="gmail_extra"><br>
</div><div class="gmail_extra">* The previous form expands through macros into these other forms:</div><div class="gmail_extra">- A defclass form for this object</div><div class="gmail_extra">- A constructor</div><div class="gmail_extra">
- A set of lisp functions with c-inline forms to access the slot values</div><div class="gmail_extra"><br></div><div class="gmail_extra">A sketch follows. It is not working, but gives you an idea</div><div class="gmail_extra">
<br></div><div class="gmail_extra"><div class="gmail_extra">(defpackage :c++</div><div class="gmail_extra"> (:use :cl :clos))</div><div class="gmail_extra"><br></div><div class="gmail_extra">(defclass c++-object ()</div>
<div class="gmail_extra"> ((pointer :initarg :pointer :reader c++-object-pointer)</div><div class="gmail_extra"> (definition :reader c++-object-definition)))</div><div class="gmail_extra"><br></div><div class="gmail_extra">
(defun parse-slot-definition (list)</div><div class="gmail_extra"> (let ((name (pop list))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>lisp-name</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>c++-name</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span>c-type</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>readers</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>writers)</div>
<div class="gmail_extra"> (if (atom name)</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>(setf lisp-name name</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> c++-name (string-downcase name))</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span>(setf lisp-name (first name)</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> c++-name (second name)))</div><div class="gmail_extra">
(loop for option = (pop list)</div><div class="gmail_extra"> for value = (pop list)</div><div class="gmail_extra"> while option</div><div class="gmail_extra"> do (case option</div><div class="gmail_extra">
<span class="" style="white-space:pre"> </span> (:c-type (setf c-type value))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> (:reader (push value readers))</div><div class="gmail_extra">
<span class="" style="white-space:pre"> </span> (:writer (push `(setf ,value) writers))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> (:accessor (push value readers)</div><div class="gmail_extra">
<span class="" style="white-space:pre"> </span> (push `(setf ,value) writers))))</div><div class="gmail_extra"> (unless c-type</div><div class="gmail_extra"> (error "In DEFC++CLASS definition, no value was supplied for the slot type."))</div>
<div class="gmail_extra"> (list lisp-name c++-name c++-type readers writers)))</div><div class="gmail_extra"><br></div><div class="gmail_extra">(defun c++-type-to-ffi-tag (c++-type)</div><div class="gmail_extra"> (or (second (assoc c++-type</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span> '((:float "ECL_FFI_DOUBLE"</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>:int "ECL_FFI_INT"))))</div>
<div class="gmail_extra"> (error "Unknown C++ type in DEFC++CLASS")))</div><div class="gmail_extra"><br></div><div class="gmail_extra">(defun build-readers (class-name lisp-name c++-name readers writers)</div>
<div class="gmail_extra"> (let* ((slot-value (format nil "((~A *)(#0))->~A" class-c++-name c++-name))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> (slot-pointer (format nil "&(~A)" slot-value))</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span> (tag (c++-type-to-ffi-tag c++-type)))</div><div class="gmail_extra"> (loop for reader in readers</div><div class="gmail_extra"> for c-form = (format nil "ecl_foregin_data_ref(~A, ~A)"</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span> slot-pointer value-c-tag)</div><div class="gmail_extra"> collect `(defmethod ,reader ((o ,class-name))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> (ffi:c-inline ((c++-object-pointer o))</div>
<div class="gmail_extra"><span class="" style="white-space:pre"> </span>(:pointer-void) :object</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span>,c-form :one-liner t)))))</div><div class="gmail_extra">
<br></div><div class="gmail_extra"><br></div><div class="gmail_extra">(defmacro defc++class ((lisp-class-name c++-class-name) parents slot-definitions)</div><div class="gmail_extra"> (let ((parse-definitions (mapcar #'parse-slot-definition slot-definitions)))</div>
<div class="gmail_extra"> `(progn</div><div class="gmail_extra"> (defclass ,lisp-class-name ,(append parents '(c++-object))</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> (definition :initform ',slot-definitions))</div>
<div class="gmail_extra"> ,@(loop for d in parsed-definitions</div><div class="gmail_extra"><span class="" style="white-space:pre"> </span> nconc (apply #'build-readers lisp-name c++-class-name d)))))</div><div class="gmail_extra">
<br></div><div class="gmail_extra">#|</div><div class="gmail_extra">Assuming</div><div class="gmail_extra"><br></div><div class="gmail_extra">struct foo {</div><div class="gmail_extra"> int a;</div><div class="gmail_extra">
};</div><div class="gmail_extra"><br></div><div class="gmail_extra">|#</div><div class="gmail_extra"><br></div><div class="gmail_extra">(defc++class (foo "foo") ()</div><div class="gmail_extra"> ((a :c-type :int :reader foo-a)))</div>
</div><div class="gmail_extra"><br clear="all"><div><br></div>-- <br>Instituto de Física Fundamental, CSIC<br>c/ Serrano, 113b, Madrid 28006 (Spain) <br><a href="http://juanjose.garciaripoll.googlepages.com" target="_blank">http://juanjose.garciaripoll.googlepages.com</a><br>
</div>