diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/RTruffleVisitor.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/RTruffleVisitor.java index ef67b860c9597b9520ec201bfe898f20df81a710..da33cc8deb0005e2b3b1d47ce1f601502a0ecc8a 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/RTruffleVisitor.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/RTruffleVisitor.java @@ -308,7 +308,7 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { private static final String varSymbol = "*tmp*"; - private static Object constructReplacementPrefix(RNode[] seq, RNode rhs, String vSymbol, SimpleAccessVariable vAST, boolean isSuper) { + private static Object constructReplacementPrefix(RNode[] seq, RNode rhs, RNode replacementArg) { //@formatter:off // store a - need to use temporary, otherwise there is a failure in case multiple calls to // the replacement form are chained: @@ -318,9 +318,7 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { WriteVariableNode rhsAssign = WriteVariableNode.create(rhsSymbol, rhs, false, false, WriteVariableNode.COPY); - ReadVariableNode v = isSuper ? ReadVariableSuperMaterializedNode.create(vAST.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(vAST.getSource(), vSymbol, RRuntime.TYPE_ANY, - vAST.shouldCopyValue()); - WriteVariableNode varAssign = WriteVariableNode.create(varSymbol, v, false, false, WriteVariableNode.TEMP); + WriteVariableNode varAssign = WriteVariableNode.create(varSymbol, replacementArg, false, false, WriteVariableNode.TEMP); seq[0] = rhsAssign; seq[1] = varAssign; @@ -328,14 +326,13 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { return rhsSymbol; } - private static SequenceNode constructReplacementSuffix(RNode[] seq, RNode op, String vSymbol, Object rhsSymbol, SourceSection source, boolean isSuper) { + private static SequenceNode constructReplacementSuffix(RNode[] seq, RNode assignFromTemp, Object rhsSymbol, SourceSection source) { // assign var, read rhs - WriteVariableNode vAssign = WriteVariableNode.create(vSymbol, op, false, isSuper, WriteVariableNode.TEMP); WriteVariableNode varReset = WriteVariableNode.create(varSymbol, ConstantNode.create(RNull.instance), false, false); ReadVariableNode rhsRead = ReadVariableNode.create(rhsSymbol, false); // assemble - seq[2] = vAssign; + seq[2] = assignFromTemp; seq[3] = varReset; seq[4] = Invisible.create(rhsRead); SequenceNode replacement = new SequenceNode(seq); @@ -349,7 +346,7 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { SequenceNode vecUpdate = new SequenceNode(seq); vecUpdate.assignSourceSection(source); - return visitUpdateVector(vecAST, vecUpdate, isSuper, source, true); + return createVectorUpdate(vecAST, vecUpdate, isSuper, source, true); } private static SimpleAccessVariable getVectorVariable(AccessVector v) { @@ -363,7 +360,16 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { } } - private RNode visitUpdateVector(AccessVector a, RNode rhs, boolean isSuper, SourceSection source, boolean recursive) { + private static SimpleAccessVariable getFieldAccessVariable(FieldAccess a) { + if (a.getLhs() instanceof SimpleAccessVariable) { + return (SimpleAccessVariable) a.getLhs(); + } else { + Utils.nyi(); + return null; + } + } + + private RNode createVectorUpdate(AccessVector a, RNode rhs, boolean isSuper, SourceSection source, boolean recursive) { int argLength = a.getArgs().size(); if (!recursive) { argLength--; // last argument == RHS @@ -373,14 +379,17 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { String vSymbol = RRuntime.toString(varAST.getSymbol()); RNode[] seq = new RNode[5]; - final Object rhsSymbol = constructReplacementPrefix(seq, rhs, vSymbol, varAST, isSuper); + ReadVariableNode v = isSuper ? ReadVariableSuperMaterializedNode.create(varAST.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(varAST.getSource(), vSymbol, + RRuntime.TYPE_ANY, varAST.shouldCopyValue()); + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, v); RNode rhsAccess = ReadVariableNode.create(null, rhsSymbol, RRuntime.TYPE_ANY, false); RNode tmpVarAccess = ReadVariableNode.create(null, varSymbol, RRuntime.TYPE_ANY, false); RNode positions = createPositions(a.getArgs(), argLength, a.isSubset(), true); CoerceVector coerceVector = CoerceVectorFactory.create(null, null, null); UpdateArrayHelperNode updateOp = UpdateArrayHelperNodeFactory.create(a.isSubset(), tmpVarAccess, rhsAccess, ConstantNode.create(0), (PositionsArrayNodeValue) positions, coerceVector); - return constructReplacementSuffix(seq, updateOp, vSymbol, rhsSymbol, source, isSuper); + RNode assignFromTemp = WriteVariableNode.create(vSymbol, updateOp, false, isSuper, WriteVariableNode.TEMP); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, source); } else if (a.getVector() instanceof AccessVector) { // assign value to the outermost dimension and then the result (recursively) to // appropriate position in the lower dimension @@ -391,7 +400,9 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { String vSymbol = RRuntime.toString(varAST.getSymbol()); RNode[] seq = new RNode[3]; - final Object rhsSymbol = constructReplacementPrefix(seq, rhs, vSymbol, varAST, isSuper); + ReadVariableNode v = isSuper ? ReadVariableSuperMaterializedNode.create(varAST.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(varAST.getSource(), vSymbol, + RRuntime.TYPE_ANY, varAST.shouldCopyValue()); + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, v); RNode rhsAccess = AccessVariable.create(null, rhsSymbol).accept(this); @@ -400,6 +411,20 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { UpdateArrayHelperNode updateOp = UpdateArrayHelperNodeFactory.create(a.isSubset(), vecAST.accept(this), rhsAccess, ConstantNode.create(0), (PositionsArrayNodeValue) positions, coerceVector); return constructRecursiveUpdateSuffix(seq, updateOp, vecAST, source, isSuper); + } else if (a.getVector() instanceof FieldAccess) { + FieldAccess accessAST = (FieldAccess) a.getVector(); + SimpleAccessVariable varAST = getFieldAccessVariable(accessAST); + + String vSymbol = RRuntime.toString(varAST.getSymbol()); + RNode[] seq = new RNode[5]; + ReadVariableNode v = isSuper ? ReadVariableSuperMaterializedNode.create(varAST.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(varAST.getSource(), vSymbol, + RRuntime.TYPE_ANY, varAST.shouldCopyValue()); + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, v); + RNode rhsAccess = ReadVariableNode.create(null, rhsSymbol, RRuntime.TYPE_ANY, false); + RNode tmpVarAccess = ReadVariableNode.create(null, varSymbol, RRuntime.TYPE_ANY, false); + UpdateFieldNode ufn = UpdateFieldNodeFactory.create(tmpVarAccess, rhsAccess, RRuntime.toString(accessAST.getFieldName())); + RNode assignFromTemp = WriteVariableNode.create(vSymbol, ufn, false, isSuper, WriteVariableNode.TEMP); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, source); } else if (a.getVector() instanceof FunctionCall) { FunctionCall callAST = (FunctionCall) a.getVector(); RNode positions = createPositions(a.getArgs(), argLength, a.isSubset(), true); @@ -413,7 +438,7 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { @Override public RNode visit(UpdateVector u) { - return visitUpdateVector(u.getVector(), u.getRHS().accept(this), u.isSuper(), u.getSource(), false); + return createVectorUpdate(u.getVector(), u.getRHS().accept(this), u.isSuper(), u.getSource(), false); } @Override @@ -430,6 +455,22 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { return WriteVariableNode.create(n.getSource(), n.getSymbol(), expression, false, n.isSuper()); } + private RCallNode prepareReplacementCall(FunctionCall f, List<ArgNode> args, final Object rhsSymbol) { + // massage arguments to replacement function call (replace v with tmp, append a) + List<ArgNode> rfArgs = new ArrayList<>(); + rfArgs.add(ArgNode.create(null, (Symbol) null, AccessVariable.create(null, varSymbol, false))); + if (args.size() > 1) { + for (int i = 1; i < args.size(); ++i) { + rfArgs.add(args.get(i)); + } + } + rfArgs.add(ArgNode.create(null, (Symbol) null, AccessVariable.create(null, rhsSymbol))); + + // replacement function call (use visitor for FunctionCall) + FunctionCall rfCall = new FunctionCall(null, f.getName(), rfArgs); + return (RCallNode) visit(rfCall); + } + //@formatter:off /** * Handle an assignment of the form {@code xxx(v) <- a} (or similar, with additional arguments). @@ -449,36 +490,40 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { @Override public RNode visit(Replacement n) { // preparations - RNode rhs = n.getExpr().accept(this); + ASTNode rhsAst = n.getExpr(); + RNode rhs = rhsAst.accept(this); FunctionCall f = n.getBuiltin(); List<ArgNode> args = f.getArgs(); - SimpleAccessVariable vAST; ASTNode val = args.get(0).getValue(); if (val instanceof SimpleAccessVariable) { - vAST = (SimpleAccessVariable) val; + SimpleAccessVariable callArgAst = (SimpleAccessVariable) val; + String vSymbol = RRuntime.toString(callArgAst.getSymbol()); + RNode[] seq = new RNode[5]; + ReadVariableNode v = n.isSuper() ? ReadVariableSuperMaterializedNode.create(callArgAst.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(callArgAst.getSource(), vSymbol, + RRuntime.TYPE_ANY, callArgAst.shouldCopyValue()); + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, v); + RNode replacementCall = prepareReplacementCall(f, args, rhsSymbol); + RNode assignFromTemp = WriteVariableNode.create(vSymbol, replacementCall, false, n.isSuper(), WriteVariableNode.TEMP); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, n.getSource()); + } else if (val instanceof AccessVector) { + AccessVector callArgAst = (AccessVector) val; + RNode replacementArg = callArgAst.accept(this); + RNode[] seq = new RNode[5]; + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, replacementArg); + RNode replacementCall = prepareReplacementCall(f, args, rhsSymbol); + // see AssignVariable.writeVector (number of args must match) + callArgAst.getArgs().add(ArgNode.create(rhsAst.getSource(), "value", rhsAst)); + RNode assignFromTemp = createVectorUpdate(callArgAst, replacementCall, n.isSuper(), n.getSource(), false); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, n.getSource()); } else { - vAST = getVectorVariable((AccessVector) val); - } - String vSymbol = RRuntime.toString(vAST.getSymbol()); - - RNode[] seq = new RNode[5]; - final Object rhsSymbol = constructReplacementPrefix(seq, rhs, vSymbol, vAST, n.isSuper()); - - // massage arguments to replacement function call (replace v with tmp, append a) - List<ArgNode> rfArgs = new ArrayList<>(); - rfArgs.add(ArgNode.create(null, (Symbol) null, AccessVariable.create(null, varSymbol, false))); - if (args.size() > 1) { - for (int i = 1; i < args.size(); ++i) { - rfArgs.add(args.get(i)); - } + FieldAccess callArgAst = (FieldAccess) val; + RNode replacementArg = callArgAst.accept(this); + RNode[] seq = new RNode[5]; + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, replacementArg); + RNode replacementCall = prepareReplacementCall(f, args, rhsSymbol); + RNode assignFromTemp = createFieldUpdate(callArgAst, replacementCall, n.isSuper(), n.getSource()); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, n.getSource()); } - rfArgs.add(ArgNode.create(null, (Symbol) null, AccessVariable.create(null, rhsSymbol))); - - // replacement function call (use visitor for FunctionCall) - FunctionCall rfCall = new FunctionCall(null, f.getName(), rfArgs); - RCallNode replacementFunctionCall = (RCallNode) visit(rfCall); - - return constructReplacementSuffix(seq, replacementFunctionCall, vSymbol, rhsSymbol, n.getSource(), n.isSuper()); } @Override @@ -537,24 +582,31 @@ public final class RTruffleVisitor extends BasicVisitor<RNode> { return afn; } - @Override - public RNode visit(UpdateField u) { - FieldAccess a = u.getVector(); - RNode rhs = u.getRHS().accept(this); - SimpleAccessVariable vAST = null; + private static RNode createFieldUpdate(FieldAccess a, RNode rhs, boolean isSuper, SourceSection source) { + SimpleAccessVariable varAST = null; if (a.getLhs() instanceof SimpleAccessVariable) { - vAST = (SimpleAccessVariable) a.getLhs(); + varAST = (SimpleAccessVariable) a.getLhs(); } else { Utils.nyi(); } - String vSymbol = RRuntime.toString(vAST.getSymbol()); + String vSymbol = RRuntime.toString(varAST.getSymbol()); RNode[] seq = new RNode[5]; - final Object rhsSymbol = constructReplacementPrefix(seq, rhs, vSymbol, vAST, u.isSuper()); + ReadVariableNode v = isSuper ? ReadVariableSuperMaterializedNode.create(varAST.getSource(), vSymbol, RRuntime.TYPE_ANY) : ReadVariableNode.create(varAST.getSource(), vSymbol, + RRuntime.TYPE_ANY, varAST.shouldCopyValue()); + final Object rhsSymbol = constructReplacementPrefix(seq, rhs, v); RNode rhsAccess = ReadVariableNode.create(null, rhsSymbol, RRuntime.TYPE_ANY, false); RNode tmpVarAccess = ReadVariableNode.create(null, varSymbol, RRuntime.TYPE_ANY, false); UpdateFieldNode ufn = UpdateFieldNodeFactory.create(tmpVarAccess, rhsAccess, RRuntime.toString(a.getFieldName())); - return constructReplacementSuffix(seq, ufn, vSymbol, rhsSymbol, u.getSource(), u.isSuper()); + RNode assignFromTemp = WriteVariableNode.create(vSymbol, ufn, false, isSuper, WriteVariableNode.TEMP); + return constructReplacementSuffix(seq, assignFromTemp, rhsSymbol, source); + } + + @Override + public RNode visit(UpdateField u) { + FieldAccess a = u.getVector(); + RNode rhs = u.getRHS().accept(this); + return createFieldUpdate(a, rhs, u.isSuper(), u.getSource()); } } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/GroupDispatchNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/GroupDispatchNode.java index abaefec9d06c46e8d9c8efc7692ba2e33c7f81cf..9317833157e09489e2327670dff5f905e31ee791 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/GroupDispatchNode.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/GroupDispatchNode.java @@ -97,13 +97,14 @@ public class GroupDispatchNode extends S3DispatchNode { @Override public Object execute(VirtualFrame frame) { + CompilerDirectives.transferToInterpreterAndInvalidate(); RNode[] args = callArgsNode.getArguments(); if (args == null || args.length < 1) { return callBuiltin(frame); } evaluatedArgs = new Object[]{args[0].execute(frame)}; if ((this.type = getArgClass(evaluatedArgs[0])) != null) { - if (targetFunction != null && isEqualType(this.type, this.typeLast) && findFunction(targetFunctionName, frame) && isFirst) { + if (targetFunction != null && isEqualType(this.type, this.typeLast) && isFirst) { return executeHelper(); } findTargetFunction(frame); diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Inherits.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Inherits.java index fb23306dbd5f8c2ae1cdaa72031bcb079a3530e2..09bad75a677f7bff717d1161caf04e6ddfb0df91 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Inherits.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Inherits.java @@ -15,9 +15,9 @@ import static com.oracle.truffle.r.nodes.builtin.RBuiltinKind.*; import java.util.*; -import com.oracle.truffle.api.*; import com.oracle.truffle.api.dsl.*; import com.oracle.truffle.api.frame.*; +import com.oracle.truffle.api.CompilerDirectives.SlowPath; import com.oracle.truffle.r.nodes.*; import com.oracle.truffle.r.nodes.access.*; import com.oracle.truffle.r.nodes.builtin.*; @@ -43,6 +43,8 @@ public abstract class Inherits extends RBuiltinNode { public abstract byte execute(VirtualFrame frame, Object x, RAbstractStringVector what, byte which); + @SlowPath + // map operations lead to recursion resulting in compilation failure @Specialization(order = 0) public Object doesInherit(RAbstractVector x, RAbstractStringVector what, byte which) { controlVisibility(); @@ -76,26 +78,30 @@ public abstract class Inherits extends RBuiltinNode { } } - @Specialization(order = 3) - @SuppressWarnings("unused") - public Object doesInherit(RAbstractVector x, RAbstractStringVector what, Object which) { - controlVisibility(); - CompilerDirectives.transferToInterpreter(); - throw RError.getNotLengthOneLogicalVector(getEncapsulatingSourceSection(), RRuntime.WHICH); - } + // TODO: these generic specializations must go away - this simply does not work in general (e.g. + // inherits is used by implementation of is.factor, which means that arguments of different + // types can easily flow through the same node) - @Specialization(order = 4) - @SuppressWarnings("unused") - public Object doesInherit(RAbstractVector x, Object what, Object which) { - controlVisibility(); - CompilerDirectives.transferToInterpreter(); - throw RError.getNotCharacterVector(getEncapsulatingSourceSection(), RRuntime.WHAT); - } - - @Specialization(order = 6) - @SuppressWarnings("unused") - public Object doesInherit(Object x, Object what, Object which) { - controlVisibility(); - throw new UnsupportedOperationException(); - } +// @Specialization(order = 3) +// @SuppressWarnings("unused") +// public Object doesInherit(RAbstractVector x, RAbstractStringVector what, Object which) { +// controlVisibility(); +// CompilerDirectives.transferToInterpreter(); +// throw RError.getNotLengthOneLogicalVector(getEncapsulatingSourceSection(), RRuntime.WHICH); +// } +// +// @Specialization(order = 4) +// @SuppressWarnings("unused") +// public Object doesInherit(RAbstractVector x, Object what, Object which) { +// controlVisibility(); +// CompilerDirectives.transferToInterpreter(); +// throw RError.getNotCharacterVector(getEncapsulatingSourceSection(), RRuntime.WHAT); +// } +// +// @Specialization(order = 6) +// @SuppressWarnings("unused") +// public Object doesInherit(Object x, Object what, Object which) { +// controlVisibility(); +// throw new UnsupportedOperationException(); +// } } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java index 7ec5741aea53038930f56da17840ede22891ce69..2645ec140ec31b4596db2cc23f5f5c0c68a2df52 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/LaFunctions.java @@ -52,7 +52,8 @@ public class LaFunctions { } protected void lapackError(String func, int info) { - error("error code " + info + " from Lapack routine '" + func + "'"); + CompilerDirectives.transferToInterpreter(); + throw RError.getGenericError(getEncapsulatingSourceSection(), "error code " + info + " from Lapack routine '" + func + "'"); } } @@ -243,4 +244,121 @@ public class LaFunctions { error(String.format(format, a, b)); } } + + @RBuiltin(name = "det_ge_real", kind = INTERNAL) + public abstract static class DetGeReal extends LaHelper { + + private static final RStringVector NAMES_VECTOR = RDataFactory.createStringVector(new String[]{"modulus", "sign"}, RDataFactory.COMPLETE_VECTOR); + private static final RStringVector DET_CLASS = RDataFactory.createStringVector(new String[]{"det"}, RDataFactory.COMPLETE_VECTOR); + + @Specialization + public RList doDetGeReal(RDoubleVector aIn, byte useLogIn) { + if (!aIn.isMatrix()) { + error("'a' must be a numeric matrix"); + } + RDoubleVector a = (RDoubleVector) aIn.copy(); + int[] aDims = aIn.getDimensions(); + int n = aDims[0]; + if (n != aDims[1]) { + error("'a' must be a square matrix"); + } + int[] ipiv = new int[n]; + double modulus = 0; + boolean useLog = RRuntime.fromLogical(useLogIn); + double[] aData = a.getDataWithoutCopying(); + int info = RFFIFactory.getRFFI().getLapackRFFI().dgetrf(n, n, aData, n, ipiv); + int sign = 1; + if (info < 0) { + lapackError("dgetrf", info); + } else if (info > 0) { + modulus = useLog ? Double.NEGATIVE_INFINITY : 0; + } else { + for (int i = 0; i < n; i++) { + if (ipiv[i] != (i + 1)) { + sign = -sign; + } + } + if (useLog) { + modulus = 0.0; + int n1 = n + 1; + for (int i = 0; i < n; i++) { + double dii = aData[i * n1]; /* ith diagonal element */ + modulus += Math.log(dii < 0 ? -dii : dii); + if (dii < 0) { + sign = -sign; + } + } + } else { + modulus = 1.0; + int n1 = n + 1; + for (int i = 0; i < n; i++) { + modulus *= aData[i * n1]; + } + if (modulus < 0) { + modulus = -modulus; + sign = -sign; + } + } + } + RDoubleVector modulusVec = RDataFactory.createDoubleVectorFromScalar(modulus); + modulusVec.setAttr("logarithm", useLogIn); + RList result = RDataFactory.createList(new Object[]{modulusVec, sign}, NAMES_VECTOR); + RList.setClassAttr(result, DET_CLASS, null); + return result; + } + } + + @RBuiltin(name = "La_chol", kind = INTERNAL) + public abstract static class LaChol extends LaHelper { + @Specialization + public RDoubleVector doDetGeReal(RDoubleVector aIn, byte pivot, double tol) { + RDoubleVector a = (RDoubleVector) aIn.copy(); + int[] aDims = aIn.getDimensions(); + int n = aDims[0]; + int m = aDims[1]; + if (n != m) { + error("'a' must be a square matrix"); + } + if (m <= 0) { + error("'a' must have dims > 0"); + } + double[] aData = a.getDataWithoutCopying(); + /* zero the lower triangle */ + for (int j = 0; j < n; j++) { + for (int i = j + 1; i < n; i++) { + aData[i + n * j] = 0; + } + } + boolean piv = RRuntime.fromLogical(pivot); + int info; + if (!piv) { + info = RFFIFactory.getRFFI().getLapackRFFI().dpotrf('U', m, aData, m); + if (info != 0) { + // TODO informative error message (aka GnuR) + lapackError("dpotrf", info); + } + } else { + int[] ipiv = new int[m]; + double[] work = new double[2 * m]; + int[] rank = new int[1]; + info = RFFIFactory.getRFFI().getLapackRFFI().dpstrf('U', n, aData, n, ipiv, rank, tol, work); + if (info != 0) { + // TODO informative error message (aka GnuR) + lapackError("dpotrf", info); + } + a.setAttr("pivot", pivot); + a.setAttr("rank", rank[0]); + RList dn = a.getDimNames(); + if (dn != null && dn.getDataAt(0) != null) { + Object[] dn2 = new Object[m]; + // need to pivot the colnames + for (int i = 0; i < m; i++) { + dn2[i] = dn.getDataAt(ipiv[i] - 1); + } + a.setDimNames(RDataFactory.createList(dn2)); + } + } + return a; + } + } } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethodDispatchNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethodDispatchNode.java index 9df98e2c0a751b8bbce20c9ed8c56f7bb7ec9e91..e11796990e629257817c9498fb614a890f038b8d 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethodDispatchNode.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/NextMethodDispatchNode.java @@ -45,7 +45,7 @@ public class NextMethodDispatchNode extends S3DispatchNode { @Override public Object execute(VirtualFrame frame) { readGenericVars(frame); - if (!isSame() || !isFirst || !findFunction(targetFunctionName, genCallEnv)) { + if (!isSame() || !isFirst) { findTargetFunction(frame); storeValues(); } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Order.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Order.java index dca9acdac9efcf77bfd2275e9f9545fe75efeb7f..6a2dad85964402cf9eee0b9c1c7dc6fc6d6acd15 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Order.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Order.java @@ -23,8 +23,10 @@ package com.oracle.truffle.r.nodes.builtin.base; import static com.oracle.truffle.r.nodes.builtin.RBuiltinKind.*; + import com.oracle.truffle.api.CompilerDirectives.SlowPath; import com.oracle.truffle.api.dsl.*; +import com.oracle.truffle.api.frame.*; import com.oracle.truffle.r.nodes.*; import com.oracle.truffle.r.nodes.access.*; import com.oracle.truffle.r.nodes.builtin.*; @@ -48,6 +50,8 @@ public abstract class Order extends RBuiltinNode { return new RNode[]{ConstantNode.create(RMissing.instance), ConstantNode.create(RMissing.instance)}; } + public abstract Object executeDoubleVector(VirtualFrame frame, RDoubleVector vec, RMissing tie); + @Child protected BooleanOperation eq = BinaryCompare.EQUAL.create(); @Child protected BooleanOperation lt = BinaryCompare.LESS_THAN.create(); @Child protected BooleanOperation le = BinaryCompare.LESS_EQUAL.create(); diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/chol.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/chol.R new file mode 100644 index 0000000000000000000000000000000000000000..e36314661bb30fd2d960aada36ed1f2ab87f0597 --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/chol.R @@ -0,0 +1,31 @@ +# File src/library/base/R/chol.R +# Part of the R package, http://www.R-project.org +# +# Copyright (C) 1995-2013 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program 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 for more details. +# +# A copy of the GNU General Public License is available at +# http://www.r-project.org/Licenses/ + +chol <- function(x, ...) UseMethod("chol") + +chol.default <- function(x, pivot = FALSE, LINPACK = FALSE, tol = -1, ...) +{ + if (is.complex(x)) + stop("complex matrices not permitted at present") + + .Internal(La_chol(as.matrix(x), pivot, tol)) +} + +chol2inv <- function(x, size = NCOL(x), LINPACK = FALSE) + .Internal(La_chol2inv(x, size)) + diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/det.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/det.R new file mode 100644 index 0000000000000000000000000000000000000000..2e145a956cb68602b886e0cbd94551b942013208 --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/det.R @@ -0,0 +1,55 @@ +# File src/library/base/R/det.R +# Part of the R package, http://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program 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 for more details. +# +# A copy of the GNU General Public License is available at +# http://www.r-project.org/Licenses/ + +## det now uses Lapack and an LU decomposition. The method argument is +## no longer used. +## S-plus' Matrix pkg has arg. "logarithm = TRUE" and returns list +## (which is necessary for keeping the sign when taking log ..) +## S-plus v 6.x has incorporated the Matrix pkg det as determinant + +det <- function(x, ...) +{ +# TODO proper argument handling +# z <- determinant(x, logarithm = TRUE, ...) + z <- determinant(x, logarithm = TRUE) + c(z$sign * exp(z$modulus)) +} + +# TODO proper argument handling +#determinant <- function(x, logarithm = TRUE, ...) UseMethod("determinant") +determinant <- function(x, logarithm = TRUE) UseMethod("determinant") + +# TODO proper argument handling +#determinant.matrix <- function(x, logarithm = TRUE, ...) +determinant.matrix <- function(x, logarithm = TRUE) +{ + if ((n <- ncol(x)) != nrow(x)) + stop("'x' must be a square matrix") + if (n < 1L) + return(structure(list(modulus = + structure(if(logarithm) 0 else 1, + logarithm = logarithm), + sign = 1L), + class = "det")) + if (is.complex(x)) + stop("'determinant' not currently defined for complex matrices") + ## FIXME: should not be so hard to implement; see + ## moddet_ge_real() in ../../../modules/lapack/Lapack.c + ## the 'sign' would have to be complex z, with |z|=1 + .Internal(det_ge_real(x, logarithm)) +} diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/factor.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/factor.R index d2588b216d4b36e595747a308a3b8bd5d7252cff..c93d71c584616e5f3355ff78338f1dff3ef1119b 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/factor.R +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/factor.R @@ -18,3 +18,9 @@ is.factor <- function(x) inherits(x, "factor") + +levels <- function(x) UseMethod("levels") +levels.default <- function(x) attr(x, "levels") +nlevels <- function(x) length(levels(x)) + +is.ordered <- function(x) inherits(x, "ordered") diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/namespace.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/namespace.R index 66a2ad79aa856f5ac44a1e7dd17b412943051135..b59bc510f01eb2f9ebd18f024fc915d6579429d9 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/namespace.R +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/namespace.R @@ -137,7 +137,7 @@ attachNamespace <- function(ns, pos = 2L, depends = NULL) } runUserHook <- function(pkgname, pkgpath) { hook <- getHook(packageEvent(pkgname, "attach")) # might be list() - debug.break(list(pkgname, hook)) + debug.break(list(pkgname, hook)) for(fun in hook) try(fun(pkgname, pkgpath)) } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sort.R b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sort.R new file mode 100644 index 0000000000000000000000000000000000000000..2d4684bad539fd5f2a3fb4f3e31defc01d8726df --- /dev/null +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/R/sort.R @@ -0,0 +1,204 @@ +# File src/library/base/R/sort.R +# Part of the R package, http://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program 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 for more details. +# +# A copy of the GNU General Public License is available at +# http://www.r-project.org/Licenses/ + +# TODO: properly handle parameters +#sort <- function(x, decreasing = FALSE, ...) +sort <- function(x, method = c("shell", "quick"), decreasing = FALSE, ...) +{ + if(!is.logical(decreasing) || length(decreasing) != 1L) + stop("'decreasing' must be a length-1 logical vector.\nDid you intend to set 'partial'?") + UseMethod("sort") +} + +# TODO: properly handle parameters +#sort.default <- function(x, decreasing = FALSE, na.last = NA, ...) +sort.default <- function(x, method = c("shell", "quick"), decreasing = FALSE, na.last = NA, ...) +{ + ## The first case includes factors. +# TODO: implement order +# if(is.object(x)) x[order(x, na.last = na.last, decreasing = decreasing)] +# else sort.int(x, na.last = na.last, decreasing = decreasing, ...) + sort.int(x, na.last = na.last, decreasing = decreasing, ...) +} + +sort.int <- +# TODO: properly handle parameters +# function(x, partial = NULL, na.last = NA, decreasing = FALSE, +# method = c("shell", "quick"), index.return = FALSE) + function(x, method = c("shell", "quick"), partial = NULL, na.last = NA, decreasing = FALSE, + index.return = FALSE) +{ + if(isfact <- is.factor(x)) { + # TODO: implement factor + stop("factors not yet supported") + if(index.return) stop("'index.return' only for non-factors") + lev <- levels(x) + nlev <- nlevels(x) + isord <- is.ordered(x) + x <- c(x) # drop attributes + } else if(!is.atomic(x)) + stop("'x' must be atomic") + + if(has.na <- any(ina <- is.na(x))) { + nas <- x[ina] + x <- x[!ina] + } + if(index.return && !is.na(na.last)) + stop("'index.return' only for 'na.last = NA'") + if(!is.null(partial)) { + stop("partial sort not yet supported") +# TODO: implement proper qsort +# if(index.return || decreasing || isfact || !missing(method)) +# stop("unsupported options for partial sorting") +# if(!all(is.finite(partial))) stop("non-finite 'partial'") +# y <- if(length(partial) <= 10L) { +# partial <- .Internal(qsort(partial, FALSE)) +# .Internal(psort(x, partial)) +# } else if (is.double(x)) .Internal(qsort(x, FALSE)) +# else .Internal(sort(x, FALSE)) + } else if(isfact && missing(method) && nlev < 100000) { + o <- sort.list(x, decreasing = decreasing, method = "radix") + y <- x[o] + } else { + nms <- names(x) +# TODO: implement deparse in match.arg +# method <- if(is.numeric(x)) match.arg(method) else "shell" + method <- if(is.numeric(x)) match.arg(method, c("shell", "quick")) else "shell" +# TODO: implement shell sort; there is also something wrong with this switch statement +# switch(method, +# "quick" = { + if(!is.null(nms)) { + # TODO: implement proper qsort + stop("vector names not currently supported with quicksort"); + if(decreasing) x <- -x + y <- .Internal(qsort(x, TRUE)) + if(decreasing) y$x <- -y$x + names(y$x) <- nms[y$ix] + if (!index.return) y <- y$x + } else { + if(decreasing) x <- -x + y <- .Internal(qsort(x, index.return)) + if(decreasing) { + # TODO: implement proper qsort + # if(index.return) y$x <- -y$x else y <- -y + if(index.return) stop("index.return not currently supported with quicksort"); + y <- -y + } + } +# }, +# "shell" = { +# stop("shell sort not yet supported") +# if(index.return || !is.null(nms)) { +# o <- sort.list(x, decreasing = decreasing) +# y <- if (index.return) list(x = x[o], ix = o) else x[o] +# } +# else +# y <- .Internal(sort(x, decreasing)) +# }) + } + if(!is.na(na.last) && has.na) + y <- if(!na.last) c(nas, y) else c(y, nas) +# TODO: implement function calling through results of an if statement +# if(isfact) +# y <- (if (isord) ordered else factor)(y, levels = seq_len(nlev), +# labels = lev) + y +} + +#order <- function(..., na.last = TRUE, decreasing = FALSE) +#{ +# z <- list(...) +# if(any(unlist(lapply(z, is.object)))) { +# z <- lapply(z, function(x) if(is.object(x)) xtfrm(x) else x) +# if(!is.na(na.last)) +# return(do.call("order", c(z, na.last = na.last, +# decreasing = decreasing))) +# } else if(!is.na(na.last)) { +# if (length(z) == 1L && is.factor(zz <- z[[1L]]) && nlevels(zz) < 100000) +# return(.Internal(radixsort(zz, na.last, decreasing))) +# else return(.Internal(order(na.last, decreasing, ...))) +# } +# +# ## na.last = NA case: remove nas +# if(any(diff(l.z <- vapply(z, length, 1L)) != 0L)) +# stop("argument lengths differ") +# ans <- vapply(z, is.na, rep.int(NA, l.z[1L])) +# ok <- if(is.matrix(ans)) !apply(ans, 1, any) else !any(ans) +# if(all(!ok)) return(integer()) +# z[[1L]][!ok] <- NA +# ans <- do.call("order", c(z, decreasing = decreasing)) +# keep <- seq_along(ok)[ok] +# ans[ans %in% keep] +#} +# +#sort.list <- function(x, partial = NULL, na.last = TRUE, decreasing = FALSE, +# method = c("shell", "quick", "radix")) +#{ +# if (missing(method) && is.factor(x) && nlevels(x) < 100000) method <-"radix" +# method <- match.arg(method) +# if(!is.atomic(x)) +# stop("'x' must be atomic for 'sort.list'\nHave you called 'sort' on a list?") +# if(!is.null(partial)) +# .NotYetUsed("partial != NULL") +# if(method == "quick") { +# if(is.factor(x)) x <- as.integer(x) # sort the internal codes +# if(is.numeric(x)) +# return(sort(x, na.last = na.last, decreasing = decreasing, +# method = "quick", index.return = TRUE)$ix) +# else stop("method = \"quick\" is only for numeric 'x'") +# } +# if(method == "radix") { +# if(!typeof(x) == "integer") # we do want to allow factors here +# stop("method = \"radix\" is only for integer 'x'") +# if(is.na(na.last)) +# return(.Internal(radixsort(x[!is.na(x)], TRUE, decreasing))) +# else +# return(.Internal(radixsort(x, na.last, decreasing))) +# } +# ## method == "shell" +# if(is.na(na.last)) .Internal(order(TRUE, decreasing, x[!is.na(x)])) +# else .Internal(order(na.last, decreasing, x)) +#} +# +# +### xtfrm is now primitive +### xtfrm <- function(x) UseMethod("xtfrm") +#xtfrm.default <- function(x) +# if(is.numeric(x)) unclass(x) else as.vector(rank(x, ties.method="min", na.last="keep")) +#xtfrm.factor <- function(x) as.integer(x) # primitive, so needs a wrapper +#xtfrm.Surv <- function(x) +# if(ncol(x) == 2L) order(x[,1L], x[,2L]) else order(x[,1L], x[,2L], x[,3L]) # needed by 'party' +#xtfrm.AsIs <- function(x) +#{ +# if(length(cl <- class(x)) > 1) oldClass(x) <- cl[-1L] +# NextMethod("xtfrm") +#} +# +### callback from C code for rank/order +#.gt <- function(x, i, j) +#{ +# xi <- x[i]; xj <- x[j] +# if (xi == xj) 0L else if(xi > xj) 1L else -1L; +#} +# +### callback for C code for is.unsorted, hence negation. +#.gtn <- function(x, strictly) +#{ +# n <- length(x) +# if(strictly) !all(x[-1L] > x[-n]) else !all(x[-1L] >= x[-n]) +#} diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Recall.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Recall.java index b16d5d9480f61f87588a8e255326c6f2f4ef72c7..c42cfb1d2ae8d5747863b36c9b59c9ade5b9a2ea 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Recall.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/Recall.java @@ -53,6 +53,11 @@ public class Recall extends RCustomBuiltinNode { @Override public Object execute(VirtualFrame frame) { controlVisibility(); + // Recall is now only used in a massively recursive benchmark (b25.prog-3) and cannot be + // compiled (Truffle eventually barfs trying to inline that many calls). Possibilities for + // making this problem less severe is to perhaps inline only to a certain call depth and + // then go back to interpretation. + CompilerDirectives.transferToInterpreterAndInvalidate(); RFunction function = RArguments.getFunction(frame); if (function == null) { CompilerDirectives.transferToInterpreter(); diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3DispatchNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3DispatchNode.java index 7d14455911da11474f4f2baca227be52a9440cfa..9a7d35a6f61789d71828381ff6eb0d4e6aa015b4 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3DispatchNode.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/S3DispatchNode.java @@ -39,7 +39,7 @@ public abstract class S3DispatchNode extends DispatchNode { protected Frame genDefEnv; protected boolean isFirst; - protected boolean findFunction(final String functionName, Frame frame) { + protected void findFunction(final String functionName, Frame frame) { if (lookup == null || !functionName.equals(lastFun)) { CompilerDirectives.transferToInterpreterAndInvalidate(); lastFun = functionName; @@ -59,9 +59,7 @@ public abstract class S3DispatchNode extends DispatchNode { if (func != null && func instanceof RFunction) { targetFunctionName = functionName; targetFunction = (RFunction) func; - return true; } - return false; } protected void findFunction(final String generic, final String className, Frame frame) { diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java index 848987d7ea52791f6451a49c6158b0a32dd21831..9ccf55e3a9ffe5dfbf38e8f352ce14ccd5e5bf8f 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/SortFunctions.java @@ -23,15 +23,22 @@ package com.oracle.truffle.r.nodes.builtin.base; import static com.oracle.truffle.r.nodes.builtin.RBuiltinKind.*; + import java.util.*; +import com.oracle.truffle.api.*; import com.oracle.truffle.api.dsl.*; +import com.oracle.truffle.api.frame.*; +import com.oracle.truffle.api.CompilerDirectives.SlowPath; +import com.oracle.truffle.r.nodes.*; +import com.oracle.truffle.r.nodes.access.*; import com.oracle.truffle.r.nodes.builtin.*; import com.oracle.truffle.r.runtime.*; import com.oracle.truffle.r.runtime.data.*; +import com.oracle.truffle.r.runtime.data.model.*; /** - * Temporary minimal implementation for eigen/b25. Eventually this should be combined with + * Temporary minimal implementation for b25 benchmarks. Eventually this should be combined with * {@link Order} and made consistent with {@code sort.R}. * */ @@ -40,19 +47,70 @@ public class SortFunctions { @RBuiltin(name = "sort.list", kind = SUBSTITUTE) // TODO Implement in R public abstract static class SortList extends RBuiltinNode { + + private static final String[] PARAMETER_NAMES = new String[]{"x", "partial", "na.last", "decreasing", "method"}; + + @Override + public Object[] getParameterNames() { + return PARAMETER_NAMES; + } + + @Override + public RNode[] getParameterValues() { + return new RNode[]{ConstantNode.create(RMissing.instance), ConstantNode.create(RNull.instance), ConstantNode.create(RRuntime.LOGICAL_TRUE), ConstantNode.create(RRuntime.LOGICAL_FALSE), + ConstantNode.create(RMissing.instance)}; + } + + @Child Order doubleOrder; + + @SuppressWarnings("unused") @Specialization - public RDoubleVector sortList(RDoubleVector vec, byte decreasing) { + public RIntVector sortList(VirtualFrame frame, RDoubleVector vec, RNull partial, byte naLast, byte decreasing, RMissing method) { controlVisibility(); - double[] data = vec.getDataCopy(); - Arrays.sort(data); - if (decreasing == RRuntime.LOGICAL_TRUE) { - double[] rdata = new double[data.length]; + if (doubleOrder == null) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + doubleOrder = insert(OrderFactory.create(new RNode[2], getBuiltin())); + } + RIntVector result = (RIntVector) doubleOrder.executeDoubleVector(frame, vec, RMissing.instance); + if (RRuntime.fromLogical(decreasing)) { + int[] data = result.getDataWithoutCopying(); + int[] rdata = new int[data.length]; for (int i = 0; i < data.length; i++) { rdata[i] = data[data.length - (i + 1)]; } - data = rdata; + result.resetData(rdata); } - return RDataFactory.createDoubleVector(data, RDataFactory.COMPLETE_VECTOR); + return result; } } + + @RBuiltin(name = "qsort", kind = INTERNAL) + // TODO full implementation in Java handling NAs + public abstract static class QSort extends RBuiltinNode { + + @SlowPath + private static void sort(double[] data) { + Arrays.sort(data); + } + + @SlowPath + private static void sort(int[] data) { + Arrays.sort(data); + } + + @Specialization + public RDoubleVector qsort(RAbstractDoubleVector vec, @SuppressWarnings("unused") Object indexReturn) { + double[] data = vec.materialize().getDataCopy(); + sort(data); + return RDataFactory.createDoubleVector(data, vec.isComplete()); + } + + @Specialization + public RIntVector qsort(RAbstractIntVector vec, @SuppressWarnings("unused") Object indexReturn) { + int[] data = vec.materialize().getDataCopy(); + sort(data); + return RDataFactory.createIntVector(data, vec.isComplete()); + } + } + } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethod.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethod.java index 27f1da580a2d536fac0a537ce3c2e1da5a077da7..4be0aeba052f8c8ce93e7a755e78b6114aa83f9d 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethod.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethod.java @@ -30,8 +30,8 @@ public abstract class UseMethod extends RBuiltinNode { * and a warning is generated. */ private static final Object[] PARAMETER_NAMES = new Object[]{"generic", "object"}; - @Child protected DispatchedCallNode dispatchedCallNode; - protected String lastGenericName; + + @Child UseMethodNode useMethodNode; @Override public Object[] getParameterNames() { @@ -44,93 +44,99 @@ public abstract class UseMethod extends RBuiltinNode { } @Specialization - public Object useMethod(VirtualFrame frame, String generic, RAbstractContainer arg) { + public Object execute(VirtualFrame frame, String generic, Object arg) { controlVisibility(); - return useMethodHelper(frame, generic, arg.getClassHierarchy()); + if (useMethodNode == null) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + useMethodNode = insert(new UseMethodUninitializedNode()); + } + return useMethodNode.execute(frame, generic, arg); + } + + private static final class UseMethodUninitializedNode extends UseMethodNode { + @Override + public Object execute(VirtualFrame frame, final String generic, Object obj) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + return specialize(obj).execute(frame, generic, obj); + } + + private UseMethodNode specialize(Object obj) { + CompilerAsserts.neverPartOfCompilation(); + if (obj instanceof RMissing) { + return this.replace(new UseMethodGenericOnlyNode()); + } + return this.replace(new UseMethodGenericAndObjectNode()); + } } /* * If only one argument is passed to UseMethod, the first argument of enclosing function is used * to resolve the generic. */ - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") RMissing arg) { - controlVisibility(); - if (RArguments.getArgumentsLength(frame) == 0 || RArguments.getArgument(frame, 0) == null) { - CompilerDirectives.transferToInterpreter(); - throw RError.getUnknownFunctionUseMethod(getEncapsulatingSourceSection(), generic, RNull.instance.toString()); + private static final class UseMethodGenericOnlyNode extends UseMethodNode { + + @Override + public Object execute(VirtualFrame frame, final String generic, Object obj) { + if (RArguments.getArgumentsLength(frame) == 0 || RArguments.getArgument(frame, 0) == null) { + CompilerDirectives.transferToInterpreter(); + throw RError.getUnknownFunctionUseMethod(getEncapsulatingSourceSection(), generic, RNull.instance.toString()); + } + Object enclosingArg = RArguments.getArgument(frame, 0); + initDispatchedCallNode(generic); + throw new ReturnException(dispatchedCallNode.execute(frame, getClassHierarchy(enclosingArg))); } - Object enclosingArg = RArguments.getArgument(frame, 0); - if (enclosingArg instanceof Byte) { - return useMethod(frame, generic, (byte) enclosingArg); - } - if (enclosingArg instanceof String) { - return useMethod(frame, generic, (String) enclosingArg); - } - if (enclosingArg instanceof Integer) { - return useMethod(frame, generic, (int) enclosingArg); - } - if (enclosingArg instanceof Double) { - return useMethod(frame, generic, (double) enclosingArg); - } - if (enclosingArg instanceof RComplex) { - return useMethod(frame, generic, (RComplex) enclosingArg); - } - return useMethod(frame, generic, (RAbstractContainer) enclosingArg); - } - - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") byte arg) { - controlVisibility(); - return useMethodHelper(frame, generic, RRuntime.TYPE_LOGICAL); - } - - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") String arg) { - controlVisibility(); - return useMethodHelper(frame, generic, RRuntime.TYPE_CHARACTER); } - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") int arg) { - controlVisibility(); - return useMethodHelper(frame, generic, RRuntime.CLASS_INTEGER); - } + private static final class UseMethodGenericAndObjectNode extends UseMethodNode { - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") double arg) { - controlVisibility(); - return useMethodHelper(frame, generic, RRuntime.CLASS_DOUBLE); + @Override + public Object execute(VirtualFrame frame, final String generic, Object obj) { + initDispatchedCallNode(generic); + throw new ReturnException(dispatchedCallNode.execute(frame, getClassHierarchy(obj))); + } } - @Specialization - public Object useMethod(VirtualFrame frame, String generic, @SuppressWarnings("unused") RComplex arg) { - controlVisibility(); - return useMethodHelper(frame, generic, RRuntime.TYPE_COMPLEX); - } + private abstract static class UseMethodNode extends RNode { - @Specialization - public Object useMethod(@SuppressWarnings("unused") VirtualFrame frame, @SuppressWarnings("unused") Object generic, @SuppressWarnings("unused") Object arg) { - controlVisibility(); - CompilerDirectives.transferToInterpreter(); - throw RError.getNonStringGeneric(getEncapsulatingSourceSection()); - } + @Child protected DispatchedCallNode dispatchedCallNode; + protected String lastGenericName; - private Object useMethodHelper(VirtualFrame frame, String generic, String className) { - return useMethodHelper(frame, generic, RDataFactory.createStringVector(className)); - } + @Override + public Object execute(VirtualFrame frame) { + throw new AssertionError(); + } - private Object useMethodHelper(VirtualFrame frame, String generic, String[] classNames) { - return useMethodHelper(frame, generic, RDataFactory.createStringVector(classNames, true)); - } + protected void initDispatchedCallNode(final String generic) { + if (dispatchedCallNode == null || !lastGenericName.equals(generic)) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + DispatchedCallNode dcn = DispatchedCallNode.create(generic, RRuntime.USE_METHOD); + dispatchedCallNode = dispatchedCallNode == null ? insert(dcn) : dispatchedCallNode.replace(dcn); + lastGenericName = generic; + } + } - private Object useMethodHelper(VirtualFrame frame, String generic, RStringVector classNames) { - if (dispatchedCallNode == null || !lastGenericName.equals(generic)) { - CompilerDirectives.transferToInterpreterAndInvalidate(); - DispatchedCallNode dcn = DispatchedCallNode.create(generic, RRuntime.USE_METHOD); - dispatchedCallNode = dispatchedCallNode == null ? insert(dcn) : dispatchedCallNode.replace(dcn); - lastGenericName = generic; + protected RStringVector getClassHierarchy(Object anObj) { + if (anObj instanceof RAbstractContainer) { + return ((RAbstractContainer) anObj).getClassHierarchy(); + } + if (anObj instanceof Byte) { + return RDataFactory.createStringVector(RRuntime.TYPE_LOGICAL); + } + if (anObj instanceof String) { + return RDataFactory.createStringVector(RRuntime.TYPE_CHARACTER); + } + if (anObj instanceof Integer) { + return RDataFactory.createStringVector(RRuntime.TYPE_INTEGER); + } + if (anObj instanceof Double) { + return RDataFactory.createStringVector(RRuntime.CLASS_DOUBLE, RDataFactory.COMPLETE_VECTOR); + } + if (anObj instanceof RComplex) { + return RDataFactory.createStringVector(RRuntime.TYPE_COMPLEX); + } + throw new AssertionError(); } - throw new ReturnException(dispatchedCallNode.execute(frame, classNames)); + + public abstract Object execute(VirtualFrame frame, final String generic, final Object o); } } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethodDispatchNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethodDispatchNode.java index 337592ebff082f7bcf9584f2e1f78e8a05350ae4..565da1d1e3046e0c34721e2348897ecf27fe21f7 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethodDispatchNode.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/UseMethodDispatchNode.java @@ -14,6 +14,7 @@ package com.oracle.truffle.r.nodes.builtin.base; import java.util.*; import com.oracle.truffle.api.*; +import com.oracle.truffle.api.CompilerDirectives.SlowPath; import com.oracle.truffle.api.frame.*; import com.oracle.truffle.api.frame.FrameInstance.FrameAccess; import com.oracle.truffle.r.runtime.*; @@ -29,7 +30,7 @@ public class UseMethodDispatchNode extends S3DispatchNode { @Override public Object execute(VirtualFrame frame) { Frame callerFrame = Utils.getCallerFrame(FrameAccess.MATERIALIZE); - if (targetFunction == null || !isFirst || !findFunction(targetFunctionName, callerFrame)) { + if (targetFunction == null || !isFirst) { findTargetFunction(callerFrame); } return executeHelper(frame, callerFrame); @@ -55,6 +56,12 @@ public class UseMethodDispatchNode extends S3DispatchNode { argList.add(arg); } } + + return executeHelper2(callerFrame, argList); + } + + @SlowPath + private Object executeHelper2(Frame callerFrame, List<Object> argList) { Object[] argObject = RArguments.createS3Args(targetFunction, argList.toArray()); VirtualFrame newFrame = Truffle.getRuntime().createVirtualFrame(argObject, new FrameDescriptor()); genCallEnv = callerFrame; @@ -63,6 +70,7 @@ public class UseMethodDispatchNode extends S3DispatchNode { return funCallNode.call(newFrame, targetFunction.getTarget(), argObject); } + @SlowPath private void findTargetFunction(Frame callerFrame) { for (int i = 0; i < this.type.getLength(); ++i) { findFunction(this.genericName, this.type.getDataAt(i), callerFrame); diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/debug/DebugTreeBuiltin.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/debug/DebugTreeBuiltin.java index c4fa1ff661248c9382e0d83bf43834b0534ee2c8..45e174593cf5247ad26d944866d93ea15e1d255b 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/debug/DebugTreeBuiltin.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/debug/DebugTreeBuiltin.java @@ -26,7 +26,6 @@ import static com.oracle.truffle.r.nodes.builtin.RBuiltinKind.*; import com.oracle.truffle.api.*; import com.oracle.truffle.api.dsl.*; -import com.oracle.truffle.api.impl.*; import com.oracle.truffle.api.nodes.*; import com.oracle.truffle.r.nodes.*; import com.oracle.truffle.r.nodes.access.*; @@ -53,16 +52,12 @@ public abstract class DebugTreeBuiltin extends RBuiltinNode { @Specialization public Object printTree(RFunction function, byte verbose) { controlVisibility(); - CallTarget target = function.getTarget(); - if (target instanceof DefaultCallTarget) { - RootNode root = ((DefaultCallTarget) target).getRootNode(); - if (verbose == RRuntime.LOGICAL_TRUE) { - return NodeUtil.printTreeToString(root); - } else { - return NodeUtil.printCompactTreeToString(root); - } + RootNode root = function.getTarget().getRootNode(); + if (verbose == RRuntime.LOGICAL_TRUE) { + return NodeUtil.printTreeToString(root); + } else { + return NodeUtil.printCompactTreeToString(root); } - return RNull.instance; } @Specialization diff --git a/com.oracle.truffle.r.parser/src/com/oracle/truffle/r/parser/ast/AssignVariable.java b/com.oracle.truffle.r.parser/src/com/oracle/truffle/r/parser/ast/AssignVariable.java index 9b5caa51c7cf4744a31d87b64f70004c8a8d0d72..75ba4d6fd52890fb7205b6b1060dd3394f1a7d50 100644 --- a/com.oracle.truffle.r.parser/src/com/oracle/truffle/r/parser/ast/AssignVariable.java +++ b/com.oracle.truffle.r.parser/src/com/oracle/truffle/r/parser/ast/AssignVariable.java @@ -81,6 +81,10 @@ public abstract class AssignVariable extends ASTNode { UpdateVector update = new UpdateVector(isSuper, lhs, rhs); lhs.args.add(ArgNode.create(rhs.getSource(), "value", rhs)); return update; + } else if (first instanceof FieldAccess) { + UpdateVector update = new UpdateVector(isSuper, lhs, rhs); + lhs.args.add(ArgNode.create(rhs.getSource(), "value", rhs)); + return update; } else if (first instanceof FunctionCall) { FunctionCall replacementFunc = (FunctionCall) first; FunctionCall func = new FunctionCall(replacementFunc.getSource(), replacementFunc.getLhs(), replacementFunc.getArgs()); @@ -114,6 +118,8 @@ public abstract class AssignVariable extends ASTNode { return new Replacement(src, isSuper, lhs, rhs); } else if (first instanceof AccessVector) { return new Replacement(src, isSuper, lhs, rhs); + } else if (first instanceof FieldAccess) { + return new Replacement(src, isSuper, lhs, rhs); } else { Utils.nyi(); // TODO here we need to flatten complex assignments } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java index 6438dabca0e882564ee19516857222fb6ddba865..c991fa2fe711defbec3134bb9779d00bb28e795f 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/Utils.java @@ -246,6 +246,7 @@ public final class Utils { /** * Retrieve the caller frame of the current frame. */ + @SlowPath public static Frame getCallerFrame(FrameAccess fa) { return getStackFrame(fa, 1); } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java index 1c74ebd953e4dcaa00ae0f12bb38bebf2afd263f..211a53126c0fd2a55eee458d6eb4893197553dcf 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/LapackRFFI.java @@ -34,20 +34,20 @@ public interface LapackRFFI extends RFFI { void ilaver(int[] version); /** - * See <a href="http://www.netlib.no/netlib/lapack/double/dgeev.f">spec</a>. + * See <a href="http://www.netlib.org/lapack/explore-html/d9/d28/dgeev_8f.html">spec</a>. */ // @formatter:off int dgeev(char jobVL, char jobVR, int n, double[] a, int lda, double[] wr, double[] wi, double[] vl, int ldvl, double[] vr, int ldvr, double[] work, int lwork); /** - * See <a href="http://www.netlib.no/netlib/lapack/double/dgeqp3.f">spec</a>. + * See <a href="http://www.netlib.org/lapack/explore-html/db/de5/dgeqp3_8f.html">spec</a>. */ // @formatter:off int dgeqp3(int m, int n, double[] a, int lda, int[] jpvt, double[] tau, double[] work, int lwork); /** - * See <a href="http://www.netlib.no/netlib/lapack/double/dormqr.f">spec</a>. + * See <a href="http://www.netlib.org/lapack/explore-html/da/d82/dormqr_8f.html">spec</a>. */ // @formatter:off int dormqr(char side, char trans, int m, int n, int k, double[] a, int lda, double[] tau, double[] c, int ldc, @@ -55,8 +55,26 @@ public interface LapackRFFI extends RFFI { /** - * See <a href="http://www.netlib.no/netlib/lapack/double/dtrtrs.f">spec</a>. + * See <a href="http://www.netlib.org/lapack/explore-html/d6/d6f/dtrtrs_8f.html">spec</a>. */ // @formatter:off int dtrtrs(char uplo, char trans, char diag, int n, int nrhs, double[] a, int lda, double[] b, int ldb); + + /** + * See <a href="http://www.netlib.org/lapack/explore-html/d3/d6a/dgetrf_8f.html">spec</a>. + */ + // @formatter:off + int dgetrf(int m, int n, double[] a, int lda, int[] ipiv); + + /** + * See <a href="http://www.netlib.org/lapack/explore-html/d0/d8a/dpotrf_8f.html">spec</a>. + */ + // @formatter:off + int dpotrf(char uplo, int n, double[] a, int lda); + + /** + * See <a href="http://www.netlib.org/lapack/explore-html/dd/dad/dpstrf_8f.html">spec</a>. + */ + // @formatter:off + int dpstrf(char uplo, int n, double[] a, int lda, int[] piv, int[] rank, double tol, double[] work); } diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java index c39ed8ba3ca075339a44828ac76a65e4047f3fda..d3985e1cea326b76868351f29fdc23d76e813588 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java @@ -31,6 +31,7 @@ import jnr.posix.*; import jnr.constants.platform.Errno; import com.oracle.truffle.api.*; +import com.oracle.truffle.api.CompilerDirectives.SlowPath; import com.oracle.truffle.r.runtime.ffi.*; /** @@ -57,9 +58,14 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp private static class LibCXProvider { private static LibCX libcx; + @SlowPath + private static LibCX createAndLoadLib() { + return LibraryLoader.create(LibCX.class).load("c"); + } + static LibCX libcx() { if (libcx == null) { - libcx = LibraryLoader.create(LibCX.class).load("c"); + libcx = createAndLoadLib(); } return libcx; } @@ -164,37 +170,42 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp */ public interface Lapack { // Checkstyle: stop method name + // @formatter:off void ilaver_(@Out int[] major, @Out int[] minor, @Out int[] patch); - // @formatter:off - // Checkstyle: stop method name void dgeev_(@In byte[] jobVL, @In byte[] jobVR, @In int[] n, @In double[] a, @In int[] lda, @Out double[] wr, @Out double[] wi, @Out double[] vl, @In int[] ldvl, @Out double[] vr, @In int[] ldvr, @Out double[] work, @In int[] lwork, @Out int[] info); - // @formatter:off - // Checkstyle: stop method name void dgeqp3_(@In int[] m, @In int[] n, double[] a, @In int[] lda, int[] jpvt, @Out double[] tau, @Out double[] work, @In int[] lwork, @Out int[] info); - // @formatter:off - // Checkstyle: stop method name - int dormqr_(@In byte[] side, @In byte[] trans, @In int[] m, @In int[] n, @In int[] k, @In double[] a, @In int[] lda, + void dormqr_(@In byte[] side, @In byte[] trans, @In int[] m, @In int[] n, @In int[] k, @In double[] a, @In int[] lda, @In double[] tau, double[] c, @In int[] ldc, @Out double[] work, @In int[] lwork, @Out int[] info); - // @formatter:off - // Checkstyle: stop method name - int dtrtrs_(@In byte[] uplo, @In byte[] trans, @In byte[] diag, @In int[] n, @In int[] nrhs, @In double[] a, @In int[] lda, + void dtrtrs_(@In byte[] uplo, @In byte[] trans, @In byte[] diag, @In int[] n, @In int[] nrhs, @In double[] a, @In int[] lda, double[] b, @In int[] ldb, @Out int[] info); -} + void dgetrf_(@In int[] m, @In int[] n, double[] a, @In int[] lda, @Out int[] ipiv, @Out int[] info); + + void dpotrf_(@In byte[] uplo, @In int[] n, double[] a, @In int[] lda, @Out int[] info); + + void dpstrf_(@In byte[] uplo, @In int[] n, double[] a, @In int[] lda, @Out int[] piv, @Out int[] rank, @In double[] tol, @Out double[] work, @Out int[] info); + } + + // @formatter:on private static class LapackProvider { private static Lapack lapack; + @SlowPath + private static Lapack createAndLoadLib() { + return LibraryLoader.create(Lapack.class).load("Rlapack"); + } + static Lapack lapack() { if (lapack == null) { - lapack = LibraryLoader.create(Lapack.class).load("Rlapack"); + lapack = createAndLoadLib(); } return lapack; } @@ -317,6 +328,51 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp return RefScalars_dtrtrs.info[0]; } + private static class RefScalars_dgetrf { + static int[] m = new int[1]; + static int[] n = new int[1]; + static int[] lda = new int[1]; + static int[] info = new int[1]; + } + + public int dgetrf(int m, int n, double[] a, int lda, int[] ipiv) { + RefScalars_dgetrf.m[0] = m; + RefScalars_dgetrf.n[0] = n; + RefScalars_dgetrf.lda[0] = lda; + lapack().dgetrf_(RefScalars_dgetrf.m, RefScalars_dgetrf.n, a, RefScalars_dgetrf.lda, ipiv, RefScalars_dgetrf.info); + return RefScalars_dgetrf.info[0]; + } + + private static class RefScalars_dpotrf { + static byte[] uplo = new byte[1]; + static int[] n = new int[1]; + static int[] lda = new int[1]; + static int[] info = new int[1]; + } + + + public int dpotrf(char uplo, int n, double[] a, int lda) { + RefScalars_dpotrf.uplo[0] = (byte) uplo; + RefScalars_dpotrf.n[0] = n; + RefScalars_dpotrf.lda[0] = lda; + lapack().dpotrf_(RefScalars_dpotrf.uplo, RefScalars_dpotrf.n, a, RefScalars_dpotrf.lda, RefScalars_dpotrf.info); + return RefScalars_dpotrf.info[0]; + } + + private static class RefScalars_dpstrf extends RefScalars_dpotrf { + static double[] tol = new double[1]; + } + + public int dpstrf(char uplo, int n, double[] a, int lda, int[] piv, int[] rank, double tol, double[] work) { + RefScalars_dpstrf.uplo[0] = (byte) uplo; + RefScalars_dpstrf.n[0] = n; + RefScalars_dpstrf.lda[0] = lda; + RefScalars_dpstrf.tol[0] = tol; + lapack().dpstrf_(RefScalars_dpstrf.uplo, RefScalars_dpstrf.n, a, RefScalars_dpstrf.lda, piv, rank, RefScalars_dpstrf.tol, work, RefScalars_dpstrf.info); + return RefScalars_dpstrf.info[0]; + } + + /* * Linpack functions */ @@ -336,9 +392,14 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp private static class LinpackProvider { private static Linpack linpack; + @SlowPath + private static Linpack createAndLoadLib() { + return LibraryLoader.create(Linpack.class).load("R"); + } + static Linpack linpack() { if (linpack == null) { - linpack = LibraryLoader.create(Linpack.class).load("R"); + linpack = createAndLoadLib(); } return linpack; } @@ -403,9 +464,14 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp UserRngProvider.libPath = libPath; } + @SlowPath + private static UserRng createAndLoadLib() { + return LibraryLoader.create(UserRng.class).load(libPath); + } + static UserRng userRng() { if (userRng == null) { - userRng = LibraryLoader.create(UserRng.class).load(libPath); + userRng = createAndLoadLib(); } return userRng; } @@ -455,5 +521,4 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, Linp return cRFFI; } - } 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 1ca3daae2f1f4059efb33bba951530700c84c48a..d766979e4a6636d6186bd0cce12ceb8b67daab4a 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 @@ -8892,6 +8892,14 @@ Error: object 'x' not found ##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSimpleRm #{ x <- 200 ; rm("x") } +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSort +#{ sort(c(1L,10L,2L)) } +[1] 1 2 10 + +##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSort +#{ sort(c(3,10,2)) } +[1] 2 3 10 + ##com.oracle.truffle.r.test.simple.TestSimpleBuiltins.testSprintf #{ sprintf("%03d", 1:3) } [1] "001" "002" "003" @@ -48803,6 +48811,26 @@ Error in x[[c("a", "b")]] : attempt to select more than one element #{ x<-c(1,2); x[c("a", "b")] } [1] NA NA +##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther +#{ x<-c(1,2); y<-list(a=x); names(y$a)<-"c"; names(y$a) } +[1] "c" NA + +##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther +#{ x<-c(1,2); y<-list(a=x); names(y[1])<-"c"; names(y[1]) } +[1] "a" + +##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther +#{ x<-c(1,2); y<-list(a=x); names(y[1])<-"c"; names(y[[1]]) } +NULL + +##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther +#{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-"c"; names(y[1]) } +[1] "a" + +##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther +#{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-"c"; names(y[[1]]) } +[1] "c" NA + ##com.oracle.truffle.r.test.simple.TestSimpleVectors.testMoreVectorsOther #{ x<-c(1,2,3); x[[-1]]<-7 } Error in x[[-1]] <- 7 : attempt to select more than one element diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java index 31ac49e5519ec446ae59c3cfbb9ad077949ddf54..dc3535b68973d0d1dcb1f0ff23421509f24b640e 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/all/AllTests.java @@ -10749,72 +10749,72 @@ public class AllTests extends TestBase { } @Test - public void TestSimpleBuiltins_testSort_6a592c6f57c71c5d15a2ca0155fee884() { + public void TestSimpleBuiltins_testSortIgnore_6a592c6f57c71c5d15a2ca0155fee884() { assertEval("{ sort(c(1,2,0/0,NA)) }"); } @Test - public void TestSimpleBuiltins_testSort_5aa86dc4ae1bb25c682d61e872e9b040() { + public void TestSimpleBuiltins_testSortIgnore_5aa86dc4ae1bb25c682d61e872e9b040() { assertEval("{ sort(c(2,1,0/0,NA), na.last=NA) }"); } @Test - public void TestSimpleBuiltins_testSort_6a7ec5187507fa97abda94b64f5a079d() { + public void TestSimpleBuiltins_testSortIgnore_6a7ec5187507fa97abda94b64f5a079d() { assertEval("{ sort(c(3,0/0,2,NA), na.last=TRUE) }"); } @Test - public void TestSimpleBuiltins_testSort_b5d4d0684b5f7ae93abbd963d09e2547() { + public void TestSimpleBuiltins_testSortIgnore_b5d4d0684b5f7ae93abbd963d09e2547() { assertEval("{ sort(c(3,NA,0/0,2), na.last=FALSE) }"); } @Test - public void TestSimpleBuiltins_testSort_ccb733ea6a05ce0344a90278f6b60239() { + public void TestSimpleBuiltins_testSortIgnore_ccb733ea6a05ce0344a90278f6b60239() { assertEval("{ sort(c(3L,NA,2L)) }"); } @Test - public void TestSimpleBuiltins_testSort_894104e630b40ec41f7a3242c9dd48bb() { + public void TestSimpleBuiltins_testSortIgnore_894104e630b40ec41f7a3242c9dd48bb() { assertEval("{ sort(c(3L,NA,-2L), na.last=TRUE) }"); } @Test - public void TestSimpleBuiltins_testSort_7371476317ce19939f96f4a8546a66ca() { + public void TestSimpleBuiltins_testSortIgnore_7371476317ce19939f96f4a8546a66ca() { assertEval("{ sort(c(3L,NA,-2L), na.last=FALSE) }"); } @Test - public void TestSimpleBuiltins_testSort_b2088bf4f79792e07aeb1878814c42dd() { + public void TestSimpleBuiltins_testSortIgnore_b2088bf4f79792e07aeb1878814c42dd() { assertEval("{ sort(c(a=NA,b=NA,c=3,d=1),na.last=TRUE, decreasing=TRUE) }"); } @Test - public void TestSimpleBuiltins_testSort_7cfdc805071697201c562b5f50ebd539() { + public void TestSimpleBuiltins_testSortIgnore_7cfdc805071697201c562b5f50ebd539() { assertEval("{ sort(c(a=NA,b=NA,c=3,d=1),na.last=FALSE, decreasing=FALSE) }"); } @Test - public void TestSimpleBuiltins_testSort_ac8a4c1d13606a72e3e1b8c439efda29() { + public void TestSimpleBuiltins_testSortIgnore_ac8a4c1d13606a72e3e1b8c439efda29() { assertEval("{ sort(c(a=0/0,b=1/0,c=3,d=NA),na.last=TRUE, decreasing=FALSE) }"); } @Test - public void TestSimpleBuiltins_testSort_519a0465d477a73e1db30d78e8776c1b() { + public void TestSimpleBuiltins_testSortIgnore_519a0465d477a73e1db30d78e8776c1b() { assertEval("{ sort(double()) }"); } @Test - public void TestSimpleBuiltins_testSort_df4ed76c79e6d77ac09a69738271e1fd() { + public void TestSimpleBuiltins_testSortIgnore_df4ed76c79e6d77ac09a69738271e1fd() { assertEval("{ sort(c(a=NA,b=NA,c=3L,d=-1L),na.last=TRUE, decreasing=FALSE) }"); } @Test - public void TestSimpleBuiltins_testSort_2ce0809f50d42943354aa60d00cd1a90() { + public void TestSimpleBuiltins_testSortIgnore_2ce0809f50d42943354aa60d00cd1a90() { assertEval("{ sort(c(3,NA,1,d=10), decreasing=FALSE, index.return=TRUE) }"); } @Test - public void TestSimpleBuiltins_testSort_9f37df375d06bb45b37c5fe0fb3d1b54() { + public void TestSimpleBuiltins_testSortIgnore_9f37df375d06bb45b37c5fe0fb3d1b54() { assertEval("{ sort(3:1, index.return=TRUE) }"); } @@ -18258,6 +18258,31 @@ public class AllTests extends TestBase { assertEval("{ x <- c(\"a\", \"b\"); y<-c(\"c\",\"d\"); y[integer()]<-x[integer()]; y}"); } + @Test + public void TestSimpleVectors_testMoreVectorsOther_c898a1db9a39fc0bb17348530e813559() { + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[1])<-\"c\"; names(y[1]) }"); + } + + @Test + public void TestSimpleVectors_testMoreVectorsOther_e7b9c328eab1e9a9ce555eb72cda0e73() { + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[1])<-\"c\"; names(y[[1]]) }"); + } + + @Test + public void TestSimpleVectors_testMoreVectorsOther_7380a1c12d0947c93f6fe17f699f47ef() { + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-\"c\"; names(y[1]) }"); + } + + @Test + public void TestSimpleVectors_testMoreVectorsOther_0dbab0e6cc14b37e5e232dc8e2139b9b() { + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-\"c\"; names(y[[1]]) }"); + } + + @Test + public void TestSimpleVectors_testMoreVectorsOther_7d22c81f66c115bf9e0b5ba86a0e501f() { + assertEval("{ x<-c(1,2); y<-list(a=x); names(y$a)<-\"c\"; names(y$a) }"); + } + @Test public void TestSimpleVectors_testMoreVectorsOther_23e220f9c43711417c97b6024e96b424() { assertEvalError("{ x<-c(1,2); x[[c(\"a\")]] }"); diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java index 41b49ba00c12274c14312f40350b8cec4cf93201..54995a771b8af061f6b747ca1446f4ac2c38e275 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/failing/FailingTests.java @@ -2149,82 +2149,72 @@ public class FailingTests extends TestBase { } @Ignore - public void TestSimpleBuiltins_testSort_284b7e7d187c6ab2e4fa9e4409153a7b() { - assertEval("{ sort(c(1L,10L,2L)) }"); - } - - @Ignore - public void TestSimpleBuiltins_testSort_1fd4d093837b7d126d0ef7530e43c343() { - assertEval("{ sort(c(3,10,2)) }"); - } - - @Ignore - public void TestSimpleBuiltins_testSort_6a592c6f57c71c5d15a2ca0155fee884() { + public void TestSimpleBuiltins_testSortIgnore_6a592c6f57c71c5d15a2ca0155fee884() { assertEval("{ sort(c(1,2,0/0,NA)) }"); } @Ignore - public void TestSimpleBuiltins_testSort_5aa86dc4ae1bb25c682d61e872e9b040() { + public void TestSimpleBuiltins_testSortIgnore_5aa86dc4ae1bb25c682d61e872e9b040() { assertEval("{ sort(c(2,1,0/0,NA), na.last=NA) }"); } @Ignore - public void TestSimpleBuiltins_testSort_6a7ec5187507fa97abda94b64f5a079d() { + public void TestSimpleBuiltins_testSortIgnore_6a7ec5187507fa97abda94b64f5a079d() { assertEval("{ sort(c(3,0/0,2,NA), na.last=TRUE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_b5d4d0684b5f7ae93abbd963d09e2547() { + public void TestSimpleBuiltins_testSortIgnore_b5d4d0684b5f7ae93abbd963d09e2547() { assertEval("{ sort(c(3,NA,0/0,2), na.last=FALSE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_ccb733ea6a05ce0344a90278f6b60239() { + public void TestSimpleBuiltins_testSortIgnore_ccb733ea6a05ce0344a90278f6b60239() { assertEval("{ sort(c(3L,NA,2L)) }"); } @Ignore - public void TestSimpleBuiltins_testSort_894104e630b40ec41f7a3242c9dd48bb() { + public void TestSimpleBuiltins_testSortIgnore_894104e630b40ec41f7a3242c9dd48bb() { assertEval("{ sort(c(3L,NA,-2L), na.last=TRUE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_7371476317ce19939f96f4a8546a66ca() { + public void TestSimpleBuiltins_testSortIgnore_7371476317ce19939f96f4a8546a66ca() { assertEval("{ sort(c(3L,NA,-2L), na.last=FALSE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_b2088bf4f79792e07aeb1878814c42dd() { + public void TestSimpleBuiltins_testSortIgnore_b2088bf4f79792e07aeb1878814c42dd() { assertEval("{ sort(c(a=NA,b=NA,c=3,d=1),na.last=TRUE, decreasing=TRUE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_7cfdc805071697201c562b5f50ebd539() { + public void TestSimpleBuiltins_testSortIgnore_7cfdc805071697201c562b5f50ebd539() { assertEval("{ sort(c(a=NA,b=NA,c=3,d=1),na.last=FALSE, decreasing=FALSE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_ac8a4c1d13606a72e3e1b8c439efda29() { + public void TestSimpleBuiltins_testSortIgnore_ac8a4c1d13606a72e3e1b8c439efda29() { assertEval("{ sort(c(a=0/0,b=1/0,c=3,d=NA),na.last=TRUE, decreasing=FALSE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_519a0465d477a73e1db30d78e8776c1b() { + public void TestSimpleBuiltins_testSortIgnore_519a0465d477a73e1db30d78e8776c1b() { assertEval("{ sort(double()) }"); } @Ignore - public void TestSimpleBuiltins_testSort_df4ed76c79e6d77ac09a69738271e1fd() { + public void TestSimpleBuiltins_testSortIgnore_df4ed76c79e6d77ac09a69738271e1fd() { assertEval("{ sort(c(a=NA,b=NA,c=3L,d=-1L),na.last=TRUE, decreasing=FALSE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_2ce0809f50d42943354aa60d00cd1a90() { + public void TestSimpleBuiltins_testSortIgnore_2ce0809f50d42943354aa60d00cd1a90() { assertEval("{ sort(c(3,NA,1,d=10), decreasing=FALSE, index.return=TRUE) }"); } @Ignore - public void TestSimpleBuiltins_testSort_9f37df375d06bb45b37c5fe0fb3d1b54() { + public void TestSimpleBuiltins_testSortIgnore_9f37df375d06bb45b37c5fe0fb3d1b54() { assertEval("{ sort(3:1, index.return=TRUE) }"); } diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java index 7ab49eb75cd6e7fa027d2e59a06ec504fc20981f..42a620ec19910ad5ffa1842ede2fd13924db113c 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleBuiltins.java @@ -1942,10 +1942,14 @@ public class TestSimpleBuiltins extends TestBase { } @Test - @Ignore public void testSort() { assertEval("{ sort(c(1L,10L,2L)) }"); assertEval("{ sort(c(3,10,2)) }"); + } + + @Test + @Ignore + public void testSortIgnore() { assertEval("{ sort(c(1,2,0/0,NA)) }"); assertEval("{ sort(c(2,1,0/0,NA), na.last=NA) }"); assertEval("{ sort(c(3,0/0,2,NA), na.last=TRUE) }"); diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleVectors.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleVectors.java index 6fc7673f0b6c4c04ed606808340d72fd47295ffc..e6b4be29e294c4a7f849f95847966c7daf9e0250 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleVectors.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/simple/TestSimpleVectors.java @@ -488,6 +488,12 @@ public class TestSimpleVectors extends TestBase { assertEval("{ x <- c(\"a\", \"b\"); y<-NULL; y[integer()]<-x[integer()]; y }"); assertEval("{ x <- c(\"a\", \"b\"); y<-c(\"c\",\"d\"); y[integer()]<-x[integer()]; y}"); + + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[1])<-\"c\"; names(y[1]) }"); + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[1])<-\"c\"; names(y[[1]]) }"); + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-\"c\"; names(y[1]) }"); + assertEval("{ x<-c(1,2); y<-list(a=x); names(y[[1]])<-\"c\"; names(y[[1]]) }"); + assertEval("{ x<-c(1,2); y<-list(a=x); names(y$a)<-\"c\"; names(y$a) }"); } @Test diff --git a/mx.fastr/imports b/mx.fastr/imports index fcfaaa3c23f88314e488e1036a6b34e74d111c43..142df540a65705b3f1d72021f9a4b59949ee0545 100644 --- a/mx.fastr/imports +++ b/mx.fastr/imports @@ -1 +1 @@ -graal,fa04403d1cb56a78a87ada2a063aa956108de209,http://hg.openjdk.java.net/graal/graal +graal,77783d8a45efc26903119725189560e191727621,http://hg.openjdk.java.net/graal/graal diff --git a/mx.fastr/mx_fastr.py b/mx.fastr/mx_fastr.py index e121ccfcc530632e4418c431b10143cc9916c6b3..dc4ff5eaa05fa1e34c16776616717c00045d01cd 100644 --- a/mx.fastr/mx_fastr.py +++ b/mx.fastr/mx_fastr.py @@ -257,7 +257,8 @@ def _bench_harness_body(args, vmArgs): 'shootout.knucleotide', 'shootout.mandelbrot-ascii', 'shootout.nbody', 'shootout.pidigits', 'shootout.regexdna', 'shootout.reversecomplement', 'shootout.spectralnorm', 'b25.bench.prog-1', 'b25.bench.prog-2', 'b25.bench.prog-3', 'b25.bench.prog-4', 'b25.bench.prog-5', - 'b25.bench.matcal-1', 'b25.bench.matcal-2'] + 'b25.bench.matcal-1', 'b25.bench.matcal-2', + 'b25.bench.matfunc-2', 'b25.bench.matfunc-3', 'b25.bench.matfunc-4'] if vmArgs: marks = ['--J', vmArgs] + marks return rbench(marks)