Committing R-SWIG
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@9175 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Joseph Wang
parent
bf06e16ce4
commit
3a821460fe
51 changed files with 5154 additions and 9 deletions
91
SWIG/Doc/Manual/R.html
Normal file
91
SWIG/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
|
Python.html
|
||||||
Ruby.html
|
Ruby.html
|
||||||
Tcl.html
|
Tcl.html
|
||||||
|
R.html
|
||||||
Extending.html
|
Extending.html
|
||||||
|
|
|
||||||
|
|
@ -1017,3 +1017,26 @@ uffi_clean:
|
||||||
rm -f core @EXTRA_CLEAN@
|
rm -f core @EXTRA_CLEAN@
|
||||||
rm -f *.@OBJEXT@ *@SO@
|
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
SWIG/Examples/r/class/Makefile
Normal file
18
SWIG/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
SWIG/Examples/r/class/example.cxx
Normal file
28
SWIG/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
SWIG/Examples/r/class/example.h
Normal file
39
SWIG/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
SWIG/Examples/r/class/example.i
Normal file
9
SWIG/Examples/r/class/example.i
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
/* File : example.i */
|
||||||
|
%module example
|
||||||
|
|
||||||
|
%inline %{
|
||||||
|
#include "example.h"
|
||||||
|
%}
|
||||||
|
%include "example.h"
|
||||||
|
|
||||||
|
|
||||||
49
SWIG/Examples/r/class/runme.R
Normal file
49
SWIG/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
SWIG/Examples/r/simple/Makefile
Normal file
16
SWIG/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
SWIG/Examples/r/simple/example.c
Normal file
18
SWIG/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
SWIG/Examples/r/simple/example.i
Normal file
7
SWIG/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
SWIG/Examples/r/simple/runme.R
Normal file
24
SWIG/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 =
|
CSRCS =
|
||||||
TARGETPREFIX =
|
TARGETPREFIX =
|
||||||
TARGETSUFFIX =
|
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)
|
INCLUDES = -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/$(LANGUAGE) -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)
|
||||||
LIBS = -L.
|
LIBS = -L.
|
||||||
LIBPREFIX = lib
|
LIBPREFIX = lib
|
||||||
|
|
|
||||||
|
|
@ -77,7 +77,7 @@ public:
|
||||||
SWIG_STD_VECTOR_SPECIALIZE_MINIMUM(Flow, Space::Flow)
|
SWIG_STD_VECTOR_SPECIALIZE_MINIMUM(Flow, Space::Flow)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)
|
#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGPYTHON)||defined(SWIGR)
|
||||||
#define SWIG_GOOD_VECTOR
|
#define SWIG_GOOD_VECTOR
|
||||||
%ignore std::vector<Space::Flow>::vector(size_type);
|
%ignore std::vector<Space::Flow>::vector(size_type);
|
||||||
%ignore std::vector<Space::Flow>::resize(size_type);
|
%ignore std::vector<Space::Flow>::resize(size_type);
|
||||||
|
|
|
||||||
|
|
@ -19,7 +19,11 @@
|
||||||
|
|
||||||
int x;
|
int x;
|
||||||
int *xp;
|
int *xp;
|
||||||
|
#ifdef SWIGR
|
||||||
|
int& c_member = x;
|
||||||
|
#else
|
||||||
int& c = x;
|
int& c = x;
|
||||||
|
#endif
|
||||||
|
|
||||||
void *vp;
|
void *vp;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -61,7 +61,10 @@ namespace std
|
||||||
|
|
||||||
%inline {
|
%inline {
|
||||||
/* silently rename the parameter names in csharp/java */
|
/* 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; }
|
double foo(double in, double out) { return 1.0; }
|
||||||
|
#endif
|
||||||
double bar(double native, bool boolean) { return 1.0; }
|
double bar(double native, bool boolean) { return 1.0; }
|
||||||
}
|
}
|
||||||
|
|
|
||||||
54
SWIG/Examples/test-suite/r/Makefile.in
Normal file
54
SWIG/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
SWIG/Examples/test-suite/r/copyStruct_runme.R
Normal file
55
SWIG/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
SWIG/Examples/test-suite/r/double_delete.i
Normal file
15
SWIG/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
SWIG/Examples/test-suite/r/double_delete_runme.R
Normal file
12
SWIG/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
SWIG/Examples/test-suite/r/funcptr_runme.R
Normal file
7
SWIG/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
SWIG/Examples/test-suite/r/ignore_parameter_runme.R
Normal file
10
SWIG/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
SWIG/Examples/test-suite/r/legacy_runme.R
Normal file
30
SWIG/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
SWIG/Examples/test-suite/r/simpleArray_runme.R
Normal file
9
SWIG/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
SWIG/Examples/test-suite/r/unions_runme.R
Normal file
12
SWIG/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
SWIG/Examples/test-suite/r/unittest.R
Normal file
9
SWIG/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
SWIG/Lib/r/cdata.i
Normal file
1
SWIG/Lib/r/cdata.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include <typemaps/cdata.swg>
|
||||||
8
SWIG/Lib/r/exception.i
Normal file
8
SWIG/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
SWIG/Lib/r/r.swg
Normal file
189
SWIG/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
SWIG/Lib/r/rcontainer.swg
Normal file
198
SWIG/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
SWIG/Lib/r/rfragments.swg
Normal file
167
SWIG/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
SWIG/Lib/r/ropers.swg
Normal file
44
SWIG/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
SWIG/Lib/r/rrun.swg
Normal file
355
SWIG/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
SWIG/Lib/r/rstdcommon.swg
Normal file
216
SWIG/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
SWIG/Lib/r/rtype.swg
Normal file
200
SWIG/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
SWIG/Lib/r/srun.swg
Normal file
150
SWIG/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
SWIG/Lib/r/std_alloc.i
Normal file
1
SWIG/Lib/r/std_alloc.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include <std/std_alloc.i>
|
||||||
2
SWIG/Lib/r/std_common.i
Normal file
2
SWIG/Lib/r/std_common.i
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
%include <rstdcommon.swg>
|
||||||
|
%include <std/std_common.i>
|
||||||
2
SWIG/Lib/r/std_container.i
Normal file
2
SWIG/Lib/r/std_container.i
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
%include <rcontainer.swg>
|
||||||
|
%include <std/std_container.i>
|
||||||
1
SWIG/Lib/r/std_deque.i
Normal file
1
SWIG/Lib/r/std_deque.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include<std/std_deque.i>
|
||||||
1
SWIG/Lib/r/std_except.i
Normal file
1
SWIG/Lib/r/std_except.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include <typemaps/std_except.swg>
|
||||||
1
SWIG/Lib/r/std_pair.i
Normal file
1
SWIG/Lib/r/std_pair.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include<std/std_pair.i>
|
||||||
1
SWIG/Lib/r/std_string.i
Normal file
1
SWIG/Lib/r/std_string.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include <typemaps/std_string.swg>
|
||||||
10
SWIG/Lib/r/std_vector.i
Normal file
10
SWIG/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
SWIG/Lib/r/stl.i
Normal file
8
SWIG/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
SWIG/Lib/r/typemaps.i
Normal file
1
SWIG/Lib/r/typemaps.i
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
%include <typemaps/typemaps.swg>
|
||||||
|
|
@ -51,6 +51,7 @@ skip-allegrocl = test -n "@SKIP_ALLEGROCL@"
|
||||||
skip-clisp = test -n "@SKIP_CLISP@"
|
skip-clisp = test -n "@SKIP_CLISP@"
|
||||||
skip-cffi = test -n "@SKIP_CFFI@"
|
skip-cffi = test -n "@SKIP_CFFI@"
|
||||||
skip-uffi = test -n "@SKIP_UFFI@"
|
skip-uffi = test -n "@SKIP_UFFI@"
|
||||||
|
skip-r = test -n "@SKIP_R@"
|
||||||
|
|
||||||
# Additional dependencies for some tests
|
# Additional dependencies for some tests
|
||||||
skip-gcj = test -n "@SKIP_GCJ@"
|
skip-gcj = test -n "@SKIP_GCJ@"
|
||||||
|
|
@ -85,6 +86,7 @@ check-aliveness:
|
||||||
@$(skip-csharp) || ./$(TARGET) -csharp -help
|
@$(skip-csharp) || ./$(TARGET) -csharp -help
|
||||||
@$(skip-modula3) || ./$(TARGET) -modula3 -help
|
@$(skip-modula3) || ./$(TARGET) -modula3 -help
|
||||||
@$(skip-lua) || ./$(TARGET) -lua -help
|
@$(skip-lua) || ./$(TARGET) -lua -help
|
||||||
|
@$(skip-r) || ./$(TARGET) -lua -help
|
||||||
|
|
||||||
# Checks examples for compilation (does not run them)
|
# Checks examples for compilation (does not run them)
|
||||||
check-examples: \
|
check-examples: \
|
||||||
|
|
@ -105,7 +107,8 @@ check-examples: \
|
||||||
check-allegrocl-examples \
|
check-allegrocl-examples \
|
||||||
check-clisp-examples \
|
check-clisp-examples \
|
||||||
check-uffi-examples \
|
check-uffi-examples \
|
||||||
check-cffi-examples
|
check-cffi-examples \
|
||||||
|
check-r-examples
|
||||||
|
|
||||||
check-%-examples:
|
check-%-examples:
|
||||||
@passed=true; \
|
@passed=true; \
|
||||||
|
|
@ -186,7 +189,8 @@ check-test-suite: \
|
||||||
check-clisp-test-suite \
|
check-clisp-test-suite \
|
||||||
check-uffi-test-suite \
|
check-uffi-test-suite \
|
||||||
check-cffi-test-suite \
|
check-cffi-test-suite \
|
||||||
check-chicken-test-suite
|
check-chicken-test-suite \
|
||||||
|
check-r-test-suite
|
||||||
|
|
||||||
check-%-test-suite:
|
check-%-test-suite:
|
||||||
@passed=true; \
|
@passed=true; \
|
||||||
|
|
@ -224,7 +228,8 @@ all-test-suite: \
|
||||||
all-clisp-test-suite \
|
all-clisp-test-suite \
|
||||||
all-uffi-test-suite \
|
all-uffi-test-suite \
|
||||||
all-cffi-test-suite \
|
all-cffi-test-suite \
|
||||||
all-chicken-test-suite
|
all-chicken-test-suite \
|
||||||
|
all-r-test-suite
|
||||||
|
|
||||||
all-%-test-suite:
|
all-%-test-suite:
|
||||||
@$(MAKE) -k -s check-$*-test-suite ACTION=all
|
@$(MAKE) -k -s check-$*-test-suite ACTION=all
|
||||||
|
|
@ -249,7 +254,8 @@ broken-test-suite: \
|
||||||
broken-clisp-test-suite \
|
broken-clisp-test-suite \
|
||||||
broken-uffi-test-suite \
|
broken-uffi-test-suite \
|
||||||
broken-cffi-test-suite \
|
broken-cffi-test-suite \
|
||||||
broken-chicken-test-suite
|
broken-chicken-test-suite \
|
||||||
|
broken-r-test-suite
|
||||||
|
|
||||||
broken-%-test-suite:
|
broken-%-test-suite:
|
||||||
@$(MAKE) -k -s check-$*-test-suite ACTION=broken
|
@$(MAKE) -k -s check-$*-test-suite ACTION=broken
|
||||||
|
|
@ -329,7 +335,8 @@ noskip-test-suite: \
|
||||||
noskip-clisp-test-suite \
|
noskip-clisp-test-suite \
|
||||||
noskip-uffi-test-suite \
|
noskip-uffi-test-suite \
|
||||||
noskip-cffi-test-suite \
|
noskip-cffi-test-suite \
|
||||||
noskip-chicken-test-suite
|
noskip-chicken-test-suite \
|
||||||
|
noskip-r-test-suite
|
||||||
|
|
||||||
noskip-%-test-suite:
|
noskip-%-test-suite:
|
||||||
dir="Examples/test-suite/$*"; \
|
dir="Examples/test-suite/$*"; \
|
||||||
|
|
@ -375,7 +382,7 @@ install-main:
|
||||||
@$(INSTALL_PROGRAM) $(TARGET) $(DESTDIR)$(BIN_DIR)/`echo $(TARGET_NOEXE) | sed '$(transform)'`@EXEEXT@
|
@$(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 \
|
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
|
lib-modules = std
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -59,6 +59,7 @@ eswig_SOURCES = CParse/cscanner.c \
|
||||||
Modules/php4.cxx \
|
Modules/php4.cxx \
|
||||||
Modules/pike.cxx \
|
Modules/pike.cxx \
|
||||||
Modules/python.cxx \
|
Modules/python.cxx \
|
||||||
|
Modules/r.cxx \
|
||||||
Modules/ruby.cxx \
|
Modules/ruby.cxx \
|
||||||
Modules/s-exp.cxx \
|
Modules/s-exp.cxx \
|
||||||
Modules/swigmain.cxx \
|
Modules/swigmain.cxx \
|
||||||
|
|
|
||||||
3035
SWIG/Source/Modules/r.cxx
Normal file
3035
SWIG/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_clisp(void);
|
||||||
Language *swig_cffi(void);
|
Language *swig_cffi(void);
|
||||||
Language *swig_uffi(void);
|
Language *swig_uffi(void);
|
||||||
|
Language *swig_r(void);
|
||||||
}
|
}
|
||||||
|
|
||||||
struct swig_module {
|
struct swig_module {
|
||||||
|
|
@ -82,6 +83,7 @@ static swig_module modules[] = {
|
||||||
{"-tcl8", swig_tcl, 0},
|
{"-tcl8", swig_tcl, 0},
|
||||||
{"-uffi", swig_uffi, "Common Lisp / UFFI"},
|
{"-uffi", swig_uffi, "Common Lisp / UFFI"},
|
||||||
{"-xml", swig_xml, "XML"},
|
{"-xml", swig_xml, "XML"},
|
||||||
|
{"-r", swig_r, "R (aka GNU S)"},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1923,6 +1923,7 @@ AC_CONFIG_FILES([ \
|
||||||
Examples/test-suite/clisp/Makefile \
|
Examples/test-suite/clisp/Makefile \
|
||||||
Examples/test-suite/cffi/Makefile \
|
Examples/test-suite/cffi/Makefile \
|
||||||
Examples/test-suite/uffi/Makefile \
|
Examples/test-suite/uffi/Makefile \
|
||||||
|
Examples/test-suite/r/Makefile
|
||||||
])
|
])
|
||||||
AC_CONFIG_FILES([preinst-swig], [chmod +x preinst-swig])
|
AC_CONFIG_FILES([preinst-swig], [chmod +x preinst-swig])
|
||||||
AC_OUTPUT
|
AC_OUTPUT
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue