diff options
Diffstat (limited to 'share/swig/2.0.11/allegrocl/allegrocl.swg')
| -rw-r--r-- | share/swig/2.0.11/allegrocl/allegrocl.swg | 612 |
1 files changed, 612 insertions, 0 deletions
diff --git a/share/swig/2.0.11/allegrocl/allegrocl.swg b/share/swig/2.0.11/allegrocl/allegrocl.swg new file mode 100644 index 0000000..f08f87c --- /dev/null +++ b/share/swig/2.0.11/allegrocl/allegrocl.swg @@ -0,0 +1,612 @@ +/* Define a C preprocessor symbol that can be used in interface files + to distinguish between the SWIG language modules. */ + +#define SWIG_ALLEGRO_CL + +#define %ffargs(...) %feature("ffargs", "1", ##__VA_ARGS__) +%ffargs(strings_convert="t"); + +/* typemaps for argument and result type conversions. */ +%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 "(cl::setq ACL_ffresult $body)"; +%typemap(lout) void "$body"; +#ifdef __cplusplus +%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, + SWIGTYPE & +%{ (cl:let* ((address $body) + (new-inst (cl:make-instance '$lclass :foreign-address address))) + (cl:when (cl:and $owner (cl:not (cl:zerop address))) + (excl:schedule-finalization new-inst #'$ldestructor)) + (cl: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))"; +#else +%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, SWIGTYPE &, SWIGTYPE +%{ (cl:let* ((address $body) + (new-inst (cl:make-instance '$lclass :foreign-address address))) + (cl:setq ACL_ffresult new-inst)) %} +#endif + +%typemap(lisptype) bool, const bool "cl:boolean"; +%typemap(lisptype) char, const char "cl:character"; +%typemap(lisptype) unsigned char, const unsigned char "cl:integer"; +%typemap(lisptype) signed char, const signed char "cl:integer"; + +%typemap(ffitype) bool, const bool ":int"; +%typemap(ffitype) char, const char, + signed char, const signed char ":char"; +%typemap(ffitype) unsigned char, const unsigned char ":unsigned-char"; +%typemap(ffitype) short, const short, + signed short, const signed short ":short"; +%typemap(ffitype) unsigned short, const unsigned short ":unsigned-short"; +%typemap(ffitype) int, const int, signed int, const signed int ":int"; +%typemap(ffitype) unsigned int, const unsigned int ":unsigned-int"; +%typemap(ffitype) long, const long, signed long, const signed long ":long"; +%typemap(ffitype) unsigned long, const unsigned long ":unsigned-long"; +%typemap(ffitype) float, const float ":float"; +%typemap(ffitype) double, const double ":double"; +%typemap(ffitype) char *, const char *, signed char *, + const signed char *, signed char &, + const signed char & "(* :char)"; +%typemap(ffitype) unsigned char *, const unsigned char *, + unsigned char &, const unsigned char & "(* :unsigned-char)"; +%typemap(ffitype) short *, const short *, short &, + const short & "(* :short)"; +%typemap(ffitype) unsigned short *, const unsigned short *, + unsigned short &, const unsigned short & "(* :unsigned-short)"; +%typemap(ffitype) int *, const int *, int &, const int & "(* :int)"; +%typemap(ffitype) unsigned int *, const unsigned int *, + unsigned int &, const unsigned int & "(* :unsigned-int)"; +%typemap(ffitype) void * "(* :void)"; +%typemap(ffitype) void ":void"; +%typemap(ffitype) enum SWIGTYPE ":int"; +%typemap(ffitype) SWIGTYPE & "(* :void)"; + +/* const typemaps +idea: marshall all primitive c types to their respective lisp types +to maintain const corretness. For pointers/references, all bets +are off if you try to modify them. + +idea: add a constant-p slot to the base foreign-pointer class. For +constant pointer/references check this value when setting (around method?) +and error if a setf operation is performed on the address of this object. + +*/ + +/* +%exception %{ + try { + $action + } catch (...) { + return $null; + } +%} + +*/ + +// %typemap(throws) SWIGTYPE { +// (void)$1; +// SWIG_fail; +// } + +%typemap(ctype) bool, const bool "int"; +%typemap(ctype) 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 *, void, + enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[], + SWIGTYPE[ANY], SWIGTYPE &, const SWIGTYPE "$1_ltype"; +%typemap(ctype) SWIGTYPE "$&1_type"; + +%typemap(in) bool "$1 = (bool)$input;"; +%typemap(in) 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 *, void, + enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[], + SWIGTYPE[ANY], SWIGTYPE & "$1 = $input;"; +%typemap(in) SWIGTYPE "$1 = *$input;"; + +/* We don't need to do any actual C-side typechecking, but need to + use the precedence values to choose which overloaded function + interfaces to generate when conflicts arise. */ + +/* predefined precedence values + +Symbolic Name Precedence Value +------------------------------ ------------------ +SWIG_TYPECHECK_POINTER 0 +SWIG_TYPECHECK_VOIDPTR 10 +SWIG_TYPECHECK_BOOL 15 +SWIG_TYPECHECK_UINT8 20 +SWIG_TYPECHECK_INT8 25 +SWIG_TYPECHECK_UINT16 30 +SWIG_TYPECHECK_INT16 35 +SWIG_TYPECHECK_UINT32 40 +SWIG_TYPECHECK_INT32 45 +SWIG_TYPECHECK_UINT64 50 +SWIG_TYPECHECK_INT64 55 +SWIG_TYPECHECK_UINT128 60 +SWIG_TYPECHECK_INT128 65 +SWIG_TYPECHECK_INTEGER 70 +SWIG_TYPECHECK_FLOAT 80 +SWIG_TYPECHECK_DOUBLE 90 +SWIG_TYPECHECK_COMPLEX 100 +SWIG_TYPECHECK_UNICHAR 110 +SWIG_TYPECHECK_UNISTRING 120 +SWIG_TYPECHECK_CHAR 130 +SWIG_TYPECHECK_STRING 140 +SWIG_TYPECHECK_BOOL_ARRAY 1015 +SWIG_TYPECHECK_INT8_ARRAY 1025 +SWIG_TYPECHECK_INT16_ARRAY 1035 +SWIG_TYPECHECK_INT32_ARRAY 1045 +SWIG_TYPECHECK_INT64_ARRAY 1055 +SWIG_TYPECHECK_INT128_ARRAY 1065 +SWIG_TYPECHECK_FLOAT_ARRAY 1080 +SWIG_TYPECHECK_DOUBLE_ARRAY 1090 +SWIG_TYPECHECK_CHAR_ARRAY 1130 +SWIG_TYPECHECK_STRING_ARRAY 1140 +*/ + +%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_INTEGER) + unsigned char, signed char, + short, signed short, unsigned short, + int, signed int, unsigned int, + long, signed long, unsigned long, + enum SWIGTYPE { $1 = 1; }; +%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, + SWIGTYPE[], SWIGTYPE[ANY], + SWIGTYPE { $1 = 1; }; + +/* This maps C/C++ types to Lisp classes for overload dispatch */ + +%typemap(lispclass) bool "t"; +%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 "cl:integer"; +%typemap(lispclass) float "cl:single-float"; +%typemap(lispclass) double "cl:double-float"; +%typemap(lispclass) char * "cl:string"; + +%typemap(out) void ""; +%typemap(out) bool "$result = (int)$1;"; +%typemap(out) 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, SWIGTYPE *, + SWIGTYPE[ANY], SWIGTYPE & "$result = $1;"; +#ifdef __cplusplus +%typemap(out) SWIGTYPE "$result = new $1_ltype($1);"; +#else +%typemap(out) SWIGTYPE { + $result = ($&1_ltype) malloc(sizeof($1_type)); + memmove($result, &$1, sizeof($1_type)); +} +#endif + +////////////////////////////////////////////////////////////// +// UCS-2 string conversion + +// should this be SWIG_TYPECHECK_CHAR? +%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; }; + +%typemap(in) wchar_t "$1 = $input;"; +%typemap(lin,numinputs=1) wchar_t "(cl::let (($out (cl: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 "(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 "cl:character"; +%typemap(lispclass) wchar_t * "cl:string"; +////////////////////////////////////////////////////////////// + +/* Array reference typemaps */ +%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) } + +/* const pointers */ +%apply SWIGTYPE * { SWIGTYPE *const } + +/* name conversion for overloaded operators. */ +#ifdef __cplusplus +%rename(__add__) *::operator+; +%rename(__pos__) *::operator+(); +%rename(__pos__) *::operator+() const; + +%rename(__sub__) *::operator-; +%rename(__neg__) *::operator-() const; +%rename(__neg__) *::operator-(); + +%rename(__mul__) *::operator*; +%rename(__deref__) *::operator*(); +%rename(__deref__) *::operator*() const; + +%rename(__div__) *::operator/; +%rename(__mod__) *::operator%; +%rename(__logxor__) *::operator^; +%rename(__logand__) *::operator&; +%rename(__logior__) *::operator|; +%rename(__lognot__) *::operator~(); +%rename(__lognot__) *::operator~() const; + +%rename(__not__) *::operator!(); +%rename(__not__) *::operator!() const; + +%rename(__assign__) *::operator=; + +%rename(__add_assign__) *::operator+=; +%rename(__sub_assign__) *::operator-=; +%rename(__mul_assign__) *::operator*=; +%rename(__div_assign__) *::operator/=; +%rename(__mod_assign__) *::operator%=; +%rename(__logxor_assign__) *::operator^=; +%rename(__logand_assign__) *::operator&=; +%rename(__logior_assign__) *::operator|=; + +%rename(__lshift__) *::operator<<; +%rename(__lshift_assign__) *::operator<<=; +%rename(__rshift__) *::operator>>; +%rename(__rshift_assign__) *::operator>>=; + +%rename(__eq__) *::operator==; +%rename(__ne__) *::operator!=; +%rename(__lt__) *::operator<; +%rename(__gt__) *::operator>; +%rename(__lte__) *::operator<=; +%rename(__gte__) *::operator>=; + +%rename(__and__) *::operator&&; +%rename(__or__) *::operator||; + +%rename(__preincr__) *::operator++(); +%rename(__postincr__) *::operator++(int); +%rename(__predecr__) *::operator--(); +%rename(__postdecr__) *::operator--(int); + +%rename(__comma__) *::operator,(); +%rename(__comma__) *::operator,() const; + +%rename(__member_ref__) *::operator->; +%rename(__member_func_ref__) *::operator->*; + +%rename(__funcall__) *::operator(); +%rename(__aref__) *::operator[]; + +%rename(__bool__) *::operator bool(); +%rename(__bool__) *::operator bool() const; +#endif + +%insert("lisphead") %{ +(eval-when (:compile-toplevel :load-toplevel :execute) + + ;; avoid compiling ef-templates at runtime + (excl:find-external-format :fat) + (excl:find-external-format :fat-le) + +;;; You can define your own identifier converter if you want. +;;; Use the -identifier-converter command line argument to +;;; specify its name. + +(eval-when (:compile-toplevel :load-toplevel :execute) + (cl::defparameter *swig-export-list* nil)) + +(cl::defconstant *void* :..void..) + +;; parsers to aid in finding SWIG definitions in files. +(cl::defun scm-p1 (form) + (let* ((info (cl::second form)) + (id (car info)) + (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)))) + +(cl::defmacro defswig1 (name (&rest args) &body body) + `(cl::progn (cl::defmacro ,name ,args + ,@body) + (excl::define-simple-parser ,name scm-p1)) ) + +(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) + (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 + (cl::multiple-value-bind (sym) + (cl::intern string) + sym)))) + +(cl::defun full-name (id type arity class) + ; We need some kind of a hack here to handle template classes + ; and other synonym types right. We need the original name. + (let*( (sym (read-symbol-from-string + (if (eq *swig-identifier-converter* 'identifier-convert-lispify) + (string-lispify id) + id))) + (sym-class (find-class sym nil)) + (id (cond ( (not sym-class) + id ) + ( (and sym-class + (not (eq (class-name sym-class) + sym))) + (class-name sym-class) ) + ( t + id ))) ) + (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)) + (:slot id) + (:ff-operator (cl::format nil "ffi_~A" id)) + (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]" + class id arity))))) + +(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)))) + +(cl::defun string-lispify (str) + (cl::let ( (cname (excl::replace-regexp str "_" "-")) + (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 + (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower)) + (cl::when (cl::and (cl::eq lastcase :lower) + (cl::eq newcase :upper)) + ;; case change... add a dash + (cl::push #\- res) + (cl::setf newcase :other)) + (cl::push (cl::char-downcase char) res) + (cl::setf lastcase newcase) + else + (cl::push char res) + (cl::setf lastcase :other))) + (cl::coerce (cl::nreverse res) 'string))) + +(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)))) + (cl::setq cname (full-name cname type arity class)) + (cl::if (cl::eq type :constant) + (cl::setf cname (cl::format nil "*~A*" cname))) + (read-symbol-from-string (string-lispify cname))) + +(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)) + +(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) + (cl::let ((symbol (id-convert-and-export string :type :constant))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (cl::defconstant ,symbol ,value)))) + +(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 + (cl::if (cl::consp funcname) + (cl::append (cl::last arglist) (cl::butlast arglist)) + arglist)) + +(cl::defun maybe-return-value (funcname arglist) + ;; setf functions should return the new value + (cl::when (cl::consp funcname) + `(,(cl::if (cl::consp (cl::car arglist)) + (cl::caar arglist) + (cl::car 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) + (cl::let* ((symbol (id-convert-and-export name :type type + :arity arity :class class)) + (mangle (excl::if* (cl::string-equal name mangled-name) + then (id-convert-and-export + (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 (cl::intern mangled-name))) + (defun-args (maybe-reorder-args + symbol + (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 + (cl::mapcar #'cl::cdr arglist))) + ) + (cl::when (swig-anyvarargs-p ffargs) + (cl::setq ffargs '())) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (excl::compiler-let ((*record-xref-info* nil)) + (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs)) + (cl::macrolet ((swig-ff-call (&rest args) + (cl::cons ',mangle args))) + (cl::defun ,symbol ,defun-args + ,@body + ,@(maybe-return-value symbol defun-args)))))) + +(defswig1 swig-defmethod ((name &optional (mangled-name name) + &key (type :operator) class arity) + ffargs kwargs + &body body) + (cl::let* ((symbol (id-convert-and-export name :type type + :arity arity :class class)) + (mangle (cl::intern mangled-name)) + (defmethod-args (maybe-reorder-args + symbol + (cl::unless (cl::equal ffargs '(:void)) + (cl::loop for (lisparg name dispatch) in ffargs + when (eq lisparg :p+) + collect `(,name ,dispatch))))) + (ffargs (cl::if (cl::equal ffargs '(:void)) + ffargs + (cl::loop for (nil name nil . ffi) in ffargs + collect `(,name ,@ffi))))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (excl::compiler-let ((*record-xref-info* nil)) + (ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs)) + (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)) + (cl::let ((symbol (id-convert-and-export name + :type type :class class))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (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 (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) + (cl::let ((lsymbol (id-convert-and-export name :type :class)) + (symbol (id-convert-and-export name :type :type))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (ff:def-foreign-type ,symbol (:class )) + (cl::defclass ,lsymbol (ff:foreign-pointer) ())))) + +(defswig2 swig-def-foreign-class (name supers &rest rest) + (cl::let ((lsymbol (id-convert-and-export name :type :class)) + (symbol (id-convert-and-export name :type :type))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (ff:def-foreign-type ,symbol ,@rest) + (cl::defclass ,lsymbol ,supers + ((foreign-type :initform ',symbol :initarg :foreign-type + :accessor foreign-pointer-type)))))) + +(defswig2 swig-def-foreign-type (name &rest rest) + (cl::let ((symbol (id-convert-and-export name :type :type))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (ff:def-foreign-type ,symbol ,@rest)))) + +(defswig2 swig-def-synonym-type (synonym of ff-synonym) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (cl::setf (cl::find-class ',synonym) (cl::find-class ',of)) + (ff:def-foreign-type ,ff-synonym (:struct )))) + +(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)) + ".")) + +(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))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (cl::defpackage ,string + (:use :swig :ff #+ignore '(:common-lisp :ff :excl) + ,@parent-strings ,*swig-module-name*) + (:import-from :cl :* :nil :t))))) + +(cl::defmacro swig-in-package (namespace) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (cl::in-package ,(package-name-for-namespace namespace)))) + +(defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural)) + (cl::let ((symbol (id-convert-and-export name :type type))) + `(cl::eval-when (:compile-toplevel :load-toplevel :execute) + (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype)))) + +) ;; eval-when + +(cl::eval-when (:compile-toplevel :execute) + (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)))) + +%} + +typedef void *__SWIGACL_FwdReference; + +%{ + +#ifdef __cplusplus +# define EXTERN extern "C" +#else +# define EXTERN extern +#endif + +#define EXPORT EXTERN SWIGEXPORT + +typedef void *__SWIGACL_FwdReference; + +#include <string.h> +#include <stdlib.h> +%} |