Add more basic functions to runtime environment

Add tuple, nth, string->fixnum and string->tuple

bootstrap/bootstrap.h

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

bootstrap/primitives.c

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

bootstrap/runtime.c

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