brefore implementing envi stack

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;

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;

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;
+        Lisp_Object* value;
-        try symbol = lookup_symbol(node, env);
+        try value = lookup_symbol(node, env);
-        return symbol;
+        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,15 +535,7 @@ 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();
@@ -552,6 +545,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void {
             print(evaluated);
             printf("\n");
         }
-        }
+
     }
 }

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;
 
-// proc get_exe_dir() -> char*;
+
+proc print_environment(Environment*) -> void;
+inline proc get_root_environment() -> Environment*;
+inline proc get_current_environment() -> Environment*;
+
 
 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
+    namespace Current_Execution {
-    // instead
+        Lisp_Object_Array_List* call_stack = create_Lisp_Object_array_list();
-    Lisp_Object* current_source_code = nullptr;
+        Environment_Array_List* envi_stack = create_Environment_array_list();
+    }
+
     Error* error = nullptr;
 }

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_single_call(Lisp_Object* obj) -> void {
-proc print_error_location() -> void {
+    printf(console_cyan);
-    if (Globals::current_source_code) {
+    print(obj);
-        printf("%s (line %d, position %d) code:" console_red "\n    ",
+    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),
+                   obj->sourceCodeLocation->file),
-               Globals::current_source_code->sourceCodeLocation->line,
+               obj->sourceCodeLocation->line,
-               Globals::current_source_code->sourceCodeLocation->column);
+               obj->sourceCodeLocation->column);
-        print(Globals::current_source_code);
     } 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);
+    fputs("  in: ", stdout);
-    print_error_location();
+    print_call_stack();
     puts(console_normal);
-}
     
+    Globals::Current_Execution::call_stack->next_index = 0;
+}

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 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* {

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();