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

Cleanup and delete dead code

Browse Source
This commit is contained in:
Felix Brendel
2019-11-10 15:29:21 +01:00
parent bb1cfcd3c3
commit 8dbff42bdf
14 changed files with 152 additions and 256 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/assert.hpp
+9 -37
View File
@@ -27,43 +27,7 @@
"Type missmatch: expected %s, got %s", \
expected, actual)
#define create_wrong_number_of_arguments_error(expected, actual) \
__create_error("wrong-number-of-arguments", \
"Wrong number of arguments: expected %d, got %d", \
expected, actual)
#define create_too_many_arguments_error(expected, actual) \
__create_error("wrong-number-of-arguments", \
"Wrong number of arguments: expected less or equal to %d, got %d", \
expected, actual)
#define create_too_few_arguments_error(expected, actual) \
__create_error("wrong-number-of-arguments", \
"Wrong number of arguments: expected greater or equal to %d, got %d", \
expected, actual)
#define assert_arguments_length(expected, actual) \
do { \
if (expected != actual) { \
create_wrong_number_of_arguments_error(expected, actual); \
} \
} while(0)
#define assert_arguments_length_less_equal(expected, actual) \
do { \
if (expected < actual) { \
create_too_many_arguments_error(expected, actual); \
} \
} while(0)
#define assert_arguments_length_greater_equal(expected, actual) \
do { \
if (expected > actual) { \
create_too_few_arguments_error(expected, actual); \
} \
} while(0)
#ifdef _DEBUG
#define assert_type(_node, _type) \
do { \
@@ -80,3 +44,11 @@
create_generic_error("Assertion-error."); \
} \
} while(0)
#else
# define assert_arguments_length(expected, actual) do {} while (0)
# define assert_arguments_length_less_equal(expected, actual) do {} while (0)
# define assert_arguments_length_greater_equal(expected, actual) do {} while (0)
# define assert_type(_node, _type) do {} while (0)
# define assert(condition) do {} while (0)
#endif
src/built_ins.cpp
+8 -26
View File
@@ -14,17 +14,15 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
switch (Memory::get_type(n1)) {
case Lisp_Object_Type::T: // code for t and nil should never be
// reached since they are memory unique
case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::CFunction: // if they have the same
// pointer, true is returned a
// few lines above
case Lisp_Object_Type::CFunction:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::Pointer: // TODO(Felix): should a pointer
// object compare the pointer?
// TODO(Felix): should a pointer
// object compare the pointer?
case Lisp_Object_Type::Pointer:
case Lisp_Object_Type::Continuation: return false;
case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
@@ -48,7 +46,6 @@ proc add_to_load_path(const char* path) -> void {
}
proc built_in_load(String* file_name) -> Lisp_Object* {
// char* full_file_name = find_slime_file(file_name);
char* file_content;
char fullpath[4096];
sprintf(fullpath, "%s", Memory::get_c_str(file_name));
@@ -79,9 +76,10 @@ proc built_in_load(String* file_name) -> Lisp_Object* {
Array_List<Lisp_Object*>* program;
try program = Parser::parse_program(Memory::create_string(fullpath), file_content);
for (int i = 0; i < program->next_index; ++i) {
try result = eval_expr(program->data[i]);
for (auto expr : *program) {
try result = eval_expr(expr);
}
delete program;
free(file_content);
@@ -687,22 +685,6 @@ proc load_built_ins_into_environment() -> void {
func->value.function->body = maybe_wrap_body_in_begin(body);
return func;
};
// define_special((special-lambda args . body), "TODO") {
// fetch(args, body);
// Lisp_Object* fun;
// try fun = Memory::create_lisp_object();
// Memory::set_type(fun, Lisp_Object_Type::Function);
// fun->value.function->type = Function_Type::Special_Lambda;
// in_caller_env {
// fun->value.function->parent_environment = get_current_environment();
// }
// try create_arguments_from_lambda_list_and_inject(args, fun);
// fun->value.function->body = maybe_wrap_body_in_begin(body);
// return fun;
// };
define((apply fun args), "TODO") {
fetch(fun, args);
Lisp_Object* result;
src/define_macros.hpp
+4 -1
View File
@@ -22,7 +22,7 @@
} \
} while(0)
#ifdef _DEBUG
#define try_or_else_return(val) \
if (1) \
goto label(body,__LINE__); \
@@ -37,6 +37,9 @@
} \
else label(body,__LINE__):
;
#else
#define try_or_else_return(val)
#endif
#define try_struct try_or_else_return({})
#define try_void try_or_else_return()
src/env.cpp
+11 -11
View File
@@ -85,18 +85,18 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
}
proc print_indent(int indent) -> void {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
}
proc print_environment_indent(Environment* env, int indent) -> void {
// if(env == get_root_environment()) {
// print_indent(indent);
// printf("[built-ins]-Environment (%lld)\n", (long long)env);
// return;
// }
proc print_indent = [](int indent) {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
};
if(env == get_root_environment()) {
print_indent(indent);
printf("[built-ins]-Environment (%lld)\n", (long long)env);
return;
}
for_hash_map (env->hm) {
print_indent(indent);
src/error.cpp
+25 -61
View File
@@ -1,44 +1,42 @@
proc delete_error() -> void {
using Globals::error;
if (error) {
free(error);
error = nullptr;
}
free(error);
error = nullptr;
}
proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
if (Globals::log_level > Log_Level::None) {
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("-");
printf("\nin");
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(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
}
delete_error();
if (Globals::breaking_on_errors) {
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("-");
// c error location
printf("\nin");
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(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
}
// 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 {
// HACK(Felix): the length of all error strings is 200!!!!!!!!!!
using Globals::error;
int length = 200;
@@ -49,47 +47,13 @@ proc create_error(const char* c_func_name, const char* c_file_name, int c_file_l
}
int written_length;
va_list args;
char* out_msg;
va_start(args, format);
written_length = vsnprintf(&formatted_string->data, length, format, args);
written_length = vasprintf(&out_msg, format, args);
va_end(args);
formatted_string->length = written_length;
strcpy(&formatted_string->data, out_msg);
free(out_msg);
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string);
}
// proc Error_Type_to_string(Error_Type type) -> const char* {
// switch (type) {
// case Error_Type::Assertion_Error: return "Assertion failed";
// case Error_Type::File_Not_Found: return "File not found";
// case Error_Type::Ill_Formed_Arguments: return "Evaluation-error: Ill formed arguments";
// case Error_Type::Ill_Formed_Lambda_List: return "Evaluation-error: Ill formed lambda list";
// case Error_Type::Ill_Formed_List: return "Evaluation-error: Ill formed list";
// case Error_Type::Not_A_Function: return "Evaluation-error: Not a function";
// case Error_Type::Not_Yet_Implemented: return "Evaluation-error: Not yet implemented";
// case Error_Type::Symbol_Not_Defined: return "Evaluation-error: Symbol not defined";
// case Error_Type::Syntax_Error: return "Syntax Error";
// case Error_Type::Trailing_Garbage: return "Evaluation-error: Trailing garbage following expression";
// case Error_Type::Type_Missmatch: return "Evaluation-error: Type Missmatch";
// case Error_Type::Unbalanced_Parenthesis: return "Parsing-error: Unbalanced parenthesis";
// case Error_Type::Unexpected_Eof: return "Parsing-error: Unexpected EOF";
// case Error_Type::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument";
// case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments";
// case Error_Type::Out_Of_Memory: return "Runtime-error: Out of memory";
// default: return "this error type doesn't have a desciption..";
// }
// }
// proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void {
// if (!node) {
// create_generic_error(
// "The node where the type should have"
// "been checked was nullptr.");
// return;
// }
// if (node->type != type)
// create_type_missmatch_error(
// ""
// );
// }
src/eval.cpp
+7 -11
View File
@@ -45,7 +45,7 @@ proc create_extended_environment_for_function_application(
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_wrong_number_of_arguments_error(arg_spec->positional.symbols.next_index, i);
create_parsing_error("Wrong number of arguments.");
return;
}
// NOTE(Felix): We have to copy all the arguments,
@@ -259,11 +259,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
result = &function->value.function->args;
}
// ::new (&result->positional.symbols) Array_List<Lisp_Object*>;
// ::new (&result->keyword.keywords) Array_List<Lisp_Object*>;
// ::new (&result->keyword.values) Array_List<Lisp_Object*>;
// first init the fields
// first init the fields
result->rest = nullptr;
// okay let's try to read some positional arguments
@@ -286,9 +282,7 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
}
// okay we found an actual symbol
append_to_positional_argument_list(
&result->positional,
arguments->value.pair.first);
result->positional.symbols.append(arguments->value.pair.first);
arguments = arguments->value.pair.rest;
}
@@ -299,7 +293,8 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// if we are on a actual keyword (with no default arg)
auto keyword = arguments->value.pair.first;
append_to_keyword_argument_list(&result->keyword, keyword, nullptr);
result->keyword.keywords.append(keyword);
result->keyword.values.append(nullptr);
} else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
// if we are on a keyword with a default value
@@ -318,7 +313,8 @@ proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_O
create_parsing_error("Default args must be a list of 2.");
}
append_to_keyword_argument_list(&result->keyword, keyword, value);
result->keyword.keywords.append(keyword);
result->keyword.values.append(value);
}
arguments = arguments->value.pair.rest;
}
src/io.cpp
+29 -29
View File
@@ -260,11 +260,6 @@ proc log_message(Log_Level type, const char* message) -> void {
printf("%s: %s\n",prefix, message);
}
proc panic(char* message) -> void {
log_message(Log_Level::Critical, message);
exit(1);
}
char* wchar_to_char(const wchar_t* pwchar) {
// get the number of characters in the string.
int currentCharIndex = 0;
@@ -369,37 +364,41 @@ 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;
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol.identifier;
// auto symbol = head->value.pair.first;
// auto quote_sym = Memory::get_or_create_lisp_object_symbol("quote");
// auto unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
// auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
// if (symbol == quote_sym || symbol == unquote_sym)
// {
// putc(symbol == quote_sym
// ? '\''
// : ',', file);
auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_or_create_lisp_object_symbol("quote");
auto unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
auto quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing");
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{
if (symbol == quote_sym)
putc('\'', file);
else if (symbol == unquote_sym)
putc(',', file);
else if (symbol == unquote_splicing_sym)
putc('@', file);
// assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
// assert(head->value.pair.rest->value.pair.rest == Memory::nil);
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);
// assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
// print(head->value.pair.rest->value.pair.first, print_repr, file);
// break;
// }
// }
print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
else if (symbol == quasiquote_sym) {
putc('`', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
}
putc('(', file);
// NOTE(Felix): We cuold 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
// should do more checks.
while (head) {
@@ -458,5 +457,6 @@ proc log_error() -> void {
print_call_stack();
puts(console_normal);
// HACK(Felix): we should control the stack size in eval_expr not here
Globals::Current_Execution::call_stack.next_index = 0;
}
src/lisp_object.cpp
+1 -13
View File
@@ -2,7 +2,7 @@ proc create_source_code_location(String* file, int line, int col) -> Source_Code
if (!file)
return nullptr;
Source_Code_Location* ret = new(Source_Code_Location);
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file;
ret->line = line;
ret->column = col;
@@ -28,18 +28,6 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
return "unknown";
}
proc append_to_positional_argument_list(Positional_Arguments* args, Lisp_Object* sym) -> void {
args->symbols.append(sym);
}
proc append_to_keyword_argument_list(Keyword_Arguments* args,
Lisp_Object* keyword,
Lisp_Object* default_value) -> void
{
args->keywords.append(keyword);
args->values.append(default_value);
}
Lisp_Object::~Lisp_Object() {
free(sourceCodeLocation);
sourceCodeLocation = 0;
src/memory.cpp
-16
View File
@@ -119,22 +119,6 @@ namespace Memory {
return create_string(str, (int)strlen(str));
}
// proc create_string_formatted (const char* format, ...) -> String* {
// // HACK(Felix): the length of all strings is 200!!!!!!!!!!
// // HACK(Felix): the length of all strings is 200!!!!!!!!!!
// int length = 200;
// String* ret = create_string("", length);
// int written_length;
// va_list args;
// va_start(args, format);
// written_length = vsnprintf(&ret->data, length, format, args);
// va_end(args);
// ret->length = written_length;
// return ret;
// }
proc create_lisp_object() -> Lisp_Object* {
Lisp_Object* object = object_memory.allocate();
object->flags = 0;
src/platform.cpp
+32
View File
@@ -19,6 +19,38 @@ inline proc change_cwd(char* dir) -> void {
#endif
}
#ifdef _MSC_VER
int vasprintf(char **strp, const char *fmt, va_list ap) {
// _vscprintf tells you how big the buffer needs to be
int len = _vscprintf(fmt, ap);
if (len == -1) {
return -1;
}
size_t size = (size_t)len + 1;
char *str = malloc(size);
if (!str) {
return -1;
}
// _vsprintf_s is the "secure" version of vsprintf
int r = _vsprintf_s(str, len + 1, fmt, ap);
if (r == -1) {
free(str);
return -1;
}
*strp = str;
return r;
}
int asprintf(char **strp, const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
int r = vasprintf(strp, fmt, ap);
va_end(ap);
return r;
}
#endif
proc get_exe_dir() -> char* {
#ifdef _MSC_VER
DWORD last_error;