Use :length method for (length abstract)

Also adds the janet_lengthv API call. This is
needed because janet_length returns a 32 bit integer, where
as lengthv lets us return larger values (useful for typed arrays).

janet_mcall is an api function that should make it easier to call
a janet method from C code. It shares a similar signature with
janet_call.

CHANGELOG.md

@@ -1,6 +1,10 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## Unreleased
+- Allow (length x) on typed arrays an other abstract types that implement
+  the :length method.
+
 ## 1.3.0 - 2019-09-05
 - Add `get-in`, `put-in`, `update-in`, and `freeze` to core.
 - Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm.

src/core/pp.c

@@ -30,7 +30,7 @@
 #endif
 
 /* Implements a pretty printer for Janet. The pretty printer
- * is farily simple and not that flexible, but fast. */
+ * is simple and not that flexible, but fast. */
 
 /* Temporary buffer size */
 #define BUFSIZE 64

src/core/value.c

@@ -299,6 +299,38 @@ int32_t janet_length(Janet x) {
             return janet_struct_length(janet_unwrap_struct(x));
         case JANET_TABLE:
             return janet_unwrap_table(x)->count;
+        case JANET_ABSTRACT: {
+            Janet argv[1] = { x };
+            Janet len = janet_mcall("length", 1, argv);
+            if (!janet_checkint(len))
+                janet_panicf("invalid integer length %v", len);
+            return janet_unwrap_integer(len);
+        }
+    }
+}
+
+Janet janet_lengthv(Janet x) {
+    switch (janet_type(x)) {
+        default:
+            janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
+        case JANET_STRING:
+        case JANET_SYMBOL:
+        case JANET_KEYWORD:
+            return janet_wrap_integer(janet_string_length(janet_unwrap_string(x)));
+        case JANET_ARRAY:
+            return janet_wrap_integer(janet_unwrap_array(x)->count);
+        case JANET_BUFFER:
+            return janet_wrap_integer(janet_unwrap_buffer(x)->count);
+        case JANET_TUPLE:
+            return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x)));
+        case JANET_STRUCT:
+            return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x)));
+        case JANET_TABLE:
+            return janet_wrap_integer(janet_unwrap_table(x)->count);
+        case JANET_ABSTRACT: {
+            Janet argv[1] = { x };
+            return janet_mcall("length", 1, argv);
+        }
     }
 }
 

src/core/vm.c

@@ -117,9 +117,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     {\
         Janet op1 = stack[B];\
         vm_assert_type(op1, JANET_NUMBER);\
-        double x1 = janet_unwrap_number(op1);\
-        stack[A] = janet_wrap_number(x1 op CS);\
-        vm_pcnext();\
+        if (!janet_checktype(op1, JANET_NUMBER)) {\
+            vm_commit();\
+            Janet _argv[2] = { op1, janet_wrap_number(CS) };\
+            stack[A] = janet_mcall(#op, 2, _argv);\
+            vm_pcnext();\
+        } else {\
+            double x1 = janet_unwrap_number(op1);\
+            stack[A] = janet_wrap_number(x1 op CS);\
+            vm_pcnext();\
+        }\
     }
 #define _vm_bitop_immediate(op, type1)\
     {\
@@ -135,12 +142,19 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
-        vm_assert_type(op1, JANET_NUMBER);\
-        vm_assert_type(op2, JANET_NUMBER);\
-        double x1 = janet_unwrap_number(op1);\
-        double x2 = janet_unwrap_number(op2);\
-        stack[A] = wrap(x1 op x2);\
-        vm_pcnext();\
+        if (!janet_checktype(op1, JANET_NUMBER)) {\
+            vm_commit();\
+            Janet _argv[2] = { op1, op2 };\
+            stack[A] = janet_mcall(#op, 2, _argv);\
+            vm_pcnext();\
+        } else {\
+            vm_assert_type(op1, JANET_NUMBER);\
+            vm_assert_type(op2, JANET_NUMBER);\
+            double x1 = janet_unwrap_number(op1);\
+            double x2 = janet_unwrap_number(op2);\
+            stack[A] = wrap(x1 op x2);\
+            vm_pcnext();\
+        }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
 #define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
@@ -723,7 +737,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
 
     VM_OP(JOP_LENGTH)
     vm_commit();
-    stack[A] = janet_wrap_integer(janet_length(stack[E]));
+    stack[A] = janet_lengthv(stack[E]);
     vm_pcnext();
 
     VM_OP(JOP_MAKE_ARRAY) {
@@ -919,6 +933,37 @@ JanetSignal janet_pcall(
     return janet_continue(fiber, janet_wrap_nil(), out);
 }
 
+Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
+    /* At least 1 argument */
+    if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
+    /* Find method */
+    Janet method;
+    if (janet_checktype(argv[0], JANET_ABSTRACT)) {
+        void *abst = janet_unwrap_abstract(argv[0]);
+        JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
+        if (!type->get)
+            janet_panicf("abstract value %v does not implement :%s", argv[0], name);
+        method = (type->get)(abst, janet_ckeywordv(name));
+    } else if (janet_checktype(argv[0], JANET_TABLE)) {
+        JanetTable *table = janet_unwrap_table(argv[0]);
+        method = janet_table_get(table, janet_ckeywordv(name));
+    } else if (janet_checktype(argv[0], JANET_STRUCT)) {
+        const JanetKV *st = janet_unwrap_struct(argv[0]);
+        method = janet_struct_get(st, janet_ckeywordv(name));
+    } else {
+        janet_panicf("could not find method :%s for %v", name, argv[0]);
+    }
+    /* Invoke method */
+    if (janet_checktype(method, JANET_CFUNCTION)) {
+        return (janet_unwrap_cfunction(method))(argc, argv);
+    } else if (janet_checktype(method, JANET_FUNCTION)) {
+        JanetFunction *fun = janet_unwrap_function(method);
+        return janet_call(fun, argc, argv);
+    } else {
+        janet_panicf("method %s has unexpected value %v", name, method);
+    }
+}
+
 /* Setup VM */
 int janet_init(void) {
     /* Garbage collection */

src/include/janet.h

@@ -1274,6 +1274,7 @@ JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
 JANET_API Janet janet_get(Janet ds, Janet key);
 JANET_API Janet janet_getindex(Janet ds, int32_t index);
 JANET_API int32_t janet_length(Janet x);
+JANET_API Janet janet_lengthv(Janet x);
 JANET_API void janet_put(Janet ds, Janet key, Janet value);
 JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
 JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
@@ -1286,6 +1287,7 @@ JANET_API void janet_deinit(void);
 JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
 JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
+JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
 
 /* Scratch Memory API */

test/suite5.janet

@@ -54,6 +54,7 @@
 (assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
 (assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
 (assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
+(assert (= (:length a) (length a)) "length method and function")
 
 (assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")