diff --git a/.gitignore b/.gitignore index cb47a13..031a541 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,4 @@ todo.html /tests/libslime/main /tests/fullslime/main *.o +/bin/slime_d diff --git a/3rd/ftb b/3rd/ftb index 635af49..7d8eabf 160000 --- a/3rd/ftb +++ b/3rd/ftb @@ -1 +1 @@ -Subproject commit 635af49d52cb96f598d1e51882de005cf08cd578 +Subproject commit 7d8eabf47938ff4a056f94e8cbeb4a49ab9ea2d1 diff --git a/build.sh b/build.sh index 624541a..ac909c6 100755 --- a/build.sh +++ b/build.sh @@ -2,43 +2,50 @@ TIMEFORMAT=%3lU SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )" pushd $SCRIPTPATH > /dev/null -echo "" -echo "----------------------" -echo " compiling libslime " -echo "----------------------" - -time clang++ --std=c++17 \ - src/libslime.cpp -c -o libslime.o \ - -I3rd/ || exit 1 +# echo "" +# echo "----------------------" +# echo " compiling libslime " +# echo "----------------------" +# time clang++ --std=c++17 \ +# src/libslime.cpp -c -o libslime.o \ +# -I3rd/ || exit 1 echo "" -echo "----------------------" -echo " compiling fullslime " -echo "----------------------" - -# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 +echo "------------------------------" +echo " compiling fullslime (debug) " +echo "------------------------------" time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \ - src/main.cpp -g -o ./bin/slime --std=c++17 \ + src/main.cpp -gfull -gdwarf -o ./bin/slime_d --std=c++17 \ -I3rd/ || exit 1 -# time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \ - # src/main.cpp -g -o ./bin/slime --std=c++17 \ - # -I3rd/ || exit 1 -pushd ./bin > /dev/null - -echo "" -echo "----------------------" -echo " generating docs " -echo "----------------------" -time valgrind -q ./slime dd || exit 1 +# echo "" +# echo "--------------------------------" +# echo " compiling fullslime (release) " +# echo "--------------------------------" +# time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \ +# src/main.cpp -g -o ./bin/slime --std=c++17 \ +# -I3rd/ || exit 1 + +# pushd ./bin > /dev/null + +# echo "" +# echo "----------------------" +# echo " generating docs " +# echo "----------------------" +# time valgrind -q ./slime_d --generate-docs || exit 1 + +# echo "" +# echo "----------------------" +# echo " running tests " +# echo "----------------------" +# time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1 + +# echo "" +# echo "------------------------" +# echo " running benches " +# echo "------------------------" +# hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null" -echo "" -echo "----------------------" -echo " running tests " -echo "----------------------" - -time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests - -popd > /dev/null popd > /dev/null +# popd > /dev/null unset TIMEFORMAT diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 6e9e950..5252732 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -1,11 +1,4 @@ namespace Slime { - inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { - Lisp_Object* begin_symbol = Memory::get_symbol("begin"); - if (body->value.pair.rest == Memory::nil) - return body->value.pair.first; - else - return Memory::create_lisp_object_pair(begin_symbol, body); - } proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { if (n1 == n2) @@ -45,7 +38,7 @@ namespace Slime { load_path.append((void*)path); } - + proc built_in_load(String* file_name) -> Lisp_Object* { profile_with_comment(&file_name->data); char* file_content; diff --git a/src/eval.cpp b/src/eval.cpp index 1343e51..fe453ec 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -1,4 +1,246 @@ namespace Slime { + + proc create_extended_environment_for_function_application_nrc( + Array_List cs, + Lisp_Object* function, + int arg_start, + int arg_count) -> Environment* + { + profile_this(); + + bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; + Environment* new_env; + Arguments* arg_spec; + + // NOTE(Felix): Step 1. + // - setting the parent environment + // - setting the arg_spec + // - potentially evaluating the arguments + if (is_c_function) { + new_env = Memory::create_child_environment(get_root_environment()); + arg_spec = &function->value.cFunction->args; + } else { + new_env = Memory::create_child_environment(function->value.function->parent_environment); + arg_spec = &function->value.function->args; + } + + if (arg_count == 0) { + return new_env; + } + + // NOTE(Felix): Even though we will return the environment at the + // end, for defining symbols here for the parameters, it has to be + // on the envi stack. + push_environment(new_env); + defer { + pop_environment(); + }; + + // NOTE(Felix): Step 2. + // Reading the argument spec and fill in the environment + // for the function call + + Lisp_Object* sym, *val; // used as temp storage to use `try` + Array_List read_in_keywords; + int obligatory_keywords_count = 0; + int read_obligatory_keywords_count = 0; + + Lisp_Object* next_arg = cs.data[arg_start]; + + proc read_positional_args = [&] { + for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { + if (arg_count == 0) { + create_parsing_error("Wrong number of arguments."); + return; + } + // NOTE(Felix): We have to copy all the arguments, + // otherwise we change the program code. + // XXX(Felix): T C functions we pass by reference. + // TODO(Felix): Why did we decide this?? + sym = arg_spec->positional.symbols.data[i]; + if (is_c_function) { + define_symbol(sym, next_arg); + } else { + define_symbol( + sym, + Memory::copy_lisp_object_except_pairs(next_arg)); + } + next_arg = cs[++arg_start]; + --arg_count; + } + }; + + proc read_keyword_args = [&] { + // keyword arguments: use all given ones and keep track of the + // added ones (array list), if end of parameters in encountered or + // something that is not a keyword is encountered or a keyword + // that is not recognized is encoutered, jump out of the loop. + + if (arg_count == 0) { + return; + } + + // find out how many keyword args we /have/ to read + for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { + if (arg_spec->keyword.values.data[i] == nullptr) + ++obligatory_keywords_count; + else + break; + } + + while (Memory::get_type(next_arg) == Lisp_Object_Type::Keyword) { + // check if this one is even an accepted keyword + bool accepted = false; + for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { + if (next_arg == arg_spec->keyword.keywords.data[i]) + { + accepted = true; + break; + } + } + if (!accepted) { + // NOTE(Felix): if we are actually done with all the + // necessary keywords then we have to count the rest + // as :rest here, instead od always creating an error + // (special case with default variables) + if (read_obligatory_keywords_count == obligatory_keywords_count) + return; + create_generic_error( + "The function does not take the keyword argument ':%s'\n" + "and not all required keyword arguments have been read\n" + "in to potentially count it as the rest argument.", + &(next_arg->value.symbol->data)); + return; + } + + // check if it was already read in + for (int i = 0; i < read_in_keywords.next_index; ++i) { + if (next_arg == read_in_keywords.data[i]) + { + // NOTE(Felix): if we are actually done with all the + // necessary keywords then we have to count the rest + // as :rest here, instead od always creating an error + // (special case with default variables) + if (read_obligatory_keywords_count == obligatory_keywords_count) + return; + create_generic_error( + "The function already read the keyword argument ':%s'", + &(next_arg->value.symbol->data)); + return; + } + } + + // okay so we found a keyword that has to be read in and was + // not already read in, is there a next element to actually + // set it to? + if (arg_count == 0) { + create_generic_error( + "Attempting to set the keyword argument ':%s', but no value was supplied.", + &(next_arg->value.symbol->data)); + return; + } + + // if not set it and then add it to the array list + try_void sym = Memory::get_symbol(next_arg->value.symbol); + next_arg = cs[++arg_start]; + --arg_count; + // NOTE(Felix): It seems we do not need to evaluate the argument here... + if (is_c_function) { + try_void define_symbol(sym, next_arg); + } else { + try_void define_symbol( + sym, + Memory::copy_lisp_object_except_pairs(next_arg)); + } + + read_in_keywords.append(next_arg); + ++read_obligatory_keywords_count; + + // overstep both for next one + next_arg = cs[++arg_start]; + --arg_count; + + if (arg_count == 0) { + break; + } + } + }; + + proc check_keyword_args = [&]() -> void { + // check if all necessary keywords have been read in + for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { + auto defined_keyword = arg_spec->keyword.keywords.data[i]; + bool was_set = false; + for (int j = 0; j < read_in_keywords.next_index; ++j) { + if (read_in_keywords.data[j] == defined_keyword) { + was_set = true; + break; + } + } + if (arg_spec->keyword.values.data[i] == nullptr) { + // if this one does not have a default value + if (!was_set) { + create_generic_error( + "There was no value supplied for the required " + "keyword argument ':%s'.", + &defined_keyword->value.symbol->data); + return; + } + } else { + // this one does have a default value, lets see if we have + // to use it or if the user supplied his own + if (!was_set) { + try_void sym = Memory::get_symbol(defined_keyword->value.symbol); + if (is_c_function) { + try_void val = arg_spec->keyword.values.data[i]; + } else { + try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]); + } + define_symbol(sym, val); + } + } + } + }; + + proc read_rest_arg = [&]() -> void { + if (arg_count == 0) { + if (arg_spec->rest) { + define_symbol(arg_spec->rest, Memory::nil); + } + } else { + if (arg_spec->rest) { + + Lisp_Object* list; + try_void list = Memory::create_list(next_arg); + Lisp_Object* head = list; + next_arg = cs[++arg_start]; + --arg_count; + while (arg_count > 0) { + try_void head->value.pair.rest = Memory::create_list(next_arg); + head = head->value.pair.rest; + next_arg = cs[++arg_start]; + --arg_count; + } + define_symbol(arg_spec->rest, list); + } else { + // rest was not declared but additional arguments were found + create_generic_error( + "A rest argument was not declared " + "but the function was called with additional arguments."); + return; + } + } + }; + + try read_positional_args(); + try read_keyword_args(); + try check_keyword_args(); + try read_rest_arg(); + + // TODO(Felix): fucking destructors + cs.data = nullptr; + return new_env; + } proc create_extended_environment_for_function_application( Lisp_Object* unevaluated_arguments, Lisp_Object* function, @@ -246,13 +488,12 @@ namespace Slime { return result; } -/** - This parses the argument specification of funcitons into their - Function struct. It does this by allocating new - positional_arguments, keyword_arguments and rest_argument and - filling it in -*/ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { + /* NOTE This parses the argument specification of funcitons + * into their Function struct. It does this by allocating new + * positional_arguments, keyword_arguments and rest_argument + * and filling it in + */ Arguments* result; if (Memory::get_type(function) == Lisp_Object_Type::CFunction) { result = &function->value.cFunction->args; @@ -393,6 +634,280 @@ namespace Slime { return evaluated_arguments; } + proc pause() { + printf("\n-----------------------\n" + "Press ENTER to continue\n"); + getchar(); + } + inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { + Lisp_Object* begin_symbol = Memory::get_symbol("begin"); + if (body->value.pair.rest == Memory::nil) + return body->value.pair.first; + else + return Memory::create_lisp_object_pair(begin_symbol, body); + } + + proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* { + enum struct Action { + Eval, + Step, + TM, + Pop, + If, + Define_Var, + Pop_Environment + }; + + Array_List cs; + Array_List pcs; + Array_List nas; + Array_List ams; + + proc debug_step = [&] { + printf("cs:\n "); + for (auto lo : cs) { + print(lo, true); + printf("\n "); + } + printf("\npcs:\n "); + for (auto lo : pcs) { + print(lo, true); + printf("\n "); + } + printf("\nnas:\n "); + for (auto na : nas) { + printf("%s\n ", [&] + { + switch(na) { + case Action::Pop_Environment: return "Pop_Environment"; + case Action::Define_Var: return "Define_Var"; + case Action::Eval: return "Eval"; + case Action::Step: return "Step"; + case Action::TM: return "TM"; + case Action::Pop: return "Pop"; + case Action::If: return "If"; + } + }()); + } + printf("\nams:\n "); + for (auto am : ams) { + printf("%d\n ", am); + } + pause(); + }; + + proc handle_if = [&] { + /* | | | | + | | -> | | + | | | | + | .... | | ...... | */ + --ams.next_index; + Lisp_Object* args = pcs.data[--pcs.next_index]; + Lisp_Object* test = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Pair); + Lisp_Object* consequence = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Pair); + Lisp_Object* alternative = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Nil); + --cs.next_index; + cs.append(alternative); + cs.append(consequence); + cs.append(test); + nas.append(Action::Eval); + nas.append(Action::If); + nas.append(Action::Eval); + }; + + proc handle_define = [&] { + --cs.next_index; + --ams.next_index; + Lisp_Object* form = pcs.data[--pcs.next_index]; + Lisp_Object* definee = form->value.pair.first; + form = form->value.pair.rest; + try_void assert_type(form, Lisp_Object_Type::Pair); + Lisp_Object* thing = form->value.pair.first; + Lisp_Object* thing_cons = form; + form = form->value.pair.rest; + Lisp_Object_Type type = Memory::get_type(definee); + switch (type) { + case Lisp_Object_Type::Symbol: { + // BUG(Felix): Defining with doc string crashes + if (form != Memory::nil) { + Lisp_Object* doc = thing; + try_void assert_type(doc, Lisp_Object_Type::String); + try_void assert_type(form, Lisp_Object_Type::Pair); + form = form->value.pair.rest; + thing = form->value.pair.first; + try_void assert(form->value.pair.rest == Memory::nil); + // TODO docs + } + cs.append(definee); + cs.append(thing); + nas.append(Action::Define_Var); + nas.append(Action::Eval); + } break; + case Lisp_Object_Type::Pair: { + fflush(stdout); + try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); + Lisp_Object* func; + try_void func = Memory::create_lisp_object_function(Function_Type::Lambda); + func->value.function->parent_environment = get_current_environment(); + create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); + func->value.function->body = maybe_wrap_body_in_begin(thing_cons); + define_symbol(definee->value.pair.first, func); + cs.append(Memory::t); + } break; + default: { + create_generic_error("you can only define symbols"); + return; + } + } + }; + + proc handle_begin = [&] { + --cs.next_index; + --ams.next_index; + Lisp_Object* args = pcs[--pcs.next_index]; + int length = list_length(args); + cs.reserve(length); + printf("aaaaaa\n\n"); + for_lisp_list(args) { + cs.data[cs.next_index - 1 + (length - it_index)] = it; + nas.append(Action::Eval); + nas.append(Action::Pop); + } + + --nas.next_index; + cs.next_index += length; + }; + + cs.append(expr); + nas.append(Action::Eval); + + Action current_action; + Lisp_Object* pc; + while (nas.next_index > 0) { + debug_step(); + + current_action = nas.data[--nas.next_index]; + switch (current_action) { + case Action::Pop: { + --cs.next_index; + } break; + case Action::Pop_Environment: { + pop_environment(); + } break; + case Action::Eval: { + pc = cs.data[cs.next_index-1]; + Lisp_Object_Type type = Memory::get_type(pc); + switch (type) { + case Lisp_Object_Type::Symbol: { + cs.data[cs.next_index-1] = lookup_symbol(pc, get_current_environment()); + } break; + case Lisp_Object_Type::Pair: { + cs.data[cs.next_index-1] = pc->value.pair.first; + ams.append(cs.next_index-1); + pcs.append(pc->value.pair.rest); + nas.append(Action::TM); + nas.append(Action::Eval); + } break; + default: { + // NOTE(Felix): others are self evaluating + // so do nothing + } + } + } break; + case Action::TM: { + pc = cs.data[cs.next_index-1]; + + Lisp_Object_Type type = Memory::get_type(pc); + switch (type) { + case Lisp_Object_Type::CFunction: { + if (pc->value.cFunction->is_special_form) { + if (pc == Memory::_if) try handle_if(); + else if (pc == Memory::_begin) try handle_begin(); + else if (pc == Memory::_define) try handle_define(); + else { + // push_pc_on_cs(); + } + } else { + nas.append(Action::Step); + } + } break; + case Lisp_Object_Type::Function: { + if (pc->value.function->type == Function_Type::Macro) { + // push_pc_on_cs(); + } else { + nas.append(Action::Step); + } + } break; + default: { + create_generic_error("The first element of the pair was not a function but: %s", + Lisp_Object_Type_to_string(type)); + return nullptr; + } + } + + } break; + case Action::Step: { + if (pcs.data[pcs.next_index-1] == Memory::nil) { + --pcs.next_index; + int am = ams.data[--ams.next_index]; + Lisp_Object* function = cs.data[am]; + Lisp_Object_Type type = Memory::get_type(function); + Environment* extended_env = + create_extended_environment_for_function_application_nrc( + cs, function, am+1, cs.next_index-am-1); + cs.next_index = am; + push_environment(extended_env); + if (type == Lisp_Object_Type::CFunction) { + try cs.append(function->value.cFunction->body()); + pop_environment(); + } else { + nas.append(Action::Pop_Environment); + nas.append(Action::Eval); + cs.append(function->value.function->body); + } + } else { + cs.append(pcs.data[pcs.next_index-1]->value.pair.first); + pcs.data[pcs.next_index-1] = pcs.data[pcs.next_index-1]->value.pair.rest; + nas.append(Action::Step); + nas.append(Action::Eval); + } + } break; + case Action::If: { + /* | | + | | + | | + | .... | */ + cs.next_index -= 2; + // NOTE(Felix): for false it is sufficent to pop 2 for + // true we have to copy the then part to the new top + // of the stack + if (cs.data[cs.next_index+1] != Memory::nil) { + cs.data[cs.next_index-1] = cs.data[cs.next_index]; + } + } break; + case Action::Define_Var: { + /* | | + | | + | .... | */ + cs.next_index -= 1; + try assert_type(cs.data[cs.next_index-1], Lisp_Object_Type::Symbol); + try define_symbol(cs.data[cs.next_index-1], cs.data[cs.next_index]); + cs.data[cs.next_index-1] = Memory::t; + } + } + + } + debug_step(); + + return cs.data[--cs.next_index]; + } + proc eval_expr(Lisp_Object* node) -> Lisp_Object* { profile_this(); @@ -403,14 +918,6 @@ namespace Slime { }; switch (Memory::get_type(node)) { - case Lisp_Object_Type::T: - case Lisp_Object_Type::Nil: - case Lisp_Object_Type::Number: - case Lisp_Object_Type::Keyword: - case Lisp_Object_Type::String: - case Lisp_Object_Type::Function: - case Lisp_Object_Type::CFunction: - return node; case Lisp_Object_Type::Symbol: { Lisp_Object* value; try value = lookup_symbol(node, get_current_environment()); @@ -471,11 +978,7 @@ namespace Slime { Lisp_Object_Type_to_string(Memory::get_type(lispOperator))); return nullptr; } - default: { - create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); - return nullptr; - } - + default: return node; } } @@ -506,14 +1009,14 @@ namespace Slime { Lisp_Object* parsed, * evaluated; while (true) { [&] { - delete_error(); + // delete_error(); fputs("> ", stdout); line = read_expression(); - defer { - free(line); - }; + // defer { + // free(line); + // }; try_void parsed = Parser::parse_single_expression(line); - try_void evaluated = eval_expr(parsed); + try_void evaluated = nrc_eval(parsed); if (evaluated != Memory::nil) { print(evaluated); fputs("\n", stdout); diff --git a/src/main.cpp b/src/main.cpp index d95e2cf..f37276c 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -2,21 +2,20 @@ int main(int argc, char* argv[]) { - if_windows { +#ifdef _MSC_VER // enable colored terminal output for windows HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); DWORD dwMode = 0; GetConsoleMode(hOut, &dwMode); dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING; SetConsoleMode(hOut, dwMode); - } +#endif if (argc > 1) { if (Slime::string_equal(argv[1], "--run-tests")) { int res = Slime::run_all_tests(); return res ? 0 : 1; - } - if (Slime::string_equal(argv[1], "--generate-docs")) { + } else if (Slime::string_equal(argv[1], "--generate-docs")) { Slime::Memory::init(4096 * 256* 100); if (Slime::Globals::error) return 1; Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime")); diff --git a/src/memory.cpp b/src/memory.cpp index 7f7f5f1..31aa960 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -32,8 +32,13 @@ namespace Slime::Memory { // ------------------ // immutables // ------------------ - Lisp_Object* nil = nullptr; - Lisp_Object* t = nullptr; + Lisp_Object* nil = nullptr; + Lisp_Object* t = nullptr; + Lisp_Object* _if = nullptr; + Lisp_Object* _define = nullptr; + Lisp_Object* _begin = nullptr; + + proc print_status() { // printf("Memory Status:\n" @@ -136,6 +141,8 @@ namespace Slime::Memory { environment_memory.for_each([](Environment* env){ env->~Environment(); }); + // free the exe dir: + free(Globals::load_path.data[0]); } @@ -190,6 +197,10 @@ namespace Slime::Memory { Environment* user_env; try_void user_env = Memory::create_child_environment(env); push_environment(user_env); + + try_void _if = lookup_symbol(get_symbol("if"), env); + try_void _define = lookup_symbol(get_symbol("define"), env); + try_void _begin = lookup_symbol(get_symbol("begin"), env); } proc reset() -> void { @@ -239,6 +250,10 @@ namespace Slime::Memory { Environment* user_env; try_void user_env = Memory::create_child_environment(env); push_environment(user_env); + + try_void _if = lookup_symbol(get_symbol("if"), env); + try_void _define = lookup_symbol(get_symbol("define"), env); + try_void _begin = lookup_symbol(get_symbol("begin"), env); } proc create_lisp_object(void* ptr) -> Lisp_Object* { diff --git a/src/testing.cpp b/src/testing.cpp index a0eb534..b7264aa 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -603,9 +603,11 @@ namespace Slime { bool result = true; try Memory::init(409600); - if_debug { - Slime::Memory::free_everything(); - } + defer { + if_debug { + Slime::Memory::free_everything(); + } + }; push_environment(Memory::create_child_environment( get_current_environment()));