From f2ff50e60eaac3fca8f5fe382c7bd57d5b945201 Mon Sep 17 00:00:00 2001
From: Mikel Bancroft
Date: Wed, 19 Jul 2006 21:53:07 +0000
Subject: [PATCH] 07/19/2006: mutandiz [allegrocl] - Add
std_string.i support. - Add newobject patch submitted by mkoeppe
(thanks!) - Fix type name mismatch issue for nested type
definitions. specifically typedefs in templated class defns.
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@9220 626c5289-ae23-0410-ae9c-e8d60b6d4f22
---
CHANGES.current | 7 +
Doc/Manual/Allegrocl.html | 89 +++++----
Lib/allegrocl/allegrocl.swg | 343 +++++++++++++++++----------------
Lib/allegrocl/inout_typemaps.i | 44 ++---
Lib/allegrocl/std_list.i | 4 +-
Lib/allegrocl/std_string.i | 197 +++++++++++++++++++
Source/Modules/allegrocl.cxx | 27 ++-
7 files changed, 481 insertions(+), 230 deletions(-)
create mode 100755 Lib/allegrocl/std_string.i
diff --git a/CHANGES.current b/CHANGES.current
index a0510246d..4df931d4d 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -1,5 +1,12 @@
Version 1.3.30 (in progress)
============================
+07/19/2006: mutandiz
+ [allegrocl]
+ - Add std_string.i support.
+ - Add newobject patch submitted by mkoeppe (thanks!)
+ - Fix type name mismatch issue for nested type definitions.
+ specifically typedefs in templated class defns.
+
07/18/2006: mgossage
Bugfix #1522858
updated lua.cxx to support -external-runtime command
diff --git a/Doc/Manual/Allegrocl.html b/Doc/Manual/Allegrocl.html
index 2b06ebcf0..aaaf1ee04 100755
--- a/Doc/Manual/Allegrocl.html
+++ b/Doc/Manual/Allegrocl.html
@@ -204,14 +204,14 @@ int fact(char *statement); // pass it a fact, and it will rate it.
(swig-in-package ())
(swig-defun ("fact")
- ((PARM0_statement string (* :char) ))
+ ((PARM0_statement cl:string (* :char) ))
(:returning (:int )
:strings-convert t)
(let ((SWIG_arg0 PARM0_statement))
(swig-ff-call SWIG_arg0)))
(swig-defun ("fact")
- ((PARM0_n integer :int ))
+ ((PARM0_n cl:integer :int ))
(:returning (:int )
:strings-convert t)
(let ((SWIG_arg0 PARM0_n))
@@ -329,14 +329,14 @@ what is generated when parsing C code:
(swig-in-package ())
(swig-defmethod ("fact" "ACL___fact__SWIG_0" :type :function :arity 1)
- ((PARM0_statement string (* :char) ))
+ ((PARM0_statement cl:string (* :char) ))
(:returning (:int )
:strings-convert t)
(let ((SWIG_arg0 PARM0_statement))
(swig-ff-call SWIG_arg0)))
(swig-defmethod ("fact" "ACL___fact__SWIG_1" :type :function :arity 1)
- ((PARM0_n integer :int ))
+ ((PARM0_n cl:integer :int ))
(:returning (:int )
:strings-convert t)
(let ((SWIG_arg0 PARM0_n))
@@ -545,8 +545,8 @@ char *xxx();
(swig-in-package ())
(swig-defmethod ("foo" "ACL___foo__SWIG_0" :type :function :arity 2)
- ((PARM0_f1 single-float :float )
- (PARM1_f2 single-float :float ))
+ ((PARM0_f1 cl:single-float :float )
+ (PARM1_f2 cl:single-float :float ))
(:returning (:int )
:call-direct t
:strings-convert nil)
@@ -555,8 +555,8 @@ char *xxx();
(swig-ff-call SWIG_arg0 SWIG_arg1))))
(swig-defmethod ("foo" "ACL___foo__SWIG_1" :type :function :arity 2)
- ((PARM0_f1 single-float :float )
- (PARM1_c2 character :char character))
+ ((PARM0_f1 cl:single-float :float )
+ (PARM1_c2 cl:character :char character))
(:returning (:int )
:call-direct t
:strings-convert nil)
@@ -672,8 +672,9 @@ char *xxx();
C++ namespaces are translated into Lisp packages by SWIG. The
Global namespace is mapped to a package named by the %module
directive or the -module command-line argument. Further
- namespaces are created using Allegro CLs nested namespace convention.
- For example:
+ namespaces are generated by the swig-defpackage utility
+ function and given names based on Allegro CLs nested namespace
+ convention. For example:
foo.i:
@@ -731,6 +732,16 @@ namespace car {
case preferences, additional naming cues, etc.
+
+ Note that packages created by swig-defpackage do not
+ use the COMMON-LISP or EXCL package. This reduces possible
+ conflicts when defining foreign types via the SWIG interface
+ in all but the toplevel modules package. This may
+ lead to confusion if, for example, the current package is
+ foo.car.tires and you attempt to use a common-lisp
+ function such as (car '(1 2 3).
+
+
16.3.2 Constants
@@ -771,7 +782,7 @@ namespace car {
reduced to literal values, nodes are created, but with no simplification
of the constant value. A very very simple infix to prefix converter
has been implemented that tries to do the right thing for simple cases, but
- does not for more complex expressoins. If the literal parser determines
+ does not for more complex expressions. If the literal parser determines
that something is wrong, a warning will be generated and the literal
expression will be included in the generated code, but commented out.
@@ -788,7 +799,8 @@ namespace car {
- Users are cautioned to get to know their constants before use.
+ Users are cautioned to get to know their constants before use, or
+ not use the -nocwrap command-line option.
overload.cl
(swig-defmethod ("xxx" "ACL___xxx__SWIG_0" :type :function :arity 2)
- ((PARM0_i integer :int )
- (PARM1_x integer :int ))
+ ((PARM0_i cl:integer :int )
+ (PARM1_x cl:integer :int ))
(:returning (:float )
:strings-convert t)
(let ((SWIG_arg0 PARM0_i))
@@ -1408,7 +1420,7 @@ EXPORT float ACL___xxx__SWIG_2 (A *larg1, int larg2) {
(swig-ff-call SWIG_arg0 SWIG_arg1))))
(swig-defmethod ("xxx" "ACL___xxx__SWIG_1" :type :function :arity 1)
- ((PARM0_i integer :int ))
+ ((PARM0_i cl:integer :int ))
(:returning (:float )
:strings-convert t)
(let ((SWIG_arg0 PARM0_i))
@@ -1416,7 +1428,7 @@ EXPORT float ACL___xxx__SWIG_2 (A *larg1, int larg2) {
(swig-defmethod ("xxx" "ACL___xxx__SWIG_2" :type :function :arity 2)
((PARM0_inst #.(swig-insert-id "A" () :type :class) (* #.(swig-insert-id "A" ())) )
- (PARM1_x integer :int ))
+ (PARM1_x cl:integer :int ))
(:returning (:float )
:strings-convert t)
(let ((SWIG_arg0 PARM0_inst))
@@ -1776,7 +1788,7 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
- A number of custom typemaps have also been added, to facilitate
+ A number of custom typemaps have also been added to facilitate
the generation of code in the lisp side of the interface. These
are described below. The basic code generation structure is
applied as a series of nested expressions, one for each
@@ -1784,6 +1796,13 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
the foreign function call itself.
+
+ Note that the typemaps below use fully qualified symbols where
+ necessary. Users writing their own typemaps should do likewise.
+ See the explanation in the last paragraph of
+ 16.3.1 Namespaces for details.
+
+
16.4.2.1 LIN Typemap
@@ -1823,7 +1842,7 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
-%typemap(lin) SWIGTYPE "(let (($out $in))\n $body)";
+%typemap(lin) SWIGTYPE "(cl:let (($out $in))\n $body)";
@@ -1861,10 +1880,10 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
float, double, long double, char *, void *, void,
enum SWIGTYPE "$body";
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
- SWIGTYPE & "(make-instance '$lclass :foreign-address $body)";
-%typemap(lout) SWIGTYPE "(let* ((address $body)\n
- (ACL_result (make-instance '$lclass :foreign-address address)))\n
- (unless (zerop address)\n
+ SWIGTYPE & "(cl:make-instance '$lclass :foreign-address $body)";
+%typemap(lout) SWIGTYPE "(cl:let* ((address $body)\n
+ (ACL_result (cl:make-instance '$lclass :foreign-address address)))\n
+ (cl:unless (cl::zerop address)\n
(excl:schedule-finalization ACL_result #'$ldestructor))\n
ACL_result)";
@@ -1933,10 +1952,10 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
-%typemap(lisptype) bool "boolean";
-%typemap(lisptype) char "character";
-%typemap(lisptype) unsigned char "integer";
-%typemap(lisptype) signed char "integer";
+%typemap(lisptype) bool "cl:boolean";
+%typemap(lisptype) char "cl:character";
+%typemap(lisptype) unsigned char "cl:integer";
+%typemap(lisptype) signed char "cl:integer";
@@ -1952,15 +1971,15 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
%typemap(lispclass) bool "t";
-%typemap(lispclass) char "character";
+%typemap(lispclass) char "cl:character";
%typemap(lispclass) unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
- enum SWIGTYPE "integer";
-%typemap(lispclass) float "single-float";
-%typemap(lispclass) double "double-float";
-%typemap(lispclass) char * "string";
+ enum SWIGTYPE "cl:integer";
+%typemap(lispclass) float "cl:single-float";
+%typemap(lispclass) double "cl:double-float";
+%typemap(lispclass) char * "cl:string";
@@ -1977,7 +1996,7 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
%typemap(in) wchar_t "$1 = $input;";
-%typemap(lin) wchar_t "(let (($out (char-code $in)))\n $body)";
+%typemap(lin) wchar_t "(cl:let (($out (cl:char-code $in)))\n $body)";
%typemap(lin) wchar_t* "(excl:with-native-string
($out $in
:external-format #+little-endian :fat-le
@@ -1985,7 +2004,7 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
$body)"
%typemap(out) wchar_t "$result = $1;";
-%typemap(lout) wchar_t "(code-char $body)";
+%typemap(lout) wchar_t "(cl:code-char $body)";
%typemap(lout) wchar_t* "(excl:native-to-string $body
:external-format #+little-endian :fat-le
#-little-endian :fat)";
@@ -1993,8 +2012,8 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
%typemap(ffitype) wchar_t ":unsigned-short";
%typemap(lisptype) wchar_t "";
%typemap(ctype) wchar_t "wchar_t";
-%typemap(lispclass) wchar_t "character";
-%typemap(lispclass) wchar_t* "string";
+%typemap(lispclass) wchar_t "cl:character";
+%typemap(lispclass) wchar_t* "cl:string";
diff --git a/Lib/allegrocl/allegrocl.swg b/Lib/allegrocl/allegrocl.swg
index a876eae93..5b0ad7fb3 100644
--- a/Lib/allegrocl/allegrocl.swg
+++ b/Lib/allegrocl/allegrocl.swg
@@ -7,24 +7,29 @@
%ffargs(strings_convert="t");
/* typemaps for argument and result type conversions. */
-%typemap(lin,numinputs=1) SWIGTYPE "(let (($out $in))\n $body)";
+%typemap(lin,numinputs=1) SWIGTYPE "(cl::let (($out $in))\n $body)";
%typemap(lout) bool, char, unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
float, double, long double, char *, void *,
- enum SWIGTYPE "(setq ACL_ffresult $body)";
+ enum SWIGTYPE "(cl::setq ACL_ffresult $body)";
%typemap(lout) void "$body";
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
- SWIGTYPE & "(setq ACL_ffresult (make-instance '$lclass :foreign-address $body))";
+ SWIGTYPE &
+%{ (let* ((address $body)
+ (new-inst (make-instance '$lclass :foreign-address address)))
+ (when (and $owner (not (zerop address)))
+ (excl:schedule-finalization new-inst #'$ldestructor))
+ (setq ACL_ffresult new-inst)) %}
-%typemap(lout) SWIGTYPE "(let* ((address $body)\n (new-inst (make-instance '$lclass :foreign-address address)))\n (unless (zerop address)\n (excl:schedule-finalization new-inst #'$ldestructor))\n (setq ACL_ffresult new-inst))";
+%typemap(lout) SWIGTYPE "(cl::let* ((address $body)\n (new-inst (cl::make-instance '$lclass :foreign-address address)))\n (cl::unless (cl::zerop address)\n (excl:schedule-finalization new-inst #'$ldestructor))\n (cl::setq ACL_ffresult new-inst))";
-%typemap(lisptype) bool "boolean";
-%typemap(lisptype) char "character";
-%typemap(lisptype) unsigned char "integer";
-%typemap(lisptype) signed char "integer";
+%typemap(lisptype) bool "cl:boolean";
+%typemap(lisptype) char "cl:character";
+%typemap(lisptype) unsigned char "cl:integer";
+%typemap(lisptype) signed char "cl:integer";
%typemap(ffitype) bool ":int";
%typemap(ffitype) char ":char";
@@ -122,15 +127,15 @@ SWIG_TYPECHECK_STRING_ARRAY 1140
/* This maps C/C++ types to Lisp classes for overload dispatch */
%typemap(lispclass) bool "t";
-%typemap(lispclass) char "character";
+%typemap(lispclass) char "cl:character";
%typemap(lispclass) unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
- enum SWIGTYPE "integer";
-%typemap(lispclass) float "single-float";
-%typemap(lispclass) double "double-float";
-%typemap(lispclass) char * "string";
+ enum SWIGTYPE "cl:integer";
+%typemap(lispclass) float "cl:single-float";
+%typemap(lispclass) double "cl:double-float";
+%typemap(lispclass) char * "cl:string";
%typemap(out) bool "$result = (int)$1;";
%typemap(out) char, unsigned char, signed char,
@@ -156,21 +161,21 @@ SWIG_TYPECHECK_STRING_ARRAY 1140
%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
%typemap(in) wchar_t "$1 = $input;";
-%typemap(lin,numinputs=1) wchar_t "(let (($out (char-code $in)))\n $body)";
+%typemap(lin,numinputs=1) wchar_t "(cl::let (($out (char-code $in)))\n $body)";
%typemap(lin,numinputs=1) wchar_t* "(excl:with-native-string ($out $in
:external-format #+little-endian :fat-le #-little-endian :fat)\n
$body)"
%typemap(out) wchar_t "$result = $1;";
-%typemap(lout) wchar_t "(setq ACL_ffresult (code-char $body))";
-%typemap(lout) wchar_t* "(setq ACL_ffresult (excl:native-to-string $body
+%typemap(lout) wchar_t "(cl::setq ACL_ffresult (cl::code-char $body))";
+%typemap(lout) wchar_t* "(cl::setq ACL_ffresult (excl:native-to-string $body
:external-format #+little-endian :fat-le #-little-endian :fat))";
%typemap(ffitype) wchar_t ":unsigned-short";
%typemap(lisptype) wchar_t "";
%typemap(ctype) wchar_t "wchar_t";
-%typemap(lispclass) wchar_t "character";
-%typemap(lispclass) wchar_t* "string";
+%typemap(lispclass) wchar_t "cl:character";
+%typemap(lispclass) wchar_t* "cl:string";
//////////////////////////////////////////////////////////////
/* name conversion for overloaded operators. */
@@ -249,156 +254,161 @@ $body)"
;;; specify its name.
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *swig-export-list* nil))
+ (cl::defparameter *swig-export-list* nil))
-(defconstant *void* :..void..)
+(cl::defconstant *void* :..void..)
;; parsers to aid in finding SWIG definitions in files.
-(defun scm-p1 (form)
- (let* ((info (second form))
+(cl::defun scm-p1 (form)
+ (let* ((info (cl::second form))
(id (car info))
- (id-args (if (eq (car form) 'swig-dispatcher)
- (cdr info)
- (cddr info))))
- (apply *swig-identifier-converter* id
- (progn (when (eq (car form) 'swig-dispatcher)
- (remf id-args :arities))
+ (id-args (if (eq (cl::car form) 'swig-dispatcher)
+ (cl::cdr info)
+ (cl::cddr info))))
+ (cl::apply *swig-identifier-converter* id
+ (cl::progn (cl::when (cl::eq (cl::car form) 'swig-dispatcher)
+ (cl::remf id-args :arities))
id-args))))
-(defmacro defswig1 (name (&rest args) &body body)
- `(progn (defmacro ,name ,args
+(cl::defmacro defswig1 (name (&rest args) &body body)
+ `(cl::progn (cl::defmacro ,name ,args
,@body)
(excl::define-simple-parser ,name scm-p1)) )
-(defmacro defswig2 (name (&rest args) &body body)
- `(progn (defmacro ,name ,args
+(cl::defmacro defswig2 (name (&rest args) &body body)
+ `(cl::progn (cl::defmacro ,name ,args
,@body)
(excl::define-simple-parser ,name second)))
(defun read-symbol-from-string (string)
- (multiple-value-bind (result position)
- (read-from-string string nil "eof" :preserve-whitespace t)
- (if (and (symbolp result) (eql position (length string)))
+ (cl::multiple-value-bind (result position)
+ (cl::read-from-string string nil "eof" :preserve-whitespace t)
+ (cl::if (cl::and (cl::symbolp result)
+ (cl::eql position (cl::length string)))
result
- (multiple-value-bind (sym)
- (intern string)
+ (cl::multiple-value-bind (sym)
+ (cl::intern string)
sym))))
-(defun full-name (id type arity class)
- (case type
- (:getter (format nil "~@[~A_~]~A" class id))
- (:constructor (format nil "new_~A~@[~A~]" id arity))
- (:destructor (format nil "delete_~A" id))
- (:type (format nil "ff_~A" id))
- (:ff-operator (format nil "ffi_~A" id))
- (otherwise (format nil "~@[~A_~]~A~@[~A~]"
+(cl::defun full-name (id type arity class)
+ (cl::case type
+ (:getter (cl::format nil "~@[~A_~]~A" class id))
+ (:constructor (cl::format nil "new_~A~@[~A~]" id arity))
+ (:destructor (cl::format nil "delete_~A" id))
+ (:type (cl::format nil "ff_~A" id))
+ (:ff-operator (cl::format nil "ffi_~A" id))
+ (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]"
class id arity))))
-(defun identifier-convert-null (id &key type class arity)
- (if (eq type :setter)
- `(setf ,(identifier-convert-null
+(cl::defun identifier-convert-null (id &key type class arity)
+ (cl::if (cl::eq type :setter)
+ `(cl::setf ,(identifier-convert-null
id :type :getter :class class :arity arity))
(read-symbol-from-string (full-name id type arity class))))
-(defun identifier-convert-lispify (cname &key type class arity)
- (assert (stringp cname))
- (when (eq type :setter)
- (return-from identifier-convert-lispify
- `(setf ,(identifier-convert-lispify
+(cl::defun identifier-convert-lispify (cname &key type class arity)
+ (cl::assert (cl::stringp cname))
+ (cl::when (cl::eq type :setter)
+ (cl::return-from identifier-convert-lispify
+ `(cl::setf ,(identifier-convert-lispify
cname :type :getter :class class :arity arity))))
- (setq cname (full-name cname type arity class))
- (if (eq type :constant)
- (setf cname (format nil "*~A*" cname)))
- (setf cname (replace-regexp cname "_" "-"))
- (let ((lastcase :other)
- newcase char res)
- (dotimes (n (length cname))
- (setf char (schar cname n))
- (if* (alpha-char-p char)
+ (cl::setq cname (full-name cname type arity class))
+ (cl::if (cl::eq type :constant)
+ (cl::setf cname (cl::format nil "*~A*" cname)))
+ (cl::setf cname (excl::replace-regexp cname "_" "-"))
+ (cl::let ((lastcase :other)
+ newcase char res)
+ (cl::dotimes (n (cl::length cname))
+ (cl::setf char (cl::schar cname n))
+ (excl::if* (cl::alpha-char-p char)
then
- (setf newcase (if (upper-case-p char) :upper :lower))
+ (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower))
- (when (or (and (eq lastcase :upper) (eq newcase :lower))
- (and (eq lastcase :lower) (eq newcase :upper)))
+ (cl::when (cl::or (cl::and (cl::eq lastcase :upper)
+ (cl::eq newcase :lower))
+ (cl::and (cl::eq lastcase :lower)
+ (cl::eq newcase :upper)))
;; case change... add a dash
- (push #\- res)
- (setf newcase :other))
+ (cl::push #\- res)
+ (cl::setf newcase :other))
- (push (char-downcase char) res)
+ (cl::push (cl::char-downcase char) res)
- (setf lastcase newcase)
+ (cl::setf lastcase newcase)
else
- (push char res)
- (setf lastcase :other)))
- (read-symbol-from-string (coerce (nreverse res) 'string))))
+ (cl::push char res)
+ (cl::setf lastcase :other)))
+ (read-symbol-from-string (cl::coerce (cl::nreverse res) 'string))))
-(defun id-convert-and-export (name &rest kwargs)
- (multiple-value-bind (symbol package)
- (apply *swig-identifier-converter* name kwargs)
- (let ((args (list (if (consp symbol) (cadr symbol) symbol)
- (or package *package*))))
- (apply #'export args)
- (pushnew args *swig-export-list*))
+(cl::defun id-convert-and-export (name &rest kwargs)
+ (cl::multiple-value-bind (symbol package)
+ (cl::apply *swig-identifier-converter* name kwargs)
+ (cl::let ((args (cl::list (cl::if (cl::consp symbol)
+ (cl::cadr symbol) symbol)
+ (cl::or package cl::*package*))))
+ (cl::apply #'cl::export args)
+ (cl::pushnew args *swig-export-list*))
symbol))
-(defmacro swig-insert-id (name namespace &key (type :type) class)
- `(let ((*package* (find-package ,(package-name-for-namespace namespace))))
+(cl::defmacro swig-insert-id (name namespace &key (type :type) class)
+ `(cl::let ((cl::*package* (cl::find-package ,(package-name-for-namespace namespace))))
(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)
- (defconstant ,symbol ,value))))
+ (cl::let ((symbol (id-convert-and-export string :type :constant)))
+ `(cl::eval-when (compile load eval)
+ (cl::defconstant ,symbol ,value))))
-(defun maybe-reorder-args (funcname arglist)
+(cl::defun maybe-reorder-args (funcname arglist)
;; in the foreign setter function the new value will be the last argument
;; in Lisp it needs to be the first
- (if (consp funcname)
- (append (last arglist) (butlast arglist))
+ (cl::if (cl::consp funcname)
+ (cl::append (cl::last arglist) (cl::butlast arglist))
arglist))
-(defun maybe-return-value (funcname arglist)
+(cl::defun maybe-return-value (funcname arglist)
;; setf functions should return the new value
- (when (consp funcname)
- `(,(if (consp (car arglist))
- (caar arglist)
- (car arglist)))))
+ (cl::when (cl::consp funcname)
+ `(,(cl::if (cl::consp (cl::car arglist))
+ (cl::caar arglist)
+ (cl::car arglist)))))
-(defun swig-anyvarargs-p (arglist)
- (member :SWIG__varargs_ arglist))
+(cl::defun swig-anyvarargs-p (arglist)
+ (cl::member :SWIG__varargs_ arglist))
(defswig1 swig-defun ((name &optional (mangled-name name)
&key (type :operator) class arity)
arglist kwargs
&body body)
- (let* ((symbol (id-convert-and-export name :type type
+ (cl::let* ((symbol (id-convert-and-export name :type type
:arity arity :class class))
- (mangle (if* (eq name mangled-name)
+ (mangle (excl::if* (cl::eq name mangled-name)
then (id-convert-and-export
- (cond ((eq type :setter) (format nil "~A-set" name))
- ((eq type :getter) (format nil "~A-get" name))
+ (cl::cond
+ ((cl::eq type :setter) (cl::format nil "~A-set" name))
+ ((cl::eq type :getter) (cl::format nil "~A-get" name))
(t name))
:type :ff-operator :arity arity :class class)
- else (intern mangled-name)))
+ else (cl::intern mangled-name)))
(defun-args (maybe-reorder-args
symbol
- (mapcar #'car (and (not (equal arglist '(:void)))
- (loop as i in arglist
- when (eq (car i) :p+)
- collect (cdr i))))))
- (ffargs (if (equal arglist '(:void))
+ (cl::mapcar #'cl::car (cl::and (cl::not (cl::equal arglist '(:void)))
+ (cl::loop as i in arglist
+ when (cl::eq (cl::car i) :p+)
+ collect (cl::cdr i))))))
+ (ffargs (cl::if (cl::equal arglist '(:void))
arglist
- (mapcar #'cdr arglist)))
+ (cl::mapcar #'cl::cdr arglist)))
)
- (when (swig-anyvarargs-p ffargs)
- (setq ffargs '()))
- `(eval-when (compile load eval)
+ (cl::when (swig-anyvarargs-p ffargs)
+ (cl::setq ffargs '()))
+ `(cl::eval-when (compile load eval)
(excl::compiler-let ((*record-xref-info* nil))
(ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
- (macrolet ((swig-ff-call (&rest args)
- (cons ',mangle args)))
- (defun ,symbol ,defun-args
+ (cl::macrolet ((swig-ff-call (&rest args)
+ (cl::cons ',mangle args)))
+ (cl::defun ,symbol ,defun-args
,@body
,@(maybe-return-value symbol defun-args))))))
@@ -406,106 +416,107 @@ $body)"
&key (type :operator) class arity)
ffargs kwargs
&body body)
- (let* ((symbol (id-convert-and-export name :type type
+ (cl::let* ((symbol (id-convert-and-export name :type type
:arity arity :class class))
- (mangle (intern mangled-name))
+ (mangle (cl::intern mangled-name))
(defmethod-args (maybe-reorder-args
symbol
- (unless (equal ffargs '(:void))
- (loop for (lisparg name dispatch) in ffargs
+ (cl::unless (cl::equal ffargs '(:void))
+ (cl::loop for (lisparg name dispatch) in ffargs
when (eq lisparg :p+)
collect `(,name ,dispatch)))))
- (ffargs (if (equal ffargs '(:void))
+ (ffargs (cl::if (cl::equal ffargs '(:void))
ffargs
- (loop for (nil name nil . ffi) in ffargs
+ (cl::loop for (nil name nil . ffi) in ffargs
collect `(,name ,@ffi)))))
- `(eval-when (compile load eval)
+ `(cl::eval-when (compile load eval)
(excl::compiler-let ((*record-xref-info* nil))
(ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
- (macrolet ((swig-ff-call (&rest args)
- (cons ',mangle args)))
- (defmethod ,symbol ,defmethod-args
+ (cl::macrolet ((swig-ff-call (&rest args)
+ (cl::cons ',mangle args)))
+ (cl::defmethod ,symbol ,defmethod-args
,@body
,@(maybe-return-value symbol defmethod-args))))))
(defswig1 swig-dispatcher ((name &key (type :operator) class arities))
- (let ((symbol (id-convert-and-export name
+ (cl::let ((symbol (id-convert-and-export name
:type type :class class)))
- `(eval-when (compile load eval)
- (defun ,symbol (&rest args)
- (case (length args)
- ,@(loop for arity in arities
+ `(cl::eval-when (compile load eval)
+ (cl::defun ,symbol (&rest args)
+ (cl::case (cl::length args)
+ ,@(cl::loop for arity in arities
for symbol-n = (id-convert-and-export name
:type type :class class :arity arity)
- collect `(,arity (apply #',symbol-n args)))
- (t (error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (mapcar #'(lambda (x) (class-name (class-of x))) args)))
+ collect `(,arity (cl::apply #',symbol-n args)))
+ (t (cl::error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (cl::mapcar #'(cl::lambda (x) (cl::class-name (cl::class-of x))) args)))
)))))
(defswig2 swig-def-foreign-stub (name)
- (let ((lsymbol (id-convert-and-export name :type :class))
- (symbol (id-convert-and-export name :type :type)))
- `(eval-when (compile load eval)
+ (cl::let ((lsymbol (id-convert-and-export name :type :class))
+ (symbol (id-convert-and-export name :type :type)))
+ `(cl::eval-when (compile load eval)
(ff:def-foreign-type ,symbol (:class ))
- (defclass ,lsymbol (ff:foreign-pointer) ()))))
+ (cl::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)))
- `(eval-when (compile load eval)
+ (cl::let ((lsymbol (id-convert-and-export name :type :class))
+ (symbol (id-convert-and-export name :type :type)))
+ `(cl::eval-when (compile load eval)
(ff:def-foreign-type ,symbol ,@rest)
- (defclass ,lsymbol ,supers
+ (cl::defclass ,lsymbol ,supers
((foreign-type :initform ',symbol :initarg :foreign-type
: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)
+ (cl::let ((symbol (id-convert-and-export name :type :type)))
+ `(cl::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))
+ `(cl::eval-when (compile load eval)
+ (cl::setf (cl::find-class ',synonym) (cl::find-class ',of))
(ff:def-foreign-type ,ff-synonym (:struct ))))
-(defun package-name-for-namespace (namespace)
- (list-to-delimited-string
- (cons *swig-module-name*
- (mapcar #'(lambda (name)
- (string
- (funcall *swig-identifier-converter*
+(cl::defun package-name-for-namespace (namespace)
+ (excl::list-to-delimited-string
+ (cl::cons *swig-module-name*
+ (cl::mapcar #'(cl::lambda (name)
+ (cl::string
+ (cl::funcall *swig-identifier-converter*
name
:type :namespace)))
namespace))
"."))
-(defmacro swig-defpackage (namespace)
- (let* ((parent-namespaces (maplist #'reverse (cdr (reverse namespace))))
- (parent-strings (mapcar #'package-name-for-namespace
+(cl::defmacro swig-defpackage (namespace)
+ (cl::let* ((parent-namespaces (cl::maplist #'cl::reverse (cl::cdr (cl::reverse namespace))))
+ (parent-strings (cl::mapcar #'package-name-for-namespace
parent-namespaces))
- (string (package-name-for-namespace namespace)))
- `(eval-when (compile load eval)
- (defpackage ,string
- (:use :common-lisp :ff :swig :excl
- ,@parent-strings ,*swig-module-name*)))))
+ (string (package-name-for-namespace namespace)))
+ `(cl::eval-when (compile load eval)
+ (cl::defpackage ,string
+ (:use :swig :ff #+ignore '(:common-lisp :ff :excl)
+ ,@parent-strings ,*swig-module-name*)
+ (:import-from :cl "*")))))
-(defmacro swig-in-package (namespace)
- `(eval-when (compile load eval)
- (in-package ,(package-name-for-namespace namespace))))
+(cl::defmacro swig-in-package (namespace)
+ `(cl::eval-when (compile load eval)
+ (cl::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)
+ (cl::let ((symbol (id-convert-and-export name :type type)))
+ `(cl::eval-when (compile load eval)
(ff:def-foreign-variable (,symbol ,mangled-name)))))
) ;; eval-when
-(eval-when (compile eval)
- (flet ((starts-with-p (str prefix)
- (and (>= (length str) (length prefix))
- (string= str prefix :end1 (length prefix)))))
- (export (loop for sym being each present-symbol of *package*
- when (or (starts-with-p (symbol-name sym) (symbol-name :swig-))
- (starts-with-p (symbol-name sym) (symbol-name :identifier-convert-)))
+(cl::eval-when (compile eval)
+ (cl::flet ((starts-with-p (str prefix)
+ (cl::and (cl::>= (cl::length str) (cl::length prefix))
+ (cl::string= str prefix :end1 (cl::length prefix)))))
+ (cl::export (cl::loop for sym being each present-symbol of cl::*package*
+ when (cl::or (starts-with-p (cl::symbol-name sym) (cl::symbol-name :swig-))
+ (starts-with-p (cl::symbol-name sym) (cl::symbol-name :identifier-convert-)))
collect sym))))
%}
diff --git a/Lib/allegrocl/inout_typemaps.i b/Lib/allegrocl/inout_typemaps.i
index 64ffc9711..2b7330dad 100755
--- a/Lib/allegrocl/inout_typemaps.i
+++ b/Lib/allegrocl/inout_typemaps.i
@@ -35,42 +35,42 @@
// $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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(char,
- (push (code-char (ff:fslot-value-typed (quote $*in_fftype) :c $out))
+ (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
ACL_result),
- (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) $in));
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::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));
+ (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
+ (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(bool,
- (push (not (zerop (ff:fslot-value-typed (quote $*in_fftype) :c $out)))
+ (cl::push (not (zerop (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)))
ACL_result),
- (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out) (if $in 1 0)));
+ (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) (if $in 1 0)));
INOUT_TYPEMAP(char *,
- (push (ff:char*-to-string (ff:fslot-value-typed (quote $*in_fftype) :c $out))
+ (cl::push (ff:char*-to-string (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
ACL_result),
- (setf (ff:fslot-value-typed (quote $*in_fftype) :c $out)
+ (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)
(ff:string-to-char* $in)))
%typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
diff --git a/Lib/allegrocl/std_list.i b/Lib/allegrocl/std_list.i
index 26ebad54e..c8ab45649 100755
--- a/Lib/allegrocl/std_list.i
+++ b/Lib/allegrocl/std_list.i
@@ -18,7 +18,6 @@
* %template (floatlist) std::list