fixed the tests with new args

This commit is contained in:
Felix Brendel
2019-09-21 01:24:15 +02:00
parent 5f90f2877f
commit 47b33f2f3a
14 changed files with 1108 additions and 1439 deletions
+29 -39
View File
@@ -1,5 +1,5 @@
inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
static Lisp_Object* begin_symbol = Memory::get_or_create_lisp_object_symbol("begin");
Lisp_Object* begin_symbol = Memory::get_or_create_lisp_object_symbol("begin");
if (body->value.pair.rest == Memory::nil)
return body->value.pair.first;
else
@@ -101,11 +101,11 @@ proc built_in_import(String* file_name) -> Lisp_Object* {
}
proc load_built_ins_into_environment() -> void {
static String* file_name_built_ins = Memory::create_string(__FILE__);
String* file_name_built_ins = Memory::create_string(__FILE__);
#define fetch1(var) \
static Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__)
@@ -128,12 +128,12 @@ proc load_built_ins_into_environment() -> void {
// parser relys on being able to temporaily put in markers
// in the code
#define _define_helper(def, docs, special) \
static Lisp_Object* label(params,__LINE__) = Parser::parse_single_expression( \
auto label(params,__LINE__) = Parser::parse_single_expression( \
Memory::get_c_str(Memory::create_string(#def)) \
); \
assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \
assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \
static auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \
/*NOTE(Felix): for evaluating default args*/ \
push_environment(get_root_environment()); \
@@ -481,13 +481,13 @@ proc load_built_ins_into_environment() -> void {
fetch(sym, val);
try assert_type(sym, Lisp_Object_Type::Symbol);
Environment* target_env;
in_caller_env {
val = eval_expr(val);
target_env = find_binding_environment(sym->value.symbol.identifier, get_current_environment());
try assert(target_env);
}
Environment* target_env = find_binding_environment(sym->value.symbol.identifier, get_current_environment());
try assert(target_env);
push_environment(target_env);
{
@@ -728,13 +728,14 @@ proc load_built_ins_into_environment() -> void {
return result;
};
define((begin . args), "TODO") {
define_special((begin . args), "TODO") {
fetch(args);
Lisp_Object* result = Memory::nil;
for_lisp_list(args) {
try result = eval_expr(it);
in_caller_env {
for_lisp_list(args) {
try result = eval_expr(it);
}
}
return result;
};
define((list . args), "TODO") {
@@ -813,6 +814,10 @@ proc load_built_ins_into_environment() -> void {
}
return Memory::get_or_create_lisp_object_keyword("unknown");
};
define((mem-reset), "TODO") {
Memory::reset();
return Memory::nil;
};
// NOTE(Felix): we need to define_special because the docstring is
// attached to the symbol. Because some object are singletons
// (symbols, keyowrds, nil, t) we dont want to store docs on the
@@ -887,20 +892,6 @@ proc load_built_ins_into_environment() -> void {
printf("}\n");
}
// }
// // TODO(Felix): Maybe don't compare strings here?? Wtf
// if (Memory::get_type(type) == Lisp_Object_Type::Keyword &&
// (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(n);
// if (fun->docstring)
// printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->docstring));
// else
// printf("No docstring avaliable\n");
return Memory::nil;
};
define((show n), "TODO") {
@@ -968,21 +959,20 @@ proc load_built_ins_into_environment() -> void {
Memory::print_status();
return Memory::nil;
};
// // defun("try", "TODO", __LINE__, cLambda {
// // try arguments_length = list_length(arguments);
// // try assert_arguments_length(2, arguments_length);
define_special((mytry try_part catch_part), "TODO") {
fetch(try_part, catch_part);
// // Lisp_Object* try_part = arguments->value.pair.first;
// // Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first;
// // Lisp_Object* result;
Lisp_Object* result;
// // result = eval_expr(try_part);
// // if (Globals::error) {
// // delete_error();
// // try result = eval_expr(catch_part);
// // }
// // return result;
// // });
in_caller_env {
result = eval_expr(try_part);
if (Globals::error) {
delete_error();
try result = eval_expr(catch_part);
}
}
return result;
};
define((load file), "TODO") {
fetch(file);
try assert_type(file, Lisp_Object_Type::String);
+3 -1
View File
@@ -84,7 +84,9 @@ inline proc get_current_environment() -> Environment* {
}
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
assert_type(node, Lisp_Object_Type::Symbol);
// print(node);
// printf("\n");
assert_type(node, Lisp_Object_Type::Symbol);
Lisp_Object* result = try_lookup_symbol(node, env);
+1 -1
View File
@@ -16,7 +16,7 @@ proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, S
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
// debug_break();
}
// visualize_lisp_machine();
+1
View File
@@ -321,6 +321,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
value = eval_expr(value);
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
}
+1 -1
View File
@@ -4,7 +4,7 @@ int main(int argc, char* argv[]) {
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
Slime::interprete_file((char*)"generate-docs.slime");
// Slime::interprete_file((char*)"generate-docs.slime");
return res ? 0 : 1;
}