diff --git a/.dir-locals.el b/.dir-locals.el index bb706a5..1aa7131 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -32,4 +32,5 @@ (c++-mode . ((eval . (company-clang-set-prefix "slime.h")) (eval . (flycheck-mode 0)) (eval . (rainbow-mode 0)) + (eval . (setq c-backslash-max-column 99)) ))) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 8a370e2..605a368 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -106,9 +106,9 @@ proc load_built_ins_into_environment() -> void { String* file_name_built_ins = Memory::create_string(__FILE__); -#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()); \ +#define fetch1(var) \ + static 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__) #define fetch2(var1, var2) fetch1(var1); fetch1(var2) diff --git a/src/defines.cpp b/src/defines.cpp index deec26d..20c41ba 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -36,6 +36,7 @@ break; \ } \ else label(body,__LINE__): + ; #define try_struct try_or_else_return({}) #define try_void try_or_else_return() @@ -44,138 +45,133 @@ #define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false) #define ignore_logging fluid_let(Globals::log_level, Log_Level::None) - -#define define_array_list(type, name) \ - struct name##_Array_List { \ - type* data; \ - int length; \ - int next_index; \ - }; \ - \ - proc remove_index_from_array_list(name##_Array_List* arraylist, int index) -> void { \ - arraylist->data[index] = \ - arraylist->data[--(arraylist->next_index)]; \ - } \ - \ - proc append_to_array_list(name##_Array_List* arraylist, type element) -> void { \ - if (arraylist->next_index == arraylist->length) { \ - arraylist->length *= 2; \ - arraylist->data = \ - (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \ - } \ - arraylist->data[arraylist->next_index] = element; \ - arraylist->next_index++; \ - } \ - \ - proc _merge_array_lists(name##_Array_List* arr, int start, int mid, int end) -> void { \ - int start2 = mid + 1; \ - \ - /* If the direct merge is already sorted */ \ - if ((size_t)arr->data[mid] <= (size_t)arr->data[start2]) { \ - return; \ - } \ - \ - /* Two pointers to maintain start of both arrays to merge */ \ - while (start <= mid && start2 <= end) { \ - if ((size_t)arr->data[start] <= (size_t)arr->data[start2]) { \ - start++; \ - } \ - else { \ - type value = arr->data[start2]; \ - int index = start2; \ - \ - /* Shift all the elements between element 1; element 2, right by 1. */ \ - while (index != start) { \ - arr->data[index] = arr->data[index - 1]; \ - index--; \ - } \ - arr->data[start] = value; \ - \ - /* Update all the pointers */ \ - start++; \ - mid++; \ - start2++; \ - } \ - } \ - } \ - \ - proc sort_array_list(name##_Array_List* arraylist, int left=-1, int right=-1) -> void { \ - if (left == -1) { \ - sort_array_list(arraylist, 0, arraylist->next_index - 1); \ - return; \ - } else if (left == right) { \ - return; \ - } \ - \ - int middle = left + (right-left) / 2; \ - \ - sort_array_list(arraylist, left, middle); \ - sort_array_list(arraylist, middle+1, right); \ - \ - _merge_array_lists(arraylist, left, middle, right); \ - } \ - \ +#define define_array_list(type, name) \ + \ + struct name##_Array_List { \ + type* data; \ + int length; \ + int next_index; \ + }; \ + \ + proc remove_index_from_array_list(name##_Array_List* arraylist, int index) -> void { \ + arraylist->data[index] = \ + arraylist->data[--(arraylist->next_index)]; \ + } \ + \ + proc append_to_array_list(name##_Array_List* arraylist, type element) -> void { \ + if (arraylist->next_index == arraylist->length) { \ + arraylist->length *= 2; \ + arraylist->data = \ + (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \ + } \ + arraylist->data[arraylist->next_index] = element; \ + arraylist->next_index++; \ + } \ + \ + proc _merge_array_lists(name##_Array_List* arr, int start, int mid, int end) -> void { \ + int start2 = mid + 1; \ + \ + /* If the direct merge is already sorted */ \ + if ((size_t)arr->data[mid] <= (size_t)arr->data[start2]) { \ + return; \ + } \ + \ + /* Two pointers to maintain start of both arrays to merge */ \ + while (start <= mid && start2 <= end) { \ + if ((size_t)arr->data[start] <= (size_t)arr->data[start2]) { \ + start++; \ + } \ + else { \ + type value = arr->data[start2]; \ + int index = start2; \ + \ + /* Shift all the elements between element 1; element 2, right by 1. */ \ + while (index != start) { \ + arr->data[index] = arr->data[index - 1]; \ + index--; \ + } \ + arr->data[start] = value; \ + \ + /* Update all the pointers */ \ + start++; \ + mid++; \ + start2++; \ + } \ + } \ + } \ + \ + proc sort_array_list(name##_Array_List* arraylist, int left=-1, int right=-1) -> void { \ + if (left == -1) { \ + sort_array_list(arraylist, 0, arraylist->next_index - 1); \ + return; \ + } else if (left == right) { \ + return; \ + } \ + \ + int middle = left + (right-left) / 2; \ + \ + sort_array_list(arraylist, left, middle); \ + sort_array_list(arraylist, middle+1, right); \ + \ + _merge_array_lists(arraylist, left, middle, right); \ + } \ + \ proc sorted_array_list_find(name##_Array_List* arraylist, type elem, int left=-1, int right=-1) -> int { \ - if (left == -1) { \ - return sorted_array_list_find(arraylist, elem, 0, arraylist->next_index - 1); \ - } else if (left == right) { \ - if ((size_t)arraylist->data[left] == (size_t)elem) \ - return left; \ - return -1; \ - } else if (right < left) \ - return -1; \ - \ - int middle = left + (right-left) / 2; \ - \ - if ((size_t)arraylist->data[middle] < (size_t)elem) \ - return sorted_array_list_find(arraylist, elem, middle+1, right); \ - if ((size_t)arraylist->data[middle] > (size_t)elem) \ - return sorted_array_list_find(arraylist, elem, left, middle-1); \ - return middle; \ - } \ - \ - proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List { \ - name##_Array_List ret; \ - ret.data = (type*)malloc(initial_capacity * sizeof(type)); \ - ret.next_index = 0; \ - ret.length = initial_capacity; \ - return ret; \ + if (left == -1) { \ + return sorted_array_list_find(arraylist, elem, 0, arraylist->next_index - 1); \ + } else if (left == right) { \ + if ((size_t)arraylist->data[left] == (size_t)elem) \ + return left; \ + return -1; \ + } else if (right < left) \ + return -1; \ + \ + int middle = left + (right-left) / 2; \ + \ + if ((size_t)arraylist->data[middle] < (size_t)elem) \ + return sorted_array_list_find(arraylist, elem, middle+1, right); \ + if ((size_t)arraylist->data[middle] > (size_t)elem) \ + return sorted_array_list_find(arraylist, elem, left, middle-1); \ + return middle; \ + } \ + \ + proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List { \ + name##_Array_List ret; \ + ret.data = (type*)malloc(initial_capacity * sizeof(type)); \ + ret.next_index = 0; \ + ret.length = initial_capacity; \ + return ret; \ } /* * iterate over array lists */ -#define for_array_list(l) \ - if (int it_index = 0); \ - else \ - for (auto it = (l).data[0]; \ - it_index < (l).next_index; \ - it=(l).data[++it_index]) +#define for_array_list(l) \ + if (int it_index = 0); else \ + for (auto it = (l).data[0]; \ + it_index < (l).next_index; \ + it=(l).data[++it_index]) /* * iterate over lisp vectors */ -#define for_lisp_vector(v) \ - if (!v); \ - else \ - if (int it_index = 0); \ - else \ - for (auto it = v->value.vector.data; \ - it_index < v->value.vector.length; \ - it=v->value.vector.data+(++it_index)) +#define for_lisp_vector(v) \ + if (!v); else \ + if (int it_index = 0); else \ + for (auto it = v->value.vector.data; \ + it_index < v->value.vector.length; \ + it=v->value.vector.data+(++it_index)) /* * iterate over lisp lists */ -#define for_lisp_list(l) \ - if (!l); \ - else \ - if (int it_index = 0); \ - else \ - for (Lisp_Object* head = l, *it; \ - Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ - head = head->value.pair.rest, ++it_index) +#define for_lisp_list(l) \ + if (!l); else \ + if (int it_index = 0); else \ + for (Lisp_Object* head = l, *it; \ + Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ + head = head->value.pair.rest, ++it_index) /** Usage of the create_error_macros: diff --git a/src/memory.cpp b/src/memory.cpp index 2c75230..afa88f2 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -1,5 +1,11 @@ namespace Memory { + // ------------------ + // global symbol / keyword table + // ------------------ + String_Hash_Map* global_symbol_table; + String_Hash_Map* global_keyword_table; + // ------------------ // lisp_objects // ------------------ @@ -159,7 +165,18 @@ namespace Memory { return object; } + proc free_everything() { + free(global_symbol_table); + free(global_keyword_table); + free(object_memory); + free(environment_memory); + free(string_memory); + } + proc init(int oms, int ems, int sms) { + global_symbol_table = create_String_hashmap(); + global_keyword_table = create_String_hashmap(); + object_memory_size = oms; environment_memory_size = ems; string_memory_size = sms; @@ -274,44 +291,52 @@ namespace Memory { return node; } - proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { - // TODO(Felix): if we already have it stored somewhere then - // reuse it and dont create new one + proc create_new_lisp_object_symbol(String* identifier) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Symbol); - // node->value.symbol = new(Symbol); node->value.symbol.identifier = identifier; node->value.symbol.hash = hash(identifier); + hm_set(global_symbol_table, get_c_str(identifier), node); return node; } - proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* { - // TODO(Felix): This is really bad: we create a new string - // even if the symbol/keyword is already existing, just to - // check IF it exists and then never deleting it. - return get_or_create_lisp_object_symbol( - Memory::create_string(identifier)); - } - - proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { - // TODO(Felix): if we already have it stored somewhere then - // reuse it and dont create new one + proc create_new_lisp_object_keyword(String* keyword) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Keyword); - // node->value.keyword = new(Keyword); node->value.symbol.identifier = keyword; node->value.symbol.hash = hash(keyword); + hm_set(global_keyword_table, get_c_str(keyword), node); return node; } + proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { + if (auto ret = hm_get_object(global_symbol_table, get_c_str(identifier))) + return (Lisp_Object*)ret; + else + return create_new_lisp_object_symbol(identifier); + } + + proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* { + if (auto ret = hm_get_object(global_symbol_table, (char*)identifier)) + return (Lisp_Object*)ret; + else + return create_new_lisp_object_symbol(Memory::create_string(identifier)); + } + + proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { + if (auto ret = hm_get_object(global_keyword_table, get_c_str(keyword))) + return (Lisp_Object*)ret; + else + return create_new_lisp_object_keyword(keyword); + } + proc get_or_create_lisp_object_keyword(const char* keyword) -> Lisp_Object* { - // TODO(Felix): This is really bad: we create a new string - // even if the symbol/keyword is already existing, just to - // check IF it exists and then never deleting it. - return get_or_create_lisp_object_keyword( - Memory::create_string(keyword)); + if (auto ret = hm_get_object(global_keyword_table, (char*)keyword)) + return (Lisp_Object*)ret; + else + return create_new_lisp_object_keyword(Memory::create_string(keyword)); } proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* { diff --git a/src/parse.cpp b/src/parse.cpp index 76f9dcd..84f7a65 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -340,7 +340,9 @@ namespace Parser { ++parser_col; ++(*index_in_text); break; - } else if (text[(*index_in_text)] == '.') { + } else if (text[(*index_in_text) ] == '.' && + text[(*index_in_text)+1] == ' ') + { ++parser_col; ++(*index_in_text); eat_until_code(text, index_in_text); @@ -364,121 +366,6 @@ namespace Parser { head = head->value.pair.rest; } } - - // check if we have to create or delete or run macros - // while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) { - // Lisp_Object* parsed_symbol = expression->value.pair.first; - // if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) { - // // create a new macro - // Lisp_Object* arguments = expression->value.pair.rest; - // Lisp_Object* body; - // int arguments_length; - - // // HACK(Felix): almost code duplicate from - // // `built_ins.cpp`: special-lambda - // try arguments_length = list_length(arguments); - - // // (define-syntax (defun name args :rest body) (...)) - // if (arguments_length < 2) { - // create_wrong_number_of_arguments_error(3, arguments_length); - // return nullptr; - // } - - // assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair); - - // // extract the name - // Lisp_Object* symbol_for_macro = arguments->value.pair.first->value.pair.first; - // body = arguments->value.pair.rest; - // arguments = arguments->value.pair.first->value.pair.rest; - - // // Function* function = new(Function); - // Lisp_Object* macro; - // try macro = Memory::create_lisp_object(); - // Memory::set_type(macro, Lisp_Object_Type::Function); - // macro->value.function.parent_environment = get_current_environment(); - // macro->value.function.type = Function_Type::Macro; - - // // if parameters were specified - // if (arguments != Memory::nil) { - // try assert_type(arguments, Lisp_Object_Type::Pair); - // try create_arguments_from_lambda_list_and_inject(arguments, macro); - // } else { - // macro->value.function.args.positional = create_positional_argument_list(1); - // macro->value.function.args.keyword = create_keyword_argument_list(1); - // macro->value.function.args.rest = nullptr; - // } - - // // arguments = arguments->value.pair.rest; - // // if there is a docstring, use it - // if (Memory::get_type(body->value.pair.first) == Lisp_Object_Type::String) { - // macro->docstring = body->value.pair.first->value.string; - // body = body->value.pair.rest; - // } else { - // macro->docstring = nullptr; - // } - - // // we are now in the function body, just wrap it in an - // // implicit begin - // try macro->value.function.body = Memory::create_lisp_object_pair( - // Memory::get_or_create_lisp_object_symbol("begin"), - // body); - - // inject_scl(macro); - // // macro->value.function = function; - // define_symbol(symbol_for_macro, macro); - - // // print_environment(environment_for_macros); - // return Memory::nil; - - // } else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) { - // /* --- deleting an existing macro --- */ - // // TODO(Felix): this is a hard one because when - // // environments will be made from hashmaps, how can we - // // delete stuff from hashmaps? If we do probing on - // // collision and then delte the first colliding entry, - // // how can we find the second one? How many probes do - // // we have to do to know for sure that an elemenet is - // // not in the hashmap? It would be much easier if we - // // never deleted any elements from the hashmap, so - // // that, when an entry is not found immidiately, we - // // know for sure that it does not exist in the table. - - // create_generic_error("deleting macros has not yet be implemented," - // "and I don't know if it is a good idea to do so."); - // return nullptr; - // } else { - // // if threre is a macro named like this, then macroexpand - // // if not it is regular code, dont touch. - // break; - - // 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) - // { - // // printf("pretending to expand macro at %s %d %d: ", - // // Memory::get_c_str(parser_file), - // // parser_line, parser_col); - // // print(parsed_symbol); - // // printf("\n"); - // // NOTE(Felix): Execute it as a special lambda, - // // because if we keep it as a macro, the evaluator - // // will think it is a stray macro that was not yet - // // expanded, and attempt to evaluate it twice (1. - // // for expanding, and 2. for evaluating) - // macro->value.function.type = Function_Type::Special_Lambda; - // // NOTE(Felix): deferred so even if eval expr - // // fails, and returns, the type will be be - // // resetted to macro. - // defer { - // macro->value.function.type = Function_Type::Macro; - // }; - // try expression = eval_expr(expression); - // break; - // } else break; - // } - // } - return expression; } diff --git a/src/testing.cpp b/src/testing.cpp index c8bf3d6..7045cf6 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -540,9 +540,6 @@ proc test_built_in_type() -> testresult { } proc test_singular_t_and_nil() -> testresult { - Environment* env; - try env = get_root_environment(); - // nil testing char exp_string1[] = "()"; char exp_string2[] = "nil"; @@ -574,6 +571,19 @@ proc test_singular_t_and_nil() -> testresult { return pass; } +proc test_singular_symbols() -> testresult { + auto cc_s_aa = Memory::get_or_create_lisp_object_symbol("aa"); + auto cc_s_aa2 = Memory::get_or_create_lisp_object_symbol("aa2"); + auto s_s_aa = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa")); + auto s_s_aa2 = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa2")); + + assert_equal_int(cc_s_aa, s_s_aa); + assert_equal_int(cc_s_aa2, s_s_aa2); + assert_not_equal_int(cc_s_aa, cc_s_aa2); + + return pass; +} + proc test_file(const char* file) -> testresult { // Memory::reset(); // assert_no_error(); @@ -630,6 +640,7 @@ proc run_all_tests() -> bool { printf("\n-- Memory management --\n"); invoke_test(test_singular_t_and_nil); + invoke_test(test_singular_symbols); printf("\n-- Test Files --\n");