From e266667607900396c3f1535ac3fe278e2654fbcb Mon Sep 17 00:00:00 2001 From: Felix Brendel Date: Wed, 17 Jul 2019 21:17:24 +0200 Subject: [PATCH] brefore implementing envi stack --- bin/pre.slime | 2 +- src/built_ins.cpp | 2 +- src/env.cpp | 12 ++++++++- src/eval.cpp | 61 +++++++++++++++++++------------------------ src/forward_decls.cpp | 15 ++++++----- src/io.cpp | 40 +++++++++++++++++++--------- src/memory.cpp | 9 ++++--- src/testing.cpp | 32 +++++++++++------------ 8 files changed, 98 insertions(+), 75 deletions(-) diff --git a/bin/pre.slime b/bin/pre.slime index d08d1d0..6955e08 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -21,7 +21,7 @@ condition is true. `(if ,condition (begin @body) nil))) (define-syntax (unless condition :rest body) - "Special form for when multiple actions should be done if a + "Special form for when multiple actions should be done if a condition is false." (if (= (rest body) ()) `(if ,condition nil @body) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 800681e..9ab4c6b 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -72,7 +72,7 @@ proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { // create new empty environment Environment* new_env; - try new_env = Memory::create_child_environment(Globals::root_environment); + try new_env = Memory::create_child_environment(get_root_environment()); append_to_array_list(env->parents, new_env); Environment* old_macro_env = Parser::environment_for_macros; diff --git a/src/env.cpp b/src/env.cpp index 08dd898..2bfbcca 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -48,6 +48,16 @@ proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { return nullptr; } +inline proc get_root_environment() -> Environment* { + using namespace Globals::Current_Execution; + return envi_stack->data[0]; +} + +inline proc get_current_environment() -> Environment* { + using namespace Globals::Current_Execution; + return envi_stack->data[envi_stack->next_index-1]; +} + proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { Lisp_Object* result = try_lookup_symbol(node, env); @@ -68,7 +78,7 @@ proc print_indent(int indent) -> void { } proc print_environment_indent(Environment* env, int indent) -> void { - if(env == Globals::root_environment) { + if(env == get_root_environment()) { print_indent(indent); printf("[built-ins]-Environment (%lld)\n", (long long)env); return; diff --git a/src/eval.cpp b/src/eval.cpp index bbd793a..feba798 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -216,7 +216,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { else { create_parsing_error("A non recognized marker was found " "in the lambda list: ':%s'", - &arguments->value.pair.first->value.symbol.identifier); + &arguments->value.pair.first->value.symbol.identifier->data); return; } } @@ -402,7 +402,16 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments } proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { - Globals::current_source_code = node; + using namespace Globals::Current_Execution; + append_to_array_list(call_stack, node); + defer { + // NOTE(Felix): We only delete the current entry from the call + // stack, if we did not encounter an error, otherwise we neet + // to preserve the callstack to print it later. it will be + // cleared in log_error(). + if (!Globals::error) + --call_stack->next_index; + }; switch (Memory::get_type(node)) { case Lisp_Object_Type::T: @@ -414,12 +423,11 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { case Lisp_Object_Type::CFunction: return node; case Lisp_Object_Type::Symbol: { - Lisp_Object* symbol; - try symbol = lookup_symbol(node, env); - return symbol; + Lisp_Object* value; + try value = lookup_symbol(node, env); + return value; } case Lisp_Object_Type::Pair: { - Lisp_Object* lispOperator; if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) @@ -482,7 +490,7 @@ proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { proc interprete_file (char* file_name) -> Lisp_Object* { Memory::init(4096 * 256, 1024, 4096 * 256); - Environment* root_env = Globals::root_environment; + Environment* root_env = get_root_environment(); Environment* user_env; try user_env = Memory::create_child_environment(root_env); Parser::environment_for_macros = user_env; @@ -494,14 +502,12 @@ proc interprete_file (char* file_name) -> Lisp_Object* { delete_error(); return nullptr; } - - // print(result); return result; } -proc interprete_stdin(bool is_emacs_repl = false) -> void { +proc interprete_stdin() -> void { Memory::init(4096 * 256, 1024, 4096 * 256); - Environment* root_env = Globals::root_environment; + Environment* root_env = get_root_environment(); Environment* user_env = Memory::create_child_environment(root_env); if (Globals::error) { log_error(); @@ -515,11 +521,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void { char* line; - if (Globals::error) { - log_error(); - delete_error(); - } - Lisp_Object* parsed, * evaluated; while (true) { printf("> "); @@ -534,24 +535,16 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void { continue; } evaluated = eval_expr(parsed, user_env); - if (is_emacs_repl) { - if (Globals::error) { - printf("((error \"%s\"))", &Globals::error->message->data); - } else { - printf("((result \""); - print(evaluated); - printf("\"))"); - } - } else { - if (Globals::error) { - log_error(); - delete_error(); - continue; - } - if (evaluated != Memory::nil) { - print(evaluated); - printf("\n"); - } + + if (Globals::error) { + log_error(); + delete_error(); + continue; } + if (evaluated != Memory::nil) { + print(evaluated); + printf("\n"); + } + } } diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index 8862ebb..20b5b1a 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -10,9 +10,12 @@ proc is_truthy (Lisp_Object*, Environment*) -> bool; proc list_length(Lisp_Object*) -> int; proc load_built_ins_into_environment(Environment*) -> void; proc parse_argument_list(Lisp_Object*, Function*) -> void; + + proc print_environment(Environment*) -> void; +inline proc get_root_environment() -> Environment*; +inline proc get_current_environment() -> Environment*; -// proc get_exe_dir() -> char*; proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; @@ -25,7 +28,6 @@ namespace Memory { inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type; } - namespace Parser { extern Environment* environment_for_macros; @@ -36,11 +38,12 @@ namespace Parser { } namespace Globals { - Environment* root_environment; // contains the built-ins Log_Level log_level = Log_Level::Debug; - // TODO(Felix): make this the callstack by using a arraylist - // instead - Lisp_Object* current_source_code = nullptr; + namespace Current_Execution { + Lisp_Object_Array_List* call_stack = create_Lisp_Object_array_list(); + Environment_Array_List* envi_stack = create_Environment_array_list(); + } + Error* error = nullptr; } diff --git a/src/io.cpp b/src/io.cpp index 4e70940..11a01e0 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -340,9 +340,9 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v putc('(', file); - // NOTE(Felix): We cold do a while true here, however in case + // NOTE(Felix): We cuold do a while true here, however in case // we want to print a broken list (for logging the error) we - // should do mo checks. + // should do more checks. while (head) { print(head->value.pair.first, print_repr, file); head = head->value.pair.rest; @@ -363,27 +363,41 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v } } - -proc print_error_location() -> void { - if (Globals::current_source_code) { - printf("%s (line %d, position %d) code:" console_red "\n ", +proc print_single_call(Lisp_Object* obj) -> void { + printf(console_cyan); + print(obj); + printf(console_normal); + printf("\n at "); + if (obj->sourceCodeLocation) { + printf("%s (line %d, position %d)", Memory::get_c_str( - Globals::current_source_code->sourceCodeLocation->file), - Globals::current_source_code->sourceCodeLocation->line, - Globals::current_source_code->sourceCodeLocation->column); - print(Globals::current_source_code); + obj->sourceCodeLocation->file), + obj->sourceCodeLocation->line, + obj->sourceCodeLocation->column); } else { fputs("no source code location avaliable", stdout); } } +proc print_call_stack() -> void { + using Globals::Current_Execution::call_stack; + + printf("callstack [%d] (most recent call last):\n", call_stack->next_index); + for (int i = 0; i < call_stack->next_index; ++i) { + printf("%2d -> ", i); + print_single_call(call_stack->data[i]); + printf("\n"); + } +} + proc log_error() -> void { fputs(console_red, stdout); fputs(Memory::get_c_str(Globals::error->message), stdout); puts(console_normal); - fputs(" in: " console_cyan, stdout); - print_error_location(); + fputs(" in: ", stdout); + print_call_stack(); puts(console_normal); + + Globals::Current_Execution::call_stack->next_index = 0; } - diff --git a/src/memory.cpp b/src/memory.cpp index 4bb7512..10937ad 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -182,8 +182,10 @@ namespace Memory { try_void t = create_lisp_object(); set_type(t, Lisp_Object_Type::T); - try_void Globals::root_environment = create_built_ins_environment(); - try_void Parser::standard_in = create_string("stdin"); + try_void Parser::standard_in = create_string("stdin"); + + try_void Globals::Current_Execution::envi_stack->data[0] = create_built_ins_environment(); + try_void Globals::Current_Execution::envi_stack->next_index = 1; } proc reset() -> void { @@ -196,7 +198,8 @@ namespace Memory { next_index_in_environment_memory = 0; next_free_spot_in_string_memory = string_memory; - Globals::root_environment = create_built_ins_environment(); + try_void Globals::Current_Execution::envi_stack->data[0] = create_built_ins_environment(); + try_void Globals::Current_Execution::envi_stack->next_index = 1; } proc create_lisp_object_number(double number) -> Lisp_Object* { diff --git a/src/testing.cpp b/src/testing.cpp index 53afdda..6e63b91 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -197,7 +197,7 @@ proc test_eval_operands() -> testresult { char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; Lisp_Object* operands = Parser::parse_single_expression(operands_string); int operands_length; - try operands = eval_arguments(operands, Globals::root_environment, &operands_length); + try operands = eval_arguments(operands, get_root_environment(), &operands_length); assert_no_error(); assert_equal_int(list_length(operands), 4); @@ -342,7 +342,7 @@ proc test_built_in_add() -> testresult { char exp_string[] = "(+ 10 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -357,7 +357,7 @@ proc test_built_in_substract() -> testresult { Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -372,7 +372,7 @@ proc test_built_in_multiply() -> testresult { char exp_string[] = "(* 10 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -387,7 +387,7 @@ proc test_built_in_divide() -> testresult { char exp_string[] = "(/ 20 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -402,7 +402,7 @@ proc test_built_in_if() -> testresult { char exp_string1[] = "(if 1 4 5)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -411,7 +411,7 @@ proc test_built_in_if() -> testresult { char exp_string2[] = "(if () 4 5)"; expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -425,7 +425,7 @@ proc test_built_in_and() -> testresult { char exp_string1[] = "(and 1 \"asd\" 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -434,7 +434,7 @@ proc test_built_in_and() -> testresult { // a false case char exp_string2[] = "(and () \"asd\" 4)"; expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -447,7 +447,7 @@ proc test_built_in_or() -> testresult { char exp_string1[] = "(or \"asd\" nil)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -456,7 +456,7 @@ proc test_built_in_or() -> testresult { // a false case char exp_string2[] = "(or () ())"; expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -470,7 +470,7 @@ proc test_built_in_not() -> testresult { char exp_string1[] = "(not ())"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); // a true case assert_no_error(); @@ -480,7 +480,7 @@ proc test_built_in_not() -> testresult { // a false case char exp_string2[] = "(not \"asd xD\")"; expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression, Globals::root_environment); + try result = eval_expr(expression, get_root_environment()); assert_no_error(); assert_not_null(result); @@ -491,7 +491,7 @@ proc test_built_in_not() -> testresult { proc test_built_in_type() -> testresult { Environment* env; - try env = Globals::root_environment; + try env = get_root_environment(); // normal type testing char exp_string1[] = "(begin (define a 10)(type a))"; @@ -539,7 +539,7 @@ proc test_built_in_type() -> testresult { proc test_singular_t_and_nil() -> testresult { Environment* env; - try env = Globals::root_environment; + try env = get_root_environment(); // nil testing char exp_string1[] = "()"; @@ -576,7 +576,7 @@ proc test_file(const char* file) -> testresult { Memory::reset(); assert_no_error(); - Environment* root_env = Globals::root_environment; + Environment* root_env = get_root_environment(); Environment* user_env = Memory::create_child_environment(root_env); assert_no_error();