| @@ -1 +1 @@ | |||
| Subproject commit abbd0b6280738332e195d5c37430feae1dbd0d5e | |||
| Subproject commit 3959dd2fc12eefbd4955fd20a1e4220562730508 | |||
| @@ -1,5 +1,8 @@ | |||
| (import "alist.slime") | |||
| (import "automata.slime") | |||
| (import "interpolation.slime") | |||
| (import "oo.slime") | |||
| (import "math.slime") | |||
| (import "sets.slime") | |||
| (generate-docs "../manual/built-in-docs.org") | |||
| @@ -1,4 +0,0 @@ | |||
| (define a 10) | |||
| (define (get-a-1) | |||
| a) | |||
| @@ -1,8 +0,0 @@ | |||
| (import "import1.slime") | |||
| (define (set-a-2 s) | |||
| (set! a s)) | |||
| (define (get-a-2) | |||
| a) | |||
| @@ -43,7 +43,3 @@ | |||
| (point-lerp (lerper1 t) | |||
| (lerper2 t) t)))) | |||
| ) | |||
| (define sl1 (interpolation::stepped-lerper 0 1 5)) | |||
| (define sl2 (interpolation::stepped-lerper 10 -10 20)) | |||
| @@ -19,17 +19,17 @@ echo "----------------------" | |||
| echo "" | |||
| # time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 | |||
| time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \ | |||
| src/main.cpp -g -o ./bin/slime --std=c++17 \ | |||
| -I3rd/ || exit 1 | |||
| # time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \ | |||
| # time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \ | |||
| # src/main.cpp -g -o ./bin/slime --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 | |||
| echo "" | |||
| pushd ./bin > /dev/null | |||
| time valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests | |||
| # time ./slime --run-tests | |||
| # time valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests | |||
| time ./slime --run-tests | |||
| popd > /dev/null | |||
| popd > /dev/null | |||
| @@ -945,11 +945,11 @@ embedded scripting language. | |||
| # end: | |||
| #+author: Felix Brendel | |||
| #+mail: felix.brendel@airmail.cc | |||
| #+mail: felixbrendel@airmail.cc | |||
| #+options: H:2 toc:nil | |||
| #+macro: slime_header (eval (concat "#+header: :cache yes :exports both" "\n" "#+attr_latex: :options keywordstyle=\\color{slimeKeyword}, commentstyle=\\color{slimeComment}, stringstyle=\\color{slimeString}")) | |||
| #+macro: ditaa_header (eval (concat "#+header: :exports results :cmdline --no-separation --no-shadows")) | |||
| #+macro: ditaa_header (eval (concat "#+header: :cache yes :exports results :cmdline --no-separation --no-shadows")) | |||
| #+latex_class:article | |||
| @@ -726,7 +726,7 @@ proc load_built_ins_into_environment() -> void { | |||
| fetch(hm, key); | |||
| try assert_type(hm, Lisp_Object_Type::HashMap); | |||
| Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap.get_object(key); | |||
| Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key); | |||
| if (!ret) | |||
| create_symbol_undefined_error("The key was not set in the hashmap"); | |||
| @@ -735,13 +735,13 @@ proc load_built_ins_into_environment() -> void { | |||
| define((hash-map-set! hm key value), "TODO") { | |||
| fetch(hm, key, value); | |||
| try assert_type(hm, Lisp_Object_Type::HashMap); | |||
| hm->value.hashMap.set_object(key, value); | |||
| hm->value.hashMap->set_object(key, value); | |||
| return Memory::nil; | |||
| }; | |||
| define((hash-map-delete! hm key), "TODO") { | |||
| fetch(hm, key); | |||
| try assert_type(hm, Lisp_Object_Type::HashMap); | |||
| hm->value.hashMap.delete_object(key); | |||
| hm->value.hashMap->delete_object(key); | |||
| return Memory::nil; | |||
| }; | |||
| define((vector . args), "TODO") { | |||
| @@ -862,17 +862,17 @@ proc load_built_ins_into_environment() -> void { | |||
| printf("Postitional: {"); | |||
| if (args->positional.symbols.next_index != 0) { | |||
| printf("%s", | |||
| Memory::get_c_str(args->positional.symbols.data[0]->value.symbol.identifier)); | |||
| Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | |||
| for (int i = 1; i < args->positional.symbols.next_index; ++i) { | |||
| printf(", %s", | |||
| Memory::get_c_str(args->positional.symbols.data[i]->value.symbol.identifier)); | |||
| Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | |||
| } | |||
| } | |||
| printf("}\n"); | |||
| printf("Keyword: {"); | |||
| if (args->keyword.values.next_index != 0) { | |||
| printf("%s", | |||
| Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol.identifier)); | |||
| Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); | |||
| if (args->keyword.values.data[0]) { | |||
| printf(" ("); | |||
| print(args->keyword.values.data[0], true); | |||
| @@ -880,7 +880,7 @@ proc load_built_ins_into_environment() -> void { | |||
| } | |||
| for (int i = 1; i < args->keyword.values.next_index; ++i) { | |||
| printf(", %s", | |||
| Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol.identifier)); | |||
| Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | |||
| if (args->keyword.values.data[i]) { | |||
| printf(" ("); | |||
| print(args->keyword.values.data[i], true); | |||
| @@ -892,7 +892,7 @@ proc load_built_ins_into_environment() -> void { | |||
| printf("Rest: {"); | |||
| if (args->rest) | |||
| printf("%s", | |||
| Memory::get_c_str(args->rest->value.symbol.identifier)); | |||
| Memory::get_c_str(args->rest->value.symbol)); | |||
| printf("}\n"); | |||
| } | |||
| @@ -918,7 +918,9 @@ proc load_built_ins_into_environment() -> void { | |||
| define((generate-docs file_name), "TODO") { | |||
| fetch(file_name); | |||
| try assert_type(file_name, Lisp_Object_Type::String); | |||
| // try generate_docs(file_name->value.string); | |||
| in_caller_env { | |||
| try generate_docs(file_name->value.string); | |||
| } | |||
| return Memory::t; | |||
| }; | |||
| define((print (:sep " ") (:end "\n") . things), "TODO") { | |||
| @@ -1025,7 +1027,7 @@ proc load_built_ins_into_environment() -> void { | |||
| define((symbol->keyword sym), "TODO") { | |||
| fetch(sym); | |||
| try assert_type(sym, Lisp_Object_Type::Symbol); | |||
| return Memory::get_or_create_lisp_object_keyword(sym->value.symbol.identifier); | |||
| return Memory::get_or_create_lisp_object_keyword(sym->value.symbol); | |||
| }; | |||
| define((string->symbol str), "TODO") { | |||
| fetch(str); | |||
| @@ -1041,7 +1043,7 @@ proc load_built_ins_into_environment() -> void { | |||
| try assert_type(sym, Lisp_Object_Type::Symbol); | |||
| return Memory::create_lisp_object_string( | |||
| Memory::duplicate_string(sym->value.symbol.identifier)); | |||
| Memory::duplicate_string(sym->value.symbol)); | |||
| }; | |||
| define((concat-strings . strings), "TODO") { | |||
| fetch(strings); | |||
| @@ -5,7 +5,7 @@ | |||
| do { \ | |||
| if (Globals::log_level == Log_Level::Debug) { \ | |||
| printf("in"); \ | |||
| int spacing = 30-(int)strlen(__FILE__); \ | |||
| int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\ | |||
| if (spacing < 1) spacing = 1; \ | |||
| for (int i = 0; i < spacing;++i) \ | |||
| printf(" "); \ | |||
| @@ -14,11 +14,11 @@ | |||
| } \ | |||
| } while(0) | |||
| #define if_error_log_location_and_return() \ | |||
| #define if_error_log_location_and_return(val) \ | |||
| do { \ | |||
| if (Globals::error) { \ | |||
| log_location(); \ | |||
| return; \ | |||
| return val; \ | |||
| } \ | |||
| } while(0) | |||
| @@ -51,7 +51,7 @@ | |||
| #define fetch1(var) \ | |||
| Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \ | |||
| Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ | |||
| if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__) | |||
| if_error_log_location_and_return(nullptr) | |||
| #define fetch2(var1, var2) fetch1(var1); fetch1(var2) | |||
| #define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) | |||
| @@ -1,157 +1,146 @@ | |||
| // proc generate_docs(String* path) -> void { | |||
| // FILE *f = fopen(Memory::get_c_str(path), "w"); | |||
| // if (!f) { | |||
| // create_generic_error("The file for writing the documentation (%s) " | |||
| // "could not be opened for writing.", Memory::get_c_str(path)); | |||
| // return; | |||
| // } | |||
| // defer { | |||
| // fclose(f); | |||
| // }; | |||
| proc generate_docs(String* path) -> void { | |||
| FILE *f = fopen(Memory::get_c_str(path), "w"); | |||
| if (!f) { | |||
| create_generic_error("The file for writing the documentation (%s) " | |||
| "could not be opened for writing.", Memory::get_c_str(path)); | |||
| return; | |||
| } | |||
| defer { | |||
| fclose(f); | |||
| }; | |||
| // Environment_Array_List visited = create_Environment_array_list(); | |||
| Array_List<Environment*> visited; | |||
| // // recursive inner funciton | |||
| // std::function<void(Environment*, char* prefix)> print_this_env; | |||
| // print_this_env = [&](Environment* env, char* prefix) -> void { | |||
| // bool we_already_printed = false; | |||
| // // TODO(Felix): Make a generic array_list_contains function | |||
| // for_array_list(visited) { | |||
| // if (it == env) { | |||
| // we_already_printed = true; | |||
| // break; | |||
| // } | |||
| // } | |||
| // if (!we_already_printed) { | |||
| // printf("Working ion env::::"); | |||
| // print_environment(env); | |||
| // printf("\n--------------------------------\n"); | |||
| // append_to_array_list(&visited, env); | |||
| const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void { | |||
| bool we_already_printed = false; | |||
| // TODO(Felix): Make a generic array_list_contains function | |||
| for(auto it : visited) { | |||
| if (it == env) { | |||
| we_already_printed = true; | |||
| break; | |||
| } | |||
| } | |||
| if (!we_already_printed) { | |||
| // printf("Working on env::::"); | |||
| // print_environment(env); | |||
| // printf("\n--------------------------------\n"); | |||
| visited.append(env); | |||
| // push_environment(env); | |||
| // defer { | |||
| // pop_environment(); | |||
| // }; | |||
| push_environment(env); | |||
| defer { | |||
| pop_environment(); | |||
| }; | |||
| // for (int i = 0; i < env->next_index; ++i) { | |||
| // fprintf(f, "\\hrule\n* =%s%s= \n" | |||
| // // " :PROPERTIES:\n" | |||
| // // " :UNNUMBERED: t\n" | |||
| // // " :END:" | |||
| // ,prefix, env->keys[i]); | |||
| // /* | |||
| // * sourcecodeLocation | |||
| // */ | |||
| // if (env->values[i]->sourceCodeLocation) { | |||
| // try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", | |||
| // Memory::get_c_str(env->values[i]->sourceCodeLocation->file), | |||
| // env->values[i]->sourceCodeLocation->line, | |||
| // env->values[i]->sourceCodeLocation->column); | |||
| // } | |||
| // /* | |||
| // * type | |||
| // */ | |||
| // Lisp_Object_Type type = Memory::get_type(env->values[i]); | |||
| // Lisp_Object* LOtype; | |||
| // try_void LOtype = eval_expr(Memory::create_list( | |||
| // Memory::get_or_create_lisp_object_symbol("type"), | |||
| // env->values[i])); | |||
| for_hash_map(env->hm) { | |||
| try_void fprintf(f, | |||
| "#+latex: \\hrule\n" | |||
| "#+html: <hr/>\n" | |||
| "* =%s%s= \n" | |||
| " :PROPERTIES:\n" | |||
| " :UNNUMBERED: t\n" | |||
| " :END:" | |||
| ,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol)); | |||
| /* | |||
| * sourcecodeLocation | |||
| */ | |||
| if (value->sourceCodeLocation) { | |||
| try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", | |||
| Memory::get_c_str(value->sourceCodeLocation->file), | |||
| value->sourceCodeLocation->line, | |||
| value->sourceCodeLocation->column); | |||
| } | |||
| /* | |||
| * type | |||
| */ | |||
| Lisp_Object_Type type = Memory::get_type(value); | |||
| Lisp_Object* LOtype; | |||
| Lisp_Object* type_expr = Memory::create_list( | |||
| Memory::get_or_create_lisp_object_symbol("type"), | |||
| value); | |||
| try_void LOtype = eval_expr(type_expr); | |||
| // fprintf(f, "\n - type :: ="); | |||
| // print(LOtype, true, f); | |||
| // fprintf(f, "="); | |||
| fprintf(f, "\n - type :: ="); | |||
| print(LOtype, true, f); | |||
| fprintf(f, "="); | |||
| // /* | |||
| // * if printable value -> print it | |||
| // */ | |||
| // switch (type) { | |||
| // case(Lisp_Object_Type::Nil): | |||
| // case(Lisp_Object_Type::T): | |||
| // case(Lisp_Object_Type::Number): | |||
| // case(Lisp_Object_Type::String): | |||
| // case(Lisp_Object_Type::Pair): | |||
| // case(Lisp_Object_Type::Symbol): | |||
| // case(Lisp_Object_Type::Keyword): { | |||
| // fprintf(f, "\n - value :: ="); | |||
| // print(env->values[i], true, f); | |||
| // fprintf(f, "="); | |||
| // } break; | |||
| // default: break; | |||
| // } | |||
| // /* | |||
| // * if function then print arguments | |||
| // */ | |||
| // if (type == Lisp_Object_Type::Function) { | |||
| // Lisp_Object* fun = env->values[i]; | |||
| // bool printed_at_least_some_args = false; | |||
| // fprintf(f, "\n - arguments :: "); | |||
| // if (fun->value.function.args.positional.symbols.next_index != 0) { | |||
| // if (!printed_at_least_some_args) | |||
| // fprintf(f, ":"); | |||
| // fprintf(f, "\n - postitional :: "); | |||
| // try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier)); | |||
| // for (int i = 1; i < fun->value.function.args.positional.symbols.next_index; ++i) { | |||
| // fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[i]->value.symbol.identifier)); | |||
| // } | |||
| // } | |||
| // if (fun->value.function.args.keyword.values.next_index != 0) { | |||
| // if (!printed_at_least_some_args) | |||
| // fprintf(f, ":"); | |||
| // fprintf(f, "\n - keyword :: "); | |||
| // fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier)); | |||
| // if (fun->value.function.args.keyword.values.data[0]) { | |||
| // fprintf(f, " =("); | |||
| // print(fun->value.function.args.keyword.values.data[0], true, f); | |||
| // fprintf(f, ")="); | |||
| // } | |||
| // for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) { | |||
| // fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[i]->value.symbol.identifier)); | |||
| // if (fun->value.function.args.keyword.values.data[i]) { | |||
| // fprintf(f, " =("); | |||
| // print(fun->value.function.args.keyword.values.data[i], true, f); | |||
| // fprintf(f, ")="); | |||
| // } | |||
| // } | |||
| // } | |||
| // if (fun->value.function.args.rest) { | |||
| // if (!printed_at_least_some_args) | |||
| // fprintf(f, ":"); | |||
| // fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier)); | |||
| // } | |||
| // // if no args at all | |||
| // if (fun->value.function.args.positional.symbols.next_index == 0 && | |||
| // fun->value.function.args.keyword.values.next_index == 0 && | |||
| // !fun->value.function.args.rest) | |||
| // { | |||
| // fprintf(f, "none."); | |||
| // } | |||
| // } | |||
| // fprintf(f, "\n - docu :: "); | |||
| // if (env->values[i]->docstring) | |||
| // fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", | |||
| // Memory::get_c_str(env->values[i]->docstring)); | |||
| // else | |||
| // fprintf(f, "none\n"); | |||
| /* | |||
| * if printable value -> print it | |||
| */ | |||
| switch (type) { | |||
| case(Lisp_Object_Type::Nil): | |||
| case(Lisp_Object_Type::T): | |||
| case(Lisp_Object_Type::Number): | |||
| case(Lisp_Object_Type::String): | |||
| case(Lisp_Object_Type::Pair): | |||
| case(Lisp_Object_Type::Symbol): | |||
| case(Lisp_Object_Type::Keyword): { | |||
| fprintf(f, "\n - value :: ="); | |||
| print(value, true, f); | |||
| fprintf(f, "="); | |||
| } break; | |||
| default: break; | |||
| } | |||
| /* | |||
| * if function then print arguments | |||
| */ | |||
| if (type == Lisp_Object_Type::Function || | |||
| type == Lisp_Object_Type::CFunction) | |||
| { | |||
| Arguments* args = | |||
| (type == Lisp_Object_Type::Function) | |||
| ? &value->value.function->args | |||
| : &value->value.cFunction->args; | |||
| fprintf(f, "\n - arguments :: "); | |||
| // if no args at all | |||
| if (args->positional.symbols.next_index == 0 && | |||
| args->keyword.values.next_index == 0 && | |||
| !args->rest) | |||
| { | |||
| fprintf(f, "none."); | |||
| } else { | |||
| if (args->positional.symbols.next_index != 0) { | |||
| fprintf(f, "\n - postitional :: "); | |||
| fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | |||
| for (int i = 1; i < args->positional.symbols.next_index; ++i) { | |||
| fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | |||
| } | |||
| } | |||
| if (args->keyword.values.next_index != 0) { | |||
| fprintf(f, "\n - keyword :: "); | |||
| fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); | |||
| if (args->keyword.values.data[0]) { | |||
| fprintf(f, " =("); | |||
| print(args->keyword.values.data[0], true, f); | |||
| fprintf(f, ")="); | |||
| } | |||
| for (int i = 1; i < args->keyword.values.next_index; ++i) { | |||
| fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | |||
| if (args->keyword.values.data[i]) { | |||
| fprintf(f, " =("); | |||
| print(args->keyword.values.data[i], true, f); | |||
| fprintf(f, ")="); | |||
| } | |||
| } | |||
| } | |||
| if (args->rest) { | |||
| fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); | |||
| } | |||
| } | |||
| } | |||
| fprintf(f, "\n - docu :: "); | |||
| if (value->docstring) | |||
| fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", | |||
| Memory::get_c_str(value->docstring)); | |||
| else | |||
| fprintf(f, "none\n"); | |||
| } | |||
| } | |||
| // // if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function && | |||
| // // env->values[i]->userType && | |||
| // // (string_equal(env->values[i]->userType->value.symbol.identifier, "package") || | |||
| // // string_equal(env->values[i]->userType->value.symbol.identifier, "constructor"))) | |||
| // // { | |||
| // // char new_prefix[200]; | |||
| // // strcpy(new_prefix, prefix); | |||
| // // strcat(new_prefix, env->keys[i]); | |||
| // // strcat(new_prefix, " "); | |||
| // // print_this_env(env->values[i]->value.function.parent_environment, new_prefix); | |||
| // // } | |||
| // } | |||
| // } | |||
| for (int i = 0; i < env->parents.next_index; ++i) { | |||
| try_void rec(rec, env->parents.data[i], prefix); | |||
| } | |||
| }; | |||
| // for (int i = 0; i < env->parents.next_index; ++i) { | |||
| // print_this_env(env->parents.data[i], prefix); | |||
| // } | |||
| // }; | |||
| // print_this_env(get_current_environment(), (char*)""); | |||
| // } | |||
| print_this_env(print_this_env, get_current_environment(), (char*)""); | |||
| } | |||
| @@ -77,7 +77,7 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||
| if (result) | |||
| return result; | |||
| String* identifier = node->value.symbol.identifier; | |||
| String* identifier = node->value.symbol; | |||
| print_environment(env); | |||
| printf("\n"); | |||
| create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); | |||
| @@ -91,7 +91,7 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||
| printf(" "); | |||
| } | |||
| }; | |||
| if(env == get_root_environment()) { | |||
| print_indent(indent); | |||
| printf("[built-ins]-Environment (%lld)\n", (long long)env); | |||
| @@ -100,7 +100,7 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||
| for_hash_map (env->hm) { | |||
| print_indent(indent); | |||
| printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol.identifier->data)); | |||
| printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data)); | |||
| print((Lisp_Object*)value); | |||
| printf(" (0x%016llx)", (unsigned long long)value); | |||
| puts(""); | |||
| @@ -11,17 +11,16 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li | |||
| debug_break(); | |||
| } | |||
| if (Globals::log_level > Log_Level::None) { | |||
| // pretty error sign | |||
| for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) | |||
| printf("-"); | |||
| printf("\n Error - %s\n", Memory::get_c_str(message)); | |||
| for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) | |||
| printf("-"); | |||
| using Globals::error; | |||
| error = (Error*)malloc(sizeof(Error)) ; | |||
| error->type = type; | |||
| error->message = message; | |||
| log_error(); | |||
| if (Globals::log_level > Log_Level::None) { | |||
| // c error location | |||
| printf("\nin"); | |||
| int spacing = 30-((int)strlen(c_file_name) - (int)log10(c_file_line)); | |||
| printf("in"); | |||
| int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line)); | |||
| if (spacing < 1) spacing = 1; | |||
| for (int i = 0; i < spacing; ++i) | |||
| printf(" "); | |||
| @@ -30,10 +29,6 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li | |||
| } | |||
| // visualize_lisp_machine(); | |||
| using Globals::error; | |||
| error = (Error*)malloc(sizeof(Error)) ; | |||
| error->type = type; | |||
| error->message = message; | |||
| } | |||
| proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { | |||
| @@ -103,7 +103,7 @@ proc create_extended_environment_for_function_application( | |||
| "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.", | |||
| &(arguments->value.pair.first->value.symbol.identifier->data)); | |||
| &(arguments->value.pair.first->value.symbol->data)); | |||
| return; | |||
| } | |||
| @@ -119,7 +119,7 @@ proc create_extended_environment_for_function_application( | |||
| return; | |||
| create_generic_error( | |||
| "The function already read the keyword argument ':%s'", | |||
| &(arguments->value.pair.first->value.symbol.identifier->data)); | |||
| &(arguments->value.pair.first->value.symbol->data)); | |||
| return; | |||
| } | |||
| } | |||
| @@ -130,12 +130,12 @@ proc create_extended_environment_for_function_application( | |||
| if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { | |||
| create_generic_error( | |||
| "Attempting to set the keyword argument ':%s', but no value was supplied.", | |||
| &(arguments->value.pair.first->value.symbol.identifier->data)); | |||
| &(arguments->value.pair.first->value.symbol->data)); | |||
| return; | |||
| } | |||
| // if not set it and then add it to the array list | |||
| try_void sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier); | |||
| try_void sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol); | |||
| // NOTE(Felix): It seems we do not need to evaluate the argument here... | |||
| if (is_c_function) { | |||
| try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); | |||
| @@ -176,14 +176,14 @@ proc create_extended_environment_for_function_application( | |||
| create_generic_error( | |||
| "There was no value supplied for the required " | |||
| "keyword argument ':%s'.", | |||
| &defined_keyword->value.symbol.identifier->data); | |||
| &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_or_create_lisp_object_symbol(defined_keyword->value.symbol.identifier); | |||
| try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword->value.symbol); | |||
| if (is_c_function) { | |||
| try_void val = arg_spec->keyword.values.data[i]; | |||
| } else { | |||
| @@ -398,12 +398,7 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* { | |||
| using namespace Globals::Current_Execution; | |||
| call_stack.append(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; | |||
| --call_stack.next_index; | |||
| }; | |||
| switch (Memory::get_type(node)) { | |||
| @@ -492,37 +487,16 @@ proc is_truthy(Lisp_Object* expression) -> bool { | |||
| proc interprete_file (char* file_name) -> Lisp_Object* { | |||
| try Memory::init(4096 * 256); | |||
| Environment* root_env = get_root_environment(); | |||
| Environment* user_env; | |||
| try user_env = Memory::create_child_environment(root_env); | |||
| push_environment(user_env); | |||
| defer { | |||
| pop_environment(); | |||
| }; | |||
| Lisp_Object* result = built_in_load(Memory::create_string(file_name)); | |||
| Lisp_Object* result; | |||
| try result = built_in_load(Memory::create_string(file_name)); | |||
| if (Globals::error) { | |||
| log_error(); | |||
| delete_error(); | |||
| return nullptr; | |||
| } | |||
| return result; | |||
| } | |||
| proc interprete_stdin() -> void { | |||
| try_void Memory::init(4096 * 256* 100); | |||
| 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(); | |||
| return; | |||
| } | |||
| printf("Welcome to the lispy interpreter.\n"); | |||
| @@ -530,27 +504,19 @@ proc interprete_stdin() -> void { | |||
| Lisp_Object* parsed, * evaluated; | |||
| while (true) { | |||
| printf("> "); | |||
| line = read_expression(); | |||
| defer { | |||
| free(line); | |||
| }; | |||
| parsed = Parser::parse_single_expression(line); | |||
| if (Globals::error) { | |||
| log_error(); | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| evaluated = eval_expr(parsed); | |||
| if (Globals::error) { | |||
| log_error(); | |||
| [&] { | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| if (evaluated != Memory::nil) { | |||
| print(evaluated); | |||
| printf("\n"); | |||
| } | |||
| fputs("> ", stdout); | |||
| line = read_expression(); | |||
| defer { | |||
| free(line); | |||
| }; | |||
| try_void parsed = Parser::parse_single_expression(line); | |||
| try_void evaluated = eval_expr(parsed); | |||
| if (evaluated != Memory::nil) { | |||
| print(evaluated); | |||
| fputs("\n", stdout); | |||
| } | |||
| }(); | |||
| } | |||
| } | |||
| @@ -29,6 +29,7 @@ const char* Lisp_Object_Type_to_string(Lisp_Object_Type type); | |||
| void visualize_lisp_machine(); | |||
| void generate_docs(String* path); | |||
| void log_error(); | |||
| namespace Memory { | |||
| Environment* create_built_ins_environment(); | |||
| @@ -311,12 +311,12 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { | |||
| fprintf(file, "%f", node->value.number); | |||
| } 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::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break; | |||
| case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break; | |||
| case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break; | |||
| case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break; | |||
| case (Lisp_Object_Type::HashMap): { | |||
| for_hash_map (node->value.hashMap) { | |||
| for_hash_map (*(node->value.hashMap)) { | |||
| fputs(" ", file); | |||
| print(key, true, file); | |||
| fputs(" -> ", file); | |||
| @@ -347,7 +347,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { | |||
| } break; | |||
| case (Lisp_Object_Type::Function): { | |||
| if (node->userType) { | |||
| fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier)); | |||
| fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol)); | |||
| break; | |||
| } | |||
| if (node->value.function->type == Function_Type::Lambda) | |||
| @@ -365,7 +365,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { | |||
| // first check if it is a quotation form, in that case we want | |||
| // to print it prettier | |||
| if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { | |||
| String* identifier = head->value.pair.first->value.symbol.identifier; | |||
| String* identifier = head->value.pair.first->value.symbol; | |||
| auto symbol = head->value.pair.first; | |||
| @@ -458,5 +458,5 @@ proc log_error() -> void { | |||
| puts(console_normal); | |||
| // HACK(Felix): we should control the stack size in eval_expr not here | |||
| Globals::Current_Execution::call_stack.next_index = 0; | |||
| // Globals::Current_Execution::call_stack.next_index = 0; | |||
| } | |||
| @@ -34,7 +34,7 @@ Lisp_Object::~Lisp_Object() { | |||
| switch (Memory::get_type(this)) { | |||
| case Lisp_Object_Type::HashMap: { | |||
| this->value.hashMap.~Hash_Map(); | |||
| delete this->value.hashMap; | |||
| } break; | |||
| case Lisp_Object_Type::CFunction: { | |||
| this->value.cFunction->args.positional.symbols.~Array_List(); | |||
| @@ -4,8 +4,8 @@ int main(int argc, char* argv[]) { | |||
| if (argc > 1) { | |||
| if (Slime::string_equal(argv[1], "--run-tests")) { | |||
| int res = Slime::run_all_tests(); | |||
| // Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime")); | |||
| Slime::Memory::free_everything(); | |||
| // Slime::interprete_file((char*)"generate-docs.slime"); | |||
| #ifdef _MSC_VER | |||
| _CrtDumpMemoryLeaks(); | |||
| #endif | |||
| @@ -138,6 +138,28 @@ namespace Memory { | |||
| }); | |||
| } | |||
| proc create_child_environment(Environment* parent) -> Environment* { | |||
| Environment* env = environment_memory.allocate(); | |||
| // inject a new array list; | |||
| new(&env->parents) Array_List<Environment*>; | |||
| if (parent) | |||
| env->parents.append(parent); | |||
| new(&env->hm) Hash_Map<void*, Lisp_Object*>; | |||
| return env; | |||
| } | |||
| proc create_empty_environment() -> Environment* { | |||
| Environment* ret; | |||
| try ret = create_child_environment(nullptr); | |||
| return ret; | |||
| } | |||
| proc init(int sms) -> void { | |||
| char* exe_path = get_exe_dir(); | |||
| defer {free(exe_path);}; | |||
| @@ -163,6 +185,10 @@ namespace Memory { | |||
| Environment* env; | |||
| try_void env = create_built_ins_environment(); | |||
| push_environment(env); | |||
| Environment* user_env; | |||
| try_void user_env = Memory::create_child_environment(env); | |||
| push_environment(user_env); | |||
| } | |||
| proc reset() -> void { | |||
| @@ -189,8 +215,8 @@ namespace Memory { | |||
| object_memory.~Bucket_Allocator(); | |||
| environment_memory.~Bucket_Allocator(); | |||
| ::new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8); | |||
| ::new(&environment_memory) Bucket_Allocator<Environment>(1024, 8); | |||
| new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8); | |||
| new(&environment_memory) Bucket_Allocator<Environment>(1024, 8); | |||
| next_free_spot_in_string_memory = string_memory; | |||
| @@ -207,6 +233,10 @@ namespace Memory { | |||
| Environment* env; | |||
| try_void env = create_built_ins_environment(); | |||
| push_environment(env); | |||
| Environment* user_env; | |||
| try_void user_env = Memory::create_child_environment(env); | |||
| push_environment(user_env); | |||
| } | |||
| proc create_lisp_object_pointer(void* ptr) -> Lisp_Object* { | |||
| @@ -221,7 +251,7 @@ namespace Memory { | |||
| Lisp_Object* node; | |||
| try node = create_lisp_object(); | |||
| set_type(node, Lisp_Object_Type::HashMap); | |||
| ::new((&node->value.hashMap)) Hash_Map<Lisp_Object*, Lisp_Object*>; | |||
| node->value.hashMap = new Hash_Map<Lisp_Object*, Lisp_Object*>; | |||
| return node; | |||
| } | |||
| @@ -284,8 +314,7 @@ namespace Memory { | |||
| Lisp_Object* node; | |||
| try node = create_lisp_object(); | |||
| set_type(node, Lisp_Object_Type::Symbol); | |||
| node->value.symbol.identifier = identifier; | |||
| node->value.symbol.hash = hash(identifier); | |||
| node->value.symbol = identifier; | |||
| global_symbol_table.set_object(get_c_str(identifier), node); | |||
| return node; | |||
| } | |||
| @@ -294,8 +323,7 @@ namespace Memory { | |||
| Lisp_Object* node; | |||
| try node = create_lisp_object(); | |||
| set_type(node, Lisp_Object_Type::Keyword); | |||
| node->value.symbol.identifier = keyword; | |||
| node->value.symbol.hash = hash(keyword); | |||
| node->value.symbol = keyword; | |||
| global_keyword_table.set_object(get_c_str(keyword), node); | |||
| return node; | |||
| } | |||
| @@ -388,27 +416,6 @@ namespace Memory { | |||
| return copy_lisp_object(n); | |||
| } | |||
| proc create_child_environment(Environment* parent) -> Environment* { | |||
| Environment* env = environment_memory.allocate(); | |||
| // inject a new array list; | |||
| ::new(&env->parents) Array_List<Environment*>; | |||
| if (parent) | |||
| env->parents.append(parent); | |||
| ::new(&env->hm) Hash_Map<void*, Lisp_Object*>; | |||
| return env; | |||
| } | |||
| proc create_empty_environment() -> Environment* { | |||
| Environment* ret; | |||
| try ret = create_child_environment(nullptr); | |||
| return ret; | |||
| } | |||
| proc create_built_ins_environment() -> Environment* { | |||
| Environment* ret; | |||
| try ret = create_empty_environment(); | |||
| @@ -60,16 +60,6 @@ struct Source_Code_Location { | |||
| int column; | |||
| }; | |||
| struct Symbol { | |||
| String* identifier; | |||
| u64 hash; | |||
| }; | |||
| struct Keyword { | |||
| String* identifier; | |||
| u64 hash; | |||
| }; | |||
| struct Pair { | |||
| Lisp_Object* first; | |||
| Lisp_Object* rest; | |||
| @@ -129,7 +119,7 @@ struct Lisp_Object { | |||
| Lisp_Object* userType; // keyword | |||
| String* docstring; | |||
| union value { | |||
| Symbol symbol; // used for symbols and keywords | |||
| String* symbol; // used for symbols and keywords | |||
| double number; | |||
| String* string; | |||
| Pair pair; | |||
| @@ -137,8 +127,8 @@ struct Lisp_Object { | |||
| Function* function; | |||
| cFunction* cFunction; | |||
| void* pointer; | |||
| Continuation continuation; | |||
| Hash_Map<Lisp_Object*, Lisp_Object*> hashMap; | |||
| Continuation* continuation; | |||
| Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; | |||
| ~value() {} | |||
| } value; | |||
| ~Lisp_Object(); | |||
| @@ -219,7 +219,7 @@ proc test_eval_operands() -> testresult { | |||
| assert_equal_type(operands, Lisp_Object_Type::Pair); | |||
| assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(operands->value.pair.first->value.symbol.identifier, "haha"); | |||
| assert_equal_string(operands->value.pair.first->value.symbol, "haha"); | |||
| return pass; | |||
| } | |||
| @@ -256,26 +256,26 @@ proc test_parse_atom() -> testresult { | |||
| result = Parser::parse_atom(string, &index_in_text); | |||
| assert_equal_type(result, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(result->value.symbol.identifier, "key1"); | |||
| assert_equal_string(result->value.symbol, "key1"); | |||
| ++index_in_text; | |||
| result = Parser::parse_atom(string, &index_in_text); | |||
| assert_equal_type(result, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(result->value.symbol.identifier, "key:2"); | |||
| assert_equal_string(result->value.symbol, "key:2"); | |||
| // test symbols | |||
| ++index_in_text; | |||
| result = Parser::parse_atom(string, &index_in_text); | |||
| assert_equal_type(result, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.symbol.identifier, "sym"); | |||
| assert_equal_string(result->value.symbol, "sym"); | |||
| ++index_in_text; | |||
| result = Parser::parse_atom(string, &index_in_text); | |||
| assert_equal_type(result, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.symbol.identifier, "+"); | |||
| assert_equal_string(result->value.symbol, "+"); | |||
| return pass; | |||
| } | |||
| @@ -289,13 +289,13 @@ proc test_parse_expression() -> testresult { | |||
| assert_equal_type(result, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun"); | |||
| assert_equal_string(result->value.pair.first->value.symbol, "fun"); | |||
| result = result->value.pair.rest; | |||
| assert_equal_type(result, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.pair.first->value.symbol.identifier, "+"); | |||
| assert_equal_string(result->value.pair.first->value.symbol, "+"); | |||
| result = result->value.pair.rest; | |||
| @@ -315,20 +315,20 @@ proc test_parse_expression() -> testresult { | |||
| assert_equal_type(result, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.pair.first->value.symbol.identifier, "define"); | |||
| assert_equal_string(result->value.pair.first->value.symbol, "define"); | |||
| result = result->value.pair.rest; | |||
| assert_equal_type(result, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun"); | |||
| assert_equal_string(result->value.pair.first->value.symbol, "fun"); | |||
| result = result->value.pair.rest; | |||
| assert_equal_type(result, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair); | |||
| assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol); | |||
| assert_equal_string(result->value.pair.first->value.pair.first->value.symbol.identifier, "lambda"); | |||
| assert_equal_string(result->value.pair.first->value.pair.first->value.symbol, "lambda"); | |||
| result = result->value.pair.rest; | |||
| @@ -498,7 +498,7 @@ proc test_built_in_type() -> testresult { | |||
| assert_no_error(); | |||
| assert_not_null(result); | |||
| assert_equal_type(result, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(result->value.symbol.identifier, "number"); | |||
| assert_equal_string(result->value.symbol, "number"); | |||
| // setting user type | |||
| char exp_string2[] = "(begin (set-type! a :my-type)(type a))"; | |||
| @@ -508,21 +508,21 @@ proc test_built_in_type() -> testresult { | |||
| assert_no_error(); | |||
| assert_not_null(result); | |||
| assert_equal_type(result, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(result->value.symbol.identifier, "my-type"); | |||
| assert_equal_string(result->value.symbol, "my-type"); | |||
| // trying to set invalid user type | |||
| char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))"; | |||
| expression = Parser::parse_single_expression(exp_string3); | |||
| assert_no_error(); | |||
| // // trying to set invalid user type | |||
| // char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))"; | |||
| // expression = Parser::parse_single_expression(exp_string3); | |||
| // assert_no_error(); | |||
| ignore_logging { | |||
| dont_break_on_errors { | |||
| result = eval_expr(expression); | |||
| } | |||
| } | |||
| // ignore_logging { | |||
| // dont_break_on_errors { | |||
| // result = eval_expr(expression); | |||
| // } | |||
| // } | |||
| assert_error(); | |||
| delete_error(); | |||
| // assert_error(); | |||
| // delete_error(); | |||
| // deleting user type | |||
| char exp_string4[] = "(begin (delete-type! a)(type a))"; | |||
| @@ -532,7 +532,7 @@ proc test_built_in_type() -> testresult { | |||
| assert_no_error(); | |||
| assert_not_null(result); | |||
| assert_equal_type(result, Lisp_Object_Type::Keyword); | |||
| assert_equal_string(result->value.symbol.identifier, "number"); | |||
| assert_equal_string(result->value.symbol, "number"); | |||
| return pass; | |||
| } | |||
| @@ -607,17 +607,11 @@ proc run_all_tests() -> bool { | |||
| bool result = true; | |||
| try Memory::init(409600); | |||
| Environment* root_env = get_root_environment(); | |||
| Environment* user_env = Memory::create_child_environment(root_env); | |||
| push_environment(user_env); | |||
| defer{ | |||
| pop_environment(); | |||
| }; | |||
| printf("-- Util --\n"); | |||
| invoke_test(test_array_lists_adding_and_removing); | |||
| invoke_test(test_array_lists_sorting); | |||
| invoke_test(test_array_lists_searching); | |||
| // invoke_test(test_array_lists_adding_and_removing); | |||
| // invoke_test(test_array_lists_sorting); | |||
| // invoke_test(test_array_lists_searching); | |||
| printf("\n -- Parsing --\n"); | |||
| invoke_test(test_parse_atom); | |||
| @@ -643,7 +637,6 @@ proc run_all_tests() -> bool { | |||
| printf("\n-- Test Files --\n"); | |||
| // print_environment(get_current_environment()); | |||
| invoke_test_script("evaluation_of_default_args"); | |||
| invoke_test_script("alists"); | |||
| invoke_test_script("case_and_cond"); | |||