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#######################################################################