PageRenderTime 22ms CodeModel.GetById 14ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/Lib/r/srun.swg

#
Unknown | 150 lines | 108 code | 42 blank | 0 comment | 0 complexity | ce9e2d3e1ccfa6471828970707cf69ff MD5 | raw file
  1#                         srun.swg                            #
  2#
  3# This is the basic code that is needed at run time within R to
  4# provide and define the relevant classes.  It is included
  5# automatically in the generated code by copying the contents of
  6# srun.swg into the newly created binding code.
  7
  8
  9# This could be provided as a separate run-time library but this
 10# approach allows the code to to be included directly into the
 11# generated bindings and so removes the need to have and install an
 12# additional library.  We may however end up with multiple copies of
 13# this and some confusion at run-time as to which class to use. This
 14# is an issue when we use NAMESPACES as we may need to export certain
 15# classes.
 16
 17######################################################################
 18
 19if(length(getClassDef("RSWIGStruct")) == 0) 
 20  setClass("RSWIGStruct", representation("VIRTUAL"))
 21
 22
 23
 24if(length(getClassDef("ExternalReference")) == 0) 
 25# Should be virtual but this means it loses its slots currently
 26#representation("VIRTUAL")
 27  setClass("ExternalReference", representation( ref = "externalptr"))
 28
 29
 30
 31if(length(getClassDef("NativeRoutinePointer")) == 0) 
 32  setClass("NativeRoutinePointer", 
 33              representation(parameterTypes = "character",
 34                             returnType = "character",
 35                             "VIRTUAL"), 
 36              contains = "ExternalReference")
 37
 38if(length(getClassDef("CRoutinePointer")) == 0) 
 39  setClass("CRoutinePointer", contains = "NativeRoutinePointer")
 40
 41
 42if(length(getClassDef("EnumerationValue")) == 0) 
 43  setClass("EnumerationValue", contains = "integer")
 44
 45
 46if(!isGeneric("copyToR")) 
 47 setGeneric("copyToR",
 48            function(value, obj = new(gsub("Ref$", "", class(value)))) 
 49               standardGeneric("copyToR"
 50           ))
 51
 52setGeneric("delete", function(obj) standardGeneric("delete"))
 53
 54
 55SWIG_createNewRef = 
 56function(className, ..., append = TRUE)
 57{
 58  f = get(paste("new", className, sep = "_"), mode = "function")
 59
 60  f(...)
 61}
 62
 63if(!isGeneric("copyToC")) 
 64 setGeneric("copyToC", 
 65             function(value, obj = RSWIG_createNewRef(class(value)))
 66              standardGeneric("copyToC"
 67            ))
 68
 69
 70# 
 71defineEnumeration =
 72function(name, .values, where = topenv(parent.frame()), suffix = "Value")
 73{
 74   # Mirror the class definitions via the E analogous to .__C__
 75  defName = paste(".__E__", name, sep = "")
 76  assign(defName,  .values,  envir = where)
 77
 78  if(nchar(suffix))
 79    name = paste(name, suffix, sep = "")
 80
 81  setClass(name, contains = "EnumerationValue", where = where)
 82}
 83
 84enumToInteger <- function(name,type)
 85{
 86   if (is.character(name)) {
 87   ans <- as.integer(get(paste(".__E__", type, sep = ""))[name])
 88   if (is.na(ans)) {warning("enum not found ", name, " ", type)}
 89   ans
 90   } 
 91}
 92
 93enumFromInteger =
 94function(i,type)
 95{
 96  itemlist <- get(paste(".__E__", type, sep=""))
 97  names(itemlist)[match(i, itemlist)]
 98}
 99
100coerceIfNotSubclass =
101function(obj, type) 
102{
103    if(!is(obj, type)) {as(obj, type)} else obj
104}
105
106
107setClass("SWIGArray", representation(dims = "integer"), contains = "ExternalReference")
108
109setMethod("length", "SWIGArray", function(x) x@dims[1])
110
111
112defineEnumeration("SCopyReferences",
113                   .values = c( "FALSE" = 0, "TRUE" = 1, "DEEP" = 2))
114
115assert = 
116function(condition, message = "")
117{
118  if(!condition)
119    stop(message)
120
121  TRUE
122}
123
124
125if(FALSE) {
126print.SWIGFunction =
127function(x, ...)
128 {
129 }
130}
131
132
133#######################################################################
134
135R_SWIG_getCallbackFunctionStack =
136function()
137{
138    # No PACKAGE argument as we don't know what the DLL is.
139  .Call("R_SWIG_debug_getCallbackFunctionData")
140}
141
142R_SWIG_addCallbackFunctionStack =
143function(fun, userData = NULL)
144{
145    # No PACKAGE argument as we don't know what the DLL is.
146  .Call("R_SWIG_R_pushCallbackFunctionData", fun, userData)
147}
148
149
150#######################################################################