From e6e2e8d81f7eba1b5aefcaab3842b55d1ff52421 Mon Sep 17 00:00:00 2001
From: "Matthew L. Fidler" <matthew.fidler@gmail.com>
Date: Tue, 31 Oct 2023 14:54:52 -0500
Subject: [PATCH] Add md5 info based on environment address for r udf funs

---
 NAMESPACE             |  1 +
 R/rudf.R              | 30 +++++++++++++++++++++++++++---
 man/dot-udfMd5Info.Rd | 18 ++++++++++++++++++
 src/tran.c            |  2 +-
 src/udf.cpp           | 25 +++++++++++++++++--------
 5 files changed, 64 insertions(+), 12 deletions(-)
 create mode 100644 man/dot-udfMd5Info.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 8b951d6e..c914decc 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -15,6 +15,7 @@ export(.toClassicEvid)
 export(.udfCallFunArg)
 export(.udfEnvLock)
 export(.udfEnvSet)
+export(.udfMd5Info)
 export(etTransParse)
 export(forderForceBase)
 export(rxDerived)
diff --git a/R/rudf.R b/R/rudf.R
index f6026737..ce2614aa 100644
--- a/R/rudf.R
+++ b/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) == "...")) {
diff --git a/man/dot-udfMd5Info.Rd b/man/dot-udfMd5Info.Rd
new file mode 100644
index 00000000..19195447
--- /dev/null
+++ b/man/dot-udfMd5Info.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/rudf.R
+\name{.udfMd5Info}
+\alias{.udfMd5Info}
+\title{Get the udf strings for creating model md5}
+\usage{
+.udfMd5Info()
+}
+\value{
+string vector
+}
+\description{
+Get the udf strings for creating model md5
+}
+\author{
+Matthew L. Fidler
+}
+\keyword{internal}
diff --git a/src/tran.c b/src/tran.c
index 485cf78f..418d4dec 100644
--- a/src/tran.c
+++ b/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
diff --git a/src/udf.cpp b/src/udf.cpp
index da18374b..1e14a67b 100644
--- a/src/udf.cpp
+++ b/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() {