[Swig-cvs] SWIG/Lib/allegrocl allegrocl.swg,1.12,1.13 inout_typemaps.i,1.3,1.4

[Mikel B. <mut...@us...>]

Update of /cvsroot/swig/SWIG/Lib/allegrocl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11396/Lib/allegrocl

Modified Files:
	allegrocl.swg inout_typemaps.i 
Log Message:

03/20/2005: mutandiz
	    [allegrocl]
	    More tweaks to INPUT/OUTPUT typemaps for bool.

	    Fix constantWrapper for char and string literals.

	    find-definition keybindings should work in ELI/SLIME.
	    Output (in-package <module-name>) to lisp wrapper
	    instead of (in-package #.*swig-module-name*).

	    slight rework of multiple return values.

	    doc updates.



Index: inout_typemaps.i
===================================================================
RCS file: /cvsroot/swig/SWIG/Lib/allegrocl/inout_typemaps.i,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** inout_typemaps.i	12 Mar 2006 20:38:57 -0000	1.3
--- inout_typemaps.i	21 Mar 2006 07:15:38 -0000	1.4
***************
*** 1,72 ****
! /* inout_typemaps.i
! 
!    Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
!    as multiple values.
! 
! */
! 
! 
! %define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
! // OUTPUT map.
! %typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
! %{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
!      $body
!      OUTresult_
!      (ff:free-fobject $out)) %}
! 
! // INPUT map.
! %typemap(in) type_ *INPUT, type_ &INPUT
! %{ $1 = &$input; %}
! 
! %typemap(ctype) type_ *INPUT, type_ &INPUT "$*1_ltype";
! 
! 
! // INOUT map.
! %typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
! %{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
!      INbind_
!      $body
!      OUTresult_
!      (ff:free-fobject $out)) %}
! 
! %enddef
! 
! // $in, $out, $lclass,
! // $in_fftype, $*in_fftype
! 
! INOUT_TYPEMAP(int,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(short,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(long,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned int,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned short,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned long,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(char,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(float,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(double,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(bool,
! 	      (push (not (zerop (ff:fslot-value-typed (quote $*in_fftype) :c $out)))
! 		    ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) (if $in 1 0)));
! 
! // long long support not yet complete
! // INOUT_TYPEMAP(long long);
! // INOUT_TYPEMAP(unsigned long long);
! 
--- 1,74 ----
! /* inout_typemaps.i
! 
!    Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
!    as multiple values.
! 
! */
! 
! 
! %define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
! // OUTPUT map.
! %typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
! %{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
!      $body
!      OUTresult_
!      (ff:free-fobject $out)) %}
! 
! // INPUT map.
! %typemap(in) type_ *INPUT, type_ &INPUT
! %{ $1 = &$input; %}
! 
! %typemap(ctype) type_ *INPUT, type_ &INPUT "$*1_ltype";
! 
! 
! // INOUT map.
! %typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
! %{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
!      INbind_
!      $body
!      OUTresult_
!      (ff:free-fobject $out)) %}
! 
! %enddef
! 
! // $in, $out, $lclass,
! // $in_fftype, $*in_fftype
! 
! INOUT_TYPEMAP(int,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(short,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(long,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned int,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned short,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(unsigned long,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(char,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(float,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(double,
! 	      (push (ff:fslot-value-typed (quote $*in_fftype) :c $out) ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
! INOUT_TYPEMAP(bool,
! 	      (push (not (zerop (ff:fslot-value-typed (quote $*in_fftype) :c $out)))
! 		    ACL_result),
! 	      (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) (if $in 1 0)));
! 
! %typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
! 
! // long long support not yet complete
! // INOUT_TYPEMAP(long long);
! // INOUT_TYPEMAP(unsigned long long);
! 

Index: allegrocl.swg
===================================================================
RCS file: /cvsroot/swig/SWIG/Lib/allegrocl/allegrocl.swg,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** allegrocl.swg	18 Mar 2006 01:18:36 -0000	1.12
--- allegrocl.swg	21 Mar 2006 07:15:38 -0000	1.13
***************
*** 252,255 ****
--- 252,274 ----
     (defparameter *swig-export-list* nil))
  
+ (defconstant *void* :..void..)
+ 
+ ;; parsers to aid in finding SWIG definitions in files.
+ (defun scm-p1 (form)
+   (let* ((info (second form))
+ 	 (id (car info))
+ 	 (id-args (cddr info)))
+     (apply swig:*swig-identifier-converter* id id-args)))
+ 
+ (defmacro defswig1 (name (&rest args) &body body)
+   `(progn (defmacro ,name ,args
+ 	    ,@body)
+ 	  (excl::define-simple-parser ,name scm-p1)) )
+ 
+ (defmacro defswig2 (name (&rest args) &body body)
+   `(progn (defmacro ,name ,args
+ 	    ,@body)
+ 	  (excl::define-simple-parser ,name second)))
+ 
  (defun read-symbol-from-string (string)
    (multiple-value-bind (result position)
***************
*** 321,325 ****
      (id-convert-and-export ,name :type ,type :class ,class)))
  
! (defmacro swig-defconstant (string value)
    (let ((symbol (id-convert-and-export string :type :constant)))
      `(eval-when (compile load eval)
--- 340,344 ----
      (id-convert-and-export ,name :type ,type :class ,class)))
  
! (defswig2 swig-defconstant (string value)
    (let ((symbol (id-convert-and-export string :type :constant)))
      `(eval-when (compile load eval)
***************
*** 343,347 ****
    (member :SWIG__varargs_ arglist))
  
! (defmacro swig-defun ((name &optional (mangled-name name)
                              &key (type :operator) class arity)
                        arglist kwargs
--- 362,366 ----
    (member :SWIG__varargs_ arglist))
  
! (defswig1 swig-defun ((name &optional (mangled-name name)
                              &key (type :operator) class arity)
                        arglist kwargs
***************
*** 377,381 ****
             ,@(maybe-return-value symbol defun-args))))))
  
! (defmacro swig-defmethod ((name &optional (mangled-name name)
                             &key (type :operator) class arity)
                            ffargs kwargs
--- 396,400 ----
             ,@(maybe-return-value symbol defun-args))))))
  
! (defswig1 swig-defmethod ((name &optional (mangled-name name)
                             &key (type :operator) class arity)
                            ffargs kwargs
***************
*** 403,407 ****
             ,@(maybe-return-value symbol defmethod-args))))))
  
! (defmacro swig-dispatcher ((name &key (type :operator) class arities))
    (let ((symbol (id-convert-and-export name
                           :type type :class class)))
--- 422,426 ----
             ,@(maybe-return-value symbol defmethod-args))))))
  
