[Allegrocl] Remove code for Allegro Common Lisp
We dropped support for it in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2 years. See #2009.
This commit is contained in:
Olly Betts
parent
b671a37e89
commit
353baebfcf
11 changed files with 5 additions and 6496 deletions
|
|
@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
|
|||
Version 4.1.0 (in progress)
|
||||
===========================
|
||||
|
||||
2021-05-13: olly
|
||||
[Allegrocl] #2009 Remove code for Allegro Common Lisp. We dropped
|
||||
support for it in SWIG 4.0.0 and nobody has stepped forward to
|
||||
revive it in over 2 years.
|
||||
|
||||
2021-05-04: olly
|
||||
[PHP] #1982 #1457 https://sourceforge.net/p/swig/bugs/1339/
|
||||
SWIG now only use PHP's C API to implement its wrappers, and no
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -1250,46 +1250,6 @@ lua_clean:
|
|||
rm -f core @EXTRA_CLEAN@
|
||||
rm -f *.@OBJEXT@ *$(LUA_SO)
|
||||
|
||||
##################################################################
|
||||
##### ALLEGRO CL ######
|
||||
##################################################################
|
||||
|
||||
ALLEGROCL = @ALLEGROCLBIN@
|
||||
ALLEGROCL_SCRIPT=$(RUNME).lisp
|
||||
|
||||
allegrocl: $(SRCDIR_SRCS)
|
||||
$(SWIG) -allegrocl -cwrap $(SWIGOPT) -o $(ISRCS) $(INTERFACEPATH)
|
||||
$(CC) -c $(CCSHARED) $(CPPFLAGS) $(CFLAGS) $(ISRCS) $(INCLUDES) $(SRCDIR_SRCS)
|
||||
$(LDSHARED) $(CFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
|
||||
|
||||
allegrocl_cpp: $(SRCDIR_SRCS)
|
||||
$(SWIG) -c++ -allegrocl $(SWIGOPT) -o $(ICXXSRCS) $(INTERFACEPATH)
|
||||
$(CXX) -c $(CCSHARED) $(CPPFLAGS) $(CXXFLAGS) $(ICXXSRCS) $(SRCDIR_SRCS) $(SRCDIR_CXXSRCS) $(INCLUDES)
|
||||
$(CXXSHARED) $(CXXFLAGS) $(LDFLAGS) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
|
||||
|
||||
# -----------------------------------------------------------------
|
||||
# Run ALLEGRO CL example
|
||||
# -----------------------------------------------------------------
|
||||
|
||||
allegrocl_run:
|
||||
$(RUNTOOL) $(ALLEGROCL) -batch -s $(ALLEGROCL_SCRIPT) $(RUNPIPE)
|
||||
|
||||
# -----------------------------------------------------------------
|
||||
# Version display
|
||||
# -----------------------------------------------------------------
|
||||
|
||||
allegrocl_version:
|
||||
$(ALLEGROCL) --version
|
||||
|
||||
# -----------------------------------------------------------------
|
||||
# Cleaning the ALLEGRO CL examples
|
||||
# -----------------------------------------------------------------
|
||||
|
||||
allegrocl_clean:
|
||||
rm -f *_wrap* *~ .~*
|
||||
rm -f core @EXTRA_CLEAN@
|
||||
rm -f *.@OBJEXT@ *@SO@
|
||||
|
||||
##################################################################
|
||||
##### CFFI ######
|
||||
##################################################################
|
||||
|
|
|
|||
|
|
@ -1,126 +0,0 @@
|
|||
#######################################################################
|
||||
# Makefile for allegrocl test-suite
|
||||
#######################################################################
|
||||
|
||||
LANGUAGE = allegrocl
|
||||
ALLEGROCL = @ALLEGROCLBIN@
|
||||
SCRIPTSUFFIX = _runme.lisp
|
||||
|
||||
srcdir = @srcdir@
|
||||
top_srcdir = @top_srcdir@
|
||||
top_builddir = @top_builddir@
|
||||
|
||||
|
||||
# these cpp tests generate warnings/errors when compiling
|
||||
# the wrapper .cxx file.
|
||||
CPP_TEST_BROKEN_CXX =
|
||||
# the error is wrap:action code generated by swig. \
|
||||
# error: can't convert [std::string] 'b' to 'bool' \
|
||||
# might just need a bool overload op for std::string. \
|
||||
global_vars \
|
||||
# same as w/ global_vars but with more errors in cxx file \
|
||||
naturalvar \
|
||||
|
||||
# these cpp tests aren't working. Fix 'em
|
||||
# need to further separate these into tests requiring
|
||||
# std libraries, or the $ldestructor problem.
|
||||
CPP_TEST_BROKEN_ACL = \
|
||||
contract \
|
||||
allprotected \
|
||||
# 'throws' typemap entries. \
|
||||
cplusplus_throw \
|
||||
# 'throws' typemap entries. \
|
||||
default_args \
|
||||
# missing typemaps. suspect module support needed \
|
||||
dynamic_cast \
|
||||
extend_variable \
|
||||
# cdata.i support needed \
|
||||
li_cdata_cpp \
|
||||
# warning generated. otherwise all good. \
|
||||
operator_overload \
|
||||
# std_common.i support \
|
||||
sizet \
|
||||
# std_vector.i support. \
|
||||
template_default \
|
||||
# *** line 31. can't copy typemap?? \
|
||||
typemap_namespace \
|
||||
|
||||
# these aren't working due to longlong support. (low hanging fruit)
|
||||
CPP_TEST_BROKEN_LONGLONG = \
|
||||
arrays_dimensionless \
|
||||
arrays_global \
|
||||
arrays_global_twodim \
|
||||
li_typemaps \
|
||||
li_windows \
|
||||
long_long_apply \
|
||||
primitive_ref \
|
||||
reference_global_vars \
|
||||
template_default_arg
|
||||
|
||||
# These are currently unsupported.
|
||||
CPP_TEST_CASES_ACL_UNSUPPORTED = \
|
||||
# contract support \
|
||||
aggregate \
|
||||
# directors support \
|
||||
apply_signed_char \
|
||||
# contract support \
|
||||
contract \
|
||||
director_exception \
|
||||
director_protected \
|
||||
exception_order \
|
||||
# 'throws' typemap support \
|
||||
extern_throws \
|
||||
throw_exception \
|
||||
using_pointers \
|
||||
|
||||
C_TEST_CASES_ACL_BROKEN = \
|
||||
# 'cdate.i' module support \
|
||||
li_cdata \
|
||||
# adding an existing type defnition... \
|
||||
typedef_struct \
|
||||
# swigrun.swg support. \
|
||||
typemap_subst
|
||||
|
||||
C_TEST_BROKEN_LONGLONG = \
|
||||
long_long
|
||||
|
||||
|
||||
# std lib support hasn't been done yet.
|
||||
SKIP_CPP_STD_CASES = Yes
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
|
||||
# Overridden variables here
|
||||
# SWIGOPT += -debug-module 4
|
||||
|
||||
# Custom tests - tests with additional commandline options
|
||||
# none!
|
||||
|
||||
# Rules for the different types of tests
|
||||
%.cpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
%.ctest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_c)
|
||||
$(run_testcase)
|
||||
|
||||
%.multicpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_multi_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
# Runs the testcase. A testcase is only run if
|
||||
# a file is found which has _runme.lisp appended after the testcase name.
|
||||
run_testcase = \
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
|
||||
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(ALLEGROCLBIN) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
|
||||
fi
|
||||
|
||||
%.clean:
|
||||
@rm -f $*.cl
|
||||
|
||||
clean:
|
||||
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR="$(SRCDIR)" allegrocl_clean
|
||||
|
|
@ -1,615 +0,0 @@
|
|||
/* 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 &, 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 &&, 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)";
|
||||
%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 &, 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 &, 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[], 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 &, 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]) }
|
||||
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
|
||||
|
||||
/* const pointers */
|
||||
%apply SWIGTYPE * { SWIGTYPE *const }
|
||||
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
|
||||
%apply SWIGTYPE & { SWIGTYPE (CLASS::*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>
|
||||
%}
|
||||
|
|
@ -1,111 +0,0 @@
|
|||
/* inout_typemaps.i
|
||||
|
||||
Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
|
||||
as multiple values.
|
||||
|
||||
*/
|
||||
|
||||
|
||||
/* Note that this macro automatically adds a pointer to the type passed in.
|
||||
As a result, INOUT typemaps for char are for 'char *'. The definition
|
||||
of typemaps for 'char' takes advantage of this, believing that it's more
|
||||
likely to see an INOUT argument for strings, than a single char. */
|
||||
%define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
|
||||
// OUTPUT map.
|
||||
%typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
|
||||
%{(cl::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.
|
||||
// careful here. the input string is converted to a C string
|
||||
// with length equal to the input string. This should be large
|
||||
// enough to contain whatever OUTPUT value will be stored in it.
|
||||
%typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
|
||||
%{(cl::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,
|
||||
(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,
|
||||
(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,
|
||||
(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,
|
||||
(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,
|
||||
(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,
|
||||
(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));
|
||||
// char * mapping for passing strings. didn't quite work
|
||||
// INOUT_TYPEMAP(char,
|
||||
// (cl::push (excl:native-to-string $out) ACL_result),
|
||||
// (cl::setf (ff:fslot-value-typed (cl::quote $in_fftype) :c $out)
|
||||
// (excl:string-to-native $in)))
|
||||
INOUT_TYPEMAP(float,
|
||||
(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,
|
||||
(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,
|
||||
(cl::push (not (zerop (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)))
|
||||
ACL_result),
|
||||
(cl::setf (ff:fslot-value-typed (cl::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);
|
||||
|
||||
// char *OUTPUT map.
|
||||
// for this to work, swig needs to know how large an array to allocate.
|
||||
// you can fake this by
|
||||
// %typemap(ffitype) char *myarg "(:array :char 30)";
|
||||
// %apply char *OUTPUT { char *myarg };
|
||||
%typemap(lin,numinputs=0) char *OUTPUT, char &OUTPUT
|
||||
%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
|
||||
$body
|
||||
(cl::push (excl:native-to-string $out) ACL_result)
|
||||
(ff:free-fobject $out)) %}
|
||||
|
||||
// char *INPUT map.
|
||||
%typemap(in) char *INPUT, char &INPUT
|
||||
%{ $1 = &$input; %}
|
||||
%typemap(ctype) char *INPUT, char &INPUT "$*1_ltype";
|
||||
|
||||
// char *INOUT map.
|
||||
%typemap(lin,numinputs=1) char *INOUT, char &INOUT
|
||||
%{(cl::let (($out (excl:string-to-native $in)))
|
||||
$body
|
||||
(cl::push (excl:native-to-string $out) ACL_result)
|
||||
(ff:free-fobject $out)) %}
|
||||
|
||||
// uncomment this if you want INOUT mappings for chars instead of strings.
|
||||
// INOUT_TYPEMAP(char,
|
||||
// (cl::push (code-char (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));
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* longlongs.i
|
||||
*
|
||||
* Typemap addition for support of 'long long' type and 'unsigned long long
|
||||
* Makes use of swig-def-foreign-class, so this header should be loaded
|
||||
* after allegrocl.swg and after any custom user identifier-conversion
|
||||
* functions have been defined.
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
#ifdef Acl64Bit
|
||||
%typemap(ctype) long long, unsigned long long "$1_ltype";
|
||||
%typemap(out) long long, unsigned long long "$result = $1;";
|
||||
|
||||
%typemap(ffitype) long long ":nat";
|
||||
%typemap(ffitype) unsigned long long ":unsigned-nat";
|
||||
|
||||
%typemap(lout) long long, unsigned long long " #+64bit (cl::setq ACL_ffresult $body)";
|
||||
|
||||
#else
|
||||
%typemap(out) long long, unsigned long long "$result = &$1;";
|
||||
%typemap(ffitype) long long "(:struct (l1 :long) (l2 :long))";
|
||||
|
||||
%typemap(ffitype) unsigned long long "(:struct (l1 :unsigned-long) (l2 :unsigned-long))";
|
||||
|
||||
%typemap(lout) long long
|
||||
" (cl::setq ACL_ffresult (make-instance '#.(swig-insert-id \"longlong\" () :type :class)
|
||||
:foreign-address $body))";
|
||||
|
||||
%typemap(lout) unsigned long long
|
||||
" (cl:setq ACL_ffresult (make-instance '#.(swig-insert-id \"ulonglong\" () :type :class)
|
||||
:foreign-address $body))";
|
||||
|
||||
#endif
|
||||
|
||||
%typemap(in) long long, unsigned long long "$1 = $input;";
|
||||
|
||||
|
||||
%insert("lisphead") %{
|
||||
|
||||
#-64bit
|
||||
(swig-def-foreign-class "longlong"
|
||||
(ff:foreign-pointer)
|
||||
(:struct (l1 :long) (l2 :long)))
|
||||
|
||||
#-64bit
|
||||
(swig-def-foreign-class "ulonglong"
|
||||
(ff:foreign-pointer)
|
||||
(:struct (l1 :unsigned-long) (l2 :unsigned-long)))
|
||||
%}
|
||||
|
|
@ -1,230 +0,0 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* std_list.i
|
||||
*
|
||||
* SWIG typemaps for std::list types
|
||||
*
|
||||
* To use, add:
|
||||
*
|
||||
* %include "std_list.i"
|
||||
*
|
||||
* to your interface file. You will also need to include a template directive
|
||||
* for each instance of the list container you want to use in your application.
|
||||
* e.g.
|
||||
*
|
||||
* %template (intlist) std::list<int>;
|
||||
* %template (floatlist) std::list<float>;
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
%module std_list
|
||||
%warnfilter(468) std::list;
|
||||
|
||||
%{
|
||||
#include <list>
|
||||
#include <stdexcept>
|
||||
%}
|
||||
|
||||
|
||||
namespace std{
|
||||
template<class T> class list
|
||||
{
|
||||
public:
|
||||
typedef size_t size_type;
|
||||
typedef ptrdiff_t difference_type;
|
||||
typedef T value_type;
|
||||
typedef value_type* pointer;
|
||||
typedef const value_type* const_pointer;
|
||||
typedef value_type& reference;
|
||||
typedef const value_type& const_reference;
|
||||
typedef T &iterator;
|
||||
typedef const T& const_iterator;
|
||||
|
||||
list();
|
||||
list(unsigned int size, const T& value = T());
|
||||
list(const list& other);
|
||||
|
||||
void assign(unsigned int n, const T& value);
|
||||
void swap(list<T> &x);
|
||||
|
||||
const_reference front();
|
||||
const_reference back();
|
||||
const_iterator begin();
|
||||
const_iterator end();
|
||||
|
||||
void resize(unsigned int n, T c = T());
|
||||
bool empty() const;
|
||||
|
||||
void push_front(const T& INPUT);
|
||||
void push_back(const T& INPUT);
|
||||
|
||||
void pop_front();
|
||||
void pop_back();
|
||||
void clear();
|
||||
unsigned int size() const;
|
||||
unsigned int max_size() const;
|
||||
void resize(unsigned int n, const T& INPUT);
|
||||
|
||||
void remove(const T& INPUT);
|
||||
void unique();
|
||||
void reverse();
|
||||
void sort();
|
||||
|
||||
%extend
|
||||
{
|
||||
%typemap(lout) T &__getitem__ "(cl::setq ACL_ffresult (ff:fslot-value-typed '$*out_fftype :c $body))";
|
||||
%typemap(lout) T *__getitem__ "(cl::setq ACL_ffresult (make-instance '$lclass :foreign-address $body))";
|
||||
|
||||
const_reference __getitem__(int i) throw (std::out_of_range)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (i>=0 && i<size)
|
||||
{
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
return *first;
|
||||
}
|
||||
else throw std::out_of_range("list index out of range");
|
||||
}
|
||||
void __setitem__(int i, const T& INPUT) throw (std::out_of_range)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (i>=0 && i<size)
|
||||
{
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
*first = INPUT;
|
||||
}
|
||||
else throw std::out_of_range("list index out of range");
|
||||
}
|
||||
void __delitem__(int i) throw (std::out_of_range)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (i>=0 && i<size)
|
||||
{
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
self->erase(first);
|
||||
}
|
||||
else throw std::out_of_range("list index out of range");
|
||||
}
|
||||
std::list<T> __getslice__(int i,int j)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
std::list<T>::iterator end = self->end();
|
||||
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (j<0) j += size;
|
||||
if (i<0) i = 0;
|
||||
if (j>size) j = size;
|
||||
if (i>=j) i=j;
|
||||
if (i>=0 && i<size && j>=0)
|
||||
{
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
for (int m=0;m<j;m++)
|
||||
{
|
||||
end++;
|
||||
}
|
||||
std::list<T> tmp(j-i);
|
||||
if (j>i) std::copy(first,end,tmp.begin());
|
||||
return tmp;
|
||||
}
|
||||
else throw std::out_of_range("list index out of range");
|
||||
}
|
||||
void __delslice__(int i,int j)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
std::list<T>::iterator end = self->end();
|
||||
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (j<0) j += size;
|
||||
if (i<0) i = 0;
|
||||
if (j>size) j = size;
|
||||
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
for (int m=0;m<=j;m++)
|
||||
{
|
||||
end++;
|
||||
}
|
||||
self->erase(first,end);
|
||||
}
|
||||
void __setslice__(int i,int j, const std::list<T>& v)
|
||||
{
|
||||
std::list<T>::iterator first = self->begin();
|
||||
std::list<T>::iterator end = self->end();
|
||||
|
||||
int size = int(self->size());
|
||||
if (i<0) i += size;
|
||||
if (j<0) j += size;
|
||||
if (i<0) i = 0;
|
||||
if (j>size) j = size;
|
||||
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
for (int m=0;m<=j;m++)
|
||||
{
|
||||
end++;
|
||||
}
|
||||
if (int(v.size()) == j-i)
|
||||
{
|
||||
std::copy(v.begin(),v.end(),first);
|
||||
}
|
||||
else {
|
||||
self->erase(first,end);
|
||||
if (i+1 <= int(self->size()))
|
||||
{
|
||||
first = self->begin();
|
||||
for (int k=0;k<i;k++)
|
||||
{
|
||||
first++;
|
||||
}
|
||||
self->insert(first,v.begin(),v.end());
|
||||
}
|
||||
else self->insert(self->end(),v.begin(),v.end());
|
||||
}
|
||||
}
|
||||
unsigned int __len__()
|
||||
{
|
||||
return self->size();
|
||||
}
|
||||
bool __nonzero__()
|
||||
{
|
||||
return !(self->empty());
|
||||
}
|
||||
void append(const T& INPUT)
|
||||
{
|
||||
self->push_back(INPUT);
|
||||
}
|
||||
void pop()
|
||||
{
|
||||
self->pop_back();
|
||||
}
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,209 +0,0 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* std_string.i
|
||||
*
|
||||
* SWIG typemaps for std::string
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
// ------------------------------------------------------------------------
|
||||
// std::string is typemapped by value
|
||||
// This can prevent exporting methods which return a string
|
||||
// in order for the user to modify it.
|
||||
// However, I think I'll wait until someone asks for it...
|
||||
// ------------------------------------------------------------------------
|
||||
|
||||
// %include <exception.i>
|
||||
%warnfilter(404) std::string;
|
||||
%warnfilter(404) std::wstring;
|
||||
|
||||
%{
|
||||
#include <string>
|
||||
%}
|
||||
|
||||
// %include <std_vector.i>
|
||||
|
||||
// %naturalvar std::string;
|
||||
// %naturalvar std::wstring;
|
||||
|
||||
namespace std {
|
||||
typedef unsigned long size_t;
|
||||
typedef signed long ptrdiff_t;
|
||||
|
||||
template <class charT> class basic_string {
|
||||
public:
|
||||
typedef charT *pointer;
|
||||
typedef charT &reference;
|
||||
typedef const charT &const_reference;
|
||||
typedef size_t size_type;
|
||||
typedef ptrdiff_t difference_type;
|
||||
basic_string();
|
||||
basic_string( charT *str );
|
||||
size_type size();
|
||||
charT operator []( int pos ) const;
|
||||
charT *c_str() const;
|
||||
basic_string<charT> &operator = ( const basic_string &ws );
|
||||
basic_string<charT> &operator = ( const charT *str );
|
||||
basic_string<charT> &append( const basic_string<charT> &other );
|
||||
basic_string<charT> &append( const charT *str );
|
||||
void push_back( charT c );
|
||||
void clear();
|
||||
void reserve( size_type t );
|
||||
void resize( size_type n, charT c = charT() );
|
||||
int compare( const basic_string<charT> &other ) const;
|
||||
int compare( const charT *str ) const;
|
||||
basic_string<charT> &insert( size_type pos,
|
||||
const basic_string<charT> &str );
|
||||
size_type find( const basic_string<charT> &other, int pos = 0 ) const;
|
||||
size_type find( charT c, int pos = 0 ) const;
|
||||
%extend {
|
||||
bool operator == ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) == 0;
|
||||
}
|
||||
bool operator != ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) != 0;
|
||||
}
|
||||
bool operator < ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) == -1;
|
||||
}
|
||||
bool operator > ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) == 1;
|
||||
}
|
||||
bool operator <= ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) != 1;
|
||||
}
|
||||
bool operator >= ( const basic_string<charT> &other ) const {
|
||||
return self->compare( other ) != -1;
|
||||
}
|
||||
|
||||
}
|
||||
};
|
||||
|
||||
%template(string) basic_string<char>;
|
||||
%template(wstring) basic_string<wchar_t>;
|
||||
|
||||
%apply char * { string };
|
||||
%apply wchar_t * { wstring };
|
||||
|
||||
typedef basic_string<char> string;
|
||||
typedef basic_string<wchar_t> wstring;
|
||||
|
||||
// automatically convert constant std::strings to cl:strings
|
||||
%typemap(ctype) string "char *";
|
||||
%typemap(in) string "$1.assign($input);";
|
||||
%typemap(out) string "$result = (char *)(&$1)->c_str();";
|
||||
%typemap(lisptype) string "cl:string";
|
||||
%typemap(lout) string "(cl::setq ACL_ffresult $body)";
|
||||
|
||||
%typemap(ctype) const string *"char *";
|
||||
%typemap(in) const string * "$1.assign($input);";
|
||||
%typemap(out) const string * "$result = (char *)($1)->c_str();";
|
||||
%typemap(lisptype) const string * "cl:string";
|
||||
%typemap(lout) const string * "(cl::setq ACL_ffresult $body)";
|
||||
|
||||
%typemap(ctype) wstring "wchar_t *";
|
||||
%typemap(in) wstring "$1.assign($input);";
|
||||
%typemap(out) wstring "$result = (wchar_t *)(&$1)->c_str();";
|
||||
%typemap(lisptype) wstring "cl:string";
|
||||
%typemap(lout) wstring "(cl::setq ACL_ffresult (excl:native-to-string $body
|
||||
:external-format #+little-endian :fat-le #-little-endian :fat))";
|
||||
|
||||
%typemap(ctype) const wstring *"char *";
|
||||
%typemap(in) const wstring * "$1.assign($input);";
|
||||
%typemap(out) const wstring * "$result = (char *)($1)->c_str();";
|
||||
%typemap(lisptype) const wstring * "cl:string";
|
||||
%typemap(lout) const wstring * "(cl::setq ACL_ffresult $body)";
|
||||
|
||||
/* Overloading check */
|
||||
// %typemap(in) string {
|
||||
// if (caml_ptr_check($input))
|
||||
// $1.assign((char *)caml_ptr_val($input,0),
|
||||
// caml_string_len($input));
|
||||
// else
|
||||
// SWIG_exception(SWIG_TypeError, "string expected");
|
||||
// }
|
||||
|
||||
// %typemap(in) const string & ($*1_ltype temp) {
|
||||
// if (caml_ptr_check($input)) {
|
||||
// temp.assign((char *)caml_ptr_val($input,0),
|
||||
// caml_string_len($input));
|
||||
// $1 = &temp;
|
||||
// } else {
|
||||
// SWIG_exception(SWIG_TypeError, "string expected");
|
||||
// }
|
||||
// }
|
||||
|
||||
// %typemap(in) string & ($*1_ltype temp) {
|
||||
// if (caml_ptr_check($input)) {
|
||||
// temp.assign((char *)caml_ptr_val($input,0),
|
||||
// caml_string_len($input));
|
||||
// $1 = &temp;
|
||||
// } else {
|
||||
// SWIG_exception(SWIG_TypeError, "string expected");
|
||||
// }
|
||||
// }
|
||||
|
||||
// %typemap(in) string * ($*1_ltype *temp) {
|
||||
// if (caml_ptr_check($input)) {
|
||||
// temp = new $*1_ltype((char *)caml_ptr_val($input,0),
|
||||
// caml_string_len($input));
|
||||
// $1 = temp;
|
||||
// } else {
|
||||
// SWIG_exception(SWIG_TypeError, "string expected");
|
||||
// }
|
||||
// }
|
||||
|
||||
// %typemap(free) string * ($*1_ltype *temp) {
|
||||
// delete temp;
|
||||
// }
|
||||
|
||||
// %typemap(argout) string & {
|
||||
// caml_list_append(swig_result,caml_val_string_len((*$1).c_str(),
|
||||
// (*$1).size()));
|
||||
// }
|
||||
|
||||
// %typemap(directorout) string {
|
||||
// $result.assign((char *)caml_ptr_val($input,0),
|
||||
// caml_string_len($input));
|
||||
// }
|
||||
|
||||
// %typemap(out) string {
|
||||
// $result = caml_val_string_len($1.c_str(),$1.size());
|
||||
// }
|
||||
|
||||
// %typemap(out) string * {
|
||||
// $result = caml_val_string_len((*$1).c_str(),(*$1).size());
|
||||
// }
|
||||
}
|
||||
|
||||
// #ifdef ENABLE_CHARPTR_ARRAY
|
||||
// char **c_charptr_array( const std::vector <string > &str_v );
|
||||
|
||||
// %{
|
||||
// SWIGEXT char **c_charptr_array( const std::vector <string > &str_v ) {
|
||||
// char **out = new char *[str_v.size() + 1];
|
||||
// out[str_v.size()] = 0;
|
||||
// for( int i = 0; i < str_v.size(); i++ ) {
|
||||
// out[i] = (char *)str_v[i].c_str();
|
||||
// }
|
||||
// return out;
|
||||
// }
|
||||
// %}
|
||||
// #endif
|
||||
|
||||
// #ifdef ENABLE_STRING_VECTOR
|
||||
// %template (StringVector) std::vector<string >;
|
||||
|
||||
// %insert(ml) %{
|
||||
// (* Some STL convenience items *)
|
||||
|
||||
// let string_array_to_vector sa =
|
||||
// let nv = _new_StringVector C_void in
|
||||
// array_to_vector nv (fun x -> C_string x) sa ; nv
|
||||
|
||||
// let c_string_array ar =
|
||||
// _c_charptr_array (string_array_to_vector ar)
|
||||
// %}
|
||||
|
||||
// %insert(mli) %{
|
||||
// val c_string_array: string array -> c_obj
|
||||
// %}
|
||||
// #endif
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
/* Unused for Allegro CL module */
|
||||
|
||||
%include "inout_typemaps.i"
|
||||
%include "longlongs.i"
|
||||
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue