diff --git a/CHANGELOG.md b/CHANGELOG.md index 5c14ada5..f62d1921 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/src/core/pp.c b/src/core/pp.c index 76f147d3..a2a588de 100644 --- a/src/core/pp.c +++ b/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 diff --git a/src/core/value.c b/src/core/value.c index 0675e324..4063a26d 100644 --- a/src/core/value.c +++ b/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); + } } } diff --git a/src/core/vm.c b/src/core/vm.c index 7a2016a8..07802701 100644 --- a/src/core/vm.c +++ b/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 */ diff --git a/src/include/janet.h b/src/include/janet.h index ce90d04c..27aa71eb 100644 --- a/src/include/janet.h +++ b/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 */ diff --git a/test/suite5.janet b/test/suite5.janet index 7dced355..301ffd34 100644 --- a/test/suite5.janet +++ b/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")