From c947cb989459c167dc82f1ea7f03f28da59777ca Mon Sep 17 00:00:00 2001
From: Florian Angerer <florian.angerer@oracle.com>
Date: Tue, 30 May 2017 18:06:38 +0200
Subject: [PATCH] Keeping source of installed packages. Deserializing srcref
attributes.
---
.../r/nodes/builtin/tools/R/tools_overrides.R | 145 +++++-
.../oracle/truffle/r/runtime/RSerialize.java | 475 +++++++++---------
2 files changed, 391 insertions(+), 229 deletions(-)
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/tools/R/tools_overrides.R b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/tools/R/tools_overrides.R
index d7aedd7b69..9eee831d8b 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/tools/R/tools_overrides.R
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/tools/R/tools_overrides.R
@@ -51,9 +51,152 @@ makeLazyLoading <-
else {
code2LazyLoadDB(package, lib.loc = lib.loc,
keep.source = keep.source, compress = compress)
- #file.copy(loaderFile, codeFile, TRUE)
+ file.copy(loaderFile, codeFile, TRUE)
}
invisible()
}
+
+.install_package_code_files <-
+function(dir, outDir)
+{
+ if(!dir.exists(dir))
+ stop(gettextf("directory '%s' does not exist", dir),
+ domain = NA)
+ dir <- file_path_as_absolute(dir)
+
+ ## Attempt to set the LC_COLLATE locale to 'C' to turn off locale
+ ## specific sorting.
+ curLocale <- Sys.getlocale("LC_COLLATE")
+ on.exit(Sys.setlocale("LC_COLLATE", curLocale), add = TRUE)
+ ## (Guaranteed to work as per the Sys.setlocale() docs.)
+ lccollate <- "C"
+ if(Sys.setlocale("LC_COLLATE", lccollate) != lccollate) {
+ ## <NOTE>
+ ## I don't think we can give an error here.
+ ## It may be the case that Sys.setlocale() fails because the "OS
+ ## reports request cannot be honored" (src/main/platform.c), in
+ ## which case we should still proceed ...
+ warning("cannot turn off locale-specific sorting via LC_COLLATE")
+ ## </NOTE>
+ }
+
+ ## We definitely need a valid DESCRIPTION file.
+ db <- .read_description(file.path(dir, "DESCRIPTION"))
+
+ codeDir <- file.path(dir, "R")
+ if(!dir.exists(codeDir)) return(invisible())
+
+ codeFiles <- list_files_with_type(codeDir, "code", full.names = FALSE)
+
+ collationField <-
+ c(paste("Collate", .OStype(), sep = "."), "Collate")
+ if(any(i <- collationField %in% names(db))) {
+ collationField <- collationField[i][1L]
+ codeFilesInCspec <- .read_collate_field(db[collationField])
+ ## Duplicated entries in the collation spec?
+ badFiles <-
+ unique(codeFilesInCspec[duplicated(codeFilesInCspec)])
+ if(length(badFiles)) {
+ out <- gettextf("\nduplicated files in '%s' field:",
+ collationField)
+ out <- paste(out,
+ paste(" ", badFiles, collapse = "\n"),
+ sep = "\n")
+ stop(out, domain = NA)
+ }
+ ## See which files are listed in the collation spec but don't
+ ## exist.
+ badFiles <- setdiff(codeFilesInCspec, codeFiles)
+ if(length(badFiles)) {
+ out <- gettextf("\nfiles in '%s' field missing from '%s':",
+ collationField,
+ codeDir)
+ out <- paste(out,
+ paste(" ", badFiles, collapse = "\n"),
+ sep = "\n")
+ stop(out, domain = NA)
+ }
+ ## See which files exist but are missing from the collation
+ ## spec. Note that we do not want the collation spec to use
+ ## only a subset of the available code files.
+ badFiles <- setdiff(codeFiles, codeFilesInCspec)
+ if(length(badFiles)) {
+ out <- gettextf("\nfiles in '%s' missing from '%s' field:",
+ codeDir,
+ collationField)
+ out <- paste(out,
+ paste(" ", badFiles, collapse = "\n"),
+ sep = "\n")
+ stop(out, domain = NA)
+ }
+ ## Everything's groovy ...
+ codeFiles <- codeFilesInCspec
+ }
+
+ codeFiles <- file.path(codeDir, codeFiles)
+
+ if(!dir.exists(outDir) && !dir.create(outDir))
+ stop(gettextf("cannot open directory '%s'", outDir),
+ domain = NA)
+ outCodeDir <- file.path(outDir, "R")
+ if(!dir.exists(outCodeDir) && !dir.create(outCodeDir))
+ stop(gettextf("cannot open directory '%s'", outCodeDir),
+ domain = NA)
+ outFile <- file.path(outCodeDir, db["Package"])
+ if(!file.create(outFile))
+ stop(gettextf("unable to create '%s'", outFile), domain = NA)
+ writeLines(paste0(".packageName <- \"", db["Package"], "\""),
+ outFile)
+ enc <- as.vector(db["Encoding"])
+ need_enc <- !is.na(enc) # Encoding was specified
+ ## assume that if locale is 'C' we can used 8-bit encodings unchanged.
+ if(need_enc && !(Sys.getlocale("LC_CTYPE") %in% c("C", "POSIX"))) {
+ con <- file(outFile, "a")
+ on.exit(close(con)) # Windows does not like files left open
+ for(f in codeFiles) {
+ tmp <- iconv(readLines(f, warn = FALSE), from = enc, to = "")
+ if(length(bad <- which(is.na(tmp)))) {
+ warning(sprintf(ngettext(length(bad),
+ "unable to re-encode %s line %s",
+ "unable to re-encode %s lines %s"),
+ sQuote(basename(f)),
+ paste(bad, collapse = ", ")),
+ domain = NA, call. = FALSE)
+ tmp <- iconv(readLines(f, warn = FALSE), from = enc, to = "",
+ sub = "byte")
+ }
+
+ # FastR extension: also copy original source file
+ singleOutFile <- file.path(outCodeDir, basename(f))
+ writeLines(tmp, file(singleOutFile))
+
+ writeLines(paste0("#line 1 \"", f, "\""), con)
+ writeLines(tmp, con)
+ }
+ close(con); on.exit()
+ } else {
+ ## <NOTE>
+ ## It may be safer to do
+ ## writeLines(sapply(codeFiles, readLines), outFile)
+ ## instead, but this would be much slower ...
+ ## use fast version of file.append that ensures LF between files
+
+ # FastR extension: also copy original source file
+ singleOutFiles <- file.path(outCodeDir, basename(codeFiles))
+ file.copy(codeFiles, singleOutFiles)
+
+ if(!all(.file_append_ensuring_LFs(outFile, singleOutFiles)))
+ stop("unable to write code files")
+ ## </NOTE>
+ }
+ ## A syntax check here, so that we do not install a broken package.
+ ## FIXME: this is only needed if we don't lazy load, as the lazy loader
+ ## would detect the error.
+ op <- options(showErrorCalls=FALSE)
+ on.exit(options(op))
+ parse(outFile)
+ invisible()
+}
+
}), asNamespace("tools"))
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
index b9f432b18f..494ff5bb7b 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RSerialize.java
@@ -1434,269 +1434,272 @@ public class RSerialize {
outRefIndex(refIndex);
} else if (type == SEXPTYPE.SYMSXP) {
writeSymbol((RSymbol) obj);
- } else if (type == SEXPTYPE.ENVSXP) {
- REnvironment env = (REnvironment) obj;
- addReadRef(obj);
- String name = null;
- if ((name = env.isPackageEnv()) != null) {
- RError.warning(RError.SHOW_CALLER2, RError.Message.PACKAGE_AVAILABLE, name);
- stream.writeInt(SEXPTYPE.PACKAGESXP.code);
- stream.writeString(name);
- } else if (env.isNamespaceEnv()) {
- stream.writeInt(SEXPTYPE.NAMESPACESXP.code);
- RStringVector nameSpaceEnvSpec = env.getNamespaceSpec();
- outStringVec(nameSpaceEnvSpec, false);
- } else {
- stream.writeInt(SEXPTYPE.ENVSXP.code);
- stream.writeInt(env.isLocked() ? 1 : 0);
- writeItem(env.getParent());
- /*
- * TODO To be truly compatible with GnuR we should remember whether an
- * environment was created with new.env(hash=T) and output it in that form
- * with the associated size. For internal FastR use it does not matter, so
- * we use the "frame" form, which is a pairlist. tag is binding name, car is
- * binding value
- */
- String[] bindings = env.ls(true, null, false).getDataWithoutCopying();
- for (String binding : bindings) {
- Object value = getValueIgnoreActiveBinding(env.getFrame(), binding);
- writePairListEntry(binding, value);
- }
- terminatePairList();
- writeItem(RNull.instance); // hashtab
- DynamicObject attributes = env.getAttributes();
- writeAttributes(attributes, getSourceSection(obj));
- if (attributes == null) {
- writeItem(RNull.instance);
- }
- }
} else {
- // flags
- DynamicObject attributes = null;
- SourceSection ss = getSourceSection(obj);
- if (obj instanceof RAttributable) {
- RAttributable rattr = (RAttributable) obj;
- attributes = rattr.getAttributes();
- if (attributes != null && attributes.isEmpty()) {
- attributes = null;
+ SourceSection sourceSection = getSourceSection(obj);
+ if (type == SEXPTYPE.ENVSXP) {
+ REnvironment env = (REnvironment) obj;
+ addReadRef(obj);
+ String name = null;
+ if ((name = env.isPackageEnv()) != null) {
+ RError.warning(RError.SHOW_CALLER2, RError.Message.PACKAGE_AVAILABLE, name);
+ stream.writeInt(SEXPTYPE.PACKAGESXP.code);
+ stream.writeString(name);
+ } else if (env.isNamespaceEnv()) {
+ stream.writeInt(SEXPTYPE.NAMESPACESXP.code);
+ RStringVector nameSpaceEnvSpec = env.getNamespaceSpec();
+ outStringVec(nameSpaceEnvSpec, false);
+ } else {
+ stream.writeInt(SEXPTYPE.ENVSXP.code);
+ stream.writeInt(env.isLocked() ? 1 : 0);
+ writeItem(env.getParent());
+ /*
+ * TODO To be truly compatible with GnuR we should remember whether an
+ * environment was created with new.env(hash=T) and output it in that
+ * form with the associated size. For internal FastR use it does not
+ * matter, so we use the "frame" form, which is a pairlist. tag is
+ * binding name, car is binding value
+ */
+ String[] bindings = env.ls(true, null, false).getDataWithoutCopying();
+ for (String binding : bindings) {
+ Object value = getValueIgnoreActiveBinding(env.getFrame(), binding);
+ writePairListEntry(binding, value);
+ }
+ terminatePairList();
+ writeItem(RNull.instance); // hashtab
+ DynamicObject attributes = env.getAttributes();
+ writeAttributes(attributes, sourceSection);
+ if (attributes == null && sourceSection == null) {
+ writeItem(RNull.instance);
+ }
}
- }
- boolean hasTag = gnuRType == SEXPTYPE.CLOSXP || gnuRType == SEXPTYPE.DOTSXP || (gnuRType == SEXPTYPE.PROMSXP && !((RPromise) obj).isEvaluated()) ||
- (type == SEXPTYPE.LISTSXP && !((RPairList) obj).isNullTag());
- int gpbits = getGPBits(obj);
- int flags = Flags.packFlags(gnuRType, gpbits, isObject(obj), attributes != null, hasTag);
- stream.writeInt(flags);
- switch (type) {
- case STRSXP: {
- if (obj instanceof String) {
- // length 1 vector
- stream.writeInt(1);
- writeCHARSXP((String) obj);
- } else {
- outStringVec((RAbstractStringVector) obj, true);
+ } else {
+ // flags
+ DynamicObject attributes = null;
+ SourceSection ss = sourceSection;
+ if (obj instanceof RAttributable) {
+ RAttributable rattr = (RAttributable) obj;
+ attributes = rattr.getAttributes();
+ if (attributes != null && attributes.isEmpty()) {
+ attributes = null;
}
- break;
}
+ boolean hasTag = gnuRType == SEXPTYPE.CLOSXP || gnuRType == SEXPTYPE.DOTSXP || (gnuRType == SEXPTYPE.PROMSXP && !((RPromise) obj).isEvaluated()) ||
+ (type == SEXPTYPE.LISTSXP && !((RPairList) obj).isNullTag());
+ int gpbits = getGPBits(obj);
+ int flags = Flags.packFlags(gnuRType, gpbits, isObject(obj), attributes != null, hasTag);
+ stream.writeInt(flags);
+ switch (type) {
+ case STRSXP: {
+ if (obj instanceof String) {
+ // length 1 vector
+ stream.writeInt(1);
+ writeCHARSXP((String) obj);
+ } else {
+ outStringVec((RAbstractStringVector) obj, true);
+ }
+ break;
+ }
- case INTSXP: {
- if (obj instanceof Integer) {
- stream.writeInt(1);
- stream.writeInt((int) obj);
- } else {
- RAbstractIntVector vec = (RAbstractIntVector) obj;
- stream.writeInt(vec.getLength());
- for (int i = 0; i < vec.getLength(); i++) {
- stream.writeInt(vec.getDataAt(i));
+ case INTSXP: {
+ if (obj instanceof Integer) {
+ stream.writeInt(1);
+ stream.writeInt((int) obj);
+ } else {
+ RAbstractIntVector vec = (RAbstractIntVector) obj;
+ stream.writeInt(vec.getLength());
+ for (int i = 0; i < vec.getLength(); i++) {
+ stream.writeInt(vec.getDataAt(i));
+ }
}
+ break;
}
- break;
- }
- case REALSXP: {
- if (obj instanceof Double) {
- stream.writeInt(1);
- stream.writeDouble((double) obj);
- } else {
- RAbstractDoubleVector vec = (RAbstractDoubleVector) obj;
- stream.writeInt(vec.getLength());
- for (int i = 0; i < vec.getLength(); i++) {
- stream.writeDouble(vec.getDataAt(i));
+ case REALSXP: {
+ if (obj instanceof Double) {
+ stream.writeInt(1);
+ stream.writeDouble((double) obj);
+ } else {
+ RAbstractDoubleVector vec = (RAbstractDoubleVector) obj;
+ stream.writeInt(vec.getLength());
+ for (int i = 0; i < vec.getLength(); i++) {
+ stream.writeDouble(vec.getDataAt(i));
+ }
}
+ break;
}
- break;
- }
- case LGLSXP: {
- // Output as ints
- if (obj instanceof Byte) {
- stream.writeInt(1);
- stream.writeInt(RRuntime.logical2int((byte) obj));
- } else {
- RAbstractLogicalVector vec = (RAbstractLogicalVector) obj;
+ case LGLSXP: {
+ // Output as ints
+ if (obj instanceof Byte) {
+ stream.writeInt(1);
+ stream.writeInt(RRuntime.logical2int((byte) obj));
+ } else {
+ RAbstractLogicalVector vec = (RAbstractLogicalVector) obj;
+ stream.writeInt(vec.getLength());
+ for (int i = 0; i < vec.getLength(); i++) {
+ stream.writeInt(RRuntime.logical2int(vec.getDataAt(i)));
+ }
+ }
+ break;
+ }
+
+ case CPLXSXP: {
+ RAbstractComplexVector vec = (RAbstractComplexVector) obj;
stream.writeInt(vec.getLength());
for (int i = 0; i < vec.getLength(); i++) {
- stream.writeInt(RRuntime.logical2int(vec.getDataAt(i)));
+ RComplex val = vec.getDataAt(i);
+ if (RRuntime.isNA(val)) {
+ stream.writeDouble(RRuntime.DOUBLE_NA);
+ stream.writeDouble(RRuntime.DOUBLE_NA);
+ } else {
+ stream.writeDouble(val.getRealPart());
+ stream.writeDouble(val.getImaginaryPart());
+ }
}
+ break;
}
- break;
- }
- case CPLXSXP: {
- RAbstractComplexVector vec = (RAbstractComplexVector) obj;
- stream.writeInt(vec.getLength());
- for (int i = 0; i < vec.getLength(); i++) {
- RComplex val = vec.getDataAt(i);
- if (RRuntime.isNA(val)) {
- stream.writeDouble(RRuntime.DOUBLE_NA);
- stream.writeDouble(RRuntime.DOUBLE_NA);
+ case EXPRSXP:
+ case VECSXP: {
+ RAbstractVector list;
+ if (type == SEXPTYPE.EXPRSXP) {
+ list = (RExpression) obj;
} else {
- stream.writeDouble(val.getRealPart());
- stream.writeDouble(val.getImaginaryPart());
+ list = (RList) obj;
}
+ stream.writeInt(list.getLength());
+ for (int i = 0; i < list.getLength(); i++) {
+ Object listObj = list.getDataAtAsObject(i);
+ writeItem(listObj);
+ }
+ break;
}
- break;
- }
- case EXPRSXP:
- case VECSXP: {
- RAbstractVector list;
- if (type == SEXPTYPE.EXPRSXP) {
- list = (RExpression) obj;
- } else {
- list = (RList) obj;
- }
- stream.writeInt(list.getLength());
- for (int i = 0; i < list.getLength(); i++) {
- Object listObj = list.getDataAtAsObject(i);
- writeItem(listObj);
+ case RAWSXP: {
+ RRawVector raw = (RRawVector) obj;
+ byte[] data = raw.getDataWithoutCopying();
+ stream.writeInt(data.length);
+ stream.writeRaw(data);
+ break;
}
- break;
- }
- case RAWSXP: {
- RRawVector raw = (RRawVector) obj;
- byte[] data = raw.getDataWithoutCopying();
- stream.writeInt(data.length);
- stream.writeRaw(data);
- break;
- }
-
- case EXTPTRSXP: {
- addReadRef(obj);
- RExternalPtr xptr = (RExternalPtr) obj;
- writeItem(xptr.getProt());
- writeItem(xptr.getTag());
- break;
- }
-
- case S4SXP: {
- break;
- }
-
- /*
- * The objects that GnuR represents as a pairlist. To avoid stack overflow,
- * these utilize manual tail recursion on the cdr of the
- * pairlist.closePairList
- */
-
- case FUNSXP:
- case PROMSXP:
- case LANGSXP:
- case LISTSXP:
- case DOTSXP: {
- if (type == SEXPTYPE.FUNSXP && gnuRType == SEXPTYPE.BUILTINSXP) {
- // special case
- RFunction fun = (RFunction) obj;
- String name = fun.getRBuiltin().getName();
- stream.writeString(name);
+ case EXTPTRSXP: {
+ addReadRef(obj);
+ RExternalPtr xptr = (RExternalPtr) obj;
+ writeItem(xptr.getProt());
+ writeItem(xptr.getTag());
break;
}
- if (type == SEXPTYPE.FUNSXP) {
- RFunction fun = (RFunction) obj;
- RSyntaxFunction body = (RSyntaxFunction) fun.getRootNode();
- ss = body.getLazySourceSection();
- }
- tailCall = true;
- // attributes written first to avoid recursion on cdr
- writeAttributes(attributes, ss);
- if (attributes != null) {
- attributes = null;
- }
- if (ss != null) {
- ss = null;
+ case S4SXP: {
+ break;
}
- switch (type) {
- case FUNSXP: {
+ /*
+ * The objects that GnuR represents as a pairlist. To avoid stack
+ * overflow, these utilize manual tail recursion on the cdr of the
+ * pairlist.closePairList
+ */
+
+ case FUNSXP:
+ case PROMSXP:
+ case LANGSXP:
+ case LISTSXP:
+ case DOTSXP: {
+ if (type == SEXPTYPE.FUNSXP && gnuRType == SEXPTYPE.BUILTINSXP) {
+ // special case
RFunction fun = (RFunction) obj;
- RPairList pl = (RPairList) serializeLanguageObject(state, fun);
- assert pl != null;
- state.convertUnboundValues(pl);
- if (FastROptions.debugMatches("printWclosure")) {
- Debug.printClosure(pl);
- }
- writeItem(pl.getTag());
- writeItem(pl.car());
- obj = pl.cdr();
+ String name = fun.getRBuiltin().getName();
+ stream.writeString(name);
break;
}
+ if (type == SEXPTYPE.FUNSXP) {
+ RFunction fun = (RFunction) obj;
+ RSyntaxFunction body = (RSyntaxFunction) fun.getRootNode();
+ ss = body.getLazySourceSection();
+ }
+ tailCall = true;
- case PROMSXP: {
- RPairList pl = (RPairList) serializeLanguageObject(state, obj);
- assert pl != null;
- state.convertUnboundValues(pl);
- if (pl.getTag() != RNull.instance) {
- writeItem(pl.getTag());
- }
- writeItem(pl.car());
- obj = pl.cdr();
- break;
+ // attributes written first to avoid recursion on cdr
+ writeAttributes(attributes, ss);
+ if (attributes != null) {
+ attributes = null;
+ }
+ if (ss != null) {
+ ss = null;
}
- case LISTSXP: {
- RPairList pl = (RPairList) obj;
- if (!pl.isNullTag()) {
+ switch (type) {
+ case FUNSXP: {
+ RFunction fun = (RFunction) obj;
+ RPairList pl = (RPairList) serializeLanguageObject(state, fun);
+ assert pl != null;
+ state.convertUnboundValues(pl);
+ if (FastROptions.debugMatches("printWclosure")) {
+ Debug.printClosure(pl);
+ }
writeItem(pl.getTag());
+ writeItem(pl.car());
+ obj = pl.cdr();
+ break;
}
- writeItem(pl.car());
- obj = pl.cdr();
- break;
- }
- case LANGSXP: {
- RPairList pl = (RPairList) serializeLanguageObject(state, obj);
- state.convertUnboundValues(pl);
- writeItem(pl.car());
- obj = pl.cdr();
- break;
- }
+ case PROMSXP: {
+ RPairList pl = (RPairList) serializeLanguageObject(state, obj);
+ assert pl != null;
+ state.convertUnboundValues(pl);
+ if (pl.getTag() != RNull.instance) {
+ writeItem(pl.getTag());
+ }
+ writeItem(pl.car());
+ obj = pl.cdr();
+ break;
+ }
- case DOTSXP: {
- // This in GnuR is a pairlist
- RArgsValuesAndNames rvn = (RArgsValuesAndNames) obj;
- Object list = RNull.instance;
- for (int i = rvn.getLength() - 1; i >= 0; i--) {
- String name = rvn.getSignature().getName(i);
- list = RDataFactory.createPairList(rvn.getArgument(i), list, name == null ? RNull.instance : RDataFactory.createSymbolInterned(name));
+ case LISTSXP: {
+ RPairList pl = (RPairList) obj;
+ if (!pl.isNullTag()) {
+ writeItem(pl.getTag());
+ }
+ writeItem(pl.car());
+ obj = pl.cdr();
+ break;
}
- RPairList pl = (RPairList) list;
- if (!pl.isNullTag()) {
- writeItem(pl.getTag());
+
+ case LANGSXP: {
+ RPairList pl = (RPairList) serializeLanguageObject(state, obj);
+ state.convertUnboundValues(pl);
+ writeItem(pl.car());
+ obj = pl.cdr();
+ break;
+ }
+
+ case DOTSXP: {
+ // This in GnuR is a pairlist
+ RArgsValuesAndNames rvn = (RArgsValuesAndNames) obj;
+ Object list = RNull.instance;
+ for (int i = rvn.getLength() - 1; i >= 0; i--) {
+ String name = rvn.getSignature().getName(i);
+ list = RDataFactory.createPairList(rvn.getArgument(i), list, name == null ? RNull.instance : RDataFactory.createSymbolInterned(name));
+ }
+ RPairList pl = (RPairList) list;
+ if (!pl.isNullTag()) {
+ writeItem(pl.getTag());
+ }
+ writeItem(pl.car());
+ obj = pl.cdr();
+ break;
}
- writeItem(pl.car());
- obj = pl.cdr();
- break;
}
+ break;
}
- break;
+
+ default:
+ throw RInternalError.unimplemented(type.name());
}
- default:
- throw RInternalError.unimplemented(type.name());
+ writeAttributes(attributes, ss);
}
-
- writeAttributes(attributes, ss);
}
} while (tailCall);
}
@@ -1778,6 +1781,13 @@ public class RSerialize {
}
private void writeAttributes(DynamicObject attributes, SourceSection ss) throws IOException {
+ if (ss != null && ss != RSyntaxNode.LAZY_DEPARSE) {
+ String path = ss.getSource().getURI().getPath();
+ REnvironment createSrcfile = RSrcref.createSrcfile(path);
+ Object createLloc = RSrcref.createLloc(ss);
+ writePairListEntry(RRuntime.R_SRCREF, createLloc);
+ writePairListEntry(RRuntime.R_SRCFILE, createSrcfile);
+ }
if (attributes != null) {
// have to convert to GnuR pairlist
Iterator<RAttributesLayout.RAttribute> iter = RAttributesLayout.asIterable(attributes).iterator();
@@ -1789,14 +1799,7 @@ public class RSerialize {
writePairListEntry(attr.getName(), attr.getValue());
}
}
- if (ss != null && ss != RSyntaxNode.LAZY_DEPARSE) {
- String path = ss.getSource().getURI().getPath();
- REnvironment createSrcfile = RSrcref.createSrcfile(path);
- RIntVector createLloc = RSrcref.createLloc(ss, createSrcfile);
- writePairListEntry(RRuntime.R_SRCREF, createLloc);
- writePairListEntry(RRuntime.R_SRCFILE, createSrcfile);
- }
- if (attributes != null || ss != null) {
+ if (attributes != null || ss != null && ss != RSyntaxNode.LAZY_DEPARSE) {
terminatePairList();
}
}
@@ -2415,6 +2418,21 @@ public class RSerialize {
return state.closePairList();
}
+ private static Object extractFromList(Object tag, SEXPTYPE expectedType) {
+ SEXPTYPE type = SEXPTYPE.typeForClass(tag.getClass());
+ if (type == expectedType) {
+ return tag;
+ } else if (type == SEXPTYPE.LISTSXP) {
+ for (RPairList item : (RPairList) tag) {
+ Object data = item.car();
+ if (SEXPTYPE.typeForClass(data.getClass()) == expectedType) {
+ return data;
+ }
+ }
+ }
+ return null;
+ }
+
/**
* A collection of static functions that will transform a pairlist into an AST using the
* {@link RCodeBuilder}.
@@ -2422,9 +2440,10 @@ public class RSerialize {
private static final class PairlistDeserializer {
public static RFunction processFunction(Object car, Object cdr, Object tag, String functionName, String packageName) {
- // car == arguments, cdr == body, tag == environment
+ // car == arguments, cdr == body, tag == PairList(attributes, environment)
REnvironment environment = (REnvironment) tag;
+
MaterializedFrame enclosingFrame = environment.getFrame();
RootCallTarget callTarget = RContext.getASTBuilder().rootFunction(RSyntaxNode.LAZY_DEPARSE, processArguments(car), processBody(cdr), functionName);
--
GitLab