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

Add ports to the runtime representation

parent b9b7b612
......@@ -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))
......
......@@ -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);
......
......@@ -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, "(");
......
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