proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { Environment* new_env = Memory::create_child_environment(function->parent_environment); Lisp_Object* sym, *val; // used as temp storage to use `try` // positional arguments for (int i = 0; i < function->positional_arguments->next_index; ++i) { if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i); return nullptr; } // TODO(Felix): here we create new lisp_object_symbols from // their identifiers but before we converted them to // strings from symbols... Wo maybe just use the symbols? try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]); define_symbol(sym, arguments->value.pair.first, new_env); arguments = arguments->value.pair.rest; } String_Array_List* read_in_keywords = create_String_array_list(); if (arguments == Memory::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 (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) { if (string_equal( arguments->value.pair.first->value.identifier, function->keyword_arguments->identifiers[i])) { accepted = true; break; } } if (!accepted) { // TODO(Felix): if we are actually done with all the // necessary keywords then we have to count the rest // as :rest here, instead od always creating an error // (special case with default variables) create_generic_error( "The function does not take the keyword argument ':%s'", &(arguments->value.pair.first->value.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, read_in_keywords->data[i])) { // TODO(Felix): if we are actually done with all the // necessary keywords then we have to count the rest // as :rest here, instead od always creating an error // (special case with default variables) create_generic_error( "The function already read the keyword argument ':%s'", &(arguments->value.pair.first->value.identifier)); return nullptr; } } // 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 (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)); 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), 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); // overstep both for next one arguments = arguments->value.pair.rest->value.pair.rest; if (arguments == Memory::nil) { break; } } checks: // check if all necessary keywords have been read in for (int i = 0; i < function->keyword_arguments->next_index; ++i) { String* defined_keyword = function->keyword_arguments->identifiers[i]; bool was_set = false; for (int j = 0; j < read_in_keywords->next_index; ++j) { if (string_equal( read_in_keywords->data[j], defined_keyword)) { was_set = true; break; } } if (function->keyword_arguments->values->data[i] == nullptr) { // if this one does not have a default value if (!was_set) { create_generic_error( "There was no value supplied for the required " "keyword argument ':%s'.", &defined_keyword->data); return nullptr; } } else { // this one does have a default value, lets see if we have // to use it or if the user supplied his own if (!was_set) { try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]); define_symbol(sym, val, new_env); } } } if (arguments == Memory::nil) { if (function->rest_argument) { try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); define_symbol(sym, Memory::nil, new_env); } } else { if (function->rest_argument) { try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); define_symbol(sym, arguments, new_env); } else { // rest was not declared but additional arguments were found create_generic_error( "A rest argument was not declared " "but the function was called with additional arguments."); return nullptr; } } Lisp_Object* result; try result = eval_expr(function->body, new_env); return result; } /* (prog (define type--before type) (define type (lambda (e) (if (and (= (type--before e) :pair) (= (first e) :my-type)) :my-type (type--before e)))) ) */ /** This parses the argument specification of funcitons into their Function struct. It dois this by allocating new positional_arguments, keyword_arguments and rest_argument and filling it in */ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { // first init the fields function->positional_arguments = create_positional_argument_list(16); function->keyword_arguments = create_keyword_argument_list(16); function->rest_argument = nullptr; // 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")) break; else { create_parsing_error("A non recognized marker was found " "in the lambda list: ':%s'", &arguments->value.pair.first->value.identifier); return; } } 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(Memory::get_type(arguments->value.pair.first))); return; } // okay wow we found an actual symbol append_to_positional_argument_list( function->positional_arguments, arguments->value.pair.first->value.identifier); arguments = arguments->value.pair.rest; } // okay we are done with positional arguments, lets check for // keywords, 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 (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 (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) { // create_parsing_error( // "Only symbols can be parsed here, but found '%s'.", // Lisp_Object_Type_to_string(arguments->value.pair.first->type)); // return; // } 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 { create_parsing_error( "Only the :rest keyword can be parsed here, but got ':%s'.", &arguments->value.pair.first->value.identifier->data); return; } } 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(Memory::get_type(arguments->value.pair.first))); return; } // we found a symbol (arguments->value.pair->first) for // the keyword args! Let's check if the next arguement is // :defaults-to 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, "defaults-to")) { // check if there is a next argument too, otherwise it // would be an error 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, next->value.pair.first); arguments = next->value.pair.rest; } else { create_parsing_error("Expecting a value after 'defaults-to'"); return; } } 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, nullptr); arguments = next; } } } // Now we are also done with keyword arguments, lets check for // if there is a rest argument 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 (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 || 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 != Memory::nil) { create_parsing_error("The lambda list must end after the rest symbol"); } } else { printf("this should not happen?"); create_generic_error("What is happening?"); } } proc list_length(Lisp_Object* node) -> int { if (node == Memory::nil) return 0; assert_type(node, Lisp_Object_Type::Pair); int len = 0; while (Memory::get_type(node) == Lisp_Object_Type::Pair) { ++len; node = node->value.pair.rest; if (node == Memory::nil) return len; } create_parsing_error("Can't calculate length of ill formed list."); return 0; } 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)) return args->keyword_values->data[i]; } return nullptr; } proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* { int my_out_arguments_length = 0; if (arguments == Memory::nil) { *(out_arguments_length) = 0; return arguments; } Lisp_Object* evaluated_arguments; try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); Lisp_Object* evaluated_arguments_head = evaluated_arguments; Lisp_Object* current_head = arguments; 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); evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; current_head = current_head->value.pair.rest; if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; } 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."); return nullptr; } ++my_out_arguments_length; } *(out_arguments_length) = my_out_arguments_length; return evaluated_arguments; } proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { 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: case Lisp_Object_Type::Keyword: case Lisp_Object_Type::String: return node; case Lisp_Object_Type::Symbol: { Lisp_Object* symbol; try symbol = lookup_symbol(node, env); return symbol; } case Lisp_Object_Type::Pair: { Lisp_Object* lispOperator; 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); } else { lispOperator = node->value.pair.first; } Lisp_Object* arguments = node->value.pair.rest; int arguments_length; // check for c function 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 (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) { try arguments = eval_arguments(arguments, env, &arguments_length); } Lisp_Object* result; try result = apply_arguments_to_function(arguments, &lispOperator->value.function); return result; } } default: { create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); return nullptr; } } } proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { Lisp_Object* result; try result = eval_expr(expression, env); return result != Memory::nil; } proc interprete_file (char* file_name) -> Lisp_Object* { Memory::init(4096 * 256, 4096 * 256); Environment* root_env = Globals::root_environment; Environment* user_env = Memory::create_child_environment(root_env); Parser::environment_for_macros = user_env; char* file_content; try file_content = read_entire_file(file_name); built_in_load(Memory::create_string("pre.slime"), root_env); Lisp_Object_Array_List* program; program = Parser::parse_program(Memory::create_string(file_name), file_content); Lisp_Object* result = Memory::nil; for (int i = 0; i < program->next_index; ++i) { result = eval_expr(program->data[i], user_env); if (Globals::error) { log_error(); delete_error(); return nullptr; } } return result; } proc interprete_stdin() -> void { Memory::init(4096 * 256, 4096 * 256); Environment* root_env = Globals::root_environment; Environment* user_env = Memory::create_child_environment(root_env); Parser::environment_for_macros = user_env; printf("Welcome to the lispy interpreter.\n"); char* line; built_in_import(Memory::create_string("pre.slime"), user_env); if (Globals::error) { log_error(); delete_error(); } Lisp_Object* parsed, * evaluated; while (true) { printf(">"); line = read_expression(); parsed = Parser::parse_single_expression(line); free(line); if (Globals::error) { log_error(); delete_error(); continue; } evaluated = eval_expr(parsed, user_env); if (Globals::error) { log_error(); delete_error(); continue; } print(evaluated); printf("\n"); } }