Commit 406c9e49 authored by Chris Müller's avatar Chris Müller
Browse files

Add variable list for lambda expressions

parent d2625b25
......@@ -247,6 +247,8 @@ initialize(void)
Emptylist = alloc_value();
Emptylist->tag = EMPTYLIST;
Emptylist->pair.head = Emptylist;
Emptylist->pair.tail = Emptylist;
global_symbollist = Emptylist;
......@@ -266,6 +268,7 @@ core_environment(void)
#define proc_to_env(ENV, STR, FUN) \
env_let(ENV, symbol(STR), primitive(FUN))
proc_to_env(env, "write", core_write);
proc_to_env(env, "println", core_println);
return env;
......@@ -312,10 +315,17 @@ core_println(struct value* env, struct value* args)
}
printf("\n");
return True;
}
struct value*
core_write(struct value* env, struct value* args)
{
cherry_write(stdout, args);
return True;
}
// ----------------------------------------------------------------------------
// Reading
// ----------------------------------------------------------------------------
......@@ -527,9 +537,6 @@ lex_raw_string(byte_t** begin, byte_t* buffer, size_t buffer_size)
p++; // remove beginning delimeter
while(*p != '\0' && *p != '~') {
printf("STREAM %s\n", p);
fflush(stdout);
if(*p == '\r' || *p == '\n')
failure("Unexpected newline/carriage return found in raw string");
......@@ -621,11 +628,16 @@ lex_string(byte_t** begin, byte_t* buffer, size_t buffer_size)
case '0': *buffer = '0'; break;
case '"': *buffer = '"'; break;
case '\\': *buffer = '\\'; break;
state = STR_EAT;
goto NO_BUFFER_APPEND;
default:
failure("Unknown escape sequence found in this string literal");
}
state = STR_EAT;
if(buffer < buf_end)
buffer++;
else
failure("Read: Bufferoverflow in string scanning");
goto NO_BUFFER_APPEND;
break;
case STR_FINAL:
......@@ -798,6 +810,10 @@ cherry_read(byte_t** src, byte_t* buffer, size_t buffer_size)
val = False;
break;
case TOK_DOT:
val = Dot;
break;
case TOK_TRUE:
val = True;
break;
......@@ -939,15 +955,10 @@ env_let(struct value* env, struct value* var, struct value* val)
static struct value*
eval_values(struct value* env, struct value* args)
{
struct value* last = Emptylist;
struct value* begin = last;
while(!IS_NULL(args)) {
last = TAIL(last) = cons(cherry_eval(env, HEAD(args)), Emptylist);
args = TAIL(args);
}
return TAIL(begin);
if(IS_NULL(args))
return args;
else
return cons(cherry_eval(env, HEAD(args)), eval_values(env, TAIL(args)));
}
struct value*
......@@ -958,10 +969,10 @@ cherry_eval(struct value* env, struct value* value)
return value;
else if(IS_VARIABLE(value))
return env_lookup(env, value);
struct value* fn = HEAD(value);
struct value* args = TAIL(value);
if(fn == Let) {
return env_let(env, HEAD(args), cherry_eval(env, HEAD(TAIL(args))));
......@@ -983,15 +994,38 @@ cherry_eval(struct value* env, struct value* value)
? HEAD(TAIL(args))
: HEAD(TAIL(TAIL(args)));
} else if(IS_SYMBOL(fn)) {
} else if(IS_SYMBOL(fn)) {
fn = cherry_eval(env, fn);
args = eval_values(env, args);
if(IS_PRIMITIVE(fn))
value = (fn->fun_value)(env, args);
return (fn->fun_value)(env, args);
else if(IS_PROCEDURE(fn)) {
env = EXTEND_ENV(fn->procedure.env, fn->procedure.param, args);
value = cons(Begin, fn->procedure.body);
struct value* params = fn->procedure.param;
env = EXTEND_ENV(env);
if(IS_VARIABLE(params))
env_let(env, params, args);
else {
while(!IS_NULL(params)) {
if(IS_DOT(HEAD(params)) && !IS_NULL(TAIL(params))) {
env_let(env, HEAD(TAIL(params)), args);
args = params = Emptylist;
} else if(!IS_DOT(HEAD(params))) {
if(!IS_NULL(args)) {
env_let(env, HEAD(params), HEAD(args));
params = TAIL(params);
args = TAIL(args);
}
} else {
failure("Eval: Dot operator given without a variable");
}
}
}
value = cons(Begin, fn->procedure.body);
} else
failure("Eval: Unknown procedure type found");
......@@ -1041,14 +1075,6 @@ cherry_write_pair(FILE* out, struct value* value)
}
void
cherry_writeln(FILE* out, struct value* value)
{
cherry_write(out, value);
fprintf(out, "\n");
fflush(out);
}
void
cherry_write(FILE* out, struct value* value)
{
......@@ -1180,9 +1206,6 @@ cherry_write(FILE* out, struct value* value)
default:
failure("cannot write an unknown value type");
}
fprintf(out, "\n");
fflush(out);
}
......@@ -1200,6 +1223,7 @@ void cherry_main(const char* filename, const byte_t* method, struct value* args)
if(!port)
failure("could not load file %s", filename);
byte_t* p = text(port);
struct value* exp = cherry_read(&p, buffer, SCANNER_BUFFERSIZE);
struct value* env = core_environment();
......@@ -1209,6 +1233,9 @@ void cherry_main(const char* filename, const byte_t* method, struct value* args)
exp = cherry_read(&p, buffer, SCANNER_BUFFERSIZE);
}
if(method)
cherry_eval(env, cons(symbol(method), args));
exit(EXIT_SUCCESS);
}
......
......@@ -130,8 +130,8 @@ struct value* cons(struct value* head, struct value* tail);
#define SYMBOL_LEFT(node) HEAD(TAIL(node))
#define SYMBOL_RIGHT(node) TAIL(TAIL(node))
#define EXTEND_ENV(env, vars, vals) cons(cons(vars,vals), env)
#define INITIAL_ENV EXTEND_ENV(Emptylist, Emptylist, Emptylist)
#define EXTEND_ENV(env) cons(cons(Emptylist,Emptylist), env)
#define INITIAL_ENV EXTEND_ENV(Emptylist)
#define FIRST_FRAME(env) HEAD(env)
#define PARENT_FRAMES(env) TAIL(env)
#define FRAME_VARIABLES(frame) HEAD(frame)
......@@ -156,3 +156,4 @@ void cherry_write(FILE* out, struct value* v);
void cherry_writeln(FILE* out, struct value* v);
struct value* core_println(struct value* env, struct value* args);
struct value* core_write(struct value* env, struct value* args);
Markdown is supported
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