Skip to content

Commit

Permalink
eval promises immediately
Browse files Browse the repository at this point in the history
  • Loading branch information
@traversc
traversc committed May 10, 2024
1 parent 4e43a3a commit 0eea95b
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 21 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
6 changes: 4 additions & 2 deletions inst/extra_tests/correctness_testing_extended.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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())
Expand All @@ -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))
Expand All @@ -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)
Expand Down
50 changes: 32 additions & 18 deletions src/qs_serialize_common.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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<uint8_t>(numeric_header_5 | static_cast<uint8_t>(length)) );
} else if(length < 256) {
} else if(length < 256) {
sobj->push_pod_noncontiguous(numeric_header_8);
sobj->push_pod_contiguous( static_cast<uint8_t>(length) );
} else if(length < 65536) {
} else if(length < 65536) {
sobj->push_pod_noncontiguous(numeric_header_16);
sobj->push_pod_contiguous( static_cast<uint16_t>(length) );
} else if(length < 4294967296) {
Expand All @@ -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<uint8_t>(list_header_5 | static_cast<uint8_t>(length)) );
} else if(length < 256) {
} else if(length < 256) {
sobj->push_pod_noncontiguous(list_header_8);
sobj->push_pod_contiguous(static_cast<uint8_t>(length) );
} else if(length < 65536) {
} else if(length < 65536) {
sobj->push_pod_noncontiguous(list_header_16);
sobj->push_pod_contiguous(static_cast<uint16_t>(length) );
} else if(length < 4294967296) {
Expand All @@ -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<uint8_t>(integer_header_5 | static_cast<uint8_t>(length)) );
} else if(length < 256) {
} else if(length < 256) {
sobj->push_pod_noncontiguous(integer_header_8);
sobj->push_pod_contiguous(static_cast<uint8_t>(length) );
} else if(length < 65536) {
} else if(length < 65536) {
sobj->push_pod_noncontiguous(integer_header_16);
sobj->push_pod_contiguous(static_cast<uint16_t>(length) );
} else if(length < 4294967296) {
Expand All @@ -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<uint8_t>(logical_header_5 | static_cast<uint8_t>(length)) );
} else if(length < 256) {
} else if(length < 256) {
sobj->push_pod_noncontiguous(logical_header_8);
sobj->push_pod_contiguous(static_cast<uint8_t>(length) );
} else if(length < 65536) {
} else if(length < 65536) {
sobj->push_pod_noncontiguous(logical_header_16);
sobj->push_pod_contiguous(static_cast<uint16_t>(length) );
} else if(length < 4294967296) {
Expand All @@ -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<uint8_t>(character_header_5 | static_cast<uint8_t>(length)) );
} else if(length < 256) {
} else if(length < 256) {
sobj->push_pod_noncontiguous(character_header_8);
sobj->push_pod_contiguous(static_cast<uint8_t>(length) );
} else if(length < 65536) {
} else if(length < 65536) {
sobj->push_pod_noncontiguous(character_header_16);
sobj->push_pod_contiguous(static_cast<uint16_t>(length) );
} else if(length < 4294967296) {
Expand Down Expand Up @@ -355,8 +355,22 @@ void writeEnvFrame(T * const sobj, SEXP rho) {

template <class T>
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<SEXP> attrs; // attribute objects and names; r-serialized, env-references and NULLs don't have attributes, so process inline
std::vector<SEXP> anames; // just declare attribute variables for convienence here
std::vector<SEXP> anames; // just declare attribute variables for convenience here
auto xtype = TYPEOF(x);

#ifdef USE_ALT_REP
Expand Down Expand Up @@ -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++;
Expand Down Expand Up @@ -587,7 +601,7 @@ void writeObject(T * const sobj, SEXP x) {
if(sobj->qm.real_shuffle) {
sobj->shuffle_push(reinterpret_cast<char*>(REAL(x)), dl*8, 8);
} else {
sobj->push_contiguous(reinterpret_cast<char*>(REAL(x)), dl*8);
sobj->push_contiguous(reinterpret_cast<char*>(REAL(x)), dl*8);
}
writeAttributes(sobj, attrs, anames);
return;
Expand All @@ -601,7 +615,7 @@ void writeObject(T * const sobj, SEXP x) {
if(sobj->qm.int_shuffle) {
sobj->shuffle_push(reinterpret_cast<char*>(INTEGER(x)), dl*4, 4);
} else {
sobj->push_contiguous(reinterpret_cast<char*>(INTEGER(x)), dl*4);
sobj->push_contiguous(reinterpret_cast<char*>(INTEGER(x)), dl*4);
}
writeAttributes(sobj, attrs, anames);
return;
Expand All @@ -615,7 +629,7 @@ void writeObject(T * const sobj, SEXP x) {
if(sobj->qm.lgl_shuffle) {
sobj->shuffle_push(reinterpret_cast<char*>(LOGICAL(x)), dl*4, 4);
} else {
sobj->push_contiguous(reinterpret_cast<char*>(LOGICAL(x)), dl*4);
sobj->push_contiguous(reinterpret_cast<char*>(LOGICAL(x)), dl*4);
}
writeAttributes(sobj, attrs, anames);
return;
Expand All @@ -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<char*>(RAW(x)), dl);
sobj->push_contiguous(reinterpret_cast<char*>(RAW(x)), dl);
writeAttributes(sobj, attrs, anames);
return;
}
Expand All @@ -639,7 +653,7 @@ void writeObject(T * const sobj, SEXP x) {
if(sobj->qm.cplx_shuffle) {
sobj->shuffle_push(reinterpret_cast<char*>(COMPLEX(x)), dl*16, 8);
} else {
sobj->push_contiguous(reinterpret_cast<char*>(COMPLEX(x)), dl*16);
sobj->push_contiguous(reinterpret_cast<char*>(COMPLEX(x)), dl*16);
}
writeAttributes(sobj, attrs, anames);
return;
Expand All @@ -656,4 +670,4 @@ void writeObject(T * const sobj, SEXP x) {
}
}

#endif
#endif

0 comments on commit 0eea95b

Please sign in to comment.