XS-MLVP
/
swig
mirror of https://github.com/swig/swig
5
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[MzScheme/Racket] Drop support 

Closes #920
Closes #2830
This commit is contained in:
Olly Betts 2025-04-01 13:59:07 +13:00
parent 0db0a3994e
commit f3ea85af0b
74 changed files with 16 additions and 5379 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ANNOUNCE
View File

@ -10,7 +10,7 @@ What is SWIG?
SWIG is a software development tool that reads C/C++ header files and
generates the wrapper code needed to make C and C++ code accessible
from other programming languages including Perl, Python, Tcl, Ruby,
PHP, C#, Go, Java, Javascript, Lua, Scheme (Guile, MzScheme), D,
PHP, C#, Go, Java, Javascript, Lua, Scheme (Guile), D,
Ocaml, Octave, R, Scilab. SWIG can also export its parse tree in
the form of XML. Major applications of SWIG include generation of
scripting language extension modules, rapid prototyping, testing,

10
CHANGES.current
View File

@ -7,6 +7,12 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
Version 4.4.0 (in progress)
===========================
2025-04-01: olly
#920 #2830 [MzScheme/Racket] Remove support for MzScheme/Racket.
It's a long time since SWIG's support was actively maintained and
a major overhaul would be needed to support Racket 8, for which
nobody has stepped forward in over 3 years.
2025-03-31: alatina
#3149 [Octave] Fix to compile with Octave 10.0
@ -88,8 +94,8 @@ Version 4.4.0 (in progress)
2024-10-22: olly
#3034 SWIG's testsuite is now free of SWIG warnings for all target
languages except mzscheme and the SWIG -Werror option is now
enabled automatically to ensure this doesn't regress.
languages and the SWIG -Werror option is now enabled automatically
to ensure this doesn't regress.
2024-10-22: olly
#2998 Drop support for specifying SWIG's internal type string

6
Doc/Devel/runtime.txt
View File

@ -6,7 +6,7 @@ documentation.
Last updated: February 23, 2005
The file we are concerned with here should be named langrun.swg. A good example
of a simple file is the Lib/mzscheme/mzrun.swg file. First, a few requirements
of a simple file is the Lib/ruby/rubyrun.swg file. First, a few requirements
and notes:
1) Every function in this file should be declared static.
@ -77,7 +77,7 @@ You would then call
SWIG_InitializeModule(0)
2) If GetModule and SetModule need to take a custom pointer (most notably an
environment pointer, see tcl or mzscheme), then you should write
environment pointer, see tcl), then you should write
swig_module_info *SWIG_Language_GetModule(void *clientdata)
void SWIG_Language_SetModule(void *clientdata, swig_module_info *mod);
and also define
@ -105,7 +105,7 @@ Standard Functions
These functions are not required and their API is not formalized, but almost all
language modules implement them for consistency across languages. Throughout
this discussion, I will use LangType to represent the underlying language type
(Scheme_Object * in mzscheme, PyObject * in python, etc)
(PyObject * in python, etc)

12
Doc/Manual/Contents.html
View File

@ -1926,18 +1926,6 @@
</div>
<!-- INDEX -->
<h3><a href="Mzscheme.html#Mzscheme">39 SWIG and MzScheme/Racket</a></h3>
<!-- INDEX -->
<div class="sectiontoc">
<ul>
<li><a href="Mzscheme.html#MzScheme_nn2">Creating native structures</a>
<li><a href="Mzscheme.html#MzScheme_simple">Simple example</a>
<li><a href="Mzscheme.html#MzScheme_external_docs">External documentation</a>
</ul>
</div>
<!-- INDEX -->
<h3><a href="Ocaml.html#Ocaml">40 SWIG and OCaml</a></h3>
<!-- INDEX -->

182
Doc/Manual/Mzscheme.html
View File

