fixed import bug

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
+1 -1
View File
@@ -1,3 +1,3 @@
(define a 10) (define a 1111)
(define (get-a-1) a) (define (get-a-1) a)
+8 -15
View File
@@ -1,27 +1,20 @@
(import "tests/import1.slime") (import "tests/import1.slime")
(print) (assert (= a 1111))
(print ">" a) (assert (= (get-a-1) 1111))
(assert (= a 10))
(print ">" (get-a-1))
(assert (= (get-a-1) 10))
(import "tests/import2.slime") (import "tests/import2.slime")
(print ">" a)
(assert (= a 10)) (assert (= a 1111))
(print ">" (get-a-1)) (assert (= (get-a-1) 1111))
(assert (= (get-a-1) 10)) (assert (= (get-a-2) 1111))
(print ">" (get-a-2))
(assert (= (get-a-2) 10))
(set-a-2 11) (set-a-2 11)
(print "> should be 11 from now on")
(print ">" a)
(assert (= a 11)) (assert (= a 11))
(print ">" (get-a-1))
(assert (= (get-a-1) 11)) (assert (= (get-a-1) 11))
(print ">" (get-a-2))
(assert (= (get-a-2) 11)) (assert (= (get-a-2) 11))
+1092 -1092
View File
File diff suppressed because it is too large Load Diff
+128 -126
View File
@@ -1,144 +1,146 @@
proc generate_docs(String* path) -> void { namespace Slime {
FILE *f = fopen(Memory::get_c_str(path), "w"); proc generate_docs(String* path) -> void {
if (!f) { FILE *f = fopen(Memory::get_c_str(path), "w");
create_generic_error("The file for writing the documentation (%s) " if (!f) {
"could not be opened for writing.", Memory::get_c_str(path)); create_generic_error("The file for writing the documentation (%s) "
return; "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;
}
} }
if (!we_already_printed) { defer {
// printf("Working on env::::"); fclose(f);
// print_environment(env); };
// printf("\n--------------------------------\n");
visited.append(env);
push_environment(env); Array_List<Environment*> visited;
defer {
pop_environment();
};
for_hash_map(env->hm) { const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
try_void fprintf(f, bool we_already_printed = false;
"#+latex: \\hrule\n" // TODO(Felix): Make a generic array_list_contains function
"#+html: <hr/>\n" for(auto it : visited) {
"* =%s%s= \n" if (it == env) {
" :PROPERTIES:\n" we_already_printed = true;
" :UNNUMBERED: t\n" break;
" :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 if (!we_already_printed) {
*/ // printf("Working on env::::");
Lisp_Object_Type type = Memory::get_type(value); // print_environment(env);
Lisp_Object* LOtype; // printf("\n--------------------------------\n");
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value); visited.append(env);
try_void LOtype = eval_expr(type_expr);
fprintf(f, "\n - type :: ="); push_environment(env);
print(LOtype, true, f); defer {
fprintf(f, "="); 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);
/* fprintf(f, "\n - type :: =");
* if printable value -> print it print(LOtype, true, f);
*/
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, "="); fprintf(f, "=");
} break;
default: break;
} /*
/* * if printable value -> print it
* if function then print arguments */
*/ switch (type) {
if (type == Lisp_Object_Type::Function || case(Lisp_Object_Type::Nil):
type == Lisp_Object_Type::CFunction) case(Lisp_Object_Type::T):
{ case(Lisp_Object_Type::Number):
Arguments* args = case(Lisp_Object_Type::String):
(type == Lisp_Object_Type::Function) case(Lisp_Object_Type::Pair):
? &value->value.function->args case(Lisp_Object_Type::Symbol):
: &value->value.cFunction->args; case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - arguments :: "); fprintf(f, "\n - value :: =");
// if no args at all print(value, true, f);
if (args->positional.symbols.next_index == 0 && fprintf(f, "=");
args->keyword.values.next_index == 0 && } break;
!args->rest) default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function ||
type == Lisp_Object_Type::CFunction)
{ {
fprintf(f, "none."); Arguments* args =
} else { (type == Lisp_Object_Type::Function)
if (args->positional.symbols.next_index != 0) { ? &value->value.function->args
fprintf(f, "\n - postitional :: "); : &value->value.cFunction->args;
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); fprintf(f, "\n - arguments :: ");
for (int i = 1; i < args->positional.symbols.next_index; ++i) { // if no args at all
fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); if (args->positional.symbols.next_index == 0 &&
} args->keyword.values.next_index == 0 &&
} !args->rest)
if (args->keyword.values.next_index != 0) { {
fprintf(f, "\n - keyword :: "); fprintf(f, "none.");
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); } else {
if (args->keyword.values.data[0]) { if (args->positional.symbols.next_index != 0) {
fprintf(f, " =("); fprintf(f, "\n - postitional :: ");
print(args->keyword.values.data[0], true, f); fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
fprintf(f, ")="); 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));
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->keyword.values.next_index != 0) {
if (args->rest) { fprintf(f, "\n - keyword :: ");
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); 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) { for (int i = 0; i < env->parents.next_index; ++i) {
try_void rec(rec, env->parents.data[i], prefix); 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*)"");
}
} }
+116 -116
View File
@@ -1,126 +1,126 @@
namespace Slime { namespace Slime {
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data); profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment(); Environment* env = get_current_environment();
env->hm.set_object((void*)symbol, value); 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;
} }
auto nil_sym = Memory::get_symbol("nil"); inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
auto t_sym = Memory::get_symbol("t"); return (Lisp_Object*)env->hm.get_object((void*)sym);
if (node == nil_sym) {
return Memory::nil;
}
if (node == t_sym) {
return Memory::t;
} }
return nullptr; proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
} return lookup_symbol_in_this_envt(sym, env) != 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 { proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
printf("\n=== Environment === (0x%016llx)\n", (long long)env); if (environment_binds_symbol(sym, env))
print_environment_indent(env, 0); 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);
}
} }
+49 -46
View File
@@ -1,54 +1,57 @@
proc delete_error() -> void { namespace Slime {
using Globals::error;
free(error); proc delete_error() -> void {
error = nullptr; 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 { free(error);
delete_error(); error = nullptr;
if (Globals::breaking_on_errors) {
debug_break();
} }
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 {
error = (Error*)malloc(sizeof(Error)) ; delete_error();
error->type = type; if (Globals::breaking_on_errors) {
error->message = message; debug_break();
}
log_error(); using Globals::error;
if (Globals::log_level > Log_Level::None) { error = (Error*)malloc(sizeof(Error)) ;
// 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; error->type = type;
} error->message = message;
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; log_error();
strcpy(&formatted_string->data, out_msg); if (Globals::log_level > Log_Level::None) {
free(out_msg); // c error location
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); 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);
}
} }
+465 -463
View File
@@ -1,116 +1,99 @@
proc create_extended_environment_for_function_application( namespace Slime {
Lisp_Object* unevaluated_arguments, proc create_extended_environment_for_function_application(
Lisp_Object* function, Lisp_Object* unevaluated_arguments,
bool should_evaluate) -> Environment* Lisp_Object* function,
{ bool should_evaluate) -> Environment*
profile_this(); {
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; profile_this();
Environment* new_env; bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Lisp_Object* arguments = unevaluated_arguments; Environment* new_env;
Arguments* arg_spec; Lisp_Object* arguments = unevaluated_arguments;
Arguments* arg_spec;
// NOTE(Felix): Step 1. // NOTE(Felix): Step 1.
// - setting the parent environment // - setting the parent environment
// - setting the arg_spec // - setting the arg_spec
// - potentially evaluating the arguments // - potentially evaluating the arguments
if (is_c_function) { if (is_c_function) {
new_env = Memory::create_child_environment(get_root_environment()); new_env = Memory::create_child_environment(get_root_environment());
arg_spec = &function->value.cFunction->args; arg_spec = &function->value.cFunction->args;
} else { } else {
new_env = Memory::create_child_environment(function->value.function->parent_environment); new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args; 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;
} }
}; if (should_evaluate) {
try arguments = eval_arguments(arguments);
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;
} }
// 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 // NOTE(Felix): Step 2.
bool accepted = false; // Reading the argument spec and fill in the environment
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { // for the function call
if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i])
{ Lisp_Object* sym, *val; // used as temp storage to use `try`
accepted = true; Array_List<Lisp_Object*> read_in_keywords;
break; int obligatory_keywords_count = 0;
} int read_obligatory_keywords_count = 0;
}
if (!accepted) { proc read_positional_args = [&]() -> void {
// NOTE(Felix): if we are actually done with all the for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
// necessary keywords then we have to count the rest if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
// as :rest here, instead od always creating an error create_parsing_error("Wrong number of arguments.");
// (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count)
return; return;
create_generic_error( }
"The function does not take the keyword argument ':%s'\n" // NOTE(Felix): We have to copy all the arguments,
"and not all required keyword arguments have been read\n" // otherwise we change the program code. XXX(Felix): T C
"in to potentially count it as the rest argument.", // functions we pass by reference...
&(arguments->value.pair.first->value.symbol->data)); 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; 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) { while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
if (arguments->value.pair.first == read_in_keywords.data[i]) // 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 // NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest // necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error // 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) if (read_obligatory_keywords_count == obligatory_keywords_count)
return; return;
create_generic_error( 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)); &(arguments->value.pair.first->value.symbol->data));
return; return;
} }
}
// okay so we found a keyword that has to be read in and was // check if it was already read in
// not already read in, is there a next element to actually for (int i = 0; i < read_in_keywords.next_index; ++i) {
// set it to? if (arguments->value.pair.first == read_in_keywords.data[i])
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { {
create_generic_error( // NOTE(Felix): if we are actually done with all the
"Attempting to set the keyword argument ':%s', but no value was supplied.", // necessary keywords then we have to count the rest
&(arguments->value.pair.first->value.symbol->data)); // as :rest here, instead od always creating an error
return; // (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 // okay so we found a keyword that has to be read in and was
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol); // not already read in, is there a next element to actually
// NOTE(Felix): It seems we do not need to evaluate the argument here... // set it to?
if (is_c_function) { if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); create_generic_error(
} else { "Attempting to set the keyword argument ':%s', but no value was supplied.",
try_void define_symbol( &(arguments->value.pair.first->value.symbol->data));
sym, return;
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); }
}
read_in_keywords.append(arguments->value.pair.first); // if not set it and then add it to the array list
++read_obligatory_keywords_count; 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 read_in_keywords.append(arguments->value.pair.first);
arguments = arguments->value.pair.rest->value.pair.rest; ++read_obligatory_keywords_count;
if (arguments == Memory::nil) { // overstep both for next one
break; arguments = arguments->value.pair.rest->value.pair.rest;
}
}
};
proc check_keyword_args = [&]() -> void { if (arguments == Memory::nil) {
// 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; 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( create_generic_error(
"There was no value supplied for the required " "A rest argument was not declared "
"keyword argument ':%s'.", "but the function was called with additional arguments.");
&defined_keyword->value.symbol->data);
return; 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 { try read_positional_args();
if (arguments == Memory::nil) { try read_keyword_args();
if (arg_spec->rest) { try check_keyword_args();
define_symbol(arg_spec->rest, Memory::nil); try read_rest_arg();
}
} 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(); return new_env;
try read_keyword_args(); }
try check_keyword_args();
try read_rest_arg();
return new_env; proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
} profile_this();
Environment* new_env;
Lisp_Object* result;
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
profile_this(); push_environment(new_env);
Environment* new_env; defer {
Lisp_Object* result; 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 (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function: // if c function:
try result = function->value.cFunction->body(); try result = function->value.cFunction->body();
else else
// if lisp function // if lisp function
try result = eval_expr(function->value.function->body); try result = eval_expr(function->value.function->body);
return result; return result;
} }
/** /**
This parses the argument specification of funcitons into their 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 positional_arguments, keyword_arguments and rest_argument and
filling it in filling it in
*/ */
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
Arguments* result; Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) { if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args; 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;
} else { } 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; return nullptr;
} }
// ++my_out_arguments_length; default: {
} create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
// *(out_arguments_length) = my_out_arguments_length; return nullptr;
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 proc is_truthy(Lisp_Object* expression) -> bool {
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { Lisp_Object* result;
// only for lambdas we evaluate the arguments before try result = eval_expr(expression);
// apllying, for the other types, special-lambda and macro
// we do not need.
Lisp_Object* result; return result != Memory::nil;
try result = apply_arguments_to_function( }
arguments,
lispOperator,
lispOperator->value.function->type == Function_Type::Lambda);
// NOTE(Felix): The parser does not understnad (import ..) proc interprete_file (char* file_name) -> Lisp_Object* {
// so it cannot expand imported macros at read time try Memory::init(4096 * 256);
// (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; 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);
}
}();
} }
} }
+77 -75
View File
@@ -1,83 +1,85 @@
void add_to_load_path(const char*); namespace Slime {
bool lisp_object_equal(Lisp_Object*,Lisp_Object*); void add_to_load_path(const char*);
Lisp_Object* built_in_load(String*); bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
Lisp_Object* built_in_import(String*); Lisp_Object* built_in_load(String*);
void delete_error(); Lisp_Object* built_in_import(String*);
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); void delete_error();
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(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
Lisp_Object* eval_arguments(Lisp_Object*); void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line);
Lisp_Object* eval_expr(Lisp_Object*); Lisp_Object* eval_arguments(Lisp_Object*);
bool is_truthy (Lisp_Object*); Lisp_Object* eval_expr(Lisp_Object*);
int list_length(Lisp_Object*); bool is_truthy (Lisp_Object*);
void* load_built_ins_into_environment(); int list_length(Lisp_Object*);
void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); 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*); Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value); void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*); void print_environment(Environment*);
bool run_all_tests(); bool run_all_tests();
inline Environment* get_root_environment(); inline Environment* get_root_environment();
inline Environment* get_current_environment(); inline Environment* get_current_environment();
inline void push_environment(Environment*); inline void push_environment(Environment*);
inline void pop_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 visualize_lisp_machine();
void generate_docs(String* path); void generate_docs(String* path);
void log_error(); void log_error();
namespace Memory { namespace Memory {
Environment* create_built_ins_environment(); Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special); Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node); inline Lisp_Object_Type get_type(Lisp_Object* node);
void init(int); void init(int);
char* get_c_str(String*); char* get_c_str(String*);
void free_everything(); void free_everything();
String* create_string(const char*); String* create_string(const char*);
Lisp_Object* get_symbol(String* identifier); Lisp_Object* get_symbol(String* identifier);
Lisp_Object* get_symbol(const char*); Lisp_Object* get_symbol(const char*);
Lisp_Object* get_keyword(String* identifier); Lisp_Object* get_keyword(String* identifier);
Lisp_Object* get_keyword(const char*); Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(double); Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(const char*); 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* create_lisp_object_vector(Lisp_Object*, 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(Lisp_Object*, Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(int, 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*);
inline Lisp_Object* create_list(Lisp_Object*,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*);
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*);
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*);
inline Lisp_Object* create_list(Lisp_Object*,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 { namespace Parser {
// extern Environment* environment_for_macros; // extern Environment* environment_for_macros;
extern String* standard_in; extern String* standard_in;
extern String* parser_file; extern String* parser_file;
extern int parser_line; extern int parser_line;
extern int parser_col; extern int parser_col;
Lisp_Object* parse_expression(char* text, int* index_in_text); Lisp_Object* parse_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(char* text); Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text); Lisp_Object* parse_single_expression(wchar_t* text);
} }
namespace Globals { namespace Globals {
extern char* bin_path; extern char* bin_path;
extern Log_Level log_level; extern Log_Level log_level;
extern Array_List<void*> load_path; extern Array_List<void*> load_path;
namespace Current_Execution { namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack; extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack; extern Array_List<Environment*> envi_stack;
}
extern Error* error;
extern bool breaking_on_errors;
} }
extern Error* error;
extern bool breaking_on_errors;
} }
+1 -1
View File
@@ -1,4 +1,4 @@
namespace GC { namespace Slime::GC {
proc maybe_mark(Environment* env) -> void; proc maybe_mark(Environment* env) -> void;
int current_mark; int current_mark;
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Globals { namespace Slime::Globals {
char* bin_path = nullptr; char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug; Log_Level log_level = Log_Level::Debug;
+418 -416
View File
@@ -1,460 +1,462 @@
proc string_equal(const char input[], const char check[]) -> bool { namespace Slime {
if (input == check) return true; proc string_equal(const char input[], const char check[]) -> bool {
if (input == check) return true;
for(int i = 0; input[i] == check[i]; i++) { for(int i = 0; input[i] == check[i]; i++) {
if (input[i] == '\0') 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 true;
return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
} }
return false; proc get_nibble(char c) -> char {
} if (c >= 'A' && c <= 'F')
return (c - 'A') + 10;
proc string_equal(String* str, const char check[]) -> bool { else if (c >= 'a' && c <= 'f')
return string_equal(Memory::get_c_str(str), check); return (c - 'a') + 10;
} return (c - '0');
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;
} }
char* ret = (char*)malloc((i+count+1)*sizeof(char)); proc escape_string(char* in) -> char* {
// TODO(Felix): add more escape sequences
// copy in int i = 0, count = 0;
i = 0; while (in[i] != '\0') {
int j = 0; switch (in[i]) {
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 '\'':
case '\\': 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++; *out++ = *p++;
case '?': } else {
break; /* escape sequence */
case 'x': switch (*++p) {
case 'X': case '0': *out++ = '\a'; ++p; break;
if (!isxdigit(p[1]) || !isxdigit(p[2])) { 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( create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. " "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, in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in); (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; break;
default:
create_parsing_error( if(--len == 0) {
"The string '%s' at %s:%d:%d could not be unescaped. " len = lenmax;
"(Unexpected '\\' with no escape sequence at char %d)", char * linen = (char*)realloc(linep, lenmax *= 2);
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in); 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. */ proc read_line() -> char* {
*out = '\0'; char* line = (char*)malloc(100), * linep = line;
return (int)(out - in); size_t lenmax = 100, len = lenmax;
} int c;
proc read_entire_file(char* filename) -> char* { int nesting = 0;
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(line == nullptr)
if (fseek(fp, 0L, SEEK_SET) != 0) { return nullptr;
fputs("Error reading file", stderr);
goto closeFile;
}
/* Allocate our buffer to that size. */ for(;;) {
fileContent = (char*)calloc(bufsize, sizeof(char)); c = fgetc(stdin);
if(c == EOF)
/* 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)
break; 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* { if(linen == nullptr) {
char* line = (char*)malloc(100), * linep = line; free(linep);
size_t lenmax = 100, len = lenmax; return nullptr;
int c; }
line = linen + (line - linep);
int nesting = 0; linep = linen;
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;
} }
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; const int charCount = currentCharIndex + 1;
if(*line == '(')
++nesting; // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
else if(*line == ')') char* filePathC = (char*)malloc(sizeof(char) * charCount);
--nesting;
else if(*line == '\n') for (int i = 0; i < charCount; i++)
if (nesting == 0) {
// 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; break;
line++; }
} if (node->value.function->type == Function_Type::Lambda)
(*line)--; // we dont want the \n actually fputs("[lambda]", file);
*line = '\0'; // else if (node->value.function->type == Function_Type::Special_Lambda)
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)
// fputs("[special-lambda]", file); // fputs("[special-lambda]", file);
else if (node->value.function->type == Function_Type::Macro) else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file); fputs("[macro]", file);
else else
assert(false); assert(false);
} break; } break;
case (Lisp_Object_Type::Pair): { case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node; Lisp_Object* head = node;
// first check if it is a quotation form, in that case we want // first check if it is a quotation form, in that case we want
// to print it prettier // to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol; String* identifier = head->value.pair.first->value.symbol;
auto symbol = head->value.pair.first; auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_symbol("quote"); auto quote_sym = Memory::get_symbol("quote");
auto unquote_sym = Memory::get_symbol("unquote"); auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote"); auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{ {
if (symbol == quote_sym) if (symbol == quote_sym)
putc('\'', file); putc('\'', file);
else if (symbol == unquote_sym) else if (symbol == unquote_sym)
putc(',', file); putc(',', file);
else if (symbol == unquote_splicing_sym) else if (symbol == unquote_splicing_sym)
fputs(",@", file); fputs(",@", file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert(head->value.pair.rest->value.pair.rest == Memory::nil); assert(head->value.pair.rest->value.pair.rest == Memory::nil);
print(head->value.pair.rest->value.pair.first, print_repr, file); print(head->value.pair.rest->value.pair.first, print_repr, file);
break; 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); putc('(', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file); // NOTE(Felix): We could do a while true here, however in case
break; // 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); proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
// NOTE(Felix): We could do a while true here, however in case print(obj, true);
// we want to print a broken list (for logging the error) we printf(console_normal);
// should do more checks. printf("\n at ");
while (head) { if (obj->sourceCodeLocation) {
print(head->value.pair.first, print_repr, file); printf("%s (line %d, position %d)",
head = head->value.pair.rest; Memory::get_c_str(
if (!head) obj->sourceCodeLocation->file),
return; obj->sourceCodeLocation->line,
if (Memory::get_type(head) != Lisp_Object_Type::Pair) obj->sourceCodeLocation->column);
break; } else {
putc(' ', file); fputs("no source code location avaliable", stdout);
} }
}
if (Memory::get_type(head) != Lisp_Object_Type::Nil) { proc print_call_stack() -> void {
fputs(" . ", file); using Globals::Current_Execution::call_stack;
print(head, print_repr, file);
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); proc log_error() -> void {
} break; 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);
}
+3 -4
View File
@@ -39,14 +39,14 @@ unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj); unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp" #include "ftb/hashmap.hpp"
namespace Slime {
# include "defines.cpp" # include "defines.cpp"
# include "assert.hpp" # include "assert.hpp"
# include "define_macros.hpp" # include "define_macros.hpp"
# include "platform.cpp" # include "platform.cpp"
# include "structs.cpp" # include "structs.cpp"
# include "forward_decls.cpp" # include "forward_decls.cpp"
}
bool hm_objects_match(char* a, char* b) { bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0; return strcmp(a, b) == 0;
@@ -107,7 +107,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) {
} }
} }
namespace Slime {
# include "globals.cpp" # include "globals.cpp"
# include "memory.cpp" # include "memory.cpp"
# include "gc.cpp" # include "gc.cpp"
@@ -122,4 +121,4 @@ namespace Slime {
# include "built_ins.cpp" # include "built_ins.cpp"
# include "testing.cpp" # include "testing.cpp"
// # include "undefines.cpp" // # include "undefines.cpp"
}
+49 -47
View File
@@ -1,53 +1,55 @@
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* { namespace Slime {
if (!file) proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
return nullptr; if (!file)
return nullptr;
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location)); Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file; ret->file = file;
ret->line = line; ret->line = line;
ret->column = col; ret->column = col;
return ret; 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";
} }
return "unknown";
}
Lisp_Object::~Lisp_Object() { proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
free(sourceCodeLocation); switch (type) {
sourceCodeLocation = 0; 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)) { Lisp_Object::~Lisp_Object() {
case Lisp_Object_Type::HashMap: { free(sourceCodeLocation);
delete this->value.hashMap; sourceCodeLocation = 0;
} break;
case Lisp_Object_Type::CFunction: { switch (Memory::get_type(this)) {
this->value.cFunction->args.positional.symbols.~Array_List(); case Lisp_Object_Type::HashMap: {
this->value.cFunction->args.keyword.keywords.~Array_List(); delete this->value.hashMap;
this->value.cFunction->args.keyword.values.~Array_List(); } break;
delete this->value.cFunction; case Lisp_Object_Type::CFunction: {
} break; this->value.cFunction->args.positional.symbols.~Array_List();
case Lisp_Object_Type::Function:{ this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.function->args.positional.symbols.~Array_List(); this->value.cFunction->args.keyword.values.~Array_List();
this->value.function->args.keyword.keywords.~Array_List(); delete this->value.cFunction;
this->value.function->args.keyword.values.~Array_List(); } break;
delete this->value.function; case Lisp_Object_Type::Function:{
} break; this->value.function->args.positional.symbols.~Array_List();
default: break; this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
}
} }
} }
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Memory { namespace Slime::Memory {
// ------------------ // ------------------
// global symbol / keyword table // global symbol / keyword table
+1 -1
View File
@@ -1,4 +1,4 @@
namespace Parser { namespace Slime::Parser {
String* standard_in; String* standard_in;
String* parser_file; String* parser_file;
int parser_line; int parser_line;
+144 -141
View File
@@ -1,167 +1,170 @@
inline proc get_cwd() -> char* { namespace Slime {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char)); inline proc get_cwd() -> char* {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char));
#ifdef _MSC_VER #ifdef _MSC_VER
_getcwd(res, buf_size); _getcwd(res, buf_size);
#else #else
getcwd(res, buf_size); getcwd(res, buf_size);
#endif #endif
return res; return res;
} }
inline proc change_cwd(char* dir) -> void { inline proc change_cwd(char* dir) -> void {
#ifdef _MSC_VER #ifdef _MSC_VER
_chdir(dir); _chdir(dir);
#else #else
chdir(dir); chdir(dir);
#endif #endif
} }
#ifdef _MSC_VER #ifdef _MSC_VER
int vasprintf(char **strp, const char *fmt, va_list ap) { int vasprintf(char **strp, const char *fmt, va_list ap) {
// _vscprintf tells you how big the buffer needs to be // _vscprintf tells you how big the buffer needs to be
int len = _vscprintf(fmt, ap); int len = _vscprintf(fmt, ap);
if (len == -1) { if (len == -1) {
return -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;
} }
else if (result == path_size - 1) { size_t size = (size_t)len + 1;
free(path); char *str = (char*)malloc(size);
/* May need to also check for ERROR_SUCCESS here if XP/2K */ if (!str) {
if (ERROR_INSUFFICIENT_BUFFER != last_error) { 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; path = 0;
break; break;
} }
path_size = path_size * 2; else if (result == path_size - 1) {
path = (char*)malloc(path_size); free(path);
} /* May need to also check for ERROR_SUCCESS here if XP/2K */
else if (ERROR_INSUFFICIENT_BUFFER != last_error) {
break; path = 0;
} break;
}
if (!path) { path_size = path_size * 2;
fprintf(stderr, "Failure: %ld\n", last_error); path = (char*)malloc(path_size);
return nullptr; }
} else
else { break;
// 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) { 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; errno = ENOMEM;
return NULL; 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) { return path;
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;
#endif #endif
}
} }
+125 -123
View File
@@ -1,142 +1,144 @@
struct Lisp_Object; namespace Slime {
struct String; struct Lisp_Object;
struct Environment; struct String;
struct Environment;
enum struct Thread_Type { enum struct Thread_Type {
Main, Main,
GarbageCollection GarbageCollection
}; };
enum struct Lisp_Object_Type { enum struct Lisp_Object_Type {
Nil, Nil,
T, T,
Symbol, Symbol,
Keyword, Keyword,
Number, Number,
String, String,
Pair, Pair,
Vector, Vector,
Continuation, Continuation,
Pointer, Pointer,
HashMap, HashMap,
// OwningPointer, // OwningPointer,
Function, Function,
CFunction, CFunction,
}; };
enum class Lisp_Object_Flags enum class Lisp_Object_Flags
{ {
// bits 1 to 5 (including) will be reserved for the type // bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5, Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6, Under_Construction = 1 << 6,
}; };
enum struct Function_Type { enum struct Function_Type {
Lambda, Lambda,
Macro Macro
}; };
enum struct Log_Level { enum struct Log_Level {
None, None,
Critical, Critical,
Warning, Warning,
Info, Info,
Debug, Debug,
}; };
struct Continuation { struct Continuation {
Array_List<Lisp_Object*> call_stack; Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack; Array_List<Environment*> envi_stack;
}; };
struct String { struct String {
int length; int length;
char data; char data;
}; };
struct Source_Code_Location { struct Source_Code_Location {
String* file; String* file;
int line; int line;
int column; int column;
}; };
struct Pair { struct Pair {
Lisp_Object* first; Lisp_Object* first;
Lisp_Object* rest; Lisp_Object* rest;
}; };
struct Vector { struct Vector {
int length; int length;
Lisp_Object* data; Lisp_Object* data;
}; };
struct Positional_Arguments { struct Positional_Arguments {
Array_List<Lisp_Object*> symbols; Array_List<Lisp_Object*> symbols;
}; };
struct Keyword_Arguments { struct Keyword_Arguments {
// Array of Pointers to Lisp_Object<Keyword> // Array of Pointers to Lisp_Object<Keyword>
Array_List<Lisp_Object*> keywords; Array_List<Lisp_Object*> keywords;
// NOTE(Felix): values[i] will be nullptr if no defalut value was // NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i] // declared for key identifiers[i]
Array_List<Lisp_Object*> values; Array_List<Lisp_Object*> values;
}; };
struct Arguments { struct Arguments {
Positional_Arguments positional; Positional_Arguments positional;
Keyword_Arguments keyword; Keyword_Arguments keyword;
// NOTE(Felix): rest_argument will be nullptr if no rest argument // NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol // is declared otherwise its a symbol
Lisp_Object* rest; Lisp_Object* rest;
}; };
struct Environment { struct Environment {
Array_List<Environment*> parents; Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm; Hash_Map<void*, Lisp_Object*> hm;
~Environment() { ~Environment() {
parents.~Array_List(); parents.~Array_List();
hm.~Hash_Map(); hm.~Hash_Map();
} }
}; };
struct Function { struct Function {
Function_Type type; Function_Type type;
Arguments args; Arguments args;
Lisp_Object* body; // maybe implicit begin Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!! Environment* parent_environment; // we are doing closures now!!
}; };
struct cFunction { struct cFunction {
Lisp_Object* (*body)(); Lisp_Object* (*body)();
Arguments args; Arguments args;
bool is_special_form; bool is_special_form;
}; };
struct Lisp_Object { struct Lisp_Object {
Source_Code_Location* sourceCodeLocation; Source_Code_Location* sourceCodeLocation;
u64 flags; u64 flags;
Lisp_Object* userType; // keyword Lisp_Object* userType; // keyword
String* docstring; String* docstring;
union value { union value {
String* symbol; // used for symbols and keywords String* symbol; // used for symbols and keywords
double number; double number;
String* string; String* string;
Pair pair; Pair pair;
Vector vector; Vector vector;
Function* function; Function* function;
cFunction* cFunction; cFunction* cFunction;
void* pointer; void* pointer;
Continuation* continuation; Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {} ~value() {}
} value; } value;
~Lisp_Object(); ~Lisp_Object();
}; };
struct Error { struct Error {
Lisp_Object* position; Lisp_Object* position;
// type has to be a keyword // type has to be a keyword
Lisp_Object* type; Lisp_Object* type;
String* message; String* message;
}; };
}
+505 -499
View File
File diff suppressed because it is too large Load Diff
+514 -512
View File
File diff suppressed because it is too large Load Diff