Work on basic stl. Add _ binding to repl for last value

Makefile

@@ -6,8 +6,8 @@ TARGET=interp
 PREFIX=/usr/local
 
 # C sources
-HEADERS=vm.h ds.h compile.h parse.h value.h datatypes.h gc.h util.h gst.h
+HEADERS=vm.h ds.h compile.h parse.h value.h datatypes.h gc.h util.h gst.h stl.h
-SOURCES=main.c parse.c value.c vm.c ds.c compile.c gc.c
+SOURCES=main.c parse.c value.c vm.c ds.c compile.c gc.c stl.c
 OBJECTS=$(patsubst %.c,%.o,$(SOURCES))
 
 all: $(TARGET)

compile.c

@@ -1320,6 +1320,8 @@ GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) {
         /* Clear all but root scope */
         if (c->tail)
             c->tail->parent = NULL;
+        if (c->error == NULL)
+            c->error = "unknown error";
         return NULL;
     }
     /* Create a scope */

datatypes.h

@@ -18,7 +18,8 @@ typedef enum GstType {
     GST_BYTEBUFFER,
     GST_FUNCTION,
     GST_CFUNCTION,
-    GST_OBJECT
+    GST_OBJECT,
+    GST_USERDATA
 } GstType;
 
 /* The state of the virtual machine */
@@ -38,6 +39,7 @@ typedef struct GstThread GstThread;
 typedef int (*GstCFunction)(Gst * vm);
 
 /* Implementation details */
+typedef struct GstUserdataHeader GstUserdataHeader;
 typedef struct GstFuncDef GstFuncDef;
 typedef struct GstFuncEnv GstFuncEnv;
 
@@ -104,13 +106,13 @@ struct GstObject {
     uint32_t capacity;
     GstBucket **buckets;
     uint32_t flags;
-    GstValue meta;
+    GstObject *meta;
 };
 
 /* Some function defintion flags */
 #define GST_FUNCDEF_FLAG_VARARG 1
 
-/* A function defintion. Contains information need to instatiate closures. */
+/* A function definition. Contains information need to instatiate closures. */
 struct GstFuncDef {
     uint32_t locals;
     uint32_t arity; /* Not including varargs */
@@ -142,6 +144,12 @@ struct GstBucket {
     GstBucket *next;
 };
 
+/* Contains information about userdata */
+struct GstUserdataHeader {
+	uint32_t size;
+	GstObject *meta;
+};
+
 /* A stack frame in the VM */
 struct GstStackFrame {
     GstValue callee;

ds.c

@@ -156,6 +156,20 @@ GstValue *gst_tuple(Gst *vm, uint32_t length) {
 	return tuple;
 }
 
+/****/
+/* Userdata functions */
+/****/
+
+/* Create new userdata */
+void *gst_userdata(Gst *vm, uint32_t size, GstObject *meta) {
+	char *data = gst_alloc(vm, sizeof(GstUserdataHeader) + size);
+	GstUserdataHeader *header = (GstUserdataHeader *)data;
+	void *user = data + sizeof(GstUserdataHeader);
+	header->size = size;
+	header->meta = meta;
+	return user;
+}
+
 /****/
 /* Dictionary functions */
 /****/

ds.h

@@ -67,13 +67,19 @@ GstValue ArrayPeek(GstArray *array);
 
 /****/
 /* Tuple functions */
-/* These really don't do all that much */
 /****/
 
 /* Create an empty tuple. It is expected to be mutated right after
  * creation. */
 GstValue *gst_tuple(Gst *vm, uint32_t length);
 
+/****/
+/* Userdataa functions */
+/****/
+
+/* Create new userdata */
+void *gst_userdata(Gst *vm, uint32_t size, GstObject *meta);
+
 /****/
 /* Object functions */
 /****/

gc.c

@@ -153,6 +153,16 @@ void gst_mark(Gst *vm, GstValue *x) {
                 }
             }
             break;
+
+        case GST_USERDATA:
+            if (gc_header(x->data.string - sizeof(GstUserdataHeader))->color != vm->black) {
+				GstUserdataHeader *userHeader = (GstUserdataHeader *)x->data.string - 1;
+				gc_header(userHeader)->color = vm->black;
+				GstValue temp;
+				temp.type = GST_OBJECT;
+				temp.data.object = userHeader->meta;
+				gst_mark(vm, &temp);
+            }
     }
 }
 

gst.h

@@ -7,5 +7,6 @@
 #include "parse.h"
 #include "compile.h"
 #include "value.h"
+#include "stl.h"
 
 #endif // gst_h_INCLUDED

main.c

@@ -3,24 +3,13 @@
 #include "gst.h"
 
 /* Simple printer for gst strings */