@ -1,182 +0,0 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>SWIG and MzScheme/Racket</title>
<link rel="stylesheet" type="text/css" href="style.css">
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<body bgcolor="#ffffff">
<H1><a name="Mzscheme">39 SWIG and MzScheme/Racket</a></H1>
<!-- INDEX -->
<div class="sectiontoc">
<ul>
<li><a href="#MzScheme_nn2">Creating native structures</a>
<li><a href="#MzScheme_simple">Simple example</a>
<li><a href="#MzScheme_external_docs">External documentation</a>
</ul>
</div>
<!-- INDEX -->
<p>
This section contains information on SWIG's support of Racket, formally known as MzScheme. SWIG works with Racket versions &lt; 8 (Racket 8 switched to be based on a different scheme interpreter and SWIG hasn't been updated for this change).
</p>
<H2><a name="MzScheme_nn2">39.1 Creating native structures</a></H2>
<p>
Example interface file:
</p>
<div class="code">
<pre>
/* define a macro for the struct creation */
%define handle_ptr(TYPE, NAME)
%typemap(argout) TYPE *NAME{
Scheme_Object *o = SWIG_NewStructFromPtr($1, $*1_mangle);
SWIG_APPEND_VALUE(o);
}
%typemap(in, numinputs=0) TYPE *NAME (TYPE temp) {
$1 = &amp;temp;
}
%enddef
/* setup the typemaps for the pointer to an output parameter cntrs */
handle_ptr(struct diag_cntrs, cntrs);
</pre>
</div>
<p>
Then in scheme, you can use regular struct access procedures like
</p>
<div class="code">
<pre>
; suppose a function created a struct foo as
; (define foo (make-diag-cntrs (#x1 #x2 #x3) (make-inspector))
; Then you can do
(format "0x~x" (diag-cntrs-field1 foo))
(format "0x~x" (diag-cntrs-field2 foo))
;etc...
</pre>
</div>
<H2><a name="MzScheme_simple">39.2 Simple example</a></H2>
<p>
A few examples are available in the Examples/mzscheme directory.
The code and log of a session using SWIG below should help getting started.
</p>
<p>
C header file:
</p>
<div class="code">
<pre>
// example.h
int fact(int n);
</pre>
</div>
<p>
C source code:
</p>
<div class="code">
<pre>
// File: example.c
#include "example.h"
int fact(int n) {
if (n &lt; 0) { /* This should probably return an error, but this is simpler */
return 0;
}
if (n == 0) {
return 1;
}
else {
/* testing for overflow would be a good idea here */
return n * fact(n-1);
}
}
</pre>
</div>
<p>
SWIG interface file:
</p>
<div class="code">
<pre>
/* File: example.i */
%module example
%{
#include "example.h"
%}
int fact(int n);
</pre>
</div>
<p>
The session below using the above files is on an OS X machine, but the points to be made are more general. On OS X, libtool is the tool which creates libraries, which are named .dylib, rather than .so on other unixes, or .dll on Windows.
</p>
<div class="shell">
<pre>
% swig -mzscheme -declaremodule example.i
% gcc -c -m32 -o example.o example.c # force 32-bit object file (mzscheme is 32-bit only)
% libtool -dynamic -o libexample.dylib example.o # make it into a library
% ls # what've we got so far?
example.c example.o
example.h example_wrap.c
example.i libexample.dylib*
% mzc --cgc --cc example_wrap.c # compile the wrapping code
% LDFLAGS="-L. -lexample" mzc --ld example_wrap.dylib example_wrap.o # ...and link it
% mzscheme -e '(path-&gt;string (build-path "compiled" "native" (system-library-subpath)))'
"compiled/native/i386-macosx/3m"
% mkdir -p compiled/native/i386-macosx/3m # move the extension library to a magic place
% mv example_wrap.dylib compiled/native/i386-macosx/3m/example_ss.dylib
% mzscheme
Welcome to MzScheme v4.2.4 [3m], Copyright (c) 2004-2010 PLT Scheme Inc.
&gt; (require "example.ss")
&gt; (fact 5)
120
&gt; ^D
% echo 'It works!'
</pre>
</div>
<p>
Some points of interest:
</p>
<ul>
<li> This is on a 64-bit machine, so we have to include the -m32 option when building the object file
<li> If you want to declare a scheme module (and you probably do), it's important that you include the -declaremodule option to swig (if you miss this out, it'll appear to work, but fail later).
<li> Use mzc to compile and then link the wrapped code. You'll probably need to adjust the link flags to refer to the library you're wrapping (you can either do this with an LDFLAGS declaration, as here, or with multiple ++ldf options to mzc).
<li> Create the directory with path (build-path "compiled" "native" (system-library-subpath)) and move the freshly-generated .dylib to there, changing its name to module-name_ss.dylib. After that, you can REQUIRE the new module with (require "module-name.ss").
<li> The above requests mzc to create an extension using the CGC garbage-collector. The alternative -- the 3m collector -- has generally better performance, but work is still required for SWIG to emit code which is compatible with it.
</ul>
<H2><a name="MzScheme_external_docs">39.3 External documentation</a></H2>
<p>
See the <a href="https://docs.racket-lang.org/inside/index.html">C API</a> for more description of using the mechanism for adding extensions. The main documentation is <a href="https://docs.racket-lang.org/">here</a>.
</p>
<p>
Tip: mzc's --vv option is very useful for debugging the inevitable library problems you'll encounter.
</p>
</body>
</html>

1
Doc/Manual/Preprocessor.html
View File

@ -136,7 +136,6 @@ SWIG_JAVASCRIPT_JSC Defined when using Javascript with -jsc
SWIG_JAVASCRIPT_V8 Defined when using Javascript with -v8 or -node
SWIG_JAVASCRIPT_NAPI Defined when using Javascript with -napi
SWIGLUA Defined when using Lua
SWIGMZSCHEME Defined when using Mzscheme
SWIGOCAML Defined when using OCaml
SWIGOCTAVE Defined when using Octave
SWIGPERL Defined when using Perl

3
Doc/Manual/SWIG.html
View File

@ -141,9 +141,6 @@ Experimental Target Language Options
-c - Generate C wrappers
-ocaml - Generate OCaml wrappers
Deprecated Target Language Options
-mzscheme - Generate MzScheme/Racket wrappers
General Options
-addextern - Add extra extern declarations
-c++ - Enable C++ processing

4
Doc/Manual/Sections.html
View File

@ -68,10 +68,6 @@ Last update : SWIG-4.4.0 (20 Oct 2024)
<H3><a name="Sections_deprecated_language_modules">Deprecated Language Modules Documentation</a></H3>
<ul>
<li><a href="Mzscheme.html#Mzscheme">MzScheme/Racket support</a></li>
</ul>
<H3><a name="Sections_developers_docs">Developer Documentation</a></H3>
<ul>

1
Doc/Manual/chapters
View File

@ -36,6 +36,5 @@ Ruby.html
Scilab.html
Tcl.html
C.html
Mzscheme.html
Ocaml.html
Extending.html

48
Examples/Makefile.in
View File

@ -949,54 +949,6 @@ lua_clean:
rm -f core @EXTRA_CLEAN@
rm -f *.@OBJEXT@ *$(LUA_SO)
##################################################################
##### MZSCHEME ######
##################################################################
MZSCHEME = mzscheme
MZC = @MZC@
MZDYNOBJ = @MZDYNOBJ@
MZSCHEME_SO = @MZSCHEME_SO@
MZSCHEME_SCRIPT = $(SRCDIR)$(RUNME).scm
# ----------------------------------------------------------------
# Build a C/C++ dynamically loadable module
# ----------------------------------------------------------------
mzscheme: $(SRCDIR_SRCS)
$(SWIG) -mzscheme $(SWIGOPT) -o $(ISRCS) $(INTERFACEPATH)
$(COMPILETOOL) $(MZC) `echo " $(CPPFLAGS) $(INCLUDES) $(CFLAGS)" | sed 's/ -/ ++ccf -/g'` --cc $(ISRCS) $(SRCDIR_SRCS)
$(COMPILETOOL) $(MZC) --ld $(TARGET)$(MZSCHEME_SO) $(OBJS) $(IOBJS)
mzscheme_cpp: $(SRCDIR_SRCS)
$(SWIG) -mzscheme -c++ $(SWIGOPT) -o $(ICXXSRCS) $(INTERFACEPATH)
env CFLAGS= $(COMPILETOOL) $(MZC) `echo " $(CPPFLAGS) $(INCLUDES) $(CXXFLAGS)" | sed 's/ -/ ++ccf -/g'` --cc $(ICXXSRCS) $(SRCDIR_SRCS) $(SRCDIR_CXXSRCS)
$(CXXSHARED) $(CPPFLAGS) $(CXXFLAGS) $(LDFLAGS) -o $(LIBPREFIX)$(TARGET)$(MZSCHEME_SO) $(OBJS) $(IOBJS) $(MZDYNOBJ) $(CPP_DLLIBS)
# -----------------------------------------------------------------
# Run mzscheme example
# -----------------------------------------------------------------
mzscheme_run:
env LD_LIBRARY_PATH=$$PWD $(RUNTOOL) $(MZSCHEME) -r $(MZSCHEME_SCRIPT) $(RUNPIPE)
# -----------------------------------------------------------------
# Version display
# -----------------------------------------------------------------
mzscheme_version:
$(MZSCHEME) -v
$(MZC) -v
# -----------------------------------------------------------------
# Cleaning the mzscheme examples
# -----------------------------------------------------------------
mzscheme_clean:
rm -f *_wrap* *~ .~*
rm -f core @EXTRA_CLEAN@
rm -f *.@OBJEXT@ *$(MZSCHEME_SO)
##################################################################
##### OCAML ######
##################################################################

1
Examples/index.html
View File

@ -40,7 +40,6 @@ language:
<li><a href="tcl/index.html">Tcl</a>
<li><a href="guile/">Guile</a>
<li><a href="java/index.html">Java</a>
<li><a href="mzscheme">Mzscheme</a>
<li><a href="ruby/index.html">Ruby</a>
</ul>

5
Examples/mzscheme/check.list
View File

@ -1,5 +0,0 @@
# see top-level Makefile.in
class
multimap
simple
std_vector

18
Examples/mzscheme/class/Makefile
View File

@ -1,18 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
CXXSRCS = example.cxx
TARGET = example
INTERFACE = example.i
SWIGOPT =
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_run
build:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' mzscheme_cpp
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_clean

28
Examples/mzscheme/class/example.cxx
View File

@ -1,28 +0,0 @@
/* File : example.cxx */
#include "example.h"
#define M_PI 3.14159265358979323846
/* Move the shape to a new location */
void Shape::move(double dx, double dy) {
x += dx;
y += dy;
}
int Shape::nshapes = 0;
double Circle::area() {
return M_PI*radius*radius;
}
double Circle::perimeter() {
return 2*M_PI*radius;
}
double Square::area() {
return width*width;
}
double Square::perimeter() {
return 4*width;
}

34
Examples/mzscheme/class/example.h
View File

@ -1,34 +0,0 @@
/* File : example.h */
class Shape {
public:
Shape() {
nshapes++;
}
virtual ~Shape() {
nshapes--;
}
double x, y;
void move(double dx, double dy);
virtual double area() = 0;
virtual double perimeter() = 0;
static int nshapes;
};
class Circle : public Shape {
private:
double radius;
public:
Circle(double r) : radius(r) { }
virtual double area();
virtual double perimeter();
};
class Square : public Shape {
private:
double width;
public:
Square(double w) : width(w) { }
virtual double area();
virtual double perimeter();
};

9
Examples/mzscheme/class/example.i
View File

@ -1,9 +0,0 @@
/* File : example.i */
%module example
%{
#include "example.h"
%}
/* Let's just grab the original header file here */
%include "example.h"

60
Examples/mzscheme/class/runme.scm
View File

@ -1,60 +0,0 @@
; file: runme.scm
; This file illustrates the proxy class C++ interface generated
; by SWIG.
(load-extension "example.so")
; Convenience wrapper around the display function
; (which only accepts one argument at the time)
(define (mdisplay-newline . args)
(for-each display args)
(newline))
; ----- Object creation -----
(mdisplay-newline "Creating some objects:")
(define c (new-Circle 10))
(mdisplay-newline " Created circle " c)
(define s (new-Square 10))
(mdisplay-newline " Created square " s)
; ----- Access a static member -----
(mdisplay-newline "\nA total of " (Shape-nshapes) " shapes were created")
; ----- Member data access -----
; Set the location of the object
(Shape-x-set c 20)
(Shape-y-set c 30)
(Shape-x-set s -10)
(Shape-y-set s 5)
(mdisplay-newline "\nHere is their current position:")
(mdisplay-newline " Circle = (" (Shape-x-get c) "," (Shape-y-get c) ")")
(mdisplay-newline " Square = (" (Shape-x-get s) "," (Shape-y-get s) ")")
; ----- Call some methods -----
(mdisplay-newline "\nHere are some properties of the shapes:")
(define (shape-props o)
(mdisplay-newline " " o)
(mdisplay-newline " area = " (Shape-area o))
(mdisplay-newline " perimeter = " (Shape-perimeter o)))
(for-each shape-props (list c s))
(mdisplay-newline "\nGuess I'll clean up now")
; Note: this invokes the virtual destructor
(delete-Shape c)
(delete-Shape s)
(define s 3)
(mdisplay-newline (Shape-nshapes) " shapes remain")
(mdisplay-newline "Goodbye")
(exit 0)

18
Examples/mzscheme/multimap/Makefile
View File

@ -1,18 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
SRCS = example.c
TARGET = example
INTERFACE = example.i
SWIGOPT =
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_run
build:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' mzscheme
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_clean

53
Examples/mzscheme/multimap/example.c
View File

@ -1,53 +0,0 @@
/* File : example.c */
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
/* Compute the greatest common divisor of positive integers */
int gcd(int x, int y) {
int g;
g = y;
while (x > 0) {
g = x;
x = y % x;
y = g;
}
return g;
}
int gcdmain(int argc, char *argv[]) {
int x,y;
if (argc != 3) {
printf("usage: gcd x y\n");
return -1;
}
x = atoi(argv[1]);
y = atoi(argv[2]);
printf("gcd(%d,%d) = %d\n", x,y,gcd(x,y));
return 0;
}
int charcount(char *bytes, int len, char c) {
int i;
int count = 0;
for (i = 0; i < len; i++) {
if (bytes[i] == c) count++;
}
return count;
}
void capitalize(char *str, int len) {
int i;
for (i = 0; i < len; i++) {
str[i] = (char)toupper(str[i]);
}
}
void circle(double x, double y) {
double a = x*x + y*y;
if (a > 1.0) {
printf("Bad points %g, %g\n", x,y);
} else {
printf("Good points %g, %g\n", x,y);
}
}

91
Examples/mzscheme/multimap/example.i
View File

@ -1,91 +0,0 @@
/* File : example.i */
%module example
%{
extern int gcd(int x, int y);
extern int gcdmain(int argc, char *argv[]);
extern int charcount(char *bytes, int len, char c);
extern void capitalize (char *str, int len);
extern void circle (double cx, double cy);
extern int squareCubed (int n, int *OUTPUT);
%}
%include exception.i
%include typemaps.i
extern int gcd(int x, int y);
%typemap(in) (int argc, char *argv[]) {
int i;
Scheme_Object **elms;
if (!SCHEME_VECTORP($input)) {
scheme_wrong_type("$name","vector",$argnum,argc,argv);
}
$1 = SCHEME_VEC_SIZE($input);
elms = SCHEME_VEC_ELS($input);
if ($1 == 0) {
scheme_wrong_type("$name","vector",$argnum,argc,argv);
}
$2 = (char **) malloc(($1+1)*sizeof(char *));
for (i = 0; i < $1; i++) {
if (!SCHEME_STRINGP(elms[i])) {
free($2);
scheme_wrong_type("$name","vector",$argnum,argc,argv);
}
$2[i] = SCHEME_STR_VAL(elms[i]);
}
$2[i] = 0;
}
%typemap(freearg) (int argc, char *argv[]) {
free($2);
}
extern int gcdmain(int argc, char *argv[]);
%typemap(in) (char *bytes, int len) {
if (!SCHEME_STRINGP($input)) {
scheme_wrong_type("$name","string",1,argc,argv);
}
$1 = SCHEME_STR_VAL($input);
$2 = SCHEME_STRLEN_VAL($input);
}
extern int charcount(char *bytes, int len, char c);
/* This example shows how to wrap a function that mutates a string */
%typemap(in) (char *str, int len) {
if (!SCHEME_STRINGP($input)) {
scheme_wrong_type("$name","string",1,argc,argv);
}
$2 = SCHEME_STRLEN_VAL($input);
$1 = (char *) malloc($2+1);
memmove($1,SCHEME_STR_VAL($input),$2);
}
/* Return the mutated string as a new object. */
%typemap(argout) (char *str, int len) {
Scheme_Object *s;
s = scheme_make_sized_string($1,$2);
SWIG_APPEND_VALUE(s);
free($1);
}
extern void capitalize(char *str, int len);
/* A multi-valued constraint. Force two arguments to lie
inside the unit circle */
%typemap(check) (double cx, double cy) {
double a = $1*$1 + $2*$2;
if (a > 1.0) {
SWIG_exception(SWIG_ValueError,"$1_name and $2_name must be in unit circle");
return NULL;
}
}
extern void circle(double cx, double cy);

27
Examples/mzscheme/multimap/runme.scm
View File

@ -1,27 +0,0 @@
;; run with mzscheme -r runme.scm
(load-extension "example.so")
; Call the GCD function
(define x 42)
(define y 105)
(define g (gcd x y))
(display "The gcd of ")
(display x)
(display " and ")
(display y)
(display " is ")
(display g)
(newline)
; Call the gcdmain() function
(gcdmain #("gcdmain" "42" "105"))
(display (charcount "Hello World" #\l))
(newline)
(display (capitalize "hello world"))
(newline)

18
Examples/mzscheme/simple/Makefile
View File

@ -1,18 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
SRCS = example.c
TARGET = example
INTERFACE = example.i
SWIGOPT =
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_run
build:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' SRCS='$(SRCS)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' mzscheme
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_clean

18
Examples/mzscheme/simple/example.c
View File

@ -1,18 +0,0 @@
/* File : example.c */
/* A global variable */
double Foo = 3.0;
/* Compute the greatest common divisor of positive integers */
int gcd(int x, int y) {
int g;
g = y;
while (x > 0) {
g = x;
x = y % x;
y = g;
}
return g;
}

7
Examples/mzscheme/simple/example.i
View File

@ -1,7 +0,0 @@
/* File : example.i */
%module example
%inline %{
extern int gcd(int x, int y);
extern double Foo;
%}

31
Examples/mzscheme/simple/runme.scm
View File

@ -1,31 +0,0 @@
;; run with mzscheme -r runme.scm
(load-extension "example.so")
; Call our gcd() function
(define x 42)
(define y 105)
(define g (gcd x y))
(display "The gcd of ")
(display x)
(display " and ")
(display y)
(display " is ")
(display g)
(newline)
; Manipulate the Foo global variable
; Output its current value
(display "Foo = ")
(display (Foo))
(newline)
; Change its value
(Foo 3.1415926)
; See if the change took effect
(display "Foo = ")
(display (Foo))
(newline)

18
Examples/mzscheme/std_vector/Makefile
View File

@ -1,18 +0,0 @@
TOP = ../..
SWIGEXE = $(TOP)/../swig
SWIG_LIB_DIR = $(TOP)/../$(TOP_BUILDDIR_TO_TOP_SRCDIR)Lib
CXXSRCS =
TARGET = example
INTERFACE = example.i
SWIGOPT =
check: build
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_run
build:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' CXXSRCS='$(CXXSRCS)' \
SWIG_LIB_DIR='$(SWIG_LIB_DIR)' SWIGEXE='$(SWIGEXE)' \
SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' mzscheme_cpp
clean:
$(MAKE) -f $(TOP)/Makefile SRCDIR='$(SRCDIR)' mzscheme_clean

24
Examples/mzscheme/std_vector/example.h
View File

@ -1,24 +0,0 @@
/* File : example.h */
#include <vector>
#include <algorithm>
#include <functional>
#include <numeric>
double average(std::vector<int> v) {
return std::accumulate(v.begin(),v.end(),0.0)/v.size();
}
std::vector<double> half(const std::vector<double>& v) {
std::vector<double> w(v);
for (unsigned int i=0; i<w.size(); i++)
w[i] /= 2.0;
return w;
}
void halve_in_place(std::vector<double>& v) {
for (std::vector<double>::iterator it = v.begin(); it != v.end(); ++it)
*it /= 2.0;
}

17
Examples/mzscheme/std_vector/example.i
View File

@ -1,17 +0,0 @@
/* File : example.i */
%module example
%{
#include "example.h"
%}
%include stl.i
/* instantiate the required template specializations */
namespace std {
%template(IntVector) vector<int>;
%template(DoubleVector) vector<double>;
}
/* Let's just grab the original header file here */
%include "example.h"

54
Examples/mzscheme/std_vector/runme.scm
View File

@ -1,54 +0,0 @@
;; run with mzscheme -r runme.scm
(load-extension "example.so")
; repeatedly invoke a procedure with v and an index as arguments
(define (with-vector v proc size-proc)
(let ((size (size-proc v)))
(define (with-vector-item v i)
(if (< i size)
(begin
(proc v i)
(with-vector-item v (+ i 1)))
(void)))
(with-vector-item v 0)))
(define (with-IntVector v proc)
(with-vector v proc IntVector-length))
(define (with-DoubleVector v proc)
(with-vector v proc DoubleVector-length))
(define (print-DoubleVector v)
(with-DoubleVector v (lambda (v i) (display (DoubleVector-ref v i))
(display " ")))
(newline))
; Call average with a Scheme list...
(display (average '(1 2 3 4)))
(newline)
; ... or a wrapped std::vector<int>
(define v (new-IntVector 4))
(with-IntVector v (lambda (v i) (IntVector-set! v i (+ i 1))))
(display (average v))
(newline)
(delete-IntVector v)
; half will return a Scheme vector.
; Call it with a Scheme vector...
(display (half #(1 1.5 2 2.5 3)))
(newline)
; ... or a wrapped std::vector<double>
(define v (new-DoubleVector))
(map (lambda (i) (DoubleVector-push! v i)) '(1 2 3 4))
(display (half v))
(newline)
; now halve a wrapped std::vector<double> in place
(halve-in-place v)
(print-DoubleVector v)
(delete-DoubleVector v)

2
Examples/test-suite/li_std_wstring.i
View File

@ -1,7 +1,7 @@
%module li_std_wstring
// The languages below are yet to provide std_wstring.i
#if !(defined(SWIGD) || defined(SWIGGO) || defined(SWIGGUILE) || defined(SWIGJAVASCRIPT) || defined(SWIGLUA) || defined(SWIGMZSCHEME) || defined(SWIGOCAML) || defined(SWIGOCTAVE) || defined(SWIGPERL) || defined(SWIGPHP) || defined(SWIGR) || defined(SWIGSCILAB))
#if !(defined(SWIGD) || defined(SWIGGO) || defined(SWIGGUILE) || defined(SWIGJAVASCRIPT) || defined(SWIGLUA) || defined(SWIGOCAML) || defined(SWIGOCTAVE) || defined(SWIGPERL) || defined(SWIGPHP) || defined(SWIGR) || defined(SWIGSCILAB))
%warnfilter(SWIGWARN_TYPEMAP_WCHARLEAK) wchar_t_const_ptr_member; // Setting a const wchar_t * variable may leak memory.

123
Examples/test-suite/mzscheme/Makefile.in
View File

@ -1,123 +0,0 @@
#######################################################################
# Makefile for mzscheme test-suite
#######################################################################
LANGUAGE = mzscheme
MZSCHEME = mzscheme
SCRIPTSUFFIX = _runme.scm
HAVE_CXX11 = @HAVE_CXX11@
HAVE_CXX14 = @HAVE_CXX14@
HAVE_CXX17 = @HAVE_CXX17@
HAVE_CXX20 = @HAVE_CXX20@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
FAILING_CPP_TESTS = \
allowexcept \
apply_strings \
arrays_dimensionless \
arrays_global \
char_strings \
chartest \
class_scope_weird \
constant_pointers \
cpp11_alternate_function_syntax \
cpp11_director_enums \
cpp11_ref_qualifiers \
cpp11_rvalue_reference2 \
cpp11_strongly_typed_enumerations \
cpp_basic \
cpp_enum \
curiously_recurring_template_pattern \
default_arg_expressions \
default_constructor \
derived_nested \
director_ignore \
enum_thorough \
extend \
friends \
global_scope_types \
inherit_member \
li_attribute \
li_attribute_template \
li_boost_shared_ptr \
li_std_combinations \
li_std_map \
li_std_pair \
li_std_pair_using \
li_std_string \
li_std_vector \
li_windows \
member_funcptr_galore \
member_pointer \
member_pointer_const \
memberin_extend \
namespace_spaces \
naturalvar \
naturalvar_more \
nested_class \
nested_template_base \
ordering \
preproc_constants \
samename \
static_const_member \
string_constants \
template_default2 \
template_specialization_defarg \
template_typemaps \
typemap_variables \
valuewrapper_opaque \
FAILING_C_TESTS = \
enums \
integers \
preproc_constants_c \
preproc_line_file \
FAILING_MULTI_CPP_TESTS = \
multi_import \
include $(srcdir)/../common.mk
# Overridden variables here
SWIGOPT += -w524 # Suppress SWIGWARN_LANG_EXPERIMENTAL warning
# Ensure testsuite remains free from SWIG warnings.
# Currently there are a lot of SWIG warnings for mzscheme, but it is marked
# as "Experimental" and slated for removal in 4.4.0 (#2830).
#SWIGOPT += -Werror
# Custom tests - tests with additional commandline options
# none!
# Rules for the different types of tests
%.cpptest:
$(setup)
+$(swig_and_compile_cpp)
$(run_testcase)
%.ctest:
$(setup)
+$(swig_and_compile_c)
$(run_testcase)
%.multicpptest:
$(setup)
+$(swig_and_compile_multi_cpp)
$(run_testcase)
# Runs the testcase. A testcase is only run if
# a file is found which has _runme.scm appended after the testcase name.
run_testcase = \
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(MZSCHEME) -r $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
fi
# Clean
%.clean:
@exit 0
clean:
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' mzscheme_clean

4
Examples/test-suite/mzscheme/README
View File

@ -1,4 +0,0 @@
See ../README for common README file.
Any testcases which have _runme.scm appended after the testcase name will be detected and run.

44
Examples/test-suite/mzscheme/argcargvtest_runme.scm
View File

@ -1,44 +0,0 @@
(load-extension "argcargvtest.so")
(define largs #("hi" "hola" "hello"))
(when (not (= (mainc largs) 3))
(error "calling mainc failed"))
(define targs #("hi" "hola"))
(when (not (string=? (mainv targs 0) "hi"))
(error "calling mainv failed"))
(when (not (string=? (mainv targs 1) "hola"))
(error "calling mainv failed"))
(when (not (string=? (mainv targs 2) "<<NULL>>"))
(error "calling mainv failed"))
(with-handlers ([exn:fail? (lambda (exn)
(when (not (string=? (exn-message exn)
"SWIG contract, assertion failed: function=mainv, message=null array"))
(error "wrong error")))])
(mainv "hello" 1)
(error "mainv should generate exception"))
(initializeApp largs)
; Check that an empty array works.
(define empty_args #())
(when (not (= (mainc empty_args) 0))
(error "calling mainc failed"))
(when (not (string=? (mainv empty_args 0) "<<NULL>>"))
(error "calling mainv failed"))
; Check that empty strings are handled.
(define empty_string #("hello" "" "world"))
(when (not (= (mainc empty_string) 3))
(error "calling mainc failed"))
(when (not (string=? (mainv empty_string 0) "hello"))
(error "calling mainv 0 failed"))
(when (not (string=? (mainv empty_string 1) ""))
(error "calling mainv 1 failed"))
(when (not (string=? (mainv empty_string 2) "world"))
(error "calling mainv 2 failed"))
(when (not (string=? (mainv empty_string 3) "<<NULL>>"))
(error "calling mainv 3 failed"))
(exit 0)

7
Examples/test-suite/mzscheme/casts_runme.scm
View File

@ -1,7 +0,0 @@
(load-extension "casts.so")
(define x (new-B))
(A-hello x)
(exit 0)

18
Examples/test-suite/mzscheme/catches_strings_runme.scm
View File

@ -1,18 +0,0 @@
(load-extension "catches_strings.so")
(require (lib "defmacro.ss"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(StringsThrower-charstring))
(unless (string-contains? exception_thrown "charstring message")
(error (format "incorrect exception message: ~a" exception_thrown)))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(StringsThrower-stdstring))
(unless (string-contains? exception_thrown "stdstring message")
(error (format "incorrect exception message: ~a" exception_thrown)))
(exit 0)

6
Examples/test-suite/mzscheme/char_constant_runme.scm
View File

@ -1,6 +0,0 @@
(load-extension "char_constant.so")
(if (and (char? (CHAR-CONSTANT))
(string? (STRING-CONSTANT)))
(exit 0)
(exit 1))

55
Examples/test-suite/mzscheme/cpp11_move_typemaps_runme.scm
View File

@ -1,55 +0,0 @@
(load-extension "cpp11_move_typemaps.so")
(require (lib "defmacro.ss"))
; Copied from ../schemerunme/cpp11_move_typemaps.scm and modified for exceptions
; Define an equivalent to Guile's gc procedure
(define-macro (gc)
`(collect-garbage 'major))
(Counter-reset-counts)
(define mo (new-MoveOnly 111))
(Counter-check-counts 1 0 0 0 0 0)
(MoveOnly-take mo)
(Counter-check-counts 1 0 0 1 0 2)
(delete-MoveOnly mo)
(Counter-check-counts 1 0 0 1 0 2)
(Counter-reset-counts)
(define mo (new-MovableCopyable 111))
(Counter-check-counts 1 0 0 0 0 0)
(MovableCopyable-take mo)
(Counter-check-counts 1 0 0 1 0 2)
(delete-MovableCopyable mo)
(Counter-check-counts 1 0 0 1 0 2)
(define mo (new-MoveOnly 222))
(MoveOnly-take mo)
(define exception_thrown "no exception thrown for mo")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(MoveOnly-take mo))
(unless (string-contains? exception_thrown "cannot release ownership as memory is not owned")
(error "Wrong or no exception thrown: " exception_thrown))
(Counter-reset-counts)
(define imt (new-InstanceMethodsTester))
(define mo (new-MoveOnly 333))
(Counter-check-counts 1 0 0 0 0 0)
(InstanceMethodsTester-instance-take-move-only imt mo)
(Counter-check-counts 1 0 0 1 0 2)
(delete-MoveOnly mo)
(Counter-check-counts 1 0 0 1 0 2)
(Counter-reset-counts)
(define mc (new-MovableCopyable 444))
(Counter-check-counts 1 0 0 0 0 0)
(InstanceMethodsTester-instance-take-movable-copyable imt mc)
(Counter-check-counts 1 0 0 1 0 2)
(delete-MovableCopyable mc)
(Counter-check-counts 1 0 0 1 0 2)
(exit 0)

68
Examples/test-suite/mzscheme/cpp11_rvalue_reference_move_runme.scm
View File

@ -1,68 +0,0 @@
(load-extension "cpp11_rvalue_reference_move.so")
(require (lib "defmacro.ss"))
; Copied from ../schemerunme/cpp11_rvalue_reference_move.scm and modified for exceptions
; Function containing rvalue reference parameter
(Counter-reset-counts)
(define mo (new-MovableCopyable 222))
(Counter-check-counts 1 0 0 0 0 0)
(MovableCopyable-movein mo)
(Counter-check-counts 1 0 0 1 0 2)
(unless (MovableCopyable-is-nullptr mo)
(error "is_nullptr failed"))
(delete-MovableCopyable mo)
(Counter-check-counts 1 0 0 1 0 2)
; Move constructor test
(Counter-reset-counts)
(define mo (new-MovableCopyable 222))
(Counter-check-counts 1 0 0 0 0 0)
(define mo_moved (new-MovableCopyable mo))
(Counter-check-counts 1 0 0 1 0 1)
(unless (MovableCopyable-is-nullptr mo)
(error "is_nullptr failed"))
(delete-MovableCopyable mo)
(Counter-check-counts 1 0 0 1 0 1)
(delete-MovableCopyable mo_moved)
(Counter-check-counts 1 0 0 1 0 2)
; Move assignment operator test
(Counter-reset-counts)
(define mo111 (new-MovableCopyable 111))
(define mo222 (new-MovableCopyable 222))
(Counter-check-counts 2 0 0 0 0 0)
(MovableCopyable-MoveAssign mo111 mo222)
(Counter-check-counts 2 0 0 0 1 1)
(unless (MovableCopyable-is-nullptr mo222)
(error "is_nullptr failed"))
(delete-MovableCopyable mo222)
(Counter-check-counts 2 0 0 0 1 1)
(delete-MovableCopyable mo111)
(Counter-check-counts 2 0 0 0 1 2)
; null check
(Counter-reset-counts)
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(MovableCopyable-movein '()))
(unless (string=? exception_thrown "MovableCopyable-movein: swig-type-error (null reference)")
(error (format "incorrect exception message: ~a" exception_thrown)))
(Counter-check-counts 0 0 0 0 0 0)
; output
(Counter-reset-counts)
(define mc (MovableCopyable-moveout 1234))
(Counter-check-counts 2 0 0 0 1 1)
(MovableCopyable-check-numbers-match mc 1234)
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(MovableCopyable-movein mc))
(unless (string-contains? exception_thrown "cannot release ownership as memory is not owned")
(error (format "incorrect exception message: ~a" exception_thrown)))
(Counter-check-counts 2 0 0 0 1 1)
(exit 0)

300
Examples/test-suite/mzscheme/cpp11_std_unique_ptr_runme.scm
View File

@ -1,300 +0,0 @@
(load-extension "cpp11_std_unique_ptr.so")
(require (lib "defmacro.ss"))
; Copied from ../schemerunme/cpp11_std_unique_ptr.scm and modified for exceptions
; Define an equivalent to Guile's gc procedure
(define-macro (gc)
`(collect-garbage 'major))
(define checkCount
(lambda (expected-count)
(define actual-count (Klass-getTotal-count))
(unless (= actual-count expected-count) (error (format "Counts incorrect, expected:~a actual:~a" expected-count actual-count)))))
; Test raw pointer handling involving virtual inheritance
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (useKlassRawPtr kini))
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(set! kini '()) (gc)
(checkCount 0)
; ;;;; INPUT BY VALUE ;;;;
; unique_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassUniquePtr kin))
(unless (string=? exception_thrown "takeKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(set! kin '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(define notowned (get-not-owned-ptr kin))
(set! exception_thrown "no exception thrown for notowned")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassUniquePtr notowned))
(unless (string=? exception_thrown "takeKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (takeKlassUniquePtr kini))
(checkCount 0)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(unless (is-nullptr kini)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define null '())
(takeKlassUniquePtr null)
(takeKlassUniquePtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (overloadTest) 0)
(error "overloadTest failed"))
(unless (= (overloadTest null) 1)
(error "overloadTest failed"))
(unless (= (overloadTest (new-Klass "over")) 1)
(error "overloadTest failed"))
(checkCount 0)
; ;;;; INPUT BY RVALUE REF ;;;;
; unique_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (moveKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (moveKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(moveKlassUniquePtr kin))
(unless (string=? exception_thrown "moveKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(set! kin '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(define notowned (get-not-owned-ptr kin))
(set! exception_thrown "no exception thrown for notowned")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(moveKlassUniquePtr notowned))
(unless (string=? exception_thrown "moveKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (moveKlassUniquePtr kini))
(checkCount 0)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(unless (is-nullptr kini)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define null '())
(moveKlassUniquePtr null)
(moveKlassUniquePtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (moveOverloadTest) 0)
(error "moveOverloadTest failed"))
(unless (= (moveOverloadTest null) 1)
(error "moveOverloadTest failed"))
(unless (= (moveOverloadTest (new-Klass "over")) 1)
(error "moveOverloadTest failed"))
(checkCount 0)
; ;;;; INPUT BY NON-CONST LVALUE REF ;;;;
; unique_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (moveRefKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (moveRefKlassUniquePtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(moveRefKlassUniquePtr kin))
(unless (string=? exception_thrown "moveRefKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(set! kin '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(define notowned (get-not-owned-ptr kin))
(set! exception_thrown "no exception thrown for notowned")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(moveRefKlassUniquePtr notowned))
(unless (string=? exception_thrown "moveRefKlassUniquePtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (moveRefKlassUniquePtr kini))
(checkCount 0)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(unless (is-nullptr kini)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define null '())
(moveRefKlassUniquePtr null)
(moveRefKlassUniquePtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (moveRefOverloadTest) 0)
(error "moveRefOverloadTest failed"))
(unless (= (moveRefOverloadTest null) 1)
(error "moveRefOverloadTest failed"))
(unless (= (moveRefOverloadTest (new-Klass "over")) 1)
(error "moveRefOverloadTest failed"))
(checkCount 0)
; ;;;; INPUT BY CONST LVALUE REF ;;;;
; unique_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (useRefKlassUniquePtr kin))
(checkCount 1)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (useRefKlassUniquePtr kini))
(checkCount 1)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(set! kini '()) (gc)
(checkCount 0)
(define null '())
(useRefKlassUniquePtr null)
(useRefKlassUniquePtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (useRefOverloadTest) 0)
(error "useRefOverloadTest failed"))
(unless (= (useRefOverloadTest null) 1)
(error "useRefOverloadTest failed"))
(define kin (new-Klass "over"))
(unless (= (useRefOverloadTest kin) 1)
(error "useRefOverloadTest failed"))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
; unique_ptr as output
(define k1 (makeKlassUniquePtr "first"))
(define k2 (makeKlassUniquePtr "second"))
(checkCount 2)
(set! k1 '()) (gc)
(checkCount 1)
(unless (string=? (Klass-getLabel k2) "second")
(error "wrong object label" ))
(set! k2 '()) (gc)
(checkCount 0)
(unless (null? (makeNullUniquePtr))
(error "null failure"))
; unique_ptr as output (rvalue ref)
(define k1 (makeRVRKlassUniquePtr "first"))
(unless (string=? (Klass-getLabel k1) "first")
(error "wrong object label" ))
(unless (null? (makeRVRKlassUniquePtr '()))
(error "null failure"))
; unique_ptr as output (lvalue ref)
(define k1 (makeRefKlassUniquePtr "lvalueref"))
(unless (string=? (Klass-getLabel k1) "lvalueref")
(error "wrong object label" ))
(unless (null? (makeRefKlassUniquePtr '()))
(error "null failure"))
(exit 0)

16
Examples/test-suite/mzscheme/imports_runme.scm
View File

@ -1,16 +0,0 @@
;;; This file is part of a test for SF bug #231619.
;;; It shows that the %import directive does not work properly in SWIG
;;; 1.3a5: Type information is not properly generated if a base class
;;; comes from an %import-ed file.
(load-extension "imports_a.so")
(load-extension "imports_b.so")
(define x (new-B))
;; This fails in 1.3a5 because the SWIG runtime code does not know
;; that x (an instance of class B) can be passed to methods of class A.
(A-hello x)
(exit 0)

9
Examples/test-suite/mzscheme/integers_runme.scm
View File

@ -1,9 +0,0 @@
(load-extension "integers.so")
(require (lib "defmacro.ss"))
(define-macro (throws-exception? form)
`(with-handlers ((not-break-exn? (lambda (exn) #t)))
,form
#f))
(load (build-path (path-only (path->complete-path (find-system-path 'run-file))) "../schemerunme/integers.scm"))

109
Examples/test-suite/mzscheme/li_std_auto_ptr_runme.scm
View File

@ -1,109 +0,0 @@
(load-extension "li_std_auto_ptr.so")
(require (lib "defmacro.ss"))
; Copied from ../schemerunme/li_std_auto_ptr.scm and modified for exceptions
; Define an equivalent to Guile's gc procedure
(define-macro (gc)
`(collect-garbage 'major))
(define checkCount
(lambda (expected-count)
(define actual-count (Klass-getTotal-count))
(unless (= actual-count expected-count) (error (format "Counts incorrect, expected:~a actual:~a" expected-count actual-count)))))
; Test raw pointer handling involving virtual inheritance
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (useKlassRawPtr kini))
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(set! kini '()) (gc)
(checkCount 0)
; auto_ptr as input
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kin))
(checkCount 0)
(unless (string=? s "KlassInput")
(error "Incorrect string: " s))
(unless (is-nullptr kin)
(error "is_nullptr failed"))
(define exception_thrown "no exception thrown for kin")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassAutoPtr kin))
(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(set! kin '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define kin (new-Klass "KlassInput"))
(define notowned (get-not-owned-ptr kin))
(set! exception_thrown "no exception thrown for notowned")
(with-handlers ([exn:fail? (lambda (exn)
(set! exception_thrown (exn-message exn)))])
(takeKlassAutoPtr notowned))
(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
(error "Wrong or no exception thrown: " exception_thrown))
(checkCount 1)
(set! kin '()) (gc)
(checkCount 0)
(define kini (new-KlassInheritance "KlassInheritanceInput"))
(checkCount 1)
(define s (takeKlassAutoPtr kini))
(checkCount 0)
(unless (string=? s "KlassInheritanceInput")
(error "Incorrect string: " s))
(unless (is-nullptr kini)
(error "is_nullptr failed"))
(set! kini '()) (gc) ; Should not fail, even though already deleted
(checkCount 0)
(define null '())
(takeKlassAutoPtr null)
(takeKlassAutoPtr (make-null))
(checkCount 0)
; overloaded parameters
(unless (= (overloadTest) 0)
(error "overloadTest failed"))
(unless (= (overloadTest null) 1)
(error "overloadTest failed"))
(unless (= (overloadTest (new-Klass "over")) 1)
(error "overloadTest failed"))
(checkCount 0)
; auto_ptr as output
(define k1 (makeKlassAutoPtr "first"))
(define k2 (makeKlassAutoPtr "second"))
(checkCount 2)
(set! k1 '()) (gc)
(checkCount 1)
(unless (string=? (Klass-getLabel k2) "second")
(error "wrong object label" ))
(set! k2 '()) (gc)
(checkCount 0)
(unless (null? (makeNullAutoPtr))
(error "null failure"))
(exit 0)

10
Examples/test-suite/mzscheme/name_runme.scm
View File

@ -1,10 +0,0 @@
;; The SWIG modules have "passive" Linkage, i.e., they don't generate
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(load-extension "name.so")
(foo-2)
bar-2
Baz-2
(exit 0)

9
Examples/test-suite/mzscheme/newobject1_runme.scm
View File

@ -1,9 +0,0 @@
(load-extension "newobject1.so")
(require (lib "defmacro.ss"))
; Define an equivalent to Guile's gc procedure
(define-macro (gc)
`(collect-garbage 'major))
(load (build-path (path-only (path->complete-path (find-system-path 'run-file))) "../schemerunme/newobject1.scm"))

3
Examples/test-suite/mzscheme/null_pointer_runme.scm
View File

@ -1,3 +0,0 @@
(load-extension "null_pointer.so")
(load (build-path (path-only (path->complete-path (find-system-path 'run-file))) "../schemerunme/null_pointer.scm"))

40
Examples/test-suite/mzscheme/unions_runme.scm
View File

@ -1,40 +0,0 @@
;;; This is the union runtime testcase. It ensures that values within a
;;; union embedded within a struct can be set and read correctly.
(load-extension "unions.so")
;; Create new instances of SmallStruct and BigStruct for later use
(define small (new-SmallStruct))
(SmallStruct-jill-set small 200)
(define big (new-BigStruct))
(BigStruct-smallstruct-set big small)
(BigStruct-jack-set big 300)
;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
;; Ensure values in EmbeddedUnionTest are set correctly for each.
(define eut (new-EmbeddedUnionTest))
;; First check the SmallStruct in EmbeddedUnionTest
(EmbeddedUnionTest-number-set eut 1)
(EmbeddedUnionTest-uni-small-set (EmbeddedUnionTest-uni-get eut)
small)
(let ((Jill1 (SmallStruct-jill-get
(EmbeddedUnionTest-uni-small-get
(EmbeddedUnionTest-uni-get eut)))))
(if (not (= Jill1 200))
(begin
(display "Runtime test 1 failed.")
(exit 1))
(void)))
(let ((Num1 (EmbeddedUnionTest-number-get eut)))
(if (not (= Num1 1))
(begin
(display "Runtime test 2 failed.")
(exit 1))
(void)))
;; that should do
(exit 0)

1
Examples/test-suite/preproc_predefined.h
View File

@ -8,7 +8,6 @@
+defined(SWIGJAVA)\
+defined(SWIGJAVASCRIPT)\
+defined(SWIGLUA)\
+defined(SWIGMZSCHEME)\
+defined(SWIGOCAML)\
+defined(SWIGOCTAVE)\
+defined(SWIGPERL)\

2
Examples/test-suite/typemap_namespace.i
View File

@ -37,7 +37,7 @@ namespace Foo {
%typemap(dout) Str1 * = char *;
#endif
%typemap(in) Str1 * = char *;
#if !(defined(SWIGCSHARP) || defined(SWIGLUA) || defined(SWIGPHP) || defined(SWIGMZSCHEME) || defined(SWIGOCAML) || defined(SWIGGO) || defined(SWIGD))
#if !(defined(SWIGCSHARP) || defined(SWIGLUA) || defined(SWIGPHP) || defined(SWIGOCAML) || defined(SWIGGO) || defined(SWIGD))
%typemap(freearg) Str1 * = char *;
#endif
%typemap(typecheck) Str1 * = char *;

33
Lib/exception.i
View File

@ -59,39 +59,6 @@
%}
#endif
#ifdef SWIGMZSCHEME
%{
SWIGINTERN void SWIG_exception_ (int code, const char *msg) {
#define ERROR(errname) \
scheme_signal_error(errname " (%s)", msg);
#define MAP(swigerr, errname) \
case swigerr: \
ERROR(errname); \
break
switch (code) {
MAP(SWIG_MemoryError, "swig-memory-error");
MAP(SWIG_IOError, "swig-io-error");
MAP(SWIG_RuntimeError, "swig-runtime-error");
MAP(SWIG_IndexError, "swig-index-error");
MAP(SWIG_TypeError, "swig-type-error");
MAP(SWIG_DivisionByZero, "swig-division-by-zero");
MAP(SWIG_OverflowError, "swig-overflow-error");
MAP(SWIG_SyntaxError, "swig-syntax-error");
MAP(SWIG_ValueError, "swig-value-error");
MAP(SWIG_SystemError, "swig-system-error");
MAP(SWIG_NullReferenceError, "swig-null-reference-error");
default:
ERROR("swig-error");
}
#undef ERROR
#undef MAP
}
#define SWIG_exception(a,b) SWIG_exception_(a, b)
%}
#endif
#ifdef SWIGJAVA
%{
SWIGINTERN void SWIG_JavaException(JNIEnv *jenv, int code, const char *msg) {

3
Lib/mzscheme/Makefile
View File

@ -1,3 +0,0 @@
co:
co RCS/*.i* RCS/*.swg*

41
Lib/mzscheme/argcargv.i
View File

@ -1,41 +0,0 @@
/* -------------------------------------------------------------
* SWIG library containing argc and argv multi-argument typemaps
* ------------------------------------------------------------- */
%typemap(in) (int ARGC, char **ARGV) {
$1_ltype i, len;
Scheme_Object **elems;
SWIG_contract_assert($input != (Scheme_Object *)NULL &&
$input != scheme_null &&
SCHEME_TYPE($input) == scheme_vector_type, "null array");
len = SCHEME_VEC_SIZE($input);
$1 = len;
$2 = ($2_ltype) SWIG_MzScheme_Malloc((size_t)(len+1)*sizeof($*2_ltype), FUNC_NAME);
elems = SCHEME_VEC_ELS($input);
for (i = 0; i < len; i++) {
SWIG_contract_assert(SCHEME_TYPE(elems[i]) == scheme_char_string_type,
"elements in array must be strings");
$2[i] = ($*2_ltype)SCHEME_STR_VAL(elems[i]);
}
$2[i] = NULL;
}
%typemap(typecheck, precedence=SWIG_TYPECHECK_STRING_ARRAY) (int ARGC, char **ARGV) {
if ($input != (Scheme_Object *)NULL && $input != scheme_null &&
SCHEME_TYPE($input) == scheme_vector_type) {
size_t len = SCHEME_VEC_SIZE($input);
size_t i;
Scheme_Object **elems = SCHEME_VEC_ELS($input);
for (i = 0; i < len; i++) {
if (SCHEME_TYPE(elems[i]) != scheme_char_string_type) {
break;
}
}
/* All elements are strings! */
$1 = (i == len);
}
}
%typemap(freearg) (int ARGC, char **ARGV) {
SWIG_free((void *)$2);
}

19
Lib/mzscheme/cdata.i
View File

@ -1,19 +0,0 @@
/* -----------------------------------------------------------------------------
* cdata.i
*
* SWIG library file containing macros for manipulating raw C data.
*
* TODO:
* Use generic cdata by deleting this file and implementing
* SWIG_AsCharPtrAndSize() and SWIG_FromCharPtrAndSize()
* Or implement (void *BYTES, size_t LENGTH) and SWIGCDATA typemaps
* ----------------------------------------------------------------------------- */
%typemap(in) (const void *BYTES, size_t LENGTH) {}
%apply (const void *BYTES, size_t LENGTH) { (void *BYTES, size_t LENGTH) }
%include <typemaps/cdata_begin.swg>
%typemap(out) SWIGCDATA ""
%include <typemaps/cdata_end.swg>

523
Lib/mzscheme/mzrun.swg
View File

@ -1,523 +0,0 @@
/* -----------------------------------------------------------------------------
* mzrun.swg
* ----------------------------------------------------------------------------- */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <limits.h>
#include <escheme.h>
#include <assert.h>
#ifdef __cplusplus
extern "C" {
#endif
/* Common SWIG API */
#define SWIG_ConvertPtr(s, result, type, flags) \
SWIG_MzScheme_ConvertPtr(s, result, type, flags)
#define SWIG_NewPointerObj(ptr, type, owner) \
SWIG_MzScheme_NewPointerObj((void *)ptr, type, owner)
#define SWIG_MustGetPtr(s, type, argnum, flags) \
SWIG_MzScheme_MustGetPtr(s, type, argnum, flags, FUNC_NAME, argc, argv)
#define SWIG_contract_assert(expr,msg) \
do { \
if (!(expr)) { \
size_t len=strlen(msg)+1000; \
char *m=(char *) scheme_malloc(len); \
SWIG_snprintf2(m, len, "SWIG contract, assertion failed: function=%s, message=%s", \
(char *) FUNC_NAME,(char *) msg); \
scheme_signal_error(m); \
} \
} while (0)
/* Runtime API */
#define SWIG_GetModule(clientdata) SWIG_MzScheme_GetModule((Scheme_Env *)(clientdata))
#define SWIG_SetModule(clientdata, pointer) SWIG_MzScheme_SetModule((Scheme_Env *) (clientdata), pointer)
#define SWIG_MODULE_CLIENTDATA_TYPE Scheme_Env *
/* MzScheme-specific SWIG API */
#define SWIG_malloc(size) SWIG_MzScheme_Malloc(size, FUNC_NAME)
#define SWIG_free(mem) free(mem)
#define SWIG_NewStructFromPtr(ptr,type) \
_swig_convert_struct_##type##(ptr)
#define MAXVALUES 6
#define swig_make_boolean(b) (b ? scheme_true : scheme_false)
static long
SWIG_convert_integer(Scheme_Object *o,
long lower_bound, long upper_bound,
const char *func_name, int argnum, int argc,
Scheme_Object **argv)
{
long value;
int status = scheme_get_int_val(o, &value);
if (!status)
scheme_wrong_type(func_name, "integer", argnum, argc, argv);
if (value < lower_bound || value > upper_bound)
scheme_wrong_type(func_name, "integer", argnum, argc, argv);
return value;
}
static int
SWIG_is_integer(Scheme_Object *o)
{
long value;
return scheme_get_int_val(o, &value);
}
static unsigned long
SWIG_convert_unsigned_integer(Scheme_Object *o,
unsigned long lower_bound, unsigned long upper_bound,
const char *func_name, int argnum, int argc,
Scheme_Object **argv)
{
unsigned long value;
int status = scheme_get_unsigned_int_val(o, &value);
if (!status)
scheme_wrong_type(func_name, "integer", argnum, argc, argv);
if (value < lower_bound || value > upper_bound)
scheme_wrong_type(func_name, "integer", argnum, argc, argv);
return value;
}
static int
SWIG_is_unsigned_integer(Scheme_Object *o)
{
unsigned long value;
return scheme_get_unsigned_int_val(o, &value);
}
/* -----------------------------------------------------------------------
* mzscheme 30X support code
* ----------------------------------------------------------------------- */
#ifndef SCHEME_STR_VAL
#define MZSCHEME30X 1
#endif
#ifdef MZSCHEME30X
/*
* This is MZSCHEME 299.100 or higher (30x). From version 299.100 of
* mzscheme upwards, strings are in unicode. These functions convert
* to and from utf8 encodings of these strings. NB! strlen(s) will be
* the size in bytes of the string, not the actual length.
*/
#define SCHEME_STR_VAL(obj) SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(obj))
#define SCHEME_STRLEN_VAL(obj) SCHEME_BYTE_STRLEN_VAL(scheme_char_string_to_byte_string(obj))
#define SCHEME_STRINGP(obj) SCHEME_CHAR_STRINGP(obj)
#define scheme_make_string(s) scheme_make_utf8_string(s)
#define scheme_make_sized_string(s,l) scheme_make_sized_utf8_string(s,l)
#define scheme_make_sized_offset_string(s,d,l) \
scheme_make_sized_offset_utf8_string(s,d,l)
#define SCHEME_MAKE_STRING(s) scheme_make_utf8_string(s)
#else
#define SCHEME_MAKE_STRING(s) scheme_make_string_without_copying(s)
#endif
/* -----------------------------------------------------------------------
* End of mzscheme 30X support code
* ----------------------------------------------------------------------- */
struct swig_mz_proxy {
Scheme_Type mztype;
swig_type_info *type;
void *object;
int own;
};
static Scheme_Type swig_type;
static void
mz_free_swig(void *p, void *data) {
struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) p;
if (SCHEME_NULLP((Scheme_Object*)p) || SCHEME_TYPE((Scheme_Object*)p) != swig_type)
return;
if (proxy->type) {
if (proxy->type->clientdata && proxy->own) {
((Scheme_Prim *)proxy->type->clientdata)(1, (Scheme_Object **)&proxy);
}
}
}
static Scheme_Object *
SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) {
if (ptr) {
struct swig_mz_proxy *new_proxy;
new_proxy = (struct swig_mz_proxy *) scheme_malloc(sizeof(struct swig_mz_proxy));
new_proxy->mztype = swig_type;
new_proxy->type = type;
new_proxy->object = ptr;
new_proxy->own = owner & SWIG_POINTER_OWN;
if (new_proxy->own) {
scheme_add_finalizer(new_proxy, mz_free_swig, NULL);
}
return (Scheme_Object *) new_proxy;
} else {
return scheme_make_null();
}
}
static int
SWIG_MzScheme_ConvertPtr(Scheme_Object *s, void **result, swig_type_info *type, int flags) {
swig_cast_info *cast;
int ret = SWIG_ERROR;
if (SCHEME_NULLP(s)) {
*result = NULL;
return (flags & SWIG_POINTER_NO_NULL) ? SWIG_NullReferenceError : SWIG_OK;
} else if (SCHEME_TYPE(s) == swig_type) {
struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) s;
if ((flags & SWIG_POINTER_RELEASE) == SWIG_POINTER_RELEASE && !proxy->own) {
return SWIG_ERROR_RELEASE_NOT_OWNED;
}
if (type) {
cast = SWIG_TypeCheckStruct(proxy->type, type);
if (cast) {
int newmemory = 0;
*result = SWIG_TypeCast(cast, proxy->object, &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
ret = SWIG_OK;
} else {
return SWIG_ERROR;
}
} else {
*result = proxy->object;
ret = SWIG_OK;
}
if (flags & SWIG_POINTER_DISOWN) {
scheme_subtract_finalizer(proxy, mz_free_swig, NULL);
proxy->own = 0;
}
if (flags & SWIG_POINTER_CLEAR) {
proxy->object = 0;
}
}
return ret;
}
static SWIGINLINE void *
SWIG_MzScheme_MustGetPtr(Scheme_Object *s, swig_type_info *type,
int argnum, int flags, const char *func_name,
int argc, Scheme_Object **argv) {
void *result;
if (SWIG_MzScheme_ConvertPtr(s, &result, type, flags)) {
scheme_wrong_type(func_name, type->str ? type->str : "void *", argnum - 1, argc, argv);
}
return result;
}
static SWIGINLINE void *
SWIG_MzScheme_Malloc(size_t size, const char *func_name) {
void *p = malloc(size);
if (p == NULL) {
scheme_signal_error("swig-memory-error");
}
return p;
}
static Scheme_Object *
SWIG_MzScheme_PackageValues(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);
}
#ifndef scheme_make_inspector
#define scheme_make_inspector(x,y) \
_scheme_apply(scheme_builtin_value("make-inspector"), x, y)
#endif
/* Function to create a new struct. */
static Scheme_Object *
SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename,
int num_fields, char** field_names)
{
Scheme_Object *new_type;
int count_out, i;
Scheme_Object **struct_names;
Scheme_Object **vals;
Scheme_Object **a = (Scheme_Object**) \
scheme_malloc(num_fields*sizeof(Scheme_Object*));
for (i=0; i<num_fields; ++i) {
a[i] = (Scheme_Object*) scheme_intern_symbol(field_names[i]);
}
new_type = scheme_make_struct_type(scheme_intern_symbol(basename),
NULL /*super_type*/,
scheme_make_inspector(0, NULL),
num_fields,
0 /* auto_fields */,
NULL /* auto_val */,
NULL /* properties */
#ifdef MZSCHEME30X
,NULL /* Guard */
#endif
);
struct_names = scheme_make_struct_names(scheme_intern_symbol(basename),
scheme_build_list(num_fields,a),
0 /*flags*/, &count_out);
vals = scheme_make_struct_values(new_type, struct_names, count_out, 0);
for (i = 0; i < count_out; i++)
scheme_add_global_symbol(struct_names[i], vals[i],env);
return new_type;
}
#if defined(_WIN32) || defined(__WIN32__)
#define __OS_WIN32
#endif
#ifdef __OS_WIN32
#include <windows.h>
#else
#include <dlfcn.h>
#endif
static char **mz_dlopen_libraries=NULL;
static void **mz_libraries=NULL;
static char **mz_dynload_libpaths=NULL;
static void mz_set_dlopen_libraries(const char *_libs)
{
int i,k,n;
int mz_dynload_debug=(1==0);
char *extra_paths[1000];
char *EP;
{
char *dbg=getenv("MZ_DYNLOAD_DEBUG");
if (dbg!=NULL) {
mz_dynload_debug=atoi(dbg);
}
}
{
char *ep=getenv("MZ_DYNLOAD_LIBPATH");
int i,k,j;
k=0;
if (ep!=NULL) {
EP=strdup(ep);
for(i=0,j=0;EP[i]!='\0';i++) {
if (EP[i]==':') {
EP[i]='\0';
extra_paths[k++]=&EP[j];
j=i+1;
}
}
if (j!=i) {
extra_paths[k++]=&EP[j];
}
}
else {
EP=strdup("");
}
extra_paths[k]=NULL;
k+=1;
if (mz_dynload_debug) {
fprintf(stderr,"SWIG:mzscheme:MZ_DYNLOAD_LIBPATH=%s\n",(ep==NULL) ? "(null)" : ep);
fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]\n",k-1);
for(i=0;i<k-1;i++) {
fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]=%s\n",i,extra_paths[i]);
}
}
mz_dynload_libpaths=(char **) malloc(sizeof(char *)*k);
for(i=0;i<k;i++) {
if (extra_paths[i]!=NULL) {
mz_dynload_libpaths[i]=strdup(extra_paths[i]);
}
else {
mz_dynload_libpaths[i]=NULL;
}
}
if (mz_dynload_debug) {
int i;
for(i=0;extra_paths[i]!=NULL;i++) {
fprintf(stderr,"SWIG:mzscheme:%s\n",extra_paths[i]);
}
}
}
{
#ifdef MZ_DYNLOAD_LIBS
char *libs=(char *) malloc((strlen(MZ_DYNLOAD_LIBS)+1)*sizeof(char));
strcpy(libs,MZ_DYNLOAD_LIBS);
#else
char *libs=(char *) malloc((strlen(_libs)+1)*sizeof(char));
strcpy(libs,_libs);
#endif
for(i=0,n=strlen(libs),k=0;i<n;i++) {
if (libs[i]==',') { k+=1; }
}
k+=1;
mz_dlopen_libraries=(char **) malloc(sizeof(char *)*(k+1));
mz_dlopen_libraries[0]=libs;
for(i=0,k=1,n=strlen(libs);i<n;i++) {
if (libs[i]==',') {
libs[i]='\0';
mz_dlopen_libraries[k++]=&libs[i+1];
i+=1;
}
}
if (mz_dynload_debug) {
fprintf(stderr,"k=%d\n",k);
}
mz_dlopen_libraries[k]=NULL;
free(EP);
}
}
static void *mz_load_function(char *function)
{
int mz_dynload_debug=(1==0);
{
char *dbg=getenv("MZ_DYNLOAD_DEBUG");
if (dbg!=NULL) {
mz_dynload_debug=atoi(dbg);
}
}
if (mz_dlopen_libraries==NULL) {
return NULL;
}
else {
if (mz_libraries==NULL) {
int i,n;
for(n=0;mz_dlopen_libraries[n]!=NULL;n++);
if (mz_dynload_debug) {
fprintf(stderr,"SWIG:mzscheme:n=%d\n",n);
}
mz_libraries=(void **) malloc(sizeof(void*)*n);
for(i=0;i<n;i++) {
if (mz_dynload_debug) {
fprintf(stderr,"SWIG:mzscheme:loading %s\n",mz_dlopen_libraries[i]);
}
#ifdef __OS_WIN32
mz_libraries[i]=(void *) LoadLibrary(mz_dlopen_libraries[i]);
#else
mz_libraries[i]=(void *) dlopen(mz_dlopen_libraries[i],RTLD_LAZY);
#endif
if (mz_libraries[i]==NULL) {
int k;
char *libp;
for(k=0;mz_dynload_libpaths[k]!=NULL && mz_libraries[i]==NULL;k++) {
int L=strlen(mz_dynload_libpaths[k])+strlen("\\")+strlen(mz_dlopen_libraries[i])+1;
libp=(char *) malloc(L*sizeof(char));
#ifdef __OS_WIN32
SWIG_snprintf2(libp,L,"%s\\%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]);
mz_libraries[i]=(void *) LoadLibrary(libp);
#else
SWIG_snprintf2(libp,L,"%s/%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]);
mz_libraries[i]=(void *) dlopen(libp,RTLD_LAZY);
#endif
if (mz_dynload_debug) {
fprintf(stderr,"SWIG:mzscheme:trying %s --> %p\n",libp,mz_libraries[i]);
}
free(libp);
}
}
}
}
{
int i;
void *func=NULL;
for(i=0;mz_dlopen_libraries[i]!=NULL && func==NULL;i++) {
if (mz_libraries[i]!=NULL) {
#ifdef __OS_WIN32
func=GetProcAddress(mz_libraries[i],function);
#else
func=dlsym(mz_libraries[i],function);
#endif
}
if (mz_dynload_debug) {
fprintf(stderr,
"SWIG:mzscheme:library:%s;dlopen=%p,function=%s,func=%p\n",
mz_dlopen_libraries[i],mz_libraries[i],function,func
);
}
}
return func;
}
}
}
/* The interpreter will store a pointer to this structure in a global
variable called swig-runtime-data-type-pointer. The instance of this
struct is only used if no other module has yet been loaded */
struct swig_mzscheme_runtime_data {
swig_module_info *module_head;
Scheme_Type type;
};
static struct swig_mzscheme_runtime_data swig_mzscheme_runtime_data;
static swig_module_info *
SWIG_MzScheme_GetModule(Scheme_Env *env) {
Scheme_Object *pointer, *symbol;
struct swig_mzscheme_runtime_data *data;
/* first check if pointer already created */
symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME);
pointer = scheme_lookup_global(symbol, env);
if (pointer && SCHEME_CPTRP(pointer)) {
data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer);
swig_type = data->type;
return data->module_head;
} else {
return NULL;
}
}
static void
SWIG_MzScheme_SetModule(Scheme_Env *env, swig_module_info *module) {
Scheme_Object *pointer, *symbol;
struct swig_mzscheme_runtime_data *data;
/* first check if pointer already created */
symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME);
pointer = scheme_lookup_global(symbol, env);
if (pointer && SCHEME_CPTRP(pointer)) {
data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer);
swig_type = data->type;
data->module_head = module;
} else {
/* create a new type for wrapped pointer values */
swig_type = scheme_make_type((char *)"swig");
swig_mzscheme_runtime_data.module_head = module;
swig_mzscheme_runtime_data.type = swig_type;
/* create a new pointer */
#ifndef MZSCHEME30X
pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, "swig_mzscheme_runtime_data");
#else
pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data,
scheme_make_byte_string("swig_mzscheme_runtime_data"));
#endif
scheme_add_global_symbol(symbol, pointer, env);
}
}
#ifdef __cplusplus
}
#endif

54
Lib/mzscheme/mzscheme.swg
View File

@ -1,54 +0,0 @@
/* -----------------------------------------------------------------------------
* mzscheme.swg
*
* SWIG Configuration File for MzScheme.
* This file is parsed by SWIG before reading any other interface file.
* ----------------------------------------------------------------------------- */
/* Include headers */
%runtime "swigrun.swg" // Common C API type-checking code
%runtime "swigerrors.swg" // SWIG errors
%runtime "mzrun.swg"
#define SWIG_APPEND_VALUE(value) values[lenv++] = value
/* Definitions */
#define SWIG_malloc(size) swig_malloc(size, FUNC_NAME)
#define SWIG_free(mem) free(mem)
#define SWIG_convert_short(o) \
SWIG_convert_integer(o, - (1 << (8 * sizeof(short) - 1)), \
(1 << (8 * sizeof(short) - 1)) - 1, \
FUNC_NAME, $argnum-1, argc, argv)
#define SWIG_convert_int(o) \
SWIG_convert_integer(o, INT_MIN, INT_MAX, \
FUNC_NAME, $argnum-1, argc, argv)
#define SWIG_convert_long(o) \
SWIG_convert_integer(o, LONG_MIN, LONG_MAX, \
FUNC_NAME, $argnum-1, argc, argv)
#define SWIG_convert_unsigned_short(o) \
SWIG_convert_unsigned_integer(o, 0, \
(1 << (8 * sizeof(short))) - 1, \
FUNC_NAME, $argnum-1, argc, argv)
#define SWIG_convert_unsigned_int(o) \
SWIG_convert_unsigned_integer(o, 0, UINT_MAX, \
FUNC_NAME, $argnum-1, argc, argv)
#define SWIG_convert_unsigned_long(o) \
SWIG_convert_unsigned_integer(o, 0, ULONG_MAX, \
FUNC_NAME, $argnum-1, argc, argv)
/* 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>
%insert(init) "swiginit.swg"
%init %{
Scheme_Object *scheme_reload(Scheme_Env *env) {
Scheme_Env *menv = SWIG_MZSCHEME_CREATE_MENV(env);
SWIG_InitializeModule((void *) env);
%}

39
Lib/mzscheme/std_auto_ptr.i
View File

@ -1,39 +0,0 @@
/* -----------------------------------------------------------------------------
* std_auto_ptr.i
*
* SWIG library file for handling std::auto_ptr.
* Memory ownership is passed from the std::auto_ptr C++ layer to the proxy
* class when returning a std::auto_ptr from a function.
* Memory ownership is passed from the proxy class to the std::auto_ptr in the
* C++ layer when passed as a parameter to a wrapped function.
* ----------------------------------------------------------------------------- */
%define %auto_ptr(TYPE)
%typemap(in, noblock=1) std::auto_ptr< TYPE > (void *argp = 0, int res = 0) {
res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), SWIG_POINTER_RELEASE);
if (!SWIG_IsOK(res)) {
if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'");
} else {
%argument_fail(res, "TYPE *", $symname, $argnum);
}
}
$1.reset((TYPE *)argp);
}
%typemap (out) std::auto_ptr< TYPE > %{
%set_output(SWIG_NewPointerObj($1.release(), $descriptor(TYPE *), SWIG_POINTER_OWN));
%}
%typemap(typecheck, precedence=SWIG_TYPECHECK_POINTER, equivalent="TYPE *", noblock=1) std::auto_ptr< TYPE > {
void *vptr = 0;
int res = SWIG_ConvertPtr($input, &vptr, $descriptor(TYPE *), 0);
$1 = SWIG_CheckState(res);
}
%template() std::auto_ptr< TYPE >;
%enddef
namespace std {
template <class T> class auto_ptr {};
}

23
Lib/mzscheme/std_common.i
View File

@ -1,23 +0,0 @@
/* -----------------------------------------------------------------------------
* std_common.i
*
* SWIG typemaps for STL - common utilities
* ----------------------------------------------------------------------------- */
%include <std/std_except.i>
%apply size_t { std::size_t };
%{
#include <string>
SWIGINTERNINLINE
std::string swig_scm_to_string(Scheme_Object *x) {
return std::string(SCHEME_STR_VAL(x));
}
SWIGINTERNINLINE
Scheme_Object *swig_make_string(const std::string &s) {
return scheme_make_string(s.c_str());
}
%}

1
Lib/mzscheme/std_deque.i
View File

@ -1 +0,0 @@
%include <std/_std_deque.i>

284
Lib/mzscheme/std_map.i
View File

@ -1,284 +0,0 @@
/* -----------------------------------------------------------------------------
* std_map.i
*
* SWIG typemaps for std::map
* ----------------------------------------------------------------------------- */
%include <std_common.i>
%include <exception.i>
// ------------------------------------------------------------------------
// std::map
//
// The aim of all that follows would be to integrate std::map with
// MzScheme as much as possible, namely, to allow the user to pass and
// be returned Scheme association lists.
// const declarations are used to guess the intent of the function being
// exported; therefore, the following rationale is applied:
//
// -- f(std::map<T>), f(const std::map<T>&), f(const std::map<T>*):
// the parameter being read-only, either a Scheme alist or a
// previously wrapped std::map<T> can be passed.
// -- f(std::map<T>&), f(std::map<T>*):
// the parameter must be modified; therefore, only a wrapped std::map
// can be passed.
// -- std::map<T> f():
// the map is returned by copy; therefore, a Scheme alist
// is returned which is most easily used in other Scheme functions
// -- std::map<T>& f(), std::map<T>* f(), const std::map<T>& f(),
// const std::map<T>* f():
// the map is returned by reference; therefore, a wrapped std::map
// is returned
// ------------------------------------------------------------------------
%{
#include <map>
#include <algorithm>
#include <stdexcept>
%}
// exported class
namespace std {
template<class K, class T, class C = std::less<K> > class map {
%typemap(in) map< K, T, C > (std::map< K, T, C >* m) {
if (SCHEME_NULLP($input)) {
$1 = std::map< K, T, C >();
} else if (SCHEME_PAIRP($input)) {
$1 = std::map< K, T, C >();
Scheme_Object* alist = $input;
while (!SCHEME_NULLP(alist)) {
K* k;
T* x;
Scheme_Object *entry, *key, *val;
entry = scheme_car(alist);
if (!SCHEME_PAIRP(entry))
SWIG_exception(SWIG_TypeError,"alist expected");
key = scheme_car(entry);
val = scheme_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) == -1) {
if (!SCHEME_PAIRP(val))
SWIG_exception(SWIG_TypeError,"alist expected");
val = scheme_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
}
%#ifdef __cpp_lib_map_try_emplace
(($1_type &)$1).insert_or_assign(*k, *x);
%#else
(($1_type &)$1)[*k] = *x;
%#endif
alist = scheme_cdr(alist);
}
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%typemap(in) const map< K, T, C >& (std::map< K, T, C > temp,
std::map< K, T, C >* m),
const map< K, T, C >* (std::map< K, T, C > temp,
std::map< K, T, C >* m) {
if (SCHEME_NULLP($input)) {
temp = std::map< K, T, C >();
$1 = &temp;
} else if (SCHEME_PAIRP($input)) {
temp = std::map< K, T, C >();
$1 = &temp;
Scheme_Object* alist = $input;
while (!SCHEME_NULLP(alist)) {
K* k;
T* x;
Scheme_Object *entry, *key, *val;
entry = scheme_car(alist);
if (!SCHEME_PAIRP(entry))
SWIG_exception(SWIG_TypeError,"alist expected");
key = scheme_car(entry);
val = scheme_cdr(entry);
k = (K*) SWIG_MustGetPtr(key,$descriptor(K *),$argnum, 0);
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) == -1) {
if (!SCHEME_PAIRP(val))
SWIG_exception(SWIG_TypeError,"alist expected");
val = scheme_car(val);
x = (T*) SWIG_MustGetPtr(val,$descriptor(T *),$argnum, 0);
}
%#ifdef __cpp_lib_map_try_emplace
temp.insert_or_assign(*k, *x);
%#else
temp[*k] = *x;
%#endif
alist = scheme_cdr(alist);
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%typemap(out) map< K, T, C > {
Scheme_Object* alist = scheme_null;
for (std::map< K, T, C >::reverse_iterator i=$1.rbegin();
i!=$1.rend(); ++i) {
K* key = new K(i->first);
T* val = new T(i->second);
Scheme_Object* k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
Scheme_Object* x = SWIG_NewPointerObj(val,$descriptor(T *), 1);
Scheme_Object* entry = scheme_make_pair(k,x);
alist = scheme_make_pair(entry,alist);
}
$result = alist;
}
%typecheck(SWIG_TYPECHECK_MAP) map< K, T, C > {
/* native sequence? */
if (SCHEME_NULLP($input)) {
/* an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
K* k;
T* x;
Scheme_Object* head = scheme_car($input);
if (SCHEME_PAIRP(head)) {
Scheme_Object* key = scheme_car(head);
Scheme_Object* val = scheme_cdr(head);
if (SWIG_ConvertPtr(key,(void**) &k,
$descriptor(K *), 0) == -1) {
$1 = 0;
} else {
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) != -1) {
$1 = 1;
} else if (SCHEME_PAIRP(val)) {
val = scheme_car(val);
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) != -1)
$1 = 1;
else
$1 = 0;
} else {
$1 = 0;
}
}
} else {
$1 = 0;
}
} else {
/* wrapped map? */
std::map< K, T, C >* m;
if (SWIG_ConvertPtr($input,(void **) &m,
$&1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_MAP) const map< K, T, C >&,
const map< K, T, C >* {
/* native sequence? */
if (SCHEME_NULLP($input)) {
/* an empty sequence can be of any type */
$1 = 1;
} else if (SCHEME_PAIRP($input)) {
/* check the first element only */
K* k;
T* x;
Scheme_Object* head = scheme_car($input);
if (SCHEME_PAIRP(head)) {
Scheme_Object* key = scheme_car(head);
Scheme_Object* val = scheme_cdr(head);
if (SWIG_ConvertPtr(key,(void**) &k,
$descriptor(K *), 0) == -1) {
$1 = 0;
} else {
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) != -1) {
$1 = 1;
} else if (SCHEME_PAIRP(val)) {
val = scheme_car(val);
if (SWIG_ConvertPtr(val,(void**) &x,
$descriptor(T *), 0) != -1)
$1 = 1;
else
$1 = 0;
} else {
$1 = 0;
}
}
} else {
$1 = 0;
}
} else {
/* wrapped map? */
std::map< K, T, C >* m;
if (SWIG_ConvertPtr($input,(void **) &m,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%rename("length") size;
%rename("null?") empty;
%rename("clear!") clear;
%rename("ref") __getitem__;
%rename("set!") __setitem__;
%rename("delete!") __delitem__;
%rename("has-key?") has_key;
public:
typedef size_t size_type;
typedef ptrdiff_t difference_type;
typedef K key_type;
typedef T mapped_type;
typedef std::pair< const K, T > value_type;
typedef value_type* pointer;
typedef const value_type* const_pointer;
typedef value_type& reference;
typedef const value_type& const_reference;
map();
map(const map& other);
unsigned int size() const;
bool empty() const;
void clear();
%extend {
T& __getitem__(const K& key) throw (std::out_of_range) {
std::map< K, T, C >::iterator i = self->find(key);
if (i != self->end())
return i->second;
else
throw std::out_of_range("key not found");
}
void __setitem__(const K& key, const T& x) {
%#ifdef __cpp_lib_map_try_emplace
(*self).insert_or_assign(key, x);
%#else
(*self)[key] = x;
%#endif
}
void __delitem__(const K& key) throw (std::out_of_range) {
std::map< K, T, C >::iterator i = self->find(key);
if (i != self->end())
self->erase(i);
else
throw std::out_of_range("key not found");
}
bool has_key(const K& key) {
std::map< K, T, C >::iterator i = self->find(key);
return i != self->end();
}
Scheme_Object* keys() {
Scheme_Object* result = scheme_null;
for (std::map< K, T, C >::reverse_iterator i=self->rbegin();
i!=self->rend(); ++i) {
K* key = new K(i->first);
Scheme_Object* k = SWIG_NewPointerObj(key,$descriptor(K *), 1);
result = scheme_make_pair(k,result);
}
return result;
}
}
};
}

874
Lib/mzscheme/std_pair.i
View File

@ -1,874 +0,0 @@
/* -----------------------------------------------------------------------------
* std_pair.i
*
* SWIG typemaps for std::pair
* ----------------------------------------------------------------------------- */
%include <std_common.i>
%include <exception.i>
// ------------------------------------------------------------------------
// std::pair
//
// See std_vector.i for the rationale of typemap application
// ------------------------------------------------------------------------
%{
#include <utility>
%}
// exported class
namespace std {
template<class T, class U> struct pair {
%typemap(in) pair<T,U> (std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
T* x;
U* y;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
x = (T*) SWIG_MustGetPtr(first,$descriptor(T *),$argnum, 0);
y = (U*) SWIG_MustGetPtr(second,$descriptor(U *),$argnum, 0);
$1 = std::make_pair(*x,*y);
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%typemap(in) const pair<T,U>& (std::pair<T,U> temp,
std::pair<T,U>* m),
const pair<T,U>* (std::pair<T,U> temp,
std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
T* x;
U* y;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
x = (T*) SWIG_MustGetPtr(first,$descriptor(T *),$argnum, 0);
y = (U*) SWIG_MustGetPtr(second,$descriptor(U *),$argnum, 0);
temp = std::make_pair(*x,*y);
$1 = &temp;
} else {
$1 = ($1_ltype)
SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%typemap(out) pair<T,U> {
T* x = new T($1.first);
U* y = new U($1.second);
Scheme_Object* first = SWIG_NewPointerObj(x,$descriptor(T *), 1);
Scheme_Object* second = SWIG_NewPointerObj(y,$descriptor(U *), 1);
$result = scheme_make_pair(first,second);
}
%typecheck(SWIG_TYPECHECK_PAIR) pair<T,U> {
/* native pair? */
if (SCHEME_PAIRP($input)) {
T* x;
U* y;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (SWIG_ConvertPtr(first,(void**) &x,
$descriptor(T *), 0) != -1 &&
SWIG_ConvertPtr(second,(void**) &y,
$descriptor(U *), 0) != -1) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$&1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_PAIR) const pair<T,U>&,
const pair<T,U>* {
/* native pair? */
if (SCHEME_PAIRP($input)) {
T* x;
U* y;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (SWIG_ConvertPtr(first,(void**) &x,
$descriptor(T *), 0) != -1 &&
SWIG_ConvertPtr(second,(void**) &y,
$descriptor(U *), 0) != -1) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
typedef T first_type;
typedef U second_type;
pair();
pair(T first, U second);
pair(const pair& other);
template <class U1, class U2> pair(const pair<U1, U2> &other);
T first;
U second;
};
// specializations for built-ins
%define specialize_std_pair_on_first(T,CHECK,CONVERT_FROM,CONVERT_TO)
template<class U> struct pair<T,U> {
%typemap(in) pair<T,U> (std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
U* y;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
if (!CHECK(first))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
y = (U*) SWIG_MustGetPtr(second,$descriptor(U *),$argnum, 0);
$1 = std::make_pair(CONVERT_FROM(first),*y);
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%typemap(in) const pair<T,U>& (std::pair<T,U> temp,
std::pair<T,U>* m),
const pair<T,U>* (std::pair<T,U> temp,
std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
U* y;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
if (!CHECK(first))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
y = (U*) SWIG_MustGetPtr(second,$descriptor(U *),$argnum, 0);
temp = std::make_pair(CONVERT_FROM(first),*y);
$1 = &temp;
} else {
$1 = ($1_ltype)
SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%typemap(out) pair<T,U> {
U* y = new U($1.second);
Scheme_Object* second = SWIG_NewPointerObj(y,$descriptor(U *), 1);
$result = scheme_make_pair(CONVERT_TO($1.first),second);
}
%typecheck(SWIG_TYPECHECK_PAIR) pair<T,U> {
/* native pair? */
if (SCHEME_PAIRP($input)) {
U* y;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (CHECK(first) &&
SWIG_ConvertPtr(second,(void**) &y,
$descriptor(U *), 0) != -1) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$&1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_PAIR) const pair<T,U>&,
const pair<T,U>* {
/* native pair? */
if (SCHEME_PAIRP($input)) {
U* y;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (CHECK(first) &&
SWIG_ConvertPtr(second,(void**) &y,
$descriptor(U *), 0) != -1) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
pair();
pair(T first, U second);
pair(const pair& other);
template <class U1, class U2> pair(const pair<U1, U2> &other);
T first;
U second;
};
%enddef
%define specialize_std_pair_on_second(U,CHECK,CONVERT_FROM,CONVERT_TO)
template<class T> struct pair<T,U> {
%typemap(in) pair<T,U> (std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
T* x;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
x = (T*) SWIG_MustGetPtr(first,$descriptor(T *),$argnum, 0);
if (!CHECK(second))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
$1 = std::make_pair(*x,CONVERT_FROM(second));
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%typemap(in) const pair<T,U>& (std::pair<T,U> temp,
std::pair<T,U>* m),
const pair<T,U>* (std::pair<T,U> temp,
std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
T* x;
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
x = (T*) SWIG_MustGetPtr(first,$descriptor(T *),$argnum, 0);
if (!CHECK(second))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
temp = std::make_pair(*x,CONVERT_FROM(second));
$1 = &temp;
} else {
$1 = ($1_ltype)
SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%typemap(out) pair<T,U> {
T* x = new T($1.first);
Scheme_Object* first = SWIG_NewPointerObj(x,$descriptor(T *), 1);
$result = scheme_make_pair(first,CONVERT_TO($1.second));
}
%typecheck(SWIG_TYPECHECK_PAIR) pair<T,U> {
/* native pair? */
if (SCHEME_PAIRP($input)) {
T* x;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (SWIG_ConvertPtr(first,(void**) &x,
$descriptor(T *), 0) != -1 &&
CHECK(second)) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$&1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_PAIR) const pair<T,U>&,
const pair<T,U>* {
/* native pair? */
if (SCHEME_PAIRP($input)) {
T* x;
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (SWIG_ConvertPtr(first,(void**) &x,
$descriptor(T *), 0) != -1 &&
CHECK(second)) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
pair();
pair(T first, U second);
pair(const pair& other);
template <class U1, class U2> pair(const pair<U1, U2> &other);
T first;
U second;
};
%enddef
%define specialize_std_pair_on_both(T,CHECK_T,CONVERT_T_FROM,CONVERT_T_TO,
U,CHECK_U,CONVERT_U_FROM,CONVERT_U_TO)
template<> struct pair<T,U> {
%typemap(in) pair<T,U> (std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
Scheme_Object *first, *second;
first = scheme_car($input);
second = scheme_cdr($input);
if (!CHECK_T(first) || !CHECK_U(second))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
$1 = make_pair(CONVERT_T_FROM(first),
CONVERT_U_FROM(second));
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%typemap(in) const pair<T,U>& (std::pair<T,U> temp,
std::pair<T,U>* m),
const pair<T,U>* (std::pair<T,U> temp,
std::pair<T,U>* m) {
if (SCHEME_PAIRP($input)) {
Scheme_Object *first, *second;
T *x;
first = scheme_car($input);
second = scheme_cdr($input);
x = (T*) SWIG_MustGetPtr(first,$descriptor(T *),$argnum, 0);
if (!CHECK_T(first) || !CHECK_U(second))
SWIG_exception(SWIG_TypeError,
"pair<" #T "," #U "> expected");
temp = make_pair(CONVERT_T_FROM(first),
CONVERT_U_FROM(second));
$1 = &temp;
} else {
$1 = ($1_ltype)
SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%typemap(out) pair<T,U> {
$result = scheme_make_pair(CONVERT_T_TO($1.first),
CONVERT_U_TO($1.second));
}
%typecheck(SWIG_TYPECHECK_PAIR) pair<T,U> {
/* native pair? */
if (SCHEME_PAIRP($input)) {
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (CHECK_T(first) && CHECK_U(second)) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$&1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_PAIR) const pair<T,U>&,
const pair<T,U>* {
/* native pair? */
if (SCHEME_PAIRP($input)) {
Scheme_Object* first = scheme_car($input);
Scheme_Object* second = scheme_cdr($input);
if (CHECK_T(first) && CHECK_U(second)) {
$1 = 1;
} else {
$1 = 0;
}
} else {
/* wrapped pair? */
std::pair<T,U >* p;
if (SWIG_ConvertPtr($input,(void **) &p,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
pair();
pair(T first, U second);
pair(const pair& other);
template <class U1, class U2> pair(const pair<U1, U2> &other);
T first;
U second;
};
%enddef
specialize_std_pair_on_first(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_first(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_first(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_first(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_first(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_second(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_second(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_second(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_second(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_second(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
bool,SCHEME_BOOLP,
SCHEME_TRUEP,swig_make_boolean);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
unsigned int,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
unsigned short,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
unsigned long,SCHEME_INTP,
SCHEME_INT_VAL,scheme_make_integer_value);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
double,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
float,SCHEME_REALP,
scheme_real_to_double,scheme_make_double);
specialize_std_pair_on_both(std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string,
std::string,SCHEME_STRINGP,
swig_scm_to_string,swig_make_string);
}

64
Lib/mzscheme/std_string.i
View File

@ -1,64 +0,0 @@
/* -----------------------------------------------------------------------------
* std_string.i
*
* SWIG typemaps for std::string types
* ----------------------------------------------------------------------------- */
// ------------------------------------------------------------------------
// 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 {
%naturalvar string;
class string;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string {
if (SCHEME_STRINGP($input))
$1.assign(SCHEME_STR_VAL($input));
else
SWIG_exception(SWIG_TypeError, "string expected");
}
%typemap(in) const string & ($*1_ltype temp) {
if (SCHEME_STRINGP($input)) {
temp.assign(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());
}
%typemap(throws) string {
scheme_signal_error("%s: %s", FUNC_NAME, $1.c_str());
}
%typemap(throws) const string & {
scheme_signal_error("%s: %s", FUNC_NAME, $1.c_str());
}
}

69
Lib/mzscheme/std_unique_ptr.i
View File

@ -1,69 +0,0 @@
/* -----------------------------------------------------------------------------
* std_unique_ptr.i
*
* SWIG library file for handling std::unique_ptr.
*
* Returning a std::unique_ptr from a wrapped function:
* Memory ownership is passed (moved) from the std::unique_ptr in the C++ layer
* to the proxy class when returning a std::unique_ptr by value from a function.
* Memory ownership is not moved when returning by any sort of reference.
*
* Passing a std::unique_ptr as a parameter to a wrapped function:
* Memory ownership is passed from the proxy class to the std::unique_ptr in the
* C++ layer when passed as a parameter by value, rvalue reference or non-const
* lvalue reference. Memory ownership is not transferred when passing by const
* lvalue reference.
* ----------------------------------------------------------------------------- */
%include <unique_ptr.swg>
%define %unique_ptr(TYPE)
%typemap(in, noblock=1) std::unique_ptr< TYPE > (void *argp = 0, int res = 0) {
res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), SWIG_POINTER_RELEASE);
if (!SWIG_IsOK(res)) {
if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'");
} else {
%argument_fail(res, "TYPE *", $symname, $argnum);
}
}
$1.reset((TYPE *)argp);
}
%typemap(in, noblock=1) std::unique_ptr< TYPE > & (void *argp = 0, int res = 0, std::unique_ptr< TYPE > uptr), std::unique_ptr< TYPE > && (void *argp = 0, int res = 0, std::unique_ptr< TYPE > uptr) {
res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), SWIG_POINTER_RELEASE);
if (!SWIG_IsOK(res)) {
if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'");
} else {
%argument_fail(res, "TYPE *", $symname, $argnum);
}
}
uptr.reset((TYPE *)argp);
$1 = &uptr;
}
%typemap(in, noblock=1, fragment="SwigNoDeleteUniquePtr") const std::unique_ptr< TYPE > & (void *argp = 0, int res = 0, swig::NoDeleteUniquePtr< TYPE > ndup) {
res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), 0);
if (!SWIG_IsOK(res)) {
%argument_fail(res, "TYPE *", $symname, $argnum);
}
ndup.uptr.reset((TYPE *)argp);
$1 = &ndup.uptr;
}
%typemap (out) std::unique_ptr< TYPE > %{
%set_output(SWIG_NewPointerObj($1.release(), $descriptor(TYPE *), SWIG_POINTER_OWN));
%}
%typemap (out) std::unique_ptr< TYPE > &, std::unique_ptr< TYPE > && %{
%set_output(SWIG_NewPointerObj($1->get(), $descriptor(TYPE *), $owner));
%}
%typemap(typecheck, precedence=SWIG_TYPECHECK_POINTER, equivalent="TYPE *", noblock=1) std::unique_ptr< TYPE >, std::unique_ptr< TYPE > &, std::unique_ptr< TYPE > && {
void *vptr = 0;
int res = SWIG_ConvertPtr($input, &vptr, $descriptor(TYPE *), 0);
$1 = SWIG_CheckState(res);
}
%template() std::unique_ptr< TYPE >;
%enddef

454
Lib/mzscheme/std_vector.i
View File

@ -1,454 +0,0 @@
/* -----------------------------------------------------------------------------
* std_vector.i
*
* SWIG typemaps for std::vector
* ----------------------------------------------------------------------------- */
%include <std_common.i>
// ------------------------------------------------------------------------
// 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, 0));
}
} 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, 0)));
}
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%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, 0));
}
} 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, 0)));
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum, 0);
}
}
%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_NewPointerObj(x,$descriptor(T *), 1);
}
}
%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_ConvertPtr(items[0],(void**) &x,
$descriptor(T *), 0) != -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_ConvertPtr(head,(void**) &x,
$descriptor(T *), 0) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_ConvertPtr($input,(void **) &v,
$&1_descriptor, 0) != -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_ConvertPtr(items[0],(void**) &x,
$descriptor(T *), 0) != -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_ConvertPtr(head,(void**) &x,
$descriptor(T *), 0) != -1)
$1 = 1;
else
$1 = 0;
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_ConvertPtr($input,(void **) &v,
$1_descriptor, 0) != -1)
$1 = 1;
else
$1 = 0;
}
}
public:
typedef size_t size_type;
typedef ptrdiff_t difference_type;
typedef T value_type;
typedef value_type* pointer;
typedef const value_type* const_pointer;
typedef value_type& reference;
typedef const value_type& const_reference;
vector(unsigned int size = 0);
vector(unsigned int size, const T& value);
vector(const vector& other);
%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() throw (std::out_of_range) {
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) throw (std::out_of_range) {
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) throw (std::out_of_range) {
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 - 1, 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 - 1, argc, argv);
}
} else {
$1 = *(($&1_type)
SWIG_MustGetPtr($input,$&1_descriptor,$argnum, 0));
}
}
%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 - 1, 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 - 1, argc, argv);
}
} else {
$1 = ($1_ltype) SWIG_MustGetPtr($input,$1_descriptor,$argnum - 1, 0);
}
}
%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_ConvertPtr($input,(void **) &v,
$&1_descriptor, 0) != -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_ConvertPtr($input,(void **) &v,
$1_descriptor, 0) != -1) ? 1 : 0;
}
}
public:
typedef size_t size_type;
typedef ptrdiff_t difference_type;
typedef T value_type;
typedef value_type* pointer;
typedef const value_type* const_pointer;
typedef value_type& reference;
typedef const value_type& const_reference;
vector(unsigned int size = 0);
vector(unsigned int size, const T& value);
vector(const vector& other);
%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() throw (std::out_of_range) {
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) throw (std::out_of_range) {
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) throw (std::out_of_range) {
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
%typemap(throws) std::out_of_range {
scheme_signal_error("%s: %s", FUNC_NAME, $1.what());
}
specialize_std_vector(bool,SCHEME_BOOLP,SCHEME_TRUEP,\
swig_make_boolean);
specialize_std_vector(char,SCHEME_INTP,SCHEME_INT_VAL,\
scheme_make_integer_value);
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 char,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);
}

10
Lib/mzscheme/stl.i
View File

@ -1,10 +0,0 @@
/* -----------------------------------------------------------------------------
* stl.i
* ----------------------------------------------------------------------------- */
%include <std_common.i>
%include <std_string.i>
%include <std_vector.i>
%include <std_map.i>
%include <std_pair.i>

21
Lib/mzscheme/swigmove.i
View File

@ -1,21 +0,0 @@
/* -----------------------------------------------------------------------------
* swigmove.i
*
* Input typemaps library for implementing full move semantics when passing
* parameters by value.
* ----------------------------------------------------------------------------- */
%typemap(in, noblock=1) SWIGTYPE MOVE (void *argp = 0, int res = 0) {
res = SWIG_ConvertPtr($input, &argp, $&1_descriptor, SWIG_POINTER_RELEASE);
if (!SWIG_IsOK(res)) {
if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type '$1_type'");
} else {
%argument_fail(res, "$1_type", $symname, $argnum);
}
}
if (argp == NULL) scheme_signal_error(FUNC_NAME ": swig-type-error (null reference)");
SwigValueWrapper< $1_ltype >::reset($1, ($&1_type)argp);
}
%typemap(typecheck) SWIGTYPE MOVE = SWIGTYPE;

413
Lib/mzscheme/typemaps.i
View File

@ -1,413 +0,0 @@
/* -----------------------------------------------------------------------------
* typemaps.i
* ----------------------------------------------------------------------------- */
#define %set_output(obj) $result = obj
#define %set_varoutput(obj) $result = obj
#define %argument_fail(code, type, name, argn) scheme_wrong_type(FUNC_NAME, type, argn, argc, argv)
#define %as_voidptr(ptr) (void*)(ptr)
/* The MzScheme module handles all types uniformly via typemaps. Here
are the definitions. */
/* Pointers */
%typemap(in) SWIGTYPE * {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
}
%typemap(in) void * {
$1 = SWIG_MustGetPtr($input, NULL, $argnum, 0);
}
%typemap(varin) SWIGTYPE * {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, 1, 0);
}
%typemap(varin) SWIGTYPE & {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin) SWIGTYPE && {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin) SWIGTYPE [ANY] {
void *temp;
int ii;
$1_basetype *b = 0;
temp = SWIG_MustGetPtr($input, $1_descriptor, 1, 0);
b = ($1_basetype *) $1;
for (ii = 0; ii < $1_size; ii++) b[ii] = *(($1_basetype *) temp + ii);
}
%typemap(varin) void * {
$1 = SWIG_MustGetPtr($input, NULL, 1, 0);
}
%typemap(out) SWIGTYPE * {
$result = SWIG_NewPointerObj ($1, $descriptor, $owner);
}
%typemap(out) SWIGTYPE *DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_NewPointerObj ($1, ty, $owner);
}
%typemap(varout) SWIGTYPE *, SWIGTYPE [] {
$result = SWIG_NewPointerObj ($1, $descriptor, 0);
}
%typemap(varout) SWIGTYPE & {
$result = SWIG_NewPointerObj((void *) &$1, $1_descriptor, 0);
}
%typemap(varout) SWIGTYPE && {
$result = SWIG_NewPointerObj((void *) &$1, $1_descriptor, 0);
}
/* C++ References */
#ifdef __cplusplus
%typemap(in) SWIGTYPE & {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
if ($1 == NULL) scheme_signal_error(FUNC_NAME ": swig-type-error (null reference)");
}
%typemap(in, noblock=1, fragment="<memory>") SWIGTYPE && (void *argp = 0, int res = 0, std::unique_ptr<$*1_ltype> rvrdeleter) {
res = SWIG_ConvertPtr($input, &argp, $descriptor, SWIG_POINTER_RELEASE);
if (!SWIG_IsOK(res)) {
if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type '$1_type'");
} else {
%argument_fail(res, "$1_type", $symname, $argnum);
}
}
if (argp == NULL) scheme_signal_error(FUNC_NAME ": swig-type-error (null reference)");
$1 = ($1_ltype)argp;
rvrdeleter.reset($1);
}
%typemap(out) SWIGTYPE &, SWIGTYPE && {
$result = SWIG_NewPointerObj ($1, $descriptor, $owner);
}
%typemap(out) SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_NewPointerObj ($1, ty, $owner);
}
#endif
/* Arrays */
%typemap(in) SWIGTYPE[] {
$1 = ($ltype) SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
}
%typemap(out) SWIGTYPE[] {
$result = SWIG_NewPointerObj ($1, $descriptor, $owner);
}
/* Enums */
%typemap(in) enum SWIGTYPE {
if (!SWIG_is_integer($input))
scheme_wrong_type(FUNC_NAME, "integer", $argnum - 1, argc, argv);
$1 = ($1_type) SWIG_convert_int($input);
}
%typemap(varin) enum SWIGTYPE {
if (!SWIG_is_integer($input))
scheme_wrong_type(FUNC_NAME, "integer", 0, argc, argv);
$1 = ($1_type) SWIG_convert_int($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, 0);
$1 = *argp;
}
%typemap(varin) SWIGTYPE {
$&1_ltype argp;
argp = ($&1_ltype) SWIG_MustGetPtr($input, $&1_descriptor, 1, 0);
$1 = *argp;
}
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype($1);
$result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 1);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1);
}
#endif
%typemap(varout) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype($1);
$result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 0);
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0);
}
#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(FUNC_NAME, #MZ_NAME, $argnum - 1, argc, argv);
$1 = MZ_TO_C($input);
}
%typemap(varin) C_NAME {
if (!MZ_PREDICATE($input))
scheme_wrong_type(FUNC_NAME, #MZ_NAME, 0, 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 = C_TO_MZ(*$1);
SWIG_APPEND_VALUE(s);
}
%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, SWIG_is_integer, SWIG_convert_int,
scheme_make_integer_value, integer);
SIMPLE_MAP(short, SWIG_is_integer, SWIG_convert_short,
scheme_make_integer_value, integer);
SIMPLE_MAP(long, SWIG_is_integer, SWIG_convert_long,
scheme_make_integer_value, integer);
SIMPLE_MAP(ptrdiff_t, SWIG_is_integer, SWIG_convert_long,
scheme_make_integer_value, integer);
SIMPLE_MAP(unsigned int, SWIG_is_unsigned_integer, SWIG_convert_unsigned_int,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(unsigned short, SWIG_is_unsigned_integer, SWIG_convert_unsigned_short,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(unsigned long, SWIG_is_unsigned_integer, SWIG_convert_unsigned_long,
scheme_make_integer_value_from_unsigned, integer);
SIMPLE_MAP(size_t, SWIG_is_unsigned_integer, SWIG_convert_unsigned_long,
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);
/* 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(FUNC_NAME, #MZ_NAME, $argnum - 1, 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, SWIG_is_integer, SWIG_convert_int,
scheme_make_integer_value, integer);
REF_MAP(short, SWIG_is_integer, SWIG_convert_short,
scheme_make_integer_value, integer);
REF_MAP(long, SWIG_is_integer, SWIG_convert_long,
scheme_make_integer_value, integer);
REF_MAP(unsigned int, SWIG_is_unsigned_integer, SWIG_convert_unsigned_int,
scheme_make_integer_value_from_unsigned, integer);
REF_MAP(unsigned short, SWIG_is_unsigned_integer, SWIG_convert_unsigned_short,
scheme_make_integer_value_from_unsigned, integer);
REF_MAP(unsigned long, SWIG_is_unsigned_integer, SWIG_convert_unsigned_long,
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);
%typemap(in) char * {
if (SCHEME_STRINGP($input)) {
$1 = SCHEME_STR_VAL($input);
} else if (SCHEME_NULLP($input)) {
$1 = NULL;
} else {
scheme_wrong_type(FUNC_NAME, "string", $argnum - 1, argc, argv);
}
}
%typemap(varin) char * {
if (SCHEME_STRINGP($input)) {
$1 = SCHEME_STR_VAL($input);
} else if (SCHEME_NULLP($input)) {
$1 = NULL;
} else {
scheme_wrong_type(FUNC_NAME, "string", 0, argc, argv);
}
}
%typemap(out) char * {
$result = SCHEME_MAKE_STRING($1);
}
%typemap(varout) char * {
$result = SCHEME_MAKE_STRING($1);
}
%typemap(throws) char * {
scheme_signal_error("%s: %s", FUNC_NAME, $1);
}
/* Void */
%typemap(out) void "$result = scheme_void;"
/* Pass through Scheme_Object * */
%typemap (in) Scheme_Object * "$1=$input;"
%typemap (out) Scheme_Object * "$result=$1;"
%typecheck(SWIG_TYPECHECK_POINTER) Scheme_Object * "$1=1;";
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
//%typemap(in) (char *STRING, int LENGTH) {
// int temp;
// $1 = ($1_ltype) SWIG_Guile_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 = (SWIG_is_integer($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_BOOL) 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 [] {
void *ptr;
if (SWIG_ConvertPtr($input, (void **) &ptr, $1_descriptor, 0)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE &, SWIGTYPE && {
void *ptr;
if (SWIG_ConvertPtr($input, (void **) &ptr, $1_descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
if (SWIG_ConvertPtr($input, (void **) &ptr, $&1_descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
if (SWIG_ConvertPtr($input, (void **) &ptr, 0, 0)) {
$1 = 0;
} else {
$1 = 1;
}
}
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }

10
Makefile.in
View File

@ -66,7 +66,6 @@ skip-guile = test -n "@SKIP_GUILE@"
skip-java = test -n "@SKIP_JAVA@"
skip-javascript = test -n "@SKIP_JAVASCRIPT@"
skip-lua = test -n "@SKIP_LUA@"
skip-mzscheme = test -n "@SKIP_MZSCHEME@"
skip-ocaml = test -n "@SKIP_OCAML@"
skip-octave = test -n "@SKIP_OCTAVE@"
skip-perl5 = test -n "@SKIP_PERL5@"
@ -108,7 +107,6 @@ check-aliveness:
@$(skip-java) || ./$(TARGET) -java -help
@$(skip-javascript) || ./$(TARGET) -javascript -help
@$(skip-lua) || ./$(TARGET) -lua -help
@$(skip-mzscheme) || ./$(TARGET) -mzscheme -help
@$(skip-ocaml) || ./$(TARGET) -ocaml -help
@$(skip-octave) || ./$(TARGET) -octave -help
@$(skip-perl5) || ./$(TARGET) -perl -help
@ -132,7 +130,6 @@ check-versions: \
check-java-version \
check-javascript-version \
check-lua-version \
check-mzscheme-version \
check-ocaml-version \
check-octave-version \
check-perl5-version \
@ -167,7 +164,6 @@ check-examples: \
check-java-examples \
check-javascript-examples \
check-lua-examples \
check-mzscheme-examples \
check-ocaml-examples \
check-octave-examples \
check-perl5-examples \
@ -187,7 +183,6 @@ guile_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/guile/check.list)
java_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/java/check.list)
javascript_examples:=$(shell sed '/^\#/d' $(srcdir)/Examples/javascript/check.list)
lua_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/lua/check.list)
mzscheme_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/mzscheme/check.list)
ocaml_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/ocaml/check.list)
octave_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/octave/check.list)
perl5_examples :=$(shell sed '/^\#/d' $(srcdir)/Examples/perl5/check.list)
@ -244,7 +239,6 @@ check-test-suite: \
check-java-test-suite \
check-javascript-test-suite \
check-lua-test-suite \
check-mzscheme-test-suite \
check-ocaml-test-suite \
check-octave-test-suite \
check-perl5-test-suite \
@ -292,7 +286,6 @@ all-test-suite: \
all-java-test-suite \
all-javascript-test-suite \
all-lua-test-suite \
all-mzscheme-test-suite \
all-ocaml-test-suite \
all-octave-test-suite \
all-perl5-test-suite \
@ -316,7 +309,6 @@ broken-test-suite: \
broken-java-test-suite \
broken-javascript-test-suite \
broken-lua-test-suite \
broken-mzscheme-test-suite \
broken-ocaml-test-suite \
broken-octave-test-suite \
broken-perl5-test-suite \
@ -456,7 +448,7 @@ install-main:
@echo "Installing $(DESTDIR)$(BIN_DIR)/`echo $(TARGET_NOEXE) | sed '$(transform)'`@EXEEXT@"
@$(INSTALL_PROGRAM) $(TARGET) $(DESTDIR)$(BIN_DIR)/`echo $(TARGET_NOEXE) | sed '$(transform)'`@EXEEXT@
lib-languages = typemaps tcl perl5 python guile java mzscheme ruby php ocaml octave \
lib-languages = typemaps tcl perl5 python guile java ruby php ocaml octave \
csharp lua r c go d javascript javascript/jsc \
javascript/v8 javascript/napi scilab xml

2
README
View File

@ -2,7 +2,7 @@ SWIG (Simplified Wrapper and Interface Generator)
Tagline: SWIG is a compiler that integrates C and C++ with languages
including Perl, Python, Tcl, Ruby, PHP, Java, C#, D, Go, Lua,
Octave, R, Scheme (Guile, MzScheme/Racket), Scilab, Ocaml.
Octave, R, Scheme (Guile), Scilab, Ocaml.
SWIG can also export its parse tree into XML.
SWIG reads annotated C/C++ header files and creates wrapper code (glue

1
Source/Makefile.am
View File

@ -61,7 +61,6 @@ eswig_SOURCES = CParse/cscanner.c \
Modules/lang.cxx \
Modules/lua.cxx \
Modules/main.cxx \
Modules/mzscheme.cxx \
Modules/nested.cxx \
Modules/ocaml.cxx \
Modules/octave.cxx \

761
Source/Modules/mzscheme.cxx
View File

@ -1,761 +0,0 @@
/* -----------------------------------------------------------------------------
* This file is part of SWIG, which is licensed as a whole under version 3
* (or any later version) of the GNU General Public License. Some additional
* terms also apply to certain portions of SWIG. The full details of the SWIG
* license and copyrights can be found in the LICENSE and COPYRIGHT files
* included with the SWIG source code as distributed by the SWIG developers
* and at https://www.swig.org/legal.html.
*
* mzscheme.cxx
*
* Mzscheme language module for SWIG.
* ----------------------------------------------------------------------------- */
#include "swigmod.h"
#include <ctype.h>
static const char *usage = "\
Mzscheme Options (available with -mzscheme)\n\
-declaremodule - Create extension that declares a module\n\
-dynamic-load <lib>,[lib,...] - Do not link with these libraries, dynamic load them\n\
-noinit - Do not emit module initialization code\n\
-prefix <name> - Set a prefix <name> to be prepended to all names\n\
";
static String *fieldnames_tab = 0;
static String *convert_tab = 0;
static String *convert_proto_tab = 0;
static String *struct_name = 0;
static String *mangled_struct_name = 0;
static String *prefix = 0;
static bool declaremodule = false;
static bool noinit = false;
static String *load_libraries = NULL;
static String *module = 0;
static const char *mzscheme_path = "mzscheme";
static String *init_func_def = 0;
static File *f_begin = 0;
static File *f_runtime = 0;
static File *f_header = 0;
static File *f_wrappers = 0;
static File *f_init = 0;
// Used for garbage collection
static int exporting_destructor = 0;
static String *swigtype_ptr = 0;
static String *cls_swigtype = 0;
class MZSCHEME:public Language {
public:
/* ------------------------------------------------------------
* main()
* ------------------------------------------------------------ */
virtual void main(int argc, char *argv[]) {
int i;
SWIG_library_directory(mzscheme_path);
// Look for certain command line options
for (i = 1; i < argc; i++) {
if (argv[i]) {
if (strcmp(argv[i], "-help") == 0) {
fputs(usage, stdout);
Exit(EXIT_SUCCESS);
} else if (strcmp(argv[i], "-prefix") == 0) {
if (argv[i + 1]) {
prefix = NewString(argv[i + 1]);
Swig_mark_arg(i);
Swig_mark_arg(i + 1);
i++;
} else {
Swig_arg_error();
}
} else if (strcmp(argv[i], "-declaremodule") == 0) {
declaremodule = true;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-noinit") == 0) {
noinit = true;
Swig_mark_arg(i);
}
else if (strcmp(argv[i], "-dynamic-load") == 0) {
if (argv[i + 1]) {
Delete(load_libraries);
load_libraries = NewString(argv[i + 1]);
Swig_mark_arg(i++);
Swig_mark_arg(i);
} else {
Swig_arg_error();
}
}
}
}
// If a prefix has been specified make sure it ends in a '_' (not actually used!)
if (prefix) {
const char *px = Char(prefix);
if (px[Len(prefix) - 1] != '_')
Printf(prefix, "_");
} else
prefix = NewString("swig_");
// Add a symbol for this module
Preprocessor_define("SWIGMZSCHEME 1", 0);
// Read in default typemaps */
SWIG_config_file("mzscheme.swg");
allow_overloading();
}
/* ------------------------------------------------------------
* top()
* ------------------------------------------------------------ */
virtual int top(Node *n) {
/* Initialize all of the output files */
String *outfile = Getattr(n, "outfile");
f_begin = NewFile(outfile, "w", SWIG_output_files());
if (!f_begin) {
FileErrorDisplay(outfile);
Exit(EXIT_FAILURE);
}
f_runtime = NewString("");
f_init = NewString("");
f_header = NewString("");
f_wrappers = NewString("");
/* Register file targets with the SWIG file handler */
Swig_register_filebyname("header", f_header);
Swig_register_filebyname("wrapper", f_wrappers);
Swig_register_filebyname("begin", f_begin);
Swig_register_filebyname("runtime", f_runtime);
init_func_def = NewString("");
Swig_register_filebyname("init", init_func_def);
Swig_banner(f_begin);
Swig_obligatory_macros(f_runtime, "MZSCHEME");
module = Getattr(n, "name");
Language::top(n);
SwigType_emit_type_table(f_runtime, f_wrappers);
if (!noinit) {
if (declaremodule) {
Printf(f_init, "#define SWIG_MZSCHEME_CREATE_MENV(env) scheme_primitive_module(scheme_intern_symbol(\"%s\"), env)\n", module);
} else {
Printf(f_init, "#define SWIG_MZSCHEME_CREATE_MENV(env) (env)\n");
}
Printf(f_init, "%s\n", Char(init_func_def));
if (declaremodule) {
Printf(f_init, "\tscheme_finish_primitive_module(menv);\n");
}
Printf(f_init, "\treturn scheme_void;\n}\n");
Printf(f_init, "Scheme_Object *scheme_initialize(Scheme_Env *env) {\n");
if (load_libraries) {
Printf(f_init, "mz_set_dlopen_libraries(\"%s\");\n", load_libraries);
}
Printf(f_init, "\treturn scheme_reload(env);\n");
Printf(f_init, "}\n");
Printf(f_init, "Scheme_Object *scheme_module_name(void) {\n");
if (declaremodule) {
Printf(f_init, " return scheme_intern_symbol((char*)\"%s\");\n", module);
} else {
Printf(f_init, " return scheme_make_symbol((char*)\"%s\");\n", module);
}
Printf(f_init, "}\n");
}
/* Close all of the files */
Dump(f_runtime, f_begin);
Dump(f_header, f_begin);
Dump(f_wrappers, f_begin);
Wrapper_pretty_print(f_init, f_begin);
Delete(f_header);
Delete(f_wrappers);
Delete(f_init);
Delete(f_runtime);
Delete(f_begin);
return SWIG_OK;
}
/* ------------------------------------------------------------
* functionWrapper()
* Create a function declaration and register it with the interpreter.
* ------------------------------------------------------------ */
void throw_unhandled_mzscheme_type_error(SwigType *d) {
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number, "Unable to handle type %s.\n", SwigType_str(d, 0));
}
/* Return true iff T is a pointer type */
int
is_a_pointer(SwigType *t) {
return SwigType_ispointer(SwigType_typedef_resolve_all(t));
}
virtual int functionWrapper(Node *n) {
char *iname = GetChar(n, "sym:name");
SwigType *returntype = Getattr(n, "type");
ParmList *l = Getattr(n, "parms");
Parm *p;
Wrapper *f = NewWrapper();
String *proc_name = NewString("");
String *target = NewString("");
String *arg = NewString("");
String *cleanup = NewString("");
String *outarg = NewString("");
String *build = NewString("");
String *tm;
int i = 0;
int numargs;
int numreq;
String *overname = 0;
if (load_libraries) {
ParmList *parms = Getattr(n, "parms");
SwigType *type = Getattr(n, "type");
String *name = NewString("caller");
Setattr(n, "wrap:action", Swig_cresult(type, Swig_cresult_name(), Swig_cfunction_call(name, parms)));
}
// Make a wrapper name for this
String *wname = Swig_name_wrapper(iname);
if (Getattr(n, "sym:overloaded")) {
overname = Getattr(n, "sym:overname");
} else {
if (!addSymbol(iname, n)) {
DelWrapper(f);
return SWIG_ERROR;
}
}
if (overname) {
Append(wname, overname);
}
Setattr(n, "wrap:name", wname);
// Build the name for Scheme.
Printv(proc_name, iname, NIL);
Replaceall(proc_name, "_", "-");
// writing the function wrapper function
Printv(f->def, "static Scheme_Object *", wname, " (", NIL);
Printv(f->def, "int argc, Scheme_Object **argv", NIL);
Printv(f->def, ")\n{", NIL);
/* Define the scheme name in C. This define is used by several
macros. */
Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
// Emit all of the local variables for holding arguments.
emit_parameter_variables(l, f);
/* Attach the standard typemaps */
emit_attach_parmmaps(l, f);
Setattr(n, "wrap:parms", l);
numargs = emit_num_arguments(l);
numreq = emit_num_required(l);
/* Add the holder for the pointer to the function to be opened */
if (load_libraries) {
Wrapper_add_local(f, "_function_loaded", "static int _function_loaded=(1==0)");
Wrapper_add_local(f, "_the_function", "static void *_the_function=NULL");
{
String *parms = ParmList_protostr(l);
String *func = NewStringf("(*caller)(%s)", parms);
Wrapper_add_local(f, "caller", SwigType_lstr(returntype, func));
}
}
// adds local variables
Wrapper_add_local(f, "lenv", "int lenv = 1");
Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
if (load_libraries) {
Printf(f->code, "if (!_function_loaded) { _the_function=mz_load_function(\"%s\");_function_loaded=(1==1); }\n", iname);
Printf(f->code, "if (!_the_function) { scheme_signal_error(\"Cannot load C function '%s'\"); }\n", iname);
Printf(f->code, "caller=_the_function;\n");
}
// Now write code to extract the parameters (this is super ugly)
for (i = 0, p = l; i < numargs; i++) {
/* Skip ignored arguments */
while (checkAttribute(p, "tmap:in:numinputs", "0")) {
p = Getattr(p, "tmap:in:next");
}
SwigType *pt = Getattr(p, "type");
String *ln = Getattr(p, "lname");
// Produce names of source and target
Clear(target);
Clear(arg);
String *source = NewStringf("argv[%d]", i);
Printf(target, "%s", ln);
Printv(arg, Getattr(p, "name"), NIL);
if (i >= numreq) {
Printf(f->code, "if (argc > %d) {\n", i);
}
// Handle parameter types.
if ((tm = Getattr(p, "tmap:in"))) {
Replaceall(tm, "$input", source);
Setattr(p, "emit:input", source);
Printv(f->code, tm, "\n", NIL);
p = Getattr(p, "tmap:in:next");
} else {
// no typemap found
// check if typedef and resolve
throw_unhandled_mzscheme_type_error(pt);
p = nextSibling(p);
}
if (i >= numreq) {
Printf(f->code, "}\n");
}
Delete(source);
}
/* Insert constraint checking code */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:check"))) {
Printv(f->code, tm, "\n", NIL);
p = Getattr(p, "tmap:check:next");
} else {
p = nextSibling(p);
}
}
// Pass output arguments back to the caller.
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:argout"))) {
Replaceall(tm, "$arg", Getattr(p, "emit:input"));
Replaceall(tm, "$input", Getattr(p, "emit:input"));
Printv(outarg, tm, "\n", NIL);
p = Getattr(p, "tmap:argout:next");
} else {
p = nextSibling(p);
}
}
// Free up any memory allocated for the arguments.
/* Insert cleanup code */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:freearg"))) {
Printv(cleanup, tm, "\n", NIL);
p = Getattr(p, "tmap:freearg:next");
} else {
p = nextSibling(p);
}
}
// Now write code to make the function call
String *actioncode = emit_action(n);
// Now have return value, figure out what to do with it.
if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
Replaceall(tm, "$result", "values[0]");
if (GetFlag(n, "feature:new"))
Replaceall(tm, "$owner", "1");
else
Replaceall(tm, "$owner", "0");
Printv(f->code, tm, "\n", NIL);
} else {
throw_unhandled_mzscheme_type_error(returntype);
}
emit_return_variable(n, returntype, f);
// Dump the argument output code
Printv(f->code, Char(outarg), NIL);
// Dump the argument cleanup code
Printv(f->code, Char(cleanup), NIL);
// Look for any remaining cleanup
if (GetFlag(n, "feature:new")) {
if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
Printv(f->code, tm, "\n", NIL);
}
}
// Free any memory allocated by the function being wrapped..
if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
Printv(f->code, tm, "\n", NIL);
}
// Wrap things up (in a manner of speaking)
Printv(f->code, tab4, "return SWIG_MzScheme_PackageValues(lenv, values);\n", NIL);
Printf(f->code, "#undef FUNC_NAME\n");
Printv(f->code, "}\n", NIL);
bool isvoid = !Cmp(returntype, "void");
Replaceall(f->code, "$isvoid", isvoid ? "1" : "0");
/* Substitute the function name */
Replaceall(f->code, "$symname", iname);
Wrapper_print(f, f_wrappers);
if (!Getattr(n, "sym:overloaded")) {
// Now register the function
char temp[256];
sprintf(temp, "%d", numargs);
if (exporting_destructor) {
Printf(init_func_def, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
}
Printf(init_func_def, "scheme_add_global(\"%s\", scheme_make_prim_w_arity(%s,\"%s\",%d,%d),menv);\n", proc_name, wname, proc_name, numreq, numargs);
} else {
if (!Getattr(n, "sym:nextSibling")) {
/* Emit overloading dispatch function */
int maxargs;
String *dispatch = Swig_overload_dispatch(n, "return %s(argc,argv);", &maxargs);
/* Generate a dispatch wrapper for all overloaded functions */
Wrapper *df = NewWrapper();
String *dname = Swig_name_wrapper(iname);
Printv(df->def, "static Scheme_Object *\n", dname, "(int argc, Scheme_Object **argv) {", NIL);
Printv(df->code, dispatch, "\n", NIL);
Printf(df->code, "scheme_signal_error(\"No matching function for overloaded '%s'\");\n", iname);
Printf(df->code, "return NULL;\n");
Printv(df->code, "}\n", NIL);
Wrapper_print(df, f_wrappers);
Printf(init_func_def, "scheme_add_global(\"%s\", scheme_make_prim_w_arity(%s,\"%s\",%d,%d),menv);\n", proc_name, dname, proc_name, 0, maxargs);
DelWrapper(df);
Delete(dispatch);
Delete(dname);
}
}
Delete(proc_name);
Delete(target);
Delete(arg);
Delete(outarg);
Delete(cleanup);
Delete(build);
DelWrapper(f);
return SWIG_OK;
}
/* ------------------------------------------------------------
* variableWrapper()
*
* Create a link to a C variable.
* This creates a single function _wrap_swig_var_varname().
* This function takes a single optional argument. If supplied, it means
* we are setting this variable to some value. If omitted, it means we are
* simply evaluating this variable. Either way, we return the variables
* value.
* ------------------------------------------------------------ */
virtual int variableWrapper(Node *n) {
char *name = GetChar(n, "name");
char *iname = GetChar(n, "sym:name");
SwigType *t = Getattr(n, "type");
String *proc_name = NewString("");
String *tm;
String *tm2 = NewString("");
String *argnum = NewString("0");
String *arg = NewString("argv[0]");
Wrapper *f;
if (!addSymbol(iname, n))
return SWIG_ERROR;
f = NewWrapper();
// evaluation function names
String *var_name = Swig_name_wrapper(iname);
// Build the name for scheme.
Printv(proc_name, iname, NIL);
Replaceall(proc_name, "_", "-");
Setattr(n, "wrap:name", proc_name);
if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {
Printf(f->def, "static Scheme_Object *%s(int argc, Scheme_Object** argv) {\n", var_name);
Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
Wrapper_add_local(f, "swig_result", "Scheme_Object *swig_result");
if (!GetFlag(n, "feature:immutable")) {
/* Check for a setting of the variable value */
Printf(f->code, "if (argc) {\n");
if ((tm = Swig_typemap_lookup("varin", n, name, 0))) {
Replaceall(tm, "$input", "argv[0]");
Replaceall(tm, "$argnum", "1");
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_mzscheme_type_error(t);
}
Printf(f->code, "}\n");
}
// Now return the value of the variable (regardless
// of evaluating or setting)
if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
Replaceall(tm, "$result", "swig_result");
/* Printf (f->code, "%s\n", tm); */
emit_action_code(n, f->code, tm);
} else {
throw_unhandled_mzscheme_type_error(t);
}
Printf(f->code, "\nreturn swig_result;\n");
Printf(f->code, "#undef FUNC_NAME\n");
Printf(f->code, "}\n");
Wrapper_print(f, f_wrappers);
// Now add symbol to the MzScheme interpreter
Printv(init_func_def,
"scheme_add_global(\"", proc_name, "\", scheme_make_prim_w_arity(", var_name, ", \"", proc_name, "\", ", "0", ", ", "1", "), menv);\n", NIL);
} else {
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0));
}
Delete(var_name);
Delete(proc_name);
Delete(argnum);
Delete(arg);
Delete(tm2);
DelWrapper(f);
return SWIG_OK;
}
/* ------------------------------------------------------------
* constantWrapper()
* ------------------------------------------------------------ */
virtual int constantWrapper(Node *n) {
char *name = GetChar(n, "name");
char *iname = GetChar(n, "sym:name");
SwigType *type = Getattr(n, "type");
String *value = Getattr(n, "value");
String *tm;
if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
return SWIG_NOWRAP;
}
// See if there's a typemap
if ((tm = Swig_typemap_lookup("constant", n, name, 0))) {
Replaceall(tm, "$value", value);
Printf(f_init, "%s\n", tm);
} else {
// Create a static variable and assign it a value
String *var_name = NewStringf("_wrap_const_%s", Swig_name_mangle_string(Getattr(n, "sym:name")));
Printf(f_header, "static %s = %s;\n", SwigType_lstr(type, var_name), value);
// Now create a variable declaration
{
/* Hack alert: will cleanup later -- Dave */
Node *nn = NewHash();
Setfile(nn, Getfile(n));
Setline(nn, Getline(n));
Setattr(nn, "name", var_name);
Setattr(nn, "sym:name", iname);
Setattr(nn, "type", type);
SetFlag(nn, "feature:immutable");
variableWrapper(nn);
Delete(nn);
}
Delete(var_name);
}
return SWIG_OK;
}
virtual int destructorHandler(Node *n) {
exporting_destructor = true;
Language::destructorHandler(n);
exporting_destructor = false;
return SWIG_OK;
}
/* ------------------------------------------------------------
* classHandler()
* ------------------------------------------------------------ */
virtual int classHandler(Node *n) {
String *scm_structname = NewString("");
SwigType *ctype_ptr = NewStringf("p.%s", getClassType());
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
swigtype_ptr = SwigType_manglestr(t);
Delete(t);
cls_swigtype = SwigType_manglestr(Getattr(n, "name"));
fieldnames_tab = NewString("");
convert_tab = NewString("");
convert_proto_tab = NewString("");
struct_name = Getattr(n, "sym:name");
mangled_struct_name = Swig_name_mangle_string(Getattr(n, "sym:name"));
Printv(scm_structname, struct_name, NIL);
Replaceall(scm_structname, "_", "-");
Printv(fieldnames_tab, "static const char *_swig_struct_", cls_swigtype, "_field_names[] = { \n", NIL);
Printv(convert_proto_tab, "static Scheme_Object *_swig_convert_struct_", cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ");\n", NIL);
Printv(convert_tab, "static Scheme_Object *_swig_convert_struct_", cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ")\n {\n", NIL);
Printv(convert_tab,
tab4, "Scheme_Object *obj;\n", tab4, "Scheme_Object *fields[_swig_struct_", cls_swigtype, "_field_names_cnt];\n", tab4, "int i = 0;\n\n", NIL);
/* Generate normal wrappers */
Language::classHandler(n);
Printv(convert_tab, tab4, "obj = scheme_make_struct_instance(", "_swig_struct_type_", cls_swigtype, ", i, fields);\n", NIL);
Printv(convert_tab, tab4, "return obj;\n}\n\n", NIL);
Printv(fieldnames_tab, "};\n", NIL);
Printv(f_header, "static Scheme_Object *_swig_struct_type_", cls_swigtype, ";\n", NIL);
Printv(f_header, fieldnames_tab, NIL);
Printv(f_header, "#define _swig_struct_", cls_swigtype, "_field_names_cnt (sizeof(_swig_struct_", cls_swigtype, "_field_names)/sizeof(char*))\n", NIL);
Printv(f_header, convert_proto_tab, NIL);
Printv(f_wrappers, convert_tab, NIL);
Printv(init_func_def, "_swig_struct_type_", cls_swigtype,
" = SWIG_MzScheme_new_scheme_struct(menv, \"", scm_structname, "\", ",
"_swig_struct_", cls_swigtype, "_field_names_cnt,", "(char**) _swig_struct_", cls_swigtype, "_field_names);\n", NIL);
Delete(swigtype_ptr);
swigtype_ptr = 0;
Delete(fieldnames_tab);
Delete(convert_tab);
Delete(ctype_ptr);
Delete(convert_proto_tab);
struct_name = 0;
mangled_struct_name = 0;
Delete(cls_swigtype);
cls_swigtype = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------
* membervariableHandler()
* ------------------------------------------------------------ */
virtual int membervariableHandler(Node *n) {
Language::membervariableHandler(n);
if (!is_smart_pointer()) {
String *symname = Getattr(n, "sym:name");
String *name = Getattr(n, "name");
SwigType *type = Getattr(n, "type");
String *swigtype = SwigType_manglestr(Getattr(n, "type"));
String *tm = 0;
String *access_mem = NewString("");
SwigType *ctype_ptr = NewStringf("p.%s", Getattr(n, "type"));
Printv(fieldnames_tab, tab4, "\"", symname, "\",\n", NIL);
Printv(access_mem, "(ptr)->", name, NIL);
if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
Printv(convert_tab, tab4, "fields[i++] = ", NIL);
Printv(convert_tab, "_swig_convert_struct_", swigtype, "((", SwigType_str(ctype_ptr, 0), ")&((ptr)->", name, "));\n", NIL);
} else if ((tm = Swig_typemap_lookup("varout", n, access_mem, 0))) {
Replaceall(tm, "$result", "fields[i++]");
Printv(convert_tab, tm, "\n", NIL);
} else
Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported member variable type %s (ignored).\n", SwigType_str(type, 0));
Delete(access_mem);
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* validIdentifier()
* ------------------------------------------------------------ */
virtual int validIdentifier(String *s) {
char *c = Char(s);
/* Check whether we have an R5RS identifier. */
/* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
/* <initial> --> <letter> | <special initial> */
if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|| (*c == '^') || (*c == '_') || (*c == '~'))) {
/* <peculiar identifier> --> + | - | ... */
if ((strcmp(c, "+") == 0)
|| strcmp(c, "-") == 0 || strcmp(c, "...") == 0)
return 1;
else
return 0;
}
/* <subsequent> --> <initial> | <digit> | <special subsequent> */
while (*c) {
if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|| (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
|| (*c == '-') || (*c == '.') || (*c == '@')))
return 0;
c++;
}
return 1;
}
String *runtimeCode() {
String *s = Swig_include_sys("mzrun.swg");
if (!s) {
Printf(stderr, "*** Unable to open 'mzrun.swg'\n");
s = NewString("");
}
return s;
}
String *defaultExternalRuntimeFilename() {
return NewString("swigmzrun.h");
}
};
/* -----------------------------------------------------------------------------
* swig_mzscheme() - Instantiate module
* ----------------------------------------------------------------------------- */
static Language *new_swig_mzscheme() {
return new MZSCHEME();
}
extern "C" Language *swig_mzscheme(void) {
return new_swig_mzscheme();
}

2
Source/Modules/swigmain.cxx
View File

@ -34,7 +34,6 @@ extern "C" {
Language *swig_java(void);
Language *swig_javascript(void);
Language *swig_lua(void);
Language *swig_mzscheme(void);
Language *swig_ocaml(void);
Language *swig_octave(void);
Language *swig_perl5(void);
@ -64,7 +63,6 @@ static TargetLanguageModule modules[] = {
{"-javascript", swig_javascript, "Javascript", Supported},
{"-lua", swig_lua, "Lua", Supported},
{"-modula3", NULL, "Modula 3", Disabled},
{"-mzscheme", swig_mzscheme, "MzScheme/Racket", Deprecated},
{"-ocaml", swig_ocaml, "OCaml", Experimental},
{"-octave", swig_octave, "Octave", Supported},
{"-perl", swig_perl5, NULL, Supported},

7
TODO
View File

@ -189,13 +189,6 @@ Guile
protection on the classes that need it.
Mzscheme
--------
** Port list-vector.i and pointer-in-out.i from Guile.
** Add shadow class support for the Swindle system.
Ocaml
-----
** I've been working with my camlp4 module and type information

3
Tools/CI-linux-install.sh
View File

@ -76,9 +76,6 @@ case "$SWIGLANG" in
$RETRY sudo apt-get -qq install lua${VER} liblua${VER}-dev
fi
;;
"mzscheme")
$RETRY sudo apt-get -qq install racket
;;
"ocaml")
$RETRY sudo apt-get -qq install ocaml camlp4
;;

2
Tools/testflags.py
View File

@ -17,7 +17,6 @@ def get_cflags(language, std, compiler):
"java":"-Werror " + c_common,
"javascript":"-Werror " + c_common,
"lua":"-Werror " + c_common,
"mzscheme":"-Werror " + c_common,
"ocaml":"-Werror " + c_common,
"octave":"-Werror " + c_common,
"perl5":"-Werror " + c_common,
@ -49,7 +48,6 @@ def get_cxxflags(language, std, compiler):
"java":"-Werror " + cxx_common,
"javascript":"-Werror " + cxx_common + " -Wno-error=unused-function", # Until overload_rename is fixed for node
"lua":"-Werror " + cxx_common,
"mzscheme":"-Werror " + cxx_common,
"ocaml":"-Werror " + cxx_common,
"octave":"-Werror " + cxx_common,
"perl5":"-Werror " + cxx_common,

56
configure.ac
View File

@ -463,11 +463,6 @@ case $host in
*) PHP_SO=$SO;;
esac
AC_SUBST(MZSCHEME_SO)
case $host in
*) MZSCHEME_SO=.so;;
esac
AC_SUBST(LUA_SO)
case $host in
*-*-darwin*) LUA_SO=.so;;
@ -1524,48 +1519,6 @@ AC_SUBST(LUAFLAGS)
AC_SUBST(LUALINK)
AC_SUBST(LUABIN)
#----------------------------------------------------------------
# Look for MzScheme
#----------------------------------------------------------------
AC_ARG_WITH(mzscheme, AS_HELP_STRING([--without-mzscheme], [Disable MzScheme])
AS_HELP_STRING([--with-mzscheme=path], [Set location of MzScheme executable]),[ MZSCHEMEBIN="$withval"], [MZSCHEMEBIN="$alllang_default"])
AC_ARG_WITH(mzc, AS_HELP_STRING([--with-mzc=path], [Set location of MzScheme's mzc]), [ MZCBIN="$withval"], [MZCBIN=])
# First, check for "--without-mzscheme" or "--with-mzscheme=no".
if test x"${MZSCHEMEBIN}" = xno; then
AC_MSG_NOTICE([Disabling MzScheme])
MZC=
else
if test "x$MZSCHEMEBIN" = xyes; then
AC_PATH_PROG(MZSCHEME, mzscheme)
else
MZSCHEME="$MZSCHEMEBIN"
fi
if test -z "$MZCBIN"; then
AC_PATH_PROG(MZC, mzc)
fi
if test -n "$MZSCHEME"; then
AC_MSG_CHECKING(for MzScheme dynext object)
MZDYNOBJ=`$MZSCHEME --eval '(begin (require dynext/link) (with-handlers (((lambda args #t) (lambda args #f))) (for-each (lambda (x) (printf "~a" x)) (expand-for-link-variant (current-standard-link-libraries)))))' 2>/dev/null`
if test -f "$MZDYNOBJ"; then
:
else
# older versions (3.72 approx and earlier)
MZDYNOBJ=`$MZSCHEME --mute-banner --version --eval '(begin (require (lib "link.ss" "dynext")) (with-handlers (((lambda args #t) (lambda args #f))) (for-each (lambda (x) (display x) (display " ")) ((current-make-standard-link-libraries)))) (with-handlers (((lambda args #t) (lambda args #f))) (for-each (lambda (x) (display x)) (expand-for-link-variant (current-standard-link-libraries)))))' 2>/dev/null`
fi
if test -f "$MZDYNOBJ"; then
AC_MSG_RESULT($MZDYNOBJ)
else
AC_MSG_RESULT(not found)
MZDYNOBJ=""
fi
fi
fi
AC_SUBST(MZDYNOBJ)
#----------------------------------------------------------------
# Look for OCaml
#----------------------------------------------------------------
@ -2703,13 +2656,6 @@ fi
AC_SUBST(SKIP_LUA)
SKIP_MZSCHEME=
if test -z "$MZC" || test -z "$MZDYNOBJ" ; then
SKIP_MZSCHEME="1"
fi
AC_SUBST(SKIP_MZSCHEME)
SKIP_OCAML=
if test -z "$OCAMLC" || test -z "$CAMLP4" ; then
SKIP_OCAML="1"
@ -2868,7 +2814,6 @@ AC_CONFIG_FILES([
Examples/test-suite/java/Makefile
Examples/test-suite/javascript/Makefile
Examples/test-suite/lua/Makefile
Examples/test-suite/mzscheme/Makefile
Examples/test-suite/ocaml/Makefile
Examples/test-suite/octave/Makefile
Examples/test-suite/perl5/Makefile
@ -2931,7 +2876,6 @@ test -n "$SKIP_GUILE" || langs="${langs}guile "
test -n "$SKIP_JAVA" || langs="${langs}java "
test -n "$SKIP_JAVASCRIPT" || langs="${langs}javascript "
test -n "$SKIP_LUA" || langs="${langs}lua "
test -n "$SKIP_MZSCHEME" || langs="${langs}mzscheme "
test -n "$SKIP_OCAML" || langs="${langs}ocaml "
test -n "$SKIP_OCTAVE" || langs="${langs}octave "
test -n "$SKIP_PERL5" || langs="${langs}perl5 "