Merge pull request #30 from jfcap/get-set-abstract

Get set abstract

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

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))

examples/numarray/numarray.c

@@ -0,0 +1,127 @@
+#include <stdlib.h>
+#include <janet/janet.h>
+
+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;i<array->size;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;i<array->size;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<nm ; i++ ) {
+      if (!janet_cstrcmp(keyw, methods[i].name)) {
+	return janet_wrap_cfunction(methods[i].cfun);
+      }
+    }
+    janet_panicf("undefined method %s",keyw);
+  }
+  if (!janet_checkint(key))
+    janet_panic("expected integer key");
+  index = (size_t)janet_unwrap_integer(key);
+  if (index >= 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);
+}

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
 };
 

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 */

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) */

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;
+	  }
+	  
     }
 }

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 {

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 */