From 0eea95bd043559a03cb00cf2c2031d8d684ec027 Mon Sep 17 00:00:00 2001 From: Travers Date: Fri, 10 May 2024 16:32:31 -0700 Subject: [PATCH] eval promises immediately --- DESCRIPTION | 2 +- .../correctness_testing_extended.R | 6 ++- src/qs_serialize_common.h | 50 ++++++++++++------- 3 files changed, 37 insertions(+), 21 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7a205cd..f9231eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,7 @@ Imports: LinkingTo: Rcpp, RApiSerialize, stringfish, BH Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: knitr, rmarkdown, testthat, dplyr, data.table VignetteBuilder: knitr Copyright: This package includes code from the 'zstd' library owned by Facebook, Inc. and created by Yann Collet; the 'lz4' library created and owned by Yann Collet; xxHash library created and owned by Yann Collet; and code derived from the 'Blosc' library created and owned by Francesc Alted. diff --git a/inst/extra_tests/correctness_testing_extended.R b/inst/extra_tests/correctness_testing_extended.R index 60f3cd8..fb0a984 100644 --- a/inst/extra_tests/correctness_testing_extended.R +++ b/inst/extra_tests/correctness_testing_extended.R @@ -64,6 +64,7 @@ qread_rand <- function(file) { # check parent env recursion print("check recursive environments, promises and closures") for(i in 1:10) { + print(i) l1 <- round(exp(runif(1,0,log(1e6)))) l2 <- round(exp(runif(1,0,log(1e7)))) x0 <- new.env(parent = baseenv()) @@ -74,8 +75,8 @@ for(i in 1:10) { x1$data <- runif(l2) environment(x1$f) <- x1 parent.env(x0) <- x1 - delayedAssign("v", c(not_a_variable, runif(1e100)), assign.env=x0, eval.env=x1) - delayedAssign("w", c(v, rnorm(1e100)), assign.env=x1, eval.env=x0) + delayedAssign("v", c(not_a_variable, runif(1e6)), assign.env=x0, eval.env=x1) + delayedAssign("w", c(v, rnorm(1e6)), assign.env=x1, eval.env=x0) qsave_rand(x1, myfile) x1r <- qread_rand(myfile) stopifnot(serialize_identical(x1, x1r)) @@ -87,6 +88,7 @@ gc() print("mtcars ggplot example") for(i in 1:10) { + print(i) df <- mtcars %>% sample_n(1e5, replace=T) vars <- c("hp", "drat", "wt", "qsec") var <- sample(vars, 1) diff --git a/src/qs_serialize_common.h b/src/qs_serialize_common.h index 316860c..98a33c3 100644 --- a/src/qs_serialize_common.h +++ b/src/qs_serialize_common.h @@ -90,10 +90,10 @@ void writeHeader_common(const qstype object_type, const uint64_t length, T * con case qstype::NUMERIC: if(length < 32) { sobj->push_pod_noncontiguous( static_cast(numeric_header_5 | static_cast(length)) ); - } else if(length < 256) { + } else if(length < 256) { sobj->push_pod_noncontiguous(numeric_header_8); sobj->push_pod_contiguous( static_cast(length) ); - } else if(length < 65536) { + } else if(length < 65536) { sobj->push_pod_noncontiguous(numeric_header_16); sobj->push_pod_contiguous( static_cast(length) ); } else if(length < 4294967296) { @@ -107,10 +107,10 @@ void writeHeader_common(const qstype object_type, const uint64_t length, T * con case qstype::LIST: if(length < 32) { sobj->push_pod_noncontiguous( static_cast(list_header_5 | static_cast(length)) ); - } else if(length < 256) { + } else if(length < 256) { sobj->push_pod_noncontiguous(list_header_8); sobj->push_pod_contiguous(static_cast(length) ); - } else if(length < 65536) { + } else if(length < 65536) { sobj->push_pod_noncontiguous(list_header_16); sobj->push_pod_contiguous(static_cast(length) ); } else if(length < 4294967296) { @@ -124,10 +124,10 @@ void writeHeader_common(const qstype object_type, const uint64_t length, T * con case qstype::INTEGER: if(length < 32) { sobj->push_pod_noncontiguous( static_cast(integer_header_5 | static_cast(length)) ); - } else if(length < 256) { + } else if(length < 256) { sobj->push_pod_noncontiguous(integer_header_8); sobj->push_pod_contiguous(static_cast(length) ); - } else if(length < 65536) { + } else if(length < 65536) { sobj->push_pod_noncontiguous(integer_header_16); sobj->push_pod_contiguous(static_cast(length) ); } else if(length < 4294967296) { @@ -141,10 +141,10 @@ void writeHeader_common(const qstype object_type, const uint64_t length, T * con case qstype::LOGICAL: if(length < 32) { sobj->push_pod_noncontiguous( static_cast(logical_header_5 | static_cast(length)) ); - } else if(length < 256) { + } else if(length < 256) { sobj->push_pod_noncontiguous(logical_header_8); sobj->push_pod_contiguous(static_cast(length) ); - } else if(length < 65536) { + } else if(length < 65536) { sobj->push_pod_noncontiguous(logical_header_16); sobj->push_pod_contiguous(static_cast(length) ); } else if(length < 4294967296) { @@ -167,10 +167,10 @@ void writeHeader_common(const qstype object_type, const uint64_t length, T * con case qstype::CHARACTER: if(length < 32) { sobj->push_pod_noncontiguous( static_cast(character_header_5 | static_cast(length)) ); - } else if(length < 256) { + } else if(length < 256) { sobj->push_pod_noncontiguous(character_header_8); sobj->push_pod_contiguous(static_cast(length) ); - } else if(length < 65536) { + } else if(length < 65536) { sobj->push_pod_noncontiguous(character_header_16); sobj->push_pod_contiguous(static_cast(length) ); } else if(length < 4294967296) { @@ -355,8 +355,22 @@ void writeEnvFrame(T * const sobj, SEXP rho) { template void writeObject(T * const sobj, SEXP x) { + // evaluate promises immediately + if(TYPEOF(x) == PROMSXP) { + int error_occured = 0; + SEXP xeval = R_tryEval(x, R_BaseEnv, &error_occured); + if(error_occured) { + writeObject(sobj, R_NilValue); + } else { + PROTECT(xeval); + writeObject(sobj, xeval); + UNPROTECT(1); + } + return; + } + std::vector attrs; // attribute objects and names; r-serialized, env-references and NULLs don't have attributes, so process inline - std::vector anames; // just declare attribute variables for convienence here + std::vector anames; // just declare attribute variables for convenience here auto xtype = TYPEOF(x); #ifdef USE_ALT_REP @@ -549,7 +563,7 @@ void writeObject(T * const sobj, SEXP x) { } case ENVSXP: { - if(x == R_GlobalEnv || x == R_BaseEnv || x == R_EmptyEnv || + if(x == R_GlobalEnv || x == R_BaseEnv || x == R_EmptyEnv || R_IsNamespaceEnv(x) || R_IsPackageEnv(x)) { Protect_Tracker pt = Protect_Tracker(); SEXP xserialized = PROTECT(serializeToRaw(x,Rf_ScalarInteger(2))); pt++; @@ -587,7 +601,7 @@ void writeObject(T * const sobj, SEXP x) { if(sobj->qm.real_shuffle) { sobj->shuffle_push(reinterpret_cast(REAL(x)), dl*8, 8); } else { - sobj->push_contiguous(reinterpret_cast(REAL(x)), dl*8); + sobj->push_contiguous(reinterpret_cast(REAL(x)), dl*8); } writeAttributes(sobj, attrs, anames); return; @@ -601,7 +615,7 @@ void writeObject(T * const sobj, SEXP x) { if(sobj->qm.int_shuffle) { sobj->shuffle_push(reinterpret_cast(INTEGER(x)), dl*4, 4); } else { - sobj->push_contiguous(reinterpret_cast(INTEGER(x)), dl*4); + sobj->push_contiguous(reinterpret_cast(INTEGER(x)), dl*4); } writeAttributes(sobj, attrs, anames); return; @@ -615,7 +629,7 @@ void writeObject(T * const sobj, SEXP x) { if(sobj->qm.lgl_shuffle) { sobj->shuffle_push(reinterpret_cast(LOGICAL(x)), dl*4, 4); } else { - sobj->push_contiguous(reinterpret_cast(LOGICAL(x)), dl*4); + sobj->push_contiguous(reinterpret_cast(LOGICAL(x)), dl*4); } writeAttributes(sobj, attrs, anames); return; @@ -626,7 +640,7 @@ void writeObject(T * const sobj, SEXP x) { if(attrs.size() > 0) writeAttributeHeader_common(attrs.size(), sobj); uint64_t dl = Rf_xlength(x); writeHeader_common(qstype::RAW, dl, sobj); - sobj->push_contiguous(reinterpret_cast(RAW(x)), dl); + sobj->push_contiguous(reinterpret_cast(RAW(x)), dl); writeAttributes(sobj, attrs, anames); return; } @@ -639,7 +653,7 @@ void writeObject(T * const sobj, SEXP x) { if(sobj->qm.cplx_shuffle) { sobj->shuffle_push(reinterpret_cast(COMPLEX(x)), dl*16, 8); } else { - sobj->push_contiguous(reinterpret_cast(COMPLEX(x)), dl*16); + sobj->push_contiguous(reinterpret_cast(COMPLEX(x)), dl*16); } writeAttributes(sobj, attrs, anames); return; @@ -656,4 +670,4 @@ void writeObject(T * const sobj, SEXP x) { } } -#endif \ No newline at end of file +#endif