diff --git a/bin/visualization.svg b/bin/visualization.svg index 38b9484..225656e 100644 --- a/bin/visualization.svg +++ b/bin/visualization.svg @@ -1,1634 +1,3016 @@ + viewBox='-00000000040 -00000000040 000000009900 000000021082'> - + Date: - - 06.05.2019 + + 07.05.2019 - + | - + Time: - - 12:17:09 + + 21:51:56 - + | - + String Memory: - + [allocated chars] - + 65536 - + [free] - + 3026 - + [used] - + 62510 - + [%free] - + 00004.617310 - + [%used] - + 00095.382690 - + | - + Object Memory: - + [#allocated] - + 8192000 - + [#free] - + 8191179 - + [#used] - + 821 - + [%free] - + 00099.989975 - + [%used] - + 00000.010022 - + | - + Memory Contents: - + Symbols: - + 302 - + = - + > - + >= - + < - + <= - + + - + - - + * - + / - + ** - + % - + assert - + define - + mutate - + if - + quote - + quasiquote - + and - + or - + not - + while - + let - + lambda - + special-lambda - + eval - + prog - + list - + pair - + first - + rest - + set-type - + delete-type - + type - + info - + show - + print - + read - + exit - + break - + memstat - + try - + load - + import - + copy - + error - + symbol->keyword - + string->symbol - + symbol->string - + concat-strings - + define-syntax - + when - + condition - + body - + if - + condition - + unquote - + pair - + prog - + body - + unquote - + nil - + quasiquote - + prog - + define-syntax - + unless - + condition - + body - + if - + condition - + unquote - + nil - + pair - + prog - + body - + unquote - + quasiquote - + prog - + define-syntax - + cond - + clauses - + define - + rec - + clauses - + if - + = - + nil - + clauses - + nil - + if - + = - + first - + first - + clauses - + else - + quote - + prog - + if - + not - + = - + rest - + clauses - + error - + pair - + prog - + quote - + rest - + first - + clauses - + list - + if - + quote - + first - + first - + clauses - + pair - + prog - + quote - + rest - + first - + clauses - + rec - + rest - + clauses - + rec - + clauses - + prog - + define - + nil? - + x - + = - + x - + nil - + define - + number? - + x - + = - + type - + x - + define - + symbol? - + x - + = - + type - + x - + define - + keyword? - + x - + = - + type - + x - + define - + pair? - + x - + = - + type - + x - + define - + string? - + x - + = - + type - + x - + define - + lambda? - + x - + = - + type - + x - + define - + special-lambda? - + x - + = - + type - + x - + define - + built-n-function? - + x - + = - + type - + x - + define - + apply - + fun - + seq - + eval - + pair - + fun - + seq - + define - + end - + seq - + if - + or - + nil? - + seq - + not - + pair? - + rest - + seq - + seq - + end - + rest - + seq - + define - + last - + seq - + first - + end - + seq - + define - + extend - + seq - + elem - + if - + pair? - + seq - + prog - + define - + e - + end - + seq - + mutate - + e - + pair - + first - + e - + elem - + seq - + elem - + define - + append - + seq - + elem - + extend - + seq - + pair - + elem - + nil - + define-syntax - + extend! - + seq - + elem - + mutate - + seq - + unquote - + extend - + seq - + unquote - + elem - + unquote - + quasiquote - + prog - + define-syntax - + append! - + seq - + elem - + mutate - + seq - + unquote - + append - + seq - + unquote - + elem - + unquote - + quasiquote - + prog - + define - + length - + seq - + if - + nil? - + seq - + + - + length - + rest - + seq - + define - + increment - + val - + + - + val - + define - + decrement - + val - + - - + val - + define - + range - + from - + to - + when - + < - + from - + to - + pair - + from - + range - + + - + from - + to - + condition - + body - + Keywords: - + 16 - + : - + rest - + : - + rest - + : - + rest - + : - + number - + : - + symbol - + : - + keyword - + : - + pair - + : - + string - + : - + dynamic-function - + : - + dynamic-macro - + : - + built-in-function - + : - + keys - + : - + defaults-to - + : - + from - + : - + to - + : - + symbol-undefined - + Numbers: - + 6 - + 00000.000000 - + 00001.000000 - + 00001.000000 - + 00001.000000 - + 00000.000000 - + 00001.000000 - + Strings: - + 21 - + "Doc String for 'when'" - + "There are additional clauses after the else clause!" - + "Checks if the argument is nil." - + "Checks if the argument is a number." - + "Checks if the argument is a symbol." - + "Checks if the argument is a keyword." - + "Checks if the argument is a pair." - + "Checks if the argument is a string." - + "Checks if the argument is a function." - + "Checks if the argument is a macro." - + "Checks if the argument is a built-in function." - + "Applies the funciton to the sequence, as in calls the function with\nithe se" - + "Returns the last pair in the sqeuence." - + "Returns the (first) of the last (pair) of the given sequence." - + "Extends a list with the given element, by putting it in\nthe (rest) of the l" - + "Appends an element to a sequence, by extendeing the list\nwith (pair elem ni" - + "test" - + "Returns the length of the given sequence." - + "Adds one to the argument." - + "Subtracts one from the argument." - + "Returns a sequence of numbers starting with the number defined\nby the key '" - - Pairs: + + Lists, Pairs: - + + 30 + + 420 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + define-syntax + + + when + + + condition + + + : + + + rest + + + body + + + + + + + "Doc String for 'when" + + + quasiquote + + + if + + + unquote + + + condition + + + + + unquote + + + pair + + + prog + + + body + + + + + + + + nil + + + + + + + + + + + + + when + + + condition + + + : + + + rest + + + body + + + + + + + "Doc String for 'when" + + + quasiquote + + + if + + + unquote + + + condition + + + + + unquote + + + pair + + + prog + + + body + + + + + + + + nil + + + + + + + + + + + + prog + + + quasiquote + + + if + + + unquote + + + condition + + + + + unquote + + + pair + + + prog + + + body + + + + + + + + nil + + + + + + + + + + + define-syntax + + + unless + + + condition + + + : + + + rest + + + body + + + + + + + quasiquote + + + if + + + unquote + + + condition + + + + + nil + + + unquote + + + pair + + + prog + + + body + + + + + + + + + + + + + + + + + prog + + + quasiquote + + + if + + + unquote + + + condition + + + + + nil + + + unquote + + + pair + + + prog + + + body + + + + + + + + + + + + + + + + define-syntax + + + cond + + + : + + + rest + + + clauses + + + + + + define + + + rec + + + clauses + + + + + if + + + = + + + nil + + + clauses + + + + + + nil + + + if + + + = + + + first + + + first + + + clauses + + + + + + + quote + + + else + + + + + + + + prog + + + if + + + not + + + = + + + () + + + rest + + + clauses + + + + + + + + + + error + + + "There are additional" + + + + + pair + + + quote + + + prog + + + + + rest + + + first + + + clauses + + + + + + + + + + + + + + + + list + + + quote + + + if + + + + + first + + + first + + + clauses + + + + + + + pair + + + quote + + + prog + + + + + rest + + + first + + + clauses + + + + + + + + + + rec + + + rest + + + clauses + + + + + + + + + + + + + + + + + + + + + + + rec + + + clauses + + + + + + + + + prog + + + define + + + rec + + + clauses + + + + + if + + + = + + + nil + + + clauses + + + + + + nil + + + if + + + = + + + first + + + first + + + clauses + + + + + + + quote + + + else + + + + + + + + prog + + + if + + + not + + + = + + + () + + + rest + + + clauses + + + + + + + + + + error + + + "There are additional" + + + + + pair + + + quote + + + prog + + + + + rest + + + first + + + clauses + + + + + + + + + + + + + + + + list + + + quote + + + if + + + + + first + + + first + + + clauses + + + + + + + pair + + + quote + + + prog + + + + + rest + + + first + + + clauses + + + + + + + + + + rec + + + rest + + + clauses + + + + + + + + + + + + + + + + + + + + + + + rec + + + clauses + + + + + + + + define + + + nil? + + + x + + + + + "Checks if the argume" + + + = + + + x + + + nil + + + + + + + + + + define + + + number? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + number + + + + + + + + + + define + + + symbol? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + symbol + + + + + + + + + + define + + + keyword? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + keyword + + + + + + + + + + define + + + pair? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + pair + + + + + + + + + + define + + + string? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + string + + + + + + + + + + define + + + lambda? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + dynamic-function + + + + + + + + + + define + + + special-lambda? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + dynamic-macro + + + + + + + + + + define + + + built-n-function? + + + x + + + + + "Checks if the argume" + + + = + + + type + + + x + + + + + : + + + built-in-function + + + + + + + + + + define + + + apply + + + fun + + + seq + + + + + + "Applies the funciton" + + + eval + + + pair + + + fun + + + seq + + + + + + + + + + + + define + + + end + + + seq + + + + + "Returns the last pai" + + + if + + + or + + + nil? + + + seq + + + + + not + + + pair? + + + rest + + + seq + + + + + + + + + + + + seq + + + end + + + rest + + + seq + + + + + + + + + + + + + + + define + + + last + + + seq + + + + + "Returns the (first) " + + + first + + + end + + + seq + + + + + + + + + + + define + + + extend + + + seq + + + elem + + + + + + "Extends a list with " + + + if + + + pair? + + + seq + + + + + prog + + + define + + + e + + + end + + + seq + + + + + + + + mutate + + + e + + + pair + + + first + + + e + + + + + elem + + + + + + + + + seq + + + + + + + elem + + + + + + + + + + + define + + + append + + + seq + + + elem + + + + + + "Appends an element t" + + + extend + + + seq + + + pair + + + elem + + + nil + + + + + + + + + + + + + define-syntax + + + extend! + + + seq + + + elem + + + + + + "test" + + + quasiquote + + + mutate + + + unquote + + + seq + + + + + extend + + + unquote + + + seq + + + + + unquote + + + elem + + + + + + + + + + + + + + + + + prog + + + quasiquote + + + mutate + + + unquote + + + seq + + + + + extend + + + unquote + + + seq + + + + + unquote + + + elem + + + + + + + + + + + + + + + define-syntax + + + append! + + + seq + + + elem + + + + + + quasiquote + + + mutate + + + unquote + + + seq + + + + + append + + + unquote + + + seq + + + + + unquote + + + elem + + + + + + + + + + + + + + + + prog + + + quasiquote + + + mutate + + + unquote + + + seq + + + + + append + + + unquote + + + seq + + + + + unquote + + + elem + + + + + + + + + + + + + + + define + + + length + + + seq + + + + + "Returns the length o" + + + if + + + nil? + + + seq + + + + + 00000.000000 + + + + + + + 00001.000000 + + + length + + + rest + + + seq + + + + + + + + + + + + + + + + + + define + + + increment + + + val + + + + + "Adds one to the argu" + + + + + + + val + + + 00001.000000 + + + + + + + + + + define + + + decrement + + + val + + + + + "Subtracts one from t" + + + - + + + val + + + 00001.000000 + + + + + + + + + + define + + + range + + + : + + + keys + + + from + + + : + + + defaults-to + + + 00000.000000 + + + to + + + + + + + + + "Returns a sequence o" + + + () + + + + + + + when + + + < + + + from + + + to + + + + + + pair + + + from + + + range + + + : + + + from + + + + + + + 00001.000000 + + + from + + + + + + : + + + to + + + to + + + + + + + + + + + + \ No newline at end of file diff --git a/src/defines.cpp b/src/defines.cpp index 449d150..f16f6bf 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -143,6 +143,25 @@ constexpr bool is_debug_build = false; _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 = new(name##_Array_List); \ ret->data = (type*)malloc(initial_capacity * sizeof(type)); \ @@ -152,105 +171,6 @@ constexpr bool is_debug_build = false; } - - - - - - - - - - - -// struct Int_Array_List { -// int* data; -// int length; -// int next_index; -// }; - -// proc remove_index_from_array_list(Int_Array_List* arraylist, int index) -> void { -// arraylist->data[index] = arraylist->data[--arraylist->next_index]; -// } - -// proc append_to_array_list(Int_Array_List* arraylist, int element) -> void { -// if (arraylist->next_index == arraylist->length) { -// arraylist->length *= 2; -// arraylist->data = -// (int*)realloc(arraylist->data, arraylist->length * sizeof(int)); -// } -// arraylist->data[arraylist->next_index++] = element; -// } - -// proc _merge_array_lists(Int_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 { -// int 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(Int_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 create_Int_array_list(int initial_capacity = 16) -> Int_Array_List* { -// Int_Array_List* ret = new(Int_Array_List); -// ret->data = (int*)malloc(initial_capacity * sizeof(int)); -// ret->next_index = 0; -// ret->length = initial_capacity; -// return ret; -// } - - - - - - - - - - - - - - template class defer_finalizer { F f; diff --git a/src/testing.cpp b/src/testing.cpp index 8afc104..effa66e 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -174,6 +174,25 @@ proc test_array_lists_sorting() -> testresult { return pass; } +proc test_array_lists_searching() -> testresult { + Int_Array_List* list = create_Int_array_list(); + append_to_array_list(list, 1); + append_to_array_list(list, 2); + append_to_array_list(list, 3); + append_to_array_list(list, 4); + + int index = sorted_array_list_find(list, 3); + assert_equal_int(index, 2); + + index = sorted_array_list_find(list, 1); + assert_equal_int(index, 0); + + index = sorted_array_list_find(list, 5); + assert_equal_int(index, -1); + + return pass; +} + proc test_eval_operands() -> testresult { char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; Lisp_Object* operands = Parser::parse_single_expression(operands_string); @@ -571,6 +590,7 @@ proc run_all_tests() -> bool { printf("-- Util --\n"); 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); diff --git a/src/visualization.cpp b/src/visualization.cpp index 2076841..01ac339 100644 --- a/src/visualization.cpp +++ b/src/visualization.cpp @@ -1,4 +1,11 @@ proc visualize_lisp_machine() -> void { + struct Drawn_Area { + int x; + int y; + int width; + int height; + }; + fprintf(stderr, "Drawing visualization..."); defer { fprintf(stderr, "Done!\n"); @@ -29,14 +36,20 @@ proc visualize_lisp_machine() -> void { write_y = 0; - proc draw_margin = [&](int count = 1) { + proc draw_margin = [&](int count = 1) -> Drawn_Area { write_x += margin * count; + return { + write_x - margin * count, + write_y, + margin * count, + write_y + }; }; proc draw_new_line = [&](int count = 1) { write_x = 0; write_y += 25 * count; }; - proc draw_text = [&](const char* text, const char* color = "#000000", bool draw_quotes = false, int max_length = 200) { + proc draw_text = [&](const char* text, const char* color = "#000000", bool draw_quotes = false, int max_length = 200) -> Drawn_Area { // take care of escaping sensitive chars int text_length = 0; int extra_needed_chars = draw_quotes ? 10 : 0; @@ -97,50 +110,140 @@ proc visualize_lisp_machine() -> void { int text_width = 12 * (text_length + (draw_quotes ? 2 : 0)); if (write_x + text_width > max_x) max_x = write_x + text_width; - if (write_y > max_y) max_y = write_y; + if (write_y + 12 > max_y) max_y = write_y + 12; const char* quote = draw_quotes ? """ : ""; if (extra_needed_chars) { - fprintf(f, draw_text_template, write_x, write_y, color, quote, new_text, quote); + fprintf(f, draw_text_template, write_x, write_y+12, color, quote, new_text, quote); free(new_text); } else { - fprintf(f, draw_text_template, write_x, write_y, color, quote, text, quote, color); + fprintf(f, draw_text_template, write_x, write_y+12, color, quote, text, quote, color); } - write_x += text_width; + // write_x += text_width; + + return { + write_x - text_width, + write_y, + text_width, + 12 + }; }; - proc draw_integer = [&](int number) { + proc draw_integer = [&](int number) -> Drawn_Area { int text_width = 12 * ((int)log10(number)+1); if (write_x + text_width > max_x) max_x = write_x + text_width; if (write_y > max_y) max_y = write_y; - fprintf(f, draw_integer_template, write_x, write_y, number); + fprintf(f, draw_integer_template, write_x, write_y+12, number); - write_x += text_width; + return { + write_x, + write_y, + text_width, + 12 + }; }; - proc draw_float = [&](float number) { + proc draw_float = [&](float number) -> Drawn_Area { int text_width = 12 * 12; if (write_x + text_width > max_x) max_x = write_x + text_width; if (write_y > max_y) max_y = write_y; - fprintf(f, draw_float_template, write_x, write_y, number); + fprintf(f, draw_float_template, write_x, write_y+12, number); - write_x += text_width; + return { + write_x, + write_y, + text_width, + 12 + }; + }; + std::function draw_pair; + proc draw_lisp_object = [&](Lisp_Object* obj) -> Drawn_Area { + switch (Memory::get_type(obj)) { + case Lisp_Object_Type::T: return draw_text("t"); + case Lisp_Object_Type::Nil: return draw_text("()"); + case Lisp_Object_Type::Pair: return draw_pair(obj); + case Lisp_Object_Type::Number: return draw_float(obj->value.number); + case Lisp_Object_Type::Symbol: return draw_text(&obj->value.string->data); + case Lisp_Object_Type::Keyword: { + Drawn_Area colon = draw_text(":", "#c61b6e"); + write_x += colon.width; + Drawn_Area text = draw_text(&obj->value.identifier->data, "#c61b6e"); + write_x -= colon.width; + return { + colon.x, + colon.y, + colon.width + text.width, + colon.height + }; + } + case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20); + default: return {0}; + } }; - proc draw_pair = [&](Lisp_Object* pair) { + draw_pair = [&](Lisp_Object* pair) -> Drawn_Area { + Drawn_Area ret; + Drawn_Area child; + + ret.x = write_x; + ret.y = write_y; + ret.width = 100; + ret.height = 100; + fprintf(f, " " " ", write_x, write_y, write_x+50, write_y, write_x+50, write_y+50); + + // arrow to first + fprintf(f, + " ", + write_x+25, write_y+25, write_x+25, write_y+100); + + write_y += 110; + child = draw_lisp_object(pair->value.pair.first); + if (ret.width < child.width) + ret.width = child.width; + if (ret.height < child.height) + ret.height = child.height; + + write_y -= 110; + if (pair->value.pair.rest == Memory::nil) { fprintf(f, " ", write_x+50, write_y+50, write_x+100, write_y); + } else { + // arrow to rest + int x_offset = 150; + if (child.width+margin > x_offset) + x_offset = child.width+margin; + + fprintf(f, + " ", + write_x+75, write_y+25, write_x+75+x_offset, write_y+25); + + write_x += x_offset; + ret.width += 50; + + child = draw_lisp_object(pair->value.pair.rest); + ret.width += child.width; + if (ret.height < 70 + child.height) + ret.height = 70 + child.height; + + write_x -= x_offset; } fprintf(f, "\n"); + + if (max_x < ret.x + ret.width) + max_x = ret.x + ret.width; + if (max_y < ret.y + ret.height) + max_y = ret.y + ret.height; + + return ret; }; proc draw_header = [&]() { proc draw_separator = [&]() { @@ -160,8 +263,8 @@ proc visualize_lisp_machine() -> void { char date[12]; snprintf(date, 12, "%02d.%02d.%d", tm.tm_mday, tm.tm_mon + 1, tm.tm_year + 1900); - draw_text("Date: "); - draw_text(date); + write_x += draw_text("Date: ").width; + write_x += draw_text(date).width; draw_separator(); @@ -171,8 +274,8 @@ proc visualize_lisp_machine() -> void { char time[12]; snprintf(time, 12, "%02d:%02d:%02d", tm.tm_hour, tm.tm_min, tm.tm_sec); - draw_text("Time: "); - draw_text(time); + write_x += draw_text("Time: ").width; + write_x += draw_text(time).width; draw_separator(); @@ -187,22 +290,22 @@ proc visualize_lisp_machine() -> void { } int used_string_memory = Memory::string_memory_size - free_string_memory; - draw_text("String Memory:"); + write_x += draw_text("String Memory:").width; draw_margin(); - draw_text("[allocated chars] "); - draw_integer(Memory::string_memory_size); + write_x += draw_text("[allocated chars] ").width; + write_x += draw_integer(Memory::string_memory_size).width; draw_margin(); - draw_text("[free] "); - draw_integer(free_string_memory); + write_x += draw_text("[free] ").width; + write_x += draw_integer(free_string_memory).width; draw_margin(); - draw_text("[used] "); - draw_integer(used_string_memory); + write_x += draw_text("[used] ").width; + write_x += draw_integer(used_string_memory).width; draw_margin(); - draw_text("[%free] "); - draw_float(100.0f * free_string_memory / Memory::string_memory_size); + write_x += draw_text("[%free] ").width; + write_x += draw_float(100.0f * free_string_memory / Memory::string_memory_size).width; draw_margin(); - draw_text("[%used] "); - draw_float(100.0f * used_string_memory / Memory::string_memory_size); + write_x += draw_text("[%used] ").width; + write_x += draw_float(100.0f * used_string_memory / Memory::string_memory_size).width; draw_separator(); draw_new_line(); @@ -214,22 +317,22 @@ proc visualize_lisp_machine() -> void { int free_object_memory_cells = Memory::object_memory_size - (Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory->next_index); int used_object_memory_cells = Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory->next_index; - draw_text("Object Memory:"); + write_x += draw_text("Object Memory:").width; draw_margin(); - draw_text("[#allocated] "); - draw_integer(Memory::object_memory_size); + write_x += draw_text("[#allocated] ").width; + write_x += draw_integer(Memory::object_memory_size).width; draw_margin(); - draw_text("[#free] "); - draw_integer(free_object_memory_cells); + write_x += draw_text("[#free] ").width; + write_x += draw_integer(free_object_memory_cells).width; draw_margin(); - draw_text("[#used] "); - draw_integer(used_object_memory_cells); + write_x += draw_text("[#used] ").width; + write_x += draw_integer(used_object_memory_cells).width; draw_margin(); - draw_text("[%free] "); - draw_float(100.0f * free_object_memory_cells / Memory::object_memory_size); + write_x += draw_text("[%free] ").width; + write_x += draw_float(100.0f * free_object_memory_cells / Memory::object_memory_size).width; draw_margin(); - draw_text("[%used] "); - draw_float(100.0f * used_object_memory_cells / Memory::object_memory_size); + write_x += draw_text("[%used] ").width; + write_x += draw_float(100.0f * used_object_memory_cells / Memory::object_memory_size).width; draw_separator(); @@ -241,6 +344,7 @@ proc visualize_lisp_machine() -> void { Lisp_Object_Array_List* numbers = create_Lisp_Object_array_list(); Lisp_Object_Array_List* strings = create_Lisp_Object_array_list(); Lisp_Object_Array_List* pairs = create_Lisp_Object_array_list(); + Lisp_Object_Array_List* lists = create_Lisp_Object_array_list(); // loop over all used memory for (int i = 0; i < Memory::next_index_in_object_memory; ++i) { @@ -262,13 +366,43 @@ proc visualize_lisp_machine() -> void { } // create the lists-list by filtering the pairs-list. - Lisp_Oject_Array_List* pairs_to_filter = create_Int_array_list(); + Lisp_Object_Array_List* pairs_to_filter = create_Lisp_Object_array_list(); Int_Array_List* indices_to_filter = create_Int_array_list(); + // helper lambda: + proc remove_doubles_from_lisp_object_array_list = [&](Lisp_Object_Array_List* list) -> void { + if (list->next_index == 0) + return; + + sort_array_list(list); + Int_Array_List* indices_to_filter = create_Int_array_list(); + + size_t last = (size_t)list->data[0]; + for (int i = 1; i < list->next_index; ++i) { + if ((size_t)list->data[i] == last) + append_to_array_list(indices_to_filter, i); + else + last = (size_t)list->data[i]; + } + + for (int i = indices_to_filter->next_index; i >= 0; --i) { + remove_index_from_array_list(list, indices_to_filter->data[i]); + } + + // sort again as removing items destroys the order + sort_array_list(list); + }; + // recursive lambda std::function filter_pair_and_children; filter_pair_and_children = [&](Lisp_Object* pair) { - + append_to_array_list(pairs_to_filter, pair); + + if (Memory::get_type(pair->value.pair.first) == Lisp_Object_Type::Pair) + filter_pair_and_children(pair->value.pair.first); + + if (Memory::get_type(pair->value.pair.rest) == Lisp_Object_Type::Pair) + filter_pair_and_children(pair->value.pair.rest); }; for (int i = 0; i < pairs->next_index; ++i) { if (Memory::get_type(pairs->data[i]->value.pair.first) == Lisp_Object_Type::Pair) @@ -279,6 +413,15 @@ proc visualize_lisp_machine() -> void { } + remove_doubles_from_lisp_object_array_list(pairs_to_filter); + fprintf(stderr, "removing %d pairs\n", pairs_to_filter->next_index); + // okay, so pairs_to_filter now only the pairs once each that + // we want to filter from the pairs list + for (int i = 0; i < pairs->next_index; ++i) { + if (sorted_array_list_find(pairs_to_filter, pairs->data[i]) == -1) { + append_to_array_list(lists, pairs->data[i]); + } + } draw_text("Memory Contents:"); draw_new_line(); @@ -287,7 +430,7 @@ proc visualize_lisp_machine() -> void { int start_x = write_x, start_y = write_y; - draw_text("Symbols: "); + write_x += draw_text("Symbols: ").width; draw_integer(symbols->next_index); draw_new_line(); write_x = start_x; @@ -303,7 +446,7 @@ proc visualize_lisp_machine() -> void { write_x = start_x + 300; write_y = start_y; - draw_text("Keywords: "); + write_x += draw_text("Keywords: ").width; draw_integer(keywords->next_index); draw_new_line(); write_x = start_x + 300; @@ -312,8 +455,7 @@ proc visualize_lisp_machine() -> void { draw_new_line(); write_x = start_x + 300; - draw_text(":", "#c61b6e"); - draw_text(&keywords->data[i]->value.identifier->data, "#c61b6e"); + draw_lisp_object(keywords->data[i]); } @@ -321,7 +463,7 @@ proc visualize_lisp_machine() -> void { write_x = start_x + 600; write_y = start_y; - draw_text("Numbers: "); + write_x += draw_text("Numbers: ").width; draw_integer(numbers->next_index); draw_new_line(); write_x = start_x + 600; @@ -336,7 +478,7 @@ proc visualize_lisp_machine() -> void { write_x = start_x + 900; write_y = start_y; - draw_text("Strings: "); + write_x += draw_text("Strings: ").width; draw_integer(strings->next_index); draw_new_line(); write_x = start_x + 900; @@ -352,16 +494,18 @@ proc visualize_lisp_machine() -> void { write_x = start_x + 2000; write_y = start_y; - draw_text("Pairs: "); + write_x += draw_text("Lists, Pairs: ").width; + write_x += draw_integer(lists->next_index).width; + draw_margin(); draw_integer(pairs->next_index); draw_new_line(); write_x = start_x + 2000; - for (int i = 0; i < pairs->next_index; ++i) { + for (int i = 0; i < lists->next_index; ++i) { draw_new_line(3); write_x = start_x + 2000; - draw_pair(pairs->data[i]); + write_y += draw_pair(lists->data[i]).height; } }; @@ -369,7 +513,7 @@ proc visualize_lisp_machine() -> void { "\n" "\n\n", -padding, -padding, 0, 0); draw_header(); @@ -385,6 +529,7 @@ proc visualize_lisp_machine() -> void { "\n" "", -padding, -padding, max_x + 2*padding, max_y + 2*padding); }