Add ports to the runtime representation

bootstrap/bootstrap.h

@@ -46,7 +46,8 @@ typedef struct value* (*primitive_t)(struct environment* env, struct value* args
 enum value_type {
     EMPTYLIST, BOOLEAN, DOT,
 	FIXNUM, FLOAT, STRING, CHAR, PAIR,
-    TUPLE, SYMBOL, PRIMITIVE, PROCEDURE
+    TUPLE, SYMBOL, PRIMITIVE, PROCEDURE,
+	PORT
 };
 
 
@@ -62,6 +63,7 @@ struct value {
 		primitive_t fun_value;
 		const byte_t* string_value;
 		const byte_t* symbol_value;
+		FILE* port_value;
 
         // lists
         struct {
@@ -94,9 +96,11 @@ struct value {
 #define IS_SYMBOL(value) (value->tag == SYMBOL)
 #define IS_FLOAT(value) (value->tag == FLOAT)
 #define IS_CHAR(value) (value->tag == CHAR)
+#define IS_TUPLE(value) (value->tag == TUPLE)
 #define IS_PAIR(value) (value->tag == PAIR)
 #define IS_PRIMITIVE(value) (value->tag == PRIMITIVE)
 #define IS_PROCEDURE(value) (value->tag == PROCEDURE)
+#define IS_PORT(value) (value->tag == PORT)
 
 #define TUPLE_DATA(obj) (obj->tuple.data)
 #define TUPLE_SIZE(obj) (obj->tuple.size)
@@ -119,6 +123,7 @@ struct value* 	floatpoint(float_t float_value);
 struct value* 	string(const byte_t* string_value);
 struct value* 	character(unicode_t char_value);
 struct value*   primitive(primitive_t fun_value);
+struct value*	port(FILE* stream);
 
 struct value*   value_dup(struct value* value);
 
@@ -180,7 +185,7 @@ extern struct value*         symbol_begin;
 #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_PROCEDURE(value))
+  (IS_BOOLEAN(value) || IS_FIXNUM(value) || IS_CHAR(value) || IS_STRING(value) || IS_FLOAT(value) || IS_PROCEDURE(value) || IS_PORT(value))
 
 #define IS_LIST(obj) (IS_PAIR(obj) || IS_NULL(obj))
 

bootstrap/runtime.c

@@ -38,6 +38,10 @@ struct value*		symbol_quote;
 struct value*		symbol_loop;
 struct value*		symbol_begin;
 
+struct value*		STDIN;
+struct value*		STDOUT;
+struct value*		STDERR;
+
 
 void 
 initialize(struct value* arguments)
@@ -68,6 +72,10 @@ initialize(struct value* arguments)
 	symbol_if     	= symbol("if");
 	symbol_loop     = symbol("loop");
 	symbol_begin   	= symbol("begin");
+
+	STDIN = port(stdin);
+	STDOUT = port(stdout);
+	STDERR = port(stderr);
 }
 
 
@@ -139,6 +147,19 @@ core_list(struct environment* env, struct value* args)
 }
 
 	
+struct value*
+core_is_list(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args))
+		core_raise(env, string("cherry.core/list?: expects one value"));
+
+	return (IS_NULL(HEAD(args)) || IS_PAIR(HEAD(args)))
+		&& (IS_NULL(TAIL(HEAD(args))) || IS_PAIR(TAIL(HEAD(args))))
+		? True 
+		: False;
+}
+
+
 struct value*
 core_is_null(struct environment* env, struct value* args)
 {
@@ -346,6 +367,15 @@ core_list_to_tuple(struct environment* env, struct value* args)
 }
 
 
+struct value*
+core_is_tuple(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args))
+		return False;
+
+	return IS_TUPLE(HEAD(args)) ? True : False;
+}
+
 
 struct value*
 core_tuple(struct environment* env, struct value* args)
@@ -958,6 +988,78 @@ core_equal(struct environment* env, struct value* args)
 }
 
 
