felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanup, lisp_ob_to_string finally

Browse Source
This commit is contained in:
Felix Brendel
2020-02-13 18:12:00 +01:00
parent f34c111c2d
commit 7aa492df67
6 changed files with 179 additions and 441 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+14 -9
View File
@@ -69,15 +69,16 @@ namespace Slime {
Array_List<Lisp_Object*>* program; Array_List<Lisp_Object*>* program;
try program = Parser::parse_program(Memory::create_string(fullpath), file_content); try program = Parser::parse_program(Memory::create_string(fullpath), file_content);
for (auto expr : *program) { // NOTE(Felix): deferred so even if the eval failes, it will
// print(expr); // run
// puts(""); defer {
try result = eval_expr(expr);
}
program->dealloc(); program->dealloc();
free(program); free(program);
free(file_content); free(file_content);
};
for (auto expr : *program) {
try result = eval_expr(expr);
}
return result; return result;
} }
@@ -431,14 +432,18 @@ namespace Slime {
return Memory::t; return Memory::t;
return Memory::nil; return Memory::nil;
}; };
define((assert test), "TODO") { define_special((assert test), "TODO") {
profile_with_name("(assert)"); profile_with_name("(assert)");
fetch(test); fetch(test);
if (is_truthy(test)) in_caller_env {
if (is_truthy(nrc_eval(test)))
return Memory::t; return Memory::t;
}
create_generic_error("Userland assertion."); char* string = lisp_object_to_string(test, true);
create_generic_error("Userland assertion. (%s)", string);
free(string);
return nullptr; return nullptr;
}; };
define_special((define-syntax form (:doc "") . body), "TODO") { define_special((define-syntax form (:doc "") . body), "TODO") {
src/eval.cpp
+4 -336
View File
@@ -34,6 +34,9 @@ namespace Slime {
Lisp_Object* sym, *val; // used as temp storage to use `try` Lisp_Object* sym, *val; // used as temp storage to use `try`
Array_List<Lisp_Object*> read_in_keywords; Array_List<Lisp_Object*> read_in_keywords;
read_in_keywords.alloc(); read_in_keywords.alloc();
defer {
read_in_keywords.dealloc();
};
int obligatory_keywords_count = 0; int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0; int read_obligatory_keywords_count = 0;
@@ -234,234 +237,6 @@ namespace Slime {
return new_env; 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* { proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
// profile_this(); // profile_this();
@@ -591,47 +366,12 @@ namespace Slime {
return nullptr; 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() { proc pause() {
printf("\n-----------------------\n" printf("\n-----------------------\n"
"Press ENTER to continue\n"); "Press ENTER to continue\n");
getchar(); getchar();
} }
inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
Lisp_Object* begin_symbol = Memory::get_symbol("begin"); Lisp_Object* begin_symbol = Memory::get_symbol("begin");
if (body->value.pair.rest == Memory::nil) if (body->value.pair.rest == Memory::nil)
@@ -648,7 +388,6 @@ namespace Slime {
nas->alloc(); nas->alloc();
defer { defer {
--nass.next_index; --nass.next_index;
nas->data = nullptr;
nas->dealloc(); nas->dealloc();
}; };
@@ -835,77 +574,6 @@ namespace Slime {
proc eval_expr(Lisp_Object* node) -> Lisp_Object* { proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
return nrc_eval(node); 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 { proc is_truthy(Lisp_Object* expression) -> bool {
src/forward_decls.cpp
+1
View File
@@ -16,6 +16,7 @@ namespace Slime {
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value); void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*); void print_environment(Environment*);
src/io.cpp
+121 -58
View File
@@ -302,73 +302,128 @@ namespace Slime {
return wc; return wc;
} }
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
proc string_buider_to_string(Array_List<char*> string_builder) -> char* {
int len = 1;
int idx = 0;
for (auto str : string_builder) {
len += strlen(str);
}
char* res = (char*)(malloc(sizeof(char) * len));
res[0] = '\0';
for (auto str : string_builder) {
strcat(res, str);
}
return res;
}
proc lisp_object_to_string(Lisp_Object* node, bool print_repr) -> char* {
char* temp;
Array_List<char*> string_builder;
string_builder.alloc();
defer {
string_builder.dealloc();
};
switch (Memory::get_type(node)) { switch (Memory::get_type(node)) {
case (Lisp_Object_Type::Nil): fputs("()", file); break; case (Lisp_Object_Type::Nil): return strdup("()");
case (Lisp_Object_Type::T): fputs("t", file); break; case (Lisp_Object_Type::T): return strdup("t");
case (Lisp_Object_Type::Continuation): return strdup("[continuation]");
case (Lisp_Object_Type::Pointer): return strdup("[pointer]");
case (Lisp_Object_Type::Number): { case (Lisp_Object_Type::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f) if (abs(node->value.number - (int)node->value.number) < 0.000001f)
fprintf(file, "%d", (int)node->value.number); asprintf(&temp, "%d", (int)node->value.number);
else else
fprintf(file, "%f", node->value.number); asprintf(&temp, "%f", node->value.number);
} break; return temp;
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.symbol)); break; case (Lisp_Object_Type::Keyword): {
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break; asprintf(&temp, ":%s", Memory::get_c_str(node->value.symbol));
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break; return temp;
}
case (Lisp_Object_Type::Symbol): {
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
return temp;
}
case (Lisp_Object_Type::HashMap): { case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) { for_hash_map (*(node->value.hashMap)) {
fputs(" ", file); char* k = lisp_object_to_string(key, true);
print(key, true, file); char* v = lisp_object_to_string((Lisp_Object*)value, true);
fputs(" -> ", file); asprintf(&temp, " %s -> %s\n", k, v);
print((Lisp_Object*)value, true, file); string_builder.append(temp);
fputs("\n", file); free(v);
free(k);
}
temp = string_buider_to_string(string_builder);
// free all asprintfs
for (auto str : string_builder) {
free(str);
}
return temp;
} }
} break;
case (Lisp_Object_Type::String): { case (Lisp_Object_Type::String): {
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
if (print_repr) { if (print_repr) {
putc('\"', file);
char* escaped = escape_string(Memory::get_c_str(node->value.string)); char* escaped = escape_string(Memory::get_c_str(node->value.string));
fputs(escaped, file); string_builder.append(strdup("\""));
putc('\"', file); string_builder.append(escaped);
string_builder.append(strdup("\""));
free(escaped); free(escaped);
} temp = string_buider_to_string(string_builder);
else // TODO free
fputs(Memory::get_c_str(node->value.string), file); return temp;
} else
return strdup(Memory::get_c_str(node->value.string));
} break; } break;
case (Lisp_Object_Type::Vector): { case (Lisp_Object_Type::Vector): {
fputs("[", file);
string_builder.append(strdup("["));
if (node->value.vector.length > 0) if (node->value.vector.length > 0)
print(node->value.vector.data, print_repr, file); string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr));
for (int i = 1; i < node->value.vector.length; ++i) { for (int i = 1; i < node->value.vector.length; ++i) {
fputs(" ", file); string_builder.append(strdup(" "));
print(node->value.vector.data+i, print_repr, file); string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr));
} }
fputs("]", file); string_builder.append(strdup("]"));
temp = string_buider_to_string(string_builder);
for (auto str : string_builder) {
free(str);
}
return temp;
} break; } break;
case (Lisp_Object_Type::Function): { case (Lisp_Object_Type::Function): {
if (node->userType) { if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol)); asprintf(&temp, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break; return temp;
} }
if (node->value.function->is_c) { if (node->value.function->is_c) {
switch (node->value.function->type.c_function_type) { switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: {fputs("[c-function]", file);} break; case C_Function_Type::cFunction: return strdup("[c-function]");
case C_Function_Type::cSpecial: {fputs("[c-special]", file);} break; case C_Function_Type::cSpecial: return strdup("[c-special]");
case C_Function_Type::cMacro: {fputs("[c-macro]", file);} break; case C_Function_Type::cMacro: return strdup("[c-macro]");
default: {fputs("[c-??]", file);} default: return strdup("[c-??]");
} }
} else { } else {
switch (node->value.function->type.lisp_function_type) { switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: {fputs("[lambda]", file);} break; case Lisp_Function_Type::Lambda: return strdup("[lambda]");
case Lisp_Function_Type::Macro: {fputs("[macro]", file);} break; case Lisp_Function_Type::Macro: return strdup("[macro]");
default: {fputs("[??]", file);} default: return strdup("[??]");
} }
} }
} break; } break;
case (Lisp_Object_Type::Pair): { case (Lisp_Object_Type::Pair): {
// TODO
Lisp_Object* head = node; Lisp_Object* head = node;
defer {
for (auto str : string_builder) {
free(str);
}
};
// first check if it is a quotation form, in that case we want // first check if it is a quotation form, in that case we want
// to print it prettier // to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
@@ -383,50 +438,57 @@ namespace Slime {
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{ {
if (symbol == quote_sym) if (symbol == quote_sym)
putc('\'', file); string_builder.append(strdup("\'"));
else if (symbol == unquote_sym) else if (symbol == unquote_sym)
putc(',', file); string_builder.append(strdup(","));
else if (symbol == unquote_splicing_sym) else if (symbol == unquote_splicing_sym)
fputs(",@", file); string_builder.append(strdup(",@"));
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert(head->value.pair.rest->value.pair.rest == Memory::nil); assert(head->value.pair.rest->value.pair.rest == Memory::nil);
print(head->value.pair.rest->value.pair.first, print_repr, file); string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
break; temp = string_buider_to_string(string_builder);
} return string_buider_to_string(string_builder);
else if (symbol == quasiquote_sym) { } else if (symbol == quasiquote_sym) {
putc('`', file); string_builder.append(strdup("`"));
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file); string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
break; return string_buider_to_string(string_builder);
} }
} }
putc('(', file); string_builder.append(strdup("("));
// NOTE(Felix): We could do a while true here, however in case // NOTE(Felix): We could do a while true here, however in case
// we want to print a broken list (for logging the error) we // we want to print a broken list (for logging the error) we
// should do more checks. // should do more checks.
while (head) { while (head) {
print(head->value.pair.first, print_repr, file); string_builder.append(lisp_object_to_string(head->value.pair.first, print_repr));
head = head->value.pair.rest; head = head->value.pair.rest;
if (!head) if (!head) break;
return; if (Memory::get_type(head) != Lisp_Object_Type::Pair) break;
if (Memory::get_type(head) != Lisp_Object_Type::Pair) string_builder.append(strdup(" "));
break;
putc(' ', file);
} }
if (Memory::get_type(head) != Lisp_Object_Type::Nil) { if (head && Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file); string_builder.append(strdup(" . "));
print(head, print_repr, file); string_builder.append(lisp_object_to_string(head, print_repr));
} }
putc(')', file); string_builder.append(strdup(")"));
} break;
return string_buider_to_string(string_builder);
} }
} }
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
char* string = lisp_object_to_string(node, print_repr);
fputs(string, file);
free(string);
}
proc print_single_call(Lisp_Object* obj) -> void { proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan); printf(console_cyan);
@@ -457,6 +519,7 @@ namespace Slime {
} }
proc log_error() -> void { proc log_error() -> void {
fputs("\n", stdout);
fputs(console_red, stdout); fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout); fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal); puts(console_normal);
src/memory.cpp
+1
View File
@@ -150,6 +150,7 @@ namespace Slime::Memory {
Globals::Current_Execution::cs.dealloc(); Globals::Current_Execution::cs.dealloc();
Globals::Current_Execution::ams.dealloc(); Globals::Current_Execution::ams.dealloc();
Globals::Current_Execution::pcs.dealloc(); Globals::Current_Execution::pcs.dealloc();
Globals::Current_Execution::nass.dealloc();
} }
src/testing.cpp
+34 -34
View File
@@ -35,7 +35,6 @@ namespace Slime {
print_assert_equal_fail(Globals::error, 0, size_t, "%zd"); \ print_assert_equal_fail(Globals::error, 0, size_t, "%zd"); \
printf("\nExpected no error to occur," \ printf("\nExpected no error to occur," \
" but an error occured anyways:\n"); \ " but an error occured anyways:\n"); \
log_error(); \
return fail; \ return fail; \
} \ } \
@@ -591,47 +590,48 @@ namespace Slime {
} }
}; };
// push_environment(Memory::create_child_environment(
// get_current_environment()));
// printf("-- Util --\n");
// invoke_test(test_array_lists_adding_and_removing);
// invoke_test(test_array_lists_sorting);
// invoke_test(test_array_lists_searching);
// printf("\n -- Parsing --\n"); push_environment(Memory::create_child_environment(
// invoke_test(test_parse_atom); get_current_environment()));
// invoke_test(test_parse_expression); printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching);
// printf("\n-- Built ins --\n"); printf("\n -- Parsing --\n");
// invoke_test(test_built_in_add); invoke_test(test_parse_atom);
// invoke_test(test_built_in_substract); invoke_test(test_parse_expression);
// invoke_test(test_built_in_multiply);
// invoke_test(test_built_in_divide);
// invoke_test(test_built_in_if);
// invoke_test(test_built_in_and);
// invoke_test(test_built_in_or);
// invoke_test(test_built_in_not);
// invoke_test(test_built_in_type);
// printf("\n-- Memory management --\n"); printf("\n-- Built ins --\n");
// invoke_test(test_singular_t_and_nil); invoke_test(test_built_in_add);
// invoke_test(test_singular_symbols); invoke_test(test_built_in_substract);
invoke_test(test_built_in_multiply);
invoke_test(test_built_in_divide);
invoke_test(test_built_in_if);
invoke_test(test_built_in_and);
invoke_test(test_built_in_or);
invoke_test(test_built_in_not);
invoke_test(test_built_in_type);
// pop_environment(); printf("\n-- Memory management --\n");
invoke_test(test_singular_t_and_nil);
invoke_test(test_singular_symbols);
pop_environment();
printf("\n-- Test Files --\n"); printf("\n-- Test Files --\n");
// invoke_test_script("evaluation_of_default_args"); invoke_test_script("evaluation_of_default_args");
// invoke_test_script("case_and_cond"); invoke_test_script("case_and_cond");
// invoke_test_script("lexical_scope"); invoke_test_script("lexical_scope");
// invoke_test_script("singular_imports"); invoke_test_script("singular_imports");
// invoke_test_script("hashmaps"); invoke_test_script("hashmaps");
// invoke_test_script("import_and_load"); invoke_test_script("import_and_load");
// invoke_test_script("macro_expand"); invoke_test_script("macro_expand");
// invoke_test_script("sicp"); invoke_test_script("sicp");
invoke_test_script("modules"); // invoke_test_script("modules");
invoke_test_script("class_macro"); // invoke_test_script("class_macro");
// invoke_test_script("automata"); // invoke_test_script("automata");
// invoke_test_script("alists"); // invoke_test_script("alists");