add additional runtime methods for cherry

add null?, map, list->string, list->tuple.

bootstrap/bootstrap.h

@@ -128,8 +128,8 @@ struct cherry_value*    cherry_primitive(primitive_t fun_value);
 struct cherry_value*    cherry_value_dup(struct cherry_value* value);
 
 
-struct cherry_value*    cherry_list_cons(struct cherry_value* head, struct cherry_value* tail);
 struct cherry_value*	cherry_list(struct cherry_value* val, ...);
+struct cherry_value*    cherry_list_cons(struct cherry_value* head, struct cherry_value* tail);
 struct cherry_value*    cherry_list_reverse(struct cherry_value* value);
 
 struct cherry_value*    cherry_tuple_new(size_t size);
@@ -198,14 +198,22 @@ struct cherry_value*    cherry_core_raise(struct cherry_environment* env, struct
 
 struct cherry_value*    cherry_core_cons(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_list(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_is_null(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_head(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_tail(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_length(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_nth(struct cherry_environment* env, struct cherry_value* args);
 
+struct cherry_value*    cherry_core_map(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_list_to_string(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_list_to_tuple(struct cherry_environment* env, struct cherry_value* args);
+
+struct cherry_value*    cherry_core_make_list(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_make_tuple(struct cherry_environment* env, struct cherry_value* args);
+
 struct cherry_value*    cherry_core_string_to_list(struct cherry_environment* env, struct cherry_value* args);
-struct cherry_value*    cherry_core_string_to_tuple(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_string_to_fixnum(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_string_to_tuple(struct cherry_environment* env, struct cherry_value* args);
 
 struct cherry_value*    cherry_core_tuple(struct cherry_environment* env, struct cherry_value* args);
 
@@ -239,7 +247,7 @@ struct cherry_value*    cherry_system_exit(struct cherry_environment* env, struc
 #define IS_TRUE(obj) (!IS_FALSE(obj))
 
 #define IS_SELF_EVALUATING(value) \
-  (IS_BOOLEAN(value) || IS_FIXNUM(value) || IS_CHAR(value) || IS_STRING(value) || IS_FLOAT(value))
+  (IS_BOOLEAN(value) || IS_FIXNUM(value) || IS_CHAR(value) || IS_STRING(value) || IS_FLOAT(value) || IS_PROCEDURE(value))
 
 #define IS_LIST(obj) (IS_PAIR(obj) || IS_NULL(obj))
 

bootstrap/primitives.c

@@ -17,6 +17,7 @@
 */
 
 #include "bootstrap.h"
+#include <gc.h>
 
     
 struct cherry_value*
@@ -53,29 +54,6 @@ cherry_core_type(struct cherry_environment* env, struct cherry_value* args)
 
 
 
-struct cherry_value*
-cherry_core_tuple(struct cherry_environment* env, struct cherry_value* args)
-{
-	struct cherry_value* p = args;
-	size_t size = 0;
-
-	while(!IS_NULL(p)) {
-		p = TAIL(p);
-		size++;
-	}
-
-	struct cherry_value* tuple = cherry_tuple_new(size);
-	struct cherry_value** pos = TUPLE_DATA(tuple);
-
-	while(!IS_NULL(args)) {
-		*pos = HEAD(args);
-		args = TAIL(args);
-		pos++;
-	}
-
-	return tuple;
-}
-
 struct cherry_value*    
 cherry_core_add(struct cherry_environment* env, struct cherry_value* args)
 {
@@ -122,9 +100,6 @@ cherry_core_sub(struct cherry_environment* env, struct cherry_value* args)
 	struct cherry_value* v = cherry_value_dup(HEAD(args));
 	args = TAIL(args);
 
-	cherry_print(stdout, v);
-	printf("\n");
-	
 	while(!IS_NULL(args)) {
 		struct cherry_value* x = HEAD(args);
 
@@ -268,6 +243,35 @@ cherry_core_list(struct cherry_environment* env, struct cherry_value* args)
 	return args;
 }
 
+	
+struct cherry_value*
+cherry_core_is_null(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args))
+		cherry_env_raise(env, cherry_string("null? expects an operand"));
+
+	return IS_NULL(HEAD(args)) ? cherry_true : cherry_false;
+}
+
+
+	
+struct cherry_value*
+cherry_core_make_list(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)) || IS_NULL(TAIL(args)))
+		cherry_env_raise(env, cherry_string("make-list expects a length fixnum and an initialization element"));
+
+	fixnum_t length = HEAD(args)->fixnum_value;
+	struct cherry_value* element = HEAD(TAIL(args));
+	struct cherry_value* list = cherry_emptylist;
+
+	while(length-- > 0) 
+		list = cherry_list_cons(element, list);
+
+	return list;
+}
+
+
 struct cherry_value*
 cherry_core_head(struct cherry_environment* env, struct cherry_value* args)
 {
@@ -363,6 +367,133 @@ cherry_core_nth(struct cherry_environment* env, struct cherry_value* args)
     return cherry_false;
 }
 
+
+struct cherry_value*    
+cherry_core_map(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_PROCEDURE(HEAD(args)) || !IS_PAIR(HEAD(TAIL(args)))) 
+		cherry_env_raise(env, cherry_string("map expects a function and a list"));
+
+	struct cherry_value* result = cherry_value_alloc(); 
+	struct cherry_value* proc = HEAD(args);
+	struct cherry_value* pair = HEAD(TAIL(args));
+	struct cherry_value* last = result; 
+
+	while(!IS_NULL(pair)) {
+		if(IS_PRIMITIVE(proc))
+			TAIL(last) = cherry_list_cons((proc->fun_value)(env, HEAD(pair)), cherry_emptylist);
+		else if(IS_PROCEDURE(proc))
+			TAIL(last) = cherry_list_cons(cherry_eval(env, cherry_list(proc, HEAD(pair), 0)), cherry_emptylist);
+
+		last = TAIL(last);
+		pair = TAIL(pair);
+	}
+
+	return TAIL(result);
+}
+
+
+struct cherry_value*    
+cherry_core_list_to_string(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
+		cherry_env_raise(env, cherry_string("list->string expects a pair for the first operand"));
+
+	struct cherry_value* result = HEAD(args);
+	size_t size = 0;
+
+	while(!IS_NULL(result)) {
+		if(!IS_CHAR(HEAD(result)))
+			cherry_env_raise(env, cherry_string("list->string expects a list of characters"));
+		size += cherry_unicode_to_utf8(0, HEAD(result)->char_value);
+		result = TAIL(result);
+	}
+
+	byte_t* p = GC_MALLOC(size * sizeof(byte_t));
+
+	result = HEAD(args);
+	size = 0;
+
+	while(!IS_NULL(result)) {
+		size += cherry_unicode_to_utf8(p + size, HEAD(result)->char_value);
+		result = TAIL(result);
+	}
+
+	return cherry_string(p);
+}
+
+
+struct cherry_value*    
+cherry_core_list_to_tuple(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
+		cherry_env_raise(env, cherry_string("list->tuple expects a pair for the first operand"));
+
+	struct cherry_value* result = HEAD(args);
+	size_t size = 0;
+
+	while(!IS_NULL(result)) {
+		size += 1;
+		result = TAIL(result);
+	}
+
+	struct cherry_value* tuple = cherry_tuple_new(size);
+
+	result = HEAD(args);
+	size_t i;
+
+	for(i = 0; i < size; ++i) {
+		TUPLE_DATA(tuple)[i] = HEAD(result);
+		result = TAIL(result);
+	}
+
+	return tuple;
+}
+
+
+
+struct cherry_value*
+cherry_core_tuple(struct cherry_environment* env, struct cherry_value* args)
+{
+	struct cherry_value* p = args;
+	size_t size = 0;
+
+	while(!IS_NULL(p)) {
+		p = TAIL(p);
+		size++;
+	}
+
+	struct cherry_value* tuple = cherry_tuple_new(size);
+	struct cherry_value** pos = TUPLE_DATA(tuple);
+
+	while(!IS_NULL(args)) {
+		*pos = HEAD(args);
+		args = TAIL(args);
+		pos++;
+	}
+
+	return tuple;
+}
+
+struct cherry_value*
+cherry_core_make_tuple(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)) || !IS_NULL(TAIL(args)))
+		cherry_env_raise(env, cherry_string("make-list expects a length fixnum and an initialization element"));
+
+	fixnum_t length = HEAD(args)->fixnum_value;
+	struct cherry_value* element = HEAD(TAIL(args));
+	struct cherry_value* tuple = cherry_tuple_new(length);
+	fixnum_t i;
+
+	for(i = 0; i < length; ++i) {
+		TUPLE_DATA(tuple)[i] = element;
+	}
+
+	return tuple;
+}
+
+
 	
 struct cherry_value*
 cherry_core_string_to_list(struct cherry_environment* env, struct cherry_value* args)

bootstrap/runtime.c

@@ -103,17 +103,25 @@ cherry_environment(void)
 	
 	proc_to_env(env, "cons", cherry_core_cons);
 	proc_to_env(env, "list", cherry_core_list);
-	proc_to_env(env, "tuple", cherry_core_tuple);
 	proc_to_env(env, "head", cherry_core_head);
 	proc_to_env(env, "tail", cherry_core_tail);
+	proc_to_env(env, "null?", cherry_core_is_null);
+	proc_to_env(env, "map", cherry_core_map);
+	proc_to_env(env, "list->string", cherry_core_list_to_string);
+	proc_to_env(env, "list->tuple", cherry_core_list_to_tuple);
+
+	proc_to_env(env, "tuple", cherry_core_tuple);
 	proc_to_env(env, "length", cherry_core_length);
 	proc_to_env(env, "nth", cherry_core_nth);
-	
-	proc_to_env(env, "string->fixnum", cherry_core_string_to_fixnum);
+
+    proc_to_env(env, "make-list", cherry_core_make_list);
+    proc_to_env(env, "make-tuple", cherry_core_make_tuple);
+
 	proc_to_env(env, "string->list", cherry_core_string_to_list);
 	proc_to_env(env, "string->tuple", cherry_core_string_to_tuple);
-
-	proc_to_env(env, "exit", cherry_system_exit);
+	proc_to_env(env, "string->fixnum", cherry_core_string_to_fixnum);
+	
+    proc_to_env(env, "exit", cherry_system_exit);
 
 	return env;
 }