|
|
|
@@ -34,6 +34,9 @@ namespace Slime { |
|
|
|
Lisp_Object* sym, *val; // used as temp storage to use `try` |
|
|
|
Array_List<Lisp_Object*> read_in_keywords; |
|
|
|
read_in_keywords.alloc(); |
|
|
|
defer {
|
|
|
|
read_in_keywords.dealloc();
|
|
|
|
};
|
|
|
|
int obligatory_keywords_count = 0; |
|
|
|
int read_obligatory_keywords_count = 0; |
|
|
|
|
|
|
|
@@ -234,234 +237,6 @@ namespace Slime { |
|
|
|
return new_env; |
|
|
|
} |
|
|
|
|
|
|
|
// proc create_extended_environment_for_function_application( |
|
|
|
// Lisp_Object* unevaluated_arguments, |
|
|
|
// Lisp_Object* function, |
|
|
|
// bool should_evaluate) -> Environment* |
|
|
|
// { |
|
|
|
// profile_this(); |
|
|
|
// bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; |
|
|
|
// Environment* new_env; |
|
|
|
// Lisp_Object* arguments = unevaluated_arguments; |
|
|
|
// Arguments* arg_spec; |
|
|
|
|
|
|
|
// // NOTE(Felix): Step 1. |
|
|
|
// // - setting the parent environment |
|
|
|
// // - setting the arg_spec |
|
|
|
// // - potentially evaluating the arguments |
|
|
|
// if (is_c_function) { |
|
|
|
// new_env = Memory::create_child_environment(get_root_environment()); |
|
|
|
// arg_spec = &function->value.cFunction->args; |
|
|
|
// } else { |
|
|
|
// new_env = Memory::create_child_environment(function->value.function->parent_environment); |
|
|
|
// arg_spec = &function->value.function->args; |
|
|
|
// } |
|
|
|
// if (should_evaluate) { |
|
|
|
// try arguments = eval_arguments(arguments); |
|
|
|
// } |
|
|
|
|
|
|
|
// // NOTE(Felix): Even though we will return the environment at the |
|
|
|
// // end, for defining symbols here for the parameters, it has to be |
|
|
|
// // on the envi stack. |
|
|
|
// push_environment(new_env); |
|
|
|
// defer { |
|
|
|
// pop_environment(); |
|
|
|
// }; |
|
|
|
|
|
|
|
|
|
|
|
// // NOTE(Felix): Step 2. |
|
|
|
// // Reading the argument spec and fill in the environment |
|
|
|
// // for the function call |
|
|
|
|
|
|
|
// Lisp_Object* sym, *val; // used as temp storage to use `try` |
|
|
|
// Array_List<Lisp_Object*> read_in_keywords; |
|
|
|
// read_in_keywords.alloc(); |
|
|
|
// defer { |
|
|
|
// read_in_keywords.dealloc(); |
|
|
|
// }; |
|
|
|
// int obligatory_keywords_count = 0; |
|
|
|
// int read_obligatory_keywords_count = 0; |
|
|
|
|
|
|
|
// proc read_positional_args = [&]() -> void { |
|
|
|
// for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { |
|
|
|
// if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { |
|
|
|
// create_parsing_error("Wrong number of arguments."); |
|
|
|
// return; |
|
|
|
// } |
|
|
|
// // NOTE(Felix): We have to copy all the arguments, |
|
|
|
// // otherwise we change the program code. XXX(Felix): T C |
|
|
|
// // functions we pass by reference... |
|
|
|
// sym = arg_spec->positional.symbols.data[i]; |
|
|
|
// if (is_c_function) { |
|
|
|
// define_symbol(sym, arguments->value.pair.first); |
|
|
|
// } else { |
|
|
|
// define_symbol( |
|
|
|
// sym, |
|
|
|
// Memory::copy_lisp_object_except_pairs(arguments->value.pair.first)); |
|
|
|
// } |
|
|
|
|
|
|
|
// arguments = arguments->value.pair.rest; |
|
|
|
// } |
|
|
|
// }; |
|
|
|
|
|
|
|
// proc read_keyword_args = [&]() -> void { |
|
|
|
// // 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. |
|
|
|
|
|
|
|
// if (arguments == Memory::nil) |
|
|
|
// return; |
|
|
|
|
|
|
|
// // find out how many keyword args we /have/ to read |
|
|
|
// for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { |
|
|
|
// if (arg_spec->keyword.values.data[i] == nullptr) |
|
|
|
// ++obligatory_keywords_count; |
|
|
|
// else |
|
|
|
// break; |
|
|
|
// } |
|
|
|
|
|
|
|
|
|
|
|
// 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 < arg_spec->keyword.values.next_index; ++i) { |
|
|
|
// if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i]) |
|
|
|
// { |
|
|
|
// accepted = true; |
|
|
|
// break; |
|
|
|
// } |
|
|
|
// } |
|
|
|
// if (!accepted) { |
|
|
|
// // NOTE(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) |
|
|
|
// if (read_obligatory_keywords_count == obligatory_keywords_count) |
|
|
|
// return; |
|
|
|
// create_generic_error( |
|
|
|
// "The function does not take the keyword argument ':%s'\n" |
|
|
|
// "and not all required keyword arguments have been read\n" |
|
|
|
// "in to potentially count it as the rest argument.", |
|
|
|
// &(arguments->value.pair.first->value.symbol->data)); |
|
|
|
// return; |
|
|
|
// } |
|
|
|
|
|
|
|
// // check if it was already read in |
|
|
|
// for (int i = 0; i < read_in_keywords.next_index; ++i) { |
|
|
|
// if (arguments->value.pair.first == read_in_keywords.data[i]) |
|
|
|
// { |
|
|
|
// // NOTE(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) |
|
|
|
// if (read_obligatory_keywords_count == obligatory_keywords_count) |
|
|
|
// return; |
|
|
|
// create_generic_error( |
|
|
|
// "The function already read the keyword argument ':%s'", |
|
|
|
// &(arguments->value.pair.first->value.symbol->data)); |
|
|
|
// return; |
|
|
|
// } |
|
|
|
// } |
|
|
|
|
|
|
|
// // 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.symbol->data)); |
|
|
|
// return; |
|
|
|
// } |
|
|
|
|
|
|
|
// // if not set it and then add it to the array list |
|
|
|
// try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol); |
|
|
|
// // NOTE(Felix): It seems we do not need to evaluate the argument here... |
|
|
|
// if (is_c_function) { |
|
|
|
// try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); |
|
|
|
// } else { |
|
|
|
// try_void define_symbol( |
|
|
|
// sym, |
|
|
|
// Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); |
|
|
|
// } |
|
|
|
|
|
|
|
// read_in_keywords.append(arguments->value.pair.first); |
|
|
|
// ++read_obligatory_keywords_count; |
|
|
|
|
|
|
|
// // overstep both for next one |
|
|
|
// arguments = arguments->value.pair.rest->value.pair.rest; |
|
|
|
|
|
|
|
// if (arguments == Memory::nil) { |
|
|
|
// break; |
|
|
|
// } |
|
|
|
// } |
|
|
|
// }; |
|
|
|
|
|
|
|
// proc check_keyword_args = [&]() -> void { |
|
|
|
// // check if all necessary keywords have been read in |
|
|
|
// for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { |
|
|
|
// auto defined_keyword = arg_spec->keyword.keywords.data[i]; |
|
|
|
// bool was_set = false; |
|
|
|
// for (int j = 0; j < read_in_keywords.next_index; ++j) { |
|
|
|
// if (read_in_keywords.data[j] == defined_keyword) { |
|
|
|
// was_set = true; |
|
|
|
// break; |
|
|
|
// } |
|
|
|
// } |
|
|
|
// if (arg_spec->keyword.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->value.symbol->data); |
|
|
|
// return; |
|
|
|
// } |
|
|
|
// } 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_void sym = Memory::get_symbol(defined_keyword->value.symbol); |
|
|
|
// if (is_c_function) { |
|
|
|
// try_void val = arg_spec->keyword.values.data[i]; |
|
|
|
// } else { |
|
|
|
// try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]); |
|
|
|
// } |
|
|
|
// define_symbol(sym, val); |
|
|
|
// } |
|
|
|
// } |
|
|
|
// } |
|
|
|
// }; |
|
|
|
|
|
|
|
// proc read_rest_arg = [&]() -> void { |
|
|
|
// if (arguments == Memory::nil) { |
|
|
|
// if (arg_spec->rest) { |
|
|
|
// define_symbol(arg_spec->rest, Memory::nil); |
|
|
|
// } |
|
|
|
// } else { |
|
|
|
// if (arg_spec->rest) { |
|
|
|
// define_symbol( |
|
|
|
// arg_spec->rest, |
|
|
|
// // NOTE(Felix): arguments will be a list, and I THINK |
|
|
|
// // we do not need to copy it... |
|
|
|
// arguments); |
|
|
|
// } 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; |
|
|
|
// } |
|
|
|
// } |
|
|
|
// }; |
|
|
|
|
|
|
|
// try read_positional_args(); |
|
|
|
// try read_keyword_args(); |
|
|
|
// try check_keyword_args(); |
|
|
|
// try read_rest_arg(); |
|
|
|
|
|
|
|
// return new_env; |
|
|
|
// } |
|
|
|
|
|
|
|
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { |
|
|
|
// profile_this(); |
|
|
|
@@ -591,47 +366,12 @@ namespace Slime { |
|
|
|
return nullptr; |
|
|
|
} |
|
|
|
|
|
|
|
// proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* { |
|
|
|
// profile_this(); |
|
|
|
// // 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); |
|
|
|
|
|
|
|
// evaluated_arguments_head->value.pair.first->sourceCodeLocation = |
|
|
|
// copy_scl(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 pause() { |
|
|
|
printf("\n-----------------------\n" |
|
|
|
"Press ENTER to continue\n"); |
|
|
|
getchar(); |
|
|
|
} |
|
|
|
|
|
|
|
inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { |
|
|
|
Lisp_Object* begin_symbol = Memory::get_symbol("begin"); |
|
|
|
if (body->value.pair.rest == Memory::nil) |
|
|
|
@@ -648,7 +388,6 @@ namespace Slime { |
|
|
|
nas->alloc(); |
|
|
|
defer { |
|
|
|
--nass.next_index; |
|
|
|
nas->data = nullptr; |
|
|
|
nas->dealloc(); |
|
|
|
}; |
|
|
|
|
|
|
|
@@ -835,77 +574,6 @@ namespace Slime { |
|
|
|
|
|
|
|
proc eval_expr(Lisp_Object* node) -> Lisp_Object* { |
|
|
|
return nrc_eval(node); |
|
|
|
// profile_this(); |
|
|
|
|
|
|
|
// using namespace Globals::Current_Execution; |
|
|
|
// call_stack.append(node); |
|
|
|
// defer { |
|
|
|
// --call_stack.next_index; |
|
|
|
// }; |
|
|
|
|
|
|
|
// switch (Memory::get_type(node)) { |
|
|
|
// case Lisp_Object_Type::Symbol: { |
|
|
|
// Lisp_Object* value; |
|
|
|
// try value = lookup_symbol(node, get_current_environment()); |
|
|
|
// return value; |
|
|
|
// } |
|
|
|
// 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); |
|
|
|
// } else { |
|
|
|
// lispOperator = node->value.pair.first; |
|
|
|
// } |
|
|
|
|
|
|
|
// Lisp_Object* arguments = node->value.pair.rest; |
|
|
|
// // check for c function |
|
|
|
// if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { |
|
|
|
// Lisp_Object* result; |
|
|
|
// try result = apply_arguments_to_function( |
|
|
|
// arguments, |
|
|
|
// lispOperator, |
|
|
|
// !lispOperator->value.cFunction->is_special_form); |
|
|
|
// return result; |
|
|
|
// } |
|
|
|
|
|
|
|
// // check for lisp function |
|
|
|
// if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { |
|
|
|
// // only for lambdas we evaluate the arguments before |
|
|
|
// // apllying, for the other types, special-lambda and macro |
|
|
|
// // we do not need. |
|
|
|
|
|
|
|
// Lisp_Object* result; |
|
|
|
// try result = apply_arguments_to_function( |
|
|
|
// arguments, |
|
|
|
// lispOperator, |
|
|
|
// lispOperator->value.function->type == Function_Type::Lambda); |
|
|
|
|
|
|
|
// // NOTE(Felix): The parser does not understnad (import ..) |
|
|
|
// // so it cannot expand imported macros at read time |
|
|
|
// // (because at read time, they are not imported yet, this |
|
|
|
// // is done at runtime...). That is why we sometimes have |
|
|
|
// // stray macros fying around, in that case, we expand them |
|
|
|
// // and bake them in, so they do not have to be expanded |
|
|
|
// // later again. We will call this "lazy macro expansion" |
|
|
|
// if (lispOperator->value.function->type == Function_Type::Macro) { |
|
|
|
// // bake in the macro expansion: |
|
|
|
// *node = *Memory::copy_lisp_object(result); |
|
|
|
// result->sourceCodeLocation = copy_scl(result->sourceCodeLocation); |
|
|
|
// // eval again because macro |
|
|
|
// try result = eval_expr(result); |
|
|
|
// } |
|
|
|
|
|
|
|
// return result; |
|
|
|
// } |
|
|
|
|
|
|
|
// create_generic_error("The first element of the pair was not a function but: %s", |
|
|
|
// Lisp_Object_Type_to_string(Memory::get_type(lispOperator))); |
|
|
|
// return nullptr; |
|
|
|
// } |
|
|
|
// default: return node; |
|
|
|
// } |
|
|
|
} |
|
|
|
|
|
|
|
proc is_truthy(Lisp_Object* expression) -> bool { |
|
|
|
|