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

Add string->list to runtime environment.

parent 40d28355
......@@ -29,6 +29,8 @@ struct org_cherry_value* org_cherry_core_head(struct org_cherry_environment*
struct org_cherry_value* org_cherry_core_tail(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_length(struct org_cherry_environment* env, struct org_cherry_value* args);
struct org_cherry_value* org_cherry_core_string_to_list(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);
......
......@@ -17,6 +17,7 @@
*/
#include "cherry/primitives.h"
#include "cherry/unicode.h"
struct org_cherry_value*
org_cherry_core_type(struct org_cherry_environment* env, struct org_cherry_value* args)
......@@ -50,60 +51,6 @@ org_cherry_core_type(struct org_cherry_environment* env, struct org_cherry_value
return org_cherry_false;
}
struct org_cherry_value*
org_cherry_core_cons(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_NULL(TAIL(TAIL(args))))
org_cherry_env_raise(env, org_cherry_string("cons only accept exactly two parameters"));
TAIL(args) = HEAD(TAIL(args));
return args;
}
struct org_cherry_value*
org_cherry_core_list(struct org_cherry_environment* env, struct org_cherry_value* args)
{
return args;
}
struct org_cherry_value*
org_cherry_core_head(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
return HEAD(HEAD(args));
}
struct org_cherry_value*
org_cherry_core_tail(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
return TAIL(HEAD(args));
}
struct org_cherry_value*
org_cherry_core_length(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_LIST(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
struct org_cherry_value* lst = HEAD(args);
cy_fixnum_t length = 0;
while(!IS_NULL(lst)) {
length++;
lst = TAIL(lst);
}
return org_cherry_fixnum(length);
}
struct org_cherry_value*
......@@ -302,3 +249,78 @@ org_cherry_core_raise(struct org_cherry_environment* env, struct org_cherry_valu
return org_cherry_false;
}
struct org_cherry_value*
org_cherry_core_cons(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_NULL(TAIL(TAIL(args))))
org_cherry_env_raise(env, org_cherry_string("cons only accept exactly two parameters"));
TAIL(args) = HEAD(TAIL(args));
return args;
}
struct org_cherry_value*
org_cherry_core_list(struct org_cherry_environment* env, struct org_cherry_value* args)
{
return args;
}
struct org_cherry_value*
org_cherry_core_head(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
return HEAD(HEAD(args));
}
struct org_cherry_value*
org_cherry_core_tail(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
return TAIL(HEAD(args));
}
struct org_cherry_value*
org_cherry_core_length(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_LIST(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("no list is given for the first operand"));
struct org_cherry_value* lst = HEAD(args);
cy_fixnum_t length = 0;
while(!IS_NULL(lst)) {
length++;
lst = TAIL(lst);
}
return org_cherry_fixnum(length);
}
struct org_cherry_value*
org_cherry_core_string_to_list(struct org_cherry_environment* env, struct org_cherry_value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
org_cherry_env_raise(env, org_cherry_string("string->list accepts only one string as argument"));
const cy_byte_t* p = HEAD(args)->string_value;
struct org_cherry_value* lst = org_cherry_emptylist;
while(*p != '\0') {
cy_unicode_t ch = org_cherry_utf8_get(p);
lst = org_cherry_list_cons(org_cherry_char(ch), lst);
p = org_cherry_utf8_next(p);
}
return org_cherry_list_reverse(lst);
}
......@@ -99,6 +99,7 @@ org_cherry_environment(void)
proc_to_env(env, "tail", org_cherry_core_tail);
proc_to_env(env, "length", org_cherry_core_length);
proc_to_env(env, "tuple", org_cherry_core_tuple);
proc_to_env(env, "string->list", org_cherry_core_string_to_list);
proc_to_env(env, "exit", org_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