Implements qs2 serialization as an option

DESCRIPTION

@@ -33,8 +33,10 @@ Enhances:
     promises
 Suggests: 
     later,
-    litedown
+    litedown,
+    qs2
 VignetteBuilder: litedown
 RoxygenNote: 7.3.2
 Config/build/compilation-database: true
 Roxygen: list(markdown = TRUE)
+Remotes: qsbase/qs2

NAMESPACE

@@ -103,6 +103,7 @@ export(unresolved)
 export(unsubscribe)
 export(until)
 export(until_)
+export(use_qs2)
 export(wait)
 export(wait_)
 export(write_cert)

NEWS.md

@@ -1,5 +1,9 @@
 # nanonext (development version)
 
+#### New Features
+
+* `use_qs2()` switches serialization to use the qs2 package.
+
 #### Updates
 
 * `write_cert()` argument 'cn' now defaults to '127.0.0.1' instead of 'localhost'.

R/aio.R

@@ -140,8 +140,8 @@ send_aio <- function(con, data, mode = c("serial", "raw"), timeout = NULL, pipe
 #' @export
 #'
 recv_aio <- function(con,
-                     mode = c("serial", "character", "complex", "double",
-                              "integer", "logical", "numeric", "raw", "string"),
+                     mode = c("serial", "character", "complex", "double", "integer",
+                              "logical", "numeric", "raw", "string"),
                      timeout = NULL,
                      cv = NULL,
                      n = 65536L)

R/context.R

@@ -242,8 +242,8 @@ reply <- function(context,
 request <- function(context,
                     data,
                     send_mode = c("serial", "raw"),
-                    recv_mode = c("serial", "character", "complex", "double",
-                                  "integer", "logical", "numeric", "raw", "string"),
+                    recv_mode = c("serial", "character", "complex", "double", "integer",
+                                  "logical", "numeric", "raw", "string"),
                     timeout = NULL,
                     cv = NULL)
   data <- .Call(rnng_request, context, data, send_mode, recv_mode, timeout, cv, environment())

R/nano.R

@@ -483,3 +483,13 @@ print.tlsConfig <- function(x, ...) {
 #'
 .DollarNames.ncurlAio <- function(x, pattern = "")
   grep(pattern, c("status", "headers", "data"), value = TRUE, fixed = TRUE)
+
+#' Use qs2 serialization
+#'
+#' Use serialization from \CRANpkg{qs2} instead of base R.
+#'
+#' @return NULL.
+#'
+#' @export
+#'
+use_qs2 <- function() .Call(rnng_use_qs2)

src/aio.c

@@ -487,6 +487,7 @@ SEXP rnng_send_aio(SEXP con, SEXP data, SEXP mode, SEXP timeout, SEXP pipe, SEXP
 
     const int pipeid = sock ? nano_integer(pipe) : 0;
     nano_encodes(mode) == 2 ? nano_encode(&buf, data) : nano_serialize(&buf, data, NANO_PROT(con));
+
     nng_msg *msg;
     saio = R_Calloc(1, nano_aio);
     saio->type = SENDAIO;

src/comms.c

@@ -307,6 +307,7 @@ SEXP rnng_send(SEXP con, SEXP data, SEXP mode, SEXP block, SEXP pipe) {
 
     const int pipeid = sock ? nano_integer(pipe) : 0;
     nano_encodes(mode) == 2 ? nano_encode(&buf, data) : nano_serialize(&buf, data, NANO_PROT(con));
+
     nng_msg *msgp;
 
     if (flags <= 0) {

src/core.c

@@ -266,6 +266,13 @@ SEXP rawToChar(const unsigned char *buf, const size_t sz) {
 
 void nano_serialize(nano_buf *buf, const SEXP object, SEXP hook) {
 
+  if (serial_alt) {
+    nano_qs2_loaded();
+    buf->buf = qs2_serialize(object, &buf->cur, 3, true, 1);
+    buf->len = buf->cur;
+    return;
+  }
+
   NANO_ALLOC(buf, NANONEXT_INIT_BUFSIZE);
   const int reg = hook != R_NilValue;
   int vec;
@@ -402,6 +409,9 @@ SEXP nano_unserialize(unsigned char *buf, const size_t sz, SEXP hook) {
       }
       cur = 12;
       goto resume;
+    case 0x0b:
+      nano_qs2_loaded();
+      return qs2_deserialize(buf, sz, false, 1);
     }
   }
 
@@ -437,6 +447,18 @@ SEXP nano_unserialize(unsigned char *buf, const size_t sz, SEXP hook) {
 
 }
 
+void nano_qs2_loaded(void) {
+  if (qs2_deserialize != NULL)
+    return;
+  SEXP str, call;
+  PROTECT(str = Rf_mkString("qs2"));
+  PROTECT(call = Rf_lang2(Rf_install("loadNamespace"), str));
+  Rf_eval(call, R_BaseEnv);
+  UNPROTECT(2);
+  qs2_serialize = (unsigned char *(*)(SEXP, size_t *, const int, const bool, const int)) R_GetCCallable("qs2", "c_qs_serialize");
+  qs2_deserialize = (SEXP (*)(const unsigned char *, const size_t, const bool, const int)) R_GetCCallable("qs2", "c_qs_deserialize");
+}
+
 SEXP nano_decode(unsigned char *buf, const size_t sz, const uint8_t mod, SEXP hook) {
 
   SEXP data;
@@ -510,7 +532,7 @@ SEXP nano_decode(unsigned char *buf, const size_t sz, const uint8_t mod, SEXP ho
     return data;
   default:
     data = nano_unserialize(buf, sz, hook);
-  return data;
+    return data;
   }
 
   memcpy(NANO_DATAPTR(data), buf, sz);
@@ -660,3 +682,10 @@ SEXP rnng_eval_safe(SEXP arg) {
   return R_ToplevelExec(nano_eval_safe, arg) ? nano_eval_res : Rf_allocVector(RAWSXP, 1);
 
 }
+
+SEXP rnng_use_qs2(void) {
+
+  serial_alt = 1;
+  return R_NilValue;
+
+}

src/init.c

@@ -18,6 +18,9 @@
 
 #include "nanonext.h"
 
+int serial_alt = 0;
+unsigned char *(*qs2_serialize)(SEXP, size_t *, const int, const bool, const int) = NULL;
+SEXP (*qs2_deserialize)(const unsigned char *, const size_t, const bool, const int) = NULL;
 void (*eln2)(void (*)(void *), void *, double, int) = NULL;
 
 int nano_interrupt = 0;
@@ -196,6 +199,7 @@ static const R_CallMethodDef callMethods[] = {
   {"rnng_version", (DL_FUNC) &rnng_version, 0},
   {"rnng_wait_thread_create", (DL_FUNC) &rnng_wait_thread_create, 1},
   {"rnng_write_cert", (DL_FUNC) &rnng_write_cert, 2},
+  {"rnng_use_qs2", (DL_FUNC) &rnng_use_qs2, 0},
   {NULL, NULL, 0}
 };
 

src/nanonext.h

@@ -219,6 +219,9 @@ typedef struct nano_buf_s {
   size_t cur;
 } nano_buf;
 
+extern int serial_alt;
+extern unsigned char *(*qs2_serialize)(SEXP, size_t *, const int, const bool, const int);
+extern SEXP (*qs2_deserialize)(const unsigned char *, const size_t, const bool, const int);
 extern void (*eln2)(void (*)(void *), void *, double, int);
 extern uint8_t special_bit;
 extern int nano_interrupt;
@@ -280,6 +283,7 @@ void nano_encode(nano_buf *, const SEXP);
 int nano_encodes(const SEXP);
 int nano_matcharg(const SEXP);
 int nano_matchargs(const SEXP);
+void nano_qs2_loaded(void);
 
 void pipe_cb_signal(nng_pipe, nng_pipe_ev, void *);
 void tls_finalizer(SEXP);
@@ -358,5 +362,6 @@ SEXP rnng_url_parse(SEXP);
 SEXP rnng_version(void);
 SEXP rnng_wait_thread_create(SEXP);
 SEXP rnng_write_cert(SEXP, SEXP);
+SEXP rnng_use_qs2(void);
 
 #endif

src/sync.c

@@ -408,7 +408,7 @@ SEXP rnng_request(SEXP con, SEXP data, SEXP sendmode, SEXP recvmode, SEXP timeou
     Rf_error("'con' is not a valid Context");
 
   const nng_duration dur = timeout == R_NilValue ? NNG_DURATION_DEFAULT : (nng_duration) nano_integer(timeout);
-  const uint8_t mod = (uint8_t) nano_matcharg(recvmode);
+  const uint8_t rmod = (uint8_t) nano_matcharg(recvmode);
   int signal, drop;
   if (cvar == R_NilValue) {
     signal = 0;
@@ -428,6 +428,7 @@ SEXP rnng_request(SEXP con, SEXP data, SEXP sendmode, SEXP recvmode, SEXP timeou
   int xc;
 
   nano_encodes(sendmode) == 2 ? nano_encode(&buf, data) : nano_serialize(&buf, data, NANO_PROT(con));
+
   saio = R_Calloc(1, nano_saio);
   saio->cb = NULL;
 
@@ -445,7 +446,7 @@ SEXP rnng_request(SEXP con, SEXP data, SEXP sendmode, SEXP recvmode, SEXP timeou
 
   raio = R_Calloc(1, nano_aio);
   raio->type = signal ? REQAIOS : REQAIO;
-  raio->mode = mod;
+  raio->mode = rmod;
   raio->cb = saio;
   raio->next = ncv;