jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

The great merge

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@4141 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2002-11-30 22:01:28 +00:00
commit 516036631c
1508 changed files with 125983 additions and 44037 deletions
Download patch file Download diff file Expand all files Collapse all files

20
SWIG/Lib/guile/cplusplus.i Normal file
View file

@ -0,0 +1,20 @@
/* SWIG typemaps for C++ */
/* By Marcio Luis Teixeira <marciot@holly.colostate.edu>: */
%typemap(guile,out) string, std::string {
$result = gh_str02scm(const_cast<char*>($1.c_str()));
}
%typemap(guile,in) string, std::string {
$1 = SWIG_scm2str($input);
}
%typemap(guile,out) complex, complex<double>, std::complex<double> {
$result = scm_make_rectangular( gh_double2scm ($1.real ()),
gh_double2scm ($1.imag ()) );
}
%typemap(guile,in) complex, complex<double>, std::complex<double> {
$1 = std::complex<double>( gh_scm2double (scm_real_part ($input)),
gh_scm2double (scm_imag_part ($input)) );
}

41
SWIG/Lib/guile/guile.i
View file

@ -1,4 +1,4 @@
/* SWIG Configuration File for Guile.
/* SWIG Configuration File for Guile. -*-c-*-
This file is parsed by SWIG before reading any other interface
file. */
@ -9,6 +9,43 @@
%insert(runtime) "guile.swg"
#endif
/* Macro for inserting Scheme code into the stub */
#define %scheme %insert("scheme")
/* Return-styles */
%pragma(guile) return_nothing_doc = "Returns unspecified."
%pragma(guile) return_one_doc = "Returns $values."
%define %values_as_list
%pragma(guile) beforereturn = ""
%pragma(guile) return_multi_doc = "Returns a list of $num_values values: $values."
%enddef
%values_as_list /* the default style */
%define %values_as_vector
%pragma(guile) beforereturn = "GUILE_MAYBE_VECTOR"
%pragma(guile) return_multi_doc = "Returns a vector of $num_values values: $values."
%enddef
%define %multiple_values
%pragma(guile) beforereturn = "GUILE_MAYBE_VALUES"
%pragma(guile) return_multi_doc = "Returns $num_values values: $values."
%enddef
/* The following definitions are supposed to provide a common API for
the supported Scheme dialects, so that typemaps may be shared. I
also plan to adopt Guile's high-level interface (GH) for this
purpose. */
#define SWIG_malloc(size) \
SCM_MUST_MALLOC(size)
#define SWIG_free(mem) \
scm_must_free(mem)
#define SWIG_GetPtr(s, result, type) \
SWIG_Guile_GetPtr(s, result, type)
#define SWIG_MustGetPtr(s, type, argnum) \
SWIG_Guile_MustGetPtr(s, type, argnum, FUNC_NAME)
#define SWIG_MakePtr(ptr, type) \
SWIG_Guile_MakePtr(ptr, type)
/* Read in standard typemaps. */
%include "typemaps.i"

84
SWIG/Lib/guile/guile.swg
View file

