Commit 2341d653 authored by Chris Müller's avatar Chris Müller
Browse files

Add variable parameter lists + massive bugfixing

org_cherry_apply can handle variable parameter lists now.
Fix many corresponding bugs.
parent 47d0f01b
......@@ -66,10 +66,10 @@ enum org_cherry_tok {
const cy_byte_t* org_cherry_tok_to_string(enum org_cherry_tok token);
enum org_cherry_tok org_cherry_lex(struct org_cherry_context* context);
const cy_byte_t* org_cherry_pos(struct org_cherry_context* context);
const cy_byte_t* org_cherry_pos(struct org_cherry_context* context);
void org_cherry_rewind(struct org_cherry_context* context, const cy_byte_t* pos);
const cy_byte_t* org_cherry_token_string(struct org_cherry_context* context);
const cy_byte_t* org_cherry_token_string(struct org_cherry_context* context);
size_t org_cherry_token_length(struct org_cherry_context* context);
struct org_cherry_value* org_cherry_read(struct org_cherry_context* context);
......@@ -26,6 +26,7 @@
enum org_cherry_value_type {
CY_EMPTYLIST,
CY_BOOLEAN,
CY_DOT,
CY_FIXNUM,
CY_FLOAT,
CY_STRING,
......@@ -64,6 +65,7 @@ struct org_cherry_value {
#define TO_VALUE(value) ((struct org_cherry_value*) value)
#define IS_NULL(value) (value->meta.type == CY_EMPTYLIST)
#define IS_BOOLEAN(value) (value->meta.type == CY_BOOLEAN)
#define IS_DOT(value) (value->meta.type == CY_DOT)
#define IS_FIXNUM(value) (value->meta.type == CY_FIXNUM)
#define IS_STRING(value) (value->meta.type == CY_STRING)
#define IS_SYMBOL(value) (value->meta.type == CY_SYMBOL)
......@@ -143,8 +145,8 @@ struct org_cherry_exception {
struct org_cherry_environment {
struct org_cherry_exception* exception_stack;
struct org_cherry_symbollist* mapping;
struct org_cherry_exception* exception_stack;
struct org_cherry_symbollist* mapping;
};
struct org_cherry_environment* org_cherry_env_push(struct org_cherry_environment* env);
......@@ -166,6 +168,7 @@ extern struct org_cherry_symbollist* org_cherry_global_symbollist;
extern struct org_cherry_value* org_cherry_emptylist;
extern struct org_cherry_value* org_cherry_true;
extern struct org_cherry_value* org_cherry_false;
extern struct org_cherry_value* org_cherry_dot;
extern struct org_cherry_value* org_cherry_symbol_quote;
extern struct org_cherry_value* org_cherry_symbol_define;
extern struct org_cherry_value* org_cherry_symbol_let;
......
......@@ -47,7 +47,8 @@ org_cherry_process_file(const char* filename, const cy_byte_t* method, struct or
}
struct org_cherry_environment* env = org_cherry_environment();
struct org_cherry_context* context = org_cherry_context(src, src, CY_SUPRESS_COMMENTS);
struct org_cherry_context* context = org_cherry_context(src, filename, CY_SUPRESS_COMMENTS);
struct org_cherry_value* exp = org_cherry_read(context);
org_cherry_env_push_exception_point(env);
......@@ -153,7 +154,7 @@ main(int argc, char** argv)
if(filename)
org_cherry_process_file(filename, method, arguments);
org_cherry_process_file(filename, method, org_cherry_list_reverse(arguments));
else
org_cherry_start_repl();
......
......@@ -35,6 +35,9 @@ org_cherry_eval_let(struct org_cherry_environment* env, struct org_cherry_value*
static struct org_cherry_value*
org_cherry_eval_values(struct org_cherry_environment* env, struct org_cherry_value* values)
{
if(IS_NULL(values))
return values;
struct org_cherry_value* begin = org_cherry_list_cons(org_cherry_eval(env, HEAD(values)), org_cherry_emptylist);
struct org_cherry_value* prev = begin;
struct org_cherry_value* head;
......@@ -66,7 +69,7 @@ tailcall:
struct org_cherry_value* v = org_cherry_env_lookup(env, value);
if(!v) {
fprintf(stderr, "ERROR value %s is not defined\n", value->symbol_value);
fprintf(stderr, "Unbound value for %s found\n", value->symbol_value);
exit(EXIT_FAILURE);
}
......@@ -131,12 +134,21 @@ tailcall:
if(IS_VARIABLE(params))
org_cherry_env_add(env, params, args);
else {
while(!IS_NULL(args)) {
// check if all params are given (IS_NULL(params))
org_cherry_env_add(env, HEAD(params), HEAD(args));
params = TAIL(params);
args = TAIL(args);
while(!IS_NULL(params)) {
if(IS_DOT(HEAD(params)) && !IS_NULL(TAIL(params))) {
org_cherry_env_add(env, HEAD(TAIL(params)), args);
params = org_cherry_emptylist;
args = org_cherry_emptylist;
} else if(!IS_DOT(HEAD(params))) {
if(!IS_NULL(args)) {
org_cherry_env_add(env, HEAD(params), HEAD(args));
args = TAIL(args);
} else {
// TODO Error msg
}
params = TAIL(params);
}
}
}
......
......@@ -43,6 +43,9 @@ org_cherry_io_println(struct org_cherry_environment* env, struct org_cherry_valu
case CY_FLOAT:
printf("%lf", v->float_value);
break;
case CY_PAIR:
org_cherry_print(stdout, v);
break;
default:
break;
}
......
......@@ -663,26 +663,12 @@ org_cherry_read_pair(struct org_cherry_context* context)
pos = org_cherry_pos(context);
tok = org_cherry_lex(context);
if(tok == TOK_ROUNDRIGHTBRACE)
if(tok == TOK_ROUNDRIGHTBRACE || tok == TOK_EOF)
return org_cherry_emptylist;
org_cherry_rewind(context, pos);
head = org_cherry_read(context);
pos = org_cherry_pos(context);
tok = org_cherry_lex(context);
if(tok == TOK_DOT) {
tail = org_cherry_read(context);
if(org_cherry_lex(context) != TOK_ROUNDRIGHTBRACE) {
org_cherry_error(context, "No trailing right parenthesis in improper list literal");
}
return (struct org_cherry_value*) org_cherry_list_cons(head, tail);
}
org_cherry_rewind(context, pos);
tail = org_cherry_read_pair(context);
return (struct org_cherry_value*) org_cherry_list_cons(head, tail);
......@@ -726,9 +712,9 @@ org_cherry_transform(struct org_cherry_value* value)
{
if(IS_TRY(value))
return org_cherry_transform_try(TAIL(value));
else if(IS_DEFINE(value))
else if(IS_DEFINE(value)) {
return org_cherry_transform_define(TAIL(value));
else
} else
return value;
}
......@@ -751,6 +737,9 @@ org_cherry_read(struct org_cherry_context* context)
case TOK_TRUE:
return org_cherry_true;
case TOK_DOT:
return org_cherry_dot;
case TOK_HEX:
return org_cherry_fixnum_from_string(org_cherry_token_string(context), 16);
......@@ -785,10 +774,11 @@ org_cherry_read(struct org_cherry_context* context)
default:
org_cherry_error(context, "bad input with token %s",
org_cherry_tok_to_string(tok));
goto RETURN_VALUE;
}
}
return 0;
RETURN_VALUE:
return org_cherry_transform(value);
}
......@@ -31,6 +31,7 @@ struct org_cherry_symbollist* org_cherry_global_symbollist;
struct org_cherry_value* org_cherry_emptylist;
struct org_cherry_value* org_cherry_true;
struct org_cherry_value* org_cherry_false;
struct org_cherry_value* org_cherry_dot;
struct org_cherry_value* org_cherry_symbol_define;
struct org_cherry_value* org_cherry_symbol_let;
......@@ -57,6 +58,9 @@ org_cherry_initialize(struct org_cherry_pair* arguments)
org_cherry_false->meta.type = CY_BOOLEAN;
org_cherry_false->boolean_value = 0;
org_cherry_dot = org_cherry_value_alloc();
org_cherry_dot->meta.type = CY_DOT;
org_cherry_emptylist = org_cherry_value_alloc();
org_cherry_emptylist->meta.type = CY_EMPTYLIST;
......
......@@ -333,7 +333,7 @@ org_cherry_env_lookup(struct org_cherry_environment* env, struct org_cherry_valu
{
struct org_cherry_symbollist* mapping = env->mapping;
while(env != 0) {
while(mapping != 0) {
struct RbNode* node = mapping->root;
while(node != 0) {
......
......@@ -382,6 +382,9 @@ org_cherry_print(FILE* out, struct org_cherry_value* value)
case CY_BOOLEAN:
fprintf(out, (value->boolean_value) ? "true" : "false");
break;
case CY_DOT:
fprintf(out, " . ");
break;
case CY_SYMBOL:
fprintf(out, "%s", value->symbol_value);
break;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment