diff --git a/bin/tests/sicp.slime b/bin/tests/sicp.slime index 8b393f7..7a469a3 100644 --- a/bin/tests/sicp.slime +++ b/bin/tests/sicp.slime @@ -338,3 +338,4 @@ (define (close-enough? x y) (< (abs (- x y)) 0.001)) (assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1)) + diff --git a/bin/visualization.svg b/bin/visualization.svg index 87bb694..66b1de7 100644 --- a/bin/visualization.svg +++ b/bin/visualization.svg @@ -16,7 +16,7 @@ Time: - 11:40:20 + 16:44:55 | diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 7fecaf2..be69c0c 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -17,7 +17,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { // unnecessary once symbols and // keywords are memory unique case Lisp_Object_Type::Keyword: - return string_equal(n1->value.identifier, n2->value.identifier); + return string_equal(n1->value.symbol.identifier, n2->value.symbol.identifier); case Lisp_Object_Type::Number: return n1->value.number == n2->value.number; case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string); case Lisp_Object_Type::Pair: @@ -440,7 +440,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // it is a pair! Lisp_Object* originalPair = expr->value.pair.first; if (Memory::get_type(originalPair) == Lisp_Object_Type::Symbol && - string_equal(originalPair->value.identifier, "unquote")) + string_equal(originalPair->value.symbol.identifier, "unquote")) { // eval replace the stuff return eval_expr(expr->value.pair.rest->value.pair.first, env); @@ -740,9 +740,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { // TODO(Felix): Maybe don't compare strings here?? Wtf if (Memory::get_type(type) == Lisp_Object_Type::Keyword && - (string_equal(type->value.identifier, "lambda") || - string_equal(type->value.identifier, "special-lambda") || - string_equal(type->value.identifier, "macro"))) + (string_equal(type->value.symbol.identifier, "lambda") || + string_equal(type->value.symbol.identifier, "special-lambda") || + string_equal(type->value.symbol.identifier, "macro"))) { Lisp_Object* fun = eval_expr(arguments->value.pair.first, env); @@ -926,7 +926,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* source = evaluated_arguments->value.pair.first; - return Memory::get_or_create_lisp_object_keyword(source->value.identifier); + return Memory::get_or_create_lisp_object_keyword(source->value.symbol.identifier); }); defun("string->symbol", cLambda { // TODO(Felix): do some sanity checks on the string. For @@ -947,7 +947,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* source = evaluated_arguments->value.pair.first; - return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.identifier)); + return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol.identifier)); }); defun("concat-strings", cLambda { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); diff --git a/src/env.cpp b/src/env.cpp index e927f1c..68bcbbc 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -10,7 +10,7 @@ proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*)); } - env->keys [env->next_index] = Memory::get_c_str(symbol->value.identifier); + env->keys [env->next_index] = Memory::get_c_str(symbol->value.symbol.identifier); env->values[env->next_index] = value; ++env->next_index; } @@ -24,7 +24,7 @@ proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Ob proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { // first check current environment - String* identifier = node->value.identifier; + String* identifier = node->value.symbol.identifier; Lisp_Object* result; result = lookup_symbol_in_this_envt(identifier, env); if (result) @@ -53,7 +53,7 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { if (result) return result; - String* identifier = node->value.identifier; + String* identifier = node->value.symbol.identifier; create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); print_environment(env); return nullptr; diff --git a/src/error.cpp b/src/error.cpp index df7155c..2fef0ba 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -14,7 +14,7 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S delete_error(); debug_break(); - // visualize_lisp_machine(); + visualize_lisp_machine(); using Globals::error; error = new(Error); diff --git a/src/eval.cpp b/src/eval.cpp index 26bcb86..fcbfdac 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -34,7 +34,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> bool accepted = false; for (int i = 0; i < function->keyword_arguments->next_index; ++i) { if (string_equal( - arguments->value.pair.first->value.identifier, + arguments->value.pair.first->value.symbol.identifier, function->keyword_arguments->identifiers[i])) { accepted = true; @@ -48,14 +48,14 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // (special case with default variables) create_generic_error( "The function does not take the keyword argument ':%s'", - &(arguments->value.pair.first->value.identifier)); + &(arguments->value.pair.first->value.symbol.identifier)); return nullptr; } // check if it was already read in for (int i = 0; i < read_in_keywords->next_index; ++i) { if (string_equal( - arguments->value.pair.first->value.identifier, + arguments->value.pair.first->value.symbol.identifier, read_in_keywords->data[i])) { // TODO(Felix): if we are actually done with all the @@ -64,7 +64,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // (special case with default variables) create_generic_error( "The function already read the keyword argument ':%s'", - &(arguments->value.pair.first->value.identifier)); + &(arguments->value.pair.first->value.symbol.identifier)); return nullptr; } } @@ -75,15 +75,15 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> 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.identifier)); + &(arguments->value.pair.first->value.symbol.identifier)); return nullptr; } // if not set it and then add it to the array list - try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier), + try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier), define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env); - append_to_array_list(read_in_keywords, arguments->value.pair.first->value.identifier); + append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier); // overstep both for next one arguments = arguments->value.pair.rest->value.pair.rest; @@ -177,13 +177,13 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // okay let's try to read some positional arguments while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { - if (string_equal(arguments->value.pair.first->value.identifier, "keys") || - string_equal(arguments->value.pair.first->value.identifier, "rest")) + if (string_equal(arguments->value.pair.first->value.symbol.identifier, "keys") || + string_equal(arguments->value.pair.first->value.symbol.identifier, "rest")) break; else { create_parsing_error("A non recognized marker was found " "in the lambda list: ':%s'", - &arguments->value.pair.first->value.identifier); + &arguments->value.pair.first->value.symbol.identifier); return; } } @@ -198,7 +198,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // okay wow we found an actual symbol append_to_positional_argument_list( function->positional_arguments, - arguments->value.pair.first->value.identifier); + arguments->value.pair.first->value.symbol.identifier); arguments = arguments->value.pair.rest; } @@ -212,7 +212,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { } if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword && - string_equal(arguments->value.pair.first->value.identifier, "keys")) + string_equal(arguments->value.pair.first->value.symbol.identifier, "keys")) { arguments = arguments->value.pair.rest; if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { @@ -227,12 +227,12 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { - if (string_equal(arguments->value.pair.first->value.identifier, "rest")) + if (string_equal(arguments->value.pair.first->value.symbol.identifier, "rest")) break; else { create_parsing_error( "Only the :rest keyword can be parsed here, but got ':%s'.", - &arguments->value.pair.first->value.identifier->data); + &arguments->value.pair.first->value.symbol.identifier->data); return; } } @@ -250,7 +250,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { Lisp_Object* next = arguments->value.pair.rest; if (Memory::get_type(next) == Lisp_Object_Type::Pair && Memory::get_type(next->value.pair.first) == Lisp_Object_Type::Keyword && - string_equal(next->value.pair.first->value.identifier, + string_equal(next->value.pair.first->value.symbol.identifier, "defaults-to")) { // check if there is a next argument too, otherwise it @@ -258,7 +258,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { next = next->value.pair.rest; if (Memory::get_type(next) == Lisp_Object_Type::Pair) { append_to_keyword_argument_list(function->keyword_arguments, - arguments->value.pair.first->value.identifier, + arguments->value.pair.first->value.symbol.identifier, next->value.pair.first); arguments = next->value.pair.rest; } else { @@ -268,7 +268,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { } else { // No :defaults-to, so just add it to the list append_to_keyword_argument_list(function->keyword_arguments, - arguments->value.pair.first->value.identifier, + arguments->value.pair.first->value.symbol.identifier, nullptr); arguments = next; } @@ -285,7 +285,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { } if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword && - string_equal(arguments->value.pair.first->value.identifier, "rest")) + string_equal(arguments->value.pair.first->value.symbol.identifier, "rest")) { arguments = arguments->value.pair.rest; if (// arguments->type != Lisp_Object_Type::Pair || @@ -294,7 +294,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { create_parsing_error("After the 'rest' marker there must follow a symbol."); return; } - function->rest_argument = arguments->value.pair.first->value.identifier; + function->rest_argument = arguments->value.pair.first->value.symbol.identifier; if (arguments->value.pair.rest != Memory::nil) { create_parsing_error("The lambda list must end after the rest symbol"); } @@ -326,7 +326,7 @@ proc list_length(Lisp_Object* node) -> int { proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* { // NOTE(Felix): This will be a hashmap lookup later for (int i = 0; i < args->keyword_keys->next_index; ++i) { - if (string_equal(args->keyword_keys->data[i]->value.identifier, keyword)) + if (string_equal(args->keyword_keys->data[i]->value.symbol.identifier, keyword)) return args->keyword_values->data[i]; } return nullptr; diff --git a/src/io.cpp b/src/io.cpp index 37270f8..0a90320 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -211,7 +211,7 @@ proc read_line() -> char* { return linep; } -proc log_message(Log_Level type, char* message) -> void { +proc log_message(Log_Level type, const char* message) -> void { if (type > Globals::log_level) return; @@ -238,7 +238,7 @@ proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) -> case (Lisp_Object_Type::T): fputs("t", file); break; case (Lisp_Object_Type::Number): 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.identifier)); break; + case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break; case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break; case (Lisp_Object_Type::String): { if (print_quotes) { diff --git a/src/memory.cpp b/src/memory.cpp index f3e6c33..cd4dbfd 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -72,6 +72,19 @@ namespace Memory { node->flags = (u64)(node->flags) | bitmask; } + proc hash(String* str) -> u64 { + // TODO(Felix): When parsing symbols or keywords, compute the + // hash while reading them in. + u64 value = str->data << 7; + for (int i = 1; i < str->length; ++i) { + char c = ((char*)&str->data)[i]; + value = (1000003 * value) ^ c; + } + value ^= str->length; + + return value; + + } proc create_string(const char* str, int len) -> String* { // TODO(Felix): check the holes first, not just always append @@ -216,7 +229,8 @@ namespace Memory { try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Symbol); // node->value.symbol = new(Symbol); - node->value.identifier = identifier; + node->value.symbol.identifier = identifier; + node->value.symbol.hash = hash(identifier); return node; } @@ -235,7 +249,8 @@ namespace Memory { try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Keyword); // node->value.keyword = new(Keyword); - node->value.identifier = keyword; + node->value.symbol.identifier = keyword; + node->value.symbol.hash = hash(keyword); return node; } diff --git a/src/parse.cpp b/src/parse.cpp index fc801f8..f43ad4c 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -365,7 +365,7 @@ namespace Parser { // 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.identifier)) { + if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) { // create a new macro Lisp_Object* arguments = expression->value.pair.rest; Lisp_Object* body; @@ -426,7 +426,7 @@ namespace Parser { // print_environment(environment_for_macros); return Memory::nil; - } else if (string_equal("delete-syntax", parsed_symbol->value.identifier)) { + } 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 diff --git a/src/structs.cpp b/src/structs.cpp index 93a93ed..4c63548 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -57,10 +57,12 @@ struct Source_Code_Location { struct Symbol { String* identifier; + u64 hash; }; struct Keyword { String* identifier; + u64 hash; }; // struct Number { @@ -109,7 +111,7 @@ struct Lisp_Object { u64 flags; Lisp_Object* userType; union { - String* identifier; // used for symbols and keywords + Symbol symbol; // used for symbols and keywords double number; String* string; Pair pair; diff --git a/src/testing.cpp b/src/testing.cpp index 8c9c176..768304d 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -222,7 +222,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.identifier, "haha"); + assert_equal_string(operands->value.pair.first->value.symbol.identifier, "haha"); return pass; } @@ -259,26 +259,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.identifier, "key1"); + assert_equal_string(result->value.symbol.identifier, "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.identifier, "key:2"); + assert_equal_string(result->value.symbol.identifier, "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.identifier, "sym"); + assert_equal_string(result->value.symbol.identifier, "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.identifier, "+"); + assert_equal_string(result->value.symbol.identifier, "+"); return pass; } @@ -292,13 +292,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.identifier, "fun"); + assert_equal_string(result->value.pair.first->value.symbol.identifier, "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.identifier, "+"); + assert_equal_string(result->value.pair.first->value.symbol.identifier, "+"); result = result->value.pair.rest; @@ -318,20 +318,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.identifier, "define"); + assert_equal_string(result->value.pair.first->value.symbol.identifier, "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.identifier, "fun"); + assert_equal_string(result->value.pair.first->value.symbol.identifier, "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.identifier, "lambda"); + assert_equal_string(result->value.pair.first->value.pair.first->value.symbol.identifier, "lambda"); result = result->value.pair.rest; @@ -500,7 +500,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.identifier, "number"); + assert_equal_string(result->value.symbol.identifier, "number"); // setting user type char exp_string2[] = "(prog (set-type a :my-type)(type a))"; @@ -510,7 +510,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.identifier, "my-type"); + assert_equal_string(result->value.symbol.identifier, "my-type"); // trying to set invalid user type char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))"; @@ -531,7 +531,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.identifier, "number"); + assert_equal_string(result->value.symbol.identifier, "number"); return pass; } diff --git a/src/visualization.cpp b/src/visualization.cpp index ec57b31..28a411f 100644 --- a/src/visualization.cpp +++ b/src/visualization.cpp @@ -6,9 +6,10 @@ proc visualize_lisp_machine() -> void { int height; }; - fprintf(stderr, "Drawing visualization..."); + log_message(Log_Level::Info, "Drawing visualization..."); + defer { - fprintf(stderr, "Done!\n"); + log_message(Log_Level::Info, "Done drawing visualization!"); }; const int padding = 40; @@ -20,15 +21,14 @@ proc visualize_lisp_machine() -> void { FILE *f = fopen("visualization.svg", "w"); - defer { - fclose(f); - }; - - if (f == NULL) { - create_generic_error("The file for writing the visualization" + if (!f) { + create_generic_error("The file for writing the visualization " "could not be opened for writing"); return; } + defer { + fclose(f); + }; int max_x = 0, max_y = 0, @@ -170,7 +170,7 @@ proc visualize_lisp_machine() -> void { 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"); + Drawn_Area text = draw_text(&obj->value.symbol.identifier->data, "#c61b6e"); write_x -= colon.width; return { colon.x, @@ -179,8 +179,12 @@ proc visualize_lisp_machine() -> void { colon.height }; } - case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20); - default: return {0}; + case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20); + case Lisp_Object_Type::Function: return draw_text("Function", "#aa1100"); + case Lisp_Object_Type::CFunction: return draw_text("CFunction", "#11aa00"); + default: + fprintf(stderr, "Do not know hot to visualize type %d\n", Memory::get_type(obj)); + return {0}; } }; draw_pair = [&](Lisp_Object* pair) -> Drawn_Area { @@ -439,7 +443,7 @@ proc visualize_lisp_machine() -> void { draw_new_line(); write_x = start_x; - draw_text(&symbols->data[i]->value.identifier->data); + draw_text(&symbols->data[i]->value.symbol.identifier->data); }