@ -7,6 +7,10 @@
/* SWIG pointer structure */
#ifdef __cplusplus
extern "C" {
#endif
struct SwigCast {
unsigned short type; /* Index into SwigPtrTbl */
void *(*cast)(void *); /* Pointer casting function */
@ -14,8 +18,8 @@ struct SwigCast {
};
struct SwigPtrType {
char *name; /* Datatype name */
char *prettyname; /* Pretty datatype name */
const char *name; /* Datatype name */
const char *prettyname; /* Pretty datatype name */
unsigned short tag; /* Index in SwigPtrTable */
struct SwigCast *cast; /* List of compatible types */
};
@ -45,7 +49,7 @@ swigsort (const void *data1, const void *data2)
/* Register a new datatype with the type-checker */
SWIGSTATIC size_t
SWIG_RegisterType (char *type, char *prettyname)
SWIG_RegisterType (const char *type, const char *prettyname)
{
int i;
@ -90,9 +94,9 @@ SWIG_RegisterType (char *type, char *prettyname)
/* Register two data types and their mapping with the type checker. */
SWIGSTATIC void
SWIG_RegisterMapping (char *origtype, char *newtype, void *(*cast)(void *))
SWIG_RegisterMapping (const char *origtype, const char *newtype,
swig_converter_func cast)
{
int i;
size_t t = SWIG_RegisterType(origtype, NULL);
if (newtype!=NULL) {
@ -118,7 +122,6 @@ SWIG_RegisterMapping (char *origtype, char *newtype, void *(*cast)(void *))
static void
SWIG_SortTable (void)
{
int i;
qsort ((void *) SwigPtrTbl, SwigPtrN, sizeof(size_t), swigsort);
/* Indicate that everything is sorted */
SwigPtrSort = 1;
@ -137,10 +140,9 @@ swigcmp (const void *key, const void *data)
static SwigPtrType *
SWIG_GetPtrType (const char *_t)
{
int start, end;
size_t *result;
if (!SwigPtrSort) SWIG_SortTable();
result = bsearch(_t, SwigPtrTbl, SwigPtrN, sizeof(size_t), swigcmp);
result = (size_t *) bsearch(_t, SwigPtrTbl, SwigPtrN, sizeof(size_t), swigcmp);
if (result!=NULL) return SwigPtrList+*result;
else return NULL;
}
@ -156,8 +158,8 @@ SWIG_Cast (void *source, size_t source_type,
mapping table to figure out whether or not we can accept this
datatype. */
struct SwigCast *c;
for (c = SwigPtrList[source_type].cast;
c && c->type!=dest_type; c = c->next) /* nothing */;
for (c = SwigPtrList[dest_type].cast;
c && c->type!=source_type; c = c->next) /* nothing */;
if (c) {
/* Get pointer value. */
if (c->cast) *ptr = (*(c->cast))(source);
@ -175,6 +177,19 @@ SWIG_Cast (void *source, size_t source_type,
}
}
/* Dynamic pointer casting. Down an inheritance hierarchy */
SWIGSTATIC swig_type_info *
SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr)
{
swig_type_info *lastty = ty;
if (!ty || !ty->dcast) return ty;
while (ty && (ty->dcast)) {
ty = (*ty->dcast)(ptr);
if (ty) lastty = ty;
}
return lastty;
}
/* Function for getting a pointer value */
static unsigned long swig_tag = 0;
@ -199,7 +214,7 @@ SWIG_Guile_GetPtr(SCM s, void **result, swig_type_info *type)
&& (unsigned long) SCM_TYP16(s) == swig_tag) {
if (type)
return !SWIG_Cast((void *) SCM_CDR(s),
SCM_CAR(s) >> 16,
(long) SCM_CAR(s) >> 16,
result, type->tag);
else {
*result = (void *) SCM_CDR(s);
@ -209,18 +224,30 @@ SWIG_Guile_GetPtr(SCM s, void **result, swig_type_info *type)
return 1;
}
SWIGSTATIC void *
SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
int argnum, const char *func_name)
{
void *result;
if (SWIG_Guile_GetPtr(s, &result, type)) {
/* type mismatch */
scm_wrong_type_arg((char *) func_name, argnum, s);
}
return result;
}
/* Init */
static int
print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
{
char buf[16];
scm_puts("#<swig ", port);
if (SwigPtrList[SCM_CAR(swig_smob) >> 16].prettyname != NULL)
scm_puts(SwigPtrList[SCM_CAR(swig_smob) >> 16].prettyname, port);
else scm_puts(SwigPtrList[SCM_CAR(swig_smob) >> 16].name, port);
sprintf(buf, " 0x%lx>", SCM_CDR(swig_smob));
scm_puts(buf, port);
scm_puts((char *) "#<swig ", port);
if (SwigPtrList[(long) SCM_CAR(swig_smob) >> 16].prettyname != NULL)
scm_puts((char*) SwigPtrList[(long) SCM_CAR(swig_smob) >> 16].prettyname, port);
else scm_puts((char*) SwigPtrList[(long) SCM_CAR(swig_smob) >> 16].name, port);
scm_puts((char *) " ", port);
scm_intprint((long) SCM_CDR(swig_smob), 16, port);
scm_puts((char *) ">", port);
/* non-zero means success */
return 1;
}
@ -238,7 +265,7 @@ SWIGSTATIC void
SWIG_Guile_Init (void)
{
if (swig_tag == 0) {
swig_tag = scm_make_smob_type_mfpe("swig", 0, NULL, NULL,
swig_tag = scm_make_smob_type_mfpe((char *) "swig", 0, NULL, NULL,
print_swig, equalp_swig);
}
}
@ -246,11 +273,12 @@ SWIG_Guile_Init (void)
/* Convert datatype table */
SWIGSTATIC
void SWIG_Guile_RegisterTypes(swig_type_info **table)
void SWIG_Guile_RegisterTypes(swig_type_info **table,
swig_type_info **init)
{
for (; *table; table++) {
swig_type_info *type = *table;
char *origname = type->name;
for (; *init; table++, init++) {
swig_type_info *type = *table = *init;
const char *origname = type->name;
/* Register datatype itself and store pointer back */
type->tag = SWIG_RegisterType(origname, type->str);
/* Register compatible types */
@ -259,26 +287,30 @@ void SWIG_Guile_RegisterTypes(swig_type_info **table)
}
}
SWIGSTATIC void
SWIGSTATIC int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname)
{
int i;
int num_args_passed = 0;
for (i = 0; i<reqargs; i++) {
if (!SCM_CONSP(rest))
scm_wrong_num_args(gh_str02scm(procname));
scm_wrong_num_args(gh_str02scm((char *) procname));
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (; i<optargs; i++)
*dest++ = GH_NOT_PASSED;
if (!SCM_NULLP(rest))
scm_wrong_num_args(gh_str02scm(procname));
scm_wrong_num_args(gh_str02scm((char *) procname));
return num_args_passed;
}
#ifdef __cplusplus

72
SWIG/Lib/guile/guiledec.swg
View file

@ -27,23 +27,39 @@ extern "C" {
#define GH_NOT_PASSED SCM_UNDEFINED
#define GH_UNSPECIFIED SCM_UNSPECIFIED
#define GUILE_APPEND_RESULT(object) \
if (gswig_result == GH_UNSPECIFIED) \
gswig_result = object; \
else { \
if (!gh_pair_p(gswig_result)) \
gswig_result = gh_list(gswig_result, object, GH_NOT_PASSED); \
else \
gswig_result = gh_append2(gswig_result, \
gh_list(object, GH_NOT_PASSED)); \
#define SWIG_APPEND_VALUE(object) \
if (gswig_result == GH_UNSPECIFIED) \
gswig_result = object; \
else { \
if (!gswig_list_p) { \
gswig_list_p = 1; \
gswig_result = gh_list(gswig_result, object, GH_NOT_PASSED); \
} \
else \
gswig_result = gh_append2(gswig_result, \
gh_list(object, GH_NOT_PASSED)); \
}
#define GUILE_APPEND_RESULT SWIG_APPEND_VALUE
/* scm_values was implemented on C level in 1.4.1, and the prototype
is not included in libguile.h, so play safe and lookup `values'... */
#define GUILE_MAYBE_VALUES \
if (gswig_list_p) \
gswig_result = gh_apply(gh_lookup("values"), gswig_result);
#define GUILE_MAYBE_VECTOR \
if (gswig_list_p) \
gswig_result = gh_list_to_vector(gswig_result);
static char *
GSWIG_scm2str (SCM s)
SWIG_scm2str (SCM s)
{
return gh_scm2newstr (s, NULL);
}
#define GSWIG_scm2str SWIG_scm2str
/* SCM_CHAR and SCM_CHARP were introduced in Guile 1.4; the following is for
1.3.4 compatibility. */
#ifndef SCM_CHAR
@ -60,6 +76,7 @@ GSWIG_scm2char (SCM s)
if (SCM_CHARP(s)) return SCM_CHAR(s);
scm_wrong_type_arg(NULL, 0, s);
}
#define gh_scm2char GSWIG_scm2char
/* More 1.3.4 compatibility */
#ifndef SCM_INPUT_PORT_P
@ -69,19 +86,23 @@ GSWIG_scm2char (SCM s)
/* Type system */
typedef void *(*swig_converter_func)(void *);
typedef struct swig_type_info *(*swig_dycast_func)(void **);
typedef struct SwigPtrType SwigPtrType;
typedef struct swig_type_info {
char *name;
void *(*converter)(void *);
char *str;
const char *name;
swig_converter_func converter;
const char *str;
void *clientdata;
size_t tag;
swig_dycast_func dcast;
} swig_type_info;
#define swig_types_initial swig_types
SWIGSTATIC void
SWIG_Guile_RegisterTypes (swig_type_info **table);
SWIG_Guile_RegisterTypes (swig_type_info **table,
swig_type_info **init);
/* Register a new type-mapping with the type-checker. origtype is the
original datatype and newtype is an equivalent type. cast is optional
@ -90,8 +111,13 @@ SWIG_Guile_RegisterTypes (swig_type_info **table);
C++). */
SWIGSTATIC void
SWIG_RegisterMapping (char *origtype, char *newtype,
void *(*cast)(void *));
SWIG_RegisterMapping (const char *origtype, const char *newtype,
swig_converter_func cast);
/* Dynamic pointer casting. Down an inheritance hierarchy */
SWIGSTATIC swig_type_info *
SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr);
/* Register SWIG smobs with Guile. */
SWIGSTATIC void
@ -106,16 +132,24 @@ SWIG_Guile_Init();
SWIGSTATIC int
SWIG_Guile_GetPtr (SCM s, void **result, swig_type_info *type);
/* Get a pointer value from a smob. If there is a type-mismatch,
signal a wrong-type-arg error for the given argument number. */
SWIGSTATIC void *
SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
int argnum, const char *func_name);
/* Make a smob from a pointer and typeinfo. */
SWIGSTATIC SCM
SWIG_Guile_MakePtr (void *ptr, swig_type_info *type);
/* Get arguments from an argument list */
SWIGSTATIC void
SWIGSTATIC int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname);
typedef SCM (*swig_guile_proc)();
#ifdef __cplusplus
}
#endif

8
SWIG/Lib/guile/guilemain.i
View file

@ -27,6 +27,10 @@
%{
#include <libguile.h>
#ifdef __cplusplus
extern "C" {
#endif
/* Debugger interface (don't change the order of the following lines) */
#define GDB_TYPE SCM
#include <libguile/gdb_interface.h>
@ -44,6 +48,10 @@ inner_main(void *closure, int argc, char **argv)
/* never reached: scm_shell will perform an exit */
}
#ifdef __cplusplus
}
#endif
int
main(int argc, char **argv)
{

430
SWIG/Lib/guile/list-vector.i Normal file
View file

@ -0,0 +1,430 @@
/* list-vector.i --- Guile typemaps for converting between -*- c -*- arrays
and Scheme lists or vectors
Copyright (C) 2001, 2002 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
$Header$
*/
/* Here is a macro that will define typemaps for converting between C
arrays and Scheme lists or vectors when passing arguments to the C
function.
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(C_TYPE, SCM_TO_C, C_TO_SCM, SCM_TYPE)
Supported calling conventions:
func(int VECTORLENINPUT, [const] C_TYPE *VECTORINPUT)
Scheme wrapper will take one argument, a vector. A temporary C
array of elements of type C_TYPE will be allocated and filled
with the elements of the vectors, converted to C with the
SCM_TO_C function. Length and address of the array are passed
to the C function.
SCM_TYPE is used to describe the Scheme type of the elements in
the Guile procedure documentation.
func(int LISTLENINPUT, [const] C_TYPE *LISTINPUT)
Likewise, but the Scheme wrapper will take one argument, a list.
func(int *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT)
Scheme wrapper will take no arguments. Addresses of an integer
and a C_TYPE * variable will be passed to the C function. The
C function is expected to return address and length of a
freshly allocated array of elements of type C_TYPE through
these pointers. The elements of this array are converted to
Scheme with the C_TO_SCM function and returned as a Scheme
vector.
If the function has a void return value, the vector constructed
by this typemap becomes the return value of the Scheme wrapper.
Otherwise, the function returns multiple values. (See
the documentation on how to deal with multiple values.)
func(int *LISTLENOUTPUT, C_TYPE **LISTOUTPUT)
Likewise, but the Scheme wrapper will return a list instead of
a vector.
It is also allowed to use "size_t LISTLENINPUT" rather than "int
LISTLENINPUT". */
%define TYPEMAP_LIST_VECTOR_INPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, SCM_TYPE)
/* input */
/* We make use of the new multi-dispatch typemaps here. */
%typemap(in, doc="$NAME is a vector of " #SCM_TYPE " values")
(int VECTORLENINPUT, C_TYPE *VECTORINPUT),
(size_t VECTORLENINPUT, C_TYPE *VECTORINPUT)
{
SCM_VALIDATE_VECTOR($argnum, $input);
$1 = gh_vector_length($input);
if ($1 > 0) {
$1_ltype i;
$2 = SWIG_malloc(sizeof(C_TYPE) * $1);
for (i = 0; i<$1; i++) {
SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i));
$2[i] = SCM_TO_C_EXPR;
}
}
else $2 = NULL;
}
%typemap(in, doc="$NAME is a list of " #SCM_TYPE " values")
(int LISTLENINPUT, C_TYPE *LISTINPUT),
(size_t LISTLENINPUT, C_TYPE *LISTINPUT)
{
SCM_VALIDATE_LIST($argnum, $input);
$1 = gh_length($input);
if ($1 > 0) {
$1_ltype i;
SCM rest;
$2 = SWIG_malloc(sizeof(C_TYPE) * $1);
for (i = 0, rest = $input;
i<$1;
i++, rest = gh_cdr(rest)) {
SCM swig_scm_value = gh_car(rest);
$2[i] = SCM_TO_C_EXPR;
}
}
else $2 = NULL;
}
/* Do not check for NULL pointers (override checks). */
%typemap(check) C_TYPE *VECTORINPUT,
const C_TYPE *VECTORINPUT,
C_TYPE *LISTINPUT,
const C_TYPE *LISTINPUT
"/* no check for NULL pointer */";
/* Discard the temporary array after the call. */
%typemap(freearg) C_TYPE *VECTORINPUT,
const C_TYPE *VECTORINPUT,
C_TYPE *LISTINPUT,
const C_TYPE *LISTINPUT
{if ($1!=NULL) SWIG_free($1);}
%enddef
/* output */
%define TYPEMAP_LIST_VECTOR_OUTPUT_WITH_EXPR(C_TYPE, C_TO_SCM_EXPR, SCM_TYPE)
/* First we make temporary variables ARRAYLENTEMP and ARRAYTEMP,
whose addresses we pass to the C function. We ignore both
arguments for Scheme. */
%typemap(in,numinputs=0) (int *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT)
(int arraylentemp, C_TYPE *arraytemp),
(int *LISTLENOUTPUT, C_TYPE **LISTOUTPUT)
(int arraylentemp, C_TYPE *arraytemp),
(size_t *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT)
(int arraylentemp, C_TYPE *arraytemp),
(size_t *LISTLENOUTPUT, C_TYPE **LISTOUTPUT)
(int arraylentemp, C_TYPE *arraytemp)
%{
$1 = &arraylentemp;
$2 = &arraytemp;
%}
/* In the ARGOUT typemaps, we convert the array into a vector or
a list and append it to the results. */
%typemap(argout, doc="$NAME (a vector of " #SCM_TYPE " values)")
(int *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT),
(size_t *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT)
{
$*1_ltype i;
SCM res = gh_make_vector(gh_int2scm(*$1),
SCM_BOOL_F);
for (i = 0; i<*$1; i++) {
C_TYPE swig_c_value = (*$2)[i];
SCM elt = C_TO_SCM_EXPR;
gh_vector_set_x(res, gh_int2scm(i), elt);
}
SWIG_APPEND_VALUE(res);
}
%typemap(argout, doc="$NAME (a list of " #SCM_TYPE " values)")
(int *LISTLENOUTPUT, C_TYPE **LISTOUTPUT),
(size_t *LISTLENOUTPUT, C_TYPE **LISTOUTPUT)
{
int i;
SCM res = SCM_EOL;
for (i = ((int)(*$1)) - 1; i>=0; i--) {
C_TYPE swig_c_value = (*$2)[i];
SCM elt = C_TO_SCM_EXPR;
res = gh_cons(elt, res);
}
SWIG_APPEND_VALUE(res);
}
/* In the FREEARG typemaps, get rid of the C vector.
(This can be overridden if you want to keep the C vector.) */
%typemap(freearg)
(int *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT),
(size_t *VECTORLENOUTPUT, C_TYPE **VECTOROUTPUT),
(int *LISTLENOUTPUT, C_TYPE **LISTOUTPUT),
(size_t *LISTLENOUTPUT, C_TYPE **LISTOUTPUT)
{
if ((*$2)!=NULL) free(*$2);
}
%enddef
%define TYPEMAP_LIST_VECTOR_INPUT_OUTPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, C_TO_SCM_EXPR, SCM_TYPE)
TYPEMAP_LIST_VECTOR_INPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, SCM_TYPE)
TYPEMAP_LIST_VECTOR_OUTPUT_WITH_EXPR(C_TYPE, C_TO_SCM_EXPR, SCM_TYPE)
%enddef
%define TYPEMAP_LIST_VECTOR_INPUT(C_TYPE, SCM_TO_C, SCM_TYPE)
TYPEMAP_LIST_VECTOR_INPUT_WITH_EXPR
(C_TYPE, SCM_TO_C(swig_scm_value), SCM_TYPE)
%enddef
%define TYPEMAP_LIST_VECTOR_OUTPUT(C_TYPE, C_TO_SCM, SCM_TYPE)
TYPEMAP_LIST_VECTOR_OUTPUT_WITH_EXPR
(C_TYPE, C_TO_SCM(swig_c_value), SCM_TYPE)
%enddef
%define TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(C_TYPE, SCM_TO_C, C_TO_SCM, SCM_TYPE)
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT_WITH_EXPR
(C_TYPE, SCM_TO_C(swig_scm_value), C_TO_SCM(swig_c_value), SCM_TYPE)
%enddef
/* We use the macro to define typemaps for some standard types. */
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(bool, gh_scm2bool, gh_bool2scm, boolean);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(char, gh_scm2char, gh_char2scm, char);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(unsigned char, gh_scm2char, gh_char2scm, char);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(int, gh_scm2int, gh_int2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(short, gh_scm2int, gh_int2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(long, gh_scm2long, gh_long2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(ptrdiff_t, gh_scm2long, gh_long2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(unsigned int, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(unsigned short, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(unsigned long, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(size_t, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(float, gh_scm2double, gh_double2scm, real);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(double, gh_scm2double, gh_double2scm, real);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(char *, SWIG_scm2str, gh_str02scm, string);
TYPEMAP_LIST_VECTOR_INPUT_OUTPUT(const char *, SWIG_scm2str, gh_str02scm, string);
/* Following is a macro that emits typemaps that are much more
flexible. (They are also messier.) It supports multiple parallel
lists and vectors (sharing one length argument each).
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(C_TYPE, SCM_TO_C, C_TO_SCM, SCM_TYPE)
Supported calling conventions:
func(int PARALLEL_VECTORLENINPUT, [const] C_TYPE *PARALLEL_VECTORINPUT, ...) or
func([const] C_TYPE *PARALLEL_VECTORINPUT, ..., int PARALLEL_VECTORLENINPUT)
func(int PARALLEL_LISTLENINPUT, [const] C_TYPE *PARALLEL_LISTINPUT, ...) or
func([const] C_TYPE *PARALLEL_LISTINPUT, ..., int PARALLEL_LISTLENINPUT)
func(int *PARALLEL_VECTORLENOUTPUT, C_TYPE **PARALLEL_VECTOROUTPUT, ...) or
func(C_TYPE **PARALLEL_VECTOROUTPUT, int *PARALLEL_VECTORLENOUTPUT, ...)
func(int *PARALLEL_LISTLENOUTPUT, C_TYPE **PARALLEL_LISTOUTPUT) or
func(C_TYPE **PARALLEL_LISTOUTPUT, int *PARALLEL_LISTLENOUTPUT)
It is also allowed to use "size_t PARALLEL_LISTLENINPUT" rather than "int
PARALLEL_LISTLENINPUT". */
%define TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, SCM_TYPE)
/* input */
/* Passing data is a little complicated here; just remember:
IGNORE typemaps come first, then IN, then CHECK. But if
IGNORE is given, IN won't be used for this type.
We need to "ignore" one of the parameters because there shall
be only one argument on the Scheme side. Here we only
initialize the array length to 0 but save its address for a
later change. */
%typemap(in,numinputs=0) int PARALLEL_VECTORLENINPUT (int *_global_vector_length),
size_t PARALLEL_VECTORLENINPUT (size_t *_global_vector_length)
{
$1 = 0;
_global_vector_length = &$1;
}
%typemap(in,numinputs=0) int PARALLEL_LISTLENINPUT (int *_global_list_length),
size_t PARALLEL_LISTLENINPUT (int *_global_list_length)
{
$1 = 0;
_global_list_length = &$1;
}
/* All the work is done in IN. */
%typemap(in, doc="$NAME is a vector of " #SCM_TYPE " values")
C_TYPE *PARALLEL_VECTORINPUT,
const C_TYPE *PARALLEL_VECTORINPUT
{
SCM_VALIDATE_VECTOR($argnum, $input);
*_global_vector_length = gh_vector_length($input);
if (*_global_vector_length > 0) {
int i;
$1 = SWIG_malloc(sizeof(C_TYPE)
* (*_global_vector_length));
for (i = 0; i<*_global_vector_length; i++) {
SCM swig_scm_value = gh_vector_ref($input, gh_int2scm(i));
$1[i] = SCM_TO_C_EXPR;
}
}
else $1 = NULL;
}
%typemap(in, doc="($arg <list of <" #SCM_TYPE ">>)")
C_TYPE *PARALLEL_LISTINPUT,
const C_TYPE *PARALLEL_LISTINPUT
{
SCM_VALIDATE_LIST($argnum, $input);
*_global_list_length = gh_length($input);
if (*_global_list_length > 0) {
int i;
SCM rest;
$1 = SWIG_malloc(sizeof(C_TYPE)
* (*_global_list_length));
for (i = 0, rest = $input;
i<*_global_list_length;
i++, rest = gh_cdr(rest)) {
SCM swig_scm_value = gh_car(rest);
$1[i] = SCM_TO_C_EXPR;
}
}
else $1 = NULL;
}
/* Don't check for NULL pointers (override checks). */
%typemap(check) C_TYPE *PARALLEL_VECTORINPUT,
const C_TYPE *PARALLEL_VECTORINPUT,
C_TYPE *PARALLEL_LISTINPUT,
const C_TYPE *PARALLEL_LISTINPUT
"/* no check for NULL pointer */";
/* Discard the temporary array after the call. */
%typemap(freearg) C_TYPE *PARALLEL_VECTORINPUT,
const C_TYPE *PARALLEL_VECTORINPUT,
C_TYPE *PARALLEL_LISTINPUT,
const C_TYPE *PARALLEL_LISTINPUT
{if ($1!=NULL) SWIG_free($1);}
%enddef
%define TYPEMAP_PARALLEL_LIST_VECTOR_OUTPUT_WITH_EXPR(C_TYPE, C_TO_SCM_EXPR, SCM_TYPE)
/* output */
/* First we make a temporary variable ARRAYLENTEMP, use its
address as the ...LENOUTPUT argument for the C function and
"ignore" the ...LENOUTPUT argument for Scheme. */
%typemap(in,numinputs=0) int *PARALLEL_VECTORLENOUTPUT (int _global_arraylentemp),
size_t *PARALLEL_VECTORLENOUTPUT (size_t _global_arraylentemp),
int *PARALLEL_LISTLENOUTPUT (int _global_arraylentemp),
size_t *PARALLEL_LISTLENOUTPUT (size_t _global_arraylentemp)
"$1 = &_global_arraylentemp;";
/* We also need to ignore the ...OUTPUT argument. */
%typemap(in,numinputs=0) C_TYPE **PARALLEL_VECTOROUTPUT (C_TYPE *arraytemp),
C_TYPE **PARALLEL_LISTOUTPUT (C_TYPE *arraytemp)
"$1 = &arraytemp;";
/* In the ARGOUT typemaps, we convert the array into a vector or
a list and append it to the results. */
%typemap(argout, doc="$NAME (a vector of " #SCM_TYPE " values)")
C_TYPE **PARALLEL_VECTOROUTPUT
{
int i;
SCM res = gh_make_vector(gh_int2scm(_global_arraylentemp),
SCM_BOOL_F);
for (i = 0; i<_global_arraylentemp; i++) {
C_TYPE swig_c_value = (*$1)[i];
SCM elt = C_TO_SCM_EXPR;
gh_vector_set_x(res, gh_int2scm(i), elt);
}
SWIG_APPEND_VALUE(res);
}
%typemap(argout, doc="$NAME (a list of " #SCM_TYPE " values)")
C_TYPE **PARALLEL_LISTOUTPUT
{
int i;
SCM res = SCM_EOL;
if (_global_arraylentemp > 0) {
for (i = _global_arraylentemp - 1; i>=0; i--) {
C_TYPE swig_c_value = (*$1)[i];
SCM elt = C_TO_SCM_EXPR;
res = gh_cons(elt, res);
}
}
SWIG_APPEND_VALUE(res);
}
/* In the FREEARG typemaps, get rid of the C vector.
(This can be overridden if you want to keep the C vector.) */
%typemap(freearg) C_TYPE **PARALLEL_VECTOROUTPUT,
C_TYPE **PARALLEL_LISTOUTPUT
{
if ((*$1)!=NULL) free(*$1);
}
%enddef
%define TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, C_TO_SCM_EXPR, SCM_TYPE)
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_WITH_EXPR(C_TYPE, SCM_TO_C_EXPR, SCM_TYPE)
TYPEMAP_PARALLEL_LIST_VECTOR_OUTPUT_WITH_EXPR(C_TYPE, C_TO_SCM_EXPR, SCM_TYPE)
%enddef
%define TYPEMAP_PARALLEL_LIST_VECTOR_INPUT(C_TYPE, SCM_TO_C, SCM_TYPE)
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_WITH_EXPR
(C_TYPE, SCM_TO_C(swig_scm_value), SCM_TYPE)
%enddef
%define TYPEMAP_PARALLEL_LIST_VECTOR_OUTPUT(C_TYPE, C_TO_SCM, SCM_TYPE)
TYPEMAP_PARALLEL_LIST_VECTOR_OUTPUT_WITH_EXPR
(C_TYPE, C_TO_SCM(swig_c_value), SCM_TYPE)
%enddef
%define TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(C_TYPE, SCM_TO_C, C_TO_SCM, SCM_TYPE)
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT_WITH_EXPR
(C_TYPE, SCM_TO_C(swig_scm_value), C_TO_SCM(swig_c_value), SCM_TYPE)
%enddef
/* We use the macro to define typemaps for some standard types. */
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(bool, gh_scm2bool, gh_bool2scm, boolean);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(char, gh_scm2char, gh_char2scm, char);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(unsigned char, gh_scm2char, gh_char2scm, char);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(int, gh_scm2int, gh_int2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(short, gh_scm2int, gh_int2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(long, gh_scm2long, gh_long2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(ptrdiff_t, gh_scm2long, gh_long2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(unsigned int, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(unsigned short, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(unsigned long, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(size_t, gh_scm2ulong, gh_ulong2scm, integer);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(float, gh_scm2double, gh_double2scm, real);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(double, gh_scm2double, gh_double2scm, real);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(char *, SWIG_scm2str, gh_str02scm, string);
TYPEMAP_PARALLEL_LIST_VECTOR_INPUT_OUTPUT(const char *, SWIG_scm2str, gh_str02scm, string);

68
SWIG/Lib/guile/pointer-in-out.i Normal file
View file

@ -0,0 +1,68 @@
/* pointer-in-out.i --- Guile typemaps for passing -*- c -*- pointers indirectly
Copyright (C) 2001 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
$Header$
*/
/* Here is a macro that will define typemaps for passing C pointers indirectly.
TYPEMAP_POINTER_INPUT_OUTPUT(PTRTYPE, SCM_TYPE)
Supported calling conventions (in this example, PTRTYPE is int *):
func(int **INPUT)
Scheme wrapper will take one argument, a wrapped C pointer.
The address of a variable containing this pointer will be
passed to the function.
func(int **OUTPUT)
Scheme wrapper will take no arguments. The address of an int *
variable will be passed to the function. The function is
expected to modify the variable; its value is wrapped and
becomes an extra return value. (See the documentation on how
to deal with multiple values.)
func(int **BOTH)
func(int **INOUT)
This annotation combines INPUT and OUTPUT.
*/
%define TYPEMAP_POINTER_INPUT_OUTPUT(PTRTYPE, SCM_TYPE)
%typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE *INPUT(PTRTYPE temp)
{
if (SWIG_Guile_GetPtr($input, (void **) &temp, $*descriptor)) {
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
$1 = &temp;
}
%typemap(in, numinputs=0) PTRTYPE *OUTPUT(PTRTYPE temp)
"$1 = &temp;";
%typemap(argout, doc="<" #SCM_TYPE ">") PTRTYPE *OUTPUT
"SWIG_APPEND_VALUE(SWIG_Guile_MakePtr(*$1, $*descriptor));";
%typemap(in) PTRTYPE *BOTH = PTRTYPE *INPUT;
%typemap(argout) PTRTYPE *BOTH = PTRTYPE *OUTPUT;
%typemap(in) PTRTYPE *INOUT = PTRTYPE *INPUT;
%typemap(argout) PTRTYPE *INOUT = PTRTYPE *OUTPUT;
/* As a special convenience measure, also attach docs involving
SCM_TYPE to the standard pointer typemaps */
%typemap(in, doc="$NAME is of type <" #SCM_TYPE ">") PTRTYPE {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor))
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(out, doc="<" #SCM_TYPE ">") PTRTYPE {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
%enddef

29
SWIG/Lib/guile/ports.i
View file

@ -11,34 +11,33 @@
#endif
#include <stdio.h>
#include <errno.h>
#include <unistd.h>
%}
/* Feed FILE * arguments from file ports */
/* Feed temporary FILE * arguments from file ports */
%typemap(guile, in) FILE *
%typemap(in, doc="$NAME is a port") FILE *
{
if(!(SCM_FPORTP($source)))
scm_wrong_type_arg("$name", $argnum, $source);
if(!(SCM_FPORTP($input)))
scm_wrong_type_arg("$name", $argnum, $input);
else {
int fd;
if (SCM_OUTPUT_PORT_P($source))
scm_force_output($source);
fd=dup(SCM_FPORT_FDES($source));
if (SCM_OUTPUT_PORT_P($input))
scm_force_output($input);
fd=dup(SCM_FPORT_FDES($input));
if(fd==-1)
scm_misc_error("$name", strerror(errno), SCM_EOL);
$target=fdopen(fd,
SCM_OUTPUT_PORT_P($source)
? (SCM_INPUT_PORT_P($source)
$1=fdopen(fd,
SCM_OUTPUT_PORT_P($input)
? (SCM_INPUT_PORT_P($input)
? "rw" : "w")
: "r");
if($target==NULL)
if($1==NULL)
scm_misc_error("$name", strerror(errno), SCM_EOL);
}
}
%typemap(guile, indoc) FILE * "($arg <port>)";
%typemap(guile, freearg) FILE* {
fclose($target);
%typemap(freearg) FILE* {
fclose($1);
}

26
SWIG/Lib/guile/std_common.i Normal file
View file

@ -0,0 +1,26 @@
//
// SWIG typemaps for STL - common utilities
// Luigi Ballabio
// Aug 3, 2002
//
// Guile implementation
%{
#include <string>
SCM SWIG_bool2scm(bool b) {
int i = b ? 1 : 0;
return gh_bool2scm(i);
}
std::string SWIG_scm2string(SCM x) {
char* temp;
std::string s;
temp = gh_scm2newstr(x, NULL);
s = std::string(temp);
if (temp) scm_must_free(temp);
return s;
}
SCM SWIG_string2scm(const std::string& s) {
return gh_str02scm(s.c_str());
}
%}

58
SWIG/Lib/guile/std_string.i Normal file
View file

@ -0,0 +1,58 @@
//
// SWIG typemaps for std::string
// Luigi Ballabio
// Apr 8, 2002
//
// Guile implementation
// ------------------------------------------------------------------------
// 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
%{
#include <string>
%}
namespace std {
class string;
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string (char* tempptr) {
if (gh_string_p($input)) {
tempptr = gh_scm2newstr($input, NULL);
$1 = std::string(tempptr);
if (tempptr) scm_must_free(tempptr);
} else {
SWIG_exception(SWIG_TypeError, "string expected");
}
}
%typemap(in) const string & (std::string temp,
char* tempptr) {
if (gh_string_p($input)) {
tempptr = gh_scm2newstr($input, NULL);
temp = std::string(tempptr);
if (tempptr) scm_must_free(tempptr);
$1 = &temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
}
}
%typemap(out) string {
$result = gh_str02scm($1.c_str());
}
%typemap(out) const string & {
$result = gh_str02scm($1->c_str());
}
}

436
SWIG/Lib/guile/std_vector.i Normal file
View file

@ -0,0 +1,436 @@
//
// SWIG typemaps for std::vector
// Luigi Ballabio
// Apr 8, 2002
//
// Guile implementation
%include std_common.i
%include exception.i
%exception std::vector::ref {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::set {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::pop {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
// ------------------------------------------------------------------------
// std::vector
//
// The aim of all that follows would be to integrate std::vector with
// Guile as much as possible, namely, to allow the user to pass and
// be returned Guile vectors or lists.
// const declarations are used to guess the intent of the function being
// exported; therefore, the following rationale is applied:
//
// -- f(std::vector<T>), f(const std::vector<T>&), f(const std::vector<T>*):
// the parameter being read-only, either a Guile sequence or a
// previously wrapped std::vector<T> can be passed.
// -- f(std::vector<T>&), f(std::vector<T>*):
// the parameter must be modified; therefore, only a wrapped std::vector
// can be passed.
// -- std::vector<T> f():
// the vector is returned by copy; therefore, a Guile vector of T:s
// is returned which is most easily used in other Guile functions
// -- std::vector<T>& f(), std::vector<T>* f(), const std::vector<T>& f(),
// const std::vector<T>* f():
// the vector is returned by reference; therefore, a wrapped std::vector
// is returned
// ------------------------------------------------------------------------
%{
#include <vector>
#include <algorithm>
#include <stdexcept>
%}
// exported class
namespace std {
template<class T> class vector {
%typemap(in) vector<T> {
if (gh_vector_p($input)) {
unsigned long size = gh_vector_length($input);
$1 = std::vector<T >(size);
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref($input,gh_ulong2scm(i));
(($1_type &)$1)[i] =
*((T*) SWIG_MustGetPtr(o,$descriptor(T *),$argnum));
}
} else if (gh_null_p($input)) {
$1 = std::vector<T >();
} else if (gh_pair_p($input)) {
SCM head, tail;
$1 = std::vector<T >();
tail = $input;
while (!gh_null_p(tail)) {
head = gh_car(tail);
tail = gh_cdr(tail);
$1.push_back(*((T*)SWIG_MustGetPtr(head,
$descriptor(T *),
$argnum)));
}
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum));
}
}
%typemap(in) const vector<T>& (std::vector<T> temp),
const vector<T>* (std::vector<T> temp) {
if (gh_vector_p($input)) {
unsigned long size = gh_vector_length($input);
temp = std::vector<T >(size);
$1 = &temp;
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref($input,gh_ulong2scm(i));
temp[i] = *((T*) SWIG_MustGetPtr(o,
$descriptor(T *),
$argnum));
}
} else if (gh_null_p($input)) {
temp = std::vector<T >();
$1 = &temp;
} else if (gh_pair_p($input)) {
temp = std::vector<T >();
$1 = &temp;
SCM head, tail;
tail = $input;
while (!gh_null_p(tail)) {
head = gh_car(tail);
tail = gh_cdr(tail);
temp.push_back(*((T*) SWIG_MustGetPtr(head,
$descriptor(T *),
$argnum)));
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum);
}
}
%typemap(out) vector<T> {
$result = gh_make_vector(gh_long2scm($1.size()),SCM_UNSPECIFIED);
for (unsigned int i=0; i<$1.size(); i++) {
T* x = new T((($1_type &)$1)[i]);
gh_vector_set_x($result,gh_long2scm(i),
SWIG_MakePtr(x,$descriptor(T *)));
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
/* native sequence? */
if (gh_vector_p($input)) {
unsigned int size = gh_vector_length($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
SCM o = gh_vector_ref($input,gh_ulong2scm(0));
T* x;
if (SWIG_Guile_GetPtr(o,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
}
} else if (gh_null_p($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (gh_pair_p($input)) {
/* check the first element only */
T* x;
SCM head = gh_car($input);
if (SWIG_Guile_GetPtr(head,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_Guile_GetPtr($input,(void **) &v,
$&1_descriptor) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>* {
/* native sequence? */
if (gh_vector_p($input)) {
unsigned int size = gh_vector_length($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
SCM o = gh_vector_ref($input,gh_ulong2scm(0));
if (SWIG_Guile_GetPtr(o,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
}
} else if (gh_null_p($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (gh_pair_p($input)) {
/* check the first element only */
T* x;
SCM head = gh_car($input);
if (SWIG_Guile_GetPtr(head,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_Guile_GetPtr($input,(void **) &v,
$1_descriptor) != -1)
$1 = 1;
else
$1 = 0;
}
}
public:
vector(unsigned int size = 0);
vector(unsigned int size, const T& value);
vector(const vector<T>&);
%rename(length) size;
unsigned int size() const;
%rename("empty?") empty;
bool empty() const;
%rename("clear!") clear;
void clear();
%rename("set!") set;
%rename("pop!") pop;
%rename("push!") push_back;
void push_back(const T& x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T& ref(int i) {
int size = int(self->size());
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, const T& x) {
int size = int(self->size());
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
// specializations for built-ins
%define specialize_stl_vector(T,CHECK,CONVERT_FROM,CONVERT_TO)
template<> class vector<T> {
%typemap(in) vector<T> {
if (gh_vector_p($input)) {
unsigned long size = gh_vector_length($input);
$1 = std::vector<T >(size);
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref($input,gh_ulong2scm(i));
if (CHECK(o))
(($1_type &)$1)[i] = (T)(CONVERT_FROM(o));
else
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
} else if (gh_null_p($input)) {
$1 = std::vector<T >();
} else if (gh_pair_p($input)) {
SCM v = gh_list_to_vector($input);
unsigned long size = gh_vector_length(v);
$1 = std::vector<T >(size);
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref(v,gh_ulong2scm(i));
if (CHECK(o))
(($1_type &)$1)[i] = (T)(CONVERT_FROM(o));
else
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum));
}
}
%typemap(in) const vector<T>& (std::vector<T> temp),
const vector<T>* (std::vector<T> temp) {
if (gh_vector_p($input)) {
unsigned long size = gh_vector_length($input);
temp = std::vector<T >(size);
$1 = &temp;
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref($input,gh_ulong2scm(i));
if (CHECK(o))
temp[i] = (T)(CONVERT_FROM(o));
else
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
} else if (gh_null_p($input)) {
temp = std::vector<T >();
$1 = &temp;
} else if (gh_pair_p($input)) {
SCM v = gh_list_to_vector($input);
unsigned long size = gh_vector_length(v);
temp = std::vector<T >(size);
$1 = &temp;
for (unsigned long i=0; i<size; i++) {
SCM o = gh_vector_ref(v,gh_ulong2scm(i));
if (CHECK(o))
temp[i] = (T)(CONVERT_FROM(o));
else
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum);
}
}
%typemap(out) vector<T> {
$result = gh_make_vector(gh_long2scm($1.size()),SCM_UNSPECIFIED);
for (unsigned int i=0; i<$1.size(); i++) {
SCM x = CONVERT_TO((($1_type &)$1)[i]);
gh_vector_set_x($result,gh_long2scm(i),x);
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
/* native sequence? */
if (gh_vector_p($input)) {
unsigned int size = gh_vector_length($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
SCM o = gh_vector_ref($input,gh_ulong2scm(0));
$1 = CHECK(o) ? 1 : 0;
}
} else if (gh_null_p($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (gh_pair_p($input)) {
/* check the first element only */
T* x;
SCM head = gh_car($input);
$1 = CHECK(head) ? 1 : 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
$1 = (SWIG_Guile_GetPtr($input,(void **) &v,
$&1_descriptor) != -1) ? 1 : 0;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>* {
/* native sequence? */
if (gh_vector_p($input)) {
unsigned int size = gh_vector_length($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
SCM o = gh_vector_ref($input,gh_ulong2scm(0));
$1 = CHECK(o) ? 1 : 0;
}
} else if (gh_null_p($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (gh_pair_p($input)) {
/* check the first element only */
T* x;
SCM head = gh_car($input);
$1 = CHECK(head) ? 1 : 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
$1 = (SWIG_Guile_GetPtr($input,(void **) &v,
$1_descriptor) != -1) ? 1 : 0;
}
}
public:
vector(unsigned int size = 0);
vector(unsigned int size, const T& value);
vector(const vector<T>&);
%rename(length) size;
unsigned int size() const;
%rename("empty?") empty;
bool empty() const;
%rename("clear!") clear;
void clear();
%rename("set!") set;
%rename("pop!") pop;
%rename("push!") push_back;
void push_back(T x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T ref(int i) {
int size = int(self->size());
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, T x) {
int size = int(self->size());
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
%enddef
specialize_stl_vector(bool,gh_boolean_p,gh_scm2bool,SWIG_bool2scm);
specialize_stl_vector(int,gh_number_p,gh_scm2long,gh_long2scm);
specialize_stl_vector(long,gh_number_p,gh_scm2long,gh_long2scm);
specialize_stl_vector(short,gh_number_p,gh_scm2long,gh_long2scm);
specialize_stl_vector(unsigned int,gh_number_p,gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(unsigned long,gh_number_p,gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(unsigned short,gh_number_p,gh_scm2ulong,gh_ulong2scm);
specialize_stl_vector(float,gh_number_p,gh_scm2double,gh_double2scm);
specialize_stl_vector(double,gh_number_p,gh_scm2double,gh_double2scm);
specialize_stl_vector(std::string,gh_string_p,gh_scm2string,gh_string2scm);
}

9
SWIG/Lib/guile/stl.i Normal file
View file

@ -0,0 +1,9 @@
//
// SWIG typemaps for STL types
// Luigi Ballabio and Manu ???
// Apr 26, 2002
//
%include std_string.i
%include std_vector.i

367
SWIG/Lib/guile/typemaps.i
View file

@ -3,39 +3,235 @@
$Header$ */
/* Unlike other SWIG language modules, the Guile module handles all
non-pointer types uniformly via typemaps. Here are the
definitions.
/* (11/24/2001) Note to Matthias:
The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. */
I've replaced all of the documentation related typemaps (indoc, varindoc, outdoc, argoutdoc, ...)
with a typemap parameter of "doc". For example:
%typemap(in, doc="<integer>") int {
...
}
This is somewhat more sane to handle when multi-argument typemaps are used. For example:
%typemap(in, doc="<buffer>") (char *data, int len) {
...
}
See guile.cxx for details of how the typemap parameters actually get accessed.
Also, it's no longer necessary to specify typemaps for 'const' qualifiers. They
now get matched against non-const versions.
Feel free to delete this comment after you've read it.
--- Dave
*/
/* Pointers */
%typemap(in) SWIGTYPE * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor))
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(in) void * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL))
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(varin) SWIGTYPE * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor))
scm_wrong_type_arg(FUNC_NAME, 1, $input);
}
%typemap(varin) void * {
if (SWIG_Guile_GetPtr($input, (void **) &$1, NULL))
scm_wrong_type_arg(FUNC_NAME, 1, $input);
}
%typemap(out) SWIGTYPE * {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
%typemap(out) SWIGTYPE *DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_Guile_MakePtr ($1, ty);
}
%typemap(varout) SWIGTYPE * {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
/* Pass-by-value */
%typemap(in) SWIGTYPE($&1_ltype argp) {
if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor))
scm_wrong_type_arg(FUNC_NAME,$argnum,$input);
$1 = *argp;
}
%typemap(varin) SWIGTYPE {
$&1_ltype argp;
if (SWIG_Guile_GetPtr($input, (void **) &argp, $&1_descriptor))
scm_wrong_type_arg(FUNC_NAME,1,$input);
$1 = *argp;
}
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor);
}
#endif
%typemap(varout) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype&) $1);
$result = SWIG_Guile_MakePtr (resultptr, $&1_descriptor);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_Guile_MakePtr(resultptr, $&1_descriptor);
}
#endif
/* C++ References */
#ifdef __cplusplus
%typemap(in) SWIGTYPE &, const SWIGTYPE & {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)!=0 || $1 == NULL)
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(out) SWIGTYPE &, const SWIGTYPE & {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
%typemap(out) SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_Guile_MakePtr ($1, ty);
}
#endif
/* Arrays */
%typemap(in) SWIGTYPE[] {
if (SWIG_Guile_GetPtr($input, (void **) &$1, $descriptor)!=0)
scm_wrong_type_arg(FUNC_NAME, $argnum, $input);
}
%typemap(out) SWIGTYPE[] {
$result = SWIG_Guile_MakePtr ($1, $descriptor);
}
/* Enums */
%typemap(in) enum SWIGTYPE "$1 = gh_scm2int($input);";
%typemap(varin) enum SWIGTYPE "$1 = ($1_type) gh_scm2int($input);";
%typemap(out) enum SWIGTYPE "$result = gh_int2scm($1);";
%typemap(varout) enum SWIGTYPE "$result = gh_int2scm($1);";
/* The SIMPLE_MAP_WITH_EXPR macro below defines the whole set of
typemaps needed for simple types.
-- SCM_TO_C_EXPR is a C expression that translates the Scheme value
"swig_scm_value" to a C value.
-- C_TO_SCM_EXPR is a C expression that translates the C value
"swig_c_value" to a Scheme value. */
%define SIMPLE_MAP_WITH_EXPR(C_NAME, SCM_TO_C_EXPR, C_TO_SCM_EXPR, SCM_NAME)
%typemap (in, doc="$NAME is of type <" #SCM_NAME ">") C_NAME
{ SCM swig_scm_value = $input;
$1 = SCM_TO_C_EXPR; }
%typemap (varin, doc="NEW-VALUE is of type <" #SCM_NAME ">") C_NAME
{ SCM swig_scm_value = $input;
$1 = SCM_TO_C_EXPR; }
%typemap (out, doc="<" #SCM_NAME ">") C_NAME
{ C_NAME swig_c_value = $1;
$result = C_TO_SCM_EXPR; }
%typemap (varout, doc="<" #SCM_NAME ">") C_NAME
{ C_NAME swig_c_value = $1;
$result = C_TO_SCM_EXPR; }
/* INPUT and OUTPUT */
%typemap (in, doc="$NAME is of type <" #SCM_NAME ">)")
C_NAME *INPUT(C_NAME temp) {
SCM swig_scm_value = $input;
temp = (C_NAME) SCM_TO_C_EXPR; $1 = &temp; }
%typemap (in,numinputs=0) C_NAME *OUTPUT (C_NAME temp)
{$1 = &temp;}
%typemap (argout,doc="$name (of type <" #SCM_NAME ">)") C_NAME *OUTPUT
{ C_NAME swig_c_value = *$1;
SWIG_APPEND_VALUE(C_TO_SCM_EXPR); }
%typemap (in) C_NAME *BOTH = C_NAME *INPUT;
%typemap (argout) C_NAME *BOTH = C_NAME *OUTPUT;
%typemap (in) C_NAME *INOUT = C_NAME *INPUT;
%typemap (argout) C_NAME *INOUT = C_NAME *OUTPUT;
/* Const primitive references. Passed by value */
%typemap(in, doc="$NAME is of type <" #SCM_NAME ">") const C_NAME & (C_NAME temp)
{ SCM swig_scm_value = $input;
temp = SCM_TO_C_EXPR;
$1 = &temp; }
%typemap(out, doc="<" #SCM_NAME ">") const C_NAME &
{ C_NAME swig_c_value = *$1;
$result = C_TO_SCM_EXPR; }
%enddef
/* The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. It generates slightly simpler code than the
macro above, but it is only suitable for very simple conversion
expressions. */
%define SIMPLE_MAP(C_NAME, SCM_TO_C, C_TO_SCM, SCM_NAME)
%typemap (guile, in) C_NAME "$target = SCM_TO_C($source);";
%typemap (guile, varin) C_NAME "$target = SCM_TO_C($source);";
%typemap (guile, out) C_NAME "$target = C_TO_SCM($source);";
%typemap (guile, varout) C_NAME "$target = C_TO_SCM($source);";
%typemap (guile, indoc) C_NAME "($arg <SCM_NAME>)";
%typemap (guile, varindoc) C_NAME "($arg <SCM_NAME>)";
%typemap (guile, outdoc) C_NAME "<SCM_NAME>";
%typemap (guile, varoutdoc) C_NAME "<SCM_NAME>";
%typemap (guile, in) C_NAME *INPUT (C_NAME temp)
"temp = (C_NAME) C_TO_SCM($source); $target = &temp;"
%typemap (guile, indoc) C_NAME *INPUT "($arg <SCM_NAME>)";
%typemap (guile, ignore) C_NAME *OUTPUT (C_NAME temp)
"$target = &temp;"
%typemap (guile, argout) C_NAME *OUTPUT
"GUILE_APPEND_RESULT(C_TO_SCM(*$target));";
%typemap (guile, argoutdoc) C_NAME *OUTPUT "($arg <SCM_NAME>)";
%typemap (guile, in) C_NAME *BOTH = C_NAME *INPUT;
%typemap (guile, indoc) C_NAME *BOTH = C_NAME *INPUT;
%typemap (guile, argout) C_NAME *BOTH = C_NAME *OUTPUT;
%typemap (guile, argoutdoc) C_NAME *BOTH = C_NAME *OUTPUT;
%typemap (in, doc="$NAME is of type <" #SCM_NAME ">")
C_NAME {$1 = SCM_TO_C($input);}
%typemap (varin, doc="NEW-VALUE is of type <" #SCM_NAME ">")
C_NAME {$1 = SCM_TO_C($input);}
%typemap (out, doc="<" #SCM_NAME ">")
C_NAME {$result = C_TO_SCM($1);}
%typemap (varout, doc="<" #SCM_NAME ">")
C_NAME {$result = C_TO_SCM($1);}
/* INPUT and OUTPUT */
%typemap (in, doc="$NAME is of type <" #SCM_NAME ">)")
C_NAME *INPUT(C_NAME temp) {
temp = (C_NAME) SCM_TO_C($input); $1 = &temp;
}
%typemap (in,numinputs=0) C_NAME *OUTPUT (C_NAME temp)
{$1 = &temp;}
%typemap (argout,doc="$name (of type <" #SCM_NAME ">)") C_NAME *OUTPUT
{SWIG_APPEND_VALUE(C_TO_SCM(*$1));}
%typemap (in) C_NAME *BOTH = C_NAME *INPUT;
%typemap (argout) C_NAME *BOTH = C_NAME *OUTPUT;
%typemap (in) C_NAME *INOUT = C_NAME *INPUT;
%typemap (argout) C_NAME *INOUT = C_NAME *OUTPUT;
/* Const primitive references. Passed by value */
%typemap(in, doc="$NAME is of type <" #SCM_NAME ">") const C_NAME & (C_NAME temp) {
temp = SCM_TO_C($input);
$1 = &temp;
}
%typemap(out, doc="<" #SCM_NAME ">") const C_NAME & {
$result = C_TO_SCM(*$1);
}
%enddef
SIMPLE_MAP(bool, gh_scm2bool, gh_bool2scm, boolean);
SIMPLE_MAP(char, GSWIG_scm2char, gh_char2scm, char);
SIMPLE_MAP(unsigned char, GSWIG_scm2char, gh_char2scm, char);
SIMPLE_MAP(char, gh_scm2char, gh_char2scm, char);
SIMPLE_MAP(unsigned char, gh_scm2char, gh_char2scm, char);
SIMPLE_MAP(int, gh_scm2int, gh_int2scm, integer);
SIMPLE_MAP(short, gh_scm2int, gh_int2scm, integer);
SIMPLE_MAP(long, gh_scm2long, gh_long2scm, integer);
@ -46,17 +242,122 @@
SIMPLE_MAP(size_t, gh_scm2ulong, gh_ulong2scm, integer);
SIMPLE_MAP(float, gh_scm2double, gh_double2scm, real);
SIMPLE_MAP(double, gh_scm2double, gh_double2scm, real);
SIMPLE_MAP(char *, GSWIG_scm2str, gh_str02scm, string);
SIMPLE_MAP(const char *, GSWIG_scm2str, gh_str02scm, string);
// SIMPLE_MAP(char *, SWIG_scm2str, gh_str02scm, string);
// SIMPLE_MAP(const char *, SWIG_scm2str, gh_str02scm, string);
/* Strings */
%typemap (in, doc="$NAME is a string") char *(int must_free = 0) {
$1 = SWIG_scm2str($input);
must_free = 1;
}
%typemap (varin, doc="NEW-VALUE is a string") char * {$1 = SWIG_scm2str($input);}
%typemap (out, doc="<string>") char * {$result = gh_str02scm($1);}
%typemap (varout, doc="<string>") char * {$result = gh_str02scm($1);}
%typemap (in, doc="$NAME is a string") char * *INPUT(char * temp, int must_free = 0) {
temp = (char *) SWIG_scm2str($input); $1 = &temp;
must_free = 1;
}
%typemap (in,numinputs=0) char * *OUTPUT (char * temp)
{$1 = &temp;}
%typemap (argout,doc="$NAME (a string)") char * *OUTPUT
{SWIG_APPEND_VALUE(gh_str02scm(*$1));}
%typemap (in) char * *BOTH = char * *INPUT;
%typemap (argout) char * *BOTH = char * *OUTPUT;
%typemap (in) char * *INOUT = char * *INPUT;
%typemap (argout) char * *INOUT = char * *OUTPUT;
/* GSWIG_scm2str makes a malloc'ed copy of the string, so get rid of it after
the function call. */
%typemap (guile, freearg) char *, const char * "if ($target) scm_must_free($target);";
%typemap (freearg) char * "if (must_free$argnum && $1) scm_must_free($1);";
%typemap (freearg) char **INPUT, char **BOTH "if (must_free$argnum && (*$1)) scm_must_free(*$1);"
%typemap (freearg) char **OUTPUT "scm_must_free(*$1);"
/* But this shall not apply if we try to pass a single char by
reference. */
%typemap (freearg) char *OUTPUT, char *BOTH "";
/* If we set a string variable, delete the old result first. */
%typemap (varin) char * {
if ($1) free($1);
$1 = SWIG_scm2str($input);
}
/* Void */
%typemap (guile, out) void "gswig_result = GH_UNSPECIFIED;";
%typemap (guile, outdoc) void "";
%typemap (out,doc="") void "gswig_result = GH_UNSPECIFIED;";
/* SCM is passed through */
typedef unsigned long SCM;
%typemap (in) SCM "$1=$input;";
%typemap (out) SCM "$result=$1;";
/* Some ANSI C typemaps */
%apply long { size_t };
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH) {
size_t temp;
$1 = ($1_ltype) gh_scm2newstr($input, &temp);
$2 = ($2_ltype) temp;
}
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
/* adapted from python.swg */
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short, long,
unsigned int, unsigned short, unsigned long,
signed char, unsigned char,
long long, unsigned long long,
const int &, const short &, const long &,
const unsigned int &, const unsigned short &, const unsigned long &,
const long long &, const unsigned long long &,
enum SWIGTYPE,
bool, const bool &
{
$1 = SCM_NFALSEP(scm_integer_p($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = SCM_NFALSEP(scm_real_p($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
$1 = SCM_CHARP($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = SCM_STRINGP($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr;
$1 = !SWIG_Guile_GetPtr($input, &ptr, $1_descriptor);
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
$1 = !SWIG_Guile_GetPtr($input, &ptr, 0);
}
/* typemaps.i ends here */