+struct value*
+core_is_number(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args))
+		return False;
+
+	return IS_FIXNUM(HEAD(args)) ? True : False;
+}
+
+struct value*
+core_number_to_string(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)))
+		core_raise(env, string("cherry.core/number->string: expects a number"));
+
+	char buffer[64];
+	snprintf(buffer, 64, "%ld", HEAD(args)->fixnum_value);
+
+	return string(string_dup(buffer));
+}
+
+
+struct value*
+core_number_to_float(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)))
+		core_raise(env, string("cherry.core/number->float: expects a number"));
+
+	return floatpoint((float_t) HEAD(args)->fixnum_value);
+}
+
+
+struct value*
+core_number_to_char(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)))
+		core_raise(env, string("cherry.core/number->char: expects a number"));
+
+	return character(HEAD(args)->fixnum_value);
+}
+
+struct value*
+core_is_float(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args))
+		return False;
+
+	return IS_FLOAT(HEAD(args)) ? True : False;
+}
+
+struct value*
+core_float_to_string(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args) || !IS_FLOAT(HEAD(args)))
+		core_raise(env, string("cherry.core/float->string: expects a float"));
+
+	char buffer[64];
+	snprintf(buffer, 64, "%lf", HEAD(args)->float_value);
+
+	return string(string_dup(buffer));
+}
+
+
+struct value*
+core_float_to_number(struct environment* env, struct value* args)
+{
+	if(IS_NULL(args) || !IS_FLOAT(HEAD(args)))
+		core_raise(env, string("cherry.core/float->number: expects a number"));
+
+	return fixnum((fixnum_t) HEAD(args)->float_value);
+}
+
 
 
 struct value*
@@ -1020,6 +1122,10 @@ environment(void)
 #define proc_to_env(ENV, STR, FUN) \
 	env_add(ENV, symbol(STR), primitive(FUN))
 
+	env_add(env, symbol("*out*"), STDOUT);
+	env_add(env, symbol("*in*"), STDIN);
+	env_add(env, symbol("*err*"), STDERR);
+
 	proc_to_env(env, "println", core_println);
 	proc_to_env(env, "type", core_type);
 	proc_to_env(env, "+", core_add);
@@ -1040,10 +1146,12 @@ environment(void)
 	proc_to_env(env, "head", core_head);
 	proc_to_env(env, "tail", core_tail);
 	proc_to_env(env, "null?", core_is_null);
-	proc_to_env(env, "map", core_map);
+	proc_to_env(env, "list?", core_is_list);
 	proc_to_env(env, "list->string", core_list_to_string);
 	proc_to_env(env, "list->tuple", core_list_to_tuple);
+	proc_to_env(env, "map", core_map);
 
+	proc_to_env(env, "tuple?", core_is_tuple);
 	proc_to_env(env, "tuple", core_tuple);
 	proc_to_env(env, "length", core_length);
 	proc_to_env(env, "nth", core_nth);
@@ -1051,6 +1159,15 @@ environment(void)
     proc_to_env(env, "make-list", core_make_list);
     proc_to_env(env, "make-tuple", core_make_tuple);
 
+	proc_to_env(env, "number?", core_is_number);
+	proc_to_env(env, "number->string", core_number_to_string);
+	proc_to_env(env, "number->float", core_number_to_float);
+	proc_to_env(env, "number->char", core_number_to_char);
+
+	proc_to_env(env, "float?", core_is_float);
+	proc_to_env(env, "float->string", core_float_to_string);
+	proc_to_env(env, "float->number", core_float_to_number);
+
 	proc_to_env(env, "string?", core_is_string);
 	proc_to_env(env, "string->list", core_string_to_list);
 	proc_to_env(env, "string->tuple", core_string_to_tuple);

bootstrap/value.c

@@ -169,6 +169,16 @@ floatpoint(float_t value)
 }
 
 
+struct value*
+port(FILE* stream)
+{
+    struct value* v = value_alloc();
+    v->tag = PORT;
+    v->port_value = stream;
+    return v;
+}
+
+
 struct value* 	
 string(const byte_t* value)
 {
@@ -414,6 +424,9 @@ cherry_print(FILE* out, struct value* value)
 			break;
         case PROCEDURE:
             fprintf(out, "#lambda-procedure");
+            break;
+        case PORT:
+            fprintf(out, "#port");
             break;
 		case PAIR:
 			fprintf(out, "(");