Committing R-SWIG
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@9175 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Joseph Wang
parent
b4626ccbac
commit
ef80a4f59a
51 changed files with 5154 additions and 9 deletions
91
Doc/Manual/R.html
Normal file
91
Doc/Manual/R.html
Normal file
|
|
@ -0,0 +1,91 @@
|
|||
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>SWIG and R</title>
|
||||
<link rel="stylesheet" type="text/css" href="style.css">
|
||||
</head>
|
||||
|
||||
<body bgcolor="#ffffff">
|
||||
<H1>SWIG and R</H1>
|
||||
|
||||
<p>
|
||||
R is a GPL'ed open source statistical and plotting environment.
|
||||
Information about R can be found at <a
|
||||
href="http://www.r-project.org/">www.r-project.org</a>.
|
||||
|
||||
The R binding are under active development and are extremely
|
||||
experimental. Not all features have been implemented and the API is
|
||||
not stable.
|
||||
</p>
|
||||
|
||||
<H2>Bugs</H2>
|
||||
<p>
|
||||
Currently the following features are not implemented or broken:
|
||||
<ul>
|
||||
<li>Garbage collection of created objects
|
||||
<li>C Array wrappings
|
||||
<li>tested on UNIX only, how well or badly it works on windows is not known
|
||||
</ul>
|
||||
|
||||
<H2>Using R and SWIG</H2>
|
||||
|
||||
<p>
|
||||
To use R and SWIG in C mode, execute the following commands where
|
||||
example_func.c is the name of the file with the functions in them
|
||||
<div class="shell">
|
||||
<pre>
|
||||
swig -r -o example,c example.i
|
||||
PKG_LIBS="example_func.c" R CMD SHLIB example.c
|
||||
</pre>
|
||||
</div>
|
||||
|
||||
The corresponding comments for C++ mode are
|
||||
<div class="shell">
|
||||
<pre>
|
||||
swig -c++ -r -o example.cpp example.i
|
||||
PKG_LIBS="example_func.cxx" R CMD SHLIB example.cpp
|
||||
</pre>
|
||||
</div>
|
||||
|
||||
Note that R is sensitive to the name of the file and to the file
|
||||
extension in C and C++ mode. The name of the wrapper file must be the
|
||||
name of the library. Also in C++ mode, the file extension must be cpp
|
||||
rather than cxx for the R compile command to recognize it.
|
||||
</p>
|
||||
|
||||
<p>
|
||||
The commands produce two files. A dynamic shared object file called
|
||||
example.so and an R wrapper file called example_wrap.S. To load these
|
||||
files, start up R and type in the following commands
|
||||
<div class="shell">
|
||||
<pre>
|
||||
dyn.load('example.so')
|
||||
source('example_wrap.S')
|
||||
</pre>
|
||||
These two files can be loaded in any order
|
||||
</p>
|
||||
|
||||
<h2>General policy</h2>
|
||||
The general policy of the module is to treat the C/C++ as a basic
|
||||
wrapping over the underlying functions and rely on the R type system
|
||||
to provide R syntax.
|
||||
|
||||
<h2>Language conventions</h2>
|
||||
getitem and setitem use C++ conventions (i.e. zero based indices). [<-
|
||||
and [ are overloaded to allow for R syntax (one based indices and
|
||||
slices)
|
||||
|
||||
<h2>C++ classes</h2>
|
||||
C++ objects are implemented as external pointer objects with the class
|
||||
being the mangled name of the class. The C++ classes are encapsulated
|
||||
as an SEXP with an external pointer type. The class is the mangled
|
||||
name of the class. The nice thing about R is that is allows you to
|
||||
keep track of the pointer object which removes the necessity for a lot
|
||||
of the proxy class baggage you see in other languages.
|
||||
|
||||
<h2>Enumerations</h2>
|
||||
enumerations are characters which are then converted back and forth to
|
||||
ints before calling the C routines. All of the enumeration code is
|
||||
done in R.
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -29,4 +29,5 @@ Pike.html
|
|||
Python.html
|
||||
Ruby.html
|
||||
Tcl.html
|
||||
R.html
|
||||
Extending.html
|
||||
|
|
|
|||
|
|
@ -1017,3 +1017,26 @@ uffi_clean:
|
|||
rm -f core @EXTRA_CLEAN@
|
||||
rm -f *.@OBJEXT@ *@SO@
|
||||
|
||||
##################################################################
|
||||
##### R ######
|
||||
##################################################################
|
||||
|
||||
R = R
|
||||
RSRCS = $(INTERFACE:.i=_wrap.c) #special code for R build system
|
||||
RCXXSRCS = $(INTERFACE:.i=_wrap.cpp) #special code for R build system
|
||||
|
||||
r: $(SRCS)
|
||||
$(SWIG) -r $(SWIGOPT) -o $(RSRCS) $(INTERFACE)
|
||||
PKG_LIBS="$(SRCS)" PKG_CPPFLAGS="$(INCLUDES)" \
|
||||
$(R) CMD SHLIB $(RSRCS)
|
||||
|
||||
r_cpp: $(CXXSRCS)
|
||||
$(SWIG) -c++ -r $(SWIGOPT) -o $(RCXXSRCS) $(INTERFACE)
|
||||
PKG_LIBS="$(CXXSRCS)" PKG_CPPFLAGS="$(INCLUDES)" \
|
||||
$(R) CMD SHLIB $(RCXXSRCS)
|
||||
|
||||
r_clean:
|
||||
rm -f *_wrap* *~ .~* $(RSRCS) $(RCXXSRCS)
|
||||
rm -f core @EXTRA_CLEAN@
|
||||
rm -f *.@OBJEXT@ *@SO@
|
||||
|
||||
|
|
|
|||
18
Examples/r/class/Makefile
Normal file
18
Examples/r/class/Makefile
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
TOP = ../..
|
||||
SWIG = $(TOP)/../preinst-swig
|
||||
CXXSRCS = example.cxx
|
||||
TARGET = example
|
||||
INTERFACE = example.i
|
||||
LIBS = -lm
|
||||
ARGS = SRCS='$(SRCS)' SWIG='$(SWIG)' \
|
||||
TARGET='$(TARGET)' INTERFACE='$(INTERFACE)'
|
||||
|
||||
all::
|
||||
$(MAKE) -f $(TOP)/Makefile CXXSRCS='$(CXXSRCS)' SWIG='$(SWIG)' \
|
||||
TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' r_cpp
|
||||
|
||||
clean::
|
||||
$(MAKE) -f $(TOP)/Makefile $(ARGS) r_clean
|
||||
|
||||
check: all
|
||||
R CMD BATCH runme.R
|
||||
28
Examples/r/class/example.cxx
Normal file
28
Examples/r/class/example.cxx
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
/* File : example.c */
|
||||
|
||||
#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(void) {
|
||||
return M_PI*radius*radius;
|
||||
}
|
||||
|
||||
double Circle::perimeter(void) {
|
||||
return 2*M_PI*radius;
|
||||
}
|
||||
|
||||
double Square::area(void) {
|
||||
return width*width;
|
||||
}
|
||||
|
||||
double Square::perimeter(void) {
|
||||
return 4*width;
|
||||
}
|
||||
39
Examples/r/class/example.h
Normal file
39
Examples/r/class/example.h
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
/* File : example.h */
|
||||
|
||||
class Shape {
|
||||
public:
|
||||
Shape() {
|
||||
nshapes++;
|
||||
}
|
||||
virtual ~Shape() {
|
||||
nshapes--;
|
||||
};
|
||||
double x, y;
|
||||
void move(double dx, double dy);
|
||||
virtual double area(void) = 0;
|
||||
virtual double perimeter(void) = 0;
|
||||
static int nshapes;
|
||||
};
|
||||
|
||||
class Circle : public Shape {
|
||||
private:
|
||||
double radius;
|
||||
public:
|
||||
Circle(double r) : radius(r) { };
|
||||
virtual double area(void);
|
||||
virtual double perimeter(void);
|
||||
};
|
||||
|
||||
class Square : public Shape {
|
||||
private:
|
||||
double width;
|
||||
public:
|
||||
Square(double w) : width(w) { };
|
||||
virtual double area(void);
|
||||
virtual double perimeter(void);
|
||||
};
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
9
Examples/r/class/example.i
Normal file
9
Examples/r/class/example.i
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
/* File : example.i */
|
||||
%module example
|
||||
|
||||
%inline %{
|
||||
#include "example.h"
|
||||
%}
|
||||
%include "example.h"
|
||||
|
||||
|
||||
49
Examples/r/class/runme.R
Normal file
49
Examples/r/class/runme.R
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
# This file illustrates the shadow-class C++ interface generated
|
||||
# by SWIG.
|
||||
|
||||
dyn.load('example_wrap.so')
|
||||
source('example_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
# ----- Object creation -----
|
||||
|
||||
print("Creating some objects:")
|
||||
circle <- Circle(10)
|
||||
print (" Created circle")
|
||||
square <- Square(10)
|
||||
print (" Created square")
|
||||
|
||||
# ----- Access a static member -----
|
||||
|
||||
sprintf("A total of %d shapes were created", Shape_nshapes())
|
||||
|
||||
# ----- Member data access -----
|
||||
|
||||
# Set the location of the object
|
||||
|
||||
circle$x <- 20
|
||||
circle$y <- 30
|
||||
|
||||
square$x <- -10
|
||||
square$y <- 5
|
||||
|
||||
print("Here is their current position:")
|
||||
sprintf(" Circle = (%f, %f)", circle$x,circle$y)
|
||||
sprintf(" Square = (%f, %f)", square$x,square$y)
|
||||
|
||||
# ----- Call some methods -----
|
||||
|
||||
print ("Here are some properties of the shapes:")
|
||||
|
||||
sapply(c(circle, square),
|
||||
function(o) {
|
||||
sprintf(" area = %f perimeter = %f", o$area(), o$perimeter())
|
||||
})
|
||||
|
||||
print("Guess I'll clean up now")
|
||||
delete(circle)
|
||||
delete(square)
|
||||
|
||||
sprintf("%d shapes remain", Shape_nshapes())
|
||||
print ("Goodbye");
|
||||
|
||||
16
Examples/r/simple/Makefile
Normal file
16
Examples/r/simple/Makefile
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
TOP = ../..
|
||||
SWIG = $(TOP)/../preinst-swig
|
||||
SRCS = example.c
|
||||
TARGET = example
|
||||
INTERFACE = example.i
|
||||
ARGS = SRCS='$(SRCS)' SWIG='$(SWIG)' \
|
||||
TARGET='$(TARGET)' INTERFACE='$(INTERFACE)'
|
||||
|
||||
all::
|
||||
$(MAKE) -f $(TOP)/Makefile $(ARGS) r
|
||||
|
||||
clean::
|
||||
$(MAKE) -f $(TOP)/Makefile $(ARGS) r_clean
|
||||
|
||||
check: all
|
||||
R CMD BATCH runme.R
|
||||
18
Examples/r/simple/example.c
Normal file
18
Examples/r/simple/example.c
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
/* 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/r/simple/example.i
Normal file
7
Examples/r/simple/example.i
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
/* File : example.i */
|
||||
%module example
|
||||
|
||||
%inline %{
|
||||
extern int gcd(int x, int y);
|
||||
extern double Foo;
|
||||
%}
|
||||
24
Examples/r/simple/runme.R
Normal file
24
Examples/r/simple/runme.R
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
# file: runme.R
|
||||
|
||||
dyn.load('example_wrap.so')
|
||||
source('example_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
# Call our gcd() function
|
||||
|
||||
x <- 42
|
||||
y <- 105
|
||||
g <- gcd(x,y)
|
||||
sprintf("The gcd of %d and %d is %d", x, y, g)
|
||||
|
||||
# Manipulate the Foo global variable
|
||||
|
||||
# Output its current value
|
||||
Foo()
|
||||
|
||||
# Change its value
|
||||
Foo(3.1415926)
|
||||
|
||||
# See if the change took effect
|
||||
Foo()
|
||||
|
||||
|
|
@ -35,7 +35,7 @@ CXXSRCS =
|
|||
CSRCS =
|
||||
TARGETPREFIX =
|
||||
TARGETSUFFIX =
|
||||
SWIGOPT = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)
|
||||
SWIGOPT = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE) -DSWIG_NOEXTRA_QUALIFICATION
|
||||
INCLUDES = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)
|
||||
LIBS = -L.
|
||||
LIBPREFIX = lib
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ public:
|
|||
SWIG_STD_VECTOR_SPECIALIZE_MINIMUM(Flow, Space::Flow)
|
||||
#endif
|
||||
|
||||
#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)
|
||||
#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)||defined(SWIGR)
|
||||
#define SWIG_GOOD_VECTOR
|
||||
%ignore std::vector<Space::Flow>::vector(size_type);
|
||||
%ignore std::vector<Space::Flow>::resize(size_type);
|
||||
|
|
|
|||
|
|
@ -19,7 +19,11 @@
|
|||
|
||||
int x;
|
||||
int *xp;
|
||||
#ifdef SWIGR
|
||||
int& c_member = x;
|
||||
#else
|
||||
int& c = x;
|
||||
#endif
|
||||
|
||||
void *vp;
|
||||
|
||||
|
|
|
|||
|
|
@ -61,7 +61,10 @@ namespace std
|
|||
|
||||
%inline {
|
||||
/* silently rename the parameter names in csharp/java */
|
||||
|
||||
#ifdef SWIGR
|
||||
double foo(double inparam, double out) { return 1.0; }
|
||||
#else
|
||||
double foo(double in, double out) { return 1.0; }
|
||||
#endif
|
||||
double bar(double native, bool boolean) { return 1.0; }
|
||||
}
|
||||
|
|
|
|||
54
Examples/test-suite/r/Makefile.in
Normal file
54
Examples/test-suite/r/Makefile.in
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
#######################################################################
|
||||
# $Header$
|
||||
# Makefile for mzscheme test-suite
|
||||
#######################################################################
|
||||
|
||||
LANGUAGE = r
|
||||
SCRIPTSUFFIX = _runme.R
|
||||
WRAPSUFFIX = _wrap.R
|
||||
RUNR = R CMD BATCH --no-save --no-restore
|
||||
srcdir = @srcdir@
|
||||
top_srcdir = @top_srcdir@
|
||||
top_builddir = @top_builddir@
|
||||
|
||||
C_TEST_CASES = copyStruct simpleArray legacy
|
||||
CPP_TEST_CASES = funcptr double_delete
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
|
||||
# Overridden variables here
|
||||
|
||||
# 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.
|
||||
#
|
||||
# Run the runme if it exists. If not just load the R wrapper to
|
||||
# check for syntactic correctness
|
||||
run_testcase = \
|
||||
if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then ( \
|
||||
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH \
|
||||
$(RUNR) $(srcdir)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ;) \
|
||||
else \
|
||||
($(RUNR) $(srcdir)/$(SCRIPTPREFIX)$*$(WRAPSUFFIX);) \
|
||||
fi;
|
||||
|
||||
# Clean
|
||||
clean:
|
||||
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile r_clean
|
||||
|
||||
%.clean:
|
||||
@rm -f $*_wrap.R $*_wrap.so $*_wrap.cpp $*_wrap.c $*_runme.Rout
|
||||
55
Examples/test-suite/r/copyStruct_runme.R
Normal file
55
Examples/test-suite/r/copyStruct_runme.R
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
source('unittest.R')
|
||||
dyn.load('copyStruct_wrap.so')
|
||||
source('copyStruct_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
a <- getA()
|
||||
|
||||
r = getARef()
|
||||
|
||||
unittest(A_d_get(r), 42)
|
||||
unittest(r$d, 42)
|
||||
unittest(r$i, 20)
|
||||
|
||||
# An error in trying to access a field that doesn't exist.
|
||||
try(r$foo)
|
||||
|
||||
r$d <- pi
|
||||
unittesttol(r$d, 3.141593, 0.0001)
|
||||
r$i <- -100
|
||||
|
||||
r$ui
|
||||
r$ui <- 10
|
||||
|
||||
# An error since i is unsigned and so must be positive.
|
||||
try(r$ui <- -10)
|
||||
|
||||
|
||||
a = A()
|
||||
unittest(a$i,0)
|
||||
unittest(a$d,0)
|
||||
unittest(a$ui,0)
|
||||
a$ui <- 100
|
||||
unittest(a$ui,100)
|
||||
a$d = 1
|
||||
unittest(a$d,1)
|
||||
|
||||
d <- bar()
|
||||
unittest(class(d), "_p_D")
|
||||
unittest(d$x, 1)
|
||||
unittest(d$u, 0)
|
||||
|
||||
|
||||
la <- new("A");
|
||||
la@ui <- 5
|
||||
|
||||
other = A()
|
||||
foo <- copyToC(la, other)
|
||||
|
||||
aa = A()
|
||||
aa$i = 201
|
||||
aa$d = pi
|
||||
aa$str = 'foo'
|
||||
copyToR(aa)
|
||||
|
||||
|
||||
15
Examples/test-suite/r/double_delete.i
Normal file
15
Examples/test-suite/r/double_delete.i
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
/* File : example.i */
|
||||
%module double_delete
|
||||
|
||||
%inline %{
|
||||
|
||||
class Foo {
|
||||
private:
|
||||
double r;
|
||||
public:
|
||||
Foo(double rin) : r(rin) {};
|
||||
};
|
||||
%}
|
||||
|
||||
|
||||
|
||||
12
Examples/test-suite/r/double_delete_runme.R
Normal file
12
Examples/test-suite/r/double_delete_runme.R
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
# This file illustrates the shadow-class C++ interface generated
|
||||
# by SWIG.
|
||||
|
||||
dyn.load('double_delete_wrap.so')
|
||||
source('double_delete_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
# ----- Object creation -----
|
||||
|
||||
f <- Foo(2.0)
|
||||
delete(f);
|
||||
delete(f);
|
||||
7
Examples/test-suite/r/funcptr_runme.R
Normal file
7
Examples/test-suite/r/funcptr_runme.R
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
source('unittest.R')
|
||||
dyn.load('funcptr_wrap.so')
|
||||
source('funcptr_wrap.R')
|
||||
cacheMetaData(1)
|
||||
unittest(do_op(1, 3, add), 4)
|
||||
unittest(do_op(2, 3, mul), 6)
|
||||
unittest(do_op(2, 3, funcvar()), 5)
|
||||
10
Examples/test-suite/r/ignore_parameter_runme.R
Normal file
10
Examples/test-suite/r/ignore_parameter_runme.R
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
source('unittest.R')
|
||||
dyn.load('ignore_parameter_wrap.so')
|
||||
source('ignore_parameter_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
unittest(jaguar(1, 1.0), "hello")
|
||||
q(save='no')
|
||||
|
||||
|
||||
|
||||
30
Examples/test-suite/r/legacy_runme.R
Normal file
30
Examples/test-suite/r/legacy_runme.R
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
source('unittest.R')
|
||||
dyn.load('legacy_wrap.so')
|
||||
source('legacy_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
obj <- getObject(1,3)
|
||||
unittest(class(obj), "_p_Obj")
|
||||
unittest(obj$i, 1)
|
||||
unittesttol(obj$d, 3, 0.001)
|
||||
unittest(obj$str, "a test string")
|
||||
obj$i <- 2
|
||||
unittest(obj$i, 2)
|
||||
obj$d <- 4
|
||||
unittesttol(obj$d, 4, 0.001)
|
||||
obj$str <- "a new string"
|
||||
unittest(obj$str, "a new string")
|
||||
|
||||
unittest(getInt(), 42)
|
||||
unittesttol(getDouble(),3.14159, 0.001)
|
||||
unittesttol(getFloat(),3.14159/2.0, 0.001)
|
||||
unittest(getLong(), -321313)
|
||||
unittest(getUnsignedLong(), 23123)
|
||||
unittest(getChar(), "A")
|
||||
|
||||
q(save='no')
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
9
Examples/test-suite/r/simpleArray_runme.R
Normal file
9
Examples/test-suite/r/simpleArray_runme.R
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
source('unittest.R')
|
||||
dyn.load('simpleArray_wrap.so')
|
||||
source('simpleArray_wrap.R')
|
||||
cacheMetaData(1)
|
||||
initArray()
|
||||
|
||||
q(save='no')
|
||||
|
||||
|
||||
12
Examples/test-suite/r/unions_runme.R
Normal file
12
Examples/test-suite/r/unions_runme.R
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
source('unittest.R')
|
||||
dyn.load('unions_wrap.so')
|
||||
source('unions_wrap.R')
|
||||
cacheMetaData(1)
|
||||
|
||||
ss <- SmallStruct()
|
||||
|
||||
bstruct <- BigStruct()
|
||||
|
||||
q(save='no')
|
||||
|
||||
|
||||
9
Examples/test-suite/r/unittest.R
Normal file
9
Examples/test-suite/r/unittest.R
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
unittest <- function (x,y) {
|
||||
if (x==y) print("PASS")
|
||||
else print("FAIL")
|
||||
}
|
||||
|
||||
unittesttol <- function(x,y,z) {
|
||||
if (abs(x-y) < z) print("PASS")
|
||||
else print("FAIL")
|
||||
}
|
||||
1
Lib/r/cdata.i
Normal file
1
Lib/r/cdata.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include <typemaps/cdata.swg>
|
||||
8
Lib/r/exception.i
Normal file
8
Lib/r/exception.i
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
%include <typemaps/exception.swg>
|
||||
|
||||
|
||||
%insert("runtime") {
|
||||
%define_as(SWIG_exception(code, msg),
|
||||
%block(switch (code) {case SWIG_IndexError: return Rf_ScalarLogical(NA_LOGICAL); default: %error(code, msg); SWIG_fail;} ))
|
||||
}
|
||||
|
||||
189
Lib/r/r.swg
Normal file
189
Lib/r/r.swg
Normal file
|
|
@ -0,0 +1,189 @@
|
|||
/* */
|
||||
|
||||
|
||||
%insert("header") "swiglabels.swg"
|
||||
|
||||
%insert("header") "swigerrors.swg"
|
||||
%insert("init") "swiginit.swg"
|
||||
%insert("runtime") "swigrun.swg"
|
||||
%insert("runtime") "rrun.swg"
|
||||
|
||||
%init %{
|
||||
SWIGEXPORT void SWIG_init(void) {
|
||||
%}
|
||||
|
||||
#define %Rruntime %insert("s")
|
||||
|
||||
#define SWIG_Object SEXP
|
||||
#define VOID_Object R_NilValue
|
||||
|
||||
#define %append_output(obj) SET_VECTOR_ELT($result, $n, obj)
|
||||
|
||||
%define %set_constant(name, obj) %begin_block
|
||||
SEXP _obj = obj;
|
||||
assign(name, _obj);
|
||||
%end_block %enddef
|
||||
|
||||
%define %raise(obj,type,desc)
|
||||
return R_NilValue;
|
||||
%enddef
|
||||
|
||||
%insert("sinit") "srun.swg"
|
||||
|
||||
%insert("sinitroutine") %{
|
||||
SWIG_init();
|
||||
SWIG_InitializeModule(0);
|
||||
%}
|
||||
|
||||
%include <typemaps/swigmacros.swg>
|
||||
%typemap(in) (double *x, int len) %{
|
||||
$1 = REAL(x);
|
||||
$2 = Rf_length(x);
|
||||
%}
|
||||
|
||||
/* XXX
|
||||
Need to worry about inheritance, e.g. if B extends A
|
||||
and we are looking for an A[], then B elements are okay.
|
||||
*/
|
||||
%typemap(scheck) SWIGTYPE[ANY]
|
||||
%{
|
||||
# assert(length($input) > $1_dim0)
|
||||
assert(all(sapply($input, class) == "$R_class"))
|
||||
%}
|
||||
|
||||
%typemap(out) void "";
|
||||
|
||||
%typemap(in) int *, int[ANY] %{
|
||||
$1 = INTEGER($input);
|
||||
%}
|
||||
|
||||
%typemap(in) double *, double[ANY] %{
|
||||
$1 = REAL($input);
|
||||
%}
|
||||
|
||||
/* Shoul dwe recycle to make the length correct.
|
||||
And warn if length() > the dimension.
|
||||
*/
|
||||
%typemap(scheck) SWIGTYPE [ANY] %{
|
||||
# assert(length($input) >= $1_dim0)
|
||||
%}
|
||||
|
||||
/* Handling vector case to avoid warnings,
|
||||
although we just use the first one. */
|
||||
%typemap(scheck) unsigned int %{
|
||||
assert(length($input) == 1 && $input >= 0, "All values must be non-negative")
|
||||
%}
|
||||
|
||||
|
||||
%typemap(scheck) int %{
|
||||
if(length($input) > 1) {
|
||||
warning("using only the first element of $input")
|
||||
}
|
||||
%}
|
||||
|
||||
|
||||
%include <typemaps/swigmacros.swg>
|
||||
%include <typemaps/fragments.swg>
|
||||
%include <rfragments.swg>
|
||||
%include <ropers.swg>
|
||||
%include <typemaps/swigtypemaps.swg>
|
||||
%include <rtype.swg>
|
||||
|
||||
%apply int[ANY] { enum SWIGTYPE[ANY] };
|
||||
|
||||
%typemap(in,noblock=1) enum SWIGTYPE[ANY] {
|
||||
$1 = %reinterpret_cast(INTEGER($input), $1_ltype);
|
||||
}
|
||||
|
||||
%typemap(in,noblock=1) char* {
|
||||
$1 = %reinterpret_cast(CHAR(STRING_ELT($input, 0)), $1_ltype);
|
||||
}
|
||||
|
||||
%typemap(in,noblock=1) char *[ANY] {
|
||||
$1 = %reinterpret_cast(CHAR(STRING_ELT($input, 0)), $1_ltype);
|
||||
}
|
||||
|
||||
%typemap(in,noblock=1) char[ANY]
|
||||
"$1 = CHAR(STRING_ELT($input, 0));";
|
||||
|
||||
%typemap(in,noblock=1) char[]
|
||||
"$1 = CHAR(STRING_ELT($input, 0));";
|
||||
|
||||
%typemap(memberin) char[] %{
|
||||
if ($input) strcpy($1, $input);
|
||||
else
|
||||
strcpy($1, "");
|
||||
%}
|
||||
|
||||
%typemap(globalin) char[] %{
|
||||
if ($input) strcpy($1, $input);
|
||||
else
|
||||
strcpy($1, "");
|
||||
%}
|
||||
|
||||
%typemap(out,noblock=1) char*
|
||||
{ $result = $1 ? mkString(%reinterpret_cast($1,char *)) : R_NilValue; }
|
||||
|
||||
%typemap(in,noblock=1) char {
|
||||
$1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype);
|
||||
}
|
||||
|
||||
%typemap(out,noblock=1) char
|
||||
{
|
||||
char tmp[2] = "x";
|
||||
tmp[0] = $1;
|
||||
$result = mkString(tmp);
|
||||
}
|
||||
|
||||
|
||||
%typemap(in,noblock=1) int {
|
||||
$1 = %static_cast(INTEGER($input)[0], $1_ltype);
|
||||
}
|
||||
|
||||
%typemap(out,noblock=1) int
|
||||
"$result = ScalarInteger($1);";
|
||||
|
||||
|
||||
%typemap(in,noblock=1) bool
|
||||
"$1 = LOGICAL($input)[0];";
|
||||
|
||||
|
||||
%typemap(out,noblock=1) bool
|
||||
"$result = ScalarLogical($1);";
|
||||
|
||||
%typemap(in,noblock=1) unsigned int,
|
||||
unsigned long,
|
||||
float,
|
||||
double,
|
||||
long
|
||||
{
|
||||
$1 = %static_cast(REAL($input)[0], $1_ltype);
|
||||
}
|
||||
|
||||
|
||||
%typemap(out,noblock=1) unsigned int *
|
||||
"$result = ScalarReal(*($1));";
|
||||
|
||||
%Rruntime %{
|
||||
setMethod('[', "ExternalReference",
|
||||
function(x,i,j, ..., drop=TRUE)
|
||||
if (!is.null(x$"__getitem__"))
|
||||
sapply(i, function(n) x$"__getitem__"(i=as.integer(n-1))))
|
||||
|
||||
setMethod('[<-' , "ExternalReference",
|
||||
function(x,i,j, ..., value)
|
||||
if (!is.null(x$"__setitem__")) {
|
||||
sapply(1:length(i), function(n)
|
||||
x$"__setitem__"(i=as.integer(i[n]-1), x=value[n]))
|
||||
x
|
||||
})
|
||||
|
||||
setAs('ExternalReference', 'character',
|
||||
function(from) {if (!is.null(from$"__str__")) from$"__str__"()})
|
||||
|
||||
setMethod('print', 'ExternalReference',
|
||||
function(x) {print(as(x, "character"))})
|
||||
%}
|
||||
|
||||
|
||||
|
||||
198
Lib/r/rcontainer.swg
Normal file
198
Lib/r/rcontainer.swg
Normal file
|
|
@ -0,0 +1,198 @@
|
|||
|
||||
//
|
||||
// Common fragments
|
||||
//
|
||||
|
||||
|
||||
/**** The python container methods ****/
|
||||
|
||||
|
||||
|
||||
%fragment("RSequence_Base","header")
|
||||
{
|
||||
%#include <functional>
|
||||
namespace swig {
|
||||
inline size_t
|
||||
check_index(ptrdiff_t i, size_t size, bool insert = false) {
|
||||
if ( i < 0 ) {
|
||||
if ((size_t) (-i) <= size)
|
||||
return (size_t) (i + size);
|
||||
} else if ( (size_t) i < size ) {
|
||||
return (size_t) i;
|
||||
} else if (insert && ((size_t) i == size)) {
|
||||
return size;
|
||||
}
|
||||
|
||||
throw std::out_of_range("index out of range");
|
||||
}
|
||||
|
||||
inline size_t
|
||||
slice_index(ptrdiff_t i, size_t size) {
|
||||
if ( i < 0 ) {
|
||||
if ((size_t) (-i) <= size) {
|
||||
return (size_t) (i + size);
|
||||
} else {
|
||||
throw std::out_of_range("index out of range");
|
||||
}
|
||||
} else {
|
||||
return ( (size_t) i < size ) ? ((size_t) i) : size;
|
||||
}
|
||||
}
|
||||
|
||||
template <class Sequence, class Difference>
|
||||
inline typename Sequence::iterator
|
||||
getpos(Sequence* self, Difference i) {
|
||||
typename Sequence::iterator pos = self->begin();
|
||||
std::advance(pos, check_index(i,self->size()));
|
||||
return pos;
|
||||
}
|
||||
|
||||
template <class Sequence, class Difference>
|
||||
inline typename Sequence::const_iterator
|
||||
cgetpos(const Sequence* self, Difference i) {
|
||||
typename Sequence::const_iterator pos = self->begin();
|
||||
std::advance(pos, check_index(i,self->size()));
|
||||
return pos;
|
||||
}
|
||||
|
||||
template <class Sequence, class Difference>
|
||||
inline Sequence*
|
||||
getslice(const Sequence* self, Difference i, Difference j) {
|
||||
typename Sequence::size_type size = self->size();
|
||||
typename Sequence::size_type ii = swig::check_index(i, size);
|
||||
typename Sequence::size_type jj = swig::slice_index(j, size);
|
||||
|
||||
if (jj > ii) {
|
||||
typename Sequence::const_iterator vb = self->begin();
|
||||
typename Sequence::const_iterator ve = self->begin();
|
||||
std::advance(vb,ii);
|
||||
std::advance(ve,jj);
|
||||
return new Sequence(vb, ve);
|
||||
} else {
|
||||
return new Sequence();
|
||||
}
|
||||
}
|
||||
|
||||
template <class Sequence, class Difference, class InputSeq>
|
||||
inline void
|
||||
setslice(Sequence* self, Difference i, Difference j, const InputSeq& v) {
|
||||
typename Sequence::size_type size = self->size();
|
||||
typename Sequence::size_type ii = swig::check_index(i, size, true);
|
||||
typename Sequence::size_type jj = swig::slice_index(j, size);
|
||||
if (jj < ii) jj = ii;
|
||||
size_t ssize = jj - ii;
|
||||
if (ssize <= v.size()) {
|
||||
typename Sequence::iterator sb = self->begin();
|
||||
typename InputSeq::const_iterator vmid = v.begin();
|
||||
std::advance(sb,ii);
|
||||
std::advance(vmid, jj - ii);
|
||||
self->insert(std::copy(v.begin(), vmid, sb), vmid, v.end());
|
||||
} else {
|
||||
typename Sequence::iterator sb = self->begin();
|
||||
typename Sequence::iterator se = self->begin();
|
||||
std::advance(sb,ii);
|
||||
std::advance(se,jj);
|
||||
self->erase(sb,se);
|
||||
self->insert(sb, v.begin(), v.end());
|
||||
}
|
||||
}
|
||||
|
||||
template <class Sequence, class Difference>
|
||||
inline void
|
||||
delslice(Sequence* self, Difference i, Difference j) {
|
||||
typename Sequence::size_type size = self->size();
|
||||
typename Sequence::size_type ii = swig::check_index(i, size, true);
|
||||
typename Sequence::size_type jj = swig::slice_index(j, size);
|
||||
if (jj > ii) {
|
||||
typename Sequence::iterator sb = self->begin();
|
||||
typename Sequence::iterator se = self->begin();
|
||||
std::advance(sb,ii);
|
||||
std::advance(se,jj);
|
||||
self->erase(sb,se);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
%define %swig_container_methods(Container...)
|
||||
|
||||
%newobject __getslice__;
|
||||
|
||||
%extend {
|
||||
bool __nonzero__() const {
|
||||
return !(self->empty());
|
||||
}
|
||||
|
||||
size_type __len__() const {
|
||||
return self->size();
|
||||
}
|
||||
}
|
||||
%enddef
|
||||
|
||||
%define %swig_sequence_methods_common(Sequence...)
|
||||
// %swig_sequence_iterator(%arg(Sequence))
|
||||
%swig_container_methods(%arg(Sequence))
|
||||
|
||||
%fragment("RSequence_Base");
|
||||
|
||||
%extend {
|
||||
value_type pop() throw (std::out_of_range) {
|
||||
if (self->size() == 0)
|
||||
throw std::out_of_range("pop from empty container");
|
||||
Sequence::value_type x = self->back();
|
||||
self->pop_back();
|
||||
return x;
|
||||
}
|
||||
|
||||
Sequence* __getslice__(difference_type i, difference_type j) throw (std::out_of_range) {
|
||||
return swig::getslice(self, i, j);
|
||||
}
|
||||
|
||||
void __setslice__(difference_type i, difference_type j, const Sequence& v)
|
||||
throw (std::out_of_range, std::invalid_argument) {
|
||||
swig::setslice(self, i, j, v);
|
||||
}
|
||||
|
||||
void __delslice__(difference_type i, difference_type j) throw (std::out_of_range) {
|
||||
swig::delslice(self, i, j);
|
||||
}
|
||||
|
||||
void __delitem__(difference_type i) throw (std::out_of_range) {
|
||||
self->erase(swig::getpos(self,i));
|
||||
}
|
||||
}
|
||||
%enddef
|
||||
|
||||
%define %swig_sequence_methods(Sequence...)
|
||||
%swig_sequence_methods_common(%arg(Sequence))
|
||||
%extend {
|
||||
const value_type& __getitem__(difference_type i) const throw (std::out_of_range) {
|
||||
return *(swig::cgetpos(self, i));
|
||||
}
|
||||
|
||||
void __setitem__(difference_type i, const value_type& x) throw (std::out_of_range) {
|
||||
*(swig::getpos(self,i)) = x;
|
||||
}
|
||||
|
||||
void append(const value_type& x) {
|
||||
self->push_back(x);
|
||||
}
|
||||
}
|
||||
%enddef
|
||||
|
||||
%define %swig_sequence_methods_val(Sequence...)
|
||||
%swig_sequence_methods_common(%arg(Sequence))
|
||||
%extend {
|
||||
value_type __getitem__(difference_type i) throw (std::out_of_range) {
|
||||
return *(swig::cgetpos(self, i));
|
||||
}
|
||||
|
||||
void __setitem__(difference_type i, value_type x) throw (std::out_of_range) {
|
||||
*(swig::getpos(self,i)) = x;
|
||||
}
|
||||
|
||||
void append(value_type x) {
|
||||
self->push_back(x);
|
||||
}
|
||||
}
|
||||
%enddef
|
||||
167
Lib/r/rfragments.swg
Normal file
167
Lib/r/rfragments.swg
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
#define SWIG_Error(code, msg) warning(msg); return Rf_ScalarLogical(NA_LOGICAL)
|
||||
|
||||
#define SWIG_fail return Rf_ScalarLogical(NA_LOGICAL)
|
||||
|
||||
/* for raw pointers */
|
||||
#define SWIG_ConvertPtr(oc, ptr, ty, flags) SWIG_R_ConvertPtr(oc, ptr, ty, flags)
|
||||
#define SWIG_ConvertFunctionPtr(oc, ptr, ty) SWIG_R_ConvertPtr(oc, ptr, ty, 0)
|
||||
#define SWIG_NewPointerObj(ptr, ty, flags) SWIG_R_NewPointerObj(ptr, ty, flags)
|
||||
#define SWIG_NewFunctionPtrObj(ptr, ty) SWIG_R_NewPointerObj(ptr, ty, 0)
|
||||
|
||||
/* for raw packed data */
|
||||
#define SWIG_ConvertPacked(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty)
|
||||
#define SWIG_NewPackedObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty)
|
||||
|
||||
/* for class or struct pointers */
|
||||
#define SWIG_ConvertInstance(obj, pptr, ty, flags) SWIG_ConvertPtr(obj, pptr, ty, flags)
|
||||
#define SWIG_NewInstanceObj(ptr, ty, flags) SWIG_NewPointerObj(ptr, ty, flags)
|
||||
|
||||
/* for C++ member pointers, ie, member methods */
|
||||
#define SWIG_ConvertMember(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty)
|
||||
#define SWIG_NewMemberObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty)
|
||||
|
||||
|
||||
/* Runtime API */
|
||||
|
||||
#define SWIG_GetModule(clientdata) SWIG_R_GetModule()
|
||||
#define SWIG_SetModule(clientdata, pointer) SWIG_R_SetModule(pointer)
|
||||
|
||||
%fragment(SWIG_From_frag(long),"header") {
|
||||
SWIGINTERNINLINE SEXP
|
||||
SWIG_From_dec(long)(long value)
|
||||
{
|
||||
return Rf_ScalarInteger((int)value);
|
||||
}
|
||||
}
|
||||
|
||||
%fragment(SWIG_AsVal_frag(long),"header") {
|
||||
SWIGINTERNINLINE int
|
||||
SWIG_AsVal_dec(long)(SEXP obj, long *val)
|
||||
{
|
||||
if (val) *val = Rf_asInteger(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%fragment(SWIG_From_frag(long long),"header") {
|
||||
SWIGINTERNINLINE SEXP
|
||||
SWIG_From_dec(long long)(long long value)
|
||||
{
|
||||
return Rf_ScalarInteger((int)value);
|
||||
}
|
||||
}
|
||||
|
||||
%fragment(SWIG_AsVal_frag(long long),"header") {
|
||||
SWIGINTERNINLINE int
|
||||
SWIG_AsVal_dec(long long)(SEXP obj, long long *val)
|
||||
{
|
||||
if (val) *val = Rf_asInteger(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
%fragment(SWIG_From_frag(unsigned long),"header") {
|
||||
SWIGINTERNINLINE SEXP
|
||||
SWIG_From_dec(unsigned long)(unsigned long value)
|
||||
{
|
||||
return Rf_ScalarInteger((int)value);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%fragment(SWIG_AsVal_frag(unsigned long),"header") {
|
||||
SWIGINTERNINLINE int
|
||||
SWIG_AsVal_dec(unsigned long)(SEXP obj, unsigned long *val)
|
||||
{
|
||||
if (val) *val = Rf_asInteger(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%fragment(SWIG_From_frag(unsigned long long),"header") {
|
||||
SWIGINTERNINLINE SEXP
|
||||
SWIG_From_dec(unsigned long long)(unsigned long long value)
|
||||
{
|
||||
return Rf_ScalarInteger((int)value);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%fragment(SWIG_AsVal_frag(unsigned long long),"header") {
|
||||
SWIGINTERNINLINE int
|
||||
SWIG_AsVal_dec(unsigned long long)(SEXP obj, unsigned long long *val)
|
||||
{
|
||||
if (val) *val = Rf_asInteger(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
%fragment(SWIG_From_frag(double),"header") {
|
||||
SWIGINTERNINLINE SEXP
|
||||
SWIG_From_dec(double)(double value)
|
||||
{
|
||||
return Rf_ScalarReal(value);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
%fragment(SWIG_AsVal_frag(double),"header") {
|
||||
SWIGINTERNINLINE int
|
||||
SWIG_AsVal_dec(double)(SEXP obj, double *val)
|
||||
{
|
||||
if (val) *val = Rf_asReal(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
%fragment("SWIG_AsCharPtrAndSize", "header")
|
||||
{
|
||||
SWIGINTERN int
|
||||
SWIG_AsCharPtrAndSize(SEXP obj, char** cptr, size_t* psize, int *alloc)
|
||||
{
|
||||
if (!cptr) return SWIG_TypeError;
|
||||
if (!Rf_isString(obj)) return SWIG_TypeError;
|
||||
char *cstr; int len;
|
||||
cstr = CHAR(STRING_ELT(obj, 0));
|
||||
len = strlen(cstr);
|
||||
|
||||
if (cptr) {
|
||||
if (alloc) {
|
||||
if (*alloc == SWIG_NEWOBJ)
|
||||
{
|
||||
*cptr = %new_copy_array(cstr, len + 1, char);
|
||||
*alloc = SWIG_NEWOBJ;
|
||||
}
|
||||
else {
|
||||
*cptr = cstr;
|
||||
*alloc = SWIG_OLDOBJ;
|
||||
}
|
||||
} else {
|
||||
*cptr = strdup(cstr);
|
||||
}
|
||||
}
|
||||
if (psize) *psize = len + 1;
|
||||
return SWIG_OK;
|
||||
}
|
||||
}
|
||||
|
||||
# This is modified from the R header files
|
||||
|
||||
%fragment("SWIG_FromCharPtrAndSize","header")
|
||||
{
|
||||
SWIGINTERN SEXP
|
||||
SWIG_FromCharPtrAndSize(const char* carray, size_t size)
|
||||
{
|
||||
SEXP t, c;
|
||||
if (!carray) return R_NilValue;
|
||||
PROTECT(t = allocVector(STRSXP, 1));
|
||||
c = allocString(size);
|
||||
strncpy(CHAR(c), carray, size);
|
||||
SET_STRING_ELT(t, 0, c);
|
||||
UNPROTECT(1);
|
||||
return t;
|
||||
}
|
||||
}
|
||||
|
||||
44
Lib/r/ropers.swg
Normal file
44
Lib/r/ropers.swg
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
#ifdef __cplusplus
|
||||
|
||||
// These are auto-supported by the Perl-module
|
||||
%rename(__plusplus__) *::operator++;
|
||||
%rename(__minmin__) *::operator--;
|
||||
%rename(__add__) *::operator+;
|
||||
%rename(__sub__) *::operator-;
|
||||
%rename(__neg__) *::operator-();
|
||||
%rename(__neg__) *::operator-() const;
|
||||
%rename(__mul__) *::operator*;
|
||||
%rename(__div__) *::operator/;
|
||||
%rename(__eq__) *::operator==;
|
||||
%rename(__ne__) *::operator!=;
|
||||
%rename(__mod__) *::operator%;
|
||||
%rename(__gt__) *::operator>;
|
||||
%rename(__lt__) *::operator<;
|
||||
%rename(__not__) *::operator!;
|
||||
|
||||
// These are renamed, but no 'use overload...' is added
|
||||
%rename(__lshift__) *::operator<<;
|
||||
%rename(__rshift__) *::operator>>;
|
||||
%rename(__and__) *::operator&;
|
||||
%rename(__or__) *::operator|;
|
||||
%rename(__xor__) *::operator^;
|
||||
%rename(__invert__) *::operator~;
|
||||
%rename(__le__) *::operator<=;
|
||||
%rename(__ge__) *::operator>=;
|
||||
%rename(__call__) *::operator();
|
||||
%rename(__getitem__) *::operator[];
|
||||
|
||||
%rename(__seteq__) *::operator=;
|
||||
|
||||
|
||||
/* Ignored operators */
|
||||
%ignoreoperator(LNOT) operator!;
|
||||
%ignoreoperator(LAND) operator&&;
|
||||
%ignoreoperator(LOR) operator||;
|
||||
%ignoreoperator(EQ) *::operator=;
|
||||
%ignoreoperator(PLUSPLUS) *::operator++;
|
||||
%ignoreoperator(MINUSMINUS) *::operator--;
|
||||
%ignoreoperator(ARROWSTAR) *::operator->*;
|
||||
%ignoreoperator(INDEX) *::operator[];
|
||||
|
||||
#endif
|
||||
355
Lib/r/rrun.swg
Normal file
355
Lib/r/rrun.swg
Normal file
|
|
@ -0,0 +1,355 @@
|
|||
|
||||
/* Not really used yet. */
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#include <Rdefines.h>
|
||||
#undef length
|
||||
#define SWIGR 1
|
||||
|
||||
/*
|
||||
This is mainly a way to avoid having lots of local variables that may
|
||||
conflict with those in the routine.
|
||||
|
||||
Change name to R_SWIG_Callb....
|
||||
*/
|
||||
typedef struct RCallbackFunctionData {
|
||||
|
||||
SEXP fun;
|
||||
SEXP userData;
|
||||
|
||||
|
||||
SEXP expr;
|
||||
SEXP retValue;
|
||||
int errorOccurred;
|
||||
|
||||
SEXP el; /* Temporary pointer used in the construction of the expression to call the R function. */
|
||||
|
||||
struct RCallbackFunctionData *previous; /* Stack */
|
||||
|
||||
} RCallbackFunctionData;
|
||||
|
||||
static RCallbackFunctionData *callbackFunctionDataStack;
|
||||
|
||||
|
||||
SWIGRUNTIME SEXP
|
||||
R_SWIG_debug_getCallbackFunctionData()
|
||||
{
|
||||
int n, i;
|
||||
SEXP ans;
|
||||
RCallbackFunctionData *p = callbackFunctionDataStack;
|
||||
|
||||
n = 0;
|
||||
while(p) {
|
||||
n++;
|
||||
p = p->previous;
|
||||
}
|
||||
|
||||
PROTECT(ans = Rf_allocVector(VECSXP, n));
|
||||
for(p = callbackFunctionDataStack, i = 0; i < n; p = p->previous, i++)
|
||||
SET_VECTOR_ELT(ans, i, p->fun);
|
||||
|
||||
UNPROTECT(1);
|
||||
|
||||
return(ans);
|
||||
}
|
||||
|
||||
|
||||
|
||||
SWIGRUNTIME RCallbackFunctionData *
|
||||
R_SWIG_pushCallbackFunctionData(SEXP fun, SEXP userData)
|
||||
{
|
||||
RCallbackFunctionData *el;
|
||||
el = (RCallbackFunctionData *) calloc(1, sizeof(RCallbackFunctionData));
|
||||
el->fun = fun;
|
||||
el->userData = userData;
|
||||
el->previous = callbackFunctionDataStack;
|
||||
|
||||
callbackFunctionDataStack = el;
|
||||
|
||||
return(el);
|
||||
}
|
||||
|
||||
|
||||
SWIGRUNTIME SEXP
|
||||
R_SWIG_R_pushCallbackFunctionData(SEXP fun, SEXP userData)
|
||||
{
|
||||
R_SWIG_pushCallbackFunctionData(fun, userData);
|
||||
return R_NilValue;
|
||||
}
|
||||
|
||||
SWIGRUNTIME RCallbackFunctionData *
|
||||
R_SWIG_getCallbackFunctionData()
|
||||
{
|
||||
if(!callbackFunctionDataStack) {
|
||||
PROBLEM "Supposedly impossible error occurred in the SWIG callback mechanism."
|
||||
" No callback function data set." /* split across two strings to make more readable. */
|
||||
ERROR;
|
||||
}
|
||||
|
||||
return callbackFunctionDataStack;
|
||||
}
|
||||
|
||||
SWIGRUNTIME void
|
||||
R_SWIG_popCallbackFunctionData(int doFree)
|
||||
{
|
||||
RCallbackFunctionData *el = NULL;
|
||||
if(!callbackFunctionDataStack)
|
||||
return ; /* Error !!! */
|
||||
|
||||
el = callbackFunctionDataStack ;
|
||||
callbackFunctionDataStack = callbackFunctionDataStack->previous;
|
||||
|
||||
if(doFree)
|
||||
free(el);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
Interface to S function
|
||||
is(obj, type)
|
||||
which is to be used to determine if an
|
||||
external pointer inherits from the right class.
|
||||
|
||||
Ideally, we would like to be able to do this without an explicit call to the is() function.
|
||||
When the S4 class system uses its own SEXP types, then we will hopefully be able to do this
|
||||
in the C code.
|
||||
|
||||
Should we make the expression static and preserve it to avoid the overhead of
|
||||
allocating each time.
|
||||
*/
|
||||
SWIGRUNTIME int
|
||||
R_SWIG_checkInherits(SEXP obj, SEXP tag, const char *type)
|
||||
{
|
||||
SEXP e, val;
|
||||
int check_err = 0;
|
||||
|
||||
PROTECT(e = Rf_allocVector(LANGSXP, 3));
|
||||
SETCAR(e, Rf_install("extends"));
|
||||
|
||||
SETCAR(CDR(e), mkString(CHAR(PRINTNAME(tag))));
|
||||
SETCAR(CDR(CDR(e)), mkString(type));
|
||||
|
||||
val = R_tryEval(e, R_GlobalEnv, &check_err);
|
||||
UNPROTECT(1);
|
||||
if(check_err)
|
||||
return(0);
|
||||
|
||||
|
||||
return(LOGICAL(val)[0]);
|
||||
}
|
||||
|
||||
|
||||
SWIGRUNTIME void *
|
||||
R_SWIG_resolveExternalRef(SEXP arg, const char * const type, const char * const argName, Rboolean nullOk)
|
||||
{
|
||||
void *ptr;
|
||||
SEXP orig = arg;
|
||||
|
||||
if(TYPEOF(arg) != EXTPTRSXP)
|
||||
arg = GET_SLOT(arg, mkString("ref"));
|
||||
|
||||
|
||||
if(TYPEOF(arg) != EXTPTRSXP) {
|
||||
PROBLEM "argument %s must be an external pointer (from an ExternalReference)", argName
|
||||
ERROR;
|
||||
}
|
||||
|
||||
|
||||
ptr = R_ExternalPtrAddr(arg);
|
||||
|
||||
if(ptr == NULL && nullOk == (Rboolean) FALSE) {
|
||||
PROBLEM "the external pointer (of type %s) for argument %s has value NULL",
|
||||
argName, type
|
||||
ERROR;
|
||||
}
|
||||
|
||||
if(type[0] && R_ExternalPtrTag(arg) != Rf_install(type) && strcmp(type, "voidRef")
|
||||
&& !R_SWIG_checkInherits(orig, R_ExternalPtrTag(arg), type)) {
|
||||
PROBLEM "the external pointer for argument %s has tag %s, not the expected value %s",
|
||||
argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type
|
||||
ERROR;
|
||||
}
|
||||
|
||||
|
||||
return(ptr);
|
||||
}
|
||||
|
||||
SWIGRUNTIME void
|
||||
R_SWIG_ReferenceFinalizer(SEXP el)
|
||||
{
|
||||
void *ptr = R_SWIG_resolveExternalRef(el, "", "<finalizer>", (Rboolean) 1);
|
||||
fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr);
|
||||
Rf_PrintValue(el);
|
||||
|
||||
if(ptr) {
|
||||
if(TYPEOF(el) != EXTPTRSXP)
|
||||
el = GET_SLOT(el, mkString("ref"));
|
||||
|
||||
if(TYPEOF(el) == EXTPTRSXP)
|
||||
R_ClearExternalPtr(el);
|
||||
|
||||
free(ptr);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
typedef enum {R_SWIG_EXTERNAL, R_SWIG_OWNER } R_SWIG_Owner;
|
||||
|
||||
SWIGRUNTIME SEXP
|
||||
SWIG_MakePtr(void *ptr, const char *typeName, R_SWIG_Owner owner)
|
||||
{
|
||||
SEXP external, r_obj;
|
||||
const char *p = typeName;
|
||||
|
||||
if(typeName[0] == '_')
|
||||
p = typeName + 1;
|
||||
|
||||
PROTECT(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue));
|
||||
PROTECT(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
|
||||
|
||||
if(owner)
|
||||
R_RegisterCFinalizer(external, R_SWIG_ReferenceFinalizer);
|
||||
|
||||
r_obj = SET_SLOT(r_obj, mkString((char *) "ref"), external);
|
||||
|
||||
UNPROTECT(2);
|
||||
|
||||
return(r_obj);
|
||||
}
|
||||
|
||||
|
||||
SWIGRUNTIME SEXP
|
||||
R_SWIG_create_SWIG_R_Array(const char *typeName, SEXP ref, int len)
|
||||
{
|
||||
SEXP arr;
|
||||
|
||||
/*XXX remove the char * cast when we can. MAKE_CLASS should be declared appropriately. */
|
||||
PROTECT(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
|
||||
PROTECT(arr = R_do_slot_assign(arr, mkString("ref"), ref));
|
||||
PROTECT(arr = R_do_slot_assign(arr, mkString("dims"), ScalarInteger(len)));
|
||||
|
||||
UNPROTECT(3);
|
||||
|
||||
return arr;
|
||||
}
|
||||
|
||||
#define ADD_OUTPUT_ARG(result, pos, value, name) r_ans = AddOutputArgToReturn(pos, value, name, OutputValues);
|
||||
|
||||
SWIGRUNTIME SEXP
|
||||
AddOutputArgToReturn(int pos, SEXP value, const char *name, SEXP output)
|
||||
{
|
||||
SET_VECTOR_ELT(output, pos, value);
|
||||
|
||||
return(output);
|
||||
}
|
||||
|
||||
/* Create a new pointer object */
|
||||
SWIGRUNTIMEINLINE SEXP
|
||||
SWIG_R_NewPointerObj(void *ptr, swig_type_info *type, int flags) {
|
||||
SEXP rptr = R_MakeExternalPtr(ptr,
|
||||
R_MakeExternalPtr(type, R_NilValue, R_NilValue), R_NilValue);
|
||||
// rptr = Rf_setAttrib(rptr, R_ClassSymbol, mkChar(SWIG_TypeName(type)));
|
||||
return rptr;
|
||||
}
|
||||
|
||||
/* Convert a pointer value */
|
||||
SWIGRUNTIMEINLINE int
|
||||
SWIG_R_ConvertPtr(SEXP obj, void **ptr, swig_type_info *ty, int flags) {
|
||||
if (!obj) return SWIG_ERROR;
|
||||
if (obj == R_NilValue) {
|
||||
if (ptr) *ptr = NULL;
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
void *vptr = R_ExternalPtrAddr(obj);
|
||||
if (ty) {
|
||||
swig_type_info *to = (swig_type_info*)
|
||||
R_ExternalPtrAddr(R_ExternalPtrTag(obj));
|
||||
if (to == ty) {
|
||||
if (ptr) *ptr = vptr;
|
||||
} else {
|
||||
swig_cast_info *tc = SWIG_TypeCheck(to->name,ty);
|
||||
if (ptr) *ptr = SWIG_TypeCast(tc,vptr);
|
||||
}
|
||||
} else {
|
||||
if (ptr) *ptr = vptr;
|
||||
}
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
SWIGRUNTIME swig_module_info *
|
||||
SWIG_GetModule(void *v) {
|
||||
static void *type_pointer = (void *)0;
|
||||
return (swig_module_info *) type_pointer;
|
||||
}
|
||||
|
||||
SWIGRUNTIME void
|
||||
SWIG_SetModule(void *v, swig_module_info *swig_module) {
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
void *pack;
|
||||
swig_type_info *ty;
|
||||
size_t size;
|
||||
} RSwigPacked;
|
||||
|
||||
/* Create a new packed object */
|
||||
|
||||
SWIGRUNTIMEINLINE SEXP RSwigPacked_New(void *ptr, size_t sz,
|
||||
swig_type_info *ty) {
|
||||
SEXP rptr;
|
||||
RSwigPacked *sobj =
|
||||
(RSwigPacked*) malloc(sizeof(RSwigPacked));
|
||||
if (sobj) {
|
||||
void *pack = malloc(sz);
|
||||
if (pack) {
|
||||
memcpy(pack, ptr, sz);
|
||||
sobj->pack = pack;
|
||||
sobj->ty = ty;
|
||||
sobj->size = sz;
|
||||
} else {
|
||||
sobj = 0;
|
||||
}
|
||||
}
|
||||
rptr = R_MakeExternalPtr(sobj, R_NilValue, R_NilValue);
|
||||
return rptr;
|
||||
}
|
||||
|
||||
SWIGRUNTIME swig_type_info *
|
||||
RSwigPacked_UnpackData(SEXP obj, void *ptr, size_t size)
|
||||
{
|
||||
RSwigPacked *sobj =
|
||||
(RSwigPacked *)R_ExternalPtrAddr(obj);
|
||||
if (sobj->size != size) return 0;
|
||||
memcpy(ptr, sobj->pack, size);
|
||||
return sobj->ty;
|
||||
}
|
||||
|
||||
SWIGRUNTIMEINLINE SEXP
|
||||
SWIG_R_NewPackedObj(void *ptr, size_t sz, swig_type_info *type) {
|
||||
return ptr ? RSwigPacked_New((void *) ptr, sz, type) : R_NilValue;
|
||||
}
|
||||
|
||||
/* Convert a packed value value */
|
||||
|
||||
SWIGRUNTIME int
|
||||
SWIG_R_ConvertPacked(SEXP obj, void *ptr, size_t sz, swig_type_info *ty) {
|
||||
swig_type_info *to = RSwigPacked_UnpackData(obj, ptr, sz);
|
||||
if (!to) return SWIG_ERROR;
|
||||
if (ty) {
|
||||
if (to != ty) {
|
||||
/* check type cast? */
|
||||
swig_cast_info *tc = SWIG_TypeCheck(to->name,ty);
|
||||
if (!tc) return SWIG_ERROR;
|
||||
}
|
||||
}
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
216
Lib/r/rstdcommon.swg
Normal file
216
Lib/r/rstdcommon.swg
Normal file
|
|
@ -0,0 +1,216 @@
|
|||
%fragment("StdTraits","header",fragment="StdTraitsCommon")
|
||||
{
|
||||
namespace swig {
|
||||
/*
|
||||
Traits that provides the from method
|
||||
*/
|
||||
|
||||
template <class Type> struct traits_from_ptr {
|
||||
static SWIG_Object from(Type *val, int owner = 0) {
|
||||
return SWIG_NewPointerObj(val, type_info<Type>(), owner);
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type> struct traits_from {
|
||||
static SWIG_Object from(const Type& val) {
|
||||
return traits_from_ptr<Type>::from(new Type(val), 1);
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type> struct traits_from<Type *> {
|
||||
static SWIG_Object from(Type* val) {
|
||||
return traits_from_ptr<Type>::from(val, 0);
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
inline SWIG_Object from(const Type& val) {
|
||||
return traits_from<Type>::from(val);
|
||||
}
|
||||
|
||||
template <class Type>
|
||||
inline SWIG_Object from_ptr(Type* val, int owner) {
|
||||
return traits_from_ptr<Type>::from(val, owner);
|
||||
}
|
||||
|
||||
/*
|
||||
Traits that provides the asval/as/check method
|
||||
*/
|
||||
template <class Type>
|
||||
struct traits_asptr {
|
||||
static int asptr(SWIG_Object obj, Type **val) {
|
||||
Type *p;
|
||||
int res = (SWIG_ConvertPtr(obj, (void**)&p, type_info<Type>(), 0) == SWIG_OK) ? SWIG_OLDOBJ : 0;
|
||||
if (SWIG_IsOK(res)) {
|
||||
if (val) *val = p;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
inline int asptr(SWIG_Object obj, Type **vptr) {
|
||||
return traits_asptr<Type>::asptr(obj, vptr);
|
||||
}
|
||||
|
||||
template <class Type>
|
||||
struct traits_asval {
|
||||
static int asval(SWIG_Object obj, Type *val) {
|
||||
if (val) {
|
||||
Type *p = 0;
|
||||
int res = traits_asptr<Type>::asptr(obj, &p);
|
||||
if (!SWIG_IsOK(res)) return res;
|
||||
if (p) {
|
||||
typedef typename noconst_traits<Type>::noconst_type noconst_type;
|
||||
*(const_cast<noconst_type*>(val)) = *p;
|
||||
if (SWIG_IsNewObj(res)){
|
||||
%delete(p);
|
||||
res = SWIG_DelNewMask(res);
|
||||
}
|
||||
return res;
|
||||
} else {
|
||||
return SWIG_ERROR;
|
||||
}
|
||||
} else {
|
||||
return traits_asptr<Type>::asptr(obj, (Type **)(0));
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type> struct traits_asval<Type*> {
|
||||
static int asval(SWIG_Object obj, Type **val) {
|
||||
if (val) {
|
||||
typedef typename noconst_traits<Type>::noconst_type noconst_type;
|
||||
noconst_type *p = 0;
|
||||
int res = traits_asptr<noconst_type>::asptr(obj, &p);
|
||||
if (SWIG_IsOK(res)) {
|
||||
*(const_cast<noconst_type**>(val)) = p;
|
||||
}
|
||||
return res;
|
||||
} else {
|
||||
return traits_asptr<Type>::asptr(obj, (Type **)(0));
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
inline int asval(SWIG_Object obj, Type *val) {
|
||||
return traits_asval<Type>::asval(obj, val);
|
||||
}
|
||||
|
||||
template <class Type>
|
||||
struct traits_as<Type, value_category> {
|
||||
static Type as(SWIG_Object obj, bool throw_error) {
|
||||
Type v;
|
||||
int res = asval(obj, &v);
|
||||
if (!obj || !SWIG_IsOK(res)) {
|
||||
// if (!PyErr_Occurred()) {
|
||||
// %type_error(swig::type_name<Type>());
|
||||
// }
|
||||
if (throw_error) throw std::invalid_argument("bad type");
|
||||
}
|
||||
return v;
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
struct traits_as<Type, pointer_category> {
|
||||
static Type as(SWIG_Object obj, bool throw_error) {
|
||||
Type *v = 0;
|
||||
int res = (obj ? traits_asptr<Type>::asptr(obj, &v) : SWIG_ERROR);
|
||||
if (SWIG_IsOK(res) && v) {
|
||||
if (SWIG_IsNewObj(res)) {
|
||||
Type r(*v);
|
||||
%delete(v);
|
||||
return r;
|
||||
} else {
|
||||
return *v;
|
||||
}
|
||||
} else {
|
||||
// Uninitialized return value, no Type() constructor required.
|
||||
static Type *v_def = (Type*) malloc(sizeof(Type));
|
||||
// if (!PyErr_Occurred()) {
|
||||
// %type_error(swig::type_name<Type>());
|
||||
// }
|
||||
if (throw_error) throw std::invalid_argument("bad type");
|
||||
memset(v_def,0,sizeof(Type));
|
||||
return *v_def;
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
struct traits_as<Type*, pointer_category> {
|
||||
static Type* as(SWIG_Object obj, bool throw_error) {
|
||||
Type *v = 0;
|
||||
int res = (obj ? traits_asptr<Type>::asptr(obj, &v) : SWIG_ERROR);
|
||||
if (SWIG_IsOK(res)) {
|
||||
return v;
|
||||
} else {
|
||||
// if (!PyErr_Occurred()) {
|
||||
// %type_error(swig::type_name<Type>());
|
||||
// }
|
||||
if (throw_error) throw std::invalid_argument("bad type");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
inline Type as(SWIG_Object obj, bool te = false) {
|
||||
return traits_as<Type, typename traits<Type>::category>::as(obj, te);
|
||||
}
|
||||
|
||||
template <class Type>
|
||||
struct traits_check<Type, value_category> {
|
||||
static bool check(SWIG_Object obj) {
|
||||
int res = obj ? asval(obj, (Type *)(0)) : SWIG_ERROR;
|
||||
return SWIG_IsOK(res) ? true : false;
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
struct traits_check<Type, pointer_category> {
|
||||
static bool check(SWIG_Object obj) {
|
||||
int res = obj ? asptr(obj, (Type **)(0)) : SWIG_ERROR;
|
||||
return SWIG_IsOK(res) ? true : false;
|
||||
}
|
||||
};
|
||||
|
||||
template <class Type>
|
||||
inline bool check(SWIG_Object obj) {
|
||||
return traits_check<Type, typename traits<Type>::category>::check(obj);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
%define %specialize_std_container(Type,Check,As,From)
|
||||
%{
|
||||
namespace swig {
|
||||
template <> struct traits_asval<Type > {
|
||||
typedef Type value_type;
|
||||
static int asval(SWIG_Object obj, value_type *val) {
|
||||
if (Check(obj)) {
|
||||
if (val) *val = As(obj);
|
||||
return SWIG_OK;
|
||||
}
|
||||
return SWIG_ERROR;
|
||||
}
|
||||
};
|
||||
template <> struct traits_from<Type > {
|
||||
typedef Type value_type;
|
||||
static SWIG_Object from(const value_type& val) {
|
||||
return From(val);
|
||||
}
|
||||
};
|
||||
|
||||
template <>
|
||||
struct traits_check<Type, value_category> {
|
||||
static int check(SWIG_Object obj) {
|
||||
int res = Check(obj);
|
||||
return obj && res ? res : 0;
|
||||
}
|
||||
};
|
||||
}
|
||||
%}
|
||||
%enddef
|
||||
200
Lib/r/rtype.swg
Normal file
200
Lib/r/rtype.swg
Normal file
|
|
@ -0,0 +1,200 @@
|
|||
|
||||
/* These map the primitive C types to the appropriate R type
|
||||
for use in class representations.
|
||||
*/
|
||||
|
||||
%typemap("rtype") int, int *, int & "numeric";
|
||||
%apply int {size_t}
|
||||
%apply int {std::size_t}
|
||||
%apply int {ptrdiff_t}
|
||||
%apply int {std::ptrdiff_t}
|
||||
|
||||
%typemap("rtype") long, long * "numeric";
|
||||
%typemap("rtype") unsigned long,
|
||||
unsigned long * "numeric";
|
||||
%typemap("rtype") unsigned int,
|
||||
unsigned int * "numeric";
|
||||
%typemap("rtype") double, double*, double & "numeric";
|
||||
%typemap("rtype") float, float *, float & "numeric";
|
||||
%typemap("rtype") char *, char ** "character";
|
||||
%typemap("rtype") char "character";
|
||||
%typemap("rtype") string, string *, string & "character";
|
||||
%typemap("rtype") std::string, std::string *, std::string & "character";
|
||||
%typemap("rtype") bool, bool * "logical";
|
||||
%typemap("rtype") enum SWIGTYPE "character";
|
||||
%typemap("rtype") enum SWIGTYPE * "character";
|
||||
%typemap("rtype") enum SWIGTYPE & "character";
|
||||
%typemap("rtype") SWIGTYPE * "$R_class";
|
||||
%typemap("rtype") SWIGTYPE & "$R_class";
|
||||
%typemap("rtype") SWIGTYPE "$&R_class";
|
||||
|
||||
|
||||
|
||||
/* Have to be careful that as(x, "numeric") is different from as.numeric(x).
|
||||
The latter makes a REALSXP, whereas the former leaves an INTSXP as an
|
||||
INTSXP.
|
||||
*/
|
||||
|
||||
|
||||
%typemap(scoercein) int, int *, int &
|
||||
%{ $input = as($input, "integer"); %}
|
||||
%typemap(scoercein) ptrdiff_t, ptrdiff_t *, ptrdiff_t &
|
||||
%{ $input = as($input, "integer"); %}
|
||||
%typemap(scoercein) unsigned long, unsigned long *, unsigned long &
|
||||
%{ $input = as($input, "integer"); %}
|
||||
%typemap(scoercein) unsigned int, unsigned int *, unsigned int &
|
||||
%{ $input = as($input, "integer"); %}
|
||||
%typemap(scoercein) double, double *, double &
|
||||
%{ $input = as($input, "numeric"); %}
|
||||
%typemap(scoercein) float, float *, float &
|
||||
%{ $input = as($input, "numeric"); %}
|
||||
%typemap(scoercein) char, char *, char &
|
||||
%{ $input = as($input, "character"); %}
|
||||
%typemap(scoercein) string, string *, string &
|
||||
%{ $input = as($input, "character"); %}
|
||||
%typemap(scoercein) std::string, std::string *, std::string &
|
||||
%{ $input = as($input, "character"); %}
|
||||
%typemap(scoercein) enum SWIGTYPE
|
||||
%{ $input = enumToInteger($input, "$R_class") %}
|
||||
%typemap(scoercein) enum SWIGTYPE &
|
||||
%{ $input = enumToInteger($input, "$R_class") %}
|
||||
%typemap(scoercein) enum SWIGTYPE *
|
||||
%{ $input = enumToInteger($input, "$R_class") %}
|
||||
|
||||
%typemap(scoercein) SWIGTYPE *
|
||||
%{ $input = coerceIfNotSubclass($input, "$R_class") %}
|
||||
|
||||
%typemap(scoercein) SWIGTYPE &
|
||||
%{ $input = coerceIfNotSubclass($input, "$R_class") %}
|
||||
|
||||
%typemap(scoercein) SWIGTYPE
|
||||
%{ $input = coerceIfNotSubclass($input, "$&R_class") %}
|
||||
|
||||
|
||||
%typemap(scoercein) SWIGTYPE[ANY]
|
||||
%{
|
||||
if(is.list($input))
|
||||
assert(all(sapply($input, class) == "$R_class"))
|
||||
%}
|
||||
|
||||
|
||||
/* **************************************************************** */
|
||||
|
||||
%typemap(scoercein) bool, bool *, bool &
|
||||
"$input = as.logical($input) ";
|
||||
|
||||
%typemap(scoercein) int,
|
||||
int *,
|
||||
int &,
|
||||
int[ANY],
|
||||
size_t,
|
||||
std::size_t,
|
||||
size_t &,
|
||||
std::size_t &
|
||||
"$input = as.integer($input) ";
|
||||
|
||||
|
||||
%typemap(scoercein) unsigned int,
|
||||
unsigned long,
|
||||
double,
|
||||
float,
|
||||
long,
|
||||
long long,
|
||||
unsigned int[],
|
||||
unsigned long[],
|
||||
double[],
|
||||
float[],
|
||||
long[],
|
||||
long long[],
|
||||
unsigned int[ANY],
|
||||
unsigned long[ANY],
|
||||
double[ANY],
|
||||
float[ANY],
|
||||
long[ANY],
|
||||
long long[ANY],
|
||||
unsigned int *,
|
||||
unsigned long *,
|
||||
double*,
|
||||
float*,
|
||||
long*,
|
||||
long long *
|
||||
%{ $input = as.numeric($input) %}
|
||||
|
||||
|
||||
%typemap(scoercein) char *, string, std::string,
|
||||
string &, std::string &
|
||||
%{ $input = as($input, "character") %}
|
||||
|
||||
%typemap(scoerceout) enum SWIGTYPE
|
||||
%{ $result = enumFromInteger($result, "$R_class") %}
|
||||
|
||||
%typemap(scoerceout) enum SWIGTYPE &
|
||||
%{ $result = enumFromInteger($result, "$R_class") %}
|
||||
|
||||
%typemap(scoerceout) enum SWIGTYPE *
|
||||
%{ $result = enumToInteger($result, "$R_class") %}
|
||||
|
||||
|
||||
%typemap(scoerceout) SWIGTYPE
|
||||
%{ class($result) <- "$&R_class" %}
|
||||
|
||||
%typemap(scoerceout) SWIGTYPE &
|
||||
%{ class($result) <- "$R_class" %}
|
||||
|
||||
%typemap(scoerceout) SWIGTYPE *
|
||||
%{ class($result) <- "$R_class" %}
|
||||
|
||||
/* Override the SWIGTYPE * above. */
|
||||
%typemap(scoerceout) char,
|
||||
char *,
|
||||
char &,
|
||||
unsigned int,
|
||||
unsigned int &,
|
||||
unsigned long,
|
||||
unsigned long &,
|
||||
double,
|
||||
double &,
|
||||
float,
|
||||
float &,
|
||||
long,
|
||||
long &,
|
||||
long long,
|
||||
long long &,
|
||||
int,
|
||||
int &,
|
||||
bool,
|
||||
bool &,
|
||||
string,
|
||||
std::string,
|
||||
string &,
|
||||
std::string &,
|
||||
size_t,
|
||||
std::size_t,
|
||||
size_t &,
|
||||
std::size_t &,
|
||||
void
|
||||
%{ %}
|
||||
|
||||
|
||||
#if 0
|
||||
Just examining the values for a SWIGTYPE.
|
||||
|
||||
%typemap(scoerceout) SWIGTYPE %{
|
||||
|
||||
name = $1_name
|
||||
type = $1_type
|
||||
ltype = $1_ltype
|
||||
|
||||
mangle = $1_mangle
|
||||
descriptor = $1_descriptor
|
||||
|
||||
pointer type = $*1_type
|
||||
pointer ltype = $*1_ltype
|
||||
|
||||
pointer descriptor = $*1_descriptor
|
||||
basetype = $*_basetype
|
||||
|
||||
%}
|
||||
#endif
|
||||
|
||||
|
||||
150
Lib/r/srun.swg
Normal file
150
Lib/r/srun.swg
Normal file
|
|
@ -0,0 +1,150 @@
|
|||
# srun.swg #
|
||||
#
|
||||
# This is the basic code that is needed at run time within R to
|
||||
# provide and define the relevant classes. It is included
|
||||
# automatically in the generated code by copying the contents of
|
||||
# srun.swg into the newly created binding code.
|
||||
|
||||
|
||||
# This could be provided as a separate run-time library but this
|
||||
# approach allows the code to to be included directly into the
|
||||
# generated bindings and so removes the need to have and install an
|
||||
# additional library. We may however end up with multiple copies of
|
||||
# this and some confusion at run-time as to which class to use. This
|
||||
# is an issue when we use NAMESPACES as we may need to export certain
|
||||
# classes.
|
||||
|
||||
######################################################################
|
||||
|
||||
if(length(getClassDef("RSWIGStruct")) == 0)
|
||||
setClass("RSWIGStruct", representation("VIRTUAL"))
|
||||
|
||||
|
||||
|
||||
if(length(getClassDef("ExternalReference")) == 0)
|
||||
# Should be virtual but this means it loses its slots currently
|
||||
#representation("VIRTUAL")
|
||||
setClass("ExternalReference", representation( ref = "externalptr"))
|
||||
|
||||
|
||||
|
||||
if(length(getClassDef("NativeRoutinePointer")) == 0)
|
||||
setClass("NativeRoutinePointer",
|
||||
representation(parameterTypes = "character",
|
||||
returnType = "character",
|
||||
"VIRTUAL"),
|
||||
contains = "ExternalReference")
|
||||
|
||||
if(length(getClassDef("CRoutinePointer")) == 0)
|
||||
setClass("CRoutinePointer", contains = "NativeRoutinePointer")
|
||||
|
||||
|
||||
if(length(getClassDef("EnumerationValue")) == 0)
|
||||
setClass("EnumerationValue", contains = "integer")
|
||||
|
||||
|
||||
if(!isGeneric("copyToR"))
|
||||
setGeneric("copyToR",
|
||||
function(value, obj = new(gsub("Ref$", "", class(value))))
|
||||
standardGeneric("copyToR"
|
||||
))
|
||||
|
||||
setGeneric("delete", function(obj) standardGeneric("delete"))
|
||||
|
||||
|
||||
SWIG_createNewRef =
|
||||
function(className, ..., append = TRUE)
|
||||
{
|
||||
f = get(paste("new", className, sep = "_"), mode = "function")
|
||||
|
||||
f(...)
|
||||
}
|
||||
|
||||
if(!isGeneric("copyToC"))
|
||||
setGeneric("copyToC",
|
||||
function(value, obj = RSWIG_createNewRef(class(value)))
|
||||
standardGeneric("copyToC"
|
||||
))
|
||||
|
||||
|
||||
#
|
||||
defineEnumeration =
|
||||
function(name, .values, where = topenv(parent.frame()), suffix = "Value")
|
||||
{
|
||||
# Mirror the class definitions via the E analogous to .__C__
|
||||
defName = paste(".__E__", name, sep = "")
|
||||
assign(defName, .values, envir = where)
|
||||
|
||||
if(nchar(suffix))
|
||||
name = paste(name, suffix, sep = "")
|
||||
|
||||
setClass(name, contains = "EnumerationValue", where = where)
|
||||
}
|
||||
|
||||
enumToInteger <- function(name,type)
|
||||
{
|
||||
if (is.character(name)) {
|
||||
ans <- as.integer(get(paste(".__E__", type, sep = ""))[name])
|
||||
if (is.na(ans)) {warning("enum not found ", name, " ", type)}
|
||||
ans
|
||||
}
|
||||
}
|
||||
|
||||
enumFromInteger =
|
||||
function(i,type)
|
||||
{
|
||||
itemlist <- get(paste(".__E__", type, sep=""))
|
||||
names(itemlist)[match(i, itemlist)]
|
||||
}
|
||||
|
||||
coerceIfNotSubclass =
|
||||
function(obj, type)
|
||||
{
|
||||
if(!is(obj, type)) {as(obj, type)} else obj
|
||||
}
|
||||
|
||||
|
||||
setClass("SWIGArray", representation(dims = "integer"), contains = "ExternalReference")
|
||||
|
||||
setMethod("length", "SWIGArray", function(x) x@dims[1])
|
||||
|
||||
|
||||
defineEnumeration("SCopyReferences",
|
||||
.values = c( "FALSE" = 0, "TRUE" = 1, "DEEP" = 2))
|
||||
|
||||
assert =
|
||||
function(condition, message = "")
|
||||
{
|
||||
if(!condition)
|
||||
stop(message)
|
||||
|
||||
TRUE
|
||||
}
|
||||
|
||||
|
||||
if(FALSE) {
|
||||
print.SWIGFunction =
|
||||
function(x, ...)
|
||||
{
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#######################################################################
|
||||
|
||||
R_SWIG_getCallbackFunctionStack =
|
||||
function()
|
||||
{
|
||||
# No PACKAGE argument as we don't know what the DLL is.
|
||||
.Call("R_SWIG_debug_getCallbackFunctionData")
|
||||
}
|
||||
|
||||
R_SWIG_addCallbackFunctionStack =
|
||||
function(fun, userData = NULL)
|
||||
{
|
||||
# No PACKAGE argument as we don't know what the DLL is.
|
||||
.Call("R_SWIG_R_pushCallbackFunctionData", fun, userData)
|
||||
}
|
||||
|
||||
|
||||
#######################################################################
|
||||
1
Lib/r/std_alloc.i
Normal file
1
Lib/r/std_alloc.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include <std/std_alloc.i>
|
||||
2
Lib/r/std_common.i
Normal file
2
Lib/r/std_common.i
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
%include <rstdcommon.swg>
|
||||
%include <std/std_common.i>
|
||||
2
Lib/r/std_container.i
Normal file
2
Lib/r/std_container.i
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
%include <rcontainer.swg>
|
||||
%include <std/std_container.i>
|
||||
1
Lib/r/std_deque.i
Normal file
1
Lib/r/std_deque.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include<std/std_deque.i>
|
||||
1
Lib/r/std_except.i
Normal file
1
Lib/r/std_except.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include <typemaps/std_except.swg>
|
||||
1
Lib/r/std_pair.i
Normal file
1
Lib/r/std_pair.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include<std/std_pair.i>
|
||||
1
Lib/r/std_string.i
Normal file
1
Lib/r/std_string.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include <typemaps/std_string.swg>
|
||||
10
Lib/r/std_vector.i
Normal file
10
Lib/r/std_vector.i
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
%fragment("StdVectorTraits","header")
|
||||
%{
|
||||
%}
|
||||
|
||||
#define %swig_vector_methods(Type...) %swig_sequence_methods(Type)
|
||||
#define %swig_vector_methods_val(Type...) %swig_sequence_methods_val(Type);
|
||||
|
||||
|
||||
|
||||
%include <std/std_vector.i>
|
||||
8
Lib/r/stl.i
Normal file
8
Lib/r/stl.i
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
/* initial STL definition. extended as needed in each language */
|
||||
%include std_common.i
|
||||
%include std_vector.i
|
||||
%include std_string.i
|
||||
|
||||
|
||||
|
||||
|
||||
1
Lib/r/typemaps.i
Normal file
1
Lib/r/typemaps.i
Normal file
|
|
@ -0,0 +1 @@
|
|||
%include <typemaps/typemaps.swg>
|
||||
19
Makefile.in
19
Makefile.in
|
|
@ -51,6 +51,7 @@ skip-allegrocl = test -n "@SKIP_ALLEGROCL@"
|
|||
skip-clisp = test -n "@SKIP_CLISP@"
|
||||
skip-cffi = test -n "@SKIP_CFFI@"
|
||||
skip-uffi = test -n "@SKIP_UFFI@"
|
||||
skip-r = test -n "@SKIP_R@"
|
||||
|
||||
# Additional dependencies for some tests
|
||||
skip-gcj = test -n "@SKIP_GCJ@"
|
||||
|
|
@ -85,6 +86,7 @@ check-aliveness:
|
|||
@$(skip-csharp) || ./$(TARGET) -csharp -help
|
||||
@$(skip-modula3) || ./$(TARGET) -modula3 -help
|
||||
@$(skip-lua) || ./$(TARGET) -lua -help
|
||||
@$(skip-r) || ./$(TARGET) -lua -help
|
||||
|
||||
# Checks examples for compilation (does not run them)
|
||||
check-examples: \
|
||||
|
|
@ -105,7 +107,8 @@ check-examples: \
|
|||
check-allegrocl-examples \
|
||||
check-clisp-examples \
|
||||
check-uffi-examples \
|
||||
check-cffi-examples
|
||||
check-cffi-examples \
|
||||
check-r-examples
|
||||
|
||||
check-%-examples:
|
||||
@passed=true; \
|
||||
|
|
@ -186,7 +189,8 @@ check-test-suite: \
|
|||
check-clisp-test-suite \
|
||||
check-uffi-test-suite \
|
||||
check-cffi-test-suite \
|
||||
check-chicken-test-suite
|
||||
check-chicken-test-suite \
|
||||
check-r-test-suite
|
||||
|
||||
check-%-test-suite:
|
||||
@passed=true; \
|
||||
|
|
@ -224,7 +228,8 @@ all-test-suite: \
|
|||
all-clisp-test-suite \
|
||||
all-uffi-test-suite \
|
||||
all-cffi-test-suite \
|
||||
all-chicken-test-suite
|
||||
all-chicken-test-suite \
|
||||
all-r-test-suite
|
||||
|
||||
all-%-test-suite:
|
||||
@$(MAKE) -k -s check-$*-test-suite ACTION=all
|
||||
|
|
@ -249,7 +254,8 @@ broken-test-suite: \
|
|||
broken-clisp-test-suite \
|
||||
broken-uffi-test-suite \
|
||||
broken-cffi-test-suite \
|
||||
broken-chicken-test-suite
|
||||
broken-chicken-test-suite \
|
||||
broken-r-test-suite
|
||||
|
||||
broken-%-test-suite:
|
||||
@$(MAKE) -k -s check-$*-test-suite ACTION=broken
|
||||
|
|
@ -329,7 +335,8 @@ noskip-test-suite: \
|
|||
noskip-clisp-test-suite \
|
||||
noskip-uffi-test-suite \
|
||||
noskip-cffi-test-suite \
|
||||
noskip-chicken-test-suite
|
||||
noskip-chicken-test-suite \
|
||||
noskip-r-test-suite
|
||||
|
||||
noskip-%-test-suite:
|
||||
dir="Examples/test-suite/$*"; \
|
||||
|
|
@ -375,7 +382,7 @@ install-main:
|
|||
@$(INSTALL_PROGRAM) $(TARGET) $(DESTDIR)$(BIN_DIR)/`echo $(TARGET_NOEXE) | sed '$(transform)'`@EXEEXT@
|
||||
|
||||
lib-languages = gcj typemaps tcl perl5 python guile java mzscheme ruby php4 ocaml \
|
||||
pike chicken csharp modula3 allegrocl clisp lua cffi uffi
|
||||
pike chicken csharp modula3 allegrocl clisp lua cffi uffi r
|
||||
|
||||
lib-modules = std
|
||||
|
||||
|
|
|
|||
|
|
@ -59,6 +59,7 @@ eswig_SOURCES = CParse/cscanner.c \
|
|||
Modules/php4.cxx \
|
||||
Modules/pike.cxx \
|
||||
Modules/python.cxx \
|
||||
Modules/r.cxx \
|
||||
Modules/ruby.cxx \
|
||||
Modules/s-exp.cxx \
|
||||
Modules/swigmain.cxx \
|
||||
|
|
|
|||
3035
Source/Modules/r.cxx
Normal file
3035
Source/Modules/r.cxx
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -45,6 +45,7 @@ extern "C" {
|
|||
Language *swig_clisp(void);
|
||||
Language *swig_cffi(void);
|
||||
Language *swig_uffi(void);
|
||||
Language *swig_r(void);
|
||||
}
|
||||
|
||||
struct swig_module {
|
||||
|
|
@ -82,6 +83,7 @@ static swig_module modules[] = {
|
|||
{"-tcl8", swig_tcl, 0},
|
||||
{"-uffi", swig_uffi, "Common Lisp / UFFI"},
|
||||
{"-xml", swig_xml, "XML"},
|
||||
{"-r", swig_r, "R (aka GNU S)"},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -1923,6 +1923,7 @@ AC_CONFIG_FILES([ \
|
|||
Examples/test-suite/clisp/Makefile \
|
||||
Examples/test-suite/cffi/Makefile \
|
||||
Examples/test-suite/uffi/Makefile \
|
||||
Examples/test-suite/r/Makefile
|
||||
])
|
||||
AC_CONFIG_FILES([preinst-swig], [chmod +x preinst-swig])
|
||||
AC_OUTPUT
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue