Add variable list for lambda expressions

source/bootstrap.c

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

source/bootstrap.h

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