From 7cebcd1823665d828fead67b1ca0e9a1b79c19d5 Mon Sep 17 00:00:00 2001 From: Felix Brendel Date: Wed, 17 Jul 2019 23:20:07 +0200 Subject: [PATCH] implemented callstack and envistack --- build.bat | 4 +- manual/built-in-docs.org | 106 +++++++++++++------------- src/built_ins.cpp | 155 ++++++++++++++++++++------------------- src/docgeneration.cpp | 6 +- src/env.cpp | 13 +++- src/eval.cpp | 62 +++++++++------- src/forward_decls.cpp | 17 +++-- src/io.cpp | 3 +- src/lisp_object.cpp | 19 ++--- src/memory.cpp | 14 ++-- src/parse.cpp | 6 +- src/structs.cpp | 21 ++++-- src/testing.cpp | 51 +++++++------ todo.org | 3 - 14 files changed, 259 insertions(+), 221 deletions(-) diff --git a/build.bat b/build.bat index 231b237..efcdc6d 100644 --- a/build.bat +++ b/build.bat @@ -9,8 +9,8 @@ pushd bin taskkill /F /IM %exeName% > NUL 2> NUL echo ---------- Compiling ---------- -call ..\timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib -rem call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc +rem call ..\timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib +call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc popd if %errorlevel% == 0 ( diff --git a/manual/built-in-docs.org b/manual/built-in-docs.org index 02bd353..2bcba64 100644 --- a/manual/built-in-docs.org +++ b/manual/built-in-docs.org @@ -1,7 +1,7 @@ \hrule * === - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:158:0= + - defined in :: =../src/./built_ins.cpp:160:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -10,7 +10,7 @@ Takes 0 or more arguments and returns =t= if all arguments are equal and =()= ot \hrule * =>= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:174:0= + - defined in :: =../src/./built_ins.cpp:176:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -19,7 +19,7 @@ TODO \hrule * =>== - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:191:0= + - defined in :: =../src/./built_ins.cpp:193:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -28,7 +28,7 @@ TODO \hrule * =<= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:208:0= + - defined in :: =../src/./built_ins.cpp:210:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -37,7 +37,7 @@ TODO \hrule * =<== - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:227:0= + - defined in :: =../src/./built_ins.cpp:229:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -46,7 +46,7 @@ TODO \hrule * =+= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:244:0= + - defined in :: =../src/./built_ins.cpp:246:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -55,7 +55,7 @@ TODO \hrule * =-= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:256:0= + - defined in :: =../src/./built_ins.cpp:258:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -64,7 +64,7 @@ TODO \hrule * =*= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:278:0= + - defined in :: =../src/./built_ins.cpp:280:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -73,7 +73,7 @@ TODO \hrule * =/= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:298:0= + - defined in :: =../src/./built_ins.cpp:300:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -82,7 +82,7 @@ TODO \hrule * =**= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:318:0= + - defined in :: =../src/./built_ins.cpp:320:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -91,7 +91,7 @@ TODO \hrule * =%= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:333:0= + - defined in :: =../src/./built_ins.cpp:335:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -100,7 +100,7 @@ TODO \hrule * =assert= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:348:0= + - defined in :: =../src/./built_ins.cpp:350:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -109,7 +109,7 @@ TODO \hrule * =define= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:359:0= + - defined in :: =../src/./built_ins.cpp:361:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -118,7 +118,7 @@ TODO \hrule * =mutate= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:421:0= + - defined in :: =../src/./built_ins.cpp:423:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -127,7 +127,7 @@ TODO \hrule * =if= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:446:0= + - defined in :: =../src/./built_ins.cpp:448:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -136,7 +136,7 @@ TODO \hrule * =quote= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:466:0= + - defined in :: =../src/./built_ins.cpp:468:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -145,7 +145,7 @@ TODO \hrule * =quasiquote= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:471:0= + - defined in :: =../src/./built_ins.cpp:473:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -154,7 +154,7 @@ TODO \hrule * =and= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:568:0= + - defined in :: =../src/./built_ins.cpp:569:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -163,7 +163,7 @@ TODO \hrule * =or= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:579:0= + - defined in :: =../src/./built_ins.cpp:580:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -172,7 +172,7 @@ TODO \hrule * =not= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:590:0= + - defined in :: =../src/./built_ins.cpp:591:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -181,7 +181,7 @@ TODO \hrule * =while= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:600:0= + - defined in :: =../src/./built_ins.cpp:601:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -190,7 +190,7 @@ TODO \hrule * =lambda= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:678:0= + - defined in :: =../src/./built_ins.cpp:679:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -199,7 +199,7 @@ TODO \hrule * =special-lambda= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:690:0= + - defined in :: =../src/./built_ins.cpp:691:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -208,7 +208,7 @@ TODO \hrule * =eval= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:698:0= + - defined in :: =../src/./built_ins.cpp:699:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -217,7 +217,7 @@ TODO \hrule * =begin= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:710:0= + - defined in :: =../src/./built_ins.cpp:711:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -226,7 +226,7 @@ TODO \hrule * =list= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:726:0= + - defined in :: =../src/./built_ins.cpp:727:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -235,7 +235,7 @@ TODO \hrule * =pair= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:730:0= + - defined in :: =../src/./built_ins.cpp:731:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -244,7 +244,7 @@ TODO \hrule * =first= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:740:0= + - defined in :: =../src/./built_ins.cpp:741:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -253,7 +253,7 @@ TODO \hrule * =rest= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:751:0= + - defined in :: =../src/./built_ins.cpp:752:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -262,7 +262,7 @@ TODO \hrule * =set-type= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:762:0= + - defined in :: =../src/./built_ins.cpp:763:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -271,7 +271,7 @@ TODO \hrule * =delete-type= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:774:0= + - defined in :: =../src/./built_ins.cpp:775:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -280,7 +280,7 @@ TODO \hrule * =type= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:781:0= + - defined in :: =../src/./built_ins.cpp:782:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -289,7 +289,7 @@ TODO \hrule * =info= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:813:0= + - defined in :: =../src/./built_ins.cpp:815:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -298,7 +298,7 @@ TODO \hrule * =show= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:895:0= + - defined in :: =../src/./built_ins.cpp:896:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -307,7 +307,7 @@ TODO \hrule * =addr-of= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:907:0= + - defined in :: =../src/./built_ins.cpp:908:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -316,7 +316,7 @@ TODO \hrule * =generate-docs= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:913:0= + - defined in :: =../src/./built_ins.cpp:914:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -325,7 +325,7 @@ TODO \hrule * =print= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:922:0= + - defined in :: =../src/./built_ins.cpp:923:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -334,7 +334,7 @@ TODO \hrule * =read= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:930:0= + - defined in :: =../src/./built_ins.cpp:931:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -343,7 +343,7 @@ TODO \hrule * =exit= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:947:0= + - defined in :: =../src/./built_ins.cpp:948:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -352,7 +352,7 @@ TODO \hrule * =break= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:958:0= + - defined in :: =../src/./built_ins.cpp:959:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -361,7 +361,7 @@ TODO \hrule * =memstat= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:963:0= + - defined in :: =../src/./built_ins.cpp:964:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -370,7 +370,7 @@ TODO \hrule * =try= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:967:0= + - defined in :: =../src/./built_ins.cpp:968:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -379,7 +379,7 @@ TODO \hrule * =load= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:982:0= + - defined in :: =../src/./built_ins.cpp:983:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -388,7 +388,7 @@ TODO \hrule * =import= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:993:0= + - defined in :: =../src/./built_ins.cpp:994:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -397,7 +397,7 @@ TODO \hrule * =copy= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1004:0= + - defined in :: =../src/./built_ins.cpp:1005:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -406,7 +406,7 @@ TODO \hrule * =error= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1012:0= + - defined in :: =../src/./built_ins.cpp:1013:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -415,7 +415,7 @@ TODO \hrule * =symbol->keyword= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1019:0= + - defined in :: =../src/./built_ins.cpp:1020:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -424,7 +424,7 @@ TODO \hrule * =string->symbol= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1028:0= + - defined in :: =../src/./built_ins.cpp:1029:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -433,7 +433,7 @@ TODO \hrule * =symbol->string= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1040:0= + - defined in :: =../src/./built_ins.cpp:1041:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -442,7 +442,7 @@ TODO \hrule * =concat-strings= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1049:0= + - defined in :: =../src/./built_ins.cpp:1050:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -1073,7 +1073,7 @@ be printed after the last argument (=end=). \hrule * =cons= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:730:0= + - defined in :: =../src/./built_ins.cpp:731:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -1082,7 +1082,7 @@ TODO \hrule * =car= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:740:0= + - defined in :: =../src/./built_ins.cpp:741:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -1091,7 +1091,7 @@ TODO \hrule * =cdr= - - defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:751:0= + - defined in :: =../src/./built_ins.cpp:752:0= - type :: =:cfunction= - docu :: #+BEGIN: diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 9ab4c6b..14f00d6 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -9,7 +9,8 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { case Lisp_Object_Type::CFunction: // if they have the same // pointer, true is returned a // few lines above - case Lisp_Object_Type::Function: return false; + case Lisp_Object_Type::Function: + case Lisp_Object_Type::Continuation: return false; case Lisp_Object_Type::T: // code for t and nil should never be // reached since they are memory unique case Lisp_Object_Type::Nil: return true; @@ -29,7 +30,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { return false; } -proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { +proc built_in_load(String* file_name) -> Lisp_Object* { // char* full_file_name = find_slime_file(file_name); char* file_content; char fullpath[4096]; @@ -64,33 +65,33 @@ proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { try program = Parser::parse_program(Memory::create_string(fullpath), file_content); for (int i = 0; i < program->next_index; ++i) { - try result = eval_expr(program->data[i], env); + try result = eval_expr(program->data[i]); } return result; } -proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { +proc built_in_import(String* file_name) -> Lisp_Object* { // create new empty environment Environment* new_env; try new_env = Memory::create_child_environment(get_root_environment()); - append_to_array_list(env->parents, new_env); + append_to_array_list(get_current_environment()->parents, new_env); - Environment* old_macro_env = Parser::environment_for_macros; - Parser::environment_for_macros = new_env; - - Lisp_Object* res = built_in_load(file_name, new_env); + push_environment(new_env); + defer { + pop_environment(); + }; - Parser::environment_for_macros = old_macro_env; + Lisp_Object* res = built_in_load(file_name); return res; } -proc load_built_ins_into_environment(Environment* env) -> void { +proc load_built_ins_into_environment() -> void { int arguments_length = 0; Lisp_Object* evaluated_arguments = nullptr; String* file_name_built_ins = Memory::create_string(__FILE__); -#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object* +#define cLambda [=](Lisp_Object* arguments) mutable -> Lisp_Object* proc defun = [&](const char* name, const char* docs, int linenum, auto fun) { auto sym = Memory::get_or_create_lisp_object_symbol(name); @@ -102,10 +103,11 @@ proc load_built_ins_into_environment(Environment* env) -> void { sfun->sourceCodeLocation->column = 0; sfun->docstring = Memory::create_string(docs); - define_symbol(sym, sfun, env); + define_symbol(sym, sfun); }; - proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* { + proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, bool is_special = false) -> Lisp_Object* { + Environment* env = get_current_environment(); // Function* function = new(Function); Lisp_Object* ret; try ret = Memory::create_lisp_object(); @@ -156,7 +158,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { "Takes 0 or more arguments and returns =t= if all arguments are equal " "and =()= otherwise.", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); if (arguments == Memory::nil) return Memory::t; @@ -172,7 +174,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::t; }); defun(">", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); double last_number = strtod("Inf", NULL); @@ -189,7 +191,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::t; }); defun(">=", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); double last_number = strtod("Inf", NULL); @@ -207,7 +209,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { }); defun("<", "TODO", __LINE__, cLambda { try { - arguments = eval_arguments(arguments, env, &arguments_length); + arguments = eval_arguments(arguments, &arguments_length); } double last_number = strtod("-Inf", NULL); @@ -225,7 +227,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::t; }); defun("<=", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); double last_number = strtod("-Inf", NULL); @@ -242,7 +244,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::t; }); defun("+", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); double sum = 0; while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { @@ -254,7 +256,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(sum); }); defun("-", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); if (arguments_length == 0) return Memory::create_lisp_object_number(0); @@ -276,7 +278,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(difference); }); defun("*", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); if (arguments_length == 0) { return Memory::create_lisp_object_number(1); @@ -296,7 +298,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(product); }); defun("/", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); if (arguments_length == 0) { return Memory::create_lisp_object_number(1); @@ -316,7 +318,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(quotient); }); defun("**", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); @@ -331,7 +333,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(pow(base, exponent)); }); defun("%", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); @@ -347,10 +349,10 @@ proc load_built_ins_into_environment(Environment* env) -> void { }); defun("assert", "TODO", __LINE__, cLambda { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); try assert(arguments_length == 1); - if (is_truthy(arguments->value.pair.first, env)) + if (is_truthy(arguments->value.pair.first)) return Memory::t; create_generic_error("Userland assertion."); @@ -393,7 +395,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { symbol ->value.pair.rest, arguments->value.pair.rest); - value = parse_lambda_starting_from_args(fake_lambda, env); + value = parse_lambda_starting_from_args(fake_lambda); symbol = real_symbol; } else { try assert_arguments_length_greater_equal(2, arguments_length); @@ -409,17 +411,17 @@ proc load_built_ins_into_environment(Environment* env) -> void { value = arguments->value.pair.rest->value.pair.first; - try value = eval_expr(value, env); + try value = eval_expr(value); if (doc) value->docstring = doc; } - define_symbol(symbol, value, env); + define_symbol(symbol, value); return value; }); defun("mutate", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); Lisp_Object* target = evaluated_arguments->value.pair.first; Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; @@ -453,13 +455,13 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* else_part = then_part->value.pair.rest; bool truthy; - try truthy = is_truthy(condition, env); + try truthy = is_truthy(condition); // printf("arg len is: %d\n", arguments_length); Lisp_Object* result; if (truthy) - try result = eval_expr(then_part->value.pair.first, env); + try result = eval_expr(then_part->value.pair.first); else - try result = eval_expr(else_part->value.pair.first, env); + try result = eval_expr(else_part->value.pair.first); return result; }); @@ -471,7 +473,6 @@ proc load_built_ins_into_environment(Environment* env) -> void { defun("quasiquote", "TODO", __LINE__, cLambda { try arguments_length = list_length(arguments); try assert_arguments_length(1, arguments_length); - // print(arguments); // printf("\n"); @@ -480,7 +481,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // with a garbage lambda, so that we can then overwrite it // a recursive lambda std::function unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;}; - unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* { + unquoteSomeExpressions = [&unquoteSomeExpressions] (Lisp_Object* expr) -> Lisp_Object* { // if it is an atom, return it if (Memory::get_type(expr) != Lisp_Object_Type::Pair) return Memory::copy_lisp_object(expr); @@ -492,7 +493,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { string_equal(originalPair->value.symbol.identifier, "unquote-splicing"))) { // eval replace the stuff - return eval_expr(expr->value.pair.rest->value.pair.first, env); + return eval_expr(expr->value.pair.rest->value.pair.first); } // it is a list but not starting with the symbol @@ -569,7 +570,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { bool result = true; while (arguments != Memory::nil) { try assert_type(arguments, Lisp_Object_Type::Pair); - try result &= is_truthy(arguments->value.pair.first, env); + try result &= is_truthy(arguments->value.pair.first); arguments = arguments->value.pair.rest; if (!result) return Memory::nil; @@ -580,7 +581,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { bool result = false; while (arguments != Memory::nil) { try assert_type(arguments, Lisp_Object_Type::Pair); - try result |= is_truthy(arguments->value.pair.first, env); + try result |= is_truthy(arguments->value.pair.first); arguments = arguments->value.pair.rest; if (result) return Memory::t; @@ -593,7 +594,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { bool truthy; - try truthy = is_truthy(arguments->value.pair.first, env); + try truthy = is_truthy(arguments->value.pair.first); return (truthy) ? Memory::nil : Memory::t; }); @@ -613,12 +614,12 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* result = Memory::nil; while (true) { - try condition = eval_expr(condition_part, env); + try condition = eval_expr(condition_part); if (condition == Memory::nil) break; - try result = eval_expr(wrapped_then_part, env); + try result = eval_expr(wrapped_then_part); } return result; @@ -683,7 +684,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { try arguments_length = list_length(arguments); try assert_arguments_length_greater_equal(1, arguments_length); - Lisp_Object* function = parse_lambda_starting_from_args(arguments, env, false); + Lisp_Object* function = parse_lambda_starting_from_args(arguments, false); return function; }); @@ -691,24 +692,24 @@ proc load_built_ins_into_environment(Environment* env) -> void { try arguments_length = list_length(arguments); try assert_arguments_length_greater_equal(1, arguments_length); - Lisp_Object* function = parse_lambda_starting_from_args(arguments, env, true); + Lisp_Object* function = parse_lambda_starting_from_args(arguments, true); return function; }); defun("eval", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); Lisp_Object* result; - try result = eval_expr(evaluated_arguments->value.pair.first, env); + try result = eval_expr(evaluated_arguments->value.pair.first); return result; }); defun("begin", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); if (evaluated_arguments == Memory::nil) return Memory::nil; @@ -724,11 +725,11 @@ proc load_built_ins_into_environment(Environment* env) -> void { return evaluated_arguments->value.pair.first; }); defun("list", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); return evaluated_arguments; }); defun("pair", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); Lisp_Object* ret; @@ -738,7 +739,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return ret; }); defun("first", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); if (evaluated_arguments->value.pair.first == Memory::nil) @@ -749,7 +750,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return evaluated_arguments->value.pair.first->value.pair.first; }); defun("rest", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); if (evaluated_arguments->value.pair.first == Memory::nil) @@ -760,7 +761,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return evaluated_arguments->value.pair.first->value.pair.rest; }); defun("set-type", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); Lisp_Object* object = evaluated_arguments->value.pair.first; @@ -772,14 +773,14 @@ proc load_built_ins_into_environment(Environment* env) -> void { return object; }); defun("delete-type", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); evaluated_arguments->value.pair.first->userType = nullptr; return Memory::t; }); defun("type", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); if (evaluated_arguments->value.pair.first->userType) { @@ -789,6 +790,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first); switch (type) { + case Lisp_Object_Type::Continuation: return Memory::get_or_create_lisp_object_keyword("continuation"); case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); case Lisp_Object_Type::Function: { Function* fun = &evaluated_arguments->value.pair.first->value.function; @@ -820,11 +822,10 @@ proc load_built_ins_into_environment(Environment* env) -> void { try type = eval_expr( Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("type"), - Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)), - env); + Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil))); if (type) { - Lisp_Object* val = eval_expr(arguments->value.pair.first, env); + Lisp_Object* val = eval_expr(arguments->value.pair.first); printf(" is of type "); print(type); printf("\nand is printed as: "); @@ -840,7 +841,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { string_equal(type->value.symbol.identifier, "special-lambda") || string_equal(type->value.symbol.identifier, "macro"))) { - Lisp_Object* fun = eval_expr(arguments->value.pair.first, env); + Lisp_Object* fun = eval_expr(arguments->value.pair.first); if (fun->docstring) printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->docstring)); @@ -893,7 +894,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::nil; }); defun("show", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Function); @@ -905,7 +906,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::nil; }); defun("addr-of", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); return Memory::create_lisp_object_number((float)((u64)&(evaluated_arguments->value.pair.first->value))); @@ -915,12 +916,12 @@ proc load_built_ins_into_environment(Environment* env) -> void { try assert_arguments_length(1, arguments_length); try assert_type(arguments->value.pair.first, Lisp_Object_Type::String); - generate_docs(env, arguments->value.pair.first->value.string); + generate_docs(arguments->value.pair.first->value.string); return Memory::t; }); defun("print", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); print(evaluated_arguments->value.pair.first); @@ -928,7 +929,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::nil; }); defun("read", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length_less_equal(1, arguments_length); if (arguments_length == 1) { @@ -945,7 +946,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_string(strLine); }); defun("exit", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length_less_equal(1, arguments_length); if (arguments_length == 1) { @@ -956,7 +957,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { exit(0); }); defun("break", "TODO", __LINE__, cLambda { - print_environment(env); + print_environment(get_current_environment()); debug_break(); return Memory::nil; }); @@ -972,31 +973,31 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first; Lisp_Object* result; - result = eval_expr(try_part, env); + result = eval_expr(try_part); if (Globals::error) { delete_error(); - try result = eval_expr(catch_part, env); + try result = eval_expr(catch_part); } return result; }); defun("load", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); Lisp_Object* result; - try result = built_in_load(evaluated_arguments->value.pair.first->value.string, env); + try result = built_in_load(evaluated_arguments->value.pair.first->value.string); return result; }); defun("import", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); Lisp_Object* result; - try result = built_in_import(evaluated_arguments->value.pair.first->value.string, env); + try result = built_in_import(evaluated_arguments->value.pair.first->value.string); return result; @@ -1004,20 +1005,20 @@ proc load_built_ins_into_environment(Environment* env) -> void { defun("copy", "TODO", __LINE__, cLambda { // TODO(Felix): if we are copying string nodes, then // shouldn't the string itself also get copied?? - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); return Memory::copy_lisp_object(evaluated_arguments->value.pair.first); }); defun("error", "TODO", __LINE__, cLambda { // TODO(Felix): make the error function useful - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(0, arguments_length); create_generic_error("Userlanderror"); return nullptr; }); defun("symbol->keyword", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol); @@ -1029,7 +1030,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // TODO(Felix): do some sanity checks on the string. For // example, numbers are not valid symbols. - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); @@ -1038,7 +1039,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::get_or_create_lisp_object_symbol(Memory::duplicate_string(source->value.string)); }); defun("symbol->string", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(1, arguments_length); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol); @@ -1047,7 +1048,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol.identifier)); }); defun("concat-strings", "TODO", __LINE__, cLambda { - try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length_greater_equal(1, arguments_length); int resulting_string_len = 0; diff --git a/src/docgeneration.cpp b/src/docgeneration.cpp index 5f53edc..7ff0b7d 100644 --- a/src/docgeneration.cpp +++ b/src/docgeneration.cpp @@ -1,4 +1,4 @@ -proc generate_docs(Environment* env, String* path) -> void { +proc generate_docs(String* path) -> void { // save the current working directory char* cwd = get_cwd(); // get the direction of the exe @@ -58,7 +58,7 @@ proc generate_docs(Environment* env, String* path) -> void { Lisp_Object* LOtype; try_void LOtype = eval_expr(Memory::create_list( Memory::get_or_create_lisp_object_symbol("type"), - env->values[i]), env); + env->values[i])); fprintf(f, "\n - type :: ="); print(LOtype, true, f); @@ -156,5 +156,5 @@ proc generate_docs(Environment* env, String* path) -> void { } }; - print_this_env(env, (char*)""); + print_this_env(get_current_environment(), (char*)""); } diff --git a/src/env.cpp b/src/env.cpp index 2bfbcca..f6b2b40 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -1,9 +1,10 @@ -proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void { +proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { // NOTE(Felix): right now we are simply adding the symol at the // back of the list without checking if it already exists but are // also searching for thesymbol from the back, so we will find the // latest defined one first, but a bit messy. Later we should use // a hashmap here. @refactor + Environment* env = get_current_environment(); if (env->next_index == env->capacity) { env->capacity *= 2; @@ -48,6 +49,16 @@ proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { return nullptr; } +inline proc push_environment(Environment* env) -> void { + using namespace Globals::Current_Execution; + append_to_array_list(envi_stack, env); +} + +inline proc pop_environment() -> void { + using namespace Globals::Current_Execution; + --envi_stack->next_index; +} + inline proc get_root_environment() -> Environment* { using namespace Globals::Current_Execution; return envi_stack->data[0]; diff --git a/src/eval.cpp b/src/eval.cpp index feba798..436621e 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -1,13 +1,17 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { Environment* new_env; try new_env = Memory::create_child_environment(function->parent_environment); + push_environment(new_env); + defer { + pop_environment(); + }; Lisp_Object* sym, *val; // used as temp storage to use `try` String_Array_List* read_in_keywords; int obligatory_keywords_count = 0; int read_obligatory_keywords_count = 0; - proc read_poitional_args = [&]() -> void { + proc read_positional_args = [&]() -> void { for (int i = 0; i < function->positional_arguments->next_index; ++i) { if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i); @@ -22,8 +26,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> try_void sym = function->positional_arguments->symbols[i]; define_symbol( sym, - Memory::copy_lisp_object_except_pairs(arguments->value.pair.first), - new_env); + Memory::copy_lisp_object_except_pairs(arguments->value.pair.first)); arguments = arguments->value.pair.rest; } @@ -109,8 +112,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // NOTE(Felix): It seems we do not need to evaluate the argument here... try_void define_symbol( sym, - Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first), - new_env); + Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier); ++read_obligatory_keywords_count; @@ -153,7 +155,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> if (!was_set) { try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); try_void val = Memory::copy_lisp_object_except_pairs(function->keyword_arguments->values->data[i]); - define_symbol(sym, val, new_env); + define_symbol(sym, val); } } } @@ -163,7 +165,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> if (arguments == Memory::nil) { if (function->rest_argument) { try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); - define_symbol(sym, Memory::nil, new_env); + define_symbol(sym, Memory::nil); } } else { if (function->rest_argument) { @@ -172,8 +174,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> sym, // NOTE(Felix): arguments will be a list, and I THINK // we do not need to copy it... - arguments, - new_env); + arguments); } else { // rest was not declared but additional arguments were found create_generic_error( @@ -184,13 +185,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> } }; - try read_poitional_args(); + try read_positional_args(); try read_keyword_args(); try check_keyword_args(); try read_rest_arg(); Lisp_Object* result; - try result = eval_expr(function->body, new_env); + try result = eval_expr(function->body); return result; } @@ -291,7 +292,11 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { next = next->value.pair.rest; if (Memory::get_type(next) == Lisp_Object_Type::Pair) { Lisp_Object* ret; - try_void ret = eval_expr(next->value.pair.first, function->parent_environment); + push_environment(function->parent_environment); + defer { + pop_environment(); + }; + try_void ret = eval_expr(next->value.pair.first); append_to_keyword_argument_list(function->keyword_arguments, arguments->value.pair.first, ret); @@ -367,7 +372,7 @@ proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object return nullptr; } -proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* { +proc eval_arguments(Lisp_Object* arguments, int *out_arguments_length) -> Lisp_Object* { int my_out_arguments_length = 0; if (arguments == Memory::nil) { *(out_arguments_length) = 0; @@ -381,7 +386,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments Lisp_Object* current_head = arguments; while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { - try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env); + try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first); evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; current_head = current_head->value.pair.rest; @@ -401,7 +406,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments return evaluated_arguments; } -proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { +proc eval_expr(Lisp_Object* node) -> Lisp_Object* { using namespace Globals::Current_Execution; append_to_array_list(call_stack, node); defer { @@ -424,7 +429,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { return node; case Lisp_Object_Type::Symbol: { Lisp_Object* value; - try value = lookup_symbol(node, env); + try value = lookup_symbol(node, get_current_environment()); return value; } case Lisp_Object_Type::Pair: { @@ -432,7 +437,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) { - try lispOperator = eval_expr(node->value.pair.first, env); + try lispOperator = eval_expr(node->value.pair.first); } else { lispOperator = node->value.pair.first; } @@ -443,7 +448,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { // check for c function if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { Lisp_Object* result; - try result = lispOperator->value.cFunction->function(arguments, env); + try result = lispOperator->value.cFunction->function(arguments); return result; } @@ -453,7 +458,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { // apllying, for the other types, special-lambda and macro // we do not need. if (lispOperator->value.function.type == Function_Type::Lambda) { - try arguments = eval_arguments(arguments, env, &arguments_length); + try arguments = eval_arguments(arguments, &arguments_length); } Lisp_Object* result; @@ -468,7 +473,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { // later again. We will call this "lazy macro expansion" if (lispOperator->value.function.type == Function_Type::Macro) { *node = *result; - try result = eval_expr(result, env); + try result = eval_expr(result); } return result; @@ -481,9 +486,9 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { } } -proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { +proc is_truthy(Lisp_Object* expression) -> bool { Lisp_Object* result; - try result = eval_expr(expression, env); + try result = eval_expr(expression); return result != Memory::nil; } @@ -493,9 +498,12 @@ proc interprete_file (char* file_name) -> Lisp_Object* { Environment* root_env = get_root_environment(); Environment* user_env; try user_env = Memory::create_child_environment(root_env); - Parser::environment_for_macros = user_env; + push_environment(user_env); + defer { + pop_environment(); + }; - Lisp_Object* result = built_in_load(Memory::create_string(file_name), user_env); + Lisp_Object* result = built_in_load(Memory::create_string(file_name)); if (Globals::error) { log_error(); @@ -509,6 +517,10 @@ proc interprete_stdin() -> void { Memory::init(4096 * 256, 1024, 4096 * 256); Environment* root_env = get_root_environment(); Environment* user_env = Memory::create_child_environment(root_env); + push_environment(user_env); + defer { + pop_environment(); + }; if (Globals::error) { log_error(); delete_error(); @@ -534,7 +546,7 @@ proc interprete_stdin() -> void { delete_error(); continue; } - evaluated = eval_expr(parsed, user_env); + evaluated = eval_expr(parsed); if (Globals::error) { log_error(); diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index 20b5b1a..18ad6ab 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -1,26 +1,27 @@ // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void; -proc built_in_load(String*, Environment*) -> Lisp_Object*; -proc built_in_import(String*, Environment*) -> Lisp_Object*; +proc built_in_load(String*) -> Lisp_Object*; +proc built_in_import(String*) -> Lisp_Object*; proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void; proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void; proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void; -proc eval_arguments(Lisp_Object*, Environment*, int*) -> Lisp_Object*; -proc eval_expr(Lisp_Object*, Environment*) -> Lisp_Object*; -proc is_truthy (Lisp_Object*, Environment*) -> bool; +proc eval_arguments(Lisp_Object*, int*) -> Lisp_Object*; +proc eval_expr(Lisp_Object*) -> Lisp_Object*; +proc is_truthy (Lisp_Object*) -> bool; proc list_length(Lisp_Object*) -> int; -proc load_built_ins_into_environment(Environment*) -> void; +proc load_built_ins_into_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*; - +inline proc push_environment(Environment*) -> void; +inline proc pop_environment() -> void; proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; proc visualize_lisp_machine() -> void; -proc generate_docs(Environment* env, String* path) -> void; +proc generate_docs(String* path) -> void; namespace Memory { proc create_built_ins_environment() -> Environment*; diff --git a/src/io.cpp b/src/io.cpp index 11a01e0..508de3b 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -281,6 +281,7 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v } break; case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break; + case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break; case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break; case (Lisp_Object_Type::String): { if (print_repr) { @@ -398,6 +399,6 @@ proc log_error() -> void { fputs(" in: ", stdout); print_call_stack(); puts(console_normal); - + Globals::Current_Execution::call_stack->next_index = 0; } diff --git a/src/lisp_object.cpp b/src/lisp_object.cpp index 9a724c5..7c4f842 100644 --- a/src/lisp_object.cpp +++ b/src/lisp_object.cpp @@ -11,15 +11,16 @@ proc create_source_code_location(String* file, int line, int col) -> Source_Code proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { switch (type) { - case(Lisp_Object_Type::Nil): return "nil"; - case(Lisp_Object_Type::T): return "t"; - case(Lisp_Object_Type::Number): return "number"; - case(Lisp_Object_Type::String): return "string"; - case(Lisp_Object_Type::Symbol): return "symbol"; - case(Lisp_Object_Type::Keyword): return "keyword"; - case(Lisp_Object_Type::Function): return "function"; - case(Lisp_Object_Type::CFunction): return "C-function"; - case(Lisp_Object_Type::Pair): return "pair"; + case(Lisp_Object_Type::Nil): return "nil"; + case(Lisp_Object_Type::T): return "t"; + case(Lisp_Object_Type::Number): return "number"; + case(Lisp_Object_Type::String): return "string"; + case(Lisp_Object_Type::Symbol): return "symbol"; + case(Lisp_Object_Type::Keyword): return "keyword"; + case(Lisp_Object_Type::Function): return "function"; + case(Lisp_Object_Type::CFunction): return "C-function"; + case(Lisp_Object_Type::Continuation): return "continuation"; + case(Lisp_Object_Type::Pair): return "pair"; } return "unknown"; } diff --git a/src/memory.cpp b/src/memory.cpp index 10937ad..9a5083c 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -266,7 +266,7 @@ namespace Memory { Memory::create_string(keyword)); } - proc create_lisp_object_cfunction(std::function function) -> Lisp_Object* { + proc create_lisp_object_cfunction(std::function function) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::CFunction); @@ -355,13 +355,19 @@ namespace Memory { proc create_built_ins_environment() -> Environment* { Environment* ret; try ret = create_empty_environment(); - load_built_ins_into_environment(ret); + push_environment(ret); + defer { + pop_environment(); + }; + + load_built_ins_into_environment(); Parser::environment_for_macros = ret; // save the current working directory char* cwd = get_cwd(); defer { + change_cwd(cwd); free(cwd); }; @@ -370,9 +376,7 @@ namespace Memory { change_cwd(exe_path); free(exe_path); - built_in_load(Memory::create_string("pre.slime"), ret); - - change_cwd(cwd); + built_in_load(Memory::create_string("pre.slime")); return ret; } diff --git a/src/parse.cpp b/src/parse.cpp index e801732..9191a44 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -426,7 +426,7 @@ namespace Parser { inject_scl(macro); // macro->value.function = function; - define_symbol(symbol_for_macro, macro, environment_for_macros); + define_symbol(symbol_for_macro, macro); // print_environment(environment_for_macros); return Memory::nil; @@ -452,7 +452,7 @@ namespace Parser { // if not it is regular code, dont touch. break; - Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros); + Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment()); if (macro && Memory::get_type(macro) == Lisp_Object_Type::Function && macro->value.function.type == Function_Type::Macro) @@ -474,7 +474,7 @@ namespace Parser { defer { macro->value.function.type = Function_Type::Macro; }; - try expression = eval_expr(expression, environment_for_macros); + try expression = eval_expr(expression); break; } else break; } diff --git a/src/structs.cpp b/src/structs.cpp index 1f859d7..6837c47 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -16,6 +16,7 @@ enum struct Lisp_Object_Type { Number, String, Pair, + Continuation, // Pointer, // OwningPointer, Function, @@ -44,6 +45,11 @@ enum struct Log_Level { Debug, }; +struct Continuation { + Lisp_Object_Array_List* call_stack; + Environment_Array_List* envi_stack; +}; + struct String { int length; char data; @@ -96,7 +102,7 @@ struct Function { }; struct cFunction { - std::function function; + std::function function; }; struct Lisp_Object { @@ -105,12 +111,13 @@ struct Lisp_Object { Lisp_Object* userType; String* docstring; union { - Symbol symbol; // used for symbols and keywords - double number; - String* string; - Pair pair; - Function function; - cFunction* cFunction; + Symbol symbol; // used for symbols and keywords + double number; + String* string; + Pair pair; + Function function; + cFunction* cFunction; + Continuation continuation; } value; }; diff --git a/src/testing.cpp b/src/testing.cpp index 6e63b91..44be238 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, get_root_environment(), &operands_length); + try operands = eval_arguments(operands, &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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); 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, get_root_environment()); + try result = eval_expr(expression); // 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, get_root_environment()); + try result = eval_expr(expression); assert_no_error(); assert_not_null(result); @@ -490,13 +490,13 @@ proc test_built_in_not() -> testresult { } proc test_built_in_type() -> testresult { - Environment* env; - try env = get_root_environment(); + // Environment* env; + // try env = get_root_environment(); // normal type testing char exp_string1[] = "(begin (define a 10)(type a))"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result = eval_expr(expression, env); + Lisp_Object* result = eval_expr(expression); assert_no_error(); assert_not_null(result); @@ -506,7 +506,7 @@ proc test_built_in_type() -> testresult { // setting user type char exp_string2[] = "(begin (set-type a :my-type)(type a))"; expression = Parser::parse_single_expression(exp_string2); - result = eval_expr(expression, env); + result = eval_expr(expression); assert_no_error(); assert_not_null(result); @@ -518,7 +518,7 @@ proc test_built_in_type() -> testresult { expression = Parser::parse_single_expression(exp_string3); without_logging { - result = eval_expr(expression, env); + result = eval_expr(expression); } assert_error(); @@ -527,7 +527,7 @@ proc test_built_in_type() -> testresult { // deleting user type char exp_string4[] = "(begin (delete-type a)(type a))"; expression = Parser::parse_single_expression(exp_string4); - result = eval_expr(expression, env); + result = eval_expr(expression); assert_no_error(); assert_not_null(result); @@ -545,7 +545,7 @@ proc test_singular_t_and_nil() -> testresult { char exp_string1[] = "()"; char exp_string2[] = "nil"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result = eval_expr(expression, env); + Lisp_Object* result = eval_expr(expression); assert_no_error(); assert_not_null(result); @@ -553,7 +553,7 @@ proc test_singular_t_and_nil() -> testresult { assert_equal_int(expression, result); Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2); - Lisp_Object* result2 = eval_expr(expression2, env); + Lisp_Object* result2 = eval_expr(expression2); assert_no_error(); assert_not_null(result); @@ -564,7 +564,7 @@ proc test_singular_t_and_nil() -> testresult { // t testing char exp_string3[] = "t"; Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3); - Lisp_Object* result3 = eval_expr(expression3, env); + Lisp_Object* result3 = eval_expr(expression3); assert_no_error(); assert_not_null(result3); @@ -580,9 +580,12 @@ proc test_file(const char* file) -> testresult { Environment* user_env = Memory::create_child_environment(root_env); assert_no_error(); - Parser::environment_for_macros = user_env; + push_environment(user_env); + defer { + pop_environment(); + }; - built_in_load(Memory::create_string(file), user_env); + built_in_load(Memory::create_string(file)); assert_no_error(); return pass; diff --git a/todo.org b/todo.org index ff66ad3..e0e0c7c 100644 --- a/todo.org +++ b/todo.org @@ -1,9 +1,7 @@ -* TODO create global environment- and callstack * TODO rename slime to plisk * TODO rename modifying functions to prefix '!' * TODO go through sicp and use the examples as test files - * TODO test macro expanding to macro * TODO BUG 1: eval dot notation #+BEGIN_SRC lisp @@ -20,4 +18,3 @@ ;; should output 6 ;; outputs 0 #+END_SRC -