diff --git a/language/pom.xml b/language/pom.xml index c7ae315..1bb0598 100644 --- a/language/pom.xml +++ b/language/pom.xml @@ -20,11 +20,24 @@ test + + org.graalvm.polyglot + js-community + pom + test + + org.graalvm.truffle truffle-api + + org.graalvm.truffle + truffle-runtime + runtime + + org.graalvm.truffle truffle-dsl-processor diff --git a/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java b/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java index 2cdfe79..a5861ab 100644 --- a/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java +++ b/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java @@ -136,6 +136,7 @@ void initGlobalFunctions() { initGlobalFunction("error-output", ISLISPErrorOutputStream::makeLispFunction); initGlobalFunction("eq", ISLISPEq::makeLispFunction); initGlobalFunction("equal", ISLISPEqual::makeLispFunction); + initGlobalFunction("eval", ISLISPEval::makeLispFunction); initGlobalFunction("format", ISLISPFormat::makeLispFunction); initGlobalFunction("format-char", ISLISPFormatChar::makeLispFunction); initGlobalFunction("format-integer", ISLISPFormatInteger::makeLispFunction); @@ -167,6 +168,7 @@ void initGlobalFunctions() { //extension initGlobalFunction("current-stacktrace", ISLISPCurrentStacktrace::makeLispFunction); initGlobalFunction("exit", ISLISPExit::makeLispFunction); + initGlobalFunction("truffle-object-fields", ISLISPTruffleObjectFields::makeLispFunction); } private void initInitializeObjectMethod() { @@ -269,6 +271,9 @@ void initBuiltinClasses() { initBuiltin("", ""); initBuiltin("", ""); initBuiltin("", ""); + + //truffle interop + initBuiltin("", ""); } /** diff --git a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPClassOf.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPClassOf.java index b11ef42..7edd7dd 100644 --- a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPClassOf.java +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPClassOf.java @@ -10,6 +10,8 @@ import com.oracle.truffle.api.dsl.Fallback; import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.library.CachedLibrary; import com.oracle.truffle.api.nodes.RootNode; /** @@ -132,6 +134,17 @@ LispClass doArray( return arrayClass; } + @Specialization(guards = { + "interop.hasMembers(o)" + }, limit = "3") + LispClass doTruffleInteropObject( + Object o, + @CachedLibrary("o") InteropLibrary interop, + @Cached("loadTruffleObjectClass()") LispClass truffleObjectClass + ) { + return truffleObjectClass; + } + @Fallback @CompilerDirectives.TruffleBoundary LispClass doFallback(Object value) { @@ -182,6 +195,10 @@ LispClass loadArrayClass() { return loadClass(""); } + LispClass loadTruffleObjectClass() { + return loadClass(""); + } + LispClass loadClass(String name) { var ctx = ISLISPContext.get(this); var symbol = ctx.namedSymbol(name); diff --git a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPEval.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPEval.java new file mode 100644 index 0000000..c8c7e9e --- /dev/null +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPEval.java @@ -0,0 +1,58 @@ +package com.github.arvyy.islisp.functions; + +import com.github.arvyy.islisp.ISLISPContext; +import com.github.arvyy.islisp.nodes.ISLISPErrorSignalerNode; +import com.github.arvyy.islisp.runtime.LispFunction; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.nodes.RootNode; +import com.oracle.truffle.api.source.Source; + +/** + * Implements `eval` function used for interop with other truffle languages. + */ +public class ISLISPEval extends RootNode { + + @Child + private ISLISPErrorSignalerNode errorSignalerNode; + + ISLISPEval(TruffleLanguage lang) { + super(lang); + errorSignalerNode = new ISLISPErrorSignalerNode(this); + } + + @Override + public Object execute(VirtualFrame frame) { + if (frame.getArguments().length != 3) { + return errorSignalerNode.signalWrongArgumentCount( + frame.getArguments().length - 1, + 2, + 2); + } + var lang = (String) frame.getArguments()[1]; + var ctx = ISLISPContext.get(this); + var env = ctx.getEnv(); + /* + var filePath = (String) frame.getArguments()[2]; + var file = env.getPublicTruffleFile(filePath); + */ + var script = (String) frame.getArguments()[2]; + try { + var source = Source.newBuilder(lang, script, "").build(); + var target = env.parsePublic(source); + return target.call(); + } catch (Exception e) { + throw new RuntimeException(e); + } + } + + /** + * Construct LispFunction using this root node. + * + * @param lang truffle language reference + * @return lisp function + */ + public static LispFunction makeLispFunction(TruffleLanguage lang) { + return new LispFunction(new ISLISPEval(lang).getCallTarget()); + } +} diff --git a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPTruffleObjectFields.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPTruffleObjectFields.java new file mode 100644 index 0000000..3723608 --- /dev/null +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPTruffleObjectFields.java @@ -0,0 +1,81 @@ +package com.github.arvyy.islisp.functions; + +import com.github.arvyy.islisp.ISLISPContext; +import com.github.arvyy.islisp.exceptions.ISLISPError; +import com.github.arvyy.islisp.nodes.ISLISPErrorSignalerNode; +import com.github.arvyy.islisp.runtime.LispFunction; +import com.github.arvyy.islisp.runtime.LispVector; +import com.oracle.truffle.api.TruffleLanguage; +import com.oracle.truffle.api.dsl.Fallback; +import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.interop.InvalidArrayIndexException; +import com.oracle.truffle.api.interop.UnsupportedMessageException; +import com.oracle.truffle.api.library.CachedLibrary; +import com.oracle.truffle.api.nodes.RootNode; + +/** + * Implements `truffle-object-fields` function, which returns fields as a list of strings + * in a given object. + */ +public abstract class ISLISPTruffleObjectFields extends RootNode { + + @Child + private ISLISPErrorSignalerNode errorSignalerNode; + + ISLISPTruffleObjectFields(TruffleLanguage language) { + super(language); + errorSignalerNode = new ISLISPErrorSignalerNode(this); + } + + @Override + public final Object execute(VirtualFrame frame) { + if (frame.getArguments().length != 2) { + return errorSignalerNode.signalWrongArgumentCount(frame.getArguments().length - 1, 1, 1); + } + try { + return executeGeneric(frame.getArguments()[1]); + } catch (Exception e) { + throw new ISLISPError(e.getMessage(), this); + } + } + + abstract Object executeGeneric(Object obj) throws UnsupportedMessageException, InvalidArrayIndexException; + + @Specialization(guards = { + "interopLibrary.hasMembers(o)" + }, limit = "3") + Object doTruffleInterop( + Object o, + @CachedLibrary("o") InteropLibrary interopLibrary + ) throws UnsupportedMessageException, InvalidArrayIndexException { + InteropLibrary uncached = InteropLibrary.getUncached(); + var membersInterop = interopLibrary.getMembers(o); + var copy = new Object[(int) uncached.getArraySize(membersInterop)]; + for (int i = 0; i < copy.length; i++) { + var fieldInterop = uncached.readArrayElement(membersInterop, i); + var field = uncached.asString(fieldInterop); + copy[i] = field; + } + return new LispVector(copy); + } + + @Fallback + Object fallback(Object o) { + var ctx = ISLISPContext.get(this); + var expectedClass = ctx.lookupClass(""); + return errorSignalerNode.signalWrongType(o, expectedClass); + } + + /** + * Construct LispFunction using this root node. + * + * @param lang truffle language reference + * @return lisp function + */ + public static LispFunction makeLispFunction(TruffleLanguage lang) { + return new LispFunction(ISLISPTruffleObjectFieldsNodeGen.create(lang).getCallTarget()); + } + +} diff --git a/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPFunctionDispatchNode.java b/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPFunctionDispatchNode.java index 39dfc6c..1135b15 100644 --- a/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPFunctionDispatchNode.java +++ b/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPFunctionDispatchNode.java @@ -1,13 +1,14 @@ package com.github.arvyy.islisp.nodes; import com.github.arvyy.islisp.ISLISPContext; -import com.github.arvyy.islisp.runtime.LispFunction; -import com.oracle.truffle.api.dsl.Cached; +import com.github.arvyy.islisp.exceptions.ISLISPError; import com.oracle.truffle.api.dsl.Fallback; import com.oracle.truffle.api.dsl.Specialization; -import com.oracle.truffle.api.nodes.DirectCallNode; -import com.oracle.truffle.api.nodes.ExplodeLoop; -import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.interop.ArityException; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.interop.UnsupportedMessageException; +import com.oracle.truffle.api.interop.UnsupportedTypeException; +import com.oracle.truffle.api.library.CachedLibrary; import com.oracle.truffle.api.nodes.Node; /** @@ -35,28 +36,20 @@ public ISLISPFunctionDispatchNode() { */ public abstract Object executeDispatch(Object lispFunction, Object[] arguments); - @ExplodeLoop - @Specialization(guards = "function.callTarget() == callNode.getCallTarget()") - Object doDirect( - LispFunction function, - Object[] args, - @Cached("create(function.callTarget())") DirectCallNode callNode) { - var realArgs = new Object[args.length + 1]; - realArgs[0] = function.closure(); - System.arraycopy(args, 0, realArgs, 1, args.length); - return callNode.call(realArgs); - } - - @ExplodeLoop - @Specialization(replaces = "doDirect") - Object doIndirect( - LispFunction function, - Object[] args, - @Cached IndirectCallNode callNode) { - var realArgs = new Object[args.length + 1]; - realArgs[0] = function.closure(); - System.arraycopy(args, 0, realArgs, 1, args.length); - return callNode.call(function.callTarget(), realArgs); + @Specialization(guards = { + "interopLibrary.isExecutable(o)" + }, limit = "3") + Object doInterop( + Object o, + Object[] args, + @CachedLibrary("o") InteropLibrary interopLibrary + ) { + try { + return interopLibrary.execute(o, args); + } catch (UnsupportedMessageException | UnsupportedTypeException | ArityException e) { + //TODO + throw new ISLISPError(e.getMessage(), this); + } } @Fallback diff --git a/language/src/main/java/com/github/arvyy/islisp/runtime/LispArray.java b/language/src/main/java/com/github/arvyy/islisp/runtime/LispArray.java index c743e1c..7355192 100644 --- a/language/src/main/java/com/github/arvyy/islisp/runtime/LispArray.java +++ b/language/src/main/java/com/github/arvyy/islisp/runtime/LispArray.java @@ -1,10 +1,12 @@ package com.github.arvyy.islisp.runtime; +import com.oracle.truffle.api.interop.TruffleObject; + /** * Lisp array. * * @param data nested Object[] values * @param dimensions amount of nesting; 2+. */ -public record LispArray(Object[] data, int dimensions) { +public record LispArray(Object[] data, int dimensions) implements TruffleObject { } diff --git a/language/src/main/java/com/github/arvyy/islisp/runtime/LispChar.java b/language/src/main/java/com/github/arvyy/islisp/runtime/LispChar.java index 39b6402..8cedca2 100644 --- a/language/src/main/java/com/github/arvyy/islisp/runtime/LispChar.java +++ b/language/src/main/java/com/github/arvyy/islisp/runtime/LispChar.java @@ -1,9 +1,11 @@ package com.github.arvyy.islisp.runtime; +import com.oracle.truffle.api.interop.TruffleObject; + /** * Signifies LISP character type, carrying around codepoint. * * @param codepoint */ -public record LispChar(int codepoint) { +public record LispChar(int codepoint) implements TruffleObject { } diff --git a/language/src/main/java/com/github/arvyy/islisp/runtime/LispFunction.java b/language/src/main/java/com/github/arvyy/islisp/runtime/LispFunction.java index c8e01e6..a97a127 100644 --- a/language/src/main/java/com/github/arvyy/islisp/runtime/LispFunction.java +++ b/language/src/main/java/com/github/arvyy/islisp/runtime/LispFunction.java @@ -1,8 +1,18 @@ package com.github.arvyy.islisp.runtime; -import com.oracle.truffle.api.CallTarget; +import com.oracle.truffle.api.RootCallTarget; +import com.oracle.truffle.api.dsl.Cached; +import com.oracle.truffle.api.dsl.ReportPolymorphism; +import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.api.frame.MaterializedFrame; +import com.oracle.truffle.api.interop.InteropLibrary; import com.oracle.truffle.api.interop.TruffleObject; +import com.oracle.truffle.api.library.ExportLibrary; +import com.oracle.truffle.api.library.ExportMessage; +import com.oracle.truffle.api.nodes.DirectCallNode; +import com.oracle.truffle.api.nodes.ExplodeLoop; +import com.oracle.truffle.api.nodes.IndirectCallNode; +import com.oracle.truffle.api.source.SourceSection; /** * ISLISP invocable function object. @@ -11,13 +21,14 @@ * @param callTarget function implementation * @param isGeneric whether this is plain or generic function. */ -public record LispFunction(Closure closure, CallTarget callTarget, boolean isGeneric) implements TruffleObject { +@ExportLibrary(InteropLibrary.class) +public record LispFunction(Closure closure, RootCallTarget callTarget, boolean isGeneric) implements TruffleObject { /** * Create plain lisp function. * @param callTarget call target */ - public LispFunction(CallTarget callTarget) { + public LispFunction(RootCallTarget callTarget) { this(new Closure(null, null, null), callTarget, false); } @@ -26,7 +37,7 @@ public LispFunction(CallTarget callTarget) { * @param frame materialized closure frame * @param callTarget call target */ - public LispFunction(MaterializedFrame frame, CallTarget callTarget) { + public LispFunction(MaterializedFrame frame, RootCallTarget callTarget) { this(new Closure(frame, null, null), callTarget, false); } @@ -37,7 +48,7 @@ public LispFunction(MaterializedFrame frame, CallTarget callTarget) { * @param args initial invocation arguments * @param callTarget call target */ - public LispFunction(GenericMethodApplicableMethods nextMethods, Object[] args, CallTarget callTarget) { + public LispFunction(GenericMethodApplicableMethods nextMethods, Object[] args, RootCallTarget callTarget) { this(new Closure(null, nextMethods, args), callTarget, true); } @@ -46,8 +57,52 @@ public LispFunction(GenericMethodApplicableMethods nextMethods, Object[] args, C * @param closure closure * @param callTarget call target */ - public LispFunction(Closure closure, CallTarget callTarget) { + public LispFunction(Closure closure, RootCallTarget callTarget) { this(closure, callTarget, false); } + @ExportMessage + boolean hasSourceLocation() { + return true; + } + + @ExportMessage + SourceSection getSourceLocation() { + return callTarget.getRootNode().getSourceSection(); + } + + @ExportMessage + boolean isExecutable() { + return true; + } + + @ExportMessage + @ReportPolymorphism + abstract static class Execute { + @ExplodeLoop + @Specialization(guards = "function.callTarget() == prevCallTarget") + static Object doDirect( + LispFunction function, + Object[] args, + @Cached("function.callTarget()") RootCallTarget prevCallTarget, + @Cached("create(function.callTarget())") DirectCallNode callNode) { + var realArgs = new Object[args.length + 1]; + realArgs[0] = function.closure(); + System.arraycopy(args, 0, realArgs, 1, args.length); + return callNode.call(realArgs); + } + + @ExplodeLoop + @Specialization(replaces = "doDirect") + static Object doIndirect( + LispFunction function, + Object[] args, + @Cached IndirectCallNode callNode) { + var realArgs = new Object[args.length + 1]; + realArgs[0] = function.closure(); + System.arraycopy(args, 0, realArgs, 1, args.length); + return callNode.call(function.callTarget(), realArgs); + } + } + } diff --git a/language/src/main/resources/islispprelude.lisp b/language/src/main/resources/islispprelude.lisp index 8695f4a..a76c1a0 100644 --- a/language/src/main/resources/islispprelude.lisp +++ b/language/src/main/resources/islispprelude.lisp @@ -183,6 +183,9 @@ (defun streamp (obj) (instancep obj (class ))) +(defun truffle-object-p (obj) + (instancep obj (class ))) + (defun identity (obj) obj) (defun not (obj) diff --git a/language/src/test/java/com/github/arvyy/islisp/ExternalTest.java b/language/src/test/java/com/github/arvyy/islisp/ExternalTest.java index 069ed40..a84d57c 100644 --- a/language/src/test/java/com/github/arvyy/islisp/ExternalTest.java +++ b/language/src/test/java/com/github/arvyy/islisp/ExternalTest.java @@ -1,6 +1,7 @@ package com.github.arvyy.islisp; import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotAccess; import org.graalvm.polyglot.Source; import org.junit.jupiter.api.DynamicTest; import org.junit.jupiter.api.TestFactory; @@ -44,8 +45,9 @@ void executeTest(Path lispFile) throws Throwable { } var output = new ByteArrayOutputStream(); var ctxBuilder = Context.newBuilder() - .in(new ByteArrayInputStream(new byte[0])) - .out(output); + .in(new ByteArrayInputStream(new byte[0])) + .out(output) + .allowPolyglotAccess(PolyglotAccess.ALL); try (var ctx = ctxBuilder.build()) { ctx.eval(Source.newBuilder("islisp", lispFile.toFile()).build()); var expected = Files.readString(resultFile); diff --git a/launcher/pom.xml b/launcher/pom.xml index cd1cb46..00ec3d4 100644 --- a/launcher/pom.xml +++ b/launcher/pom.xml @@ -25,6 +25,19 @@ 1.6.0 + + + + org.graalvm.polyglot + js-community + pom + + org.graalvm.polyglot tools diff --git a/launcher/src/main/java/com/github/arvyy/islisp/launcher/Main.java b/launcher/src/main/java/com/github/arvyy/islisp/launcher/Main.java index af77d18..90e7dcc 100644 --- a/launcher/src/main/java/com/github/arvyy/islisp/launcher/Main.java +++ b/launcher/src/main/java/com/github/arvyy/islisp/launcher/Main.java @@ -2,7 +2,9 @@ import org.apache.commons.cli.*; import org.graalvm.polyglot.Context; +import org.graalvm.polyglot.PolyglotAccess; import org.graalvm.polyglot.Source; +import org.graalvm.polyglot.io.IOAccess; import java.io.*; @@ -42,7 +44,10 @@ public static void main(String[] args) throws IOException, ParseException { var contextBuilder = Context.newBuilder() .in(System.in) .out(System.out) - .err(System.err); + .err(System.err) + .allowIO(IOAccess.ALL) + .allowNativeAccess(true) + .allowPolyglotAccess(PolyglotAccess.ALL); if (commandLine.hasOption(chromeDebuggerOpt)) { if (chromeDebuggerOpt.hasArg()) { diff --git a/pom.xml b/pom.xml index d3069ea..0f6bbd3 100644 --- a/pom.xml +++ b/pom.xml @@ -29,6 +29,16 @@ truffle-api ${graalvm.version} + + org.graalvm.truffle + truffle-runtime + ${graalvm.version} + + + org.graalvm.truffle + truffle-nfi-libffi + ${graalvm.version} + org.graalvm.polyglot polyglot @@ -45,6 +55,13 @@ ${graalvm.version} pom + + + org.graalvm.polyglot + js-community + ${graalvm.version} + pom + diff --git a/tests2/evalinterop.expect.txt b/tests2/evalinterop.expect.txt new file mode 100644 index 0000000..42ce418 --- /dev/null +++ b/tests2/evalinterop.expect.txt @@ -0,0 +1 @@ +evalinterop.lisp end \ No newline at end of file diff --git a/tests2/evalinterop.lisp b/tests2/evalinterop.lisp new file mode 100644 index 0000000..f59f48c --- /dev/null +++ b/tests2/evalinterop.lisp @@ -0,0 +1,20 @@ +(defmacro test-equal (expr value) + (let ((actual (gensym))) + `(let ((,actual ,expr)) + (if (not (equal ,actual ,value)) + (progn + (format-object (standard-output) ',expr t) + (format-char (standard-output) #\newline) + (format-object (standard-output) "Expect: " t) + (format-object (standard-output) ,value nil) + (format-char (standard-output) #\newline) + (format-object (standard-output) "Actual: " t) + (format-object (standard-output) ,actual nil) + (format-char (standard-output) #\newline) + (format-object (standard-output) "-------" nil) + (format-char (standard-output) #\newline)))))) + +(let ((fun (eval "js" "(function(arg) { return 1 + arg; })"))) + (test-equal (funcall fun 2) 3)) + +(format (standard-output) "evalinterop.lisp end")