diff --git a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/RRuntimeASTAccessImpl.java b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/RRuntimeASTAccessImpl.java
index 0727968f1c6d6eebc176930a48abba8e4ea1d66c..9fa877816e429b2dc84e80f0f560d7bdbc540dea 100644
--- a/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/RRuntimeASTAccessImpl.java
+++ b/com.oracle.truffle.r.engine/src/com/oracle/truffle/r/engine/RRuntimeASTAccessImpl.java
@@ -64,6 +64,8 @@ import com.oracle.truffle.r.runtime.Utils;
import com.oracle.truffle.r.runtime.context.Engine;
import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
+import com.oracle.truffle.r.runtime.data.RAttributable;
+import com.oracle.truffle.r.runtime.data.RAttributes;
import com.oracle.truffle.r.runtime.data.RDataFactory;
import com.oracle.truffle.r.runtime.data.RFunction;
import com.oracle.truffle.r.runtime.data.RLanguage;
@@ -244,7 +246,7 @@ class RRuntimeASTAccessImpl implements RRuntimeASTAccess {
sigNames[i - 1] = formal != null && formal.length() > 0 ? formal : null;
}
RLanguage result = RDataFactory.createLanguage(RASTUtils.createCall(fn, false, ArgumentsSignature.get(sigNames), arguments).asRNode());
- return result;
+ return addAttributes(result, list);
} else if (repType == RLanguage.RepType.FUNCTION) {
RList argsList = (RList) list.getDataAt(1);
RSyntaxNode body = (RSyntaxNode) unwrapToRNode(list.getDataAt(2));
@@ -259,12 +261,20 @@ class RRuntimeASTAccessImpl implements RRuntimeASTAccess {
RootCallTarget rootCallTarget = new RASTBuilder().rootFunction(RSyntaxNode.LAZY_DEPARSE, resArgs, body, null);
FunctionExpressionNode fnExprNode = FunctionExpressionNode.create(RSyntaxNode.LAZY_DEPARSE, rootCallTarget);
RLanguage result = RDataFactory.createLanguage(fnExprNode);
- return result;
+ return addAttributes(result, list);
} else {
throw RInternalError.shouldNotReachHere("unexpected type");
}
}
+ private static Object addAttributes(RAttributable result, RList list) {
+ RAttributes attrs = list.getAttributes();
+ if (attrs != null && !attrs.isEmpty()) {
+ result.initAttributes(attrs.copy());
+ }
+ return result;
+ }
+
private static RNode unwrapToRNode(Object objArg) {
Object obj = objArg;
// obj is RSymbol or a primitive value.
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
index f4544c4bb9c806ba2997506d0f8696e36a8b43e5..e0ebabafddce019be410544ca68bb4ccc6a5cf70 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
+++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
@@ -20,6 +20,8 @@
# The structure of the implementation somewhat reflects GnuR so that
# it is easier to update this code, should the code in GnuR be changed.
#
+# Please run tests in modelTests.R when updating this file!
+#
# ================================================================
# R reimplementations of C utility functions
@@ -128,7 +130,10 @@ InstallVar <- function(var) {
return(index)
}
}
- varlist <<- c(varlist, var)
+
+ # as.list is necessary here until FastR is fixed not to
+ # cast c(symbol, language) to expressions, we need a list
+ varlist <<- as.list(c(varlist, var))
return(index + 1L)
}
@@ -143,13 +148,11 @@ ExtractVars <- function (formula, checkonly=FALSE) {
v <- NULL
if (is.symbol(formula)) {
- haveDot <- identical(formula, quote(`.`))
+ haveDot <<- identical(formula, quote(`.`))
if (!checkonly) {
if (identical(formula, quote(`.`)) && !is.null(framenames)) {
for (framename in framenames) {
- if (!MatchVar(framename, varlist)) {
- InstallVar(framename)
- }
+ InstallVar(as.symbol(framename))
}
} else {
InstallVar(formula)
@@ -215,16 +218,9 @@ CheckRHS <- function (v) {
for (e in v) {
CheckRHS(e)
}
- }
- if (is.symbol(v)) {
- for (i in seq_along(framenames)) {
- framename <- framenames[[i]];
- # TODO is this check good enough?
- # its a raw check in GNUR
- if (identical(framename, v)) {
- framenames <<- framenames[[-i]]
- }
- }
+ } else if (is.symbol(v)) {
+ vchar <- deparse(v)
+ framenames <<- framenames[framenames != vchar]
}
}
AllocTerm <- function() {
@@ -403,7 +399,25 @@ EncodeVars <- function(formula) {
return(NULL)
} else if (is.symbol(formula)) {
if (identical(formula, quote(`.`)) && !is.null(framenames)) {
- error("termsform: not implemented when formula='.' and there are framenames")
+ if (length(framenames) == 0L) {
+ return(NULL)
+ }
+ result <- vector("list", length(framenames))
+ for (i in 1:length(framenames)) {
+ name <- framenames[[i]]
+ if (i > 1) {
+ for (j in 1:(i-1)) {
+ if (name == framenames[[j]]) {
+ error(paste0("duplicated name '", name, "' in data frame using '.'"))
+ }
+ }
+ }
+ idx <- InstallVar(as.symbol(name))
+ term <- AllocTerm();
+ term[[idx]] <- TRUE
+ result[[i]] <- term
+ }
+ return(result);
} else {
term <- AllocTerm()
term[[InstallVar(formula)]] <- TRUE
@@ -479,6 +493,22 @@ TermCode <- function(formula, callIdx, varIndex) {
return(2L);
}
+# gets the formula as parameter and returns the same formula, where
+# dot symbol is replaced with (a+b+c+...) where a,b,c.. are framenames.
+ExpandDots <- function(x) {
+ if (is.symbol(x)) {
+ if (identical(x, quote(`.`))) {
+ return(parse(text=paste(framenames, collapse="+"))[[1]])
+ }
+ return(x)
+ }
+
+ for (i in seq_along(x)) {
+ x[[i]] <- ExpandDots(x[[i]]);
+ }
+ x
+}
+
# PUBLIC: termsform
#
@@ -546,12 +576,10 @@ termsform <- function (x, specials, data, keep.order, allowDotAsName) {
attr(x, "variables") <- vars
# Note: GnuR uses bitvector of integers and variable nwords to denote its size, we do not need that
- # EncodeVars may have stretched varlist becuase it is a global variable (to reflect GnuR's implementation)
nvar <<- length(varlist)
-
formula <- EncodeVars(x)
- # EncodeVars may have stretched the varlist global variable
+ # EncodeVars may have stretched varlist becuase it is a global variable (to reflect GnuR's implementation)
nvar <<- length(varlist)
# Step 2a: Compute variable names
@@ -560,12 +588,13 @@ termsform <- function (x, specials, data, keep.order, allowDotAsName) {
# Step 2b: Find and remove any offset(s)
# first see if any of the variables are offsets
- k <- sum(substr(varnames, 0, 7) == "offset(")
- if (k > 0L) {
- offsets <- integer(k)
- # TODO remove the offset terms from the formula
- error("termsform: not implemented - remove the offset terms from formula")
- attr(x, "offset") <- offsets
+ offsets <- substr(varnames, 0, 7) == "offset("
+ if (any(offsets)) {
+ indices <- which(offsets)
+ attr(x, "offset") <- indices
+ # remove the offset terms from the formula, that is terms that contain one of the offset vars
+ keepIndices = vapply(formula, function(f) !any(f[indices]), FALSE)
+ formula <- formula[which(keepIndices)]
}
nterm <<- length(formula);
@@ -579,7 +608,7 @@ termsform <- function (x, specials, data, keep.order, allowDotAsName) {
ord <- sCounts;
} else {
pattern <- formula # save original formula
- callIdx <- 1L # on the top of the two loop below, we iterate through formula. In GnuR this is done with CDR
+ callIdx <- 1L
ord <- integer(nterm)
for (i in 0:bitmax) {
for (n in 1:nterm) {
@@ -622,15 +651,22 @@ termsform <- function (x, specials, data, keep.order, allowDotAsName) {
attr(x, "factors") <- pattern
if (!is.null(specials)) {
- # TODO -- if there are specials stick them in here
- error("termsform: not implemented when !is.null(specials)")
+ specialsAttr <- vector("pairlist", length(specials))
+ names(specialsAttr) <- specials
+ for (i in 1:length(specials)) {
+ s <- specials[[i]]
+ indices <- substring(varnames, 0, nchar(s) + 1) == paste0(s, '(');
+ if (any(indices)) {
+ specialsAttr[[i]] <- which(indices);
+ }
+ }
+ attr(x, 'specials') <- specialsAttr
}
# Step 6: Fix up the formula by substituting for dot, which should be
# the framenames joined by +
if (haveDot) {
- # TODO
- error("termsform: not implemented when haveDot")
+ x <- ExpandDots(x)
}
attr(x, "order") <- ord
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/UpdateNames.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/UpdateNames.java
index d6946e21ab8292c4de09326bff5901cafe4a94a5..d192337e3792cb3a2d984f9081c02eaf12713e9d 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/UpdateNames.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/UpdateNames.java
@@ -31,6 +31,8 @@ import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
import com.oracle.truffle.r.nodes.unary.CastStringNode;
import com.oracle.truffle.r.nodes.unary.CastStringNodeGen;
import com.oracle.truffle.r.runtime.RBuiltin;
+import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RError.Message;
import com.oracle.truffle.r.runtime.data.RDataFactory;
import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RStringVector;
@@ -71,6 +73,8 @@ public abstract class UpdateNames extends RBuiltinNode {
RAbstractContainer result = (RAbstractContainer) container.getNonShared();
if (stringVector.getLength() < result.getLength()) {
stringVector = stringVector.copyResized(result.getLength(), true);
+ } else if (stringVector.getLength() > result.getLength()) {
+ throw RError.error(this, Message.NAMES_LONGER, stringVector.getLength(), result.getLength());
} else if (stringVector == container) {
stringVector = (RStringVector) stringVector.copy();
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Vector.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Vector.java
index e8e0fa598c1fb7e9b2e142a17dfcd551a3b1dd7c..6d314f2c96ab4922cae488b2172ca3cfe206a09f 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Vector.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Vector.java
@@ -34,7 +34,7 @@ import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
import com.oracle.truffle.r.runtime.RBuiltin;
import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RType;
-import com.oracle.truffle.r.runtime.data.model.RAbstractVector;
+import com.oracle.truffle.r.runtime.data.RDataFactory;
@RBuiltin(name = "vector", kind = INTERNAL, parameterNames = {"mode", "length"})
public abstract class Vector extends RBuiltinNode {
@@ -50,7 +50,7 @@ public abstract class Vector extends RBuiltinNode {
protected RType modeToType(String mode) {
RType type = typeFromMode.execute(mode);
- if (!type.isVector()) {
+ if (type != RType.PairList && !type.isVector()) {
throw RError.error(this, RError.Message.CANNOT_MAKE_VECTOR_OF_MODE, mode);
}
return type;
@@ -58,13 +58,23 @@ public abstract class Vector extends RBuiltinNode {
@SuppressWarnings("unused")
@Specialization(guards = {"mode == cachedMode"}, limit = CACHED_MODES_LIMIT)
- RAbstractVector vectorCached(String mode, int length, @Cached("mode") String cachedMode, @Cached("modeToType(mode)") RType type) {
- return type.create(length, false);
+ Object vectorCached(String mode, int length, @Cached("mode") String cachedMode, @Cached("modeToType(mode)") RType type) {
+ return createType(type, length);
}
@Specialization(contains = "vectorCached")
@TruffleBoundary
- protected RAbstractVector vector(String mode, int length) {
- return modeToType(mode).create(length, false);
+ protected Object vector(String mode, int length) {
+ return createType(modeToType(mode), length);
+ }
+
+ // Note: we have to handle RPairList separately. In other circumstances it is not seen as a
+ // vector, e.g. is.vector(vector('pairlist',1)) is FALSE, so we cannot just turn it into
+ // RAbstractVector. Note2: pair list of size == 0 is RNull -> we have to return Object.
+ private static Object createType(RType type, int length) {
+ if (type == RType.PairList) {
+ return RDataFactory.createPairList(length);
+ }
+ return type.create(length, false);
}
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedReplaceVectorNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedReplaceVectorNode.java
index eaf18d8190e12304201d808d12206aa25a2efd3d..05330a7916efeaf31dc4e8eb49873fa2861afb3d 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedReplaceVectorNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedReplaceVectorNode.java
@@ -42,6 +42,7 @@ import com.oracle.truffle.r.runtime.RError.Message;
import com.oracle.truffle.r.runtime.RType;
import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.RAttributeProfiles;
+import com.oracle.truffle.r.runtime.data.RAttributes;
import com.oracle.truffle.r.runtime.data.RDataFactory;
import com.oracle.truffle.r.runtime.data.RExpression;
import com.oracle.truffle.r.runtime.data.RLanguage;
@@ -77,6 +78,7 @@ final class CachedReplaceVectorNode extends CachedVectorNode {
private final ConditionProfile valueIsNA = ConditionProfile.createBinaryProfile();
private final BranchProfile resizeProfile = BranchProfile.create();
private final BranchProfile sharedProfile = BranchProfile.create();
+ private final ConditionProfile rlanguageAttributesProfile = ConditionProfile.createBinaryProfile();
private final ConditionProfile valueLengthOneProfile = ConditionProfile.createBinaryProfile();
private final ConditionProfile emptyReplacementProfile = ConditionProfile.createBinaryProfile();
@@ -187,6 +189,10 @@ final class CachedReplaceVectorNode extends CachedVectorNode {
case Language:
repType = RContext.getRRuntimeASTAccess().getRepType((RLanguage) castVector);
vector = RContext.getRRuntimeASTAccess().asList((RLanguage) castVector);
+ RAttributes attrs = ((RLanguage) castVector).getAttributes();
+ if (rlanguageAttributesProfile.profile(attrs != null && !attrs.isEmpty())) {
+ vector.initAttributes(attrs.copy());
+ }
break;
case Expression:
vector = ((RExpression) castVector).getList();
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
index cf51791fc2c4c9b84042df5f92cac319f784155d..7df6df646122ce7708b1d47e5ebf37e5451f7091 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java
@@ -320,6 +320,7 @@ public final class RError extends RuntimeException {
INVALID_UNNAMED_ARGUMENT("invalid argument"),
INVALID_UNNAMED_VALUE("invalid value"),
NAMES_NONVECTOR("names() applied to a non-vector"),
+ NAMES_LONGER("'names' attribute [%d] must be the same length as the vector [%d]"),
ONLY_FIRST_VARIABLE_NAME("only the first element is used as variable name"),
INVALID_FIRST_ARGUMENT("invalid first argument"),
NO_ENCLOSING_ENVIRONMENT("no enclosing environment"),
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalCode.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalCode.java
index a49ae23d32377e6e7cf4a45916e8bda0fa38ea02..c24bbb279baa2771219151833783a6ca05bb8a81 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalCode.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RInternalCode.java
@@ -58,7 +58,7 @@ public final class RInternalCode {
public static Source loadSourceRelativeTo(Class<?> clazz, String fileName) {
URL url = clazz.getResource("/" + clazz.getPackage().getName().replaceAll("\\.", "//") + "/" + fileName);
try {
- return Source.fromURL(url, fileName);
+ return Source.newBuilder(url).name(fileName).internal().build();
} catch (IOException e) {
throw RInternalError.shouldNotReachHere(e, "Internal R script failed to load.");
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
index 626678b772d10f6eef8125b82b1b581cc1e6c585..a50f0f393f346949f4cfa5da26c9dfbf0b8a5d96 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDataFactory.java
@@ -436,6 +436,10 @@ public final class RDataFactory {
return traceDataCreated(new RPromise.PromisedPromise(exprClosure, eagerValue, notChangedNonLocally, targetFrame, feedback));
}
+ public static Object createPairList(int size) {
+ return size == 0 ? RNull.instance : traceDataCreated(RPairList.create(size));
+ }
+
public static RPairList createPairList() {
return traceDataCreated(new RPairList());
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RPairList.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RPairList.java
index bc3fe353635825c7ea4c1a29f1243ce8e3efc234..f9fa07da42f2a84b0d2d7bc09c111a696e59cec3 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RPairList.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RPairList.java
@@ -39,7 +39,7 @@ import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
*
* {@code null} is never allowed as a value for the tag, car or cdr, only the type.
*/
-public class RPairList extends RAttributeStorage implements RAbstractContainer {
+public class RPairList extends RSharingAttributeStorage implements RAbstractContainer {
private Object car = RNull.instance;
private Object cdr = RNull.instance;
/**
@@ -72,6 +72,21 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
this.type = type;
}
+ /**
+ * Creates a new pair list of given size > 0. Note: pair list of size 0 is NULL.
+ */
+ @TruffleBoundary
+ public static Object create(int size) {
+ assert size > 0 : "a pair list of size = 0 does not exist, it should be NULL";
+ RPairList result = new RPairList();
+ for (int i = 1; i < size; i++) {
+ RPairList tmp = result;
+ result = new RPairList();
+ result.cdr = tmp;
+ }
+ return result;
+ }
+
@Override
public RType getRType() {
return RType.PairList;
@@ -110,10 +125,14 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
for (int i = 0; i < len; i++) {
data[i] = plt.car();
if (named) {
- if (plt.isNullTag()) {
+ Object tag = plt.tag;
+ if (isNull(tag)) {
names[i] = RRuntime.NAMES_ATTR_EMPTY_VALUE;
+ } else if (tag instanceof RSymbol) {
+ names[i] = ((RSymbol) tag).getName();
} else {
- names[i] = ((RSymbol) plt.getTag()).getName();
+ names[i] = RRuntime.asString(tag);
+ assert names[i] != null : "unexpected type of tag in RPairList";
}
}
if (i < len - 1) {
@@ -236,7 +255,22 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
}
@Override
- public RVector getNonShared() {
+ public RShareable copy() {
+ RPairList result = new RPairList();
+ Object original = this;
+ while (!isNull(original)) {
+ RPairList origList = (RPairList) original;
+ result.car = origList.car;
+ result.tag = origList.tag;
+ result.cdr = new RPairList();
+ result = (RPairList) result.cdr;
+ original = origList.cdr;
+ }
+ return result;
+ }
+
+ @Override
+ public RShareable deepCopy() {
RInternalError.shouldNotReachHere();
return null;
}
@@ -285,27 +319,32 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
@Override
public void setNames(RStringVector newNames) {
- throw RInternalError.shouldNotReachHere();
+ Object p = this;
+ for (int i = 0; i < newNames.getLength() && !isNull(p); i++) {
+ RPairList pList = (RPairList) p;
+ pList.tag = newNames.getDataAt(i);
+ p = pList.cdr;
+ }
}
@Override
public RList getDimNames(RAttributeProfiles attrProfiles) {
- throw RInternalError.shouldNotReachHere();
+ return null;
}
@Override
public void setDimNames(RList newDimNames) {
- throw RInternalError.shouldNotReachHere();
+ throw RInternalError.unimplemented();
}
@Override
public Object getRowNames(RAttributeProfiles attrProfiles) {
- throw RInternalError.shouldNotReachHere();
+ throw RInternalError.unimplemented();
}
@Override
public void setRowNames(RAbstractVector rowNames) {
- throw RInternalError.shouldNotReachHere();
+ throw RInternalError.unimplemented();
}
@Override
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index dd74b118a4f09e8f68bc4e1d12825eeae1526b69..1b45dc72d1af750e73d4b2b8ec3d1ca16e7b9f98 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
@@ -19207,6 +19207,12 @@ Levels: A B C D E
#tmp <- c(1,8,NA,3); pivot <- c(1,2,4,3); tmp[pivot] <- tmp; tmp
[1] 1 8 3 NA
+##com.oracle.truffle.r.test.builtins.TestBuiltin_extract_replace.replaceInLanguagePreservesAttributes
+#f <- quote(a+b); attr(f, 'mya') <- 42; f[[2]] <- quote(q); f
+q + b
+attr(,"mya")
+[1] 42
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_factor.testFactor
#{ as.logical(factor(c("a", "b", "a"))) }
[1] NA NA NA
@@ -30704,6 +30710,32 @@ NULL
#argv <- list(structure(list(sec = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), min = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), hour = c(20L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 20L, 20L, 20L, 20L, 19L, 19L, 19L, 20L, 20L, 20L, 19L, 20L, 19L, 19L, 19L, 20L), mday = c(30L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 30L, 30L, 30L, 30L, 31L, 31L, 31L, 30L, 30L, 30L, 31L, 30L, 31L, 31L, 31L, 30L), mon = c(5L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 5L, 5L, 5L, 5L, 11L, 11L, 11L, 5L, 5L, 5L, 11L, 5L, 11L, 11L, 11L, 5L), year = c(72L, 72L, 73L, 74L, 75L, 76L, 77L, 78L, 79L, 81L, 82L, 83L, 85L, 87L, 89L, 90L, 92L, 93L, 94L, 95L, 97L, 98L, 105L, 108L, 112L), wday = c(5L, 0L, 1L, 2L, 3L, 5L, 6L, 0L, 1L, 2L, 3L, 4L, 0L, 4L, 0L, 1L, 2L, 3L, 4L, 0L, 1L, 4L, 6L, 3L, 6L), yday = c(181L, 365L, 364L, 364L, 364L, 365L, 364L, 364L, 364L, 180L, 180L, 180L, 180L, 364L, 364L, 364L, 181L, 180L, 180L, 364L, 180L, 364L, 364L, 365L, 181L), isdst = c(1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 1L)), .Names = c('sec', 'min', 'hour', 'mday', 'mon', 'year', 'wday', 'yday', 'isdst'), class = c('POSIXlt', 'POSIXt'), tzone = c('', 'EST', 'EDT')));names(argv[[1]]);
NULL
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesDifferentSize
+#{ l <- list(1,2,3); names(l) <- list('a','b'); l }
+$a
+[1] 1
+
+$b
+[1] 2
+
+$<NA>
+[1] 3
+
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesDifferentSize
+#{ l <- list(1,2,3); names(l) <- list('a','b','c','d'); l }
+Error in names(l) <- list("a", "b", "c", "d") :
+ 'names' attribute [4] must be the same length as the vector [3]
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesPairlist
+#{ l <- vector('pairlist',2); names(l)<-c('a','b'); l; }
+$a
+NULL
+
+$b
+NULL
+
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateNames
#{ x <- 1:2 ; names(x) <- c("hello"); names(x) }
[1] "hello" NA
@@ -51113,6 +51145,22 @@ logical(0)
##com.oracle.truffle.r.test.builtins.TestBuiltin_vector.testVectorConstructor
#{ x<-as.vector(3); y<-vector(length=x) }
+##com.oracle.truffle.r.test.builtins.TestBuiltin_vector.testVectorWithPairlist
+#vector('pairlist', 0)
+NULL
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_vector.testVectorWithPairlist
+#vector('pairlist', 3)
+[[1]]
+NULL
+
+[[2]]
+NULL
+
+[[3]]
+NULL
+
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_vector.testvector1
#argv <- list('integer', 0L); .Internal(vector(argv[[1]], argv[[2]]))
integer(0)
@@ -107352,6 +107400,92 @@ attr(,"assign")
15 2 2 99.190
16 2 2 16.000
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testExpandDostsAndSpecialsTermsform
+#f <- terms.formula(cyl~myfun(mpg)+., specials=c('myfun'), data=mtcars); attrs <- attributes(f); envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
+$.Environment
+<environment: R_GlobalEnv>
+
+$class
+[1] "terms" "formula"
+
+$factors
+ myfun(mpg) mpg disp hp drat wt qsec vs am gear carb
+cyl 0 0 0 0 0 0 0 0 0 0 0
+myfun(mpg) 1 0 0 0 0 0 0 0 0 0 0
+mpg 0 1 0 0 0 0 0 0 0 0 0
+disp 0 0 1 0 0 0 0 0 0 0 0
+hp 0 0 0 1 0 0 0 0 0 0 0
+drat 0 0 0 0 1 0 0 0 0 0 0
+wt 0 0 0 0 0 1 0 0 0 0 0
+qsec 0 0 0 0 0 0 1 0 0 0 0
+vs 0 0 0 0 0 0 0 1 0 0 0
+am 0 0 0 0 0 0 0 0 1 0 0
+gear 0 0 0 0 0 0 0 0 0 1 0
+carb 0 0 0 0 0 0 0 0 0 0 1
+
+$intercept
+[1] 1
+
+$order
+ [1] 1 1 1 1 1 1 1 1 1 1 1
+
+$response
+[1] 1
+
+$specials
+$specials$myfun
+[1] 2
+
+
+$term.labels
+ [1] "myfun(mpg)" "mpg" "disp" "hp" "drat"
+ [6] "wt" "qsec" "vs" "am" "gear"
+[11] "carb"
+
+$variables
+list(cyl, myfun(mpg), mpg, disp, hp, drat, wt, qsec, vs, am,
+ gear, carb)
+
+
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testExpandDostsTermsform
+#f <- terms.formula(cyl~hp*mpg+., data=mtcars); attrs <- attributes(f);envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
+$.Environment
+<environment: R_GlobalEnv>
+
+$class
+[1] "terms" "formula"
+
+$factors
+ hp mpg disp drat wt qsec vs am gear carb hp:mpg
+cyl 0 0 0 0 0 0 0 0 0 0 0
+hp 1 0 0 0 0 0 0 0 0 0 1
+mpg 0 1 0 0 0 0 0 0 0 0 1
+disp 0 0 1 0 0 0 0 0 0 0 0
+drat 0 0 0 1 0 0 0 0 0 0 0
+wt 0 0 0 0 1 0 0 0 0 0 0
+qsec 0 0 0 0 0 1 0 0 0 0 0
+vs 0 0 0 0 0 0 1 0 0 0 0
+am 0 0 0 0 0 0 0 1 0 0 0
+gear 0 0 0 0 0 0 0 0 1 0 0
+carb 0 0 0 0 0 0 0 0 0 1 0
+
+$intercept
+[1] 1
+
+$order
+ [1] 1 1 1 1 1 1 1 1 1 1 2
+
+$response
+[1] 1
+
+$term.labels
+ [1] "hp" "mpg" "disp" "drat" "wt" "qsec" "vs" "am"
+ [9] "gear" "carb" "hp:mpg"
+
+$variables
+list(cyl, hp, mpg, disp, drat, wt, qsec, vs, am, gear, carb)
+
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelFrame
#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;; model.frame(terms.formula(u~z*k+w*m)) }
u z k w m
@@ -108326,6 +108460,50 @@ attr(,"contrasts")$z
[1] "contr.treatment"
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testSpecialsTermsform
+#f <- terms.formula(y~myfun(z)+x, c('myfun')); attrs <- attributes(f); envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
+$.Environment
+<environment: R_GlobalEnv>
+
+$class
+[1] "terms" "formula"
+
+$factors
+ myfun(z) x
+y 0 0
+myfun(z) 1 0
+x 0 1
+
+$intercept
+[1] 1
+
+$order
+[1] 1 1
+
+$response
+[1] 1
+
+$specials
+$specials$myfun
+[1] 2
+
+
+$term.labels
+[1] "myfun(z)" "x"
+
+$variables
+list(y, myfun(z), x)
+
+
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testSubsettingModelframe
+#{x<-y<-1:10; model.frame.default(x~y, subset=3:7); }
+ x y
+3 3 3
+4 4 4
+5 5 5
+6 6 6
+7 7 7
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testTermsform
#f <- terms.formula(u~z*k+w*m); attrs <- attributes(f); envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
$.Environment
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_extract_replace.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_extract_replace.java
index 42d60834f20231a063edd61aad795b547d0b39ec..f841282b012391086fc26223296274ea5b1128be 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_extract_replace.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_extract_replace.java
@@ -37,4 +37,9 @@ public class TestBuiltin_extract_replace extends TestBase {
public void extractAndReplaceByItself() {
assertEval("tmp <- c(1,8,NA,3); pivot <- c(1,2,4,3); tmp[pivot] <- tmp; tmp");
}
+
+ @Test
+ public void replaceInLanguagePreservesAttributes() {
+ assertEval("f <- quote(a+b); attr(f, 'mya') <- 42; f[[2]] <- quote(q); f");
+ }
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_namesassign.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_namesassign.java
index b34f10272333d7e7a691c19fd5c65e0f4baa5ec0..5c16751d89b35289fffe98a204517eb66b9a43f3 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_namesassign.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_namesassign.java
@@ -112,8 +112,8 @@ public class TestBuiltin_namesassign extends TestBase {
assertEval("{ x<-c(1, 2); names(x)<-c(\"a\", \"b\"); attr(x, \"names\")<-NULL; x }");
assertEval("{ x<-c(1, 2); names(x)<-42; x }");
assertEval("{ x<-c(1, 2); names(x)<-c(TRUE, FALSE); x }");
- assertEval(Output.IgnoreErrorContext, "{ x<-c(1,2); names(x) <- 42:44; x }");
- assertEval(Output.IgnoreErrorContext, "{ x<-c(1,2); attr(x, \"names\") <- 42:45; x }");
+ assertEval("{ x<-c(1,2); names(x) <- 42:44; x }");
+ assertEval("{ x<-c(1,2); attr(x, \"names\") <- 42:45; x }");
assertEval("{ x<-list(1,2); names(x)<-c(\"a\",NA); x }");
assertEval("{ x<-list(1,2); names(x)<-c(\"a\",\"$\"); x }");
assertEval("{ x<-list(1,2); names(x)<-c(\"a\",\"b\"); x }");
@@ -137,8 +137,19 @@ public class TestBuiltin_namesassign extends TestBase {
assertEval("{ x <- c(1,2); names(x) <- c(\"A\", \"B\") ; x + 1 }");
assertEval("{ x <- 1:2; names(x) <- c(\"A\", \"B\") ; y <- c(1,2,3,4) ; names(y) <- c(\"X\", \"Y\", \"Z\") ; x + y }");
- assertEval(Output.IgnoreErrorContext, "{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\", \"d\")}");
+ assertEval("{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\", \"d\")}");
assertEval("{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\"); x}");
assertEval("{ x <- quote(plot(x = age, y = weight)); x$x <- \"random\"; x}");
}
+
+ @Test
+ public void testUpdateDimnamesDifferentSize() {
+ assertEval("{ l <- list(1,2,3); names(l) <- list('a','b','c','d'); l }"); // longer
+ assertEval("{ l <- list(1,2,3); names(l) <- list('a','b'); l }"); // shorter
+ }
+
+ @Test
+ public void testUpdateDimnamesPairlist() {
+ assertEval("{ l <- vector('pairlist',2); names(l)<-c('a','b'); l; }");
+ }
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_vector.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_vector.java
index 75ee509bceef16070ba1360ce239e12f1fd4c029..5e7c002f47917a4bb563a2971a52e36a7120e6d1 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_vector.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_vector.java
@@ -66,4 +66,10 @@ public class TestBuiltin_vector extends TestBase {
assertEval("{ vector(length=3) }");
assertEval("{ x<-as.vector(3); y<-vector(length=x) }");
}
+
+ @Test
+ public void testVectorWithPairlist() {
+ assertEval("vector('pairlist', 0)");
+ assertEval("vector('pairlist', 3)");
+ }
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
index 6fa8a297e1e1959989bd8fde81d5d4e5e37733a0..deb60b64d75a815886b0db2f360e6c4c3489d4c1 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
@@ -84,4 +84,24 @@ public class TestFormulae extends TestBase {
public void testModelMatrix() {
assertEval(template("{%0; model.matrix(model.frame(terms.formula(%1))) }", INITS, FORMULAE));
}
+
+ @Test
+ public void testSubsettingModelframe() {
+ assertEval("{x<-y<-1:10; model.frame.default(x~y, subset=3:7); }");
+ }
+
+ @Test
+ public void testSpecialsTermsform() {
+ assertEval("f <- terms.formula(y~myfun(z)+x, c('myfun')); attrs <- attributes(f); " + SHOW_ATTRS);
+ }
+
+ @Test
+ public void testExpandDostsTermsform() {
+ assertEval("f <- terms.formula(cyl~hp*mpg+., data=mtcars); attrs <- attributes(f);" + SHOW_ATTRS);
+ }
+
+ @Test
+ public void testExpandDostsAndSpecialsTermsform() {
+ assertEval("f <- terms.formula(cyl~myfun(mpg)+., specials=c('myfun'), data=mtcars); attrs <- attributes(f); " + SHOW_ATTRS);
+ }
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
index 536fd3891d5f57cd0a4223f9768ad55d5917940c..6fad3bc8dbd278793259a4daa352a4f4e6a0e757 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
@@ -59,7 +59,7 @@ check <- function(expected, actual, name) {
tests <- c(y~z, y~1+z, y~0+z, y~-1+z, y~z*k, y~z*k+w*m, u~z*k+w*m, y~z:k)
tests <- c(tests, y~z^2, y~(z+k)^2, y~z*((m+w)^3), y~(z+k)*(w+u))
tests <- c(tests, y~w%in%v, y~w/k, y~(1 + w/k))
-ignoremm <- c(y~log(z), y~z+I(k+4))
+ignoremm <- c(y~log(z), y~z+I(k+4), y~z+I(k^2), y~z+offset(log(z)))
ignoremf <- NULL
tests <- c(tests, ignoremm)
@@ -106,4 +106,17 @@ print(y~z)
mf <- model.frame.default(y~z, subset=3:7)
check(mf, modelframedefault(y~z, subset=3:7), "model.frame.default with subset")
+# check specials
+t <- y~myfun(z)+x
+print(t)
+check(terms.formula(t, c('myfun')), termsform(t, c('myfun'), NULL, FALSE, FALSE), "termsform with specials")
+# check expand dots
+t <- cyl~hp*mpg+.
+print(t)
+check(terms.formula(t, data=mtcars), termsform(t, NULL, mtcars, FALSE, FALSE), "termsform with expandDots")
+
+# check specials and expand dots
+t <- cyl~mufun(mpg)+.
+print(t)
+check(terms.formula(t, specials=c('myfun'), data=mtcars), termsform(t, c('myfun'), mtcars, FALSE, FALSE), "termsform with specials and expandDots")