add additional interfaces for mirai dev

Author: shikokuchuo

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nanonext
 Type: Package
 Title: NNG (Nanomsg Next Gen) Lightweight Messaging Library
-Version: 0.2.0.9001
+Version: 0.2.0.9002
 Description: R binding for NNG (Nanomsg Next Gen), a successor to ZeroMQ. NNG is 
     a socket library providing high-performance scalability protocols,
     implementing a cross-platform standard for messaging and communications.

NAMESPACE

@@ -21,6 +21,7 @@ S3method(setopt,nanoListener)
 S3method(setopt,nanoSocket)
 S3method(start,nanoDialer)
 S3method(start,nanoListener)
+export(.mirai_scm)
 export(call_aio)
 export(context)
 export(dial)

NEWS.md

@@ -1,4 +1,4 @@
-# nanonext 0.2.0.9001 (development)
+# nanonext 0.2.0.9002 (development)
 
 #### New Features
 

R/aio.R

@@ -64,54 +64,52 @@
 #'
 call_aio <- function(aio, block = TRUE) {
 
-  if (length(.subset2(aio, "aio"))) {
+  is.null(.subset2(aio, "aio")) && return(invisible(aio))
 
-    if (inherits(aio, "recvAio")) {
+  if (inherits(aio, "recvAio")) {
 
-      if (missing(block) || isTRUE(block)) {
-        res <- .Call(rnng_aio_wait_get_msg, .subset2(aio, "aio"))
-      } else {
-        res <- .Call(rnng_aio_get_msg, .subset2(aio, "aio"))
-        missing(res) && return()
-      }
-      mode <- .subset2(aio, "callparams")[[1L]]
-      keep.raw <- .subset2(aio, "callparams")[[2L]]
-      if (keep.raw) aio[["raw"]] <- res
-      is.integer(res) && {
-        message(res, " : ", nng_error(res))
-        return(invisible(aio))
-      }
-      on.exit(expr = {
-        aio[["raw"]] <- res
-        rm("aio", envir = aio)
-        rm("callparams", envir = aio)
-        return(invisible(aio))
-      })
-      data <- switch(mode,
-                     serial = unserialize(connection = res),
-                     character = (r <- readBin(con = res, what = mode, n = length(res)))[r != ""],
-                     raw = res,
-                     readBin(con = res, what = mode, n = length(res)))
-      aio[["data"]] <- data
-      on.exit()
+    if (missing(block) || isTRUE(block)) {
+      res <- .Call(rnng_aio_wait_get_msg, .subset2(aio, "aio"))
+    } else {
+      res <- .Call(rnng_aio_get_msg, .subset2(aio, "aio"))
+      missing(res) && return()
+    }
+    mode <- .subset2(aio, "callparams")[[1L]]
+    keep.raw <- .subset2(aio, "callparams")[[2L]]
+    if (keep.raw) aio[["raw"]] <- res
+    is.integer(res) && {
+      message(res, " : ", nng_error(res))
+      return(invisible(aio))
+    }
+    on.exit(expr = {
+      aio[["raw"]] <- res
       rm("aio", envir = aio)
       rm("callparams", envir = aio)
+      return(invisible(aio))
+    })
+    data <- switch(mode,
+                   serial = unserialize(connection = res),
+                   character = (r <- readBin(con = res, what = mode, n = length(res)))[r != ""],
+                   raw = res,
+                   readBin(con = res, what = mode, n = length(res)))
+    aio[["data"]] <- data
+    on.exit()
+    rm("aio", envir = aio)
+    rm("callparams", envir = aio)
 
-    } else if (inherits(aio, "sendAio")) {
+  } else if (inherits(aio, "sendAio")) {
 
-      if (missing(block) || isTRUE(block)) {
-        res <- .Call(rnng_aio_wait_result, .subset2(aio, "aio"))
-      } else {
-        res <- .Call(rnng_aio_result, .subset2(aio, "aio"))
-        missing(res) && return()
-      }
-      aio[["result"]] <- res
-      rm("aio", envir = aio)
-      if (res) {
-        message(res, " : ", nng_error(res))
-      }
+    if (missing(block) || isTRUE(block)) {
+      res <- .Call(rnng_aio_wait_result, .subset2(aio, "aio"))
+    } else {
+      res <- .Call(rnng_aio_result, .subset2(aio, "aio"))
+      missing(res) && return()
+    }
+    aio[["result"]] <- res
+    rm("aio", envir = aio)
+    if (res) {
+      message(res, " : ", nng_error(res))
     }
-
   }
 
   invisible(aio)

R/context.R

@@ -152,6 +152,7 @@ recv_ctx <- function(context,
                  raw = res,
                  readBin(con = res, what = mode, n = length(res)))
   on.exit()
+  missing(data) && return(.Call(rnng_scm))
   if (missing(keep.raw) || isTRUE(keep.raw)) list(raw = res, data = data) else data
 
 }

R/nanonext-package.R

@@ -122,3 +122,4 @@
 #'
 NULL
 
+utils::globalVariables("eval_mirai")

R/utils.R

@@ -70,6 +70,15 @@ is_nul_byte <- function(x) {
 
 }
 
+#' @export
+#'
+.mirai_scm <- function() {
+
+  identical(parent.env(parent.env(parent.frame())), environment(eval_mirai)) || return()
+  .Call(rnng_scm)
+
+}
+
 #' ncurl
 #'
 #' nano cURL - a minimalist http(s) client.

src/init.c

@@ -62,6 +62,7 @@ static const R_CallMethodDef CallEntries[] = {
   {"rnng_listener_set_string", (DL_FUNC) &rnng_listener_set_string, 3},
   {"rnng_listener_set_uint64", (DL_FUNC) &rnng_listener_set_uint64, 3},
   {"rnng_listener_start", (DL_FUNC) &rnng_listener_start, 1},
+  {"rnng_scm", (DL_FUNC) &rnng_scm, 0},
   {"rnng_ncurl", (DL_FUNC) &rnng_ncurl, 2},
   {"rnng_protocol_open", (DL_FUNC) &rnng_protocol_open, 1},
   {"rnng_recv", (DL_FUNC) &rnng_recv, 2},

src/nanonext.h

@@ -55,6 +55,7 @@ extern SEXP rnng_listener_set_size(SEXP, SEXP, SEXP);
 extern SEXP rnng_listener_set_string(SEXP, SEXP, SEXP);
 extern SEXP rnng_listener_set_uint64(SEXP, SEXP, SEXP);
 extern SEXP rnng_listener_start(SEXP);
+extern SEXP rnng_scm(void);
 extern SEXP rnng_ncurl(SEXP, SEXP);
 extern SEXP rnng_protocol_open(SEXP);
 extern SEXP rnng_recv(SEXP, SEXP);

src/utils.c

@@ -33,6 +33,10 @@ SEXP rnng_version(void) {
 
 }
 
+SEXP rnng_scm() {
+  return R_MissingArg;
+}
+
 /* ncurl - minimalist http client ------------------------------------------- */
 
 SEXP rnng_ncurl(SEXP http, SEXP args) {