123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162 |
- #include "erplb.c"
- void* (builtin_lookup) (int* name) {
- for (int a = 0; builtin_commands[a].name[0] != 0; a++) {
- if (symbols_are_equal(builtin_commands[a].name, name)) {
- return builtin_commands[a].operation;
- }
- }
- return NULL;
- }
- Table* atom_lookup (int* name, Table* context) {
- Table *t = table_lookup(context, name);
- if (!t) t = table_lookup(globals, name);
- return t;
- }
- Atom* eval (Atom* expr, Table** context) {
- if (!expr)
- return NULL;
- if (is_simple(expr)) {
- if (is_symbol(expr))
- return eval_symbol(expr->symb, NULL, context);
- return expr;
- }
- if (is_list(expr))
- return eval_application(expr->list, context);
- return expr;
- }
- Atom* eval_symbol (int* symb, List* args, Table** context) {
- Atom *newhead = NULL, *value = NULL;
- Atom *(*fn)(List*,Table**);
- Table *t = table_lookup(*context, symb);
- if (!t) t = table_lookup(globals, symb);
- if (t) {
- if (!t->value)
- goto error;
- switch (t->value->type) {
- case SYMB:
- fn = builtin_lookup(t->value->symb);
- if (!fn)
- goto error;
- value = fn(args, context);
- break;
- case LIST:
- newhead = eval_application(t->value->list, context);
- if (!newhead)
- goto error;
- switch (newhead->type) {
- case LAMBDA:
- value = eval_lambda(newhead->list, args, context);
- break;
- case SYMB:
- fn = builtin_lookup(newhead->symb);
- if (!fn)
- goto error;
- value = fn(args, context);
- break;
- default:
- goto error;
- }
- goto end;
- case LAMBDA:
- value = eval_lambda(t->value->list, args, context);
- break;
- default:
- goto error;
- }
- goto end;
- }
- fn = builtin_lookup(symb);
- if (!fn)
- goto error;
- value = fn(args, context);
- goto end;
- error:
- free_atom(newhead);
- return _warning("EVAL(symbol)" INVALID_ARGS);
- end:
- free_atom(newhead);
- return value;
- }
- Atom* eval_application (List* appl, Table** context) {
- Atom *newhead = NULL, *value = NULL;
- if (!appl || !appl->head)
- goto error;
- switch (appl->head->type) {
- case LAMBDA:
- value = eval_lambda(appl->head->list, appl->tail, context);
- break;
- case SYMB:
- value = eval_symbol(appl->head->symb, appl->tail, context);
- break;
- case LIST:
- newhead = eval_application(appl->head->list, context);
- if (!newhead)
- goto error;
- switch (newhead->type) {
- case SYMB:
- value = eval_symbol(newhead->symb, appl->tail, context);
- break;
- default:
- goto error;
- }
- default:
- goto error;
- }
- free_atom(newhead);
- return value;
- error:
- free_atom(newhead);
- return _warning("EVAL(application)" INVALID_ARGS);
- }
- Atom* eval_lambda (List* body, List* arguments, Table** context) {
- #warning TODO
- if (!valid_lambda(body))
- return _warning("EVAL(lambda)" INVALID_ARGS);
- if (!define_local_vars(body->head->list, arguments, context))
- return _warning("EVAL(lambda)" INSUFFICIENT_ARGS_STK);
-
-
- destroy_local_vars(body, context);
- }
- unsigned define_local_vars (List* arg_names, List* values, Table** context) {
- Table *local_vars = NULL;
-
- while (arg_names && values) {
- table_set(&local_vars, arg_names->head->symb, values->head);
- arg_names = arg_names->tail;
- values = values->tail;
- }
-
- while (arg_names) {
- if (!stack) {
- free_table(local_vars);
- return 0;
- }
- table_set(&local_vars, arg_names->head->symb, stack->head);
- arg_names = arg_names->tail;
- }
- table_union(local_vars, context);
- return 1;
- }
- void destroy_local_vars (List* arg_names, Table** context) {
- while (arg_names) {
- table_unset(context, arg_names->head->symb);
- arg_names = arg_names->tail;
- }
- }
|