Cleanup, lisp_ob_to_string finally
This commit is contained in:
+14
-9
@@ -69,15 +69,16 @@ namespace Slime {
|
||||
Array_List<Lisp_Object*>* program;
|
||||
try program = Parser::parse_program(Memory::create_string(fullpath), file_content);
|
||||
|
||||
for (auto expr : *program) {
|
||||
// print(expr);
|
||||
// puts("");
|
||||
try result = eval_expr(expr);
|
||||
}
|
||||
|
||||
// NOTE(Felix): deferred so even if the eval failes, it will
|
||||
// run
|
||||
defer {
|
||||
program->dealloc();
|
||||
free(program);
|
||||
free(file_content);
|
||||
};
|
||||
for (auto expr : *program) {
|
||||
try result = eval_expr(expr);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
@@ -431,14 +432,18 @@ namespace Slime {
|
||||
return Memory::t;
|
||||
return Memory::nil;
|
||||
};
|
||||
define((assert test), "TODO") {
|
||||
define_special((assert test), "TODO") {
|
||||
profile_with_name("(assert)");
|
||||
fetch(test);
|
||||
|
||||
if (is_truthy(test))
|
||||
in_caller_env {
|
||||
if (is_truthy(nrc_eval(test)))
|
||||
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;
|
||||
};
|
||||
define_special((define-syntax form (:doc "") . body), "TODO") {
|
||||
|
||||
+4
-336
@@ -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 {
|
||||
|
||||
@@ -16,6 +16,7 @@ namespace Slime {
|
||||
|
||||
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
|
||||
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_environment(Environment*);
|
||||
|
||||
|
||||
+121
-58
@@ -302,73 +302,128 @@ namespace Slime {
|
||||
|
||||
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)) {
|
||||
case (Lisp_Object_Type::Nil): fputs("()", file); break;
|
||||
case (Lisp_Object_Type::T): fputs("t", file); break;
|
||||
case (Lisp_Object_Type::Nil): return strdup("()");
|
||||
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): {
|
||||
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
|
||||
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, "%s", Memory::get_c_str(node->value.symbol)); break;
|
||||
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
|
||||
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
|
||||
asprintf(&temp, "%f", node->value.number);
|
||||
return temp;
|
||||
}
|
||||
case (Lisp_Object_Type::Keyword): {
|
||||
asprintf(&temp, ":%s", Memory::get_c_str(node->value.symbol));
|
||||
return temp;
|
||||
}
|
||||
case (Lisp_Object_Type::Symbol): {
|
||||
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
|
||||
return temp;
|
||||
}
|
||||
case (Lisp_Object_Type::HashMap): {
|
||||
for_hash_map (*(node->value.hashMap)) {
|
||||
fputs(" ", file);
|
||||
print(key, true, file);
|
||||
fputs(" -> ", file);
|
||||
print((Lisp_Object*)value, true, file);
|
||||
fputs("\n", file);
|
||||
char* k = lisp_object_to_string(key, true);
|
||||
char* v = lisp_object_to_string((Lisp_Object*)value, true);
|
||||
asprintf(&temp, " %s -> %s\n", k, v);
|
||||
string_builder.append(temp);
|
||||
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): {
|
||||
asprintf(&temp, "%s", Memory::get_c_str(node->value.symbol));
|
||||
if (print_repr) {
|
||||
putc('\"', file);
|
||||
char* escaped = escape_string(Memory::get_c_str(node->value.string));
|
||||
fputs(escaped, file);
|
||||
putc('\"', file);
|
||||
string_builder.append(strdup("\""));
|
||||
string_builder.append(escaped);
|
||||
string_builder.append(strdup("\""));
|
||||
free(escaped);
|
||||
}
|
||||
else
|
||||
fputs(Memory::get_c_str(node->value.string), file);
|
||||
temp = string_buider_to_string(string_builder);
|
||||
// TODO free
|
||||
return temp;
|
||||
} else
|
||||
return strdup(Memory::get_c_str(node->value.string));
|
||||
} break;
|
||||
case (Lisp_Object_Type::Vector): {
|
||||
fputs("[", file);
|
||||
|
||||
string_builder.append(strdup("["));
|
||||
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) {
|
||||
fputs(" ", file);
|
||||
print(node->value.vector.data+i, print_repr, file);
|
||||
string_builder.append(strdup(" "));
|
||||
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;
|
||||
case (Lisp_Object_Type::Function): {
|
||||
if (node->userType) {
|
||||
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
|
||||
break;
|
||||
asprintf(&temp, "[%s]", Memory::get_c_str(node->userType->value.symbol));
|
||||
return temp;
|
||||
}
|
||||
if (node->value.function->is_c) {
|
||||
switch (node->value.function->type.c_function_type) {
|
||||
case C_Function_Type::cFunction: {fputs("[c-function]", file);} break;
|
||||
case C_Function_Type::cSpecial: {fputs("[c-special]", file);} break;
|
||||
case C_Function_Type::cMacro: {fputs("[c-macro]", file);} break;
|
||||
default: {fputs("[c-??]", file);}
|
||||
case C_Function_Type::cFunction: return strdup("[c-function]");
|
||||
case C_Function_Type::cSpecial: return strdup("[c-special]");
|
||||
case C_Function_Type::cMacro: return strdup("[c-macro]");
|
||||
default: return strdup("[c-??]");
|
||||
}
|
||||
} else {
|
||||
switch (node->value.function->type.lisp_function_type) {
|
||||
case Lisp_Function_Type::Lambda: {fputs("[lambda]", file);} break;
|
||||
case Lisp_Function_Type::Macro: {fputs("[macro]", file);} break;
|
||||
default: {fputs("[??]", file);}
|
||||
case Lisp_Function_Type::Lambda: return strdup("[lambda]");
|
||||
case Lisp_Function_Type::Macro: return strdup("[macro]");
|
||||
default: return strdup("[??]");
|
||||
}
|
||||
}
|
||||
} break;
|
||||
case (Lisp_Object_Type::Pair): {
|
||||
// TODO
|
||||
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
|
||||
// to print it prettier
|
||||
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)
|
||||
putc('\'', file);
|
||||
string_builder.append(strdup("\'"));
|
||||
else if (symbol == unquote_sym)
|
||||
putc(',', file);
|
||||
string_builder.append(strdup(","));
|
||||
else if (symbol == unquote_splicing_sym)
|
||||
fputs(",@", file);
|
||||
string_builder.append(strdup(",@"));
|
||||
|
||||
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
|
||||
assert(head->value.pair.rest->value.pair.rest == Memory::nil);
|
||||
|
||||
print(head->value.pair.rest->value.pair.first, print_repr, file);
|
||||
break;
|
||||
}
|
||||
else if (symbol == quasiquote_sym) {
|
||||
putc('`', file);
|
||||
string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
|
||||
temp = string_buider_to_string(string_builder);
|
||||
return string_buider_to_string(string_builder);
|
||||
} else if (symbol == quasiquote_sym) {
|
||||
string_builder.append(strdup("`"));
|
||||
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
|
||||
print(head->value.pair.rest->value.pair.first, print_repr, file);
|
||||
break;
|
||||
string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
|
||||
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
|
||||
// we want to print a broken list (for logging the error) we
|
||||
// should do more checks.
|
||||
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;
|
||||
if (!head)
|
||||
return;
|
||||
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
|
||||
break;
|
||||
putc(' ', file);
|
||||
if (!head) break;
|
||||
if (Memory::get_type(head) != Lisp_Object_Type::Pair) break;
|
||||
string_builder.append(strdup(" "));
|
||||
}
|
||||
|
||||
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
|
||||
fputs(" . ", file);
|
||||
print(head, print_repr, file);
|
||||
if (head && Memory::get_type(head) != Lisp_Object_Type::Nil) {
|
||||
string_builder.append(strdup(" . "));
|
||||
string_builder.append(lisp_object_to_string(head, print_repr));
|
||||
}
|
||||
|
||||
putc(')', file);
|
||||
} break;
|
||||
string_builder.append(strdup(")"));
|
||||
|
||||
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 {
|
||||
printf(console_cyan);
|
||||
@@ -457,6 +519,7 @@ namespace Slime {
|
||||
}
|
||||
|
||||
proc log_error() -> void {
|
||||
fputs("\n", stdout);
|
||||
fputs(console_red, stdout);
|
||||
fputs(Memory::get_c_str(Globals::error->message), stdout);
|
||||
puts(console_normal);
|
||||
|
||||
@@ -150,6 +150,7 @@ namespace Slime::Memory {
|
||||
Globals::Current_Execution::cs.dealloc();
|
||||
Globals::Current_Execution::ams.dealloc();
|
||||
Globals::Current_Execution::pcs.dealloc();
|
||||
Globals::Current_Execution::nass.dealloc();
|
||||
}
|
||||
|
||||
|
||||
|
||||
+34
-34
@@ -35,7 +35,6 @@ namespace Slime {
|
||||
print_assert_equal_fail(Globals::error, 0, size_t, "%zd"); \
|
||||
printf("\nExpected no error to occur," \
|
||||
" but an error occured anyways:\n"); \
|
||||
log_error(); \
|
||||
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");
|
||||
// invoke_test(test_parse_atom);
|
||||
// invoke_test(test_parse_expression);
|
||||
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-- Built ins --\n");
|
||||
// invoke_test(test_built_in_add);
|
||||
// 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);
|
||||
printf("\n -- Parsing --\n");
|
||||
invoke_test(test_parse_atom);
|
||||
invoke_test(test_parse_expression);
|
||||
|
||||
// printf("\n-- Memory management --\n");
|
||||
// invoke_test(test_singular_t_and_nil);
|
||||
// invoke_test(test_singular_symbols);
|
||||
printf("\n-- Built ins --\n");
|
||||
invoke_test(test_built_in_add);
|
||||
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");
|
||||
|
||||
// invoke_test_script("evaluation_of_default_args");
|
||||
// invoke_test_script("case_and_cond");
|
||||
// invoke_test_script("lexical_scope");
|
||||
// invoke_test_script("singular_imports");
|
||||
// invoke_test_script("hashmaps");
|
||||
// invoke_test_script("import_and_load");
|
||||
// invoke_test_script("macro_expand");
|
||||
// invoke_test_script("sicp");
|
||||
invoke_test_script("modules");
|
||||
invoke_test_script("evaluation_of_default_args");
|
||||
invoke_test_script("case_and_cond");
|
||||
invoke_test_script("lexical_scope");
|
||||
invoke_test_script("singular_imports");
|
||||
invoke_test_script("hashmaps");
|
||||
invoke_test_script("import_and_load");
|
||||
invoke_test_script("macro_expand");
|
||||
invoke_test_script("sicp");
|
||||
// invoke_test_script("modules");
|
||||
|
||||
|
||||
invoke_test_script("class_macro");
|
||||
// invoke_test_script("class_macro");
|
||||
// invoke_test_script("automata");
|
||||
// invoke_test_script("alists");
|
||||
|
||||
|
||||
Reference in New Issue
Block a user