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/SWIG@4141 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2002-11-30 22:01:28 +00:00
commit 12a43edc2d
1508 changed files with 125983 additions and 44037 deletions
Download patch file Download diff file Expand all files Collapse all files

26
Lib/mzscheme/mzscheme.i Normal file
View file

@ -0,0 +1,26 @@
/* SWIG Configuration File for MzScheme. -*-c-*-
This file is parsed by SWIG before reading any other interface
file. */
/* Include headers */
%insert(runtime) "mzschemedec.swg"
/*#ifndef SWIG_NOINCLUDE*/
%insert(runtime) "mzscheme.swg"
/*#endif*/
%define SWIG_APPEND_VALUE(value)
values[lenv++] = value
%enddef
/* Definitions */
#define SWIG_malloc(size) swig_malloc(size, FUNC_NAME)
#define SWIG_free(mem) free(mem)
/* Guile compatibility kludges */
#define SCM_VALIDATE_VECTOR(argnum, value) (void)0
#define SCM_VALIDATE_LIST(argnum, value) (void)0
/* Read in standard typemaps. */
%include "typemaps.i"

279
Lib/mzscheme/mzscheme.swg
View file

@ -1,29 +1,270 @@
#include <escheme.h>
/* -*-c-*- */
typedef struct swig_proxy {
/* SWIG pointer structure */
#ifdef __cplusplus
extern "C" {
#endif
struct SwigCast {
struct SwigPtrType *type; /* Type in SwigPtrTbl */
void *(*cast)(void *); /* Pointer casting function */
struct SwigCast *next; /* Linked list pointer */
};
struct SwigPtrType {
const char *name; /* Datatype name */
const char *prettyname; /* Pretty datatype name */
struct SwigCast *cast; /* List of compatible types */
};
struct swig_proxy {
Scheme_Type type;
SwigPtrType *ptrtype;
void *object;
} swig_proxy;
};
static Scheme_Object *swig_make_c_pointer(void *c_pointer, char *type_name) {
swig_proxy *new_proxy;
new_proxy = (swig_proxy *) scheme_malloc(sizeof(swig_proxy));
new_proxy->type = scheme_make_type(type_name);
/* Pointer table */
static SwigPtrType **SwigPtrTbl = 0; /* Sorted table */
static int SwigPtrMax = 64; /* Max entries that can be held */
/* (may be adjusted dynamically) */
static int SwigPtrN = 0; /* Current number of entries */
static int SwigPtrSort = 0; /* Status flag indicating sort */
/* Sort comparison function */
static int
swigsort (const void *data1, const void *data2)
{
SwigPtrType *type1 = * (SwigPtrType **) data1;
SwigPtrType *type2 = * (SwigPtrType **) data2;
return strcmp(type1->name, type2->name);
}
/* Register a new datatype with the type-checker */
SWIGSTATIC SwigPtrType *
SWIG_RegisterType (const char *type, const char *prettyname)
{
int i;
struct SwigPtrType **t;
/* Allocate the pointer table if necessary */
if (!SwigPtrTbl) {
SwigPtrTbl = (SwigPtrType **) malloc(SwigPtrMax*sizeof(SwigPtrType *));
SwigPtrN = 0;
}
/* Grow the table if necessary */
if (SwigPtrN >= SwigPtrMax) {
SwigPtrMax = 2*SwigPtrMax;
SwigPtrTbl = (SwigPtrType **) realloc((char *) SwigPtrTbl,
SwigPtrMax*sizeof(SwigPtrType *));
}
/* Look up type */
for (i = 0; i < SwigPtrN; i++)
if (strcmp(SwigPtrTbl[i]->name,type) == 0) {
if (prettyname!=NULL)
SwigPtrTbl[i]->prettyname = prettyname;
return SwigPtrTbl[i];
}
t = SwigPtrTbl + SwigPtrN;
*t = (SwigPtrType *) malloc(sizeof(SwigPtrType));
(*t)->name = type;
(*t)->prettyname = prettyname;
(*t)->cast = NULL;
SwigPtrN++;
SwigPtrSort = 0;
return *t;
}
/* Register two data types and their mapping with the type checker. */
SWIGSTATIC void
SWIG_RegisterMapping (const char *origtype, const char *newtype, void *(*cast)(void *))
{
struct SwigPtrType *t = SWIG_RegisterType(origtype, NULL);
if (newtype!=NULL) {
struct SwigPtrType *t1 = SWIG_RegisterType(newtype, NULL);
struct SwigCast *c;
/* Check for existing cast */
for (c = t->cast; c && c->type!=t1; c=c->next) /* nothing */;
if (c) {
if (cast) c->cast = cast;
}
else {
c = (struct SwigCast *) malloc(sizeof(struct SwigCast));
c->type = t1;
c->cast = cast;
c->next = t->cast;
t->cast = c;
}
}
}
/* Sort table */
static void
SWIG_SortTable (void)
{
qsort ((void *) SwigPtrTbl, SwigPtrN, sizeof(struct SwigPtrTbl *), swigsort);
/* Indicate that everything is sorted */
SwigPtrSort = 1;
}
/* Look up pointer-type entry in table */
static int
swigcmp (const void *key, const void *data)
{
char *k = (char *) key;
SwigPtrType *t = *(SwigPtrType **) data;
return strcmp(k, t->name);
}
static SwigPtrType *
SWIG_GetPtrType (const char *_t)
{
SwigPtrType **result;
if (!SwigPtrSort) SWIG_SortTable();
result = (SwigPtrType **) bsearch(_t, SwigPtrTbl, SwigPtrN,
sizeof(SwigPtrType *), swigcmp);
if (result!=NULL) return *result;
else return NULL;
}
/* Cast a pointer if possible; returns 1 if successful */
static int
SWIG_Cast (void *source, SwigPtrType *source_type,
void **ptr, SwigPtrType *dest_type)
{
if (dest_type != source_type) {
/* We have a type mismatch. Will have to look through our type
mapping table to figure out whether or not we can accept this
datatype. */
struct SwigCast *c;
for (c = dest_type->cast;
c && c->type!=source_type; c = c->next) /* nothing */;
if (c) {
/* Get pointer value. */
if (c->cast) *ptr = (*(c->cast))(source);
else *ptr = source;
return -1;
}
/* Didn't find any sort of match for this data.
Get the pointer value and return false. */
*ptr = source;
return 0;
} else {
/* Found a match on the first try. Return pointer value. */
*ptr = source;
return -1;
}
}
/* Function for getting a pointer value */
static Scheme_Type swig_type;
int swig_initialized_p = 0;
SWIGSTATIC Scheme_Object *
SWIG_MakePtr(void *c_pointer, swig_type_info *type) {
struct swig_proxy *new_proxy;
new_proxy = (struct swig_proxy *) scheme_malloc(sizeof(struct swig_proxy));
new_proxy->type = swig_type;
new_proxy->ptrtype = type->ptrtype;
new_proxy->object = (void *) c_pointer;
return (Scheme_Object *) new_proxy;
}
/* returns 1 on success, 0 otherwise */
static int swig_get_c_pointer(Scheme_Object *so, char *c_type, void **c_ptr) {
Scheme_Type st = SCHEME_TYPE(so);
char *type_name = scheme_get_type_name(st);
int err = 1;
if(strcmp(type_name, c_type))
err = 0;
else
*c_ptr = ((swig_proxy *) so)->object;
return err;
/* Return 0 if successful. */
SWIGSTATIC int
SWIG_GetPtr(Scheme_Object *s, void **result, swig_type_info *type)
{
if (SCHEME_NULLP(s)) {
*result = NULL;
return 0;
}
else if (SCHEME_TYPE(s) == swig_type) {
struct swig_proxy *proxy = (struct swig_proxy *) s;
if (type) {
return !SWIG_Cast(proxy->object, proxy->ptrtype,
result, type->ptrtype);
}
else {
*result = proxy->object;
return 0;
}
}
return -1;
}
SWIGSTATIC void *
SWIG_MustGetPtr_ (Scheme_Object *s, swig_type_info *type,
int argnum, const char *func_name,
int argc, Scheme_Object **argv)
{
void *result;
if (SWIG_GetPtr(s, &result, type) != 0) {
/* type mismatch */
scheme_wrong_type(func_name, type->str ? type->str : "void *", argnum, argc, argv);
}
return result;
}
SWIGSTATIC
void SWIG_RegisterTypes(swig_type_info **table,
swig_type_info **init)
{
if (!swig_initialized_p) {
swig_type = scheme_make_type((char *) "swig");
swig_initialized_p = 1;
}
for (; *init; table++, init++) {
swig_type_info *type = *table = *init;
const char *origname = type->name;
/* Register datatype itself and store pointer back */
type->ptrtype = SWIG_RegisterType(origname, type->str);
/* Register compatible types */
for (type++; type->name; type++)
SWIG_RegisterMapping(origname, type->name, type->converter);
}
}
/* 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;
}
static Scheme_Object *
swig_package_values(int num, Scheme_Object **values)
{
/* ignore first value if void */
if (num > 0 && SCHEME_VOIDP(values[0]))
num--, values++;
if (num == 0) return scheme_void;
else if (num == 1) return values[0];
else return scheme_values(num, values);
}
static void *
swig_malloc(size_t size, const char *func_name)
{
void *p = malloc(size);
if (p == NULL) {
scheme_signal_error("swig-memory-error");
}
else return p;
}
#ifdef __cplusplus
}
#endif

84
Lib/mzscheme/mzschemedec.swg Normal file
View file

@ -0,0 +1,84 @@
/* -*-c-*-
* -----------------------------------------------------------------------
* swig_lib/mzscheme/mzschemedec.swg
* Copyright (C) 2000, 2001 Matthias Koeppe
*
* MzScheme runtime code -- declarations
* ----------------------------------------------------------------------- */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <escheme.h>
#if defined(SWIG_NOINCLUDE)
# define SWIGSTATIC
#elif defined(SWIG_GLOBAL)
# define SWIGSTATIC
#else
# define SWIGSTATIC static
#endif
#ifdef __cplusplus
extern "C" {
#endif
#define MAXVALUES 6
static Scheme_Object *
swig_make_boolean(int b)
{
if (b) return scheme_true;
else return scheme_false;
}
static Scheme_Object *
swig_package_values(int num, Scheme_Object **values);
typedef struct SwigPtrType SwigPtrType;
typedef struct swig_type_info *(*swig_dycast_func)(void **);
typedef struct swig_type_info {
const char *name;
void *(*converter)(void *);
const char *str;
void *clientdata;
SwigPtrType *ptrtype;
swig_dycast_func dcast;
} swig_type_info;
SWIGSTATIC SwigPtrType *
SWIG_RegisterType (const char *type, const char *prettyname);
SWIGSTATIC void
SWIG_RegisterMapping (const char *origtype, const char *newtype, void *(*cast)(void *));
/* Dynamic pointer casting. Down an inheritance hierarchy */
SWIGSTATIC swig_type_info *
SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr);
SWIGSTATIC Scheme_Object *
SWIG_MakePtr(void *c_pointer, swig_type_info *type);
SWIGSTATIC int
SWIG_GetPtr(Scheme_Object *s, void **result, swig_type_info *type);
SWIGSTATIC void *
SWIG_MustGetPtr_ (Scheme_Object *s, swig_type_info *type,
int argnum, const char *func_name,
int argc, Scheme_Object **argv);
#define SWIG_MustGetPtr(s, type, argnum) \
SWIG_MustGetPtr_(s, type, argnum, FUNC_NAME, argc, argv)
SWIGSTATIC
void SWIG_RegisterTypes(swig_type_info **table,
swig_type_info **init);
#ifdef __cplusplus
}
#endif
/* mzschemedec.swg ends here */

