add interop with external array objects

arvyy · Dec 10, 2023 · ebe8397 · ebe8397
1 parent 6b82c9f
commit ebe8397
Show file tree

Hide file tree

Showing 7 changed files with 109 additions and 5 deletions.
diff --git 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("<truffle-object>", "<object>");
+        initBuiltin("<truffle-vector>", "<basic-vector>");
     }
 
     /**

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
@@ -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("<truffle-object>");
     }
 
+    LispClass loadTruffleVectorClass() {
+        return loadClass("<truffle-vector>");
+    }
+
     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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 <truffle-vector>)) 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")
-Original file line number
+Diff line change
@@ Expand Up / @@ -274,6 +274,7 @@ void initBuiltinClasses() { @@
             //truffle interop
             initBuiltin("<truffle-object>", "<object>");
+            initBuiltin("<truffle-vector>", "<basic-vector>");
         }
         /**
@@ Expand Down @@