finish first exception prototype based on setjmp.h

include/cherry/primitives.h

@@ -21,5 +21,7 @@
 
 struct org_cherry_value*    org_cherry_primitive_println(struct org_cherry_environment* env, struct org_cherry_value* args);
 
+struct org_cherry_value*    org_cherry_primitive_raise(struct org_cherry_environment* env, struct org_cherry_value* args);
+
 struct org_cherry_value*    org_cherry_primitive_exit(struct org_cherry_environment* env, struct org_cherry_value* args);
 

include/cherry/runtime.h

@@ -21,6 +21,7 @@
 #include "cherry/standard.h"
 #include <stdio.h>
 #include <string.h>
+#include <setjmp.h>
 
 enum org_cherry_value_type {
     CY_EMPTYLIST,
@@ -119,16 +120,27 @@ struct org_cherry_value*	org_cherry_procedure(struct org_cherry_environment* env
 												 struct org_cherry_value* body);
 
 // ----------------------------------------------------------------------------
-// Symboltables
+// Symboltables and Environment
 // ----------------------------------------------------------------------------
 
 struct org_cherry_symbollist;
+struct org_cherry_exception;
 
 struct org_cherry_symbollist*	org_cherry_symbollist(void);
 struct org_cherry_value*		org_cherry_symbollist_get(struct org_cherry_symbollist* table, const cy_byte_t* name);
 
+#define EXCEPTION_JUMP(env) env->exception_stack->jump
+#define EXCEPTION_DATA(env) env->exception_stack->data
+
+struct org_cherry_exception {
+	jmp_buf jump;
+	struct org_cherry_value* data;
+	struct org_cherry_exception* next;
+};
+
+
 struct org_cherry_environment {
-  struct org_cherry_value* exception_stack;
+  struct org_cherry_exception* exception_stack;
   struct org_cherry_symbollist* mapping;
 };
 
@@ -138,6 +150,12 @@ struct org_cherry_value*        org_cherry_env_lookup(struct org_cherry_environm
 int                             org_cherry_env_add(struct org_cherry_environment* env, struct org_cherry_value* symbol, struct org_cherry_value* value);
 
 
+struct org_cherry_environment* 	org_cherry_env_push_exception_point(struct org_cherry_environment* env);
+struct org_cherry_environment* 	org_cherry_env_pop_exception_point(struct org_cherry_environment* env);
+void							org_cherry_env_raise_exception(struct org_cherry_environment* env, struct org_cherry_value* e);
+
+
+
 struct org_cherry_environment*  org_cherry_environment(void);
 
 extern struct org_cherry_symbollist*    org_cherry_global_symbollist;

source/CMakeLists.txt

@@ -5,7 +5,9 @@ set(CORE_SOURCES
   value.c
   unicode.c
   tables.c
-  primitives/print.c)
+  exception.c
+  primitives/print.c
+  primitives/system.c)
 
 set(INTERPRETER_SOURCES
   cherry.c)

source/eval.c

@@ -120,7 +120,25 @@ org_cherry_eval_if(struct org_cherry_environment* env, struct org_cherry_value*
 struct org_cherry_value*
 org_cherry_eval_begin(struct org_cherry_environment* env, struct org_cherry_value* value)
 {
-	return org_cherry_false;
+    struct org_cherry_value* return_val = org_cherry_false;
+
+    org_cherry_env_push_exception_point(env);
+
+    int val = setjmp(EXCEPTION_JUMP(env));
+
+	if(val == 0){  
+        return_val = org_cherry_apply(env, org_cherry_eval(env, HEAD(value)), org_cherry_emptylist);
+	} else if(!IS_NULL(HEAD(TAIL(value))) && val) {
+        return_val = org_cherry_apply(env, org_cherry_eval(env, HEAD(TAIL(value))), EXCEPTION_DATA(env));
+	}
+
+    if(!IS_NULL(HEAD(TAIL(TAIL(value)))))
+        org_cherry_apply(env, org_cherry_eval(env, HEAD(TAIL(TAIL(value)))), org_cherry_emptylist);
+
+    org_cherry_env_pop_exception_point(env);
+
+
+	return return_val;
 }
 
 struct org_cherry_value*
@@ -142,7 +160,7 @@ org_cherry_eval(struct org_cherry_environment* env, struct org_cherry_value* val
     else if(IS_DEFINE(value))
         return org_cherry_eval_define(env, value);
 	else if(IS_BEGIN(value))
-		return org_cherry_eval_begin(env, value);
+		return org_cherry_eval_begin(env, TAIL(value));
 	else if(IS_LAMBDA(value))
 		return org_cherry_procedure(env, HEAD(TAIL(value)), TAIL(TAIL(value)));
 	else if(IS_IF(value))

source/exception.c

+/*
+ * 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/>.
+*/
+
+#include "cherry/runtime.h"
+#include <gc.h>
+
+
+static struct org_cherry_exception*
+org_cherry_exception(void) 
+{
+	struct org_cherry_exception* e = GC_MALLOC(sizeof(struct org_cherry_exception));
+	e->data = org_cherry_emptylist;
+	e->next = 0;
+	return e;
+}
+
+
+struct org_cherry_environment*
+org_cherry_env_push_exception_point(struct org_cherry_environment* env) 
+{
+	struct org_cherry_exception* e = org_cherry_exception();
+	e->next = env->exception_stack;
+
+	env->exception_stack = e;
+
+	return env;
+}
+
+
+struct org_cherry_environment*
+org_cherry_env_pop_exception_point(struct org_cherry_environment* env)
+{
+	struct org_cherry_exception* e = env->exception_stack->next;
+	
+	env->exception_stack->next = 0;
+	env->exception_stack = e;
+
+	return env;
+}
+
+
+void
+org_cherry_env_raise_exception(struct org_cherry_environment* env, struct org_cherry_value* e)
+{
+	env->exception_stack->data = e;
+	longjmp(env->exception_stack->jump, 1);
+}
+

source/primitives/system.c

@@ -20,9 +20,18 @@
 #include <stdlib.h>
 
 struct org_cherry_value*
-org_cherry_exit(struct org_cherry_environment* env, struct org_cherry_value* args)
+org_cherry_primitive_exit(struct org_cherry_environment* env, struct org_cherry_value* args)
 {
 	return org_cherry_false;
 }
 
+struct org_cherry_value*
+org_cherry_primitive_raise(struct org_cherry_environment* env, struct org_cherry_value* args)
+{
+	if(IS_NULL(args))
+		org_cherry_env_raise_exception(env, org_cherry_emptylist);
+	else
+		org_cherry_env_raise_exception(env, args);
 
+	return org_cherry_false;
+}

source/read.c

@@ -714,15 +714,19 @@ org_cherry_transform_begin(struct org_cherry_value* value)
 					handler = org_cherry_list_cons(org_cherry_symbol_lambda, org_cherry_emptylist);
 					tmp = TAIL(HEAD(value));
 					continue;
+				} else if(IS_FINALLY(HEAD(value))) {
+					state = FINALLY;
+					tmp = TAIL(HEAD(value));
+					finally =  
+						org_cherry_list_cons(org_cherry_emptylist, 
+							org_cherry_list_cons(org_cherry_symbol_lambda, org_cherry_emptylist));
+					continue;
+
 				} else
 					code = org_cherry_list_cons(HEAD(value), code);
 				break;
 
 			case EXCEPTION_VAR:
-				printf("::: ");
-				org_cherry_print(stdout, tmp);
-				printf("\n");
-
 				if(IS_PAIR(HEAD(tmp))) {
 					handler = org_cherry_list_cons(HEAD(tmp), handler);
 					state = EXCEPTION;

source/value.c

@@ -383,12 +383,16 @@ org_cherry_environment(void)
 	struct org_cherry_environment* env = GC_MALLOC(sizeof(struct org_cherry_environment));
 
 	env->mapping = org_cherry_symbollist();
-	env->exception_stack = org_cherry_emptylist;
+	env->exception_stack = 0; 
 
 	org_cherry_env_add(env, 
 			org_cherry_symbol("println"),
 			org_cherry_primitive(org_cherry_primitive_println));
 
+	org_cherry_env_add(env,
+			org_cherry_symbol("raise"),
+			org_cherry_primitive(org_cherry_primitive_raise));
+
 	return env;
 }
 
@@ -510,6 +514,9 @@ org_cherry_print(FILE* out, struct org_cherry_value* value)
 			}
 			fprintf(out, "\"");
 			break;
+		case CY_PRIMITIVE:
+			fprintf(out, "#primitive-procedure");
+			break;
         case CY_PROCEDURE:
             fprintf(out, "#lambda-procedure");
             break;