-void string_put(FILE *out, uint8_t * string) {
+static void string_put(FILE *out, uint8_t * string) {
     uint32_t i;
     uint32_t len = gst_string_length(string);
     for (i = 0; i < len; ++i)
         fputc(string[i], out);
 }
 
-/* Test c function */
-int print(Gst *vm) {
-    uint32_t j, count;
-    count = gst_count_args(vm);
-    for (j = 0; j < count; ++j) {
-        string_put(stdout, gst_to_string(vm, gst_arg(vm, j)));
-        fputc('\n', stdout);
-    }
-    return GST_RETURN_OK;
-}
-
 /* A simple repl for debugging */
 void debug_repl(FILE *in, FILE *out) {
     char buffer[1024] = {0};
@@ -71,7 +60,9 @@ void debug_repl(FILE *in, FILE *out) {
 
         /* Try to compile generated AST */
         gst_compiler(&c, &vm);
-        gst_compiler_add_global_cfunction(&c, "print", print);
+        gst_stl_load(&c);
+        /* Save last expression */
+        gst_compiler_add_global(&c, "_", vm.ret);
         func.type = GST_FUNCTION;
         func.data.function = gst_compiler_compile(&c, p.value);
 

parse.c

@@ -268,15 +268,17 @@ static int string_state(GstParser *p, uint8_t c) {
                 top->buf.string.state = STRING_STATE_ESCAPE;
             } else if (c == '"') {
                 /* Load a quote form to get the string literal */
-                GstValue x, array;
+                GstValue x, tuplev;
+                GstValue *tuple;
                 x.type = GST_STRING;
                 x.data.string = gst_buffer_to_string(p->vm, top->buf.string.buffer);
-                array.type = GST_ARRAY;
+                tuple = gst_tuple(p->vm, 2);
-                array.data.array = gst_array(p->vm, 2);
+                tuplev.type = GST_TUPLE;
-                gst_array_push(p->vm, array.data.array, gst_load_cstring(p->vm, "quote"));
+                tuplev.data.tuple = tuple;
-                gst_array_push(p->vm, array.data.array, x);
+                tuple[0] = gst_load_cstring(p->vm, "quote");
+                tuple[1] = x;
                 parser_pop(p);
-                parser_append(p, array);
+                parser_append(p, tuplev);
             } else {
                 gst_buffer_push(p->vm, top->buf.string.buffer, c);
             }

stl.c

@@ -1,22 +1,50 @@
 /* This implemets a standard library in gst. Some of this
  * will eventually be ported over to gst if possible */
+#include "stl.h"
 #include "gst.h"
 
 /****/
-/* Misc */
+/* Core */
 /****/
 
 /* Print values for inspection */
-int print(Gst *vm) {
+int gst_stl_print(Gst *vm) {
     uint32_t j, count;
     count = gst_count_args(vm);
     for (j = 0; j < count; ++j) {
-        string_put(stdout, gst_to_string(vm, gst_arg(vm, j)));
+        uint32_t i;
+        uint8_t *string = gst_to_string(vm, gst_arg(vm, j));
+        uint32_t len = gst_string_length(string);
+        for (i = 0; i < len; ++i)
+            fputc(string[i], stdout);
         fputc('\n', stdout);
     }
     return GST_RETURN_OK;
 }
 
+/* Get class value */
+int gst_stl_getclass(Gst *vm) {
+	GstValue class = gst_get_class(gst_arg(vm, 0));
+	gst_c_return(vm, class);
+}
+
+/* Set class value */
+int gst_stl_setclass(Gst *vm) {
+	GstValue x = gst_arg(vm, 0);
+	GstValue class = gst_arg(vm, 1);
+	const char *err = gst_set_class(x, class);
+	if (err != NULL)
+    	gst_c_throwc(vm, err);
+   	gst_c_return(vm, x);
+}
+
+/* Load core */
+void gst_stl_load_core(GstCompiler *c) {
+    gst_compiler_add_global_cfunction(c, "print", gst_stl_print);
+    gst_compiler_add_global_cfunction(c, "get-class", gst_stl_getclass);
+    gst_compiler_add_global_cfunction(c, "set-class", gst_stl_setclass);
+}
+
 /****/
 /* Parsing */
 /****/
@@ -39,6 +67,11 @@ int gst_stl_parse(Gst *vm) {
     }
 }
 
+/* Load parsing */
+void gst_stl_load_parse(GstCompiler *c) {
+	gst_compiler_add_global_cfunction(c, "parse", gst_stl_parse);
+}
+
 /****/
 /* Compiling */
 /****/
@@ -54,22 +87,38 @@ int gst_stl_compile(Gst *vm) {
     /* Check for environment variables */
 	if (env.type == GST_OBJECT) {
 		/* Iterate through environment, adding globals */
-	} else if (env.type != GST_NIL) {
+  	} else if (env.type != GST_NIL) {
 		gst_c_throwc(vm, "invalid type for environment");
-	}        
+	}
 	/* Prepare return value */
 	ret.type = GST_FUNCTION;
     ret.data.function = gst_compiler_compile(&c, ast);
     /* Check for errors */
-    if (c.error != NULL) {
+    if (c.error == NULL) {
 		gst_c_return(vm, ret);
     } else {
 		gst_c_throwc(vm, c.error);
     }
 }
 
+/* Load compilation */
+void gst_stl_load_compile(GstCompiler *c) {
+	gst_compiler_add_global_cfunction(c, "compile", gst_stl_compile);
+}
+
 /****/
 /* IO */
 /****/
 
 /* TODO - add userdata to allow for manipulation of FILE pointers. */
+
+/****/
+/* Bootstraping */
+/****/
+
+/* Load all libraries */
+void gst_stl_load(GstCompiler *c) {
+	gst_stl_load_core(c);
+	gst_stl_load_parse(c);
+	gst_stl_load_compile(c);
+}

stl.h

@@ -0,0 +1,11 @@
+#ifndef stl_h_INCLUDED
+#define stl_h_INCLUDED
+
+#include "datatypes.h"
+#include "compile.h"
+
+/* Load the standard library */
+void gst_stl_load(GstCompiler *c);
+
+#endif // stl_h_INCLUDED
+

util.h

@@ -3,13 +3,13 @@
 
 /* String utils */
 #define gst_string_raw(s) ((uint32_t *)(s) - 2)
-#define gst_string_length(v) (gst_string_raw(v)[0])
+#define gst_string_length(s) (gst_string_raw(s)[0])
-#define gst_string_hash(v) (gst_string_raw(v)[1])
+#define gst_string_hash(s) (gst_string_raw(s)[1])
 
 /* Tuple utils */
-#define gst_tuple_raw(s) ((uint32_t *)(s) - 2)
+#define gst_tuple_raw(t) ((uint32_t *)(t) - 2)
-#define gst_tuple_length(v) (gst_tuple_raw(v)[0])
+#define gst_tuple_length(t) (gst_tuple_raw(t)[0])
-#define gst_tuple_hash(v) (gst_tuple_raw(v)[1])
+#define gst_tuple_hash(t) (gst_tuple_raw(t)[1])
 
 /* Memcpy for moving memory */
 #ifndef gst_memcpy

value.c

@@ -30,7 +30,7 @@ static uint8_t * number_to_string(Gst *vm, GstNumber x) {
     uint8_t *data = gst_alloc(vm, SIZE + 2 * sizeof(uint32_t));
     data += 2 * sizeof(uint32_t);
     /* TODO - not depend on stdio */
-    snprintf((char *) data, SIZE, "%.17g", x);
+    snprintf((char *) data, SIZE, "%.21g", x);
     gst_string_hash(data) = 0;
     gst_string_length(data) = strlen((char *) data);
     return data;
@@ -149,6 +149,8 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
             return string_description(vm, "function", 8, x.data.pointer);
         case GST_THREAD:
             return string_description(vm, "thread", 6, x.data.pointer);
+        case GST_USERDATA:
+            return string_description(vm, "userdata", 8, x.data.pointer);
     }
     return NULL;
 }
@@ -463,3 +465,44 @@ const char *gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value) {
 	}
 	return NULL;
 }
