diff --git a/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE b/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
index 211930545bace09e2c5139710351e1ef30a7c35c..a48008ffacf3c83dd02cbbc40af647daae1213c5 100644
--- a/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
+++ b/com.oracle.truffle.r.pkgs/refcmp/NAMESPACE
@@ -4,3 +4,4 @@ export(snapshot)
export(snapshot.init)
export(snapshot_id)
export(snapshot.show)
+export(snapshot.named)
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/actParsToList.R b/com.oracle.truffle.r.pkgs/refcmp/R/actParsToList.R
new file mode 100644
index 0000000000000000000000000000000000000000..d08ef9546cd4977facfd38ef4cd1e2a0f5537779
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/actParsToList.R
@@ -0,0 +1,15 @@
+actParsToList <-
+function (pars, env) {
+ l <- list()
+ for (i in seq_along(pars)) {
+ strrep <- as.character(pars[[i]])
+ if (is.symbol(pars[[i]])) {
+ value <- eval(pars[[i]], envir = env)
+ l[[strrep]] <- value
+ }
+ else {
+ warning(paste0("Skipping '", strrep, "' because only symbols are allowed"))
+ }
+ }
+ l
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R b/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R
deleted file mode 100644
index fc88e77f79c11d136ff82f20375a206120ef254d..0000000000000000000000000000000000000000
--- a/com.oracle.truffle.r.pkgs/refcmp/R/refcmp.R
+++ /dev/null
@@ -1,119 +0,0 @@
-##
- # Copyright (c) 2017, Oracle and/or its affiliates. All rights reserved.
- # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
- #
- # This code is free software; you can redistribute it and/or modify it
- # under the terms of the GNU General Public License version 2 only, as
- # published by the Free Software Foundation.
- #
- # This code is distributed in the hope that it will be useful, but WITHOUT
- # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
- # version 2 for more details (a copy is included in the LICENSE file that
- # accompanied this code).
- #
- # You should have received a copy of the GNU General Public License version
- # 2 along with this work; if not, write to the Free Software Foundation,
- # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
- #
- # Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
- # or visit www.oracle.com if you need additional information or have any
- # questions.
-##
-
-refcmpEnv <- new.env(parent = emptyenv())
-refcmpEnv$snapshot_dir <- 'snapshots'
-refcmpEnv$snapshot_id <- 0L
-
-snapshot.isFastR <- function() {
- length(grep('FastR', R.Version()$version.string)) != 0
-}
-refcmpEnv$isReferenceRun <- function() !snapshot.isFastR()
-
-snapshot.init <- function(dir) {
- if(!missing(dir)) {
- refcmpEnv$snaphost_dir <- dir
- }
- refcmpEnv$snapshot_id <- 0
-}
-
-snapshot <- function(...) {
- # the actual parameter expessions
- actParExprs <- as.list(match.call()[-1])
- valueList <- actParsToList(actParExprs, parent.frame())
- try({
- snapshot_id(refcmpEnv$snapshot_id, valueList)
- refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1
- })
-}
-
-snapshot_id <- function(id, valueList, env = parent.frame()) {
- if(refcmpEnv$isReferenceRun()) {
- snapshot.record(id, valueList)
- } else {
- snapshot.check(id, valueList)
- }
-}
-
-snapshot.record <- function(id, valueList) {
- dumpDir <- file.path(refcmpEnv$snapshot_dir)
- if(!dir.exists(dumpDir)) {
- dir.create(dumpDir)
- }
- fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj")))
- saveRDS(valueList, file=fcon)
- close(fcon)
-}
-
-snapshot.check <- function(id, valueList) {
- fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj")))
- restoredVars <- readRDS(file=fcon)
- close(fcon)
-
- if(length(restoredVars) < length(vars)) {
- stop(paste("recorded snapshot has", length(restoredVars), "recorded variables but expected", length(vars)))
- }
-
- var_names <- names(vars)
- restored_names <- names(restoredVars)
- for(i in seq_along(var_names)) {
- if(var_names[[i]] %in% restored_names) {
- actualVal <- vars[[var_names[[i]]]]
- expectedVal <- restoredVars[[var_names[[i]]]]
- if(!identical(expectedVal, actualVal)) {
- stop(paste0("Value of variable '", var_names[[i]], "' differs. Expected ", expectedVal, " but was ", actualVal))
- }
- } else {
- stop(paste0("Missing variable '", var_names[[i]], "' in recorded variables"))
- }
- }
-}
-
-snapshot.show <- function(id = refcmpEnv$snapshot_id) {
- snapshot_filename <- file.path(refcmpEnv$snapshot_dir, paste0("snapshot", id, ".obj"))
- if(!file.exists(snapshot_filename)) {
- stop(paste0("Snapshot with ID=", id, " does not exist"))
- }
- fcon <- file(snapshot_filename)
- restoredVars <- readRDS(file=fcon)
- close(fcon)
-
- return (restoredVars)
-}
-
-actParsToList <- function(pars, env) {
- l <- list()
- for(i in seq_along(pars)) {
- strrep <- as.character(pars[[i]])
- if (is.symbol(pars[[i]])) {
- value <- eval(pars[[i]], envir=env)
- # cat(i, ": ", strrep, " = ", value, "\n")
- l[[strrep]] <- value
- } else {
- warning(paste0("Skipping '", strrep, "' because only symbols are allowed"))
- }
- }
- l
-}
-
-
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.R
new file mode 100644
index 0000000000000000000000000000000000000000..495f770334182ff17ce68f57d31c4cd0815f76d4
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.R
@@ -0,0 +1,9 @@
+snapshot <-
+function (...) {
+ actParExprs <- as.list(match.call()[-1])
+ valueList <- actParsToList(actParExprs, parent.frame())
+ try({
+ snapshot.id(refcmpEnv$snapshot_id, valueList)
+ })
+ refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.check.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.check.R
new file mode 100644
index 0000000000000000000000000000000000000000..493b6089d4f30ff694b8d02d1609940d6a70d6b4
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.check.R
@@ -0,0 +1,28 @@
+snapshot.check <-
+function (id, valueList) {
+ fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot",
+ id, ".obj")))
+ restoredVars <- readRDS(file = fcon)
+ close(fcon)
+ if (length(restoredVars) < length(valueList)) {
+ stop(paste("recorded snapshot has", length(restoredVars),
+ "recorded variables but expected", length(valueList)))
+ }
+ var_names <- names(valueList)
+ restored_names <- names(restoredVars)
+ for (i in seq_along(var_names)) {
+ if (var_names[[i]] %in% restored_names) {
+ actualVal <- valueList[[var_names[[i]]]]
+ expectedVal <- restoredVars[[var_names[[i]]]]
+ if (!refcmpEnv$equals(expectedVal, actualVal)) {
+ stop(paste0("Value of variable '", var_names[[
+ i]], "' differs. Expected ", expectedVal, " but was ",
+ actualVal))
+ }
+ }
+ else {
+ stop(paste0("Missing variable '", var_names[[i]],
+ "' in recorded variables"))
+ }
+ }
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.id.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.id.R
new file mode 100644
index 0000000000000000000000000000000000000000..02db534a33c71ec1d22367beb96c35b00762d2f8
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.id.R
@@ -0,0 +1,9 @@
+snapshot.id <-
+function (id, valueList, env = parent.frame()) {
+ if (refcmpEnv$isReferenceRun()) {
+ snapshot.record(id, valueList)
+ }
+ else {
+ snapshot.check(id, valueList)
+ }
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.init.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.init.R
new file mode 100644
index 0000000000000000000000000000000000000000..75ecb489799c598fa067d12fb3688b1abc0c3129
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.init.R
@@ -0,0 +1,13 @@
+snapshot.init <-
+function (dir, referenceRunPredicate, equalityFunction) {
+ if (!missing(dir)) {
+ refcmpEnv$snaphost_dir <- dir
+ }
+ if (!missing(referenceRunPredicate)) {
+ refcmpEnv$isReferenceRun <- referenceRunPredicate
+ }
+ if (!missing(equalityFunction)) {
+ refcmpEnv$equals <- equalityFunction
+ }
+ refcmpEnv$snapshot_id <- 0
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.isFastR.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.isFastR.R
new file mode 100644
index 0000000000000000000000000000000000000000..dcdb7eb18a52a236fe0b327ff1cff11fe20eaae9
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.isFastR.R
@@ -0,0 +1,4 @@
+snapshot.isFastR <-
+function () {
+ length(grep("FastR", R.Version()$version.string)) != 0
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.named.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.named.R
new file mode 100644
index 0000000000000000000000000000000000000000..4706fed2b9a6636295d6f99674d5b1217509d1c4
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.named.R
@@ -0,0 +1,9 @@
+snapshot.named <-
+function (...) {
+ args <- list(...)
+ valueList <- args[names(args) != ""]
+ try({
+ snapshot.id(refcmpEnv$snapshot_id, valueList)
+ refcmpEnv$snapshot_id <- refcmpEnv$snapshot_id + 1
+ })
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.record.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.record.R
new file mode 100644
index 0000000000000000000000000000000000000000..c108c9d8270bd7ba0fa656b7352b54eb05cb1420
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.record.R
@@ -0,0 +1,11 @@
+snapshot.record <-
+function (id, valueList) {
+ dumpDir <- file.path(refcmpEnv$snapshot_dir)
+ if (!dir.exists(dumpDir)) {
+ dir.create(dumpDir)
+ }
+ fcon <- file(file.path(refcmpEnv$snapshot_dir, paste0("snapshot",
+ id, ".obj")))
+ saveRDS(valueList, file = fcon)
+ close(fcon)
+}
diff --git a/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.show.R b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.show.R
new file mode 100644
index 0000000000000000000000000000000000000000..82805dc2d2de06914f1ffe9daa40354719ce0016
--- /dev/null
+++ b/com.oracle.truffle.r.pkgs/refcmp/R/snapshot.show.R
@@ -0,0 +1,12 @@
+snapshot.show <-
+function (id = refcmpEnv$snapshot_id) {
+ snapshot_filename <- file.path(refcmpEnv$snapshot_dir, paste0(
+ "snapshot", id, ".obj"))
+ if (!file.exists(snapshot_filename)) {
+ stop(paste0("Snapshot with ID=", id, " does not exist"))
+ }
+ fcon <- file(snapshot_filename)
+ restoredVars <- readRDS(file = fcon)
+ close(fcon)
+ return(restoredVars)
+}