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

fixed import bug

Browse Source
This commit is contained in:
fumfar hiwi
2019-12-04 14:51:06 +01:00
parent 667989e373
commit efbdfeed2e
19 changed files with 3698 additions and 3680 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/tests/import1.slime
+1 -1
View File
@@ -1,3 +1,3 @@
(define a 10)
(define a 1111)
(define (get-a-1) a)
bin/tests/singular_imports.slime
+8 -15
View File
@@ -1,27 +1,20 @@
(import "tests/import1.slime")
(print)
(print ">" a)
(assert (= a 10))
(print ">" (get-a-1))
(assert (= (get-a-1) 10))
(assert (= a 1111))
(assert (= (get-a-1) 1111))
(import "tests/import2.slime")
(print ">" a)
(assert (= a 10))
(print ">" (get-a-1))
(assert (= (get-a-1) 10))
(print ">" (get-a-2))
(assert (= (get-a-2) 10))
(assert (= a 1111))
(assert (= (get-a-1) 1111))
(assert (= (get-a-2) 1111))
(set-a-2 11)
(print "> should be 11 from now on")
(print ">" a)
(assert (= a 11))
(print ">" (get-a-1))
(assert (= (get-a-1) 11))
(print ">" (get-a-2))
(assert (= (get-a-2) 11))
src/built_ins.cpp
+1092 -1092
View File
File diff suppressed because it is too large Load Diff
src/docgeneration.cpp
+128 -126
View File
@@ -1,144 +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);
};
Array_List<Environment*> visited;
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;
}
namespace Slime {
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;
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);
defer {
fclose(f);
};
push_environment(env);
defer {
pop_environment();
};
Array_List<Environment*> visited;
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);
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;
}
/*
* type
*/
Lisp_Object_Type type = Memory::get_type(value);
Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
try_void LOtype = eval_expr(type_expr);
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);
fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
push_environment(env);
defer {
pop_environment();
};
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_symbol("type"), value);
try_void LOtype = eval_expr(type_expr);
/*
* 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, "\n - type :: =");
print(LOtype, 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)
/*
* 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)
{
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, ")=");
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->rest) {
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->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");
}
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");
}
}
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) {
try_void rec(rec, env->parents.data[i], prefix);
}
};
print_this_env(print_this_env, get_current_environment(), (char*)"");
print_this_env(print_this_env, get_current_environment(), (char*)"");
}
}
src/env.cpp
+116 -116
View File
@@ -1,126 +1,126 @@
namespace Slime {
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment();
env->hm.set_object((void*)symbol, value);
}
inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
return (Lisp_Object*)env->hm.get_object((void*)sym);
}
proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
return lookup_symbol_in_this_envt(sym, env) != nullptr;
}
proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
if (environment_binds_symbol(sym, env))
return env;
for (auto it : env->parents) {
if (Environment* ret = find_binding_environment(sym, it))
return ret;
}
return nullptr;
}
proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment
Lisp_Object* result;
result = lookup_symbol_in_this_envt(node, env);
if (result)
return result;
for (int i = 0; i < env->parents.next_index; ++i) {
result = try_lookup_symbol(node, env->parents.data[i]);
if (result)
return result;
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment();
env->hm.set_object((void*)symbol, value);
}
auto nil_sym = Memory::get_symbol("nil");
auto t_sym = Memory::get_symbol("t");
if (node == nil_sym) {
return Memory::nil;
}
if (node == t_sym) {
return Memory::t;
inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
return (Lisp_Object*)env->hm.get_object((void*)sym);
}
return nullptr;
}
inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution;
envi_stack.append(env);
}
inline proc pop_environment() -> void {
using namespace Globals::Current_Execution;
--envi_stack.next_index;
}
inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[0];
}
inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[envi_stack.next_index-1];
}
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
profile_with_comment(&node->value.symbol->data);
// print(node);
assert_type(node, Lisp_Object_Type::Symbol);
Lisp_Object* result = try_lookup_symbol(node, env);
if (result)
return result;
String* identifier = node->value.symbol;
print_environment(env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
return nullptr;
}
proc print_environment_indent(Environment* env, int indent) -> void {
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);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
return lookup_symbol_in_this_envt(sym, env) != nullptr;
}
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (0x%016llx)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
}
proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
print_environment_indent(env, 0);
}
proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
if (environment_binds_symbol(sym, env))
return env;
for (auto it : env->parents) {
if (Environment* ret = find_binding_environment(sym, it))
return ret;
}
return nullptr;
}
proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment
Lisp_Object* result;
result = lookup_symbol_in_this_envt(node, env);
if (result)
return result;
for (int i = 0; i < env->parents.next_index; ++i) {
result = try_lookup_symbol(node, env->parents.data[i]);
if (result)
return result;
}
auto nil_sym = Memory::get_symbol("nil");
auto t_sym = Memory::get_symbol("t");
if (node == nil_sym) {
return Memory::nil;
}
if (node == t_sym) {
return Memory::t;
}
return nullptr;
}
inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution;
envi_stack.append(env);
}
inline proc pop_environment() -> void {
using namespace Globals::Current_Execution;
--envi_stack.next_index;
}
inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[0];
}
inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[envi_stack.next_index-1];
}
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
profile_with_comment(&node->value.symbol->data);
// print(node);
assert_type(node, Lisp_Object_Type::Symbol);
Lisp_Object* result = try_lookup_symbol(node, env);
if (result)
return result;
String* identifier = node->value.symbol;
print_environment(env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
return nullptr;
}
proc print_environment_indent(Environment* env, int indent) -> void {
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);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
}
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (0x%016llx)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
}
proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
print_environment_indent(env, 0);
}
}
src/error.cpp
+49 -46
View File
@@ -1,54 +1,57 @@
proc delete_error() -> void {
using Globals::error;
namespace Slime {
free(error);
error = nullptr;
}
proc delete_error() -> void {
using Globals::error;
proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
free(error);
error = nullptr;
}
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, String* message) -> void {
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
}
log_error();
if (Globals::log_level > Log_Level::None) {
// c error location
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(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
}
// visualize_lisp_machine();
}
proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
using Globals::error;
int length = 200;
String* formatted_string = Memory::create_string("", length);
if (error) {
error = new(Error);
using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
}
int written_length;
va_list args;
char* out_msg;
va_start(args, format);
written_length = vasprintf(&out_msg, format, args);
va_end(args);
error->message = message;
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);
log_error();
if (Globals::log_level > Log_Level::None) {
// c error location
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(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
}
// visualize_lisp_machine();
}
proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
using Globals::error;
int length = 200;
String* formatted_string = Memory::create_string("", length);
if (error) {
error = new(Error);
error->type = type;
}
int written_length;
va_list args;
char* out_msg;
va_start(args, format);
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);
}
}
src/eval.cpp
+465 -463
View File
@@ -1,116 +1,99 @@
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;
namespace Slime {
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;
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;
// 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;
}
};
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;
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();
};
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)
// 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;
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;
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));
}
// 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;
}
// 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])
{
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
@@ -118,132 +101,150 @@ proc create_extended_environment_for_function_application(
if (read_obligatory_keywords_count == obligatory_keywords_count)
return;
create_generic_error(
"The function already read the keyword argument ':%s'",
"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;
}
}
// 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;
}
// 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;
}
}
// 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));
}
// 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;
}
read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count;
// 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));
}
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count;
if (arguments == Memory::nil) {
break;
}
}
};
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
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;
if (arguments == Memory::nil) {
break;
}
}
if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value
if (!was_set) {
};
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(
"There was no value supplied for the required "
"keyword argument ':%s'.",
&defined_keyword->value.symbol->data);
"A rest argument was not declared "
"but the function was called with additional arguments.");
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();
try read_positional_args();
try read_keyword_args();
try check_keyword_args();
try read_rest_arg();
return new_env;
}
return new_env;
}
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this();
Environment* new_env;
Lisp_Object* result;
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this();
Environment* new_env;
Lisp_Object* result;
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env);
defer {
pop_environment();
};
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env);
defer {
pop_environment();
};
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else
// if lisp function
try result = eval_expr(function->value.function->body);
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else
// if lisp function
try result = eval_expr(function->value.function->body);
return result;
}
return result;
}
/**
This parses the argument specification of funcitons into their
@@ -251,272 +252,273 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function,
positional_arguments, keyword_arguments and rest_argument and
filling it in
*/
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
result = &function->value.function->args;
}
// first init the fields
result->rest = nullptr;
// okay let's try to read some positional arguments
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
// if we encounter a keyword or a list (for keywords with
// defualt args), the positionals are done
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword ||
Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
break;
}
// if we encounter something that is neither a symbol nor a
// keyword arg, it's an error
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords "
"(with or without default args) "
"can be parsed here, but found '%s'",
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
// okay we found an actual symbol
result->positional.symbols.append(arguments->value.pair.first);
arguments = arguments->value.pair.rest;
}
// if we reach here, we are on a keyword or a pair wher a keyword
// should be in first
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
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;
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
auto keyword = arguments->value.pair.first->value.pair.first;
if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) {
create_parsing_error("Default args must be keywords");
}
if (Memory::get_type(arguments->value.pair.first->value.pair.rest)
!= Lisp_Object_Type::Pair)
{
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
try_void value = eval_expr(value);
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
}
result->keyword.keywords.append(keyword);
result->keyword.values.append(value);
}
arguments = arguments->value.pair.rest;
}
// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments == Memory::nil)
return;
if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol)
result->rest = arguments;
else
create_parsing_error("The rest argument must be a symbol.");
}
}
proc list_length(Lisp_Object* node) -> int {
if (node == Memory::nil)
return 0;
assert_type(node, Lisp_Object_Type::Pair);
int len = 0;
while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
if (node == Memory::nil)
return len;
}
create_parsing_error("Can't calculate length of ill formed list.");
return 0;
}
proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
// TODO(Felix):
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;
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
create_parsing_error("Attempting to evaluate ill formed argument list.");
result = &function->value.function->args;
}
// first init the fields
result->rest = nullptr;
// okay let's try to read some positional arguments
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
// if we encounter a keyword or a list (for keywords with
// defualt args), the positionals are done
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword ||
Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
break;
}
// if we encounter something that is neither a symbol nor a
// keyword arg, it's an error
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords "
"(with or without default args) "
"can be parsed here, but found '%s'",
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
// okay we found an actual symbol
result->positional.symbols.append(arguments->value.pair.first);
arguments = arguments->value.pair.rest;
}
// if we reach here, we are on a keyword or a pair wher a keyword
// should be in first
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
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;
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
auto keyword = arguments->value.pair.first->value.pair.first;
if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) {
create_parsing_error("Default args must be keywords");
}
if (Memory::get_type(arguments->value.pair.first->value.pair.rest)
!= Lisp_Object_Type::Pair)
{
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
try_void value = eval_expr(value);
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
}
result->keyword.keywords.append(keyword);
result->keyword.values.append(value);
}
arguments = arguments->value.pair.rest;
}
// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments == Memory::nil)
return;
if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol)
result->rest = arguments;
else
create_parsing_error("The rest argument must be a symbol.");
}
}
proc list_length(Lisp_Object* node) -> int {
if (node == Memory::nil)
return 0;
assert_type(node, Lisp_Object_Type::Pair);
int len = 0;
while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
if (node == Memory::nil)
return len;
}
create_parsing_error("Can't calculate length of ill formed list.");
return 0;
}
proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
// TODO(Felix):
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 eval_expr(Lisp_Object* node) -> Lisp_Object* {
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::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Number:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return 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;
}
// ++my_out_arguments_length;
}
// *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
}
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
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::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Number:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return 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;
default: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
return nullptr;
}
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.
proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);
Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
lispOperator->value.function->type == Function_Type::Lambda);
return result != Memory::nil;
}
// 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);
}
proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256);
return result;
Lisp_Object* result;
try result = built_in_load(Memory::create_string(file_name));
return result;
}
proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100);
printf("Welcome to the lispy interpreter.\n");
char* line;
Lisp_Object* parsed, * evaluated;
while (true) {
[&] {
delete_error();
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);
}
}();
}
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: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
return nullptr;
}
}
}
proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);
return result != Memory::nil;
}
proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256);
Lisp_Object* result;
try result = built_in_load(Memory::create_string(file_name));
return result;
}
proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100);
printf("Welcome to the lispy interpreter.\n");
char* line;
Lisp_Object* parsed, * evaluated;
while (true) {
[&] {
delete_error();
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
+77 -75
View File
@@ -1,83 +1,85 @@
void add_to_load_path(const char*);
bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
Lisp_Object* built_in_load(String*);
Lisp_Object* built_in_import(String*);
void delete_error();
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line);
Lisp_Object* eval_arguments(Lisp_Object*);
Lisp_Object* eval_expr(Lisp_Object*);
bool is_truthy (Lisp_Object*);
int list_length(Lisp_Object*);
void* load_built_ins_into_environment();
void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function);
namespace Slime {
void add_to_load_path(const char*);
bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
Lisp_Object* built_in_load(String*);
Lisp_Object* built_in_import(String*);
void delete_error();
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line);
Lisp_Object* eval_arguments(Lisp_Object*);
Lisp_Object* eval_expr(Lisp_Object*);
bool is_truthy (Lisp_Object*);
int list_length(Lisp_Object*);
void* load_built_ins_into_environment();
void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function);
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);
bool run_all_tests();
bool run_all_tests();
inline Environment* get_root_environment();
inline Environment* get_current_environment();
inline void push_environment(Environment*);
inline void pop_environment();
inline Environment* get_root_environment();
inline Environment* get_current_environment();
inline void push_environment(Environment*);
inline void pop_environment();
const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
void visualize_lisp_machine();
void generate_docs(String* path);
void log_error();
void visualize_lisp_machine();
void generate_docs(String* path);
void log_error();
namespace Memory {
Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node);
void init(int);
char* get_c_str(String*);
void free_everything();
String* create_string(const char*);
Lisp_Object* get_symbol(String* identifier);
Lisp_Object* get_symbol(const char*);
Lisp_Object* get_keyword(String* identifier);
Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(const char*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
}
namespace Parser {
// extern Environment* environment_for_macros;
extern String* standard_in;
extern String* parser_file;
extern int parser_line;
extern int parser_col;
Lisp_Object* parse_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}
namespace Globals {
extern char* bin_path;
extern Log_Level log_level;
extern Array_List<void*> load_path;
namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack;
namespace Memory {
Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node);
void init(int);
char* get_c_str(String*);
void free_everything();
String* create_string(const char*);
Lisp_Object* get_symbol(String* identifier);
Lisp_Object* get_symbol(const char*);
Lisp_Object* get_keyword(String* identifier);
Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(const char*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
}
namespace Parser {
// extern Environment* environment_for_macros;
extern String* standard_in;
extern String* parser_file;
extern int parser_line;
extern int parser_col;
Lisp_Object* parse_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}
namespace Globals {
extern char* bin_path;
extern Log_Level log_level;
extern Array_List<void*> load_path;
namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack;
}
extern Error* error;
extern bool breaking_on_errors;
}
extern Error* error;
extern bool breaking_on_errors;
}
src/gc.cpp
+1 -1
View File
@@ -1,4 +1,4 @@
namespace GC {
namespace Slime::GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
src/globals.cpp
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Globals {
namespace Slime::Globals {
char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug;
src/io.cpp
+418 -416
View File
@@ -1,460 +1,462 @@
proc string_equal(const char input[], const char check[]) -> bool {
if (input == check) return true;
namespace Slime {
proc string_equal(const char input[], const char check[]) -> bool {
if (input == check) return true;
for(int i = 0; input[i] == check[i]; i++) {
if (input[i] == '\0')
for(int i = 0; input[i] == check[i]; i++) {
if (input[i] == '\0')
return true;
}
return false;
}
proc string_equal(String* str, const char check[]) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(const char check[], String* str) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(String* str1, String* str2) -> bool {
if (str1 == str2)
return true;
return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
}
return false;
}
proc string_equal(String* str, const char check[]) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(const char check[], String* str) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(String* str1, String* str2) -> bool {
if (str1 == str2)
return true;
return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
}
proc get_nibble(char c) -> char {
if (c >= 'A' && c <= 'F')
return (c - 'A') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0');
}
proc escape_string(char* in) -> char* {
// TODO(Felix): add more escape sequences
int i = 0, count = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\':
case '\n':
case '\t':
++count;
default: break;
}
++i;
proc get_nibble(char c) -> char {
if (c >= 'A' && c <= 'F')
return (c - 'A') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0');
}
char* ret = (char*)malloc((i+count+1)*sizeof(char));
// copy in
i = 0;
int j = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break;
case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break;
case '\t': ret[j++] = '\\'; ret[j++] = 't'; break;
default: ret[j++] = in[i];
}
++i;
}
ret[j++] = '\0';
return ret;
}
proc unescape_string(char* in) -> int {
if (!in) return 0;
char *out = in, *p = in;
const char *int_err = nullptr;
while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++;
} else {
/* escape sequence */
switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
case 'r': *out++ = '\r'; ++p; break;
case 't': *out++ = '\t'; ++p; break;
case 'v': *out++ = '\v'; ++p; break;
case '"':
case '\'':
proc escape_string(char* in) -> char* {
// TODO(Felix): add more escape sequences
int i = 0, count = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\':
case '\n':
case '\t':
++count;
default: break;
}
++i;
}
char* ret = (char*)malloc((i+count+1)*sizeof(char));
// copy in
i = 0;
int j = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break;
case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break;
case '\t': ret[j++] = '\\'; ret[j++] = 't'; break;
default: ret[j++] = in[i];
}
++i;
}
ret[j++] = '\0';
return ret;
}
proc unescape_string(char* in) -> int {
if (!in) return 0;
char *out = in, *p = in;
const char *int_err = nullptr;
while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++;
case '?':
break;
case 'x':
case 'X':
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
} else {
/* escape sequence */
switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
case 'r': *out++ = '\r'; ++p; break;
case 't': *out++ = '\t'; ++p; break;
case 'v': *out++ = '\v'; ++p; break;
case '"':
case '\'':
case '\\':
*out++ = *p++;
case '?':
break;
case 'x':
case 'X':
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Invalid character on hexadecimal escape at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} else {
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
p += 3;
}
break;
default:
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Invalid character on hexadecimal escape at char %d)",
"(Unexpected '\\' with no escape sequence at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} else {
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
p += 3;
}
}
}
/* Set the end of string. */
*out = '\0';
return (int)(out - in);
}
proc read_entire_file(char* filename) -> char* {
profile_with_comment(filename);
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp) + 1;
if (bufsize == 0) {
fputs("Empty file", stderr);
goto closeFile;
}
/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}
/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
fileContent[newLen] = '\0';
if (ferror(fp) != 0) {
fputs("Error reading file", stderr);
}
}
closeFile:
fclose(fp);
}
return fileContent;
/* Don't forget to call free() later! */
}
proc read_expression() -> char* {
char* line = (char*)malloc(100);
if(line == nullptr)
return nullptr;
char* linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
while (true) {
c = fgetc(stdin);
if(c == EOF)
break;
default:
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Unexpected '\\' with no escape sequence at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);
if(linen == nullptr) {
free(linep);
return nullptr;
}
line = linen + (line - linep);
linep = linen;
}
*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
}
(*line)--; // we dont want the \n actually
*line = '\0';
return linep;
}
/* Set the end of string. */
*out = '\0';
return (int)(out - in);
}
proc read_line() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
proc read_entire_file(char* filename) -> char* {
profile_with_comment(filename);
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp) + 1;
if (bufsize == 0) {
fputs("Empty file", stderr);
goto closeFile;
}
int nesting = 0;
/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}
if(line == nullptr)
return nullptr;
/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
fileContent[newLen] = '\0';
if (ferror(fp) != 0) {
fputs("Error reading file", stderr);
}
}
closeFile:
fclose(fp);
}
return fileContent;
/* Don't forget to call free() later! */
}
proc read_expression() -> char* {
char* line = (char*)malloc(100);
if(line == nullptr)
return nullptr;
char* linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
while (true) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);
if(linen == nullptr) {
free(linep);
return nullptr;
}
line = linen + (line - linep);
linep = linen;
}
*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
line++;
}
(*line)--; // we dont want the \n actually
*line = '\0';
return linep;
}
if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);
proc read_line() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;
if(line == nullptr)
return nullptr;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);
if(linen == nullptr) {
free(linep);
return nullptr;
if(linen == nullptr) {
free(linep);
return nullptr;
}
line = linen + (line - linep);
linep = linen;
}
line = linen + (line - linep);
linep = linen;
*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
}
(*line)--; // we dont want the \n actually
*line = '\0';
return linep;
}
proc log_message(Log_Level type, const char* message) -> void {
if (type > Globals::log_level)
return;
const char* prefix;
switch (type) {
case Log_Level::Critical: prefix = "CRITICAL"; break;
case Log_Level::Warning: prefix = "WARNING"; break;
case Log_Level::Info: prefix = "INFO"; break;
case Log_Level::Debug: prefix = "DEBUG"; break;
default: return;
}
printf("%s: %s\n",prefix, message);
}
char* wchar_to_char(const wchar_t* pwchar) {
// get the number of characters in the string.
int currentCharIndex = 0;
char currentChar = (char)pwchar[currentCharIndex];
while (currentChar != '\0')
{
currentCharIndex++;
currentChar = (char)pwchar[currentCharIndex];
}
*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
const int charCount = currentCharIndex + 1;
// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
char* filePathC = (char*)malloc(sizeof(char) * charCount);
for (int i = 0; i < charCount; i++)
{
// convert to char (1 byte)
char character = (char)pwchar[i];
*filePathC = character;
filePathC += sizeof(char);
}
filePathC += '\0';
filePathC -= (sizeof(char) * charCount);
return filePathC;
}
const wchar_t* char_to_wchar(const char* c) {
const size_t cSize = strlen(c)+1;
wchar_t* wc = new wchar_t[cSize];
mbstowcs (wc, c, cSize);
return wc;
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
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::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f)
fprintf(file, "%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::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)) {
fputs(" ", file);
print(key, true, file);
fputs(" -> ", file);
print((Lisp_Object*)value, true, file);
fputs("\n", file);
}
} break;
case (Lisp_Object_Type::String): {
if (print_repr) {
putc('\"', file);
char* escaped = escape_string(Memory::get_c_str(node->value.string));
fputs(escaped, file);
putc('\"', file);
free(escaped);
}
else
fputs(Memory::get_c_str(node->value.string), file);
} break;
case (Lisp_Object_Type::Vector): {
fputs("[", file);
if (node->value.vector.length > 0)
print(node->value.vector.data, print_repr, file);
for (int i = 1; i < node->value.vector.length; ++i) {
fputs(" ", file);
print(node->value.vector.data+i, print_repr, file);
}
fputs("]", file);
} break;
case (Lisp_Object_Type::Function): {
if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break;
line++;
}
(*line)--; // we dont want the \n actually
*line = '\0';
return linep;
}
proc log_message(Log_Level type, const char* message) -> void {
if (type > Globals::log_level)
return;
const char* prefix;
switch (type) {
case Log_Level::Critical: prefix = "CRITICAL"; break;
case Log_Level::Warning: prefix = "WARNING"; break;
case Log_Level::Info: prefix = "INFO"; break;
case Log_Level::Debug: prefix = "DEBUG"; break;
default: return;
}
printf("%s: %s\n",prefix, message);
}
char* wchar_to_char(const wchar_t* pwchar) {
// get the number of characters in the string.
int currentCharIndex = 0;
char currentChar = (char)pwchar[currentCharIndex];
while (currentChar != '\0')
{
currentCharIndex++;
currentChar = (char)pwchar[currentCharIndex];
}
const int charCount = currentCharIndex + 1;
// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
char* filePathC = (char*)malloc(sizeof(char) * charCount);
for (int i = 0; i < charCount; i++)
{
// convert to char (1 byte)
char character = (char)pwchar[i];
*filePathC = character;
filePathC += sizeof(char);
}
filePathC += '\0';
filePathC -= (sizeof(char) * charCount);
return filePathC;
}
const wchar_t* char_to_wchar(const char* c) {
const size_t cSize = strlen(c)+1;
wchar_t* wc = new wchar_t[cSize];
mbstowcs (wc, c, cSize);
return wc;
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
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::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f)
fprintf(file, "%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::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)) {
fputs(" ", file);
print(key, true, file);
fputs(" -> ", file);
print((Lisp_Object*)value, true, file);
fputs("\n", file);
}
} break;
case (Lisp_Object_Type::String): {
if (print_repr) {
putc('\"', file);
char* escaped = escape_string(Memory::get_c_str(node->value.string));
fputs(escaped, file);
putc('\"', file);
free(escaped);
}
else
fputs(Memory::get_c_str(node->value.string), file);
} break;
case (Lisp_Object_Type::Vector): {
fputs("[", file);
if (node->value.vector.length > 0)
print(node->value.vector.data, print_repr, file);
for (int i = 1; i < node->value.vector.length; ++i) {
fputs(" ", file);
print(node->value.vector.data+i, print_repr, file);
}
fputs("]", file);
} break;
case (Lisp_Object_Type::Function): {
if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break;
}
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function->type == Function_Type::Special_Lambda)
}
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function->type == Function_Type::Special_Lambda)
// fputs("[special-lambda]", file);
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;
// 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;
// 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;
auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_symbol("quote");
auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_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)
fputs(",@", file);
auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_symbol("quote");
auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_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)
fputs(",@", 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;
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;
}
}
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 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);
head = head->value.pair.rest;
if (!head)
return;
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
break;
putc(' ', file);
}
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head, print_repr, file);
}
putc(')', file);
} break;
}
}
putc('(', file);
// 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);
head = head->value.pair.rest;
if (!head)
return;
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
break;
putc(' ', file);
proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj, true);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
printf("%s (line %d, position %d)",
Memory::get_c_str(
obj->sourceCodeLocation->file),
obj->sourceCodeLocation->line,
obj->sourceCodeLocation->column);
} else {
fputs("no source code location avaliable", stdout);
}
}
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head, print_repr, file);
proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack;
printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
for (int i = 0; i < call_stack.next_index; ++i) {
printf("%2d -> ", i);
print_single_call(call_stack.data[i]);
printf("\n");
}
}
putc(')', file);
} break;
proc log_error() -> void {
fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal);
fputs(" in: ", stdout);
print_call_stack();
puts(console_normal);
}
}
proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj, true);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
printf("%s (line %d, position %d)",
Memory::get_c_str(
obj->sourceCodeLocation->file),
obj->sourceCodeLocation->line,
obj->sourceCodeLocation->column);
} else {
fputs("no source code location avaliable", stdout);
}
}
proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack;
printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
for (int i = 0; i < call_stack.next_index; ++i) {
printf("%2d -> ", i);
print_single_call(call_stack.data[i]);
printf("\n");
}
}
proc log_error() -> void {
fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal);
fputs(" in: ", stdout);
print_call_stack();
puts(console_normal);
}
src/libslime.cpp
+3 -4
View File
@@ -39,14 +39,14 @@ unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp"
namespace Slime {
# include "defines.cpp"
# include "assert.hpp"
# include "define_macros.hpp"
# include "platform.cpp"
# include "structs.cpp"
# include "forward_decls.cpp"
}
bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0;
@@ -107,7 +107,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) {
}
}
namespace Slime {
# include "globals.cpp"
# include "memory.cpp"
# include "gc.cpp"
@@ -122,4 +121,4 @@ namespace Slime {
# include "built_ins.cpp"
# include "testing.cpp"
// # include "undefines.cpp"
}
src/lisp_object.cpp
+49 -47
View File
@@ -1,53 +1,55 @@
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
if (!file)
return nullptr;
namespace Slime {
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
if (!file)
return nullptr;
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::CFunction): return "C-function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap";
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}
return "unknown";
}
Lisp_Object::~Lisp_Object() {
free(sourceCodeLocation);
sourceCodeLocation = 0;
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::CFunction): return "C-function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap";
}
return "unknown";
}
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.cFunction->args.keyword.values.~Array_List();
delete this->value.cFunction;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.~Array_List();
this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
Lisp_Object::~Lisp_Object() {
free(sourceCodeLocation);
sourceCodeLocation = 0;
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.cFunction->args.keyword.values.~Array_List();
delete this->value.cFunction;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.~Array_List();
this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
}
}
}
src/memory.cpp
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Memory {
namespace Slime::Memory {
// ------------------
// global symbol / keyword table
src/parse.cpp
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Parser {
namespace Slime::Parser {
String* standard_in;
String* parser_file;
int parser_line;
src/platform.cpp
+144 -141
View File
@@ -1,167 +1,170 @@
inline proc get_cwd() -> char* {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char));
namespace Slime {
inline proc get_cwd() -> char* {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char));
#ifdef _MSC_VER
_getcwd(res, buf_size);
_getcwd(res, buf_size);
#else
getcwd(res, buf_size);
getcwd(res, buf_size);
#endif
return res;
}
return res;
}
inline proc change_cwd(char* dir) -> void {
inline proc change_cwd(char* dir) -> void {
#ifdef _MSC_VER
_chdir(dir);
_chdir(dir);
#else
chdir(dir);
chdir(dir);
#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 = (char*)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;
DWORD result;
DWORD path_size = 1024;
char* path = (char*)malloc(1024);
while (true) {
memset(path, 0, path_size);
result = GetModuleFileName(0, path, path_size - 1);
last_error = GetLastError();
if (0 == result) {
free(path);
path = 0;
break;
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;
}
else if (result == path_size - 1) {
free(path);
/* May need to also check for ERROR_SUCCESS here if XP/2K */
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
size_t size = (size_t)len + 1;
char *str = (char*)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;
DWORD result;
DWORD path_size = 1024;
char* path = (char*)malloc(1024);
while (true) {
memset(path, 0, path_size);
result = GetModuleFileName(0, path, path_size - 1);
last_error = GetLastError();
if (0 == result) {
free(path);
path = 0;
break;
}
path_size = path_size * 2;
path = (char*)malloc(path_size);
}
else
break;
}
if (!path) {
fprintf(stderr, "Failure: %ld\n", last_error);
return nullptr;
}
else {
// remove the exe name, so we are only left with the path
int index_in_path = -1;
int last_backslash = -1;
char c;
while ((c = path[++index_in_path]) != '\0') {
if (c == '\\')
last_backslash = index_in_path;
else if (result == path_size - 1) {
free(path);
/* May need to also check for ERROR_SUCCESS here if XP/2K */
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
path = 0;
break;
}
path_size = path_size * 2;
path = (char*)malloc(path_size);
}
else
break;
}
// we are assuming there are some backslashes
path[last_backslash+1] = '\0';
return path;
}
#else
ssize_t size = 512, i, n;
char *path, *temp;
while (1) {
size_t used;
path = (char*)malloc(size);
if (!path) {
fprintf(stderr, "Failure: %ld\n", last_error);
return nullptr;
}
else {
// remove the exe name, so we are only left with the path
int index_in_path = -1;
int last_backslash = -1;
char c;
while ((c = path[++index_in_path]) != '\0') {
if (c == '\\')
last_backslash = index_in_path;
}
// we are assuming there are some backslashes
path[last_backslash+1] = '\0';
return path;
}
#else
ssize_t size = 512, i, n;
char *path, *temp;
while (1) {
size_t used;
path = (char*)malloc(size);
if (!path) {
errno = ENOMEM;
return NULL;
}
used = readlink("/proc/self/exe", path, size);
if (used == -1) {
const int saved_errno = errno;
free(path);
errno = saved_errno;
return NULL;
} else
if (used < 1) {
free(path);
errno = EIO;
return NULL;
}
if ((size_t)used >= size) {
free(path);
size = (size | 2047) + 2049;
continue;
}
size = (size_t)used;
break;
}
/* Find final slash. */
n = 0;
for (i = 0; i < size; i++)
if (path[i] == '/')
n = i;
/* Optimize allocated size,
ensuring there is room for
a final slash and a
string-terminating '\0', */
temp = path;
path = (char*)realloc(temp, n + 2);
if (!path) {
free(temp);
errno = ENOMEM;
return NULL;
}
used = readlink("/proc/self/exe", path, size);
/* and properly trim and terminate the path string. */
path[n+0] = '/';
path[n+1] = '\0';
if (used == -1) {
const int saved_errno = errno;
free(path);
errno = saved_errno;
return NULL;
} else
if (used < 1) {
free(path);
errno = EIO;
return NULL;
}
if ((size_t)used >= size) {
free(path);
size = (size | 2047) + 2049;
continue;
}
size = (size_t)used;
break;
}
/* Find final slash. */
n = 0;
for (i = 0; i < size; i++)
if (path[i] == '/')
n = i;
/* Optimize allocated size,
ensuring there is room for
a final slash and a
string-terminating '\0', */
temp = path;
path = (char*)realloc(temp, n + 2);
if (!path) {
free(temp);
errno = ENOMEM;
return NULL;
}
/* and properly trim and terminate the path string. */
path[n+0] = '/';
path[n+1] = '\0';
return path;
return path;
#endif
}
}
src/structs.cpp
+125 -123
View File
@@ -1,142 +1,144 @@
struct Lisp_Object;
struct String;
struct Environment;
namespace Slime {
struct Lisp_Object;
struct String;
struct Environment;
enum struct Thread_Type {
Main,
GarbageCollection
};
enum struct Thread_Type {
Main,
GarbageCollection
};
enum struct Lisp_Object_Type {
Nil,
T,
Symbol,
Keyword,
Number,
String,
Pair,
Vector,
Continuation,
Pointer,
HashMap,
// OwningPointer,
Function,
CFunction,
};
enum struct Lisp_Object_Type {
Nil,
T,
Symbol,
Keyword,
Number,
String,
Pair,
Vector,
Continuation,
Pointer,
HashMap,
// OwningPointer,
Function,
CFunction,
};
enum class Lisp_Object_Flags
{
// bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};
enum class Lisp_Object_Flags
{
// bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};
enum struct Function_Type {
Lambda,
Macro
};
enum struct Function_Type {
Lambda,
Macro
};
enum struct Log_Level {
None,
Critical,
Warning,
Info,
Debug,
};
enum struct Log_Level {
None,
Critical,
Warning,
Info,
Debug,
};
struct Continuation {
Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
};
struct Continuation {
Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
};
struct String {
int length;
char data;
};
struct String {
int length;
char data;
};
struct Source_Code_Location {
String* file;
int line;
int column;
};
struct Source_Code_Location {
String* file;
int line;
int column;
};
struct Pair {
Lisp_Object* first;
Lisp_Object* rest;
};
struct Pair {
Lisp_Object* first;
Lisp_Object* rest;
};
struct Vector {
int length;
Lisp_Object* data;
};
struct Vector {
int length;
Lisp_Object* data;
};
struct Positional_Arguments {
Array_List<Lisp_Object*> symbols;
};
struct Positional_Arguments {
Array_List<Lisp_Object*> symbols;
};
struct Keyword_Arguments {
// Array of Pointers to Lisp_Object<Keyword>
Array_List<Lisp_Object*> keywords;
// NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i]
Array_List<Lisp_Object*> values;
};
struct Keyword_Arguments {
// Array of Pointers to Lisp_Object<Keyword>
Array_List<Lisp_Object*> keywords;
// NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i]
Array_List<Lisp_Object*> values;
};
struct Arguments {
Positional_Arguments positional;
Keyword_Arguments keyword;
// NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol
Lisp_Object* rest;
};
struct Arguments {
Positional_Arguments positional;
Keyword_Arguments keyword;
// NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol
Lisp_Object* rest;
};
struct Environment {
Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm;
struct Environment {
Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm;
~Environment() {
parents.~Array_List();
hm.~Hash_Map();
}
};
~Environment() {
parents.~Array_List();
hm.~Hash_Map();
}
};
struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};
struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};
struct cFunction {
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
};
struct cFunction {
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
};
struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
u64 flags;
Lisp_Object* userType; // keyword
String* docstring;
union value {
String* symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
Vector vector;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
~Lisp_Object();
};
struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
u64 flags;
Lisp_Object* userType; // keyword
String* docstring;
union value {
String* symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
Vector vector;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
~Lisp_Object();
};
struct Error {
Lisp_Object* position;
// type has to be a keyword
Lisp_Object* type;
String* message;
};
struct Error {
Lisp_Object* position;
// type has to be a keyword
Lisp_Object* type;
String* message;
};
}
src/testing.cpp
+505 -499
View File
File diff suppressed because it is too large Load Diff
src/visualization.cpp
+514 -512
View File
File diff suppressed because it is too large Load Diff