+
+/* Get the class object of a value */
+GstValue gst_get_class(GstValue x) {
+    GstValue ret;
+    ret.type = GST_NIL;
+    switch (x.type) {
+		case GST_OBJECT:
+			if (x.data.object->meta != NULL) {
+				ret.type = GST_OBJECT;
+				ret.data.object = x.data.object->meta;
+			}
+    		break;
+    	case GST_USERDATA:
+        	{
+				GstUserdataHeader *header = (GstUserdataHeader *)x.data.pointer - 1;
+    			if (header->meta != NULL) {
+    				ret.type = GST_OBJECT;
+    				ret.data.object = header->meta;
+    			}
+        	}
+        	break;
+        default:
+            break;
+    }
+    return ret;
+}
+
+/* Set the class object of a value. Returns possible c error string */
+const char *gst_set_class(GstValue x, GstValue class) {
+    switch (x.type) {
+		case GST_OBJECT:
+    		if (class.type != GST_OBJECT) return "class must be of type object";
+    		/* TODO - check for class immutability */
+			x.data.object->meta = class.data.object;
+    		break;
+        default:
+            return "cannot set class object";
+    }
+    return NULL;
+}
+

value.h

@@ -29,4 +29,10 @@ uint8_t *gst_to_string(Gst *vm, GstValue x);
 /* Generate a hash value for a gst object */
 uint32_t gst_hash(GstValue x);
 
+/* Get the class object of a value */
+GstValue gst_get_class(GstValue x);
+
+/* Set the class object of a value. Returns possible c error string */
+const char *gst_set_class(GstValue obj, GstValue class);
+
 #endif /* end of include guard: VALUE_H_1RJPQKFM */