nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Jesse D. McDonald 2009-11-13 02:43:15 -06:00
parent 53b1cc213b
commit c01f0838f1
6 changed files with 195 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
builtin.c
View File

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

3
builtin.h
View File

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

2
gc.h
View File

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

15
interp.c
View File

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

189
reader.c
View File

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

45
rosella.c
View File

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