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

Add more basic functions to runtime environment

Add tuple, nth, string->fixnum and string->tuple
parent 9f8a8b50
......@@ -201,8 +201,11 @@ struct cherry_value* cherry_core_list(struct cherry_environment* env, struct
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_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_tuple(struct cherry_environment* env, struct cherry_value* args);
......
......@@ -290,20 +290,78 @@ 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)
{
if(IS_NULL(args) || !IS_LIST(HEAD(args)))
cherry_env_raise(env, cherry_string("no list is given for the first operand"));
if(IS_NULL(args))
return cherry_fixnum(0);
struct cherry_value* value = HEAD(args);
fixnum_t length = 0;
switch(value->tag) {
case PAIR:
while(!IS_NULL(args)) {
length++;
args = TAIL(args);
}
break;
case STRING:
return cherry_fixnum(cherry_utf8_len(value->string_value));
case TUPLE:
return cherry_fixnum(TUPLE_SIZE(value));
default:
cherry_env_raise(env, cherry_string("length expects a string, tuple or a pair for the first operand"));
}
return cherry_fixnum(length);
}
struct cherry_value*
cherry_core_nth(struct cherry_environment* env, struct cherry_value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_FIXNUM(HEAD(TAIL(args))))
cherry_env_raise(env, cherry_string("nth expects a value and a following fixnum as index"));
struct cherry_value* value = HEAD(args);
fixnum_t index = HEAD(TAIL(args))->fixnum_value;
switch(value->tag) {
case PAIR:
if(index >= 0) {
struct cherry_value* p = value;
while(index-- > 0 && !IS_NULL(p))
p = TAIL(p);
return IS_NULL(p) ? p : HEAD(p);
}
break;
case STRING:
if(index >= 0 && index < cherry_utf8_len(value->string_value)) {
const byte_t* p = value->string_value;
struct cherry_value* lst = HEAD(args);
fixnum_t length = 0;
while(index-- > 0)
p = cherry_utf8_next(p);
while(!IS_NULL(lst)) {
length++;
lst = TAIL(lst);
return cherry_char(cherry_utf8_get(p));
}
break;
case TUPLE:
if(index >= 0 && index < TUPLE_SIZE(value))
return TUPLE_DATA(value)[index];
break;
default:
cherry_env_raise(env, cherry_string("length expects a string, tuple or a pair for the first operand"));
}
return cherry_fixnum(length);
}
cherry_env_raise(env, cherry_string("Out of Bounds Error"));
return cherry_false;
}
struct cherry_value*
......@@ -326,6 +384,42 @@ cherry_core_string_to_list(struct cherry_environment* env, struct cherry_value*
}
struct cherry_value*
cherry_core_string_to_tuple(struct cherry_environment* env, struct cherry_value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
cherry_env_raise(env, cherry_string("string->list accepts only one string as argument"));
const byte_t* p = HEAD(args)->string_value;
size_t size = cherry_utf8_len(p);
struct cherry_value* tuple = cherry_tuple_new(size);
size_t i;
for(i = 0; i < size; i++) {
TUPLE_DATA(tuple)[i] = cherry_char(cherry_utf8_get(p));
p = cherry_utf8_next(p);
}
return tuple;
}
struct cherry_value*
cherry_core_string_to_fixnum(struct cherry_environment* env, struct cherry_value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
cherry_env_raise(env, cherry_string("string->fixnum accepts only one string as argument"));
const byte_t* p = HEAD(args)->string_value;
if(*p != '\0' && *(p + 1) == 'b')
return cherry_fixnum(strtol(p + 2, 0, 2));
else
return cherry_fixnum(strtol(p, 0, 0));
}
struct cherry_value*
cherry_core_not(struct cherry_environment* env, struct cherry_value* args)
{
......@@ -480,11 +574,11 @@ cherry_core_greater_equal(struct cherry_environment* env, struct cherry_value* a
struct cherry_value* next = HEAD(args);
switch(next->tag) {
case FIXNUM:
if(next->fixnum_value < val->fixnum_value)
if(next->fixnum_value > val->fixnum_value)
return cherry_false;
break;
case FLOAT:
if(next->float_value < (val->fixnum_value))
if(next->float_value > (val->fixnum_value))
return cherry_false;
break;
......@@ -498,11 +592,11 @@ cherry_core_greater_equal(struct cherry_environment* env, struct cherry_value* a
struct cherry_value* next = HEAD(args);
switch(next->tag) {
case FIXNUM:
if(next->fixnum_value < val->float_value)
if(next->fixnum_value > val->float_value)
return cherry_false;
break;
case FLOAT:
if(next->float_value < val->float_value)
if(next->float_value > val->float_value)
return cherry_false;
break;
......@@ -533,11 +627,11 @@ cherry_core_less_equal(struct cherry_environment* env, struct cherry_value* args
struct cherry_value* next = HEAD(args);
switch(next->tag) {
case FIXNUM:
if(next->fixnum_value > val->fixnum_value)
if(next->fixnum_value < val->fixnum_value)
return cherry_false;
break;
case FLOAT:
if(next->float_value > (val->fixnum_value))
if(next->float_value < (val->fixnum_value))
return cherry_false;
break;
......@@ -551,11 +645,11 @@ cherry_core_less_equal(struct cherry_environment* env, struct cherry_value* args
struct cherry_value* next = HEAD(args);
switch(next->tag) {
case FIXNUM:
if(next->fixnum_value > val->float_value)
if(next->fixnum_value < val->float_value)
return cherry_false;
break;
case FLOAT:
if(next->float_value > val->float_value)
if(next->float_value < val->float_value)
return cherry_false;
break;
......
......@@ -103,11 +103,16 @@ 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, "length", cherry_core_length);
proc_to_env(env, "tuple", cherry_core_tuple);
proc_to_env(env, "nth", cherry_core_nth);
proc_to_env(env, "string->fixnum", cherry_core_string_to_fixnum);
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);
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