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 a5861ab..0b85105 100644 --- a/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java +++ b/language/src/main/java/com/github/arvyy/islisp/ISLISPContext.java @@ -274,6 +274,7 @@ void initBuiltinClasses() { //truffle interop initBuiltin("", ""); + 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 7edd7dd..db3a609 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 @@ -135,7 +135,8 @@ LispClass doArray( } @Specialization(guards = { - "interop.hasMembers(o)" + "interop.hasMembers(o)", + "!interop.hasArrayElements(o)" }, limit = "3") LispClass doTruffleInteropObject( Object o, @@ -145,6 +146,17 @@ LispClass doTruffleInteropObject( return truffleObjectClass; } + @Specialization(guards = { + "interop.hasArrayElements(o)" + }, limit = "3") + LispClass doTruffleInteropVector( + Object o, + @CachedLibrary("o") InteropLibrary interop, + @Cached("loadTruffleVectorClass()") LispClass truffleObjectClass + ) { + return truffleObjectClass; + } + @Fallback @CompilerDirectives.TruffleBoundary LispClass doFallback(Object value) { @@ -199,6 +211,10 @@ LispClass loadTruffleObjectClass() { return loadClass(""); } + LispClass loadTruffleVectorClass() { + 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/ISLISPElt.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPElt.java index 5c9bb38..89eb9bb 100644 --- a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPElt.java +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPElt.java @@ -10,11 +10,16 @@ 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 `elt` function, that returns an element in sequence for a given index. */ +//TODO array index out of bounds handling public abstract class ISLISPElt extends RootNode { @Child @@ -54,6 +59,21 @@ Object doString(String str, int index) { return new LispChar(str.codePointAt(index)); } + @Specialization(guards = { + "interop.hasArrayElements(o)" + }, limit = "3") + Object doTruffleVector( + Object o, + int index, + @CachedLibrary("o") InteropLibrary interop + ) { + try { + return interop.readArrayElement(o, index); + } catch (UnsupportedMessageException | InvalidArrayIndexException e) { + throw new ISLISPError("Interop error", this); + } + } + @Fallback Object fallback(Object seq, Object index) { throw new ISLISPError("Bad sequence or index", this); diff --git a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPLength.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPLength.java index d030b68..8177846 100644 --- a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPLength.java +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPLength.java @@ -2,13 +2,18 @@ import com.github.arvyy.islisp.ISLISPContext; import com.github.arvyy.islisp.exceptions.ISLISPError; +import com.github.arvyy.islisp.nodes.ISLISPTypes; import com.github.arvyy.islisp.runtime.LispFunction; import com.github.arvyy.islisp.runtime.LispVector; import com.github.arvyy.islisp.runtime.Pair; import com.github.arvyy.islisp.runtime.Symbol; import com.oracle.truffle.api.TruffleLanguage; import com.oracle.truffle.api.dsl.Specialization; +import com.oracle.truffle.api.dsl.TypeSystemReference; import com.oracle.truffle.api.frame.VirtualFrame; +import com.oracle.truffle.api.interop.InteropLibrary; +import com.oracle.truffle.api.interop.UnsupportedMessageException; +import com.oracle.truffle.api.library.CachedLibrary; import com.oracle.truffle.api.nodes.RootNode; /** @@ -57,6 +62,21 @@ Object doPair(Pair p) { return len; } + @Specialization(guards = { + "interop.hasArrayElements(o)" + }, limit = "3") + Object doTruffleVector( + Object o, + @CachedLibrary("o") InteropLibrary interop + ) { + try { + return (int) interop.getArraySize(o); + } catch (UnsupportedMessageException e) { + //TODO + throw new ISLISPError("Interop error", this); + } + } + /** * Construct LispFunction using this root node. * diff --git a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPSetAref.java b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPSetAref.java index 23232ac..6e3485a 100644 --- a/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPSetAref.java +++ b/language/src/main/java/com/github/arvyy/islisp/functions/ISLISPSetAref.java @@ -12,11 +12,17 @@ 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.interop.UnsupportedTypeException; +import com.oracle.truffle.api.library.CachedLibrary; import com.oracle.truffle.api.nodes.RootNode; /** * Implements `set-aref` function. */ +//TODO validate array index out of bounds public abstract class ISLISPSetAref extends RootNode { @Child @@ -59,7 +65,7 @@ int bigIntValue(LispBigInteger arg) { abstract Object executeGeneric(Object value, Object array, int[] lookup); @Specialization - Object executeArray(Object value, LispArray arr, int[] lookup) { + Object doArray(Object value, LispArray arr, int[] lookup) { if (arr.dimensions() != lookup.length) { //TODO throw new ISLISPError("Wrong dimension count", this); @@ -73,7 +79,7 @@ Object executeArray(Object value, LispArray arr, int[] lookup) { } @Specialization - Object executeVector(Object value, LispVector vec, int[] lookup) { + Object doVector(Object value, LispVector vec, int[] lookup) { if (lookup.length != 1) { //TODO throw new ISLISPError("Wrong dimension count", this); @@ -82,7 +88,29 @@ Object executeVector(Object value, LispVector vec, int[] lookup) { return value; } - //TODO string + @Specialization + Object doString(Object value, String str, int[] lookup) { + throw new ISLISPError("Cannot modify immutable string", this); + } + + @Specialization(guards = "interop.hasArrayElements(o)", limit = "3") + Object doTruffleVector( + Object value, + Object o, + int[] lookup, + @CachedLibrary("o") InteropLibrary interop + ) { + if (lookup.length != 1) { + //TODO + throw new ISLISPError("Wrong dimension count", this); + } + try { + interop.writeArrayElement(o, lookup[0], value); + return value; + } catch (UnsupportedMessageException | UnsupportedTypeException | InvalidArrayIndexException e) { + throw new ISLISPError("Interop error", this); + } + } @Fallback Object fallback(Object value, Object arr, int[] lookup) { diff --git a/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPTypes.java b/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPTypes.java index 443b5e1..3297f3b 100644 --- a/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPTypes.java +++ b/language/src/main/java/com/github/arvyy/islisp/nodes/ISLISPTypes.java @@ -29,7 +29,7 @@ public class ISLISPTypes { protected ISLISPTypes() { } /** - * Implicitly convert big int to int. + * Implicitly convert int to big int. * * @param v big int value * @return int value @@ -40,6 +40,18 @@ public static LispBigInteger intToBigInt(int v) { return LispBigInteger.valueOf(v); } + /** + * Implicitly convert long to big int. + * + * @param v big int value + * @return int value + */ + @ImplicitCast + @CompilerDirectives.TruffleBoundary + public static LispBigInteger longToBigInt(long v) { + return LispBigInteger.valueOf(v); + } + /** * Implicitly convert int to double. * diff --git a/tests2/evalinterop.lisp b/tests2/evalinterop.lisp index 172d4f3..78c74bb 100644 --- a/tests2/evalinterop.lisp +++ b/tests2/evalinterop.lisp @@ -20,4 +20,11 @@ (let ((fun (eval "js" "(function(arr) { return arr[0]; })"))) (test-equal (funcall fun #(4 5 6)) 4)) +(let ((js-array (eval "js" "[1, 2, 3]"))) + (test-equal (instancep js-array (class )) t) + (test-equal (length js-array) 3) + (test-equal (elt js-array 1) 2) + (setf (aref js-array 1) 5) + (test-equal (elt js-array 1) 5)) + (format (standard-output) "evalinterop.lisp end")