Add string->list to runtime environment.

include/cherry/primitives.h

@@ -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);

source/primitives/core.c

@@ -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);
+}

source/runtime.c

@@ -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;