diff --git a/README.md b/README.md index bbf96475..c7f5145c 100644 --- a/README.md +++ b/README.md @@ -87,7 +87,7 @@ A repl is launched when the binary is invoked with no arguments. Pass the -h fla to display the usage information. Individual scripts can be run with `./janet myscript.janet` If you are looking to explore, you can print a list of all available macros, functions, and constants -by entering the command `(all-symbols)` into the repl. +by entering the command `(all-bindings)` into the repl. ``` $ ./janet diff --git a/examples/numarray/build.janet b/examples/numarray/build.janet new file mode 100644 index 00000000..16edc0ed --- /dev/null +++ b/examples/numarray/build.janet @@ -0,0 +1,24 @@ +(import cook) + +(cook/make-native + :name "numarray" + :source @["numarray.c"]) + +(import build/numarray :prefix "") + +(def a (numarray/new 30)) +(print (get a 20)) +(print (a 20)) + +(put a 5 3.14) +(print (a 5)) +(set (a 5) 100) +(print (a 5)) + +# (numarray/scale a 5)) +# ((a :scale) a 5) +(:scale a 5) +(for i 0 10 (print (a i))) + +# +(print "sum=" (:sum a)) diff --git a/examples/numarray/numarray.c b/examples/numarray/numarray.c new file mode 100644 index 00000000..ff0b9324 --- /dev/null +++ b/examples/numarray/numarray.c @@ -0,0 +1,127 @@ +#include +#include + +typedef struct { + double * data; + size_t size; +} num_array; + +static num_array * num_array_init(num_array * array,size_t size) { + array->data=(double *)calloc(size,sizeof(double)); + array->size=size; + return array; +} + +static void num_array_deinit(num_array * array) { + free(array->data); +} + +static int num_array_gc(void *p, size_t s) { + (void) s; + num_array * array=(num_array *)p; + num_array_deinit(array); + return 0; +} + +Janet num_array_get(void *p, Janet key); +void num_array_put(void *p, Janet key, Janet value); + + + +static const JanetAbstractType num_array_type = { + "numarray", + num_array_gc, + NULL, + num_array_get, + num_array_put +}; + +static Janet num_array_new(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + int32_t size=janet_getinteger(argv,0); + num_array * array = (num_array *)janet_abstract(&num_array_type,sizeof(num_array)); + num_array_init(array,size); + return janet_wrap_abstract(array); +} + +static Janet num_array_scale(int32_t argc, Janet *argv) { + janet_fixarity(argc, 2); + num_array * array = (num_array *)janet_getabstract(argv,0,&num_array_type); + double factor = janet_getnumber(argv,1); + size_t i; + for (i=0;isize;i++) { + array->data[i]*=factor; + } + return argv[0]; +} + +static Janet num_array_sum(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + num_array * array = (num_array *)janet_getabstract(argv,0,&num_array_type); + double sum = 0; + for (size_t i=0;isize;i++) sum+=array->data[i]; + return janet_wrap_number(sum); +} + +void num_array_put(void *p, Janet key, Janet value) { + size_t index; + num_array * array=(num_array *)p; + if (!janet_checkint(key)) + janet_panic("expected integer key"); + if (!janet_checktype(value,JANET_NUMBER)) + janet_panic("expected number value"); + + index = (size_t)janet_unwrap_integer(key); + if (index < array->size) { + array->data[index]=janet_unwrap_number(value); + } +} + +static const JanetReg methods[] = { + {"scale", num_array_scale,"(:scale numarray factor)"}, + {"sum", num_array_sum,"(:sum numarray)"} +}; + +Janet num_array_get(void *p, Janet key) { + size_t index; + Janet value; + num_array * array=(num_array *)p; + if (janet_checktype(key,JANET_KEYWORD)) { + const uint8_t *keyw = janet_unwrap_keyword(key); + const size_t nm = sizeof(methods)/sizeof(JanetReg); + size_t i; + for ( i=0 ; i= array->size) { + value = janet_wrap_nil(); + } else { + value = janet_wrap_number(array->data[index]); + } + return value; +} + + + +static const JanetReg cfuns[] = { + {"numarray/new", num_array_new, + "(numarray/new size)\n\n" + "Create new numarray" + }, + {"numarray/scale", num_array_scale, + "(numarray/scale numarray factor)\n\n" + "scale numarray by factor" + }, + {NULL,NULL,NULL} +}; + +JANET_MODULE_ENTRY(JanetTable *env) { + janet_cfuns(env, "numarray", cfuns); +} diff --git a/src/core/io.c b/src/core/io.c index 741d7760..74bc0fb3 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -53,6 +53,8 @@ static int cfun_io_gc(void *p, size_t len); JanetAbstractType cfun_io_filetype = { "core/file", cfun_io_gc, + NULL, + NULL, NULL }; diff --git a/src/core/parse.c b/src/core/parse.c index 00cad587..855e1d05 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -612,7 +612,9 @@ static int parsergc(void *p, size_t size) { static JanetAbstractType janet_parse_parsertype = { "core/parser", parsergc, - parsermark + parsermark, + NULL, + NULL }; /* C Function parser */ diff --git a/src/core/peg.c b/src/core/peg.c index 8f464c72..82c66ed9 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -1004,7 +1004,9 @@ static int peg_mark(void *p, size_t size) { static JanetAbstractType peg_type = { "core/peg", NULL, - peg_mark + peg_mark, + NULL, + NULL }; /* Convert Builder to Peg (Janet Abstract Value) */ diff --git a/src/core/value.c b/src/core/value.c index dbdd60dc..54ad73fe 100644 --- a/src/core/value.c +++ b/src/core/value.c @@ -219,6 +219,17 @@ Janet janet_get(Janet ds, Janet key) { } break; } + case JANET_ABSTRACT: + { + JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); + if (type->get) { + value = (type->get)(janet_unwrap_abstract(ds),key); + } else { + janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds); + value = janet_wrap_nil(); + } + break; + } } return value; } @@ -267,6 +278,17 @@ Janet janet_getindex(Janet ds, int32_t index) { case JANET_STRUCT: value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index)); break; + case JANET_ABSTRACT: + { + JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); + if (type->get) { + value = (type->get)(janet_unwrap_abstract(ds),janet_wrap_integer(index)); + } else { + janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds); + value = janet_wrap_nil(); + } + break; + } } return value; } @@ -327,6 +349,16 @@ void janet_putindex(Janet ds, int32_t index, Janet value) { janet_table_put(table, janet_wrap_integer(index), value); break; } + case JANET_ABSTRACT: + { + JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); + if (type->put) { + (type->put)(janet_unwrap_abstract(ds),janet_wrap_integer(index),value); + } else { + janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds); + } + break; + } } } @@ -367,5 +399,16 @@ void janet_put(Janet ds, Janet key, Janet value) { case JANET_TABLE: janet_table_put(janet_unwrap_table(ds), key, value); break; + case JANET_ABSTRACT: + { + JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); + if (type->put) { + (type->put)(janet_unwrap_abstract(ds),key,value); + } else { + janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds); + } + break; + } + } } diff --git a/src/core/vm.c b/src/core/vm.c index 0705b5f0..10d6771f 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -228,7 +228,7 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) { int32_t argn = fiber->stacktop - fiber->stackstart; Janet ds, key; if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn); - if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)) { + if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY | JANET_TFLAG_ABSTRACT)) { ds = callee; key = fiber->data[fiber->stackstart]; } else { diff --git a/src/include/janet/janet.h b/src/include/janet/janet.h index 1ce7f323..fd6e16fa 100644 --- a/src/include/janet/janet.h +++ b/src/include/janet/janet.h @@ -738,6 +738,8 @@ struct JanetAbstractType { const char *name; int (*gc)(void *data, size_t len); int (*gcmark)(void *data, size_t len); + Janet (*get)(void *data, Janet key); + void (*put)(void *data, Janet key, Janet value); }; /* Contains information about abstract types */