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

finish first exception prototype based on setjmp.h

parent 88bed142
......@@ -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);
......@@ -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;
......
......@@ -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)
......
......@@ -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))
......
/*
* 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);
}
......@@ -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;
}
......@@ -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;
......
......@@ -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;
......
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