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

Start extending runtime system for exceptions

parent 44e82a1d
/*
* 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"
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_exit(struct org_cherry_environment* env, struct org_cherry_value* args);
......@@ -56,7 +56,7 @@ struct org_cherry_value {
const cy_byte_t* symbol_value;
struct org_cherry_value* (*fun_value)(struct org_cherry_value*);
cy_primitive_t fun_value;
};
};
......@@ -101,18 +101,20 @@ struct org_cherry_pair {
#define TAIL(pair) ((struct org_cherry_pair*) pair)->tail
struct org_cherry_value* org_cherry_list_cons(struct org_cherry_value* head, struct org_cherry_value* tail);
struct org_cherry_value* org_cherry_list(struct org_cherry_value* val, ...);
struct org_cherry_value* org_cherry_list_reverse(struct org_cherry_value* value);
struct org_cherry_procedure {
struct org_cherry_meta meta;
struct org_cherry_value* param;
struct org_cherry_value* body;
struct org_cherry_symbollist* env;
struct org_cherry_environment* env;
};
#define TO_PROC(obj) ((struct org_cherry_procedure*) obj)
struct org_cherry_value* org_cherry_procedure(struct org_cherry_symbollist* env,
struct org_cherry_value* org_cherry_procedure(struct org_cherry_environment* env,
struct org_cherry_value* param,
struct org_cherry_value* body);
......@@ -125,10 +127,18 @@ struct org_cherry_symbollist;
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);
struct org_cherry_symbollist* org_cherry_env_push(struct org_cherry_symbollist* env);
struct org_cherry_symbollist* org_cherry_env_pop(struct org_cherry_symbollist* env);
struct org_cherry_value* org_cherry_env_lookup(struct org_cherry_symbollist* env, struct org_cherry_value* symbol);
int org_cherry_env_add(struct org_cherry_symbollist* env, struct org_cherry_value* symbol, struct org_cherry_value* value);
struct org_cherry_environment {
struct org_cherry_value* exception_stack;
struct org_cherry_symbollist* mapping;
};
struct org_cherry_environment* org_cherry_env_push(struct org_cherry_environment* env);
struct org_cherry_environment* org_cherry_env_pop(struct org_cherry_environment* env);
struct org_cherry_value* org_cherry_env_lookup(struct org_cherry_environment* env, struct org_cherry_value* symbol);
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_environment(void);
extern struct org_cherry_symbollist* org_cherry_global_symbollist;
......@@ -140,6 +150,9 @@ extern struct org_cherry_value* org_cherry_symbol_define;
extern struct org_cherry_value* org_cherry_symbol_lambda;
extern struct org_cherry_value* org_cherry_symbol_if;
extern struct org_cherry_value* org_cherry_symbol_begin;
extern struct org_cherry_value* org_cherry_symbol_catch;
extern struct org_cherry_value* org_cherry_symbol_finally;
// ----------------------------------------------------------------------------
......@@ -171,13 +184,22 @@ extern struct org_cherry_value* org_cherry_symbol_if;
#define IS_LAMBDA(value) \
IS_TAGGED(value, org_cherry_symbol_lambda)
#define IS_BEGIN(value) \
IS_TAGGED(value, org_cherry_symbol_begin)
#define IS_CATCH(value) \
IS_TAGGED(value, org_cherry_symbol_catch)
#define IS_FINALLY(value) \
IS_TAGGED(value, org_cherry_symbol_finally)
#define IS_APPLICATION(value) \
IS_PAIR(value)
#define TEXT_OF_QUOTATION(value) \
HEAD(TAIL(value))
struct org_cherry_value* org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* exp);
struct org_cherry_value* org_cherry_eval(struct org_cherry_environment* env, struct org_cherry_value* exp);
......
......@@ -19,6 +19,9 @@
#include <stdint.h>
struct org_cherry_environment;
struct org_cherry_value;
#define TRUE 1
#define FALSE 0
......@@ -37,3 +40,4 @@ typedef uint32_t cy_unicode_t;
typedef uint32_t cy_flags_t;
typedef struct org_cherry_value* (*cy_primitive_t)(struct org_cherry_environment* env, struct org_cherry_value* args);
......@@ -4,7 +4,8 @@ set(CORE_SOURCES
eval.c
value.c
unicode.c
tables.c)
tables.c
primitives/print.c)
set(INTERPRETER_SOURCES
cherry.c)
......
......@@ -46,7 +46,7 @@ org_cherry_process_file(const char* filename, const cy_byte_t* method, struct or
exit(EXIT_FAILURE);
}
struct org_cherry_symbollist* env = org_cherry_symbollist();
struct org_cherry_environment* env = org_cherry_environment();
struct org_cherry_context* context = org_cherry_context(src, src, CY_SUPRESS_COMMENTS);
struct org_cherry_value* exp = org_cherry_read(context);
......@@ -71,7 +71,7 @@ org_cherry_start_repl(void)
{
printf("Cherry Interpreter 0.1\n\n");
struct org_cherry_symbollist* env = org_cherry_symbollist();
struct org_cherry_environment* env = org_cherry_environment();
while(1) {
cy_byte_t* line = (cy_byte_t*) readline("> ");
......@@ -114,7 +114,6 @@ main(int argc, char** argv)
break;
case 'M':
method = optarg;
printf("%s\n", optarg);
break;
case '?':
print_usage(stderr, argv[0]);
......
......@@ -20,7 +20,7 @@
#include <stdlib.h>
static struct org_cherry_value*
org_cherry_eval_define(struct org_cherry_symbollist* env, struct org_cherry_value* exp)
org_cherry_eval_define(struct org_cherry_environment* env, struct org_cherry_value* exp)
{
struct org_cherry_value* symbol;
struct org_cherry_value* value;
......@@ -43,7 +43,7 @@ org_cherry_eval_define(struct org_cherry_symbollist* env, struct org_cherry_valu
static struct org_cherry_value*
org_cherry_eval_values(struct org_cherry_symbollist* env, struct org_cherry_value* values)
org_cherry_eval_values(struct org_cherry_environment* env, struct org_cherry_value* values)
{
struct org_cherry_value* list = org_cherry_emptylist;
struct org_cherry_value* val;
......@@ -60,7 +60,7 @@ org_cherry_eval_values(struct org_cherry_symbollist* env, struct org_cherry_valu
static struct org_cherry_value*
org_cherry_eval_sequence(struct org_cherry_symbollist* env, struct org_cherry_value* body)
org_cherry_eval_sequence(struct org_cherry_environment* env, struct org_cherry_value* body)
{
struct org_cherry_value* val = org_cherry_false;
......@@ -73,12 +73,12 @@ org_cherry_eval_sequence(struct org_cherry_symbollist* env, struct org_cherry_va
}
static struct org_cherry_value*
org_cherry_apply(struct org_cherry_value* operator, struct org_cherry_value* operands)
org_cherry_apply(struct org_cherry_environment* env, struct org_cherry_value* operator, struct org_cherry_value* operands)
{
if(IS_PRIMITIVE(operator))
return operator->fun_value(operands);
return (operator->fun_value)(env, operands);
else if(IS_PROCEDURE(operator)) {
struct org_cherry_symbollist* env = TO_PROC(operator)->env;
struct org_cherry_environment* env = TO_PROC(operator)->env;
org_cherry_env_push(env);
......@@ -103,7 +103,7 @@ org_cherry_apply(struct org_cherry_value* operator, struct org_cherry_value* ope
static struct org_cherry_value*
org_cherry_eval_if(struct org_cherry_symbollist* env, struct org_cherry_value* value)
org_cherry_eval_if(struct org_cherry_environment* env, struct org_cherry_value* value)
{
if(IS_NULL(value))
return org_cherry_false;
......@@ -116,26 +116,39 @@ org_cherry_eval_if(struct org_cherry_symbollist* env, struct org_cherry_value* v
return org_cherry_false;
}
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*
org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* value)
org_cherry_eval(struct org_cherry_environment* env, struct org_cherry_value* value)
{
if(IS_SELF_EVALUATING(value))
return value;
else if(IS_VARIABLE(value)) {
if(org_cherry_env_lookup(env, value))
return org_cherry_true;
else
return org_cherry_false;
struct org_cherry_value* v = org_cherry_env_lookup(env, value);
if(!v) {
fprintf(stderr, "ERROR value %s is not defined\n", value->symbol_value);
exit(EXIT_FAILURE);
}
return v;
} else if(IS_QUOTE(value))
return TEXT_OF_QUOTATION(value);
else if(IS_DEFINE(value))
return org_cherry_eval_define(env, value);
else if(IS_BEGIN(value))
return org_cherry_eval_begin(env, value);
else if(IS_LAMBDA(value))
return org_cherry_procedure(env, HEAD(TAIL(value)), TAIL(TAIL(value)));
else if(IS_IF(value))
return org_cherry_eval_if(env, TAIL(value));
else if(IS_APPLICATION(value))
return org_cherry_apply(org_cherry_eval(env, HEAD(value)), org_cherry_eval_values(env, TAIL(value)));
return org_cherry_apply(env, org_cherry_eval(env, HEAD(value)), org_cherry_eval_values(env, TAIL(value)));
fprintf(stderr, "can not eval unknown expression\n");
exit(1);
......
/*
* 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 <setjmp.h>
struct org_cherry_exception {
jmp_buf jump;
cy_const_pointer_t data;
};
/*
* 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 <stdio.h>
struct org_cherry_value*
org_cherry_primitive_println(struct org_cherry_environment* env, struct org_cherry_value* args)
{
while(!IS_NULL(args)) {
struct org_cherry_value* v = HEAD(args);
switch(v->meta.type) {
case CY_BOOLEAN:
if(IS_TRUE(v))
printf("true");
else
printf("false");
break;
case CY_STRING:
printf("%s", v->string_value);
break;
case CY_SYMBOL:
printf("%s", v->symbol_value);
break;
case CY_FIXNUM:
printf("%ld", v->fixnum_value);
break;
case CY_FLOAT:
printf("%lf", v->float_value);
break;
default:
break;
}
args = TAIL(args);
}
printf("\n");
return org_cherry_true;
}
/*
* 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 <stdlib.h>
struct org_cherry_value*
org_cherry_exit(struct org_cherry_environment* env, struct org_cherry_value* args)
{
return org_cherry_false;
}
......@@ -688,47 +688,153 @@ org_cherry_read_pair(struct org_cherry_context* context)
return (struct org_cherry_value*) org_cherry_list_cons(head, tail);
}
enum BeginState {
CODE, EXCEPTION_VAR, EXCEPTION, FINALLY
};
static struct org_cherry_value*
org_cherry_transform_begin(struct org_cherry_value* value)
{
struct org_cherry_value* code =
org_cherry_list_cons(org_cherry_emptylist,
org_cherry_list_cons(org_cherry_symbol_lambda, org_cherry_emptylist));
struct org_cherry_value* handler = org_cherry_emptylist;
struct org_cherry_value* finally = org_cherry_emptylist;
struct org_cherry_value* tmp = org_cherry_emptylist;
enum BeginState state = CODE;
while(!IS_NULL(value)) {
switch(state) {
case CODE:
if(IS_CATCH(HEAD(value))) {
state = EXCEPTION_VAR;
handler = org_cherry_list_cons(org_cherry_symbol_lambda, org_cherry_emptylist);
tmp = TAIL(HEAD(value));
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;
tmp = TAIL(tmp);
continue;
} else {
handler = org_cherry_list_cons(org_cherry_list(org_cherry_symbol("e"), org_cherry_emptylist), handler);
state = EXCEPTION;
continue;
}
case EXCEPTION:
while(!IS_NULL(tmp)) {
handler = org_cherry_list_cons(HEAD(tmp), handler);
tmp = TAIL(tmp);
}
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;
}
break;
case FINALLY:
while(!IS_NULL(tmp)) {
finally = org_cherry_list_cons(HEAD(tmp), finally);
tmp = TAIL(tmp);
}
break;
}
value = TAIL(value);
}
return org_cherry_list(
org_cherry_symbol_begin,
org_cherry_list_reverse(code),
org_cherry_list_reverse(handler),
org_cherry_list_reverse(finally));
}
static struct org_cherry_value*
org_cherry_transform(struct org_cherry_value* value)
{
if(IS_BEGIN(value))
return org_cherry_transform_begin(TAIL(value));
else
return value;
}
struct org_cherry_value*
org_cherry_read(struct org_cherry_context* context)
{
assert(context != 0);
struct org_cherry_value* value = org_cherry_false;
enum org_cherry_tok tok = org_cherry_lex(context);
while(tok != TOK_EOF) {
switch(tok) {
case TOK_TRUE:
return org_cherry_true;
case TOK_FALSE:
return org_cherry_false;
case TOK_TRUE:
return org_cherry_true;
case TOK_HEX:
return org_cherry_fixnum_from_string(org_cherry_token_string(context), 16);
case TOK_DEC:
return org_cherry_fixnum_from_string(org_cherry_token_string(context), 10);
case TOK_OCT:
return org_cherry_fixnum_from_string(org_cherry_token_string(context), 8);
case TOK_BIN:
return org_cherry_fixnum_from_string(org_cherry_token_string(context), 2);
case TOK_FLOAT:
return org_cherry_float_from_string(org_cherry_token_string(context));
case TOK_STRING:
return org_cherry_string_from_string(org_cherry_token_string(context));
case TOK_CHAR:
return org_cherry_char_from_string(org_cherry_token_string(context));
case TOK_SYMBOL:
return org_cherry_symbol_from_string(org_cherry_token_string(context));
case TOK_ROUNDLEFTBRACE:
return org_cherry_read_pair(context);
value = org_cherry_read_pair(context);
goto RETURN_VALUE;
case TOK_QUOTE:
return TO_VALUE(org_cherry_list_cons(org_cherry_symbol_quote,
TO_VALUE(org_cherry_list_cons(org_cherry_read(context), org_cherry_emptylist))));
return org_cherry_list_cons(org_cherry_symbol_quote, org_cherry_list_cons(org_cherry_read(context), org_cherry_emptylist));
default:
org_cherry_error(context, "bad input with token %s",
org_cherry_tok_to_string(tok));
return org_cherry_false;
goto RETURN_VALUE;
}
}
return 0;
RETURN_VALUE:
return org_cherry_transform(value);
}
......@@ -306,29 +306,35 @@ org_cherry_symbollist_get(struct org_cherry_symbollist* tree, const cy_byte_t* n
}
struct org_cherry_symbollist*
org_cherry_env_push(struct org_cherry_symbollist* env)
struct org_cherry_environment*
org_cherry_env_push(struct org_cherry_environment* env)
{
assert(env != 0);
struct org_cherry_symbollist* frame = org_cherry_symbollist();
frame->parent = env;
return frame;
frame->parent = env->mapping;
env->mapping = frame;
return env;
}
struct org_cherry_symbollist*
org_cherry_env_pop(struct org_cherry_symbollist* env)
struct org_cherry_environment*
org_cherry_env_pop(struct org_cherry_environment* env)
{
assert(env != 0);
struct org_cherry_symbollist* frame = env->parent;
env->parent = 0;
return frame;
struct org_cherry_symbollist* frame = env->mapping->parent;
env->mapping->parent = 0;
env->mapping = frame;
return env;
}
struct org_cherry_value*
org_cherry_env_lookup(struct org_cherry_symbollist* env, struct org_cherry_value* symbol)
org_cherry_env_lookup(struct org_cherry_environment* env, struct org_cherry_value* symbol)
{
struct org_cherry_symbollist* mapping = env->mapping;
while(env != 0) {
struct RbNode* node = env->root;
struct RbNode* node = mapping->root;
while(node != 0) {
if(symbol < node->symbol)
......@@ -339,7 +345,7 @@ org_cherry_env_lookup(struct org_cherry_symbollist* env, struct org_cherry_value
return node->value;
}
env = env->parent;
mapping = mapping->parent;
}
return 0;
......@@ -347,17 +353,19 @@ org_cherry_env_lookup(struct org_cherry_symbollist* env, struct org_cherry_value
int
org_cherry_env_add(struct org_cherry_symbollist* env, struct org_cherry_value* symbol, struct org_cherry_value* value)
org_cherry_env_add(struct org_cherry_environment* env, struct org_cherry_value* symbol, struct org_cherry_value* value)
{
assert(env != 0);
assert(symbol != 0);
if(env->root == 0) {
env->root = rbnode(BLACK, 0, symbol, value);
struct org_cherry_symbollist* mapping = env->mapping;
if(mapping->root == 0) {
mapping->root = rbnode(BLACK, 0, symbol, value);
return TRUE;
}
struct RbNode* node = env->root;
struct RbNode* node = mapping->root;
struct RbNode* current_node = 0;
while(current_node == 0) {
......@@ -375,7 +383,7 @@ org_cherry_env_add(struct org_cherry_symbollist* env, struct org_cherry_value* s
return FALSE;
}
rbnode_remedy_double_red(env, current_node);
rbnode_remedy_double_red(mapping, current_node);
return TRUE;
}
......
......@@ -16,7 +16,8 @@
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include "cherry/runtime.h"