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 @@ - - - + + + + + + + - + + - - - - - - - - - - - + - + - - - - - - - - + @@ -64,6 +52,13 @@ + + + @@ -71,10 +66,9 @@ DEFINITION_ORDER - @@ -142,35 +136,36 @@ - - + - - - - - - + + + + - - - + + - + - + + + + @@ -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 */ {