Add several core operators

add not, and, or operators
add greater, less, greater_equal, less_equal, equal

bootstrap/bootstrap.h

@@ -211,6 +211,15 @@ struct cherry_value*    cherry_core_sub(struct cherry_environment* env, struct c
 struct cherry_value*    cherry_core_mul(struct cherry_environment* env, struct cherry_value* args);
 struct cherry_value*    cherry_core_div(struct cherry_environment* env, struct cherry_value* args);
 
+struct cherry_value*    cherry_core_not(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_and(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_or(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_greater(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_less(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_greater_equal(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_less_equal(struct cherry_environment* env, struct cherry_value* args);
+struct cherry_value*    cherry_core_equal(struct cherry_environment* env, struct cherry_value* args);
+
 // org.cherry.io
 struct cherry_value*    cherry_io_println(struct cherry_environment* env, struct cherry_value* args);
 

bootstrap/primitives.c

@@ -325,6 +325,305 @@ cherry_core_string_to_list(struct cherry_environment* env, struct cherry_value*
 	return cherry_list_reverse(lst);
 }
 
+
+struct cherry_value*    
+cherry_core_not(struct cherry_environment* env, struct cherry_value* args)
+{
+    if(IS_NULL(args) || !IS_BOOLEAN(HEAD(args)))
+        cherry_env_raise(env, cherry_string("not operator expects one boolean operand"));
+
+    return IS_TRUE(HEAD(args)) ? cherry_false : cherry_true;
+}
+
+struct cherry_value*    
+cherry_core_and(struct cherry_environment* env, struct cherry_value* args)
+{
+	struct cherry_value* result = cherry_true;
+
+	while(!IS_NULL(args)) {
+		if(IS_FALSE(HEAD(args)))
+			return cherry_false;
+		args = TAIL(args);		
+	}
+
+	return result;
+}
+
+struct cherry_value*    
+cherry_core_or(struct cherry_environment* env, struct cherry_value* args)
+{
+	struct cherry_value* result = cherry_false;
+
+	while(!IS_NULL(args)) {
+		if(IS_TRUE(HEAD(args)))
+			return cherry_true;
+		args = TAIL(args);
+	}
+
+	return result;
+}
+
+struct cherry_value*    
+cherry_core_greater(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args))
+		return cherry_true;
+
+	struct cherry_value* val = HEAD(args);
+	args = TAIL(args);
+
+	if(IS_FIXNUM(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value >= val->fixnum_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value >= (val->fixnum_value))
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else if(IS_FLOAT(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value >= val->float_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value >= val->float_value)
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else
+		cherry_env_raise(env, cherry_string("> operator expects a number"));
+
+	return cherry_true;
+}
+
+struct cherry_value*    
+cherry_core_less(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args))
+		return cherry_true;
+
+	struct cherry_value* val = HEAD(args);
+	args = TAIL(args);
+
+	if(IS_FIXNUM(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value <= val->fixnum_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value <= (val->fixnum_value))
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else if(IS_FLOAT(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value <= val->float_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value <= val->float_value)
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else
+		cherry_env_raise(env, cherry_string("> operator expects a number"));
+
+	return cherry_true;
+}
+
+	
+struct cherry_value*    
+cherry_core_greater_equal(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args))
+		return cherry_true;
+
+	struct cherry_value* val = HEAD(args);
+	args = TAIL(args);
+
+	if(IS_FIXNUM(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value < val->fixnum_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value < (val->fixnum_value))
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else if(IS_FLOAT(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value < val->float_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value < val->float_value)
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else
+		cherry_env_raise(env, cherry_string("> operator expects a number"));
+
+	return cherry_true;
+}
+
+
+struct cherry_value*    
+cherry_core_less_equal(struct cherry_environment* env, struct cherry_value* args)
+{
+
+	if(IS_NULL(args))
+		return cherry_true;
+
+	struct cherry_value* val = HEAD(args);
+	args = TAIL(args);
+
+	if(IS_FIXNUM(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value > val->fixnum_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value > (val->fixnum_value))
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else if(IS_FLOAT(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value > val->float_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value > val->float_value)
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else
+		cherry_env_raise(env, cherry_string("> operator expects a number"));
+
+	return cherry_true;
+}
+
+struct cherry_value*    
+cherry_core_equal(struct cherry_environment* env, struct cherry_value* args)
+{
+	if(IS_NULL(args))
+		return cherry_true;
+
+	struct cherry_value* val = HEAD(args);
+	args = TAIL(args);
+
+	if(IS_FIXNUM(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value != val->fixnum_value)
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value != ((float_t) val->fixnum_value))
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else if(IS_FLOAT(val)) {
+		while(!IS_NULL(args)) {
+			struct cherry_value* next = HEAD(args);
+			switch(next->tag) {
+				case FIXNUM:
+					if(next->fixnum_value != ((float_t) val->float_value))
+						return cherry_false;
+					break;
+				case FLOAT:
+					if(next->float_value != val->float_value)
+						return cherry_false;
+					break;
+
+				default:
+					cherry_env_raise(env, cherry_string("> operator expects a number"));
+			}
+			args = TAIL(args);
+		}
+	} else
+		cherry_env_raise(env, cherry_string("> operator expects a number"));
+
+	return cherry_true;
+}
+
+
+
+
 struct cherry_value*
 cherry_io_println(struct cherry_environment* env, struct cherry_value* args)
 {

bootstrap/runtime.c

@@ -92,6 +92,15 @@ cherry_environment(void)
 	proc_to_env(env, "-", cherry_core_sub);
 	proc_to_env(env, "*", cherry_core_mul);
 	proc_to_env(env, "/", cherry_core_div);
+	proc_to_env(env, ">", cherry_core_greater);
+	proc_to_env(env, "<", cherry_core_less);
+	proc_to_env(env, ">=", cherry_core_greater_equal);
+	proc_to_env(env, "=<", cherry_core_less_equal);
+	proc_to_env(env, "=", cherry_core_equal);
+	proc_to_env(env, "not", cherry_core_not);
+	proc_to_env(env, "and", cherry_core_and);
+	proc_to_env(env, "or", cherry_core_or);
+	
 	proc_to_env(env, "cons", cherry_core_cons);
 	proc_to_env(env, "list", cherry_core_list);
 	proc_to_env(env, "head", cherry_core_head);

include/cherry.h

-/*
- * Cherry programming language
- * Copyright (C) 2013 Christoph Mueller
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-#pragma once
-
-#include "cherry/read.h"
-#include "cherry/runtime.h"
-
-

include/cherry/array.h

-/*
- * Cherry programming language
- * Copyright (C) 2013 Christoph Mueller
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-#pragma once
-
-/**
- * @file structures/array.h 
- * A dynmical, resized array implementation that hides all memory allocation for a user
- */
-
-#include "cherry/standard.h"
-#include <stdlib.h>
-
-struct org_cherry_array;
-struct org_cherry_ptrarray;
-
-/**
- * Creates an org_cherry_array instance with a given initialization- and extension size
- * \param initialsize Sets the initial memory allocation for the internal buffer. Its size is always a multiple factor of the extensionsize 
- *     and fits the given initialsize for the first initialization.
- * \param extend Sets the size of memory blocks the array is dynamically extend.
- * \return the reference cy_pointer_t to the constructed array, used by other array calls.
- */
-struct org_cherry_array*        org_cherry_array_new(size_t init_capacity);
-
-/**
- * Release all allocated memory for a created Array.
- * \param array using array that should be freed
- */
-
-size_t                  org_cherry_array_size(struct org_cherry_array* array);
-size_t                  org_cherry_array_capacity(struct org_cherry_array* array);
-
-
-size_t                  org_cherry_array_ensure(struct org_cherry_array* array, size_t min_capacity);
-size_t                  org_cherry_array_trim(struct org_cherry_array* array);
-
-void                    org_cherry_array_append(struct org_cherry_array* array, cy_const_pointer_t data, size_t size);
-int                     org_cherry_array_insert(struct org_cherry_array* array, size_t index, cy_const_pointer_t data, size_t size);
-int                     org_cherry_array_remove(struct org_cherry_array* array, size_t index, size_t size);
-int		                org_cherry_array_replace(struct org_cherry_array* array, size_t index, cy_const_pointer_t data, size_t size);
-void			        org_cherry_array_clear(struct org_cherry_array* array);
-
-cy_pointer_t                 org_cherry_array_clone(struct org_cherry_array* array);
-cy_pointer_t                 org_cherry_array_get(struct org_cherry_array* array, size_t index);
-
-
-
-struct org_cherry_ptrarray*     org_cherry_ptrarray_new(size_t init_capacity);
-
-size_t                  org_cherry_ptrarray_size(struct org_cherry_ptrarray* array);
-size_t                  org_cherry_ptrarray_capacity(struct org_cherry_ptrarray* array);
-
-size_t                  org_cherry_ptrarray_ensure(struct org_cherry_ptrarray* array, size_t min_capacity);
-size_t                  org_cherry_ptrarray_trim(struct org_cherry_ptrarray* array);
-
-
-void                    org_cherry_ptrarray_append(struct org_cherry_ptrarray* array, cy_pointer_t ptr);
-int                     org_cherry_ptrarray_insert(struct org_cherry_ptrarray* array, size_t index, cy_pointer_t ptr);
-cy_pointer_t                 org_cherry_ptrarray_remove(struct org_cherry_ptrarray* array, size_t index);
-cy_pointer_t			        org_cherry_ptrarray_replace(struct org_cherry_ptrarray* array, size_t index, cy_pointer_t ptr);
-void			        org_cherry_ptrarray_clear(struct org_cherry_ptrarray* array);
-
-cy_pointer_t                 org_cherry_ptrarray_get(struct org_cherry_ptrarray* array, size_t index);
-
-
-

include/cherry/primitives.h

-/*
- * Cherry programming language
- * Copyright (C) 2013 Christoph Mueller
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-#pragma once
-
-#include "cherry/runtime.h"
-
-// org.cherry.core
-struct cherry_value*    cherry_core_type(struct cherry_environment* env, struct cherry_value* args);
-struct cherry_value*    cherry_core_raise(struct cherry_environment* env, struct cherry_value* args);
-
-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_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_string_to_list(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*    cherry_core_add(struct cherry_environment* env, struct cherry_value* args);
-struct cherry_value*    cherry_core_sub(struct cherry_environment* env, struct cherry_value* args);
-struct cherry_value*    cherry_core_mul(struct cherry_environment* env, struct cherry_value* args);
-struct cherry_value*    cherry_core_div(struct cherry_environment* env, struct cherry_value* args);
-
-// org.cherry.io
-struct cherry_value*    cherry_io_println(struct cherry_environment* env, struct cherry_value* args);
-
-// org.cherry.system
-struct cherry_value*    cherry_system_exit(struct cherry_environment* env, struct cherry_value* args);
-

include/cherry/read.h

-/*
- * Cherry programming language
- * Copyright (C) 2013 Christoph Mueller
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#pragma once
-
-#include "cherry/runtime.h"
-#include <stdlib.h>
-#include <stdint.h>
-
-struct org_cherry_array;
-
-#define CY_DEFAULT 0
-#define CY_SUPRESS_COMMENTS 1
-
-struct org_cherry_context {
-  const char* filename;
-  const cy_byte_t* begin;  
-  const cy_byte_t* src;
-  uint32_t line;
-  struct org_cherry_array* buffer;
-  cy_flags_t flags;
-};
-
-
-struct org_cherry_context*   org_cherry_context(const cy_byte_t* source, const char* filename, cy_flags_t flags);
-struct org_cherry_context*   org_cherry_context_repl(const cy_byte_t* source);
-void                         org_cherry_context_repl_set_source(struct org_cherry_context* c, const cy_byte_t* source);
-
-void                         org_cherry_error(struct org_cherry_context* context, const char* format, ...);
-
-enum org_cherry_tok {
-  TOK_EOF,
-  TOK_ROUNDLEFTBRACE,
-  TOK_ROUNDRIGHTBRACE,
-  TOK_SQUARELEFTBRACE,
-  TOK_SQUARERIGHTBRACE,
-  TOK_COMMENT,
-  TOK_DOT,
-  TOK_STRING,
-  TOK_CHAR,
-  TOK_HEX,
-  TOK_DEC,
-  TOK_OCT,
-  TOK_BIN,
-  TOK_FLOAT,
-  TOK_SYMBOL,
-  TOK_TRUE,
-  TOK_FALSE,
-  TOK_QUOTE
-};
-
-
-const cy_byte_t*       		org_cherry_tok_to_string(enum org_cherry_tok token);
-
-enum org_cherry_tok     	org_cherry_lex(struct org_cherry_context* context);
-const cy_byte_t*            org_cherry_pos(struct org_cherry_context* context);
-void                        org_cherry_rewind(struct org_cherry_context* context, const cy_byte_t* pos);
-
-const cy_byte_t*       		org_cherry_token_string(struct org_cherry_context* context);
-size_t              		org_cherry_token_length(struct org_cherry_context* context);
-
-struct org_cherry_value*    org_cherry_read(struct org_cherry_context* context);

include/cherry/runtime.h

-/*
- * Cherry programming language
- * Copyright (C) 2013 Christoph Mueller
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#pragma once
-
-#include "cherry/standard.h"
-#include <stdio.h>
-#include <string.h>
-#include <setjmp.h>
-
-enum org_cherry_value_type {
-    CY_EMPTYLIST,
-	CY_BOOLEAN,
-    CY_DOT,
-	CY_FIXNUM,
-	CY_FLOAT,
-	CY_STRING, 
-	CY_CHAR,
-    CY_PAIR,
-    CY_TUPLE,
-    CY_SYMBOL,
-	CY_PRIMITIVE,
-	CY_PROCEDURE
-};
-
-
-struct org_cherry_meta {
-  enum org_cherry_value_type type;
-};
-
-
-struct org_cherry_value {
-    struct org_cherry_meta meta;
-