Add jlfunc (or jltryfunc)

Author: rcqls

NAMESPACE

@@ -3,9 +3,9 @@ useDynLib(jl4R, .registration = TRUE)
 # exportPattern("^\\jl_")
 # exportPattern("^\\jlR_")
 export(
-  jl, jleval, jlrun, jlcall,
+  jl, jleval, jlrun, jlcall, jlfunc,
   R, toR, 
-  jlR, jlcallR, 
+  jlR, jlcallR, jlfuncR,
   ## unsafe function (closest to julia C API)
   jlvalue_eval,
   jlvalue, is.jlvalue,

R/jl4R.R

@@ -86,7 +86,22 @@ jlcall <- jltrycall <- function(meth, ..., parent_envir =  parent.frame()) {
   jlvalue_or_jlexception(match.call(), jlval)
 }
 
+jlfunc <- jltryfunc <- function(meth, ..., parent_envir =  parent.frame()) {
+  args <- jl_rexprs2(substitute(list(...)), parent_envir)
+  ## print(list(jltcargs=args, call=match.call(), s = substitute(list(...)),env=ls(parent_envir)))
+  nmargs <- names(args)
+  if(is.null(nmargs)) nmargs <- rep("",length(args))
+  kwargs <- args[nmargs != ""]
+  args <- args[nmargs == ""]
+  ## print(list(args=args, kwargs=kwargs))
+  ## print(lapply(args, jl))
+  ## print(.RNamedList2jlNamedTuple(kwargs))
+  jlval <- .jlvalue_tryfunc(meth, jl(lapply(args, jl)), .RNamedList2jlNamedTuple(kwargs))
+  jlvalue_or_jlexception(match.call(), jlval)
+}
+
 jlcallR <- jltrycallR <- function(meth, ...) toR(jltrycall(meth, ...))
+jlfuncR <- jltryfuncR <- function(meth, ...) toR(jltryfunc(meth, ...))
 
 # apply a method call 
 jlvalue_call <- function(meth , ...) {

R/jl_internals.R

@@ -30,6 +30,11 @@
     .External("jl4R_jlvalue_trycall", meth, jlargs, jlkwargs, PACKAGE = "jl4R")
 }
 
+.jlvalue_tryfunc <- function(meth, jlargs, jlkwargs = jlvalue_eval("[]")) {
+    if(!.jlrunning()) .jlinit()
+    .External("jl4R_jlvalue_tryfunc", meth, jlargs, jlkwargs, PACKAGE = "jl4R")
+}
+
 .jlvalue_call0 <- function(meth) {
     if(!.jlrunning()) .jlinit()
     .External("jl4R_jlvalue_call0", meth, PACKAGE = "jl4R")

inst/julia/JL4R.jl

@@ -27,4 +27,12 @@ function jltrycall(fname, args, kwargs)
     end;
 end
 
+function jltryfunc(f, args, kwargs)
+    try
+        f(args...; kwargs...);
+    catch e
+        e #showerror(stdout,e)
+    end;
+end
+
 end

src/jl4R.c

@@ -753,6 +753,24 @@ SEXP jl4R_jlvalue_trycall(SEXP args) {
   return resR;
 }
 
+SEXP jl4R_jlvalue_tryfunc(SEXP args) {
+  jl_value_t *res=NULL, *jlarg=NULL, *jlarg2=NULL;
+  jl_function_t *func=NULL, *jlv=NULL;
+  SEXP resR;
+
+  jl_module_t *jl_jl4r_module = (jl_module_t*)jl_get_global(jl_main_module, jl_symbol("JL4R"));
+  func = jl_get_function(jl_jl4r_module, "jltryfunc");
+
+  JL_GC_PUSH4(&jlv,&res,&jlarg,&jlarg2);
+  jlv = (jl_function_t*)get_preserved_jlvalue_from_R_ExternalPtrAddr(CADR(args));
+  jlarg=(jl_value_t*)get_preserved_jlvalue_from_R_ExternalPtrAddr(CADDR(args));
+  jlarg2=(jl_value_t*)get_preserved_jlvalue_from_R_ExternalPtrAddr(CADDDR(args));
+  res = jl_call3(func, jlv, jlarg, jlarg2);
+  resR=(SEXP)jlvalue(res);
+  JL_GC_POP();
+  return resR;
+}
+
 SEXP jl4R_jlvalue_func_call(SEXP jl_func, SEXP jl_args, SEXP jl_nargs) {
   int nargs;
   jl_value_t **args;
@@ -900,12 +918,13 @@ static const R_ExternalMethodDef externalMethods[] = {
    // {"jl4R_as_Rvector",(DL_FUNC)&jl4R_as_Rvector,-1},
   // {"jl4R_as_jlRvector",(DL_FUNC)&jl4R_as_jlRvector,-1},
   {"jl4R_jlvalue_eval",(DL_FUNC) &jl4R_jlvalue_eval,-1},
+  {"jl4R_jlvalue_trycall",(DL_FUNC) &jl4R_jlvalue_trycall,-1},
+  {"jl4R_jlvalue_tryfunc",(DL_FUNC) &jl4R_jlvalue_tryfunc,-1},
   {"jl4R_jlvalue_call0",(DL_FUNC) &jl4R_jlvalue_call0,-1},
   {"jl4R_jlvalue_call1",(DL_FUNC) &jl4R_jlvalue_call1,-1},
   {"jl4R_jlvalue_call2",(DL_FUNC) &jl4R_jlvalue_call2,-1},
   {"jl4R_jlvalue_call3",(DL_FUNC) &jl4R_jlvalue_call3,-1},
   {"jl4R_jlvalue_func_call1",(DL_FUNC) &jl4R_jlvalue_func_call1,-1},
-  {"jl4R_jlvalue_trycall",(DL_FUNC) &jl4R_jlvalue_trycall,-1},
   {"jl4R_jlvalue2R",(DL_FUNC) &jl4R_jlvalue2R,-1},
   {"jl4R_typeof2R",(DL_FUNC) &jl4R_typeof2R,-1},
   {"jl4R_jl_symbol",(DL_FUNC) &jl4R_jl_symbol,-1},