int main (int argc, char **argv) {
// parse args
struct arguments arguments;
arguments.argc = 0;
argp_parse (&argp, argc, argv, 0, 0, &arguments);
char *filename = arguments.args[0];
LClosure *closure = l_closure_new(NULL);
l_closure_set_funcs(closure);
LValue* f = l_value_new(L_STR_TYPE, closure);
f->core.str = make_stringbuf((char*)filename);
l_closure_set(closure, "-script", f, true);
LValue *arg;
LValue *args = l_value_new(L_LIST_TYPE, closure);
args->core.list = create_vector();
int i;
for(i=1; i<arguments.argc; i++) {
arg = l_value_new(L_STR_TYPE, closure);
arg->core.str = make_stringbuf(arguments.args[i]);
vector_add(args->core.list, arg, sizeof(arg));
}
l_closure_set(closure, "-args", args, true);
l_eval_path(filename, closure);
exit(0);
}
LValue *l_eval_call_args(LNode *node, LValue *func, LClosure *outer_closure, LClosure *inner_closure) {
int i, argc;
LValue *v, *args_val, **ref;
LNode **args;
if(node != NULL) {
argc = node->exprc;
args = node->exprs;
} else {
argc = 0;
args = NULL;
}
if(outer_closure != inner_closure) {
// initialize all args to nil
for(i=0; i<func->core.func.argc; i++) {
v = l_value_new(L_NIL_TYPE, inner_closure);
l_closure_set(inner_closure, func->core.func.args[i]->val, v, true);
}
}
// setup the arguments
args_val = l_value_new(L_LIST_TYPE, inner_closure);
args_val->core.list = create_vector();
LValue ***args_ref = malloc(sizeof(LValue**) * argc);
// set all passed args
for(i=0; i<argc; i++) {
if(args[i]->type == L_VAR_TYPE) { // pass vars by reference
ref = l_closure_get_ref(outer_closure, args[i]->val);
if(ref != NULL) {
args_ref[i] = ref;
v = *ref;
} else {
// handle error
l_eval_var_node(args[i], outer_closure);
}
} else { // eval as normal and set the value
v = l_eval_node(args[i], outer_closure);
ref = malloc(sizeof(LValue*));
*ref = v;
args_ref[i] = ref;
}
// append to 'args' variable
vector_add(args_val->core.list, v, sizeof(v));
}
for(i=0; i<func->core.func.argc; i++) {
l_ref_put(inner_closure->locals, func->core.func.args[i]->val, args_ref[i]);
}
l_closure_set(inner_closure, "args", args_val, true);
return args_val;
}
LValue *l_eval_string_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_STR_TYPE, closure);
if(strchr(node->val, '\\')) {
value->core.str = make_stringbuf("");
int i, len = strlen(node->val);
char c[] = " ";
for(i=0; i<len; i++) {
if(node->val[i] == '\\' && i < len-1) {
i++;
switch(node->val[i]) {
case 'a' : c[0] = '\a'; break;
case 'b' : c[0] = '\b'; break;
case 'f' : c[0] = '\f'; break;
case 'n' : c[0] = '\n'; break;
case 'r' : c[0] = '\r'; break;
case 't' : c[0] = '\t'; break;
case 'v' : c[0] = '\v'; break;
case '\'': c[0] = '\''; break;
case '"' : c[0] = '"' ; break;
case '\\': c[0] = '\\'; break;
case '?' : c[0] = '?' ; break;
}
} else {
c[0] = node->val[i];
}
concat_stringbuf(value->core.str, c);
}
} else {
value->core.str = make_stringbuf(node->val);
}
return value;
}
LValue *l_func_count(LValue *args, LClosure *closure) {
LValue *list = l_list_get(args, 0);
l_assert_is(list, L_LIST_TYPE, L_ERR_MISSING_LIST, closure);
LValue *value = l_value_new(L_NUM_TYPE, closure);
mpz_init_set_ui(value->core.num, list->core.list->length);
return value;
}
// FIXME this does not work as expected/desired for a multi-character delimiter
// since it uses strtok under the hood
LValue *l_func_str_split(LValue *args, LClosure *closure) {
LValue *string = l_list_get(args, 0);
LValue *delim = l_list_get(args, 1);
l_assert_is(string, L_STR_TYPE, L_ERR_MISSING_STR, closure);
l_assert_is(delim, L_STR_TYPE, L_ERR_MISSING_STR, closure);
int i, size;
char **strings = str_split(string->core.str->str, delim->core.str->str, &size);
LValue *value = l_value_new(L_LIST_TYPE, closure);
value->core.list = create_vector();
LValue *s;
for(i=0; i<size; i++) {
s = l_value_new(L_STR_TYPE, closure);
s->core.str = make_stringbuf(strings[i]);
vector_add(value->core.list, s, sizeof(s));
}
return value;
}
LValue *l_func_str_add(LValue *args, LClosure *closure) {
LValue *v1 = l_list_get(args, 0);
LValue *v2 = l_list_get(args, 1);
LValue *value = l_value_new(L_STR_TYPE, closure);
value->core.str = make_stringbuf("");
concat_stringbuf(value->core.str, v1->core.str->str);
concat_stringbuf(value->core.str, v2->core.str->str);
return value;
}
LValue *l_func_list_get(LValue *args, LClosure *closure) {
LValue *list = l_list_get(args, 0);
LValue *index = l_list_get(args, 1);
l_assert_is(list, L_LIST_TYPE, L_ERR_MISSING_LIST, closure);
l_assert_is(index, L_NUM_TYPE, L_ERR_MISSING_INDEX, closure);
LValue *value = l_list_get(list, mpz_get_si(index->core.num));
if(value == NULL) value = l_value_new(L_NIL_TYPE, closure);
return value;
}
LValue *l_eval_list_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_LIST_TYPE, closure);
value->core.list = create_vector();
LValue *v;
int i;
for(i=0; i<node->exprc; i++) {
v = l_eval_node(node->exprs[i], closure);
vector_add(value->core.list, v, sizeof(v));
}
return value;
}
LValue *l_func_list_add(LValue *args, LClosure *closure) {
LValue *l1 = l_list_get(args, 0);
LValue *l2 = l_list_get(args, 1);
LValue *value = l_value_new(L_LIST_TYPE, closure);
value->core.list = subvector(l1->core.list, 0, l1->core.list->length);
int i;
for(i=0; i<l2->core.list->length; i++) {
vector_add(value->core.list, l2->core.list->data[i], l2->core.list->sizes[i]);
}
return value;
}
LValue *l_func_rest(LValue *args, LClosure *closure) {
LValue *list = l_list_get(args, 0);
l_assert_is(list, L_LIST_TYPE, L_ERR_MISSING_LIST, closure);
LValue *value = l_value_new(L_LIST_TYPE, closure);
if(list->core.list->length > 1) {
value->core.list = subvector(list->core.list, 1, list->core.list->length);
} else {
value->core.list = create_vector();
}
return value;
}
LValue *l_func_str(LValue *args, LClosure *closure) {
LValue *value = l_value_new(L_STR_TYPE, closure);
value->core.str = make_stringbuf("");
char *s;
int i;
for(i=0; i<args->core.list->length; i++) {
s = l_str(l_list_get(args, i));
concat_stringbuf(value->core.str, s);
}
return value;
}
LValue *l_eval_var_node(LNode *node, LClosure *closure) {
LValue *value = l_closure_get(closure, node->val);
if(value != NULL) {
return value;
} else {
value = l_value_new(L_ERR_TYPE, closure);
value->core.str = make_stringbuf(node->val);
buffer_concat(value->core.str, " not found");
l_handle_error(value, node, closure);
return value;
}
}
LValue *l_func_add(LValue *args, LClosure *closure) {
LValue *v1 = l_list_get(args, 0);
LValue *v2 = l_list_get(args, 1);
if(v1->type == L_LIST_TYPE && v2->type == L_LIST_TYPE) {
return l_func_list_add(args, closure);
} else if(v1->type == L_NUM_TYPE && v2->type == L_NUM_TYPE) {
return l_func_num_add(args, closure);
} else if(v1->type == L_STR_TYPE && v2->type == L_STR_TYPE) {
return l_func_str_add(args, closure);
} else {
return l_value_new(L_NIL_TYPE, closure);
}
}
LValue *l_eval_func_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_FUNC_TYPE, closure);
value->core.func.ptr = NULL;
// pass node=NULL to l_closure_clone, so this lexical frame is not printed in a stack trace
value->core.func.closure = l_closure_clone(closure, NULL);
if(node->exprs[0]) {
value->core.func.argc = node->exprs[0]->exprc;
value->core.func.args = node->exprs[0]->exprs;
} else {
value->core.func.argc = 0;
}
value->core.func.exprc = node->exprs[1]->exprc;
value->core.func.exprs = node->exprs[1]->exprs;
return value;
}
void l_eval_path(const char *filename, LClosure *closure) {
FILE *fp = fopen(filename, "r");
if(fp == NULL) {
printf("An error occurred while opening the file %s.\n", filename);
exit(1);
}
LValue* f = l_value_new(L_STR_TYPE, closure);
f->core.str = make_stringbuf((char*)filename);
l_closure_set(closure, "-filename", f, true);
stringbuf *source = make_stringbuf("");
source->str = saferead(fp);
l_eval(source->str, filename, closure);
}
LValue *l_func_type(LValue *args, LClosure *closure) {
LValue *value = l_list_get(args, 0);
char *types[9] = {
"nil",
"boolean",
"boolean",
"error",
"number",
"string",
"variable",
"list",
"function"
};
LValue *repr = l_value_new(L_STR_TYPE, closure);
repr->core.str = make_stringbuf(types[value->type]);
return repr;
}
LValue *l_eval_error_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_ERR_TYPE, closure);
value->core.str = make_stringbuf(node->val);
return value;
}
LValue *l_eval_num_node(LNode *node, LClosure *closure) {
LValue *value = l_value_new(L_NUM_TYPE, closure);
mpz_init_set_str(value->core.num, node->val, 0);
return value;
}
// sets misc global vars
void l_create_globals(LClosure *closure) {
l_closure_set(closure, "nil", l_value_new(L_NIL_TYPE, closure), false);
l_closure_set(closure, "false", l_value_new(L_FALSE_TYPE, closure), false);
l_closure_set(closure, "true", l_value_new(L_TRUE_TYPE, closure), false);
}
LValue *l_eval_call_node(LNode *node, LValue *func, LClosure *closure) {
if(func == NULL) func = l_eval_var_node(node, closure);
char *name = (node != NULL) ? node->val : "";
LValue *value, *args_val;
LNode *expr;
int i;
// create a running scope to hold arguments
// and a reference to self (for recursion)
// TODO this may not be necessary (can't we just do `cl=func->core.func.closure`?)
LClosure *cl = l_closure_clone(func->core.func.closure, node);
tail_loop:
l_debug(L_DEBUG_CALL) {
if(node) printf(">>> entering %s on line %d in %s\n", name, node->line_no, node->source_file);
else printf(">>> entering %s\n", name);
}
if(strcmp(name, "") != 0)
l_closure_set(cl, name, func, true);
args_val = l_eval_call_args(node, func, closure, cl);
if(func->core.func.ptr != NULL) {
// native C code
if(!setjmp(cl->jmp)) {
value = func->core.func.ptr(args_val, cl);
} else {
// function called longjmp to initiate a tail call
l_debug(L_DEBUG_CALL) printf("^^^ reached end of %s (longjmp tail call)\n", name);
node = NULL;
func = l_closure_get(cl, "--tail-call--");
closure = cl;
l_closure_backfill(func->core.func.closure, cl, node);
name = "";
goto tail_loop;
}
} else {
// Lydia code
int exprc = func->core.func.exprc;
if(exprc > 0) {
// eval all but the last expression
for(i=0; i<exprc-1; i++) {
expr = func->core.func.exprs[i];
value = l_eval_node(expr, cl);
}
expr = func->core.func.exprs[exprc-1];
if(expr->type == L_CALL_TYPE) { // tail call
l_debug(L_DEBUG_CALL) printf("^^^ reached end of %s (tail call)\n", name);
node = expr;
func = l_eval_var_node(node, cl);
closure = cl;
l_closure_backfill(func->core.func.closure, cl, node);
name = node->val;
goto tail_loop;
} else {
value = l_eval_node(expr, cl);
}
} else {
value = l_value_new(L_NIL_TYPE, cl);
}
}
l_closure_free(cl);
l_debug(L_DEBUG_CALL) printf("<<< returning from %s\n", name);
return value;
}
