diff --git a/.idea/workspace.xml b/.idea/workspace.xml
index ee514e9e..a9666335 100644
--- a/.idea/workspace.xml
+++ b/.idea/workspace.xml
@@ -12,11 +12,16 @@
-
-
-
+
+
+
+
+
+
+
-
+
+
@@ -31,30 +36,13 @@
-
-
-
-
-
-
-
-
-
-
-
+
-
+
-
-
-
-
-
-
-
-
+
@@ -64,6 +52,13 @@
+
+
+
@@ -71,10 +66,9 @@
DEFINITION_ORDER
-
-
-
-
+
+
+
@@ -142,35 +136,36 @@
1487818367037
+
-
+
-
+
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+
-
+
-
+
+
+
+
@@ -194,16 +189,25 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
diff --git a/Makefile b/Makefile
index d9f9a2b9..40983b66 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
# TIL
-CFLAGS=-std=c99 -Wall -Wextra -Wpedantic -g
+CFLAGS=-std=c99 -Wall -Wextra -Wpedantic -g -O3
TARGET=interp
PREFIX=/usr/local
diff --git a/compile.c b/compile.c
index f97d8eb9..e02aac1a 100644
--- a/compile.c
+++ b/compile.c
@@ -356,9 +356,7 @@ static int symbol_resolve(GstScope *scope, GstValue x, uint16_t *level, uint16_t
static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x);
/* Compile a structure that evaluates to a literal value. Useful
- * for objects like strings, or anything else that cannot be instatiated else {
- break;
- }
+ * for objects like strings, or anything else that cannot be instatiated
* from bytecode and doesn't do anything in the AST. */
static Slot compile_literal(GstCompiler *c, FormOptions opts, GstValue x) {
GstScope *scope = c->tail;
@@ -447,23 +445,24 @@ static Slot compile_symbol(GstCompiler *c, FormOptions opts, GstValue sym) {
return ret;
}
-/* Compile values in an array sequentail and track the returned slots.
+/* Compile values in a sequence and track the returned slots.
* If the result is unused, immediately drop slots we don't need. Can
- * also ignore the end of an array. */
-static void tracker_init_array(GstCompiler *c, FormOptions opts,
- SlotTracker *tracker, GstArray *array, uint32_t start, uint32_t fromEnd) {
+ * also ignore the end of the tuple sequence. */
+static void tracker_init_tuple(GstCompiler *c, FormOptions opts,
+ SlotTracker *tracker, GstValue *tuple, uint32_t start, uint32_t fromEnd) {
GstScope *scope = c->tail;
FormOptions subOpts = form_options_default();
- uint32_t i;
+ uint32_t i, count;
+ count = gst_tuple_length(tuple);
/* Calculate sub flags */
subOpts.resultUnused = opts.resultUnused;
/* Compile all of the arguments */
tracker_init(c, tracker);
/* Nothing to compile */
- if (array->count <= fromEnd) return;
+ if (count <= fromEnd) return;
/* Compile body of array */
- for (i = start; i < (array->count - fromEnd); ++i) {
- Slot slot = compile_value(c, subOpts, array->data[i]);
+ for (i = start; i < (count - fromEnd); ++i) {
+ Slot slot = compile_value(c, subOpts, tuple[i]);
if (subOpts.resultUnused)
compiler_drop_slot(c, scope, slot);
else
@@ -482,14 +481,15 @@ static void tracker_init_array(GstCompiler *c, FormOptions opts,
* is unused, it's calculation can be ignored (the evaluation of
* its argument is still carried out, but their results can
* also be ignored). */
-static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
+static Slot compile_operator(GstCompiler *c, FormOptions opts, GstValue *form,
int16_t op0, int16_t op1, int16_t op2, int16_t opn, int reverseOperands) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
Slot ret;
SlotTracker tracker;
+ uint32_t count = gst_tuple_length(form);
/* Compile operands */
- tracker_init_array(c, opts, &tracker, form, 1, 0);
+ tracker_init_tuple(c, opts, &tracker, form, 1, 0);
/* Free up space */
compiler_tracker_free(c, scope, &tracker);
if (opts.resultUnused) {
@@ -497,7 +497,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
} else {
ret = compiler_get_target(c, opts);
/* Write the correct opcode */
- if (form->count < 2) {
+ if (count < 2) {
if (op0 < 0) {
if (opn < 0) c_error(c, "this operator does not take 0 arguments");
goto opn;
@@ -505,7 +505,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
gst_buffer_push_u16(c->vm, buffer, op0);
gst_buffer_push_u16(c->vm, buffer, ret.index);
}
- } else if (form->count == 2) {
+ } else if (count == 2) {
if (op1 < 0) {
if (opn < 0) c_error(c, "this operator does not take 1 argument");
goto opn;
@@ -513,7 +513,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
gst_buffer_push_u16(c->vm, buffer, op1);
gst_buffer_push_u16(c->vm, buffer, ret.index);
}
- } else if (form->count == 3) {
+ } else if (count == 3) {
if (op2 < 0) {
if (opn < 0) c_error(c, "this operator does not take 2 arguments");
goto opn;
@@ -526,7 +526,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
if (opn < 0) c_error(c, "this operator does not take n arguments");
gst_buffer_push_u16(c->vm, buffer, opn);
gst_buffer_push_u16(c->vm, buffer, ret.index);
- gst_buffer_push_u16(c->vm, buffer, form->count - 1);
+ gst_buffer_push_u16(c->vm, buffer, count - 1);
}
}
/* Write the location of all of the arguments */
@@ -535,67 +535,59 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
}
/* Math specials */
-static Slot compile_addition(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_addition(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_ADD, -1, 0);
}
-static Slot compile_subtraction(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_subtraction(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_SUB, -1, 0);
}
-static Slot compile_multiplication(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_multiplication(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_MUL, -1, 0);
}
-static Slot compile_division(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_division(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_DIV, -1, 0);
}
-static Slot compile_equals(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_equals(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_EQL, -1, 0);
}
-static Slot compile_lt(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_lt(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 0);
}
-static Slot compile_lte(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_lte(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 0);
}
-static Slot compile_gt(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_gt(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 1);
}
-static Slot compile_gte(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_gte(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 1);
}
-static Slot compile_not(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_not(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, GST_OP_NOT, -1, -1, 0);
}
-static Slot compile_get(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_get(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_GET, -1, 0);
}
-static Slot compile_array(GstCompiler *c, FormOptions opts, GstArray *form) {
- return compile_operator(c, opts, form, -1, -1, -1, GST_OP_ARR, 0);
-}
-static Slot compile_object(GstCompiler *c, FormOptions opts, GstArray *form) {
- if ((form->count % 2) == 0) {
- c_error(c, "dictionary literal requires an even number of arguments");
- return nil_slot();
- } else {
- return compile_operator(c, opts, form, -1, -1, -1, GST_OP_DIC, 0);
- }
+static Slot compile_make_tuple(GstCompiler *c, FormOptions opts, GstValue *form) {
+ return compile_operator(c, opts, form, -1, -1, -1, GST_OP_TUP, 0);
}
/* Associative set */
-static Slot compile_set(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_set(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer;
FormOptions subOpts = form_options_default();
Slot ds, key, val;
- if (form->count != 4) c_error(c, "set expects 4 arguments");
+ if (gst_tuple_length(form) != 4) c_error(c, "set expects 4 arguments");
if (opts.resultUnused) {
- ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1]));
+ ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
} else {
subOpts = opts;
subOpts.isTail = 0;
- ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1]));
+ ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
subOpts = form_options_default();
}
- key = compiler_realize_slot(c, compile_value(c, subOpts, form->data[2]));
- val = compiler_realize_slot(c, compile_value(c, subOpts, form->data[3]));
+ key = compiler_realize_slot(c, compile_value(c, subOpts, form[2]));
+ val = compiler_realize_slot(c, compile_value(c, subOpts, form[3]));
gst_buffer_push_u16(c->vm, buffer, GST_OP_SET);
gst_buffer_push_u16(c->vm, buffer, ds.index);
gst_buffer_push_u16(c->vm, buffer, key.index);
@@ -654,22 +646,22 @@ static Slot compile_assign(GstCompiler *c, FormOptions opts, GstValue left, GstV
/* Compile series of expressions. This compiles the meat of
* function definitions and the inside of do forms. */
-static Slot compile_block(GstCompiler *c, FormOptions opts, GstArray *form, uint32_t startIndex) {
+static Slot compile_block(GstCompiler *c, FormOptions opts, GstValue *form, uint32_t startIndex) {
GstScope *scope = c->tail;
FormOptions subOpts = form_options_default();
uint32_t current = startIndex;
/* Check for empty body */
- if (form->count <= startIndex) return nil_slot();
+ if (gst_tuple_length(form) <= startIndex) return nil_slot();
/* Compile the body */
subOpts.resultUnused = 1;
subOpts.isTail = 0;
subOpts.canChoose = 1;
- while (current < form->count - 1) {
- compiler_drop_slot(c, scope, compile_value(c, subOpts, form->data[current]));
+ while (current < gst_tuple_length(form) - 1) {
+ compiler_drop_slot(c, scope, compile_value(c, subOpts, form[current]));
++current;
}
/* Compile the last expression in the body */
- return compile_value(c, opts, form->data[form->count - 1]);
+ return compile_value(c, opts, form[gst_tuple_length(form) - 1]);
}
/* Extract the last n bytes from the buffer and use them to construct
@@ -707,7 +699,7 @@ static GstFuncDef *compiler_gen_funcdef(GstCompiler *c, uint32_t lastNBytes, uin
}
/* Compile a function from a function literal */
-static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_function(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
uint32_t current = 1;
@@ -721,12 +713,12 @@ static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) {
ret = compiler_get_target(c, opts);
subGstScope = compiler_push_scope(c, 0);
/* Check for function documentation - for now just ignore. */
- if (form->data[current].type == GST_STRING)
+ if (form[current].type == GST_STRING)
++current;
/* Define the function parameters */
- if (form->data[current].type != GST_ARRAY)
- c_error(c, "expected function arguments");
- params = form->data[current++].data.array;
+ if (form[current].type != GST_ARRAY)
+ c_error(c, "expected function arguments array");
+ params = form[current++].data.array;
for (i = 0; i < params->count; ++i) {
GstValue param = params->data[i];
if (param.type != GST_STRING)
@@ -760,26 +752,26 @@ static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Branching special */
-static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_if(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
FormOptions condOpts = opts;
FormOptions branchOpts = opts;
Slot left, right, condition;
- uint32_t countAtJumpIf;
- uint32_t countAtJump;
- uint32_t countAfterFirstBranch;
+ uint32_t countAtJumpIf = 0;
+ uint32_t countAtJump = 0;
+ uint32_t countAfterFirstBranch = 0;
/* Check argument count */
- if (form->count < 3 || form->count > 4)
+ if (gst_tuple_length(form) < 3 || gst_tuple_length(form) > 4)
c_error(c, "if takes either 2 or 3 arguments");
/* Compile the condition */
condOpts.isTail = 0;
condOpts.resultUnused = 0;
- condition = compile_value(c, condOpts, form->data[1]);
+ condition = compile_value(c, condOpts, form[1]);
/* If the condition is nil, just compile false path */
if (condition.isNil) {
- if (form->count == 4) {
- return compile_value(c, opts, form->data[3]);
+ if (gst_tuple_length(form) == 4) {
+ return compile_value(c, opts, form[3]);
}
return condition;
}
@@ -791,12 +783,12 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
branchOpts.canChoose = 0;
branchOpts.target = condition.index;
/* Compile true path */
- left = compile_value(c, branchOpts, form->data[2]);
+ left = compile_value(c, branchOpts, form[2]);
if (opts.isTail) {
compiler_return(c, left);
} else {
/* If we need to jump again, do so */
- if (form->count == 4) {
+ if (gst_tuple_length(form) == 4) {
countAtJump = buffer->count;
buffer->count += sizeof(int32_t) + sizeof(uint16_t);
}
@@ -810,15 +802,15 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJumpIf) / 2);
buffer->count = countAfterFirstBranch;
/* Compile false path */
- if (form->count == 4) {
- right = compile_value(c, branchOpts, form->data[3]);
+ if (gst_tuple_length(form) == 4) {
+ right = compile_value(c, branchOpts, form[3]);
if (opts.isTail) compiler_return(c, right);
compiler_drop_slot(c, scope, right);
} else if (opts.isTail) {
compiler_return(c, condition);
}
/* Reset the second jump length */
- if (!opts.isTail && form->count == 4) {
+ if (!opts.isTail && gst_tuple_length(form) == 4) {
countAfterFirstBranch = buffer->count;
buffer->count = countAtJump;
gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP);
@@ -831,13 +823,13 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Special to throw an error */
-static Slot compile_error(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_error(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer;
Slot ret;
GstValue x;
- if (form->count != 2)
+ if (gst_tuple_length(form) != 2)
c_error(c, "error takes exactly 1 argument");
- x = form->data[1];
+ x = form[1];
ret = compiler_realize_slot(c, compile_value(c, opts, x));
gst_buffer_push_u16(c->vm, buffer, GST_OP_ERR);
gst_buffer_push_u16(c->vm, buffer, ret.index);
@@ -845,31 +837,31 @@ static Slot compile_error(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Try catch special */
-static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_try(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
Slot body;
uint16_t errorIndex;
uint32_t countAtTry, countTemp, countAtJump;
/* Check argument count */
- if (form->count < 3 || form->count > 4)
+ if (gst_tuple_length(form) < 3 || gst_tuple_length(form) > 4)
c_error(c, "try takes either 2 or 3 arguments");
/* Check for symbol to bind error to */
- if (form->data[1].type != GST_STRING)
+ if (form[1].type != GST_STRING)
c_error(c, "expected symbol at start of try");
/* Add subscope for error variable */
GstScope *subScope = compiler_push_scope(c, 1);
- errorIndex = compiler_declare_symbol(c, subScope, form->data[1]);
+ errorIndex = compiler_declare_symbol(c, subScope, form[1]);
/* Leave space for try instruction */
countAtTry = buffer->count;
buffer->count += sizeof(uint32_t) + 2 * sizeof(uint16_t);
/* Compile the body */
- body = compile_value(c, opts, form->data[2]);
+ body = compile_value(c, opts, form[2]);
if (opts.isTail) {
compiler_return(c, body);
} else {
/* If we need to jump over the catch, do so */
- if (form->count == 4) {
+ if (gst_tuple_length(form) == 4) {
countAtJump = buffer->count;
buffer->count += sizeof(int32_t) + sizeof(uint16_t);
}
@@ -882,17 +874,17 @@ static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_i32(c->vm, buffer, (countTemp - countAtTry) / 2);
buffer->count = countTemp;
/* Compile catch path */
- if (form->count == 4) {
+ if (gst_tuple_length(form) == 4) {
Slot catch;
countAtJump = buffer->count;
- catch = compile_value(c, opts, form->data[3]);
+ catch = compile_value(c, opts, form[3]);
if (opts.isTail) compiler_return(c, catch);
compiler_drop_slot(c, scope, catch);
} else if (opts.isTail) {
compiler_return(c, nil_slot());
}
/* Reset the second jump length */
- if (!opts.isTail && form->count == 4) {
+ if (!opts.isTail && gst_tuple_length(form) == 4) {
countTemp = buffer->count;
buffer->count = countAtJump;
gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP);
@@ -909,7 +901,7 @@ static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* While special */
-static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_while(GstCompiler *c, FormOptions opts, GstValue *form) {
Slot cond;
uint32_t countAtStart = c->buffer->count;
uint32_t countAtJumpDelta;
@@ -917,7 +909,7 @@ static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) {
FormOptions defaultOpts = form_options_default();
compiler_push_scope(c, 1);
/* Compile condition */
- cond = compile_value(c, defaultOpts, form->data[1]);
+ cond = compile_value(c, defaultOpts, form[1]);
/* Assert that cond is a real value - otherwise do nothing (nil is false,
* so loop never runs.) */
if (cond.isNil) return cond;
@@ -948,7 +940,7 @@ static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Do special */
-static Slot compile_do(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_do(GstCompiler *c, FormOptions opts, GstValue *form) {
Slot ret;
compiler_push_scope(c, 1);
ret = compile_block(c, opts, form, 1);
@@ -957,14 +949,14 @@ static Slot compile_do(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Quote special - returns its argument as is. */
-static Slot compile_quote(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_quote(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
Slot ret;
uint16_t literalIndex;
- if (form->count != 2)
+ if (gst_tuple_length(form) != 2)
c_error(c, "quote takes exactly 1 argument");
- GstValue x = form->data[1];
+ GstValue x = form[1];
if (x.type == GST_NIL ||
x.type == GST_BOOLEAN ||
x.type == GST_NUMBER) {
@@ -980,21 +972,21 @@ static Slot compile_quote(GstCompiler *c, FormOptions opts, GstArray *form) {
}
/* Assignment special */
-static Slot compile_var(GstCompiler *c, FormOptions opts, GstArray *form) {
- if (form->count != 3)
+static Slot compile_var(GstCompiler *c, FormOptions opts, GstValue *form) {
+ if (gst_tuple_length(form) != 3)
c_error(c, "assignment expects 2 arguments");
- return compile_assign(c, opts, form->data[1], form->data[2]);
+ return compile_assign(c, opts, form[1], form[2]);
}
/* Define a function type for Special Form helpers */
-typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, GstArray *form);
+typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, GstValue *form);
/* Dispatch to a special form */
-static SpecialFormHelper get_special(GstArray *form) {
+static SpecialFormHelper get_special(GstValue *form) {
uint8_t *name;
- if (form->count < 1 || form->data[0].type != GST_STRING)
+ if (gst_tuple_length(form) < 1 || form[0].type != GST_STRING)
return NULL;
- name = form->data[0].data.string;
+ name = form[0].data.string;
/* If we have a symbol with a zero length name, we have other
* problems. */
if (gst_string_length(name) == 0)
@@ -1031,16 +1023,6 @@ static SpecialFormHelper get_special(GstArray *form) {
}
}
break;
- case 'a':
- {
- if (gst_string_length(name) == 5 &&
- name[1] == 'r' &&
- name[2] == 'r' &&
- name[3] == 'a' &&
- name[4] == 'y') {
- return compile_array;
- }
- }
case 'e':
{
if (gst_string_length(name) == 5 &&
@@ -1092,14 +1074,6 @@ static SpecialFormHelper get_special(GstArray *form) {
}
}
break;
- case 'o':
- {
- if (gst_string_length(name) == 3 &&
- name[1] == 'b' &&
- name[2] == 'j') {
- return compile_object;
- }
- }
case 'q':
{
if (gst_string_length(name) == 5 &&
@@ -1126,6 +1100,12 @@ static SpecialFormHelper get_special(GstArray *form) {
name[1] == 'r' &&
name[2] == 'y') {
return compile_try;
+ } else if (gst_string_length(name) == 5 &&
+ name[1] == 'u' &&
+ name[2] == 'p' &&
+ name[3] == 'l' &&
+ name[4] == 'e') {
+ return compile_make_tuple;
}
}
case 'w':
@@ -1153,13 +1133,66 @@ static SpecialFormHelper get_special(GstArray *form) {
return NULL;
}
+/* Compile an array */
+static Slot compile_array(GstCompiler *c, FormOptions opts, GstArray *array) {
+ GstScope *scope = c->tail;
+ FormOptions subOpts = form_options_default();
+ GstBuffer *buffer = c->buffer;
+ Slot ret;
+ SlotTracker tracker;
+ uint32_t i, count;
+ count = array->count;
+ ret = compiler_get_target(c, opts);
+ tracker_init(c, &tracker);
+ for (i = 0; i < count; ++i) {
+ Slot slot = compile_value(c, subOpts, array->data[i]);
+ compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
+ }
+ compiler_tracker_free(c, scope, &tracker);
+ gst_buffer_push_u16(c->vm, buffer, GST_OP_ARR);
+ gst_buffer_push_u16(c->vm, buffer, ret.index);
+ gst_buffer_push_u16(c->vm, buffer, count);
+ compiler_tracker_write(c, &tracker, 0);
+ return ret;
+}
+
+/* Compile an object literal */
+static Slot compile_object(GstCompiler *c, FormOptions opts, GstObject *obj) {
+ GstScope *scope = c->tail;
+ FormOptions subOpts = form_options_default();
+ GstBuffer *buffer = c->buffer;
+ GstBucket *bucket;
+ Slot ret;
+ SlotTracker tracker;
+ uint32_t i, cap;
+ cap = obj->capacity;
+ ret = compiler_get_target(c, opts);
+ tracker_init(c, &tracker);
+ for (i = 0; i < cap; ++i) {
+ bucket = obj->buckets[i];
+ while (bucket != NULL) {
+ Slot slot = compile_value(c, subOpts, bucket->key);
+ compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
+ slot = compile_value(c, subOpts, bucket->value);
+ compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
+ bucket = bucket->next;
+ }
+ }
+ compiler_tracker_free(c, scope, &tracker);
+ gst_buffer_push_u16(c->vm, buffer, GST_OP_DIC);
+ gst_buffer_push_u16(c->vm, buffer, ret.index);
+ gst_buffer_push_u16(c->vm, buffer, obj->count * 2);
+ compiler_tracker_write(c, &tracker, 0);
+ return ret;
+}
+
/* Compile a form. Checks for special forms and macros. */
-static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) {
+static Slot compile_form(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
SpecialFormHelper helper;
/* Empty forms evaluate to nil. */
- if (form->count == 0) {
+ if (gst_tuple_length(form) == 0) {
GstValue temp;
temp.type = GST_NIL;
return compile_nonref_type(c, opts, temp);
@@ -1175,10 +1208,10 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) {
uint32_t i;
tracker_init(c, &tracker);
/* Compile function to be called */
- callee = compiler_realize_slot(c, compile_value(c, subOpts, form->data[0]));
+ callee = compiler_realize_slot(c, compile_value(c, subOpts, form[0]));
/* Compile all of the arguments */
- for (i = 1; i < form->count; ++i) {
- Slot slot = compile_value(c, subOpts, form->data[i]);
+ for (i = 1; i < gst_tuple_length(form); ++i) {
+ Slot slot = compile_value(c, subOpts, form[i]);
compiler_tracker_push(c, &tracker, slot);
}
/* Free up some slots */
@@ -1196,7 +1229,7 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_u16(c->vm, buffer, callee.index);
gst_buffer_push_u16(c->vm, buffer, ret.index);
}
- gst_buffer_push_u16(c->vm, buffer, form->count - 1);
+ gst_buffer_push_u16(c->vm, buffer, gst_tuple_length(form) - 1);
/* Write the location of all of the arguments */
compiler_tracker_write(c, &tracker, 0);
return ret;
@@ -1212,8 +1245,12 @@ static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) {
return compile_nonref_type(c, opts, x);
case GST_STRING:
return compile_symbol(c, opts, x);
+ case GST_TUPLE:
+ return compile_form(c, opts, x.data.tuple);
case GST_ARRAY:
- return compile_form(c, opts, x.data.array);
+ return compile_array(c, opts, x.data.array);
+ case GST_OBJECT:
+ return compile_object(c, opts, x.data.object);
default:
return compile_literal(c, opts, x);
}
@@ -1279,27 +1316,3 @@ GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) {
return func;
}
}
-
-/* Macro expansion. Macro expansion happens prior to the compilation process
- * and is completely separate. This allows the compilation to not have to worry
- * about garbage collection and other issues that would complicate both the
- * runtime and the compilation. */
-int gst_macro_expand(Gst *vm, GstValue x, GstObject *macros, GstValue *out) {
- while (x.type == GST_ARRAY) {
- GstArray *form = x.data.array;
- GstValue sym, macroFn;
- if (form->count == 0) break;
- sym = form->data[0];
- macroFn = gst_object_get(macros, sym);
- if (macroFn.type != GST_FUNCTION && macroFn.type != GST_CFUNCTION) break;
- gst_load(vm, macroFn);
- if (gst_start(vm)) {
- /* We encountered an error during parsing */
- return 1;
- } else {
- x = vm->ret;
- }
- }
- *out = x;
- return 0;
-}
diff --git a/datatypes.h b/datatypes.h
index 417b190f..be8a7869 100644
--- a/datatypes.h
+++ b/datatypes.h
@@ -4,12 +4,17 @@
#include
#include
+/* Flag for immutability in an otherwise mutable datastructure */
+#define GST_IMMUTABLE 1
+
+/* Verious types */
typedef enum GstType {
GST_NIL = 0,
GST_NUMBER,
GST_BOOLEAN,
GST_STRING,
GST_ARRAY,
+ GST_TUPLE,
GST_THREAD,
GST_BYTEBUFFER,
GST_FUNCTION,
@@ -57,6 +62,7 @@ struct GstValue {
GstBuffer *buffer;
GstObject *object;
GstThread *thread;
+ GstValue *tuple;
GstCFunction cfunction;
GstFunction *function;
uint8_t *string;
@@ -80,7 +86,7 @@ struct GstThread {
/* Size of stack frame */
#define GST_FRAME_SIZE ((sizeof(GstStackFrame) + sizeof(GstValue) + 1) / sizeof(GstValue))
-/* A dynamic array type */
+/* A dynamic array type. Useful for implementing a stack. */
struct GstArray {
uint32_t count;
uint32_t capacity;
@@ -195,6 +201,11 @@ struct GstCompiler {
#define gst_string_length(v) (gst_string_raw(v)[0])
#define gst_string_hash(v) (gst_string_raw(v)[1])
+/* Tuple utils */
+#define gst_tuple_raw(s) ((uint32_t *)(s) - 2)
+#define gst_tuple_length(v) (gst_tuple_raw(v)[0])
+#define gst_tuple_hash(v) (gst_tuple_raw(v)[1])
+
/* Bytecode */
enum GstOpCode {
GST_OP_ADD = 0, /* Addition */
@@ -202,38 +213,40 @@ enum GstOpCode {
GST_OP_MUL, /* Multiplication */
GST_OP_DIV, /* Division */
GST_OP_MOD, /* Modulo division */
+ GST_OP_IDV, /* Integer division */
GST_OP_EXP, /* Exponentiation */
GST_OP_CCT, /* Concatenation */
GST_OP_NOT, /* Invert */
GST_OP_LEN, /* Length */
GST_OP_TYP, /* Type */
- GST_OP_FLS,
- GST_OP_TRU,
- GST_OP_NIL,
- GST_OP_I16,
- GST_OP_UPV,
- GST_OP_JIF,
- GST_OP_JMP,
- GST_OP_CAL,
- GST_OP_RET,
- GST_OP_SUV,
- GST_OP_CST,
- GST_OP_I32,
- GST_OP_F64,
- GST_OP_MOV,
- GST_OP_CLN,
- GST_OP_EQL,
- GST_OP_LTN,
- GST_OP_LTE,
- GST_OP_ARR,
- GST_OP_DIC,
- GST_OP_TCL,
- GST_OP_RTN,
- GST_OP_SET,
- GST_OP_GET,
- GST_OP_ERR,
- GST_OP_TRY,
- GST_OP_UTY
+ GST_OP_FLS, /* Load false */
+ GST_OP_TRU, /* Load true */
+ GST_OP_NIL, /* Load nil */
+ GST_OP_I16, /* Load 16 bit signed integer */
+ GST_OP_UPV, /* Load upvalue */
+ GST_OP_JIF, /* Jump if */
+ GST_OP_JMP, /* Jump */
+ GST_OP_CAL, /* Call function */
+ GST_OP_RET, /* Return from function */
+ GST_OP_SUV, /* Set upvalue */
+ GST_OP_CST, /* Load constant */
+ GST_OP_I32, /* Load 32 bit signed integer */
+ GST_OP_F64, /* Load 64 bit IEEE double */
+ GST_OP_MOV, /* Move value */
+ GST_OP_CLN, /* Create a closure */
+ GST_OP_EQL, /* Check equality */
+ GST_OP_LTN, /* Check less than */
+ GST_OP_LTE, /* Check less than or equal to */
+ GST_OP_ARR, /* Create array */
+ GST_OP_DIC, /* Create object */
+ GST_OP_TUP, /* Create tuple */
+ GST_OP_TCL, /* Tail call */
+ GST_OP_RTN, /* Return nil */
+ GST_OP_SET, /* Assocaitive set */
+ GST_OP_GET, /* Associative get */
+ GST_OP_ERR, /* Throw error */
+ GST_OP_TRY, /* Begin try block */
+ GST_OP_UTY /* End try block */
};
#endif
diff --git a/dict.c b/dict.c
index ae6c3ded..aefe2cbd 100644
--- a/dict.c
+++ b/dict.c
@@ -1,24 +1,7 @@
-#include "datatypes.h"
+#include "dict.h"
#include "util.h"
#include "value.h"
-#define GST_DICT_FLAG_OCCUPIED 1
-#define GST_DICT_FLAG_TOMBSTONE 2
-
-typedef struct GstDictBucket GstDictBucket;
-struct GstDictBucket {
- GstValue key;
- GstValue value;
- uint8_t flags;
-};
-
-typedef struct GstDict GstDict;
-struct GstDict {
- uint32_t capacity;
- uint32_t count;
- GstDictBucket *buckets;
-};
-
/* Initialize a dictionary */
GstDict *gst_dict_init(GstDict *dict, uint32_t capacity) {
GstDictBucket *buckets = gst_raw_calloc(1, sizeof(GstDictBucket) * capacity);
@@ -100,7 +83,7 @@ int gst_dict_get(GstDict *dict, GstValue key, GstValue *value) {
/* Add item to dictionary */
GstDict *gst_dict_put(GstDict *dict, GstValue key, GstValue value) {
-i /* Check if we need to increase capacity. The load factor is low
+ /* Check if we need to increase capacity. The load factor is low
* because we are using linear probing */
uint32_t index, i;
uint32_t newCap = dict->count * 2 + 1;
@@ -131,7 +114,7 @@ i /* Check if we need to increase capacity. The load factor is low
dict->count++;
return dict;
}
- /* Error should never get here */
+ /* Error - should never get here */
return NULL;
}
diff --git a/dict.h b/dict.h
new file mode 100644
index 00000000..8a3b4820
--- /dev/null
+++ b/dict.h
@@ -0,0 +1,41 @@
+#ifndef dict_h_INCLUDED
+#define dict_h_INCLUDED
+
+#include "datatypes.h"
+
+#define GST_DICT_FLAG_OCCUPIED 1
+#define GST_DICT_FLAG_TOMBSTONE 2
+
+typedef struct GstDictBucket GstDictBucket;
+struct GstDictBucket {
+ GstValue key;
+ GstValue value;
+ uint8_t flags;
+};
+
+typedef struct GstDict GstDict;
+struct GstDict {
+ uint32_t capacity;
+ uint32_t count;
+ GstDictBucket *buckets;
+};
+
+/* Initialize a dictionary */
+GstDict *gst_dict_init(GstDict *dict, uint32_t capacity);
+
+/* Deinitialize a dictionary */
+GstDict *gst_dict_free(GstDict *dict);
+
+/* Rehash a dictionary */
+GstDict *gst_dict_rehash(GstDict *dict, uint32_t newCapacity);
+
+/* Get item from dictionary */
+int gst_dict_get(GstDict *dict, GstValue key, GstValue *value);
+
+/* Add item to dictionary */
+GstDict *gst_dict_put(GstDict *dict, GstValue key, GstValue value);
+
+/* Remove item from dictionary */
+int gst_dict_remove(GstDict *dict, GstValue key);
+
+#endif // dict_h_INCLUDED
diff --git a/disasm.c b/disasm.c
index 5c9947ed..a466426c 100644
--- a/disasm.c
+++ b/disasm.c
@@ -172,6 +172,9 @@ void gst_dasm(FILE * out, uint16_t *byteCode, uint32_t len) {
case GST_OP_DIC:
current += dasm_varg_op(out, current, "object", 1);
break;
+ case GST_OP_TUP:
+ current += dasm_varg_op(out, current, "tuple", 1);
+ break;
case GST_OP_TCL:
current += dasm_varg_op(out, current, "tailCall", 1);
break;
diff --git a/ds.c b/ds.c
index 67132226..032587c5 100644
--- a/ds.c
+++ b/ds.c
@@ -142,6 +142,20 @@ GstValue gst_array_peek(GstArray *array) {
}
}
+/****/
+/* Tuple functions */
+/****/
+
+/* Create a new emoty tuple of the given size. Expected to be
+ * mutated immediately */
+GstValue *gst_tuple(Gst *vm, uint32_t length) {
+ char *data = gst_alloc(vm, 2 * sizeof(uint32_t) + length * sizeof(GstValue));
+ GstValue *tuple = (GstValue *)(data + (2 * sizeof(uint32_t)));
+ gst_tuple_length(tuple) = length;
+ gst_tuple_hash(tuple) = 0;
+ return tuple;
+}
+
/****/
/* Dictionary functions */
/****/
diff --git a/ds.h b/ds.h
index 725340b8..e9d38aeb 100644
--- a/ds.h
+++ b/ds.h
@@ -65,6 +65,15 @@ GstValue gst_array_pop(GstArray *array);
/* Look at the top most item of an Array */
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);
+
/****/
/* Object functions */
/****/
diff --git a/gc.c b/gc.c
index 90dd1aca..b029df16 100644
--- a/gc.c
+++ b/gc.c
@@ -97,6 +97,16 @@ void gst_mark(Gst *vm, GstValue *x) {
}
break;
+ case GST_TUPLE:
+ if (gc_header(gst_tuple_raw(x->data.tuple))->color != vm->black) {
+ uint32_t i, count;
+ count = gst_tuple_length(x->data.tuple);
+ gc_header(gst_tuple_raw(x->data.tuple))->color = vm->black;
+ for (i = 0; i < count; ++i)
+ gst_mark(vm, x->data.tuple + i);
+ }
+ break;
+
case GST_THREAD:
if (gc_header(x->data.thread)->color != vm->black) {
GstThread *thread = x->data.thread;
@@ -227,3 +237,70 @@ void gst_clear_memory(Gst *vm) {
}
vm->blocks = NULL;
}
+
+/* Header for managed memory blocks */
+struct MMHeader {
+ struct MMHeader *next;
+ struct MMHeader *previous;
+};
+
+/* Initialize managed memory */
+void gst_mm_init(GstManagedMemory *mm) {
+ *mm = NULL;
+}
+
+/* Allocate some managed memory */
+void *gst_mm_alloc(GstManagedMemory *mm, uint32_t size) {
+ struct MMHeader *mem = gst_raw_alloc(size + sizeof(struct MMHeader));
+ if (mem == NULL)
+ return NULL;
+ mem->next = *mm;
+ mem->previous = NULL;
+ *mm = mem;
+ return mem + 1;
+}
+
+/* Intialize zeroed managed memory */
+void *gst_mm_zalloc(GstManagedMemory *mm, uint32_t size) {
+ struct MMHeader *mem = gst_raw_calloc(1, size + sizeof(struct MMHeader));
+ if (mem == NULL)
+ return NULL;
+ mem->next = *mm;
+ mem->previous = NULL;
+ *mm = mem;
+ return mem + 1;
+}
+
+/* Free a memory block used in managed memory */
+void gst_mm_free(GstManagedMemory *mm, void *block) {
+ struct MMHeader *mem = (struct MMHeader *)(((char *)block) - sizeof(struct MMHeader));
+ if (mem->previous != NULL) {
+ mem->previous->next = mem->next;
+ } else {
+ *mm = mem->next;
+ }
+ gst_raw_free(mem);
+}
+
+/* Free all memory in managed memory */
+void gst_mm_clear(GstManagedMemory *mm) {
+ struct MMHeader *block = (struct MMHeader *)(*mm);
+ struct MMHeader *next;
+ while (block != NULL) {
+ next = block->next;
+ free(block);
+ block = next;
+ };
+ *mm = NULL;
+}
+
+/* Analog to realloc */
+void *gst_mm_realloc(GstManagedMemory *mm, void *block, uint32_t nsize) {
+ struct MMHeader *mem = gst_raw_realloc(block, nsize + sizeof(struct MMHeader));
+ if (mem == NULL)
+ return NULL;
+ mem->next = *mm;
+ mem->previous = NULL;
+ *mm = mem;
+ return mem + 1;
+}
diff --git a/gc.h b/gc.h
index d054320c..ecb4e606 100644
--- a/gc.h
+++ b/gc.h
@@ -26,4 +26,26 @@ void gst_maybe_collect(Gst *vm);
/* Clear all memory */
void gst_clear_memory(Gst *vm);
-#endif
\ No newline at end of file
+/* Separate memory container. This memory is not gced, but can be freed at once. This
+ * is used in the compiler and parser to prevent memory leaks on errors. */
+typedef void *GstManagedMemory;
+
+/* Initialize managed memory */
+void gst_mm_init(GstManagedMemory *mm);
+
+/* Allocate some managed memory */
+void *gst_mm_alloc(GstManagedMemory *mm, uint32_t size);
+
+/* Intialize zeroed managed memory */
+void *gst_mm_zalloc(GstManagedMemory *mm, uint32_t size);
+
+/* Free a memory block used in managed memory */
+void gst_mm_free(GstManagedMemory *mm, void *block);
+
+/* Free all memory in managed memory */
+void gst_mm_clear(GstManagedMemory *mm);
+
+/* Analog to realloc */
+void *gst_mm_realloc(GstManagedMemory *mm, void *block, uint32_t nsize);
+
+#endif
diff --git a/parse.c b/parse.c
index 17c2b074..21764d08 100644
--- a/parse.c
+++ b/parse.c
@@ -21,10 +21,17 @@ struct GstParseState {
union {
struct {
uint8_t endDelimiter;
- GstArray * array;
+ GstArray *array;
} form;
struct {
- GstBuffer * buffer;
+ GstValue key;
+ int keyFound;
+ GstObject *object;
+ } object;
+ struct {
+ GstBuffer *buffer;
+ uint32_t count;
+ uint32_t accum;
enum {
STRING_STATE_BASE,
STRING_STATE_ESCAPE,
@@ -80,15 +87,8 @@ static void parser_push(GstParser *p, ParseType type, uint8_t character) {
case PTYPE_FORM:
top->buf.form.array = gst_array(p->vm, 10);
if (character == '(') top->buf.form.endDelimiter = ')';
- if (character == '[') {
- top->buf.form.endDelimiter = ']';
- gst_array_push(p->vm, top->buf.form.array, gst_load_cstring(p->vm, "array"));
- }
- if (character == '{') {
- top->buf.form.endDelimiter = '}';
- gst_array_push(p->vm, top->buf.form.array, gst_load_cstring(p->vm, "obj"));
- }
- break;
+ if (character == '[') top->buf.form.endDelimiter = ']';
+ if (character == '{') top->buf.form.endDelimiter = '}';
}
}
@@ -105,7 +105,7 @@ static void parser_append(GstParser *p, GstValue x) {
gst_array_push(p->vm, top->buf.form.array, x);
break;
default:
- p_error(p, "Expected container type.");
+ p_error(p, "expected container type");
break;
}
}
@@ -218,7 +218,7 @@ static GstValue build_token(GstParser *p, GstBuffer *buf) {
x.data.boolean = 1;
} else {
if (buf->data[0] >= '0' && buf->data[0] <= '9') {
- p_error(p, "Symbols cannot start with digits.");
+ p_error(p, "symbols cannot start with digits");
x.type = GST_NIL;
} else {
x.type = GST_STRING;
@@ -240,13 +240,27 @@ static int token_state(GstParser *p, uint8_t c) {
gst_buffer_push(p->vm, buf, c);
return 1;
} else {
- p_error(p, "Expected symbol character.");
+ p_error(p, "expected symbol character");
return 1;
}
}
+/* Get hex digit from a letter */
+static int to_hex(uint8_t c) {
+ if (c >= '0' && c <= '9') {
+ return c - '0';
+ } else if (c >= 'a' && c <= 'f') {
+ return 10 + c - 'a';
+ } else if (c >= 'A' && c <= 'F') {
+ return 10 + c - 'A';
+ } else {
+ return -1;
+ }
+}
+
/* Handle parsing a string literal */
static int string_state(GstParser *p, uint8_t c) {
+ int digit;
GstParseState *top = parser_peek(p);
switch (top->buf.string.state) {
case STRING_STATE_BASE:
@@ -279,15 +293,33 @@ static int string_state(GstParser *p, uint8_t c) {
case '"': next = '"'; break;
case '\'': next = '\''; break;
case 'z': next = '\0'; break;
+ case 'h':
+ top->buf.string.state = STRING_STATE_ESCAPE_HEX;
+ top->buf.string.count = 0;
+ top->buf.string.accum = 0;
+ return 1;
default:
- p_error(p, "Unknown string escape sequence.");
- return 1;
+ p_error(p, "unknown string escape sequence");
+ return 1;
}
gst_buffer_push(p->vm, top->buf.string.buffer, next);
top->buf.string.state = STRING_STATE_BASE;
}
break;
case STRING_STATE_ESCAPE_HEX:
+ digit = to_hex(c);
+ if (digit < 0) {
+ p_error(p, "invalid hexidecimal digit");
+ return 1;
+ } else {
+ top->buf.string.accum *= 16;
+ top->buf.string.accum += digit;
+ }
+ top->buf.string.accum += digit;
+ if (++top->buf.string.count == 2) {
+ gst_buffer_push(p->vm, top->buf.string.buffer, top->buf.string.accum);
+ top->buf.string.state = STRING_STATE_BASE;
+ }
break;
case STRING_STATE_ESCAPE_UNICODE:
break;
@@ -314,7 +346,7 @@ static int root_state(GstParser *p, uint8_t c) {
parser_push(p, PTYPE_TOKEN, c);
return 0;
}
- p_error(p, "Unexpected character.");
+ p_error(p, "unexpected character");
return 1;
}
@@ -324,8 +356,25 @@ static int form_state(GstParser *p, uint8_t c) {
if (c == top->buf.form.endDelimiter) {
GstArray *array = top->buf.form.array;
GstValue x;
- x.type = GST_ARRAY;
- x.data.array = array;
+ if (c == ']') {
+ x.type = GST_ARRAY;
+ x.data.array = array;
+ } else if (c == ')') {
+ x.type = GST_TUPLE;
+ x.data.tuple = gst_tuple(p->vm, array->count);
+ gst_memcpy(x.data.tuple, array->data, array->count * sizeof(GstValue));
+ } else { /* c == '{' */
+ uint32_t i;
+ if (array->count % 2 != 0) {
+ p_error(p, "object literal must have even number of elements");
+ return 1;
+ }
+ x.type = GST_OBJECT;
+ x.data.object = gst_object(p->vm, array->count);
+ for (i = 0; i < array->count; i += 2) {
+ gst_object_put(p->vm, x.data.object, array->data[i], array->data[i + 1]);
+ }
+ }
parser_pop(p);
parser_append(p, x);
return 1;
diff --git a/parser.c b/parser.c
deleted file mode 100644
index c0db9446..00000000
--- a/parser.c
+++ /dev/null
@@ -1 +0,0 @@
-#include "datatypes.h"
diff --git a/sample.gst b/sample.gst
new file mode 100644
index 00000000..2677c948
--- /dev/null
+++ b/sample.gst
@@ -0,0 +1,12 @@
+# GST is a general purpose language. It is small, not slow, and supports meta-
+# programming. It also should be structured and static enough to easily scale to
+# large programs. Lastly, it is interoperable with C and C++.
+
+# Syntax - There is very little syntax. This simplifies parsing and makes macros
+# easier to implement, which are useful in metaprogramming.
+(+ 1 2 3)
+
+# Unlike most lisps, it is not a pure functional language. Also unlike lisp, gst does
+# not make much use of a list data structure, instead using arrays and objects for
+# better performance at runtime.
+
diff --git a/util.h b/util.h
index 231d5ca7..c22ae2be 100644
--- a/util.h
+++ b/util.h
@@ -13,12 +13,18 @@
#define gst_raw_alloc malloc
#endif
-/* Clear allocation */
+/* Zero allocation */
#ifndef gst_raw_calloc
#include
#define gst_raw_calloc calloc
#endif
+/* Realloc */
+#ifndef gst_raw_realloc
+#include
+#define gst_raw_realloc realloc
+#endif
+
/* Free */
#ifndef gst_raw_free
#include
diff --git a/value.c b/value.c
index 0819620c..3bb7a9f1 100644
--- a/value.c
+++ b/value.c
@@ -87,17 +87,58 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
case GST_ARRAY:
{
uint32_t i;
- GstBuffer * b = gst_buffer(vm, 40);
- gst_buffer_push(vm, b, '(');
+ GstBuffer *b = gst_buffer(vm, 40);
+ gst_buffer_push(vm, b, '[');
for (i = 0; i < x.data.array->count; ++i) {
- uint8_t * substr = gst_to_string(vm, x.data.array->data[i]);
+ uint8_t *substr = gst_to_string(vm, x.data.array->data[i]);
gst_buffer_append(vm, b, substr, gst_string_length(substr));
if (i < x.data.array->count - 1)
gst_buffer_push(vm, b, ' ');
}
+ gst_buffer_push(vm, b, ']');
+ return gst_buffer_to_string(vm, b);
+ }
+ case GST_TUPLE:
+ {
+ uint32_t i, count;
+ GstBuffer *b = gst_buffer(vm, 40);
+ GstValue *tuple = x.data.tuple;
+ gst_buffer_push(vm, b, '(');
+ count = gst_tuple_length(tuple);
+ for (i = 0; i < count; ++i) {
+ uint8_t *substr = gst_to_string(vm, tuple[i]);
+ gst_buffer_append(vm, b, substr, gst_string_length(substr));
+ if (i < count - 1)
+ gst_buffer_push(vm, b, ' ');
+ }
gst_buffer_push(vm, b, ')');
return gst_buffer_to_string(vm, b);
}
+ case GST_OBJECT:
+ {
+ uint32_t i, count;
+ GstBucket *bucket;
+ GstBuffer *b = gst_buffer(vm, 40);
+ GstObject *object = x.data.object;
+ gst_buffer_push(vm, b, '{');
+ count = 0;
+ for (i = 0; i < object->capacity; ++i) {
+ bucket = object->buckets[i];
+ while (bucket != NULL) {
+ uint8_t *substr = gst_to_string(vm, bucket->key);
+ gst_buffer_append(vm, b, substr, gst_string_length(substr));
+ gst_buffer_push(vm, b, ' ');
+ substr = gst_to_string(vm, bucket->value);
+ gst_buffer_append(vm, b, substr, gst_string_length(substr));
+ count++;
+ if (count < object->count)
+ gst_buffer_push(vm, b, ' ');
+ bucket = bucket->next;
+ }
+ }
+ gst_buffer_push(vm, b, '}');
+ return gst_buffer_to_string(vm, b);
+ }
case GST_STRING:
return x.data.string;
case GST_BYTEBUFFER:
@@ -106,8 +147,6 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
return string_description(vm, "cfunction", 9, x.data.pointer);
case GST_FUNCTION:
return string_description(vm, "function", 8, x.data.pointer);
- case GST_OBJECT:
- return string_description(vm, "object", 6, x.data.pointer);
case GST_THREAD:
return string_description(vm, "thread", 6, x.data.pointer);
}
@@ -115,7 +154,7 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
}
/* Simple hash function */
-uint32_t djb2(const uint8_t * str) {
+static uint32_t djb2(const uint8_t * str) {
const uint8_t * end = str + gst_string_length(str);
uint32_t hash = 5381;
while (str < end)
@@ -123,6 +162,16 @@ uint32_t djb2(const uint8_t * str) {
return hash;
}
+/* Simple hash function to get tuple hash */
+static uint32_t tuple_hash(GstValue *tuple) {
+ uint32_t i;
+ uint32_t count = gst_tuple_length(tuple);
+ uint32_t hash = 5387;
+ for (i = 0; i < count; ++i)
+ hash = (hash << 5) + hash + gst_hash(tuple[i]);
+ return hash;
+}
+
/* Check if two values are equal. This is strict equality with no conversion. */
int gst_equals(GstValue x, GstValue y) {
int result = 0;
@@ -157,6 +206,27 @@ int gst_equals(GstValue x, GstValue y) {
}
result = 0;
break;
+ case GST_TUPLE:
+ if (x.data.tuple == y.data.tuple) {
+ result = 1;
+ break;
+ }
+ if (gst_hash(x) != gst_hash(y) ||
+ gst_tuple_length(x.data.string) != gst_tuple_length(y.data.string)) {
+ result = 0;
+ break;
+ }
+ result = 1;
+ {
+ uint32_t i;
+ for (i = 0; i < gst_tuple_length(x.data.tuple); ++i) {
+ if (!gst_equals(x.data.tuple[i], y.data.tuple[i])) {
+ result = 0;
+ break;
+ }
+ }
+ }
+ break;
default:
/* compare pointers */
result = (x.data.array == y.data.array);
@@ -194,6 +264,12 @@ uint32_t gst_hash(GstValue x) {
else
hash = gst_string_hash(x.data.string) = djb2(x.data.string);
break;
+ case GST_TUPLE:
+ if (gst_tuple_hash(x.data.tuple))
+ hash = gst_tuple_hash(x.data.tuple);
+ else
+ hash = gst_tuple_hash(x.data.tuple) = tuple_hash(x.data.tuple);
+ break;
default:
/* Cast the pointer */
{
@@ -253,6 +329,24 @@ int gst_compare(GstValue x, GstValue y) {
return xlen < ylen ? -1 : 1;
}
}
+ /* Lower indices are most significant */
+ case GST_TUPLE:
+ {
+ uint32_t i;
+ uint32_t xlen = gst_tuple_length(x.data.tuple);
+ uint32_t ylen = gst_tuple_length(y.data.tuple);
+ uint32_t count = xlen < ylen ? xlen : ylen;
+ for (i = 0; i < count; ++i) {
+ int comp = gst_compare(x.data.tuple[i], y.data.tuple[i]);
+ if (comp != 0) return comp;
+ }
+ if (xlen < ylen)
+ return -1;
+ else if (xlen > ylen)
+ return 1;
+ return 0;
+ }
+ break;
default:
if (x.data.string == y.data.string) {
return 0;
@@ -273,7 +367,7 @@ static int32_t to_index(GstNumber raw, int64_t len) {
int32_t toInt = raw;
if ((GstNumber) toInt == raw) {
/* We were able to convert */
- if (toInt < 0) {
+ if (toInt < 0 && len > 0) {
/* Index from end */
if (toInt < -len) return -1;
return len + toInt;
@@ -302,26 +396,33 @@ GstValue gst_get(Gst *vm, GstValue ds, GstValue key) {
case GST_ARRAY:
gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.array->count);
- if (index == -1) gst_error(vm, "Invalid array access");
- return ds.data.array->data[index];
+ if (index == -1) gst_error(vm, "invalid array access");
+ ret = ds.data.array->data[index];
+ break;
+ case GST_TUPLE:
+ gst_assert_type(vm, key, GST_NUMBER);
+ index = to_index(key.data.number, gst_tuple_length(ds.data.tuple));
+ if (index < 0) gst_error(vm, "invalid tuple access");
+ ret = ds.data.tuple[index];
+ break;
case GST_BYTEBUFFER:
gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.buffer->count);
- if (index == -1) gst_error(vm, "Invalid buffer access");
+ if (index == -1) gst_error(vm, "invalid buffer access");
ret.type = GST_NUMBER;
ret.data.number = ds.data.buffer->data[index];
break;
case GST_STRING:
gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, gst_string_length(ds.data.string));
- if (index == -1) gst_error(vm, "Invalid string access");
+ if (index == -1) gst_error(vm, "invalid string access");
ret.type = GST_NUMBER;
ret.data.number = ds.data.string[index];
break;
case GST_OBJECT:
return gst_object_get(ds.data.object, key);
default:
- gst_error(vm, "Cannot get.");
+ gst_error(vm, "cannot get");
}
return ret;
}
@@ -331,22 +432,31 @@ void gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value) {
int32_t index;
switch (ds.type) {
case GST_ARRAY:
+ if (ds.data.array->flags & GST_IMMUTABLE)
+ goto immutable;
gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.array->count);
- if (index == -1) gst_error(vm, "Invalid array access");
+ if (index == -1) gst_error(vm, "invalid array access");
ds.data.array->data[index] = value;
break;
case GST_BYTEBUFFER:
+ if (ds.data.buffer->flags & GST_IMMUTABLE)
+ goto immutable;
gst_assert_type(vm, key, GST_NUMBER);
gst_assert_type(vm, value, GST_NUMBER);
index = to_index(key.data.number, ds.data.buffer->count);
- if (index == -1) gst_error(vm, "Invalid buffer access");
+ if (index == -1) gst_error(vm, "invalid buffer access");
ds.data.buffer->data[index] = to_byte(value.data.number);
break;
case GST_OBJECT:
+ if (ds.data.object->flags & GST_IMMUTABLE)
+ goto immutable;
gst_object_put(vm, ds.data.object, key, value);
break;
default:
- gst_error(vm, "Cannot set.");
+ gst_error(vm, "cannot set");
}
+ return;
+ immutable:
+ gst_error(vm, "cannot set immutable value");
}
diff --git a/vm.c b/vm.c
index 65a772db..0374a67e 100644
--- a/vm.c
+++ b/vm.c
@@ -1,3 +1,4 @@
+
#include "vm.h"
#include "util.h"
#include "value.h"
@@ -78,7 +79,7 @@ int gst_start(Gst *vm) {
switch (*pc) {
- #define DO_BINARY_MATH(op) \
+ #define OP_BINARY_MATH(op) \
v1 = stack[pc[2]]; \
v2 = stack[pc[3]]; \
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP); \
@@ -90,18 +91,18 @@ int gst_start(Gst *vm) {
break;
case GST_OP_ADD: /* Addition */
- DO_BINARY_MATH(+)
+ OP_BINARY_MATH(+)
case GST_OP_SUB: /* Subtraction */
- DO_BINARY_MATH(-)
+ OP_BINARY_MATH(-)
case GST_OP_MUL: /* Multiplication */
- DO_BINARY_MATH(*)
+ OP_BINARY_MATH(*)
case GST_OP_DIV: /* Division */
- DO_BINARY_MATH(/)
+ OP_BINARY_MATH(/)
- #undef DO_BINARY_MATH
+ #undef OP_BINARY_MATH
case GST_OP_NOT: /* Boolean unary (Boolean not) */
temp.type = GST_BOOLEAN;
@@ -281,7 +282,7 @@ int gst_start(Gst *vm) {
case GST_OP_CLN: /* Create closure from constant FuncDef */
{
- GstFunction *fn, *current;
+ GstFunction *fn;
if (frame.callee.type != GST_FUNCTION)
gst_error(vm, GST_EXPECTED_FUNCTION);
if (!frame.env) {
@@ -291,13 +292,12 @@ int gst_start(Gst *vm) {
frame.env->stackOffset = thread.count;
frame.env->values = NULL;
}
- current = frame.callee.data.function;
- temp = gst_vm_literal(vm, current, pc[2]);
+ temp = gst_vm_literal(vm, frame.callee.data.function, pc[2]);
if (temp.type != GST_NIL)
gst_error(vm, "cannot create closure");
fn = gst_alloc(vm, sizeof(GstFunction));
fn->def = (GstFuncDef *) temp.data.pointer;
- fn->parent = current;
+ fn->parent = frame.callee.data.function;
fn->env = frame.env;
temp.type = GST_FUNCTION;
temp.data.function = fn;
@@ -359,6 +359,20 @@ int gst_start(Gst *vm) {
pc += kvs;
}
break;
+
+ case GST_OP_TUP: /* Tuple literal */
+ {
+ uint32_t i;
+ uint32_t len = pc[2];
+ GstValue *tuple = gst_tuple(vm, len);
+ for (i = 0; i < len; ++i)
+ tuple[i] = stack[pc[3 + i]];
+ temp.type = GST_TUPLE;
+ temp.data.tuple = tuple;
+ stack[pc[1]] = temp;
+ pc += 3 + len;
+ }
+ break;
case GST_OP_TCL: /* Tail call */
{