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

Add tuple support to cherry

Implement and Add tuple values to the runtime system.
parent 3ad75844
......@@ -24,6 +24,8 @@ struct org_cherry_value* org_cherry_core_raise(struct org_cherry_environment*
struct org_cherry_value* org_cherry_core_cons(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_tuple(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_add(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_sub(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_mul(struct org_cherry_environment* env, struct org_cherry_value* args);
......
......@@ -32,6 +32,7 @@ enum org_cherry_value_type {
CY_STRING,
CY_CHAR,
CY_PAIR,
CY_TUPLE,
CY_SYMBOL,
CY_PRIMITIVE,
CY_PROCEDURE
......@@ -48,14 +49,10 @@ struct org_cherry_value {
union {
cy_boolean_t boolean_value;
cy_fixnum_t fixnum_value;
cy_float_t float_value;
const cy_byte_t* string_value;
cy_unicode_t char_value;
const cy_byte_t* string_value;
const cy_byte_t* symbol_value;
cy_primitive_t fun_value;
......@@ -63,6 +60,7 @@ struct org_cherry_value {
};
#define TO_VALUE(value) ((struct org_cherry_value*) value)
#define TYPE(value) ((struct org_cherry_value*) value)->meta.type
#define IS_NULL(value) (value->meta.type == CY_EMPTYLIST)
#define IS_BOOLEAN(value) (value->meta.type == CY_BOOLEAN)
#define IS_DOT(value) (value->meta.type == CY_DOT)
......@@ -110,6 +108,19 @@ struct org_cherry_value* org_cherry_list_cons(struct org_cherry_value* head,
struct org_cherry_value* org_cherry_list(struct org_cherry_value* val, ...);
struct org_cherry_value* org_cherry_list_reverse(struct org_cherry_value* value);
struct org_cherry_tuple {
struct org_cherry_meta meta;
struct org_cherry_value** data;
size_t size;
};
#define TO_TUPLE(tuple) ((struct org_cherry_tuple*) tuple)
#define TUPLE_DATA(tuple) ((struct org_cherry_tuple*) tuple)->data
#define TUPLE_SIZE(tuple) ((struct org_cherry_tuple*) tuple)->size
struct org_cherry_value* org_cherry_tuple_new(size_t size);
struct org_cherry_procedure {
struct org_cherry_meta meta;
......
......@@ -60,6 +60,29 @@ org_cherry_core_cons(struct org_cherry_environment* env, struct org_cherry_value
}
struct org_cherry_value*
org_cherry_core_tuple(struct org_cherry_environment* env, struct org_cherry_value* args)
{
struct org_cherry_value* p = args;
size_t size = 0;
while(!IS_NULL(p)) {
p = TAIL(p);
size++;
}
struct org_cherry_value* tuple = org_cherry_tuple_new(size);
struct org_cherry_value** pos = TUPLE_DATA(tuple);
while(!IS_NULL(args)) {
*pos = HEAD(args);
args = TAIL(args);
pos++;
}
return tuple;
}
struct org_cherry_value*
org_cherry_core_add(struct org_cherry_environment* env, struct org_cherry_value* args)
{
......
......@@ -93,6 +93,7 @@ org_cherry_environment(void)
proc_to_env(env, "-", org_cherry_core_sub);
proc_to_env(env, "*", org_cherry_core_mul);
proc_to_env(env, "/", org_cherry_core_div);
proc_to_env(env, "tuple", org_cherry_core_tuple);
proc_to_env(env, "cons", org_cherry_core_cons);
proc_to_env(env, "exit", org_cherry_system_exit);
......
......@@ -276,7 +276,7 @@ org_cherry_procedure(struct org_cherry_environment* env, struct org_cherry_value
}
// ----------------------------------------------------------------------------
// cherry list operations
// list operations
// ----------------------------------------------------------------------------
struct org_cherry_value*
......@@ -343,6 +343,25 @@ org_cherry_list_reverse(struct org_cherry_value* xs)
return pair;
}
// ----------------------------------------------------------------------------
// tuple operations
// ----------------------------------------------------------------------------
struct org_cherry_value*
org_cherry_tuple_new(size_t size)
{
struct org_cherry_value* tuple = GC_MALLOC(sizeof(struct org_cherry_pair));
TYPE(tuple) = CY_TUPLE;
if(size > 0) {
TUPLE_DATA(tuple) = GC_MALLOC(size * sizeof(struct org_cherry_value*));
} else
TUPLE_DATA(tuple) = 0;
TUPLE_SIZE(tuple) = size;
return tuple;
}
......@@ -350,6 +369,22 @@ org_cherry_list_reverse(struct org_cherry_value* xs)
// Print
// ----------------------------------------------------------------------------
static void
print_tuple(FILE* out, struct org_cherry_tuple* value)
{
struct org_cherry_value** p = TUPLE_DATA(value);
struct org_cherry_value** e = TUPLE_DATA(value) + TUPLE_SIZE(value);
org_cherry_print(out, *p);
p++;
while(p < e) {
fprintf(out, " ");
org_cherry_print(out, *p);
p++;
}
}
static void
print_pair(FILE* out, struct org_cherry_pair* value)
{
......@@ -476,9 +511,14 @@ org_cherry_print(FILE* out, struct org_cherry_value* value)
break;
case CY_PAIR:
fprintf(out, "(");
print_pair(out, (struct org_cherry_pair*) value);
print_pair(out, TO_PAIR(value));
fprintf(out, ")");
break;
case CY_TUPLE:
fprintf(out, "[");
print_tuple(out, TO_TUPLE(value));
fprintf(out, "]");
break;
default:
fprintf(stderr, "cannot write unknown type\n");
break;
......
Supports Markdown
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