From 3277e50164e1dff8eab3a562d71d976e2202e144 Mon Sep 17 00:00:00 2001 From: Felix Brendel Date: Sat, 20 Apr 2019 17:26:18 +0200 Subject: [PATCH] Moved type info into a flags field in the lisp objects --- src/built_ins.cpp | 84 ++++++++++++++++++++++--------------------- src/defines.cpp | 4 +-- src/eval.cpp | 83 +++++++++++++++++++++--------------------- src/forward_decls.cpp | 1 + src/io.cpp | 8 ++--- src/memory.cpp | 33 ++++++++++++----- src/parse.cpp | 14 ++++---- src/structs.cpp | 31 ++++++---------- src/testing.cpp | 12 +++---- 9 files changed, 139 insertions(+), 131 deletions(-) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index aba179f..6c93310 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -1,10 +1,10 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { if (n1 == n2) return true; - if (n1->type != n2->type) + if (Memory::get_type(n1) != Memory::get_type(n2)) return false; - switch (n1->type) { + switch (Memory::get_type(n1)) { case Lisp_Object_Type::CFunction: // if they have the same // pointer, true is returned a @@ -72,7 +72,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* { // Function* function = new(Function); Lisp_Object* ret = Memory::create_lisp_object(); - ret->type = Lisp_Object_Type::Function; + Memory::set_type(ret, Lisp_Object_Type::Function); ret->value.function.parent_environment = env; @@ -82,7 +82,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { ret->value.function.type = Function_Type::Lambda; // if parameters were specified - if (arguments->value.pair.first->type != Lisp_Object_Type::Nil) { + if (arguments->value.pair.first != Memory::nil) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair); } @@ -97,7 +97,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { arguments = arguments->value.pair.rest; // if there is a docstring, use it - if (arguments->value.pair.first->type == Lisp_Object_Type::String) { + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::String) { ret->value.function.docstring = arguments->value.pair.first->value.string; arguments = arguments->value.pair.rest; } else { @@ -121,12 +121,12 @@ proc load_built_ins_into_environment(Environment* env) -> void { arguments = eval_arguments(arguments, env, &arguments_length); } - if (arguments->type == Lisp_Object_Type::Nil) + if (arguments == Memory::nil) return Memory::t; Lisp_Object* first = arguments->value.pair.first; - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { if (!lisp_object_equal(arguments->value.pair.first, first)) return Memory::nil; arguments = arguments->value.pair.rest; @@ -142,7 +142,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double last_number = strtod("Inf", NULL); - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -164,7 +164,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double last_number = strtod("Inf", NULL); - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -186,7 +186,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double last_number = strtod("-Inf", NULL); - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -208,7 +208,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double last_number = strtod("-Inf", NULL); - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -229,7 +229,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { } double sum = 0; - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -251,7 +251,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double difference = arguments->value.pair.first->value.number; arguments = arguments->value.pair.rest; - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -273,7 +273,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double product = arguments->value.pair.first->value.number; arguments = arguments->value.pair.rest; - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -295,7 +295,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { double quotient = arguments->value.pair.first->value.number; arguments = arguments->value.pair.rest; - while (arguments->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); } @@ -351,7 +351,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* symbol = arguments->value.pair.first; Lisp_Object* value; - if (symbol->type == Lisp_Object_Type::Pair) { + if (Memory::get_type(symbol) == Lisp_Object_Type::Pair) { /* 1: arguments 2: symbol @@ -433,9 +433,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try assert(arguments_length == 2); - if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil || - evaluated_arguments->value.pair.first->type == Lisp_Object_Type::T || - evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword) + if (evaluated_arguments->value.pair.first == Memory::nil || + evaluated_arguments->value.pair.first == Memory::t || + Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword) { create_generic_error("You cannot mutate nil, t or keywords"); } @@ -486,12 +486,12 @@ proc load_built_ins_into_environment(Environment* env) -> void { std::function unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;}; unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* { // if it is an atom, return it - if (expr->type != Lisp_Object_Type::Pair) + if (Memory::get_type(expr) != Lisp_Object_Type::Pair) return Memory::copy_lisp_object(expr); // it is a pair! Lisp_Object* originalPair = expr->value.pair.first; - if (originalPair->type == Lisp_Object_Type::Symbol && + if (Memory::get_type(originalPair) == Lisp_Object_Type::Symbol && string_equal(originalPair->value.identifier, "unquote")) { // eval replace the stuff @@ -510,10 +510,10 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* newPair = Memory::create_lisp_object_pair(nullptr, nullptr); Lisp_Object* newPairHead = newPair; Lisp_Object* head = expr; - while (head->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(head) == Lisp_Object_Type::Pair) { newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first); - if (head->value.pair.rest->type != Lisp_Object_Type::Pair) + if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) break; newPairHead->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); @@ -534,7 +534,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { }); defun("and", cLambda { bool result = true; - while (arguments->type != Lisp_Object_Type::Nil) { + while (arguments != Memory::nil) { try assert_type(arguments, Lisp_Object_Type::Pair); try result &= is_truthy(arguments->value.pair.first, env); @@ -545,7 +545,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { }); defun("or", cLambda { bool result = false; - while (arguments->type != Lisp_Object_Type::Nil) { + while (arguments != Memory::nil) { try assert_type(arguments, Lisp_Object_Type::Pair); try result |= is_truthy(arguments->value.pair.first, env); @@ -576,7 +576,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { while (true) { try condition = eval_expr(condition_part, env); - if (condition->type == Lisp_Object_Type::Nil) + if (condition == Memory::nil) break; try result = eval_expr(then_part->value.pair.first, env); @@ -592,7 +592,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Environment* let_env = Memory::create_child_environment(env); Lisp_Object* bindings = arguments->value.pair.first; while (true) { - if (bindings->type == Lisp_Object_Type::Nil) { + if (bindings == Memory::nil) { break; } @@ -622,7 +622,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* evaluated_arguments; try evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length); - if (evaluated_arguments->type == Lisp_Object_Type::Nil) + if (evaluated_arguments == Memory::nil) return evaluated_arguments; // skip to the last evaluated operand and return it, @@ -630,7 +630,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // manually, because we want to increase code reuse, // but at the cost that we have to find the end of the // list again - while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) { evaluated_arguments = evaluated_arguments->value.pair.rest; } return evaluated_arguments->value.pair.first; @@ -670,7 +670,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { defun("prog", cLambda { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); - if (evaluated_arguments->type == Lisp_Object_Type::Nil) + if (evaluated_arguments == Memory::nil) return evaluated_arguments; // skip to the last evaluated operand and return it, @@ -678,7 +678,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // manually, because we want to increase code reuse, // but at the cost that we have to find the end of the // list again - while (evaluated_arguments->value.pair.rest->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) { evaluated_arguments = evaluated_arguments->value.pair.rest; } return evaluated_arguments->value.pair.first; @@ -698,7 +698,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try assert(arguments_length == 1); - if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil) + if (evaluated_arguments->value.pair.first == Memory::nil) return Memory::nil; try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Pair); @@ -709,7 +709,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try assert(arguments_length == 1); - if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil) + if (evaluated_arguments->value.pair.first == Memory::nil) return Memory::nil; try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Pair); @@ -743,7 +743,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { return evaluated_arguments->value.pair.first->userType; } - Lisp_Object_Type type = evaluated_arguments->value.pair.first->type; + Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first); switch (type) { case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); case Lisp_Object_Type::Function: { @@ -784,7 +784,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { printf("\n\n"); // TODO(Felix): Maybe don't compare strings here?? Wtf - if (type->type == Lisp_Object_Type::Keyword && + 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"))) @@ -937,11 +937,13 @@ proc load_built_ins_into_environment(Environment* env) -> void { try assert(arguments_length == 1); - if (evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Nil || - evaluated_arguments->value.pair.first->type == Lisp_Object_Type::T || - evaluated_arguments->value.pair.first->type == Lisp_Object_Type::Keyword) + if (evaluated_arguments->value.pair.first == Memory::nil || + evaluated_arguments->value.pair.first == Memory::t || + Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Symbol || + Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword) { - create_generic_error("The values of 'nil', 't', and keywords can't be copied."); + // we don't copy singleton objects + return evaluated_arguments->value.pair.first; } Lisp_Object* target = Memory::create_lisp_object(); @@ -995,7 +997,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { Lisp_Object* head = evaluated_arguments; - while (head->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(head) == Lisp_Object_Type::Pair) { try assert_type(head->value.pair.first, Lisp_Object_Type::String); resulting_string_len += head->value.pair.first->value.string->length; @@ -1007,7 +1009,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { String* resulting_string = Memory::create_string("", resulting_string_len); int index_in_string = 0; - while (head->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(head) == Lisp_Object_Type::Pair) { strcpy((&resulting_string->data)+index_in_string, Memory::get_c_str(head->value.pair.first->value.string)); index_in_string += head->value.pair.first->value.string->length; diff --git a/src/defines.cpp b/src/defines.cpp index 578ef82..e07905c 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -151,8 +151,8 @@ struct { #define assert_type(_node, _type) \ do { \ - if (_node->type != _type) { \ - create_type_missmatch_error("symbol", Lisp_Object_Type_to_string(_node->type)); \ + if (Memory::get_type(_node) != _type) { \ + create_type_missmatch_error("symbol", Lisp_Object_Type_to_string(Memory::get_type(_node))); \ } \ } while(0) diff --git a/src/eval.cpp b/src/eval.cpp index bfe3e94..e7c1066 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -3,7 +3,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // positional arguments for (int i = 0; i < function->positional_arguments->next_index; ++i) { - if (arguments->type != Lisp_Object_Type::Pair) { + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i); return nullptr; } @@ -19,14 +19,14 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> String_Array_List* read_in_keywords = create_String_array_list(); - if (arguments->type == Lisp_Object_Type::Nil) + if (Memory::get_type(arguments) == Lisp_Object_Type::Nil) goto checks; // keyword arguments: use all given ones and keep track of the // added ones (array list), if end of parameters in encountered or // something that is not a keyword is encountered or a keyword // that is not recognized is encoutered, jump out of the loop. - while (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) { + while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { // check if this one is even an accepted keyword bool accepted = false; for (int i = 0; i < function->keyword_arguments->next_index; ++i) { @@ -69,7 +69,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // okay so we found a keyword that has to be read in and was // not already read in, is there a next element to actually // set it to? - if (arguments->value.pair.rest->type != Lisp_Object_Type::Pair) { + 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)); @@ -87,7 +87,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // overstep both for next one arguments = arguments->value.pair.rest->value.pair.rest; - if (arguments->type == Lisp_Object_Type::Nil) { + if (arguments == Memory::nil) { break; } } @@ -127,7 +127,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> } - if (arguments->type == Lisp_Object_Type::Nil) { + if (arguments == Memory::nil) { if (function->rest_argument) { define_symbol( Memory::get_or_create_lisp_object_symbol(function->rest_argument), @@ -181,8 +181,8 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { function->rest_argument = nullptr; // okay let's try to read some positional arguments - while (arguments->type == Lisp_Object_Type::Pair) { - if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) { + 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")) break; @@ -194,10 +194,10 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { } } - if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) { + if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) { create_parsing_error("Only symbols and keywords can be " "parsed here, but found '%s'", - Lisp_Object_Type_to_string(arguments->value.pair.first->type)); + Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first))); return; } @@ -211,17 +211,17 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // okay we are done with positional arguments, lets check for // keywords, - if (arguments->type != Lisp_Object_Type::Pair) { - if (arguments->type != Lisp_Object_Type::Nil) + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { + if (arguments != Memory::nil) create_parsing_error("The lambda list must be nil terminated."); return; } - if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword && + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword && string_equal(arguments->value.pair.first->value.identifier, "keys")) { arguments = arguments->value.pair.rest; - if (arguments->type != Lisp_Object_Type::Pair) { + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { create_parsing_error("Actual keys have to follow the :keys indicator."); } // if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) { @@ -231,8 +231,8 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // return; // } - while (arguments->type == Lisp_Object_Type::Pair) { - if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword) { + 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")) break; else { @@ -243,10 +243,10 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { } } - if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) { + if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) { create_parsing_error( "Only symbols can be parsed here, but found '%s'.", - Lisp_Object_Type_to_string(arguments->value.pair.first->type)); + Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first))); return; } @@ -254,15 +254,15 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // the keyword args! Let's check if the next arguement is // :defaults-to Lisp_Object* next = arguments->value.pair.rest; - if (next->type == Lisp_Object_Type::Pair && - next->value.pair.first->type == Lisp_Object_Type::Keyword && + 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, "defaults-to")) { // check if there is a next argument too, otherwise it // would be an error next = next->value.pair.rest; - if (next->type == Lisp_Object_Type::Pair) { + if (Memory::get_type(next) == Lisp_Object_Type::Pair) { append_to_keyword_argument_list(function->keyword_arguments, arguments->value.pair.first->value.identifier, next->value.pair.first); @@ -284,24 +284,24 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // Now we are also done with keyword arguments, lets check for // if there is a rest argument - if (arguments->type != Lisp_Object_Type::Pair) { - if (arguments->type != Lisp_Object_Type::Nil) + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { + if (arguments != Memory::nil) create_parsing_error("The lambda list must be nil terminated."); return; } - if (arguments->value.pair.first->type == Lisp_Object_Type::Keyword && + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword && string_equal(arguments->value.pair.first->value.identifier, "rest")) { arguments = arguments->value.pair.rest; if (// arguments->type != Lisp_Object_Type::Pair || - arguments->value.pair.first->type != Lisp_Object_Type::Symbol) + Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) { create_parsing_error("After the 'rest' marker there must follow a symbol."); return; } function->rest_argument = arguments->value.pair.first->value.identifier; - if (arguments->value.pair.rest->type != Lisp_Object_Type::Nil) { + if (arguments->value.pair.rest != Memory::nil) { create_parsing_error("The lambda list must end after the rest symbol"); } } else { @@ -312,16 +312,16 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { proc list_length(Lisp_Object* node) -> int { - if (node->type == Lisp_Object_Type::Nil) + if (node == Memory::nil) return 0; assert_type(node, Lisp_Object_Type::Pair); int len = 0; - while (node->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(node) == Lisp_Object_Type::Pair) { ++len; node = node->value.pair.rest; - if (node->type == Lisp_Object_Type::Nil) + if (node == Memory::nil) return len; } @@ -340,7 +340,7 @@ proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* { int my_out_arguments_length = 0; - if (arguments->type == Lisp_Object_Type::Nil) { + if (arguments == Memory::nil) { *(out_arguments_length) = 0; return arguments; } @@ -348,7 +348,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments Lisp_Object* evaluated_arguments = Memory::create_lisp_object_pair(nullptr, nullptr); Lisp_Object* evaluated_arguments_head = evaluated_arguments; Lisp_Object* current_head = arguments; - while (current_head->type == Lisp_Object_Type::Pair) { + while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { try { evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env); @@ -356,10 +356,10 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; current_head = current_head->value.pair.rest; - if (current_head->type == Lisp_Object_Type::Pair) { + if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; - } else if (current_head->type == Lisp_Object_Type::Nil) { + } else if (current_head == Memory::nil) { evaluated_arguments_head->value.pair.rest = current_head; } else { create_parsing_error("Attempting to evaluate ill formed argument list."); @@ -372,7 +372,9 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments } proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { - switch (node->type) { + Globals::current_source_code = node; + + switch (Memory::get_type(node)) { case Lisp_Object_Type::T: case Lisp_Object_Type::Nil: case Lisp_Object_Type::Number: @@ -387,11 +389,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { return symbol; } case Lisp_Object_Type::Pair: { - Globals::current_source_code = node; Lisp_Object* lispOperator; - if (node->value.pair.first->type != Lisp_Object_Type::CFunction && - node->value.pair.first->type != Lisp_Object_Type::Function) + if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && + Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) { try { lispOperator = eval_expr(node->value.pair.first, env); @@ -404,13 +405,13 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { int arguments_length; // check for c function - if (lispOperator->type == Lisp_Object_Type::CFunction) { + if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { Lisp_Object* result = lispOperator->value.cFunction->function(arguments, env); return result; } // check for lisp function - if (lispOperator->type == Lisp_Object_Type::Function) { + if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { // only for lambdas we evaluate the arguments before // apllying if (lispOperator->value.function.type == Function_Type::Lambda) { @@ -427,7 +428,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { } } default: { - create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(node->type)); + create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); return nullptr; } } @@ -438,7 +439,7 @@ proc is_truthy (Lisp_Object* expression, Environment* env) -> bool { try { result = eval_expr(expression, env); } - if (result->type == Lisp_Object_Type::Nil) + if (result == Memory::nil) return false; return true; } diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index 72fbdf8..53585ca 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -15,6 +15,7 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; namespace Memory { proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*; + inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type; } namespace Globals { diff --git a/src/io.cpp b/src/io.cpp index 2f71504..2d95825 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -230,12 +230,12 @@ proc panic(char* message) -> void { proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) -> void { - switch (node->type) { + switch (Memory::get_type(node)) { case (Lisp_Object_Type::Nil): fputs("()", file); break; 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, Memory::get_c_str(node->value.identifier)); break; + case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.identifier)); break; case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break; case (Lisp_Object_Type::String): { if (print_quotes) { @@ -268,12 +268,12 @@ proc print(Lisp_Object* node, bool print_quotes = false, FILE* file = stdout) -> head = head->value.pair.rest; if (!head) return; - if (head->type != Lisp_Object_Type::Pair) + if (Memory::get_type(head) != Lisp_Object_Type::Pair) break; putc(' ', file); } - if (head->type != Lisp_Object_Type::Nil) { + if (Memory::get_type(head) != Lisp_Object_Type::Nil) { fputs(" . ", file); print(head); } diff --git a/src/memory.cpp b/src/memory.cpp index 3f85ebc..7e3d85f 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -51,6 +51,21 @@ namespace Memory { return get_c_str(str->value.string); } + inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type { + // the type is in the bits 0 to 5 (including) + return (Lisp_Object_Type) ((u64)node->flags & (u64)0xffffff); + } + + + inline proc set_type(Lisp_Object* node, Lisp_Object_Type type) { + // the type is in the bits 0 to 5 (including) + u64 bitmask = (u64)-1; + bitmask -= 0xffffff; + bitmask += (u64) type; + node->flags = (u64)(node->flags) | bitmask; + } + + proc create_string(const char* str, int len) -> String* { // TODO(Felix): check the holes first, not just always append // at the end @@ -136,11 +151,11 @@ namespace Memory { // init nil nil = create_lisp_object(); - nil->type = Lisp_Object_Type::Nil; + set_type(nil, Lisp_Object_Type::Nil); // init t t = create_lisp_object(); - t->type = Lisp_Object_Type::T; + set_type(t, Lisp_Object_Type::T); } proc reset() -> void { @@ -152,21 +167,21 @@ namespace Memory { proc create_lisp_object_number(double number) -> Lisp_Object* { Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::Number; + set_type(node, Lisp_Object_Type::Number); node->value.number = number; return node; } proc create_lisp_object_string(String* str) -> Lisp_Object* { Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::String; + set_type(node, Lisp_Object_Type::String); node->value.string = str; return node; } proc create_lisp_object_string(char* str) -> Lisp_Object* { Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::String; + set_type(node, Lisp_Object_Type::String); node->value.string = create_string(str); return node; } @@ -175,7 +190,7 @@ namespace Memory { // TODO(Felix): if we already have it stored somewhere then // reuse it and dont create new one Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::Symbol; + set_type(node, Lisp_Object_Type::Symbol); // node->value.symbol = new(Symbol); node->value.identifier = identifier; return node; @@ -193,7 +208,7 @@ namespace Memory { // TODO(Felix): if we already have it stored somewhere then // reuse it and dont create new one Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::Keyword; + set_type(node, Lisp_Object_Type::Keyword); // node->value.keyword = new(Keyword); node->value.identifier = keyword; return node; @@ -209,7 +224,7 @@ namespace Memory { proc create_lisp_object_cfunction(std::function function) -> Lisp_Object* { Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::CFunction; + set_type(node, Lisp_Object_Type::CFunction); // node->value.lambdaWrapper = new Lambda_Wrapper(function); node->value.cFunction = new(cFunction); node->value.cFunction->function = function; @@ -218,7 +233,7 @@ namespace Memory { proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { Lisp_Object* node = create_lisp_object(); - node->type = Lisp_Object_Type::Pair; + set_type(node, Lisp_Object_Type::Pair); // node->value.pair = new(Pair); node->value.pair.first = first; node->value.pair.rest = rest; diff --git a/src/parse.cpp b/src/parse.cpp index 23ec281..036ef36 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -292,7 +292,7 @@ namespace Parser { // okay there is something Lisp_Object* head = Memory::create_lisp_object(); - head->type = Lisp_Object_Type::Pair; + Memory::set_type(head, Lisp_Object_Type::Pair); // head->value.pair = new(Pair); Lisp_Object* expression = head; @@ -352,7 +352,7 @@ namespace Parser { } // check if we have to create or delete or run macros - if (expression->value.pair.first->type == Lisp_Object_Type::Symbol) { + if (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) { if (string_equal("define-syntax", expression->value.pair.first->value.identifier)) { // create a new macro Lisp_Object* arguments = expression->value.pair.rest; @@ -378,12 +378,12 @@ namespace Parser { // Function* function = new(Function); Lisp_Object* macro = Memory::create_lisp_object(); - macro->type = Lisp_Object_Type::Function; + Memory::set_type(macro, Lisp_Object_Type::Function); macro->value.function.parent_environment = environment_for_macros; macro->value.function.type = Function_Type::Macro; // if parameters were specified - if (arguments->value.pair.first->type != Lisp_Object_Type::Nil) { + if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Nil) { try { assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair); } @@ -398,7 +398,7 @@ namespace Parser { arguments = arguments->value.pair.rest; // if there is a docstring, use it - if (arguments->value.pair.first->type == Lisp_Object_Type::String) { + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::String) { macro->value.function.docstring = arguments->value.pair.first->value.string; arguments = arguments->value.pair.rest; } else { @@ -439,7 +439,7 @@ namespace Parser { for (int i = 0; i < environment_for_macros->next_index; ++i) { if (string_equal(expression->value.pair.first->value.identifier, environment_for_macros->keys[i]) && - environment_for_macros->values[i]->type == Lisp_Object_Type::Function && + Memory::get_type(environment_for_macros->values[i]) == Lisp_Object_Type::Function && environment_for_macros->values[i]->value.function.type == Function_Type::Macro) { try { @@ -543,7 +543,7 @@ namespace Parser { for (int i = 0; i < program->next_index; ++i) { // a macro will parse as nil for now, so we skip those - if (program->data[i]->type == Lisp_Object_Type::Nil) + if (program->data[i] == Memory::nil) continue; print(program->data[i], true, f); fprintf(f, "\n\n"); diff --git a/src/structs.cpp b/src/structs.cpp index df23d84..f394e14 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -16,36 +16,25 @@ enum struct Lisp_Object_Type { String, Pair, // Pointer, + // OwningPointer, Function, CFunction, }; +typedef uint64_t u64; + +enum class Lisp_Object_Flags : u64 +{ + // bits 0 to 5 will be reserved for the type + aliveness = 1 << 6, +}; + enum struct Function_Type { Lambda, Special_Lambda, Macro }; -// enum struct Error_Type { -// Assertion_Error, -// File_Not_Found, -// Ill_Formed_Arguments, -// Ill_Formed_Lambda_List, -// Ill_Formed_List, -// Not_A_Function, -// Not_Yet_Implemented, -// Out_Of_Memory, -// Symbol_Not_Defined, -// Syntax_Error, -// Trailing_Garbage, -// Type_Missmatch, -// Unbalanced_Parenthesis, -// Unexpected_Eof, -// Unknown_Error, -// Unknown_Keyword_Argument, -// Wrong_Number_Of_Arguments, -// }; - enum struct Log_Level { None, Critical, @@ -116,7 +105,7 @@ struct cFunction { struct Lisp_Object { Source_Code_Location* sourceCodeLocation; - Lisp_Object_Type type; + u64 flags; Lisp_Object* userType; union { String* identifier; // used for symbols and keywords diff --git a/src/testing.cpp b/src/testing.cpp index 4cb9767..e3a05af 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -63,13 +63,13 @@ return fail; \ } -#define assert_equal_type(node, _type) \ - if (node->type != _type) { \ - print_assert_equal_fail( \ - Lisp_Object_Type_to_string(node->type), \ +#define assert_equal_type(node, _type) \ + if (Memory::get_type(node) != _type) { \ + print_assert_equal_fail( \ + Lisp_Object_Type_to_string(Memory::get_type(node)), \ Lisp_Object_Type_to_string(_type), char*, "%s"); \ - return fail; \ - } \ + return fail; \ + } \ #define assert_null(variable) \ assert_equal_int(variable, nullptr)