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

add additional runtime methods for cherry

add null?, map, list->string, list->tuple.
parent 79e1b5f4
......@@ -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))
......
......@@ -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)
......
......@@ -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;
}
......
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