! (defswig1 swig-dispatcher ((name &key (type :operator) class arities))
    (let ((symbol (id-convert-and-export name
                           :type type :class class)))
***************
*** 416,420 ****
  	   )))))
  
! (defmacro swig-def-foreign-stub (name)
    (let ((lsymbol (id-convert-and-export name :type :class))
  	(symbol (id-convert-and-export name :type :type)))
--- 435,439 ----
  	   )))))
  
! (defswig2 swig-def-foreign-stub (name)
    (let ((lsymbol (id-convert-and-export name :type :class))
  	(symbol (id-convert-and-export name :type :type)))
***************
*** 423,427 ****
  	(defclass ,lsymbol (ff:foreign-pointer) ()))))
  
! (defmacro swig-def-foreign-class (name supers &rest rest)
    (let ((lsymbol (id-convert-and-export name :type :class))
  	(symbol (id-convert-and-export name :type :type)))
--- 442,446 ----
  	(defclass ,lsymbol (ff:foreign-pointer) ()))))
  
! (defswig2 swig-def-foreign-class (name supers &rest rest)
    (let ((lsymbol (id-convert-and-export name :type :class))
  	(symbol (id-convert-and-export name :type :type)))
***************
*** 432,441 ****
  			:accessor foreign-pointer-type))))))
  
! (defmacro swig-def-foreign-type (name &rest rest)
    (let ((symbol (id-convert-and-export name :type :type)))
      `(eval-when (compile load eval)
         (ff:def-foreign-type ,symbol ,@rest))))
  
! (defmacro swig-def-synonym-type (synonym of ff-synonym)
    `(eval-when (compile load eval)
       (setf (find-class ',synonym) (find-class ',of))
--- 451,460 ----
  			:accessor foreign-pointer-type))))))
  
! (defswig2 swig-def-foreign-type (name &rest rest)
    (let ((symbol (id-convert-and-export name :type :type)))
      `(eval-when (compile load eval)
         (ff:def-foreign-type ,symbol ,@rest))))
  
! (defswig2 swig-def-synonym-type (synonym of ff-synonym)
    `(eval-when (compile load eval)
       (setf (find-class ',synonym) (find-class ',of))
***************
*** 467,471 ****
      (in-package ,(package-name-for-namespace namespace))))
  
! (defmacro swig-defvar (name mangled-name &key type)
    (let ((symbol (id-convert-and-export name :type type)))
      `(eval-when (compile load eval)
--- 486,490 ----
      (in-package ,(package-name-for-namespace namespace))))
  
! (defswig2 swig-defvar (name mangled-name &key type)
    (let ((symbol (id-convert-and-export name :type type)))
      `(eval-when (compile load eval)
***************
*** 483,488 ****
                    collect sym))))
  
- (in-package #.*swig-module-name*)
- 
  %}
  
--- 502,505 ----