Skip to content
Snippets Groups Projects
Commit 6224ba9f authored by stepan's avatar stepan
Browse files

CAR/CDR and related macros refactored + support for RSymbol and RNull for all variants

parent df4ac095
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
+ 106
− 147
View file @ 6224ba9f
/* /*
* Copyright (c) 2017, 2017, Oracle and/or its affiliates. All rights reserved. * Copyright (c) 2017, 2018, Oracle and/or its affiliates. All rights reserved.
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
* *
* This code is free software; you can redistribute it and/or modify it * This code is free software; you can redistribute it and/or modify it
...@@ -26,15 +26,7 @@ import com.oracle.truffle.api.dsl.Cached; ...@@ -26,15 +26,7 @@ import com.oracle.truffle.api.dsl.Cached;
import com.oracle.truffle.api.dsl.Fallback; import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.dsl.TypeSystemReference; import com.oracle.truffle.api.dsl.TypeSystemReference;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CAARNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CAD4RNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADDDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CARNodeGen; import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CARNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDARNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDDDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDRNodeGen; import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.SETCARNodeGen; import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.SETCARNodeGen;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode; import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
...@@ -98,57 +90,6 @@ public final class ListAccessNodes { ...@@ -98,57 +90,6 @@ public final class ListAccessNodes {
} }
} }
@TypeSystemReference(RTypes.class)
public abstract static class CAARNode extends FFIUpCallNode.Arg1 {
@Child private CARNode car1 = CARNode.create();
@Child private CARNode car2 = CARNode.create();
@Specialization
protected Object caar(Object value) {
return car2.executeObject(car1.executeObject(value));
}
public static CAARNode create() {
return CAARNodeGen.create();
}
}
@TypeSystemReference(RTypes.class)
public static final class SETCADRNode extends FFIUpCallNode.Arg2 {
@Child private SETCARNode setcarNode = SETCARNode.create();
@Child private CDRNode cdrNode = CDRNode.create();
@Override
public Object executeObject(Object x, Object y) {
return setcarNode.executeObject(cdrNode.executeObject(x), y);
}
}
@TypeSystemReference(RTypes.class)
public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
public static SETCARNode create() {
return SETCARNodeGen.create();
}
@Specialization
protected Object doRLang(RLanguage x, Object y) {
x.getPairList().setCar(y);
return y;
}
@Specialization
protected Object doRLang(RPairList x, Object y) {
x.setCar(y);
return y;
}
@Fallback
protected Object car(@SuppressWarnings("unused") Object x, @SuppressWarnings("unused") Object y) {
throw RInternalError.unimplemented("SETCAR only works on pair lists or language objects");
}
}
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CDRNode extends FFIUpCallNode.Arg1 { public abstract static class CDRNode extends FFIUpCallNode.Arg1 {
@Specialization @Specialization
...@@ -183,6 +124,16 @@ public final class ListAccessNodes { ...@@ -183,6 +124,16 @@ public final class ListAccessNodes {
return copy; return copy;
} }
@Specialization
protected RNull cdr(@SuppressWarnings("unused") RSymbol symbol) {
return RNull.instance;
}
@Specialization
protected RNull handleNull(@SuppressWarnings("unused") RNull rNull) {
return rNull;
}
@Fallback @Fallback
protected Object cdr(@SuppressWarnings("unused") Object obj) { protected Object cdr(@SuppressWarnings("unused") Object obj) {
throw RInternalError.unimplemented("CDR only works on pair lists, language objects, and argument lists"); throw RInternalError.unimplemented("CDR only works on pair lists, language objects, and argument lists");
...@@ -194,153 +145,161 @@ public final class ListAccessNodes { ...@@ -194,153 +145,161 @@ public final class ListAccessNodes {
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CADRNode extends FFIUpCallNode.Arg1 { public static final class CAARNode extends FFIUpCallNode.Arg1 {
@Child private CARNode car1 = CARNode.create();
@Child private CARNode car2 = CARNode.create();
@Override
public Object executeObject(Object x) {
return car2.executeObject(car1.executeObject(x));
}
public static CAARNode create() {
return new CAARNode();
}
}
@TypeSystemReference(RTypes.class)
public static final class SETCADRNode extends FFIUpCallNode.Arg2 {
@Child private SETCARNode setcarNode = SETCARNode.create();
@Child private CDRNode cdrNode = CDRNode.create();
@Override
public Object executeObject(Object x, Object y) {
return setcarNode.executeObject(cdrNode.executeObject(x), y);
}
}
@TypeSystemReference(RTypes.class)
public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
public static SETCARNode create() {
return SETCARNodeGen.create();
}
@Specialization @Specialization
protected Object cadr(RPairList pl) { protected Object doRLang(RLanguage x, Object y) {
return pl.cadr(); x.getPairList().setCar(y);
return y;
} }
@Specialization @Specialization
protected Object cadr(RLanguage lang) { protected Object doRPairList(RPairList x, Object y) {
return lang.getDataAtAsObject(1); x.setCar(y);
return y;
} }
@Fallback @Fallback
protected Object cadr(@SuppressWarnings("unused") Object obj) { protected Object car(@SuppressWarnings("unused") Object x, @SuppressWarnings("unused") Object y) {
throw RInternalError.unimplemented("CADR only works on pair lists and language objects"); throw RInternalError.unimplemented("SETCAR only works on pair lists or language objects");
}
}
@TypeSystemReference(RTypes.class)
public static final class CADRNode extends FFIUpCallNode.Arg1 {
@Child private CDRNode cdr = CDRNode.create();
@Child private CARNode car = CARNode.create();
@Override
public Object executeObject(Object x) {
return car.executeObject(cdr.executeObject(x));
} }
public static CADRNode create() { public static CADRNode create() {
return CADRNodeGen.create(); return new CADRNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CDARNode extends FFIUpCallNode.Arg1 { public static final class CDARNode extends FFIUpCallNode.Arg1 {
@Child private CARNode car = CARNode.create(); @Child private CARNode car = CARNode.create();
@Child private CDRNode cdr = CDRNode.create(); @Child private CDRNode cdr = CDRNode.create();
@Specialization @Override
protected Object cdar(Object value) { public Object executeObject(Object x) {
return cdr.executeObject(car.executeObject(value)); return cdr.executeObject(car.executeObject(x));
} }
public static CDARNode create() { public static CDARNode create() {
return CDARNodeGen.create(); return new CDARNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CADDRNode extends FFIUpCallNode.Arg1 { public static final class CADDRNode extends FFIUpCallNode.Arg1 {
@Specialization @Child private CARNode car = CARNode.create();
protected Object caddr(RPairList pl) { @Child private CDRNode cdr1 = CDRNode.create();
return pl.caddr(); @Child private CDRNode cdr2 = CDRNode.create();
}
@Specialization
protected Object caddr(RLanguage lang) {
return lang.getDataAtAsObject(2);
}
@Fallback @Override
protected Object caddr(@SuppressWarnings("unused") Object obj) { public Object executeObject(Object x) {
throw RInternalError.unimplemented("CADDR only works on pair lists and language objects"); return car.executeObject(cdr1.executeObject(cdr2.executeObject(x)));
} }
public static CADDRNode create() { public static CADDRNode create() {
return CADDRNodeGen.create(); return new CADDRNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CADDDRNode extends FFIUpCallNode.Arg1 { public static final class CADDDRNode extends FFIUpCallNode.Arg1 {
@Specialization @Child private CARNode car = CARNode.create();
protected Object cadddr(RPairList pl) { @Child private CDRNode cdr1 = CDRNode.create();
RPairList tmp = (RPairList) pl.cddr(); @Child private CDRNode cdr2 = CDRNode.create();
return tmp.cadr(); @Child private CDRNode cdr3 = CDRNode.create();
}
@Specialization
protected Object cadddr(RLanguage lang) {
return lang.getDataAtAsObject(3);
}
@Fallback @Override
protected Object cadddr(@SuppressWarnings("unused") Object obj) { public Object executeObject(Object x) {
throw RInternalError.unimplemented("CADDDR only works on pair lists and language objects"); return car.executeObject(cdr1.executeObject(cdr2.executeObject(cdr3.executeObject(x))));
} }
public static CADDDRNode create() { public static CADDDRNode create() {
return CADDDRNodeGen.create(); return new CADDDRNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CAD4RNode extends FFIUpCallNode.Arg1 { public static final class CAD4RNode extends FFIUpCallNode.Arg1 {
@Specialization @Child private CADDDRNode cadddr = CADDDRNode.create();
protected Object cad4r(RPairList pl) { @Child private CDRNode cdr = CDRNode.create();
RPairList tmp = (RPairList) pl.cddr();
return tmp.caddr();
}
@Specialization
protected Object cad4r(RLanguage lang) {
return lang.getDataAtAsObject(4);
}
@Fallback @Override
protected Object cad4r(@SuppressWarnings("unused") Object obj) { public Object executeObject(Object x) {
throw RInternalError.unimplemented("CAD4R only works on pair lists and language objects"); return cadddr.executeObject(cdr.executeObject(x));
} }
public static CAD4RNode create() { public static CAD4RNode create() {
return CAD4RNodeGen.create(); return new CAD4RNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CDDRNode extends FFIUpCallNode.Arg1 { public static final class CDDRNode extends FFIUpCallNode.Arg1 {
@Specialization @Child private CDRNode cdr1 = CDRNode.create();
protected Object cddr(RPairList pl) { @Child private CDRNode cdr2 = CDRNode.create();
return pl.cddr();
}
@Specialization @Override
protected Object cddr(RLanguage lang) { public Object executeObject(Object x) {
RPairList l = lang.getPairList(); return cdr1.executeObject(cdr2.executeObject(x));
return l.cddr();
}
@Fallback
protected Object cddr(@SuppressWarnings("unused") Object obj) {
throw RInternalError.unimplemented("CDDR only works on pair lists and language objects");
} }
public static CDDRNode create() { public static CDDRNode create() {
return CDDRNodeGen.create(); return new CDDRNode();
} }
} }
@TypeSystemReference(RTypes.class) @TypeSystemReference(RTypes.class)
public abstract static class CDDDRNode extends FFIUpCallNode.Arg1 { public static final class CDDDRNode extends FFIUpCallNode.Arg1 {
@Specialization @Child CDDRNode cddr = CDDRNode.create();
protected Object cdddr(RPairList pl) { @Child CDRNode cdr = CDRNode.create();
return pl.cddr();
}
@Specialization
protected Object cdddr(RLanguage lang) {
RPairList l = (RPairList) lang.getPairList().cddr();
return l.cdr();
}
@Fallback @Override
protected Object cdddr(@SuppressWarnings("unused") Object obj) { public Object executeObject(Object x) {
throw RInternalError.unimplemented("CDDDR only works on pair lists and language objects"); return cdr.executeObject(cddr.executeObject(x));
} }
public static CDDDRNode create() { public static CDDDRNode create() {
return CDDDRNodeGen.create(); return new CDDDRNode();
} }
} }
} }
com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+ 5
− 0
View file @ 6224ba9f
...@@ -114,3 +114,8 @@ for(i in seq(5000)) { ...@@ -114,3 +114,8 @@ for(i in seq(5000)) {
# Following code calls Rf_eval with a language object that contains a promise instead of the expected function # Following code calls Rf_eval with a language object that contains a promise instead of the expected function
set.seed(42) set.seed(42)
rffi.RfEvalWithPromiseInPairList() rffi.RfEvalWithPromiseInPairList()
# CAR/CDR tests
rffi.CAR(NULL)
rffi.CDR(NULL)
rffi.CAR(as.symbol('a'))
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment