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

More cleanup

Browse Source
This commit is contained in:
Felix Brendel
2019-11-14 00:36:12 +01:00
parent 8dbff42bdf
commit 650eba7f18
23 changed files with 4086 additions and 2737 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+13 -11
View File
@@ -726,7 +726,7 @@ proc load_built_ins_into_environment() -> void {
fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap);
Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap.get_object(key);
Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key);
if (!ret)
create_symbol_undefined_error("The key was not set in the hashmap");
@@ -735,13 +735,13 @@ proc load_built_ins_into_environment() -> void {
define((hash-map-set! hm key value), "TODO") {
fetch(hm, key, value);
try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap.set_object(key, value);
hm->value.hashMap->set_object(key, value);
return Memory::nil;
};
define((hash-map-delete! hm key), "TODO") {
fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap.delete_object(key);
hm->value.hashMap->delete_object(key);
return Memory::nil;
};
define((vector . args), "TODO") {
@@ -862,17 +862,17 @@ proc load_built_ins_into_environment() -> void {
printf("Postitional: {");
if (args->positional.symbols.next_index != 0) {
printf("%s",
Memory::get_c_str(args->positional.symbols.data[0]->value.symbol.identifier));
Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
for (int i = 1; i < args->positional.symbols.next_index; ++i) {
printf(", %s",
Memory::get_c_str(args->positional.symbols.data[i]->value.symbol.identifier));
Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
}
}
printf("}\n");
printf("Keyword: {");
if (args->keyword.values.next_index != 0) {
printf("%s",
Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol.identifier));
Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
if (args->keyword.values.data[0]) {
printf(" (");
print(args->keyword.values.data[0], true);
@@ -880,7 +880,7 @@ proc load_built_ins_into_environment() -> void {
}
for (int i = 1; i < args->keyword.values.next_index; ++i) {
printf(", %s",
Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol.identifier));
Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) {
printf(" (");
print(args->keyword.values.data[i], true);
@@ -892,7 +892,7 @@ proc load_built_ins_into_environment() -> void {
printf("Rest: {");
if (args->rest)
printf("%s",
Memory::get_c_str(args->rest->value.symbol.identifier));
Memory::get_c_str(args->rest->value.symbol));
printf("}\n");
}
@@ -918,7 +918,9 @@ proc load_built_ins_into_environment() -> void {
define((generate-docs file_name), "TODO") {
fetch(file_name);
try assert_type(file_name, Lisp_Object_Type::String);
// try generate_docs(file_name->value.string);
in_caller_env {
try generate_docs(file_name->value.string);
}
return Memory::t;
};
define((print (:sep " ") (:end "\n") . things), "TODO") {
@@ -1025,7 +1027,7 @@ proc load_built_ins_into_environment() -> void {
define((symbol->keyword sym), "TODO") {
fetch(sym);
try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::get_or_create_lisp_object_keyword(sym->value.symbol.identifier);
return Memory::get_or_create_lisp_object_keyword(sym->value.symbol);
};
define((string->symbol str), "TODO") {
fetch(str);
@@ -1041,7 +1043,7 @@ proc load_built_ins_into_environment() -> void {
try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::create_lisp_object_string(
Memory::duplicate_string(sym->value.symbol.identifier));
Memory::duplicate_string(sym->value.symbol));
};
define((concat-strings . strings), "TODO") {
fetch(strings);
src/define_macros.hpp
+4 -4
View File
@@ -5,7 +5,7 @@
do { \
if (Globals::log_level == Log_Level::Debug) { \
printf("in"); \
int spacing = 30-(int)strlen(__FILE__); \
int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\
if (spacing < 1) spacing = 1; \
for (int i = 0; i < spacing;++i) \
printf(" "); \
@@ -14,11 +14,11 @@
} \
} while(0)
#define if_error_log_location_and_return() \
#define if_error_log_location_and_return(val) \
do { \
if (Globals::error) { \
log_location(); \
return; \
return val; \
} \
} while(0)
@@ -51,7 +51,7 @@
#define fetch1(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__)
if_error_log_location_and_return(nullptr)
#define fetch2(var1, var2) fetch1(var1); fetch1(var2)
#define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3)
src/docgeneration.cpp
+137 -148
View File
@@ -1,157 +1,146 @@
// proc generate_docs(String* path) -> void {
// FILE *f = fopen(Memory::get_c_str(path), "w");
// if (!f) {
// create_generic_error("The file for writing the documentation (%s) "
// "could not be opened for writing.", Memory::get_c_str(path));
// return;
// }
// defer {
// fclose(f);
// };
proc generate_docs(String* path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) {
create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path));
return;
}
defer {
fclose(f);
};
// Environment_Array_List visited = create_Environment_array_list();
Array_List<Environment*> visited;
// // recursive inner funciton
// std::function<void(Environment*, char* prefix)> print_this_env;
// print_this_env = [&](Environment* env, char* prefix) -> void {
// bool we_already_printed = false;
// // TODO(Felix): Make a generic array_list_contains function
// for_array_list(visited) {
// if (it == env) {
// we_already_printed = true;
// break;
// }
// }
// if (!we_already_printed) {
// printf("Working ion env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
// append_to_array_list(&visited, env);
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function
for(auto it : visited) {
if (it == env) {
we_already_printed = true;
break;
}
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);
// push_environment(env);
// defer {
// pop_environment();
// };
push_environment(env);
defer {
pop_environment();
};
// for (int i = 0; i < env->next_index; ++i) {
// fprintf(f, "\\hrule\n* =%s%s= \n"
// // " :PROPERTIES:\n"
// // " :UNNUMBERED: t\n"
// // " :END:"
// ,prefix, env->keys[i]);
// /*
// * sourcecodeLocation
// */
// if (env->values[i]->sourceCodeLocation) {
// try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
// Memory::get_c_str(env->values[i]->sourceCodeLocation->file),
// env->values[i]->sourceCodeLocation->line,
// env->values[i]->sourceCodeLocation->column);
// }
// /*
// * type
// */
// Lisp_Object_Type type = Memory::get_type(env->values[i]);
// Lisp_Object* LOtype;
// try_void LOtype = eval_expr(Memory::create_list(
// Memory::get_or_create_lisp_object_symbol("type"),
// env->values[i]));
for_hash_map(env->hm) {
try_void fprintf(f,
"#+latex: \\hrule\n"
"#+html: <hr/>\n"
"* =%s%s= \n"
" :PROPERTIES:\n"
" :UNNUMBERED: t\n"
" :END:"
,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
/*
* sourcecodeLocation
*/
if (value->sourceCodeLocation) {
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
Memory::get_c_str(value->sourceCodeLocation->file),
value->sourceCodeLocation->line,
value->sourceCodeLocation->column);
}
/*
* type
*/
Lisp_Object_Type type = Memory::get_type(value);
Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(
Memory::get_or_create_lisp_object_symbol("type"),
value);
try_void LOtype = eval_expr(type_expr);
// fprintf(f, "\n - type :: =");
// print(LOtype, true, f);
// fprintf(f, "=");
fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
// /*
// * if printable value -> print it
// */
// switch (type) {
// case(Lisp_Object_Type::Nil):
// case(Lisp_Object_Type::T):
// case(Lisp_Object_Type::Number):
// case(Lisp_Object_Type::String):
// case(Lisp_Object_Type::Pair):
// case(Lisp_Object_Type::Symbol):
// case(Lisp_Object_Type::Keyword): {
// fprintf(f, "\n - value :: =");
// print(env->values[i], true, f);
// fprintf(f, "=");
// } break;
// default: break;
// }
// /*
// * if function then print arguments
// */
// if (type == Lisp_Object_Type::Function) {
// Lisp_Object* fun = env->values[i];
// bool printed_at_least_some_args = false;
// fprintf(f, "\n - arguments :: ");
// if (fun->value.function.args.positional.symbols.next_index != 0) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - postitional :: ");
// try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier));
// for (int i = 1; i < fun->value.function.args.positional.symbols.next_index; ++i) {
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[i]->value.symbol.identifier));
// }
// }
// if (fun->value.function.args.keyword.values.next_index != 0) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - keyword :: ");
// fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier));
// if (fun->value.function.args.keyword.values.data[0]) {
// fprintf(f, " =(");
// print(fun->value.function.args.keyword.values.data[0], true, f);
// fprintf(f, ")=");
// }
// for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) {
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[i]->value.symbol.identifier));
// if (fun->value.function.args.keyword.values.data[i]) {
// fprintf(f, " =(");
// print(fun->value.function.args.keyword.values.data[i], true, f);
// fprintf(f, ")=");
// }
// }
// }
// if (fun->value.function.args.rest) {
// if (!printed_at_least_some_args)
// fprintf(f, ":");
// fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier));
// }
// // if no args at all
// if (fun->value.function.args.positional.symbols.next_index == 0 &&
// fun->value.function.args.keyword.values.next_index == 0 &&
// !fun->value.function.args.rest)
// {
// fprintf(f, "none.");
// }
// }
// fprintf(f, "\n - docu :: ");
// if (env->values[i]->docstring)
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
// Memory::get_c_str(env->values[i]->docstring));
// else
// fprintf(f, "none\n");
/*
* if printable value -> print it
*/
switch (type) {
case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Pair):
case(Lisp_Object_Type::Symbol):
case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - value :: =");
print(value, true, f);
fprintf(f, "=");
} break;
default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function ||
type == Lisp_Object_Type::CFunction)
{
Arguments* args =
(type == Lisp_Object_Type::Function)
? &value->value.function->args
: &value->value.cFunction->args;
fprintf(f, "\n - arguments :: ");
// if no args at all
if (args->positional.symbols.next_index == 0 &&
args->keyword.values.next_index == 0 &&
!args->rest)
{
fprintf(f, "none.");
} else {
if (args->positional.symbols.next_index != 0) {
fprintf(f, "\n - postitional :: ");
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
for (int i = 1; i < args->positional.symbols.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
}
}
if (args->keyword.values.next_index != 0) {
fprintf(f, "\n - keyword :: ");
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
if (args->keyword.values.data[0]) {
fprintf(f, " =(");
print(args->keyword.values.data[0], true, f);
fprintf(f, ")=");
}
for (int i = 1; i < args->keyword.values.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) {
fprintf(f, " =(");
print(args->keyword.values.data[i], true, f);
fprintf(f, ")=");
}
}
}
if (args->rest) {
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
}
}
}
fprintf(f, "\n - docu :: ");
if (value->docstring)
fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
Memory::get_c_str(value->docstring));
else
fprintf(f, "none\n");
}
}
// // if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function &&
// // env->values[i]->userType &&
// // (string_equal(env->values[i]->userType->value.symbol.identifier, "package") ||
// // string_equal(env->values[i]->userType->value.symbol.identifier, "constructor")))
// // {
// // char new_prefix[200];
// // strcpy(new_prefix, prefix);
// // strcat(new_prefix, env->keys[i]);
// // strcat(new_prefix, " ");
// // print_this_env(env->values[i]->value.function.parent_environment, new_prefix);
// // }
// }
// }
for (int i = 0; i < env->parents.next_index; ++i) {
try_void rec(rec, env->parents.data[i], prefix);
}
};
// for (int i = 0; i < env->parents.next_index; ++i) {
// print_this_env(env->parents.data[i], prefix);
// }
// };
// print_this_env(get_current_environment(), (char*)"");
// }
print_this_env(print_this_env, get_current_environment(), (char*)"");
}
src/env.cpp
+3 -3
View File
@@ -77,7 +77,7 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
if (result)
return result;
String* identifier = node->value.symbol.identifier;
String* identifier = node->value.symbol;
print_environment(env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
@@ -91,7 +91,7 @@ proc print_environment_indent(Environment* env, int indent) -> void {
printf(" ");
}
};
if(env == get_root_environment()) {
print_indent(indent);
printf("[built-ins]-Environment (%lld)\n", (long long)env);
@@ -100,7 +100,7 @@ proc print_environment_indent(Environment* env, int indent) -> void {
for_hash_map (env->hm) {
print_indent(indent);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol.identifier->data));
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
src/error.cpp
+8 -13
View File
@@ -11,17 +11,16 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
debug_break();
}
if (Globals::log_level > Log_Level::None) {
// pretty error sign
for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i)
printf("-");
printf("\n Error - %s\n", Memory::get_c_str(message));
for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i)
printf("-");
using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
error->message = message;
log_error();
if (Globals::log_level > Log_Level::None) {
// c error location
printf("\nin");
int spacing = 30-((int)strlen(c_file_name) - (int)log10(c_file_line));
printf("in");
int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line));
if (spacing < 1) spacing = 1;
for (int i = 0; i < spacing; ++i)
printf(" ");
@@ -30,10 +29,6 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
}
// visualize_lisp_machine();
using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
error->message = message;
}
proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
src/eval.cpp
+23 -57
View File
@@ -103,7 +103,7 @@ proc create_extended_environment_for_function_application(
"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.identifier->data));
&(arguments->value.pair.first->value.symbol->data));
return;
}
@@ -119,7 +119,7 @@ proc create_extended_environment_for_function_application(
return;
create_generic_error(
"The function already read the keyword argument ':%s'",
&(arguments->value.pair.first->value.symbol.identifier->data));
&(arguments->value.pair.first->value.symbol->data));
return;
}
}
@@ -130,12 +130,12 @@ proc create_extended_environment_for_function_application(
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.identifier->data));
&(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_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier);
try_void sym = Memory::get_or_create_lisp_object_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);
@@ -176,14 +176,14 @@ proc create_extended_environment_for_function_application(
create_generic_error(
"There was no value supplied for the required "
"keyword argument ':%s'.",
&defined_keyword->value.symbol.identifier->data);
&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_or_create_lisp_object_symbol(defined_keyword->value.symbol.identifier);
try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword->value.symbol);
if (is_c_function) {
try_void val = arg_spec->keyword.values.data[i];
} else {
@@ -398,12 +398,7 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
using namespace Globals::Current_Execution;
call_stack.append(node);
defer {
// NOTE(Felix): We only delete the current entry from the call
// stack, if we did not encounter an error, otherwise we neet
// to preserve the callstack to print it later. it will be
// cleared in log_error().
if (!Globals::error)
--call_stack.next_index;
--call_stack.next_index;
};
switch (Memory::get_type(node)) {
@@ -492,37 +487,16 @@ proc is_truthy(Lisp_Object* expression) -> bool {
proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256);
Environment* root_env = get_root_environment();
Environment* user_env;
try user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer {
pop_environment();
};
Lisp_Object* result = built_in_load(Memory::create_string(file_name));
Lisp_Object* result;
try result = built_in_load(Memory::create_string(file_name));
if (Globals::error) {
log_error();
delete_error();
return nullptr;
}
return result;
}
proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer {
pop_environment();
};
if (Globals::error) {
log_error();
delete_error();
return;
}
printf("Welcome to the lispy interpreter.\n");
@@ -530,27 +504,19 @@ proc interprete_stdin() -> void {
Lisp_Object* parsed, * evaluated;
while (true) {
printf("> ");
line = read_expression();
defer {
free(line);
};
parsed = Parser::parse_single_expression(line);
if (Globals::error) {
log_error();
[&] {
delete_error();
continue;
}
evaluated = eval_expr(parsed);
if (Globals::error) {
log_error();
delete_error();
continue;
}
if (evaluated != Memory::nil) {
print(evaluated);
printf("\n");
}
fputs("> ", stdout);
line = read_expression();
defer {
free(line);
};
try_void parsed = Parser::parse_single_expression(line);
try_void evaluated = eval_expr(parsed);
if (evaluated != Memory::nil) {
print(evaluated);
fputs("\n", stdout);
}
}();
}
}
src/forward_decls.cpp
+1
View File
@@ -29,6 +29,7 @@ const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
void visualize_lisp_machine();
void generate_docs(String* path);
void log_error();
namespace Memory {
Environment* create_built_ins_environment();
src/io.cpp
+5 -5
View File
@@ -311,12 +311,12 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
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.identifier)); break;
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::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): {
for_hash_map (node->value.hashMap) {
for_hash_map (*(node->value.hashMap)) {
fputs(" ", file);
print(key, true, file);
fputs(" -> ", file);
@@ -347,7 +347,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
} break;
case (Lisp_Object_Type::Function): {
if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier));
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break;
}
if (node->value.function->type == Function_Type::Lambda)
@@ -365,7 +365,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
// 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) {
String* identifier = head->value.pair.first->value.symbol.identifier;
String* identifier = head->value.pair.first->value.symbol;
auto symbol = head->value.pair.first;
@@ -458,5 +458,5 @@ proc log_error() -> void {
puts(console_normal);
// HACK(Felix): we should control the stack size in eval_expr not here
Globals::Current_Execution::call_stack.next_index = 0;
// Globals::Current_Execution::call_stack.next_index = 0;
}
src/lisp_object.cpp
+1 -1
View File
@@ -34,7 +34,7 @@ Lisp_Object::~Lisp_Object() {
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
this->value.hashMap.~Hash_Map();
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
src/main.cpp
+1 -1
View File
@@ -4,8 +4,8 @@ int main(int argc, char* argv[]) {
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
// Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
Slime::Memory::free_everything();
// Slime::interprete_file((char*)"generate-docs.slime");
#ifdef _MSC_VER
_CrtDumpMemoryLeaks();
#endif
src/memory.cpp
+35 -28
View File
@@ -138,6 +138,28 @@ namespace Memory {
});
}
proc create_child_environment(Environment* parent) -> Environment* {
Environment* env = environment_memory.allocate();
// inject a new array list;
new(&env->parents) Array_List<Environment*>;
if (parent)
env->parents.append(parent);
new(&env->hm) Hash_Map<void*, Lisp_Object*>;
return env;
}
proc create_empty_environment() -> Environment* {
Environment* ret;
try ret = create_child_environment(nullptr);
return ret;
}
proc init(int sms) -> void {
char* exe_path = get_exe_dir();
defer {free(exe_path);};
@@ -163,6 +185,10 @@ namespace Memory {
Environment* env;
try_void env = create_built_ins_environment();
push_environment(env);
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
}
proc reset() -> void {
@@ -189,8 +215,8 @@ namespace Memory {
object_memory.~Bucket_Allocator();
environment_memory.~Bucket_Allocator();
::new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8);
::new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8);
new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
next_free_spot_in_string_memory = string_memory;
@@ -207,6 +233,10 @@ namespace Memory {
Environment* env;
try_void env = create_built_ins_environment();
push_environment(env);
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
}
proc create_lisp_object_pointer(void* ptr) -> Lisp_Object* {
@@ -221,7 +251,7 @@ namespace Memory {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::HashMap);
::new((&node->value.hashMap)) Hash_Map<Lisp_Object*, Lisp_Object*>;
node->value.hashMap = new Hash_Map<Lisp_Object*, Lisp_Object*>;
return node;
}
@@ -284,8 +314,7 @@ namespace Memory {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Symbol);
node->value.symbol.identifier = identifier;
node->value.symbol.hash = hash(identifier);
node->value.symbol = identifier;
global_symbol_table.set_object(get_c_str(identifier), node);
return node;
}
@@ -294,8 +323,7 @@ namespace Memory {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Keyword);
node->value.symbol.identifier = keyword;
node->value.symbol.hash = hash(keyword);
node->value.symbol = keyword;
global_keyword_table.set_object(get_c_str(keyword), node);
return node;
}
@@ -388,27 +416,6 @@ namespace Memory {
return copy_lisp_object(n);
}
proc create_child_environment(Environment* parent) -> Environment* {
Environment* env = environment_memory.allocate();
// inject a new array list;
::new(&env->parents) Array_List<Environment*>;
if (parent)
env->parents.append(parent);
::new(&env->hm) Hash_Map<void*, Lisp_Object*>;
return env;
}
proc create_empty_environment() -> Environment* {
Environment* ret;
try ret = create_child_environment(nullptr);
return ret;
}
proc create_built_ins_environment() -> Environment* {
Environment* ret;
try ret = create_empty_environment();
src/structs.cpp
+3 -13
View File
@@ -60,16 +60,6 @@ struct Source_Code_Location {
int column;
};
struct Symbol {
String* identifier;
u64 hash;
};
struct Keyword {
String* identifier;
u64 hash;
};
struct Pair {
Lisp_Object* first;
Lisp_Object* rest;
@@ -129,7 +119,7 @@ struct Lisp_Object {
Lisp_Object* userType; // keyword
String* docstring;
union value {
Symbol symbol; // used for symbols and keywords
String* symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
@@ -137,8 +127,8 @@ struct Lisp_Object {
Function* function;
cFunction* cFunction;
void* pointer;
Continuation continuation;
Hash_Map<Lisp_Object*, Lisp_Object*> hashMap;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
~Lisp_Object();
src/testing.cpp
+27 -34
View File
@@ -219,7 +219,7 @@ proc test_eval_operands() -> testresult {
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword);
assert_equal_string(operands->value.pair.first->value.symbol.identifier, "haha");
assert_equal_string(operands->value.pair.first->value.symbol, "haha");
return pass;
}
@@ -256,26 +256,26 @@ proc test_parse_atom() -> testresult {
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "key1");
assert_equal_string(result->value.symbol, "key1");
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "key:2");
assert_equal_string(result->value.symbol, "key:2");
// test symbols
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol.identifier, "sym");
assert_equal_string(result->value.symbol, "sym");
++index_in_text;
result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol.identifier, "+");
assert_equal_string(result->value.symbol, "+");
return pass;
}
@@ -289,13 +289,13 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun");
assert_equal_string(result->value.pair.first->value.symbol, "fun");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "+");
assert_equal_string(result->value.pair.first->value.symbol, "+");
result = result->value.pair.rest;
@@ -315,20 +315,20 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "define");
assert_equal_string(result->value.pair.first->value.symbol, "define");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun");
assert_equal_string(result->value.pair.first->value.symbol, "fun");
result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.pair.first->value.symbol.identifier, "lambda");
assert_equal_string(result->value.pair.first->value.pair.first->value.symbol, "lambda");
result = result->value.pair.rest;
@@ -498,7 +498,7 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "number");
assert_equal_string(result->value.symbol, "number");
// setting user type
char exp_string2[] = "(begin (set-type! a :my-type)(type a))";
@@ -508,21 +508,21 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "my-type");
assert_equal_string(result->value.symbol, "my-type");
// trying to set invalid user type
char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3);
assert_no_error();
// // trying to set invalid user type
// char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))";
// expression = Parser::parse_single_expression(exp_string3);
// assert_no_error();
ignore_logging {
dont_break_on_errors {
result = eval_expr(expression);
}
}
// ignore_logging {
// dont_break_on_errors {
// result = eval_expr(expression);
// }
// }
assert_error();
delete_error();
// assert_error();
// delete_error();
// deleting user type
char exp_string4[] = "(begin (delete-type! a)(type a))";
@@ -532,7 +532,7 @@ proc test_built_in_type() -> testresult {
assert_no_error();
assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "number");
assert_equal_string(result->value.symbol, "number");
return pass;
}
@@ -607,17 +607,11 @@ proc run_all_tests() -> bool {
bool result = true;
try Memory::init(409600);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer{
pop_environment();
};
printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching);
// 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);
@@ -643,7 +637,6 @@ proc run_all_tests() -> bool {
printf("\n-- Test Files --\n");
// print_environment(get_current_environment());
invoke_test_script("evaluation_of_default_args");
invoke_test_script("alists");
invoke_test_script("case_and_cond");