Home | History | Annotate | Download | only in r 
      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 
     19 if(length(getClassDef("RSWIGStruct")) == 0) 
     20   setClass("RSWIGStruct", representation("VIRTUAL"))
     21 
     22 
     23 
     24 if(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 
     31 if(length(getClassDef("NativeRoutinePointer")) == 0) 
     32   setClass("NativeRoutinePointer", 
     33               representation(parameterTypes = "character",
     34                              returnType = "character",
     35                              "VIRTUAL"), 
     36               contains = "ExternalReference")
     37 
     38 if(length(getClassDef("CRoutinePointer")) == 0) 
     39   setClass("CRoutinePointer", contains = "NativeRoutinePointer")
     40 
     41 
     42 if(length(getClassDef("EnumerationValue")) == 0) 
     43   setClass("EnumerationValue", contains = "integer")
     44 
     45 
     46 if(!isGeneric("copyToR")) 
     47  setGeneric("copyToR",
     48             function(value, obj = new(gsub("Ref$", "", class(value)))) 
     49                standardGeneric("copyToR"
     50            ))
     51 
     52 setGeneric("delete", function(obj) standardGeneric("delete"))
     53 
     54 
     55 SWIG_createNewRef = 
     56 function(className, ..., append = TRUE)
     57 {
     58   f = get(paste("new", className, sep = "_"), mode = "function")
     59 
     60   f(...)
     61 }
     62 
     63 if(!isGeneric("copyToC")) 
     64  setGeneric("copyToC", 
     65              function(value, obj = RSWIG_createNewRef(class(value)))
     66               standardGeneric("copyToC"
     67             ))
     68 
     69 
     70 # 
     71 defineEnumeration =
     72 function(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 
     84 enumToInteger <- 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 
     93 enumFromInteger =
     94 function(i,type)
     95 {
     96   itemlist <- get(paste(".__E__", type, sep=""))
     97   names(itemlist)[match(i, itemlist)]
     98 }
     99 
    100 coerceIfNotSubclass =
    101 function(obj, type) 
    102 {
    103     if(!is(obj, type)) {as(obj, type)} else obj
    104 }
    105 
    106 
    107 setClass("SWIGArray", representation(dims = "integer"), contains = "ExternalReference")
    108 
    109 setMethod("length", "SWIGArray", function(x) x@dims[1])
    110 
    111 
    112 defineEnumeration("SCopyReferences",
    113                    .values = c( "FALSE" = 0, "TRUE" = 1, "DEEP" = 2))
    114 
    115 assert = 
    116 function(condition, message = "")
    117 {
    118   if(!condition)
    119     stop(message)
    120 
    121   TRUE
    122 }
    123 
    124 
    125 if(FALSE) {
    126 print.SWIGFunction =
    127 function(x, ...)
    128  {
    129  }
    130 }
    131 
    132 
    133 #######################################################################
    134 
    135 R_SWIG_getCallbackFunctionStack =
    136 function()
    137 {
    138     # No PACKAGE argument as we don't know what the DLL is.
    139   .Call("R_SWIG_debug_getCallbackFunctionData")
    140 }
    141 
    142 R_SWIG_addCallbackFunctionStack =
    143 function(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 #######################################################################