Add md5 info based on environment address for r udf funs

NAMESPACE

@@ -15,6 +15,7 @@ export(.toClassicEvid)
 export(.udfCallFunArg)
 export(.udfEnvLock)
 export(.udfEnvSet)
+export(.udfMd5Info)
 export(etTransParse)
 export(forderForceBase)
 export(rxDerived)

R/rudf.R

@@ -1,11 +1,31 @@
 .udfEnv <- new.env(parent=emptyenv())
 .udfEnv$fun <- list()
 .udfEnv$udf <- integer(0)
+.udfEnv$envir <- new.env(parent=emptyenv())
 .udfEnv$lockedEnvir <- FALSE
 .udfEnv$rxSEeqUsr <- NULL
 .udfEnv$rxCcode <- NULL
 .udfEnv$symengineFs <- new.env(parent = emptyenv())
 .udfEnv$extraCnow <- ""
+
+#' Get the udf strings for creating model md5
+#'
+#' @return string vector
+#' @export
+#' @author Matthew L. Fidler
+#' @keywords internal
+.udfMd5Info <- function() {
+  .tmp <- ls(.udfEnv$symengineFs)
+  c(vapply(.tmp, function(x) {
+    .cur <- .udfEnv$fun[[x]]
+    if (!is.null(.cur)) {
+      return(paste(x, data.table::address(.cur[[2]])))
+    }
+    x
+  }, character(1), USE.NAMES = FALSE),
+  data.table::address(.udfEnv$envir))
+}
+
 #' Generate extraC information for rxode2 models
 #'
 #' @param extraC Additional extraC from rxode2 compile optioioins
@@ -161,9 +181,13 @@ rxRmFunParse <- function(name) {
 .getUdfInfo <- function(fun) {
   .fun <- try(get(fun, mode="function", envir=.udfEnv$envir), silent=TRUE)
   if (inherits(.fun, "try-error")) {
-    return(list(nargs=NA_integer_,
-                sprintf("function '%s' is not supported; user function not found",
-                        fun)))
+    .msg <- try(attr(.fun, "condition")$message, silent=TRUE)
+    if (inherits(.msg, "try-error")){
+      .msg <- sprintf("function '%s' is not supported; user function not found",
+                      fun)
+    }
+    print(get(fun, envir=.udfEnv$envir))
+    return(list(nargs=NA_integer_, .msg))
   }
   .formals <- formals(.fun)
   if (any(names(.formals) == "...")) {

src/tran.c

@@ -297,7 +297,7 @@ char *f1LinCmtLine = NULL;
 char *rate1LinCmtLine = NULL;
 char *dur1LinCmtLine = NULL;
 
-void _rxode2parse_resetUdf();
+SEXP _rxode2parse_resetUdf();
 
 void reset(void) {
   // Reset sb/sbt string buffers

src/udf.cpp

@@ -14,30 +14,39 @@ BEGIN_RCPP
 END_RCPP
 }
 
-extern "C" double _rxode2parse_evalUdf(const char *fun, int n, const double *args) {
+extern "C" SEXP _rxode2parse_evalUdfS(const char *fun, int n, const double *args) {
 BEGIN_RCPP
   Environment rxode2parseNS = loadNamespace("rxode2parse");
   Function rxode2parse_evalUdf = as<Function>(rxode2parseNS[".udfCall"]);
   List retL(n);
   CharacterVector funC(1);
   funC = fun;
-  for (unsigned int i = 0; i < n; ++i) {
+  for (int i = 0; i < n; ++i) {
     NumericVector nv(1);
     nv[0] = args[i];
     retL[i] = nv;
   }
-  NumericVector ret = rxode2parse_evalUdf(funC, retL);
-  return ret[0];
-VOID_END_RCPP
-  return NA_REAL;
+  NumericVector ret0 = rxode2parse_evalUdf(funC, retL);
+  NumericVector ret(1);
+  ret[0] = ret0[0];
+  return wrap(ret);
+END_RCPP
+}
+
+extern "C" double _rxode2parse_evalUdf(const char *fun, int n, const double *args) {
+  SEXP ret = PROTECT(_rxode2parse_evalUdfS(fun, n, args));
+  double r = REAL(ret)[0];
+  UNPROTECT(1);
+  return r;
 }
 
-extern "C" void _rxode2parse_resetUdf() {
+extern "C" SEXP _rxode2parse_resetUdf() {
 BEGIN_RCPP
   Environment rxode2parseNS = loadNamespace("rxode2parse");
   Function resetUdf = as<Function>(rxode2parseNS[".udfReset"]);
   resetUdf();
-VOID_END_RCPP
+  return R_NilValue;
+END_RCPP
 }
 
 extern "C" SEXP _rxode2parse_getUdf() {