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

work transfer to laptop

Browse Source
This commit is contained in:
Felix Brendel
2019-09-19 09:20:26 +02:00
parent 5a117d94ee
commit 0c73728217
22 changed files with 3018 additions and 3090 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+914 -1034
View File
File diff suppressed because it is too large Load Diff
src/env.cpp
+3 -1
View File
@@ -84,6 +84,8 @@ inline proc get_current_environment() -> Environment* {
}
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
assert_type(node, Lisp_Object_Type::Symbol);
Lisp_Object* result = try_lookup_symbol(node, env);
if (result)
@@ -110,8 +112,8 @@ proc print_environment_indent(Environment* env, int indent) -> void {
}
for (int i = 0; i < env->next_index; ++i) {
print_indent(indent);
printf("-> %s :: ", env->keys[i]);
print(env->values[i]);
printf(" %s", env->keys[i]);
printf(" (%lld)", (long long)env->values[i]);
puts("");
}
src/error.cpp
+4 -4
View File
@@ -9,10 +9,10 @@ proc delete_error() -> void {
proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
if (Globals::log_level > Log_Level::None) {
printf("Error created in:\n %s:%d\n", c_file_name, c_file_line);
printf(" -> %s\n", Memory::get_c_str(message));
}
if (Globals::log_level > Log_Level::None) {
printf("Error created in:\n %s:%d\n", c_file_name, c_file_line);
printf(" -> %s\n", Memory::get_c_str(message));
}
delete_error();
if (Globals::breaking_on_errors) {
src/eval.cpp
+150 -152
View File
@@ -1,30 +1,68 @@
proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* {
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function) -> Environment*
{
profile_this;
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
try new_env = Memory::create_child_environment(function->parent_environment);
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;
// if it is not a special form, evaluate the arguments
if (!function->value.cFunction->is_special_form) {
try arguments = eval_arguments(arguments);
}
} else {
new_env = Memory::create_child_environment(function->value.function.parent_environment);
arg_spec = &function->value.function.args;
// if it is a lambda
if (function->value.function.type == Function_Type::Lambda) {
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`
String_Array_List read_in_keywords;
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;
proc read_positional_args = [&]() -> void {
for (int i = 0; i < function->args.positional.symbols.next_index; ++i) {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_wrong_number_of_arguments_error(function->args.positional.symbols.next_index, i);
create_wrong_number_of_arguments_error(arg_spec->positional.symbols.next_index, i);
return;
}
// NOTE(Felix): We have to copy all the arguments, otherwise
// we change the program code.
try_void sym = function->args.positional.symbols.data[i];
define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first));
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. XXX(Felix): T C
// functions we pass by reference...
try_void 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;
}
@@ -41,8 +79,8 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
return;
// find out how many keyword args we /have/ to read
for (int i = 0; i < function->args.keyword.values.next_index; ++i) {
if (function->args.keyword.values.data[i] == nullptr)
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;
@@ -52,10 +90,10 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
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 < function->args.keyword.values.next_index; ++i) {
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (string_equal(
arguments->value.pair.first->value.symbol.identifier,
function->args.keyword.keywords.data[i]->value.symbol.identifier))
arg_spec->keyword.keywords.data[i]->value.symbol.identifier))
{
accepted = true;
break;
@@ -108,9 +146,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// if not set it and then add it to the array list
try_void sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier);
// NOTE(Felix): It seems we do not need to evaluate the argument here...
try_void define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
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));
}
append_to_array_list(&read_in_keywords, arguments->value.pair.first->value.symbol.identifier);
++read_obligatory_keywords_count;
@@ -126,8 +168,8 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
proc check_keyword_args = [&]() -> void {
// check if all necessary keywords have been read in
for (int i = 0; i < function->args.keyword.values.next_index; ++i) {
String* defined_keyword = function->args.keyword.keywords.data[i]->value.symbol.identifier;
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
String* defined_keyword = arg_spec->keyword.keywords.data[i]->value.symbol.identifier;
bool was_set = false;
for (int j = 0; j < read_in_keywords.next_index; ++j) {
// TODO(Felix): Later compare the keywords, not their strings!!
@@ -139,7 +181,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
break;
}
}
if (function->args.keyword.values.data[i] == nullptr) {
if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value
if (!was_set) {
create_generic_error(
@@ -153,7 +195,11 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// to use it or if the user supplied his own
if (!was_set) {
try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
try_void val = Memory::copy_lisp_object_except_pairs(function->args.keyword.values.data[i]);
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);
}
}
@@ -162,13 +208,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
proc read_rest_arg = [&]() -> void {
if (arguments == Memory::nil) {
if (function->args.rest) {
define_symbol(function->args.rest, Memory::nil);
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
} else {
if (function->args.rest) {
if (arg_spec->rest) {
define_symbol(
function->args.rest,
arg_spec->rest,
// NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it...
arguments);
@@ -187,11 +233,27 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
try check_keyword_args();
try read_rest_arg();
Lisp_Object* result;
try result = eval_expr(function->body);
return result;
return new_env;
}
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function) -> Lisp_Object* {
profile_this;
Environment* new_env;
try new_env = create_extended_environment_for_function_application(arguments, function);
push_environment(new_env);
defer {
pop_environment();
};
Lisp_Object* result;
// if c function:
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
try result = function->value.cFunction->body();
else // if lisp function
try result = eval_expr(function->value.function.body);
return result;
}
/**
This parses the argument specification of funcitons into their
@@ -199,145 +261,84 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
positional_arguments, keyword_arguments and rest_argument and
filling it in
*/
proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
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
function->args.positional = create_positional_argument_list(16);
function->args.keyword = create_keyword_argument_list(16);
function->args.rest = nullptr;
result->positional = create_positional_argument_list(16);
result->keyword = create_keyword_argument_list(16);
result->rest = nullptr;
// okay let's try to read some positional arguments
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair.first->value.symbol.identifier, "keys") ||
string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
// 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;
else {
create_parsing_error("A non recognized marker was found "
"in the lambda list: ':%s'",
&arguments->value.pair.first->value.symbol.identifier->data);
return;
}
}
// 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 can be "
"parsed here, but found '%s'",
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 wow we found an actual symbol
// okay we found an actual symbol
append_to_positional_argument_list(
&function->args.positional,
&result->positional,
arguments->value.pair.first);
arguments = arguments->value.pair.rest;
}
// okay we are done with positional arguments, lets check for
// keywords,
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments != Memory::nil)
create_parsing_error("The lambda list must be nil terminated.");
return;
}
// 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;
append_to_keyword_argument_list(&result->keyword, keyword, nullptr);
} else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
// if we are on a keyword with a default value
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair.first->value.symbol.identifier, "keys"))
{
arguments = arguments->value.pair.rest;
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_parsing_error("Actual keys have to follow the :keys indicator.");
}
// if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
// create_parsing_error(
// "Only symbols can be parsed here, but found '%s'.",
// Lisp_Object_Type_to_string(arguments->value.pair.first->type));
// return;
// }
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
if (string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
break;
else {
create_parsing_error(
"Only the :rest keyword can be parsed here, but got ':%s'.",
&arguments->value.pair.first->value.symbol.identifier->data);
return;
}
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) != Lisp_Object_Type::Symbol) {
create_parsing_error(
"Only symbols can be parsed here, but found '%s'.",
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
// we found a symbol (arguments->value.pair->first) for
// the keyword args! Let's check if the next arguement is
// :defaults-to
Lisp_Object* next = arguments->value.pair.rest;
if (Memory::get_type(next) == Lisp_Object_Type::Pair &&
Memory::get_type(next->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(next->value.pair.first->value.symbol.identifier,
"defaults-to"))
if (Memory::get_type(arguments->value.pair.first->value.pair.rest)
!= Lisp_Object_Type::Pair)
{
// check if there is a next argument too, otherwise it
// would be an error
next = next->value.pair.rest;
if (Memory::get_type(next) == Lisp_Object_Type::Pair) {
Lisp_Object* ret;
push_environment(function->parent_environment);
defer {
pop_environment();
};
try_void ret = eval_expr(next->value.pair.first);
append_to_keyword_argument_list(&function->args.keyword,
arguments->value.pair.first,
ret);
arguments = next->value.pair.rest;
} else {
create_parsing_error("Expecting a value after 'defaults-to'");
return;
}
} else {
// No :defaults-to, so just add it to the list
append_to_keyword_argument_list(&function->args.keyword,
arguments->value.pair.first,
nullptr);
arguments = next;
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
}
}
}
append_to_keyword_argument_list(&result->keyword, keyword, 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)
create_parsing_error("The lambda list must be nil terminated.");
return;
}
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
string_equal(arguments->value.pair.first->value.symbol.identifier, "rest"))
{
arguments = arguments->value.pair.rest;
if (// arguments->type != Lisp_Object_Type::Pair ||
Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol)
{
create_parsing_error("After the 'rest' marker there must follow a symbol.");
if (arguments == Memory::nil)
return;
}
function->args.rest = arguments->value.pair.first;
if (arguments->value.pair.rest != Memory::nil) {
create_parsing_error("The lambda list must end after the rest symbol");
}
} else {
printf("this should not happen?");
create_generic_error("What is happening?");
if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol)
result->rest = arguments;
else
create_parsing_error("The rest argument must be a symbol.");
}
}
@@ -361,11 +362,11 @@ proc list_length(Lisp_Object* node) -> int {
return 0;
}
proc eval_arguments(Lisp_Object* arguments, int *out_arguments_length) -> Lisp_Object* {
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this;
int my_out_arguments_length = 0;
// int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
*(out_arguments_length) = 0;
// *(out_arguments_length) = 0;
return arguments;
}
@@ -390,9 +391,9 @@ proc eval_arguments(Lisp_Object* arguments, int *out_arguments_length) -> Lisp_O
create_parsing_error("Attempting to evaluate ill formed argument list.");
return nullptr;
}
++my_out_arguments_length;
// ++my_out_arguments_length;
}
*(out_arguments_length) = my_out_arguments_length;
// *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
}
@@ -435,12 +436,10 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
}
Lisp_Object* arguments = node->value.pair.rest;
int arguments_length;
// check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result;
try result = lispOperator->value.cFunction->function(arguments);
try result = apply_arguments_to_function(arguments, lispOperator);
return result;
}
@@ -449,12 +448,9 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
// only for lambdas we evaluate the arguments before
// apllying, for the other types, special-lambda and macro
// we do not need.
if (lispOperator->value.function.type == Function_Type::Lambda) {
try arguments = eval_arguments(arguments, &arguments_length);
}
Lisp_Object* result;
try result = apply_arguments_to_function(arguments, &lispOperator->value.function);
try result = apply_arguments_to_function(arguments, lispOperator);
// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
@@ -464,7 +460,9 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
// 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 = *result;
// eval again because macro
try result = eval_expr(result);
}
src/forward_decls.cpp
+4 -2
View File
@@ -4,12 +4,12 @@ proc built_in_import(String*) -> Lisp_Object*;
proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void;
proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void;
proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void;
proc eval_arguments(Lisp_Object*, int*) -> Lisp_Object*;
proc eval_arguments(Lisp_Object*) -> Lisp_Object*;
proc eval_expr(Lisp_Object*) -> Lisp_Object*;
proc is_truthy (Lisp_Object*) -> bool;
proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment() -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void;
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function) -> void;
proc print_environment(Environment*) -> void;
@@ -36,6 +36,8 @@ namespace Parser {
extern String* parser_file;
extern int parser_line;
extern int parser_col;
proc parse_single_expression(char* text) -> Lisp_Object*;
}
namespace Globals {
src/gc.cpp
+94 -93
View File
@@ -1,93 +1,94 @@
namespace GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
Lisp_Object_Array_List marked_objects;
String_Array_List marked_strings;
Environment_Array_List marked_environments;
Environment_Array_List protected_environments;
proc marked(Lisp_Object* node) -> bool {
return false;
}
proc marked(Environment* env) -> bool {
return false;
}
proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node))
return;
// mark object itself
append_to_array_list(&marked_objects, node);
// mark docstring
if (node->docstring)
append_to_array_list(&marked_strings, node->docstring);
// mark type specific data
switch (Memory::get_type(node)) {
case Lisp_Object_Type::Pair: {
for_lisp_list (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::Vector: {
for_lisp_vector (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::String: {
append_to_array_list(&marked_strings, node->value.string);
} break;
case Lisp_Object_Type::Function: {
// NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function.parent_environment);
maybe_mark(node->value.function.body);
// mark the default arguemnt values:
for_array_list (node->value.function.args.keyword.values) {
if (it) maybe_mark(it);
}
} break;
}
}
proc maybe_mark(Environment* env) -> void {
if (marked(env))
return;
append_to_array_list(&marked_environments, env);
for_array_list (env->parents) {
maybe_mark(it);
}
Lisp_Object* it = env->values[0];
for (int i = 0; i < env->next_index; it = env->values[++i]) {
maybe_mark(it);
}
}
proc garbage_collect() -> void {
profile_this;
++current_mark;
for_array_list (protected_environments) maybe_mark(it);
for_array_list (Globals::Current_Execution::envi_stack) maybe_mark(it);
}
proc gc_init_and_go() -> void {
current_mark = 0;
marked_objects = create_Lisp_Object_array_list(1024);
marked_environments = create_Environment_array_list(1024);
while (1) {
garbage_collect();
}
}
}
namespace GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
Lisp_Object_Array_List marked_objects;
String_Array_List marked_strings;
Environment_Array_List marked_environments;
Environment_Array_List protected_environments;
proc marked(Lisp_Object* node) -> bool {
return false;
}
proc marked(Environment* env) -> bool {
return false;
}
proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node))
return;
// mark object itself
append_to_array_list(&marked_objects, node);
// mark docstring
if (node->docstring)
append_to_array_list(&marked_strings, node->docstring);
// mark type specific data
switch (Memory::get_type(node)) {
case Lisp_Object_Type::Pair: {
for_lisp_list (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::Vector: {
for_lisp_vector (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::String: {
append_to_array_list(&marked_strings, node->value.string);
} break;
case Lisp_Object_Type::Function: {
// NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function.parent_environment);
maybe_mark(node->value.function.body);
// mark the default arguemnt values:
for_array_list (node->value.function.args.keyword.values) {
if (it) maybe_mark(it);
}
} break;
default: break;
}
}
proc maybe_mark(Environment* env) -> void {
if (marked(env))
return;
append_to_array_list(&marked_environments, env);
for_array_list (env->parents) {
maybe_mark(it);
}
Lisp_Object* it = env->values[0];
for (int i = 0; i < env->next_index; it = env->values[++i]) {
maybe_mark(it);
}
}
proc garbage_collect() -> void {
profile_this;
++current_mark;
for_array_list (protected_environments) maybe_mark(it);
for_array_list (Globals::Current_Execution::envi_stack) maybe_mark(it);
}
proc gc_init_and_go() -> void {
current_mark = 0;
marked_objects = create_Lisp_Object_array_list(1024);
marked_environments = create_Environment_array_list(1024);
while (1) {
garbage_collect();
}
}
}
src/io.cpp
+2 -2
View File
@@ -366,7 +366,7 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head);
print(head, print_repr, file);
}
putc(')', file);
@@ -376,7 +376,7 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj);
print(obj, true);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
src/main.cpp
+2 -1
View File
@@ -1,10 +1,11 @@
#include "slime.h"
int main(int argc, char* argv[]) {
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
Slime::interprete_file("generate-docs.slime");
Slime::interprete_file((char*)"generate-docs.slime");
return res ? 0 : 1;
}
src/memory.cpp
+17 -16
View File
@@ -184,8 +184,8 @@ namespace Memory {
try_void Parser::standard_in = create_string("stdin");
try_void Globals::Current_Execution::envi_stack.data[0] = create_built_ins_environment();
try_void Globals::Current_Execution::envi_stack.next_index = 1;
Globals::Current_Execution::envi_stack.next_index = 0;
push_environment(create_built_ins_environment());
}
proc reset() -> void {
@@ -198,8 +198,8 @@ namespace Memory {
next_index_in_environment_memory = 0;
next_free_spot_in_string_memory = string_memory;
try_void Globals::Current_Execution::envi_stack.data[0] = create_built_ins_environment();
try_void Globals::Current_Execution::envi_stack.next_index = 1;
Globals::Current_Execution::envi_stack.next_index = 0;
push_environment(create_built_ins_environment());
}
proc create_lisp_object_number(double number) -> Lisp_Object* {
@@ -306,13 +306,14 @@ namespace Memory {
Memory::create_string(keyword));
}
proc create_lisp_object_cfunction(std::function<Lisp_Object* (Lisp_Object*)> function) -> Lisp_Object* {
proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::CFunction);
// node->value.lambdaWrapper = new Lambda_Wrapper(function);
node->value.cFunction = new(cFunction);
node->value.cFunction->function = function;
node->value.cFunction->args = {};
node->value.cFunction->is_special_form = is_special;
return node;
}
@@ -402,17 +403,17 @@ namespace Memory {
load_built_ins_into_environment();
// // save the current working directory
// char* cwd = get_cwd();
// defer {
// change_cwd(cwd);
// free(cwd);
// };
// save the current working directory
//char* cwd = get_cwd();
//defer {
// change_cwd(cwd);
// free(cwd);
//};
// // get the direction of the exe
// char* exe_path = get_exe_dir();
// change_cwd(exe_path);
// free(exe_path);
//// get the direction of the exe
//char* exe_path = get_exe_dir();
//change_cwd(exe_path);
//free(exe_path);
built_in_load(Memory::create_string("pre.slime"));
src/parse.cpp
+99 -99
View File
@@ -366,118 +366,118 @@ namespace Parser {
}
// check if we have to create or delete or run macros
while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
Lisp_Object* parsed_symbol = expression->value.pair.first;
if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) {
// create a new macro
Lisp_Object* arguments = expression->value.pair.rest;
Lisp_Object* body;
int arguments_length;
// while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
// Lisp_Object* parsed_symbol = expression->value.pair.first;
// if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) {
// // create a new macro
// Lisp_Object* arguments = expression->value.pair.rest;
// Lisp_Object* body;
// int arguments_length;
// HACK(Felix): almost code duplicate from
// `built_ins.cpp`: special-lambda
try arguments_length = list_length(arguments);
// // HACK(Felix): almost code duplicate from
// // `built_ins.cpp`: special-lambda
// try arguments_length = list_length(arguments);
// (define-syntax (defun name args :rest body) (...))
if (arguments_length < 2) {
create_wrong_number_of_arguments_error(3, arguments_length);
return nullptr;
}
// // (define-syntax (defun name args :rest body) (...))
// if (arguments_length < 2) {
// create_wrong_number_of_arguments_error(3, arguments_length);
// return nullptr;
// }
assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
// assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
// extract the name
Lisp_Object* symbol_for_macro = arguments->value.pair.first->value.pair.first;
body = arguments->value.pair.rest;
arguments = arguments->value.pair.first->value.pair.rest;
// // extract the name
// Lisp_Object* symbol_for_macro = arguments->value.pair.first->value.pair.first;
// body = arguments->value.pair.rest;
// arguments = arguments->value.pair.first->value.pair.rest;
// Function* function = new(Function);
Lisp_Object* macro;
try macro = Memory::create_lisp_object();
Memory::set_type(macro, Lisp_Object_Type::Function);
macro->value.function.parent_environment = get_current_environment();
macro->value.function.type = Function_Type::Macro;
// // Function* function = new(Function);
// Lisp_Object* macro;
// try macro = Memory::create_lisp_object();
// Memory::set_type(macro, Lisp_Object_Type::Function);
// macro->value.function.parent_environment = get_current_environment();
// macro->value.function.type = Function_Type::Macro;
// if parameters were specified
if (arguments != Memory::nil) {
try assert_type(arguments, Lisp_Object_Type::Pair);
try parse_argument_list(arguments, &macro->value.function);
} else {
macro->value.function.args.positional = create_positional_argument_list(1);
macro->value.function.args.keyword = create_keyword_argument_list(1);
macro->value.function.args.rest = nullptr;
}
// // if parameters were specified
// if (arguments != Memory::nil) {
// try assert_type(arguments, Lisp_Object_Type::Pair);
// try create_arguments_from_lambda_list_and_inject(arguments, macro);
// } else {
// macro->value.function.args.positional = create_positional_argument_list(1);
// macro->value.function.args.keyword = create_keyword_argument_list(1);
// macro->value.function.args.rest = nullptr;
// }
// arguments = arguments->value.pair.rest;
// if there is a docstring, use it
if (Memory::get_type(body->value.pair.first) == Lisp_Object_Type::String) {
macro->docstring = body->value.pair.first->value.string;
body = body->value.pair.rest;
} else {
macro->docstring = nullptr;
}
// // arguments = arguments->value.pair.rest;
// // if there is a docstring, use it
// if (Memory::get_type(body->value.pair.first) == Lisp_Object_Type::String) {
// macro->docstring = body->value.pair.first->value.string;
// body = body->value.pair.rest;
// } else {
// macro->docstring = nullptr;
// }
// we are now in the function body, just wrap it in an
// implicit begin
try macro->value.function.body = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("begin"),
body);
// // we are now in the function body, just wrap it in an
// // implicit begin
// try macro->value.function.body = Memory::create_lisp_object_pair(
// Memory::get_or_create_lisp_object_symbol("begin"),
// body);
inject_scl(macro);
// macro->value.function = function;
define_symbol(symbol_for_macro, macro);
// inject_scl(macro);
// // macro->value.function = function;
// define_symbol(symbol_for_macro, macro);
// print_environment(environment_for_macros);
return Memory::nil;
// // print_environment(environment_for_macros);
// return Memory::nil;
} else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) {
/* --- deleting an existing macro --- */
// TODO(Felix): this is a hard one because when
// environments will be made from hashmaps, how can we
// delete stuff from hashmaps? If we do probing on
// collision and then delte the first colliding entry,
// how can we find the second one? How many probes do
// we have to do to know for sure that an elemenet is
// not in the hashmap? It would be much easier if we
// never deleted any elements from the hashmap, so
// that, when an entry is not found immidiately, we
// know for sure that it does not exist in the table.
// } else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) {
// /* --- deleting an existing macro --- */
// // TODO(Felix): this is a hard one because when
// // environments will be made from hashmaps, how can we
// // delete stuff from hashmaps? If we do probing on
// // collision and then delte the first colliding entry,
// // how can we find the second one? How many probes do
// // we have to do to know for sure that an elemenet is
// // not in the hashmap? It would be much easier if we
// // never deleted any elements from the hashmap, so
// // that, when an entry is not found immidiately, we
// // know for sure that it does not exist in the table.
create_generic_error("deleting macros has not yet be implemented,"
"and I don't know if it is a good idea to do so.");
return nullptr;
} else {
// if threre is a macro named like this, then macroexpand
// if not it is regular code, dont touch.
break;
// create_generic_error("deleting macros has not yet be implemented,"
// "and I don't know if it is a good idea to do so.");
// return nullptr;
// } else {
// // if threre is a macro named like this, then macroexpand
// // if not it is regular code, dont touch.
// break;
Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment());
if (macro &&
Memory::get_type(macro) == Lisp_Object_Type::Function &&
macro->value.function.type == Function_Type::Macro)
{
// printf("pretending to expand macro at %s %d %d: ",
// Memory::get_c_str(parser_file),
// parser_line, parser_col);
// print(parsed_symbol);
// printf("\n");
// NOTE(Felix): Execute it as a special lambda,
// because if we keep it as a macro, the evaluator
// will think it is a stray macro that was not yet
// expanded, and attempt to evaluate it twice (1.
// for expanding, and 2. for evaluating)
macro->value.function.type = Function_Type::Special_Lambda;
// NOTE(Felix): deferred so even if eval expr
// fails, and returns, the type will be be
// resetted to macro.
defer {
macro->value.function.type = Function_Type::Macro;
};
try expression = eval_expr(expression);
break;
} else break;
}
}
// Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment());
// if (macro &&
// Memory::get_type(macro) == Lisp_Object_Type::Function &&
// macro->value.function.type == Function_Type::Macro)
// {
// // printf("pretending to expand macro at %s %d %d: ",
// // Memory::get_c_str(parser_file),
// // parser_line, parser_col);
// // print(parsed_symbol);
// // printf("\n");
// // NOTE(Felix): Execute it as a special lambda,
// // because if we keep it as a macro, the evaluator
// // will think it is a stray macro that was not yet
// // expanded, and attempt to evaluate it twice (1.
// // for expanding, and 2. for evaluating)
// macro->value.function.type = Function_Type::Special_Lambda;
// // NOTE(Felix): deferred so even if eval expr
// // fails, and returns, the type will be be
// // resetted to macro.
// defer {
// macro->value.function.type = Function_Type::Macro;
// };
// try expression = eval_expr(expression);
// break;
// } else break;
// }
// }
return expression;
}
src/structs.cpp
+5 -3
View File
@@ -121,13 +121,15 @@ struct Environment {
struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // implicit begin
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};
struct cFunction {
std::function<Lisp_Object* (Lisp_Object*)> function;
std::function<Lisp_Object* ()> body;
Arguments args;
bool is_special_form;
};
struct Lisp_Object {
src/testing.cpp
+12 -7
View File
@@ -196,8 +196,7 @@ proc test_array_lists_searching() -> testresult {
proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string);
int operands_length;
try operands = eval_arguments(operands, &operands_length);
try operands = eval_arguments(operands);
assert_no_error();
assert_equal_int(list_length(operands), 4);
@@ -504,7 +503,7 @@ proc test_built_in_type() -> testresult {
assert_equal_string(result->value.symbol.identifier, "number");
// setting user type
char exp_string2[] = "(begin (set-type a :my-type)(type a))";
char exp_string2[] = "(begin (set-type! a :my-type)(type a))";
expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression);
@@ -514,7 +513,7 @@ proc test_built_in_type() -> testresult {
assert_equal_string(result->value.symbol.identifier, "my-type");
// trying to set invalid user type
char exp_string3[] = "(begin (set-type a \"wrong tpye\")(type a))";
char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3);
assert_no_error();
@@ -528,7 +527,7 @@ proc test_built_in_type() -> testresult {
delete_error();
// deleting user type
char exp_string4[] = "(begin (delete-type a)(type a))";
char exp_string4[] = "(begin (delete-type! a)(type a))";
expression = Parser::parse_single_expression(exp_string4);
result = eval_expr(expression);
@@ -598,13 +597,19 @@ proc run_all_tests() -> bool {
bool result = true;
Memory::init(4096 * 2000, 1024 * 32, 4096 * 16 * 10);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer{
pop_environment();
};
printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching);
Memory::init(4096 * 2000, 1024 * 32, 4096 * 16 * 10);
printf("\n -- Parsing --\n");
invoke_test(test_parse_atom);
invoke_test(test_parse_expression);