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

Fixed a bug where cs was accessed out of bouds, gensyms, 'and and 'or are now macros

Browse Source
This commit is contained in:
Felix Brendel
2020-03-17 12:06:55 +01:00
parent aac3985a61
commit e22ffb7354
5 changed files with 161 additions and 196 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+10 -32
View File
@@ -543,6 +543,14 @@ namespace Slime {
return Memory::create_lisp_object(x);
};
define((gensym), "TODO") {
profile_with_name("(gensym)");
Lisp_Object* node;
try node = Memory::create_lisp_object();
Memory::set_type(node, Lisp_Object_Type::Symbol);
node->value.symbol = Memory::create_string("gensym");
return node;
};
define_special((bound? var), "TODO") {
profile_with_name("(bound?)");
fetch(var);
@@ -807,40 +815,10 @@ namespace Slime {
expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
return expr;
};
define_special((and . args), "TODO") {
profile_with_name("(and)");
fetch(args);
bool result = true;
in_caller_env {
for_lisp_list (args) {
try result &= is_truthy(it);
if (!result)
return Memory::nil;
}
}
return Memory::t;
};
define_special((or . args), "TODO") {
profile_with_name("(or)");
fetch(args);
bool result = false;
in_caller_env {
for_lisp_list (args) {
try result |= is_truthy(it);
if (result)
return Memory::t;
}
}
return Memory::nil;
};
define_special((not test), "TODO") {
define((not test), "TODO") {
profile_with_name("(not)");
fetch(test);
bool truthy;
in_caller_env {
try truthy = is_truthy(test);
}
return (truthy) ? Memory::nil : Memory::t;
return is_truthy(test) ? Memory::nil : Memory::t;
};
// // // defun("while", "TODO", __LINE__, cLambda {
// // // try arguments_length = list_length(arguments);
src/env.cpp
+5 -1
View File
@@ -1,7 +1,11 @@
namespace Slime {
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment();
define_symbol(symbol, value, get_current_environment());
}
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void {
profile_with_comment(&symbol->value.symbol->data);
env->hm.set_object((void*)symbol, value);
}
src/eval.cpp
+112 -163
View File
@@ -1,38 +1,18 @@
namespace Slime {
proc create_extended_environment_for_function_application_nrc(
// TODO(Felix): pass cs as value as soon as we got rid of
// destructors, to prevent destroying it on scope exit
Array_List<Lisp_Object*>* cs,
Lisp_Object* function,
int arg_start,
int arg_end) -> Environment*
{
profile_this();
using namespace Globals::Current_Execution;
int arg_pos = arg_start;
int index_of_next_arg = arg_start;
bool is_c_function = function->value.function->is_c;
Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
Environment* env = Memory::create_child_environment(function->value.function->parent_environment);
Arguments* arg_spec = &function->value.function->args;
// NOTE(Felix): Step 1.
// - setting the parent environment
// - setting the arg_spec
// - potentially evaluating the 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;
read_in_keywords.alloc();
defer {
@@ -41,201 +21,173 @@ namespace Slime {
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;
Lisp_Object* next_arg = cs->data[arg_pos];
Lisp_Object* sym;
Lisp_Object* val;
proc read_positional_args = [&] {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
sym = arg_spec->positional.symbols.data[i];
if (arg_pos == arg_end) {
create_parsing_error(
"Not enough positional args supplied. Needed: %d suppied, %d.\n"
"Next missing arg is '%s'",
arg_spec->positional.symbols.next_index, arg_end-arg_pos,
&sym->value.symbol->data);
return;
}
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code.
// XXX(Felix): To C functions we pass by reference.
// TODO(Felix): Why did we decide this??
if (is_c_function) {
define_symbol(sym, next_arg);
} else {
define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(next_arg));
}
assert("cs access index out of range",
arg_pos+1 < cs->next_index);
next_arg = cs->data[++arg_pos];
// read positionals
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (index_of_next_arg == arg_end) {
create_parsing_error(
"Not enough positional args supplied. Needed: %d suppied, %d.\n"
"Next missing arg is '%s'",
arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
&arg_spec->positional.symbols.data[i]->value.symbol->data);
return nullptr;
}
};
proc read_keyword_args = [&] {
// debug_break();
// 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 (arg_pos == arg_end) {
return;
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. To C functions we
// pass by reference for better performance and trust them
// to not mutate the arguments because we expect c
// programmers to know what they are doing. Bold claim I
// know.
if (is_c_function) {
define_symbol(arg_spec->positional.symbols.data[i], cs.data[index_of_next_arg], env);
} else {
define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
}
++index_of_next_arg;
}
// if there are some left read keywords and rest
if (index_of_next_arg != arg_end) {
// 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;
}
while (Memory::get_type(next_arg) == Lisp_Object_Type::Keyword) {
while (Memory::get_type(cs.data[index_of_next_arg]) == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
for (int i = 0; i < arg_spec->keyword.keywords.next_index; ++i) {
if (next_arg == arg_spec->keyword.keywords.data[i])
{
if (cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) {
accepted = true;
break;
}
}
if (!accepted) {
// NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
// if we read all we need then we are done here
if (read_obligatory_keywords_count == obligatory_keywords_count)
return;
break;
// otherwise we would have to read more but there
// was a not accepted kwarg, so signal the error
create_generic_error(
"The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.",
&(next_arg->value.symbol->data));
return;
&(cs.data[index_of_next_arg]->value.symbol->data));
return nullptr;
}
// check if it was already read in
// This is an accepted kwarg; check if it was already
// read in
for (int i = 0; i < read_in_keywords.next_index; ++i) {
if (next_arg == read_in_keywords.data[i])
if (cs.data[index_of_next_arg] == read_in_keywords.data[i])
{
// NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
// if we already read it in but also finished
// all other kwargs, then count it as rest and
// be done here
if (read_obligatory_keywords_count == obligatory_keywords_count)
return;
goto kw_done;
// If there are some kwargs left to be read
// in, it is an error
create_generic_error(
"The function already read the keyword argument ':%s'",
&(next_arg->value.symbol->data));
return;
&(cs.data[index_of_next_arg]->value.symbol->data));
return nullptr;
}
}
// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (arg_pos == arg_end) {
if (index_of_next_arg+1 == arg_end) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(next_arg->value.symbol->data));
return;
&(cs.data[index_of_next_arg]->value.symbol->data));
return nullptr;
}
// if not set it and then add it to the array list
Lisp_Object* key = next_arg;
try_void sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_pos];
Lisp_Object* key = cs.data[index_of_next_arg];
try sym = Memory::get_symbol(key->value.symbol);
++index_of_next_arg;
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) {
try_void define_symbol(sym, next_arg);
try define_symbol(sym, cs.data[index_of_next_arg], env);
} else {
try_void define_symbol(sym,
Memory::copy_lisp_object_except_pairs(next_arg));
try define_symbol(sym, Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
}
read_in_keywords.append(key);
++read_obligatory_keywords_count;
// overstep both for next one
next_arg = cs->data[++arg_pos];
++index_of_next_arg;
if (arg_pos == arg_end) {
if (index_of_next_arg == arg_end) {
break;
}
}
};
}
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);
}
kw_done:
// check keywords for completeness
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;
}
}
};
proc read_rest_arg = [&]() -> void {
if (arg_pos == arg_end) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
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 nullptr;
}
} else {
if (arg_spec->rest) {
Lisp_Object* list;
try_void list = Memory::create_list(next_arg);
Lisp_Object* head = list;
for (++arg_pos;arg_pos < arg_end; ++arg_pos) {
next_arg = cs->data[arg_pos];
try_void head->value.pair.rest = Memory::create_list(next_arg);
head = head->value.pair.rest;
// 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 sym = Memory::get_symbol(defined_keyword->value.symbol);
if (is_c_function) {
try val = arg_spec->keyword.values.data[i];
} else {
try val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
}
define_symbol(arg_spec->rest, list);
} 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;
define_symbol(sym, val, env);
}
}
};
}
try read_positional_args();
try read_keyword_args();
try check_keyword_args();
try read_rest_arg();
// read in rest arg
if (index_of_next_arg == arg_end) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil, env);
}
} else {
if (arg_spec->rest) {
Lisp_Object* list;
try list = Memory::create_list(cs.data[index_of_next_arg]);
Lisp_Object* head = list;
for (++index_of_next_arg;index_of_next_arg < arg_end; ++index_of_next_arg) {
try head->value.pair.rest = Memory::create_list(cs.data[index_of_next_arg]);
head = head->value.pair.rest;
}
define_symbol(arg_spec->rest, list, env);
} 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 nullptr;
}
}
return new_env;
return env;
}
@@ -507,7 +459,7 @@ namespace Slime {
Environment* extended_env;
try extended_env = create_extended_environment_for_function_application_nrc(
&cs, function, am+1, cs.next_index);
function, am+1, cs.next_index);
cs.next_index = am;
push_environment(extended_env);
if (function->value.function->is_c) {
@@ -558,11 +510,8 @@ namespace Slime {
return cs.data[--cs.next_index];
}
proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);
return result != Memory::nil;
inline proc is_truthy(Lisp_Object* expression) -> bool {
return expression != Memory::nil;
}
proc interprete_file (char* file_name) -> Lisp_Object* {
src/forward_decls.cpp
+1
View File
@@ -16,6 +16,7 @@ namespace Slime {
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, Environment* env);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);