1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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)
}
#######################################################################
|