17
Lib/mzscheme/std_common.i Normal file
View file

@ -0,0 +1,17 @@
//
// SWIG typemaps for STL - common utilities
// Luigi Ballabio
// Aug 3, 2002
//
// MzScheme implementation
%{
#include <string>
std::string swig_scm_to_string(Scheme_Object* x) {
return std::string(SCHEME_STR_VAL(x));
}
Scheme_Object* swig_make_string(const std::string& s) {
return scheme_make_string(s.c_str());
}
%}

56
Lib/mzscheme/std_string.i Normal file
View file

@ -0,0 +1,56 @@
//
// SWIG typemaps for std::string types
// Luigi Ballabio
// Apr 8, 2002
//
// MzScheme 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;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string {
if (SCHEME_STRINGP($input))
$1 = std::string(SCHEME_STR_VAL($input));
else
SWIG_exception(SWIG_TypeError, "string expected");
}
%typemap(in) const string & (std::string temp) {
if (SCHEME_STRINGP($input)) {
temp = std::string(SCHEME_STR_VAL($input));
$1 = &temp;
} else {
SWIG_exception(SWIG_TypeError, "string expected");
}
}
%typemap(out) string {
$result = scheme_make_string($1.c_str());
}
%typemap(out) const string & {
$result = scheme_make_string($1->c_str());
}
}

460
Lib/mzscheme/std_vector.i Normal file
View file

@ -0,0 +1,460 @@
//
// SWIG typemaps for std::vector
// Luigi Ballabio
// Apr 8, 2002
//
// MzScheme implementation
%include std_common.i
%include exception.i
// containers
%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
// MzScheme as much as possible, namely, to allow the user to pass and
// be returned MzScheme 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 MzScheme 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 MzScheme vector of T:s
// is returned which is most easily used in other MzScheme 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 (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
$1 = std::vector<T >(size);
Scheme_Object** items = SCHEME_VEC_ELS($input);
for (unsigned int i=0; i<size; i++) {
(($1_type &)$1)[i] =
*((T*) SWIG_MustGetPtr(items[i],
$descriptor(T *),
$argnum));
}
} else if (SCHEME_NULLP($input)) {
$1 = std::vector<T >();
} else if (SCHEME_PAIRP($input)) {
Scheme_Object *head, *tail;
$1 = std::vector<T >();
tail = $input;
while (!SCHEME_NULLP(tail)) {
head = scheme_car(tail);
tail = scheme_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 (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
temp = std::vector<T >(size);
$1 = &temp;
Scheme_Object** items = SCHEME_VEC_ELS($input);
for (unsigned int i=0; i<size; i++) {
temp[i] = *((T*) SWIG_MustGetPtr(items[i],
$descriptor(T *),
$argnum));
}
} else if (SCHEME_NULLP($input)) {
temp = std::vector<T >();
$1 = &temp;
} else if (SCHEME_PAIRP($input)) {
temp = std::vector<T >();
$1 = &temp;
Scheme_Object *head, *tail;
tail = $input;
while (!SCHEME_NULLP(tail)) {
head = scheme_car(tail);
tail = scheme_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 = scheme_make_vector($1.size(),scheme_undefined);
Scheme_Object** els = SCHEME_VEC_ELS($result);
for (unsigned int i=0; i<$1.size(); i++) {
T* x = new T((($1_type &)$1)[i]);
els[i] = SWIG_MakePtr(x,$descriptor(T *));
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
/* native sequence? */
if (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
Scheme_Object** items = SCHEME_VEC_ELS($input);
if (SWIG_GetPtr(items[0],(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
}
} else if (SCHEME_NULLP($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
T* x;
Scheme_Object *head = scheme_car($input);
if (SWIG_GetPtr(head,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_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 (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
Scheme_Object** items = SCHEME_VEC_ELS($input);
if (SWIG_GetPtr(items[0],(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
}
} else if (SCHEME_NULLP($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
T* x;
Scheme_Object *head = scheme_car($input);
if (SWIG_GetPtr(head,(void**) &x,
$descriptor(T *)) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_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_std_vector(T,CHECK,CONVERT_FROM,CONVERT_TO)
template<> class vector<T> {
%typemap(in) vector<T> {
if (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
$1 = std::vector<T >(size);
Scheme_Object** items = SCHEME_VEC_ELS($input);
for (unsigned int i=0; i<size; i++) {
Scheme_Object* o = items[i];
if (CHECK(o))
(($1_type &)$1)[i] = (T)(CONVERT_FROM(o));
else
scheme_wrong_type(FUNC_NAME, "vector<" #T ">",
$argnum, argc, argv);
}
} else if (SCHEME_NULLP($input)) {
$1 = std::vector<T >();
} else if (SCHEME_PAIRP($input)) {
Scheme_Object *head, *tail;
$1 = std::vector<T >();
tail = $input;
while (!SCHEME_NULLP(tail)) {
head = scheme_car(tail);
tail = scheme_cdr(tail);
if (CHECK(head))
$1.push_back((T)(CONVERT_FROM(head)));
else
scheme_wrong_type(FUNC_NAME, "vector<" #T ">",
$argnum, argc, argv);
}
} 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 (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
temp = std::vector<T >(size);
$1 = &temp;
Scheme_Object** items = SCHEME_VEC_ELS($input);
for (unsigned int i=0; i<size; i++) {
Scheme_Object* o = items[i];
if (CHECK(o))
temp[i] = (T)(CONVERT_FROM(o));
else
scheme_wrong_type(FUNC_NAME, "vector<" #T ">",
$argnum, argc, argv);
}
} else if (SCHEME_NULLP($input)) {
temp = std::vector<T >();
$1 = &temp;
} else if (SCHEME_PAIRP($input)) {
temp = std::vector<T >();
$1 = &temp;
Scheme_Object *head, *tail;
tail = $input;
while (!SCHEME_NULLP(tail)) {
head = scheme_car(tail);
tail = scheme_cdr(tail);
if (CHECK(head))
temp.push_back((T)(CONVERT_FROM(head)));
else
scheme_wrong_type(FUNC_NAME, "vector<" #T ">",
$argnum, argc, argv);
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum);
}
}
%typemap(out) vector<T> {
$result = scheme_make_vector($1.size(),scheme_undefined);
Scheme_Object** els = SCHEME_VEC_ELS($result);
for (unsigned int i=0; i<$1.size(); i++)
els[i] = CONVERT_TO((($1_type &)$1)[i]);
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
/* native sequence? */
if (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
Scheme_Object** items = SCHEME_VEC_ELS($input);
$1 = CHECK(items[0]) ? 1 : 0;
}
} else if (SCHEME_NULLP($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
T* x;
Scheme_Object *head = scheme_car($input);
$1 = CHECK(head) ? 1 : 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
$1 = (SWIG_GetPtr($input,(void **) &v,
$&1_descriptor) != -1) ? 1 : 0;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>* {
/* native sequence? */
if (SCHEME_VECTORP($input)) {
unsigned int size = SCHEME_VEC_SIZE($input);
if (size == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* x;
Scheme_Object** items = SCHEME_VEC_ELS($input);
$1 = CHECK(items[0]) ? 1 : 0;
}
} else if (SCHEME_NULLP($input)) {
/* again, an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
T* x;
Scheme_Object *head = scheme_car($input);
$1 = CHECK(head) ? 1 : 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
$1 = (SWIG_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_std_vector(bool,SCHEME_BOOLP,SCHEME_TRUEP,\
swig_make_boolean);
specialize_std_vector(int,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(short,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(long,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(unsigned int,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(unsigned short,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(unsigned long,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
specialize_std_vector(float,SCHEME_REALP,scheme_real_to_double,\
scheme_make_double);
specialize_std_vector(double,SCHEME_REALP,scheme_real_to_double,\
scheme_make_double);
specialize_std_vector(std::string,SCHEME_STRINGP,swig_scm_to_string,\
swig_make_string);
}

9
Lib/mzscheme/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

978
Lib/mzscheme/typemaps.i
View file

@ -1,673 +1,343 @@
/*
--------------------------------------------------
argout typemaps
convert arguments from C to Scheme
--------------------------------------------------
*/
/* typemaps.i --- mzscheme typemaps -*- c -*-
Copyright 2000, 2001 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
Based on code written by Oleg Tolmatcev.
%{
#define MAXVALUES 6
%}
$Id$
*/
%typemap(mzscheme, argout)
int *M_OUTPUT,
unsigned int *M_OUTPUT,
short *M_OUTPUT,
unsigned short *M_OUTPUT
/* The MzScheme module handles all types uniformly via typemaps. Here
are the definitions. */
/* Pointers */
%typemap(in) SWIGTYPE * {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum);
}
%typemap(in) void * {
$1 = SWIG_MustGetPtr($input, NULL, $argnum);
}
%typemap(varin) SWIGTYPE * {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, 1);
}
%typemap(varin) void * {
$1 = SWIG_MustGetPtr($input, NULL, 1);
}
%typemap(out) SWIGTYPE * {
$result = SWIG_MakePtr ($1, $descriptor);
}
%typemap(out) SWIGTYPE *DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_MakePtr ($1, ty);
}
%typemap(varout) SWIGTYPE * {
$result = SWIG_MakePtr ($1, $descriptor);
}
/* C++ References */
#ifdef __cplusplus
%typemap(in) SWIGTYPE &, const SWIGTYPE & {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum);
if ($1 == NULL) scheme_signal_error("swig-type-error (null reference)");
}
%typemap(out) SWIGTYPE &, const SWIGTYPE & {
$result = SWIG_MakePtr ($1, $descriptor);
}
%typemap(out) SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_MakePtr ($1, ty);
}
#endif
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
Scheme_Object *s;
s = scheme_make_integer(*$target);
m_output_helper(_values, s, &_lenv);
}
%typemap(mzscheme, argout)
long *M_OUTPUT
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_MakePtr (resultptr, $&1_descriptor);
}
#else
{
Scheme_Object *s;
s = scheme_make_integer_value(*$target);
m_output_helper(_values, s, &_lenv);
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_MakePtr(resultptr, $&1_descriptor);
}
#endif
/* Arrays */
%typemap(in) SWIGTYPE[] {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum);
}
%typemap(out) SWIGTYPE[] {
$result = SWIG_MakePtr ($1, $descriptor);
}
/* Enums */
%typemap(in) enum SWIGTYPE {
if (!SCHEME_INTP($input))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$1 = SCHEME_INT_VAL($input);
}
%typemap(varin) enum SWIGTYPE {
if (!SCHEME_INTP($input))
scheme_wrong_type("$name", "integer", 1, argc, argv);
$1 = ($1_type) SCHEME_INT_VAL($input);
}
%typemap(out) enum SWIGTYPE "$result = scheme_make_integer_value($1);";
%typemap(varout) enum SWIGTYPE "$result = scheme_make_integer_value($1);";
/* Pass-by-value */
%typemap(in) SWIGTYPE($&1_ltype argp) {
argp = ($&1_ltype) SWIG_MustGetPtr($input, $&1_descriptor, $argnum);
$1 = *argp;
}
%typemap(varin) SWIGTYPE {
$&1_ltype argp;
argp = ($&1_ltype) SWIG_MustGetPtr($input, $&1_descriptor, 1);
$1 = *argp;
}
%typemap(mzscheme, argout)
unsigned long *M_OUTPUT
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
Scheme_Object *s;
s = scheme_make_integer_value_from_unsigned(*$target);
m_output_helper(_values, s, &_lenv);
}
%typemap(mzscheme, argout)
char *M_OUTPUT,
unsigned char *M_OUTPUT
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_MakePtr (resultptr, $&1_descriptor);
}
#else
{
Scheme_Object *s;
s = scheme_make_string_without_copying(*$target);
m_output_helper(_values, s, &_lenv);
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_MakePtr(resultptr, $&1_descriptor);
}
#endif
%typemap(mzscheme, argout)
float *M_OUTPUT,
double *M_OUTPUT
%typemap(varout) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
$result = SWIG_MakePtr (resultptr, $&1_descriptor);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_MakePtr(resultptr, $&1_descriptor);
}
#endif
/* The SIMPLE_MAP macro below defines the whole set of typemaps needed
for simple types. */
%define SIMPLE_MAP(C_NAME, MZ_PREDICATE, MZ_TO_C, C_TO_MZ, MZ_NAME)
%typemap(in) C_NAME {
if (!MZ_PREDICATE($input))
scheme_wrong_type("$name", #MZ_NAME, $argnum, argc, argv);
$1 = MZ_TO_C($input);
}
%typemap(varin) C_NAME {
if (!MZ_PREDICATE($input))
scheme_wrong_type("$name", #MZ_NAME, 1, argc, argv);
$1 = MZ_TO_C($input);
}
%typemap(out) C_NAME {
$result = C_TO_MZ($1);
}
%typemap(varout) C_NAME {
$result = C_TO_MZ($1);
}
%typemap(in) C_NAME *INPUT (C_NAME temp) {
temp = (C_NAME) MZ_TO_C($input);
$1 = &temp;
}
%typemap(in,numinputs=0) C_NAME *OUTPUT (C_NAME temp) {
$1 = &temp;
}
%typemap(argout) C_NAME *OUTPUT {
Scheme_Object *s;
s = scheme_make_double(*$target);
m_output_helper(_values, s, &_lenv);
s = C_TO_MZ(*$1);
SWIG_APPEND_VALUE(s);
}
%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;
%enddef
SIMPLE_MAP(bool, SCHEME_BOOLP, SCHEME_TRUEP,
swig_make_boolean, boolean);
SIMPLE_MAP(char, SCHEME_CHARP, SCHEME_CHAR_VAL,
scheme_make_character, character);
SIMPLE_MAP(unsigned char, SCHEME_CHARP, SCHEME_CHAR_VAL,
scheme_make_character, character);
SIMPLE_MAP(int, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
SIMPLE_MAP(short, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
SIMPLE_MAP(long, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
SIMPLE_MAP(ptrdiff_t, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
SIMPLE_MAP(unsigned int, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(unsigned short, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(unsigned long, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(size_t, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(float, SCHEME_REALP, scheme_real_to_double,
scheme_make_double, real);
SIMPLE_MAP(double, SCHEME_REALP, scheme_real_to_double,
scheme_make_double, real);
SIMPLE_MAP(char *, SCHEME_STRINGP, SCHEME_STR_VAL,
scheme_make_string_without_copying, string);
SIMPLE_MAP(const char *, SCHEME_STRINGP, SCHEME_STR_VAL,
scheme_make_string_without_copying, string);
/* Const primitive references. Passed by value */
%define REF_MAP(C_NAME, MZ_PREDICATE, MZ_TO_C, C_TO_MZ, MZ_NAME)
%typemap(in) const C_NAME & (C_NAME temp) {
if (!MZ_PREDICATE($input))
scheme_wrong_type("$name", #MZ_NAME, $argnum, argc, argv);
temp = MZ_TO_C($input);
$1 = &temp;
}
%typemap(out) const C_NAME & {
$result = C_TO_MZ(*$1);
}
%enddef
REF_MAP(bool, SCHEME_BOOLP, SCHEME_TRUEP,
swig_make_boolean, boolean);
REF_MAP(char, SCHEME_CHARP, SCHEME_CHAR_VAL,
scheme_make_character, character);
REF_MAP(unsigned char, SCHEME_CHARP, SCHEME_CHAR_VAL,
scheme_make_character, character);
REF_MAP(int, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
REF_MAP(short, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
REF_MAP(long, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value, integer);
REF_MAP(unsigned int, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
REF_MAP(unsigned short, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
REF_MAP(unsigned long, SCHEME_INTP, SCHEME_INT_VAL,
scheme_make_integer_value_from_unsigned, integer);
REF_MAP(float, SCHEME_REALP, scheme_real_to_double,
scheme_make_double, real);
REF_MAP(double, SCHEME_REALP, scheme_real_to_double,
scheme_make_double, real);
/* Void */
%typemap(out) void "$result = scheme_void;";
/* Pass through Scheme_Object * */
%typemap (in) Scheme_Object * "$1=$input;";
%typemap (out) Scheme_Object * "$result=$1;";
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
//%typemap(in) (char *STRING, int LENGTH) {
// int temp;
// $1 = ($1_ltype) gh_scm2newstr($input, &temp);
// $2 = ($2_ltype) temp;
//}
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%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
{
$1 = (SCHEME_INTP($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_BOOL) bool &, const bool &
{
$1 = (SCHEME_BOOLP($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = (SCHEME_REALP($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char {
$1 = (SCHEME_STRINGP($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = (SCHEME_STRINGP($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr;
if (SWIG_GetPtr($input, (void **) &ptr, $1_descriptor)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
if (SWIG_GetPtr($input, (void **) &ptr, $&1_descriptor)) {
$1 = 0;
} else {
$1 = 1;
}
}
%{
void m_output_helper(Scheme_Object **target, Scheme_Object *s, int *_lenv) {
target[*_lenv] = s;
(*_lenv)++;
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
if (SWIG_GetPtr($input, (void **) &ptr, 0)) {
$1 = 0;
} else {
$1 = 1;
}
}
%}
/*
-------------------------------------------------
Check the type of the MzScheme arguments and
convert function arguments from a MzScheme to a C
representation.
-------------------------------------------------
*/
%typemap(mzscheme, in) char {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
$target = SCHEME_CHAR_VAL($source);
}
%typemap(mzscheme, in) unsigned char {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
$target = SCHEME_CHAR_VAL($source);
}
%typemap(mzscheme, in) char * {
if(!SCHEME_STRINGP($source))
scheme_wrong_type("$name", "string", $argnum, argc, argv);
$target = SCHEME_STR_VAL($source);
}
%typemap(mzscheme, in) char [ANY] {
if(!SCHEME_STRINGP($source))
scheme_wrong_type("$name", "string", $argnum, argc, argv);
$target = SCHEME_STR_VAL($source);
}
%typemap(mzscheme, in) int {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, in) long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &$target);
}
%typemap(mzscheme, in) short {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, in) unsigned int {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, in) unsigned long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_unsigned_int_val($source, &$target);
}
%typemap(mzscheme, in) unsigned short {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
/*
%typemap(mzscheme, in) long long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &$target);
}
*/
%typemap(mzscheme, in) float {
if(!SCHEME_DBLP($source))
scheme_wrong_type("$name", "double", $argnum, argc, argv);
$target = SCHEME_DBL_VAL($source);
}
%typemap(mzscheme, in) double {
if(SCHEME_DBLP($source))
$target = SCHEME_DBL_VAL($source);
else if(SCHEME_REALP($source))
$target = scheme_real_to_double($source);
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, in) long double {
if(SCHEME_DBLP($source))
$target = SCHEME_DBL_VAL($source);
else if(SCHEME_REALP($source))
$target = scheme_real_to_double($source);
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/
/*
------------------------------------
in typemaps for pass-by-reference
------------------------------------
*/
%typemap(mzscheme, in) unsigned char *(unsigned char temp) {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
temp = SCHEME_STR_VAL($source);
$target = &temp;
}
%typemap(mzscheme, in) int *(int temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (int)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, in) long *(long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &temp);
$target = &temp;
}
%typemap(mzscheme, in) short *(short temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (short)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, in) unsigned int *(unsigned temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (unsigned)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, in) unsigned long *(unsigned long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_unsigned_int_val($source, &temp);
$target = &temp;
}
%typemap(mzscheme, in) unsigned short *(unsigned short temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (unsigned short)SCHEME_INT_VAL($source);
$target = &temp;
}
/*
%typemap(mzscheme, in) long long *(long long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &temp);
$target = &temp;
}
*/
%typemap(mzscheme, in) float *(float temp) {
if(!SCHEME_DBLP($source))
scheme_wrong_type("$name", "double", $argnum, argc, argv);
temp = (float)SCHEME_DBL_VAL($source);
$target = &temp;
}
%typemap(mzscheme, in) double *(double temp) {
if(SCHEME_DBLP($source)) {
temp = (double)SCHEME_DBL_VAL($source);
$target = &temp;
}
else if(SCHEME_REALP($source)) {
temp = (double)scheme_real_to_double($source);
$target = &temp;
}
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, in) long double *(long double temp) {
if(SCHEME_DBLP($source)) {
temp = (long double)SCHEME_DBL_VAL($source);
$target = &temp;
}
else if(SCHEME_REALP($source)) {
temp = (long double)scheme_real_to_double($source);
$target = &temp;
}
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/
/*
------------------------------------
convert return type from C to Scheme
------------------------------------
*/
%typemap(mzscheme, out) char {
$target = scheme_make_character($source);
}
%typemap(mzscheme, out) unsigned char {
$target = scheme_make_character($source);
}
%typemap(mzscheme, out) char * {
$target = scheme_make_string_without_copying($source);
}
%typemap(mzscheme, out) char [ANY] {
$target = scheme_make_string_without_copying($source);
}
%typemap(mzscheme, out) int {
$target = scheme_make_integer_value($source);
}
%typemap(mzscheme, out) long {
$target = scheme_make_integer_value($source);
}
%typemap(mzscheme, out) short {
$target = scheme_make_integer_value($source);
}
/*
%typemap(mzscheme, out) long long {
$target = scheme_make_integer_value($source);
}
*/
%typemap(mzscheme, out) unsigned int {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, out) unsigned long {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, out) unsigned short {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, out) float {
$target = scheme_make_double($source);
}
%typemap(mzscheme, out) double {
$target = scheme_make_double($source);
}
/*
%typemap(mzscheme, out) long double {
$target = scheme_make_double($source);
}
*/
/*
-----------------------------------
convert pointers from C to MzScheme
-----------------------------------
*/
%typemap(mzscheme, out) int * {
$target = scheme_make_integer_value(*$source);
}
%typemap(mzscheme, out) long * {
$target = scheme_make_integer_value(*$source);
}
%typemap(mzscheme, out) short * {
$target = scheme_make_integer_value(*$source);
}
/*
%typemap(mzscheme, out) long long * {
$target = scheme_make_integer_value(*$source);
}
*/
%typemap(mzscheme, out) unsigned int * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, out) unsigned long * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, out) unsigned short * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, out) float * {
$target = scheme_make_double(*$source);
}
%typemap(mzscheme, out) double * {
$target = scheme_make_double(*$source);
}
/*
%typemap(mzscheme, out) long double * {
$target = scheme_make_double(*$source);
}
*/
/*
------------------------------------------------------------
Typemaps for accessing a global C variable from MzScheme
------------------------------------------------------------
*/
%typemap(mzscheme, varin) char {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
$target = SCHEME_CHAR_VAL($source);
}
%typemap(mzscheme, varin) unsigned char {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
$target = SCHEME_CHAR_VAL($source);
}
%typemap(mzscheme, varin) char * {
if(!SCHEME_STRINGP($source))
scheme_wrong_type("$name", "string", $argnum, argc, argv);
$target = SCHEME_STR_VAL($source);
}
%typemap(mzscheme, varin) char [ANY] {
if(!SCHEME_STRINGP($source))
scheme_wrong_type("$name", "string", $argnum, argc, argv);
$target = SCHEME_STR_VAL($source);
}
%typemap(mzscheme, varin) int {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, varin) long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &$target);
}
%typemap(mzscheme, varin) short {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, varin) unsigned int {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
%typemap(mzscheme, varin) unsigned long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_unsigned_int_val($source, &$target);
}
%typemap(mzscheme, varin) unsigned short {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
$target = SCHEME_INT_VAL($source);
}
/*
%typemap(mzscheme, varin) long long {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &$target);
}
*/
%typemap(mzscheme, varin) float {
if(!SCHEME_DBLP($source))
scheme_wrong_type("$name", "double", $argnum, argc, argv);
$target = SCHEME_DBL_VAL($source);
}
%typemap(mzscheme, varin) double {
if(SCHEME_DBLP($source))
$target = SCHEME_DBL_VAL($source);
else if(SCHEME_REALP($source))
$target = scheme_real_to_double($source);
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, varin) long double {
if(SCHEME_DBLP($source))
$target = SCHEME_DBL_VAL($source);
else if(SCHEME_REALP($source))
$target = scheme_real_to_double($source);
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/
/*
------------------------------------
global pointer variable
------------------------------------
*/
%typemap(mzscheme, varin) unsigned char *(unsigned char temp) {
if(!SCHEME_CHARP($source))
scheme_wrong_type("$name", "character", $argnum, argc, argv);
temp = SCHEME_STR_VAL($source);
$target = &temp;
}
%typemap(mzscheme, varin) int *(int temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (int)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, varin) long *(long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &temp);
$target = &temp;
}
%typemap(mzscheme, varin) short *(short temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (short)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, varin) unsigned int *(unsigned temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (unsigned)SCHEME_INT_VAL($source);
$target = &temp;
}
%typemap(mzscheme, varin) unsigned long *(unsigned long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_unsigned_int_val($source, &temp);
$target = &temp;
}
%typemap(mzscheme, varin) unsigned short *(unsigned short temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
temp = (unsigned short)SCHEME_INT_VAL($source);
$target = &temp;
}
/*
%typemap(mzscheme, varin) long long *(long long temp) {
if(!SCHEME_INTP($source))
scheme_wrong_type("$name", "integer", $argnum, argc, argv);
scheme_get_int_val($source, &temp);
$target = &temp;
}
*/
%typemap(mzscheme, varin) float *(float temp) {
if(!SCHEME_DBLP($source))
scheme_wrong_type("$name", "double", $argnum, argc, argv);
temp = (float)SCHEME_DBL_VAL($source);
$target = &temp;
}
%typemap(mzscheme, varin) double *(double temp) {
if(SCHEME_DBLP($source)) {
temp = (double)SCHEME_DBL_VAL($source);
$target = &temp;
}
else if(SCHEME_REALP($source)) {
temp = (double)scheme_real_to_double($source);
$target = &temp;
}
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
/*
%typemap(mzscheme, varin) long double *(long double temp) {
if(SCHEME_DBLP($source)) {
temp = (long double)SCHEME_DBL_VAL($source);
$target = &temp;
}
else if(SCHEME_REALP($source)) {
temp = (long double)scheme_real_to_double($source);
$target = &temp;
}
else scheme_wrong_type("$name", "real", $argnum, argc, argv);
}
*/
/*
-----------------------------------
convert a variable from C to Scheme
-----------------------------------
*/
%typemap(mzscheme, varout) char {
$target = scheme_make_character($source);
}
%typemap(mzscheme, varout) unsigned char {
$target = scheme_make_character($source);
}
%typemap(mzscheme, varout) char * {
$target = scheme_make_string_without_copying($source);
}
%typemap(mzscheme, varout) char [ANY] {
$target = scheme_make_string_without_copying($source);
}
%typemap(mzscheme, varout) int {
$target = scheme_make_integer_value($source);
}
%typemap(mzscheme, varout) long {
$target = scheme_make_integer_value($source);
}
%typemap(mzscheme, varout) short {
$target = scheme_make_integer_value($source);
}
/*
%typemap(mzscheme, varout) long long {
$target = scheme_make_integer_value($source);
}
*/
%typemap(mzscheme, varout) unsigned int {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, varout) unsigned long {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, varout) unsigned short {
$target = scheme_make_integer_value_from_unsigned($source);
}
%typemap(mzscheme, varout) float {
$target = scheme_make_double($source);
}
%typemap(mzscheme, varout) double {
$target = scheme_make_double($source);
}
/*
%typemap(mzscheme, varout) long double {
$target = scheme_make_double($source);
}
*/
/*
-----------------------------------
convert a pointer variable from C to MzScheme
-----------------------------------
*/
%typemap(mzscheme, varout) int * {
$target = scheme_make_integer_value(*$source);
}
%typemap(mzscheme, varout) long * {
$target = scheme_make_integer_value(*$source);
}
%typemap(mzscheme, varout) short * {
$target = scheme_make_integer_value(*$source);
}
/*
%typemap(mzscheme, varout) long long * {
$target = scheme_make_integer_value(*$source);
}
*/
%typemap(mzscheme, varout) unsigned int * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, varout) unsigned long * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, varout) unsigned short * {
$target = scheme_make_integer_value_from_unsigned(*$source);
}
%typemap(mzscheme, varout) float * {
$target = scheme_make_double(*$source);
}
%typemap(mzscheme, varout) double * {
$target = scheme_make_double(*$source);
}
/*
%typemap(mzscheme, varout) long double * {
$target = scheme_make_double(*$source);
}
*/