From c01f0838f13d049850696bf9889b3df02cf9f6df Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Fri, 13 Nov 2009 02:43:15 -0600 Subject: [PATCH] Misc. reader improvements, plus ability to run *.rla directly. Fix tree_replace() to handle recursive data structures. Fix some other minor bugs in the reader and interpreter. Implement comment-escapes in the string parser, for more readable input. Allow input program files (*.rla) to be invoked directly, with arguments. Add a simple string->number converter as a builtin function. --- builtin.c | 26 ++++++++ builtin.h | 3 + gc.h | 2 +- interp.c | 15 +++-- reader.c | 189 +++++++++++++++++++++++++++++++++--------------------- rosella.c | 45 +++++++++++-- 6 files changed, 195 insertions(+), 85 deletions(-) diff --git a/builtin.c b/builtin.c index 02b9ab2..498fcb0 100644 --- a/builtin.c +++ b/builtin.c @@ -5,6 +5,7 @@ #include "gc.h" #include "builtin.h" +#include "interp.h" static gc_root_t builtin_list; @@ -12,6 +13,8 @@ static void register_structure(gc_root_t *ms_root); static void register_template(gc_root_t *ms_root); static void register_lambda(gc_root_t *ms_root); +static void bi_string_to_number(interp_state_t *state); + void builtin_init(void) { gc_root_t ms_root; @@ -20,6 +23,7 @@ void builtin_init(void) register_gc_root(&ms_root, UNDEFINED); register_builtin(BI_UNDEFINED, UNDEFINED); + register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number)); register_structure(&ms_root); register_template(&ms_root); @@ -167,4 +171,26 @@ static void register_lambda(gc_root_t *ms_root) #undef SS +static void bi_string_to_number(interp_state_t *state) +{ + char *str; + char *end; + fixnum_t num; + value_t rval; + + str = value_to_string(CAR(state->argv.value)); + num = strtol(str, &end, 0); + free(str); + + if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num)) + rval = cons(fixnum_value(num), NIL); + else + rval = cons(FALSE_VALUE, NIL); + + state->lambda.value = state->k.value; + state->argv.value = rval; + state->k.value = FALSE_VALUE; + state->ctx.value = FALSE_VALUE; +} + /* vim:set sw=2 expandtab: */ diff --git a/builtin.h b/builtin.h index 55e821d..fb12d3d 100644 --- a/builtin.h +++ b/builtin.h @@ -13,6 +13,9 @@ #define BI_TEMPLATE "template" #define BI_LAMBDA "lambda" +/* Name of builtin function */ +#define BI_STRING_TO_NUMBER "string->number" + #define STRUCTURE_SLOT_NAME 0 #define STRUCTURE_SLOT_SUPER 1 #define STRUCTURE_SLOT_SLOTS 2 diff --git a/gc.h b/gc.h index 36c7a78..51beaef 100644 --- a/gc.h +++ b/gc.h @@ -51,7 +51,7 @@ typedef void (builtin_fn_t)(struct interp_state *state); /* Special values (0 <= n < 1024) */ /* These correspond to objects within the first page of memory */ -#define SPECIAL_VALUE(n) ((value_t)(4*(n)+2)) +#define SPECIAL_VALUE(n) ((value_t)(4*(n)+4)) #define TYPE_TAG(n) SPECIAL_VALUE(768+(n)) #define MAX_SPECIAL SPECIAL_VALUE(1023) diff --git a/interp.c b/interp.c index a2d5991..a6e7ee5 100644 --- a/interp.c +++ b/interp.c @@ -208,16 +208,21 @@ static value_t make_lambda(interp_state_t *state, value_t templ) struct_t *ts; vector_t *l_inst; byte_string_t *t_inst; + value_t temp; + + if (struct_is_a(templ, lambda_type_root.value)) + return templ; + + release_assert(struct_is_a(templ, template_type_root.value)); register_gc_root(&templ_root, templ); register_gc_root(&lambda_root, make_struct(lambda_type_root.value, LAMBDA_SLOTS)); /* Need to do this first, since it can call the garbage collector. */ - _LAMBDA_SLOT(lambda_root.value, INSTANCE_VARS) = - make_vector(get_vector(get_struct(templ_root.value) - ->slots[TEMPLATE_SLOT_INSTANCE_VARS]) - ->size, - UNDEFINED); + temp = make_vector(get_byte_string(get_struct(templ_root.value) + ->slots[TEMPLATE_SLOT_INSTANCE_VARS])->size, + UNDEFINED); + _LAMBDA_SLOT(lambda_root.value, INSTANCE_VARS) = temp; ls = _get_struct(lambda_root.value); ts = _get_struct(templ_root.value); diff --git a/reader.c b/reader.c index b63909f..9abaf77 100644 --- a/reader.c +++ b/reader.c @@ -10,7 +10,9 @@ typedef struct reader_state { FILE *file; - char ch; + int ch; + int line; + int column; gc_root_t ref_alist; gc_root_t weak_list; gc_root_t ref_list; @@ -31,6 +33,7 @@ static value_t read_definition(reader_state_t *state); static value_t read_backref(reader_state_t *state); static void next_char(reader_state_t *state); +static void skip_whitespace(reader_state_t *state); static value_t make_placeholder(reader_state_t *state, fixnum_t ref); static value_t get_placeholder(reader_state_t *state, fixnum_t ref); @@ -48,6 +51,7 @@ value_t read_value(FILE *f) register_gc_root(&state.ref_list, NIL); state.file = f; + state.line = state.column = 1; next_char(&state); result = read_one_value(&state); ungetc(state.ch, f); @@ -63,9 +67,7 @@ value_t read_value(FILE *f) static value_t read_one_value(reader_state_t *state) { - while (isspace(state->ch)) - next_char(state); - + skip_whitespace(state); release_assert(state->ch != EOF); switch (state->ch) @@ -80,6 +82,8 @@ static value_t read_one_value(reader_state_t *state) case '\"': return read_string(state); default: + fprintf(stderr, "Unexpected character '%c' in input on line %d, column %d.\n", + state->ch, state->line, state->column); release_assert(NOTREACHED("Unexpected character in input.")); return UNDEFINED; } @@ -170,9 +174,7 @@ static value_t read_list(reader_state_t *state) while (!done) { - while (isspace(state->ch)) - next_char(state); - + skip_whitespace(state); release_assert(state->ch != EOF); switch (state->ch) @@ -184,9 +186,7 @@ static value_t read_list(reader_state_t *state) value_t temp = read_one_value(state); reverse_list(&list_root.value, temp); - while (isspace(state->ch)) - next_char(state); - + skip_whitespace(state); release_assert(state->ch == ')'); next_char(state); @@ -202,17 +202,14 @@ static value_t read_list(reader_state_t *state) break; default: { - value_t temp; - list_root.value = cons(UNDEFINED, list_root.value); - temp = read_one_value(state); - _CAR(list_root.value) = temp; + value_t temp = read_one_value(state); + list_root.value = cons(temp, list_root.value); } break; } } unregister_gc_root(&list_root); - return list_root.value; } @@ -225,8 +222,13 @@ static value_t read_number(reader_state_t *state) { negative = true; next_char(state); - release_assert(isdigit(state->ch)); } + else if (state->ch == '+') + { + next_char(state); + } + + release_assert(isdigit(state->ch)); while (isdigit(state->ch)) { @@ -256,10 +258,10 @@ static value_t read_string(reader_state_t *state) while (state->ch != '"') { - bool skip_whitespace = false; + bool skip_ws = false; char ch; - if ((buffer_size - length) < 2) + if ((buffer_size - length) < 1) { release_assert(buffer_size <= INT32_MAX / 3); buffer_size = (3 * buffer_size) / 2; @@ -315,7 +317,14 @@ static value_t read_string(reader_state_t *state) case '\t': case '\v': case '\n': - skip_whitespace = true; + skip_ws = true; + break; + case ';': + /* Treats everything that follows on the same line as a comment, + * and additionally skips leading whitespace on the next line. */ + while (state->ch != '\n') + next_char(state); + skip_ws = true; break; case '\\': ch = '\\'; next_char(state); break; case '\'': ch = '\''; next_char(state); break; @@ -335,8 +344,10 @@ static value_t read_string(reader_state_t *state) } } - if (skip_whitespace) + if (skip_ws) { + /* Slightly different from the normal skip_whitespace(); + * Assumes first char is space, and bounded by '\n' afterward. */ do { next_char(state); } while (isspace(state->ch) && (state->ch != '\n')); @@ -349,7 +360,6 @@ static value_t read_string(reader_state_t *state) next_char(state); - buffer[length] = '\0'; value = make_byte_string(length, '\0'); memcpy(_get_byte_string(value)->bytes, buffer, length); free(buffer); @@ -359,86 +369,70 @@ static value_t read_string(reader_state_t *state) static value_t read_box(reader_state_t *state) { - gc_root_t root; - value_t v; - next_char(state); - - register_gc_root(&root, make_box(UNDEFINED)); - - v = read_one_value(state); - _get_box(root.value)->value = v; - - unregister_gc_root(&root); - - return root.value; + return make_box(read_one_value(state)); } static value_t read_vector(reader_state_t *state) { gc_root_t list_root; - gc_root_t vec_root; size_t length = 0; - value_t v; + value_t value; + value_t item; register_gc_root(&list_root, read_list(state)); - for (value_t v = list_root.value; !is_nil(v); v = CDR(v)) + for (value_t item = list_root.value; !is_nil(item); item = CDR(item)) ++length; - register_gc_root(&vec_root, make_vector(length, UNDEFINED)); + value = make_vector(length, UNDEFINED); - v = list_root.value; - for (size_t i = 0; i < length; ++i, v = _CDR(v)) - _get_vector(vec_root.value)->elements[i] = _CAR(v); + item = list_root.value; + for (size_t i = 0; i < length; ++i) + { + _get_vector(value)->elements[i] = _CAR(item); + item = _CDR(item); + } unregister_gc_root(&list_root); - unregister_gc_root(&vec_root); - return vec_root.value; + return value; } static value_t read_struct(reader_state_t *state) { gc_root_t list_root; - gc_root_t struct_root; size_t slots = 0; - value_t v; + value_t value; + value_t item; register_gc_root(&list_root, read_list(state)); - for (value_t v = CDR(list_root.value); !is_nil(v); v = CDR(v)) + for (item = CDR(list_root.value); !is_nil(item); item = CDR(item)) ++slots; - register_gc_root(&struct_root, make_struct(_CAR(list_root.value), slots)); + value = make_struct(_CAR(list_root.value), slots); - v = _CDR(list_root.value); - for (size_t i = 0; i < slots; ++i, v = _CDR(v)) - _get_struct(struct_root.value)->slots[i] = _CAR(v); + item = _CDR(list_root.value); + for (size_t i = 0; i < slots; ++i) + { + _get_struct(value)->slots[i] = _CAR(item); + item = _CDR(item); + } unregister_gc_root(&list_root); - unregister_gc_root(&struct_root); - return struct_root.value; + return value; } static value_t read_weak_box(reader_state_t *state) { - gc_root_t box_root; - gc_root_t value_root; + value_t value; next_char(state); - - register_gc_root(&box_root, make_weak_box(UNDEFINED)); - register_gc_root(&value_root, read_one_value(state)); - - _get_weak_box(box_root.value)->value = value_root.value; - state->weak_list.value = cons(value_root.value, state->weak_list.value); - - unregister_gc_root(&box_root); - unregister_gc_root(&value_root); - - return box_root.value; + value = read_one_value(state); + state->weak_list.value = cons(value, state->weak_list.value); + return make_weak_box(value); } static value_t read_definition(reader_state_t *state) @@ -461,6 +455,7 @@ static value_t read_definition(reader_state_t *state) static value_t read_backref(reader_state_t *state) { next_char(state); + skip_whitespace(state); release_assert(state->ch != EOF); if (state->ch == '"') @@ -518,44 +513,94 @@ static void set_placeholder(value_t place, value_t value) CAR(CDR(place)) = value; } -static void tree_replace(value_t *in, value_t oldval, value_t newval) +typedef struct seen_value { + value_t value; + struct seen_value *prev; +} seen_value_t; + +static void _tree_replace(value_t *in, value_t oldval, value_t newval, + seen_value_t *seen) +{ + seen_value_t this_seen = { *in, seen }; + + for (seen_value_t *item = seen; item; item = item->prev) + { + if (*in == item->value) + return; + } + if (*in == oldval) { *in = newval; } else if (is_box(*in)) { - tree_replace(&_get_box(*in)->value, oldval, newval); + _tree_replace(&_get_box(*in)->value, oldval, newval, &this_seen); } else if (is_pair(*in)) { - tree_replace(&_get_pair(*in)->car, oldval, newval); - tree_replace(&_get_pair(*in)->cdr, oldval, newval); + _tree_replace(&_get_pair(*in)->car, oldval, newval, &this_seen); + _tree_replace(&_get_pair(*in)->cdr, oldval, newval, &this_seen); } else if (is_vector(*in)) { for (size_t i = 0; i < _get_vector(*in)->size; ++i) { - tree_replace(&_get_vector(*in)->elements[i], oldval, newval); + _tree_replace(&_get_vector(*in)->elements[i], oldval, newval, &this_seen); } } else if (is_struct(*in)) { - tree_replace(&_get_struct(*in)->type, oldval, newval); + _tree_replace(&_get_struct(*in)->type, oldval, newval, &this_seen); for (size_t i = 0; i < _get_struct(*in)->nslots; ++i) - tree_replace(&_get_struct(*in)->slots[i], oldval, newval); + _tree_replace(&_get_struct(*in)->slots[i], oldval, newval, &this_seen); } else if (is_weak_box(*in)) { - tree_replace(&_get_weak_box(*in)->value, oldval, newval); + _tree_replace(&_get_weak_box(*in)->value, oldval, newval, &this_seen); } } +static void tree_replace(value_t *in, value_t oldval, value_t newval) +{ + _tree_replace(in, oldval, newval, NULL); +} + static void next_char(reader_state_t *state) { state->ch = fgetc(state->file); + + if (state->ch == '\n') + { + ++state->line; + state->column = 1; + } + else + { + ++state->column; + } +} + +static void skip_whitespace(reader_state_t *state) +{ + while (isspace(state->ch)) + next_char(state); + + /* Comments count as whitespace */ + if (state->ch == ';') + { + do { + next_char(state); + + if (state->ch == '\n') + { + next_char(state); + break; + } + } while (state->ch != EOF); + } } /* vim:set sw=2 expandtab: */ diff --git a/rosella.c b/rosella.c index 707321b..86d69b7 100644 --- a/rosella.c +++ b/rosella.c @@ -32,15 +32,38 @@ int main(int argc, char **argv) srand((unsigned int)time(NULL)); gc_init(1024, 256*1024*1024); - builtin_init(); interpreter_init(); - test_builtins(); - test_weak_boxes_and_wills(); - if (argc > 1) - test_reader(); - test_garbage_collection(argc > 1); + if (argc < 2 || (strcmp(argv[1], "-k") == 0)) + { + test_builtins(); + test_weak_boxes_and_wills(); + if (argc > 1) + test_reader(); + test_garbage_collection(argc > 1); + } + else + { + gc_root_t argv_root; + FILE *f = fopen(argv[1], "r"); + value_t program; + + register_gc_root(&argv_root, NIL); + + /* Construct list backward, so that we don't have to reverse it. */ + for (int i = argc - 1; i >= 2; --i) + { + value_t temp = string_to_value(argv[i]); + argv_root.value = cons(temp, argv_root.value); + } + + program = read_value(f); + print_value(run_interpreter(program, argv_root.value)); + nl(); + fclose(f); + unregister_gc_root(&argv_root); + } return 0; } @@ -159,7 +182,15 @@ static void test_reader(void) do { v = read_value(stdin); - print_value(v); nl(); nl(); + if (is_struct(v) && _get_struct(v)->type == lookup_builtin(BI_LAMBDA)) + { + print_value(run_interpreter(v, NIL)); + } + else + { + print_value(v); + } + nl(); nl(); } while (v != NIL); }