Minor change to define-callback

diff --git a/gffi/interface.lisp b/gffi/interface.lisp
index bcb0caec974b24a7f41f6705aee318a4b4c3bfad..0df9387e8d6025c0c231a0bcd4d91a0378abb792 100644 (file)
--- a/gffi/interface.lisp
+++ b/gffi/interface.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 

-;; $Id: interface.lisp,v 1.6 2007-09-07 07:28:42 espen Exp $
+;; $Id: interface.lisp,v 1.7 2007-10-17 17:04:15 espen Exp $

 
 (in-package "GFFI")
 
 
 (in-package "GFFI")
 


@@ -306,7 +306,10 @@ (defmacro define-callback (name return-type args &body body)
   (let ((define-callback 
          #+cmu'alien:def-callback                    
          #+(and sbcl alien-callbacks)'sb-alien::define-alien-callback
   (let ((define-callback 
          #+cmu'alien:def-callback                    
          #+(and sbcl alien-callbacks)'sb-alien::define-alien-callback

-         #+(and sbcl (not alien-callbacks))'sb-alien:define-alien-function))
+         #+(and sbcl (not alien-callbacks))'sb-alien:define-alien-function)
+       (args (mapcar #'(lambda (arg)
+                         (if (atom arg) (list arg arg) arg))
+                     args)))

     `(progn
        #+cmu(defparameter ,name nil)
        (,define-callback ,name 
     `(progn
        #+cmu(defparameter ,name nil)
        (,define-callback ,name 


@@ -383,8 +386,11 @@   (defun restore-callback-pointers ()
   ;;; translated according to RETTYPE.  Obtain a pointer that can be
   ;;; passed to C code for this callback by calling %CALLBACK.
   (defmacro define-callback (name return-type args &body body)
   ;;; translated according to RETTYPE.  Obtain a pointer that can be
   ;;; passed to C code for this callback by calling %CALLBACK.
   (defmacro define-callback (name return-type args &body body)

-    (let ((arg-names (mapcar #'first args))
-         (arg-types (mapcar #'second args)))
+    (let* ((args (mapcar #'(lambda (arg)
+                            (if (atom arg) (list arg arg) arg))
+                        args))
+          (arg-names (mapcar #'first args))
+          (arg-types  (mapcar #'second args)))

       `(progn
         (defvar ,name ',name)
         (register-callback ',name 
       `(progn
         (defvar ,name ',name)
         (register-callback ',name