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
bin/pre.slime
+33
View File
@@ -25,6 +25,39 @@
(define-syntax (mac a) (list + 1 1)) (define-syntax (mac a) (list + 1 1))
(define-syntax (add . args) (pair '+ args)) (define-syntax (add . args) (pair '+ args))
(define-syntax (and . args)
;; (and cond1 cond2 (cond3 args))
;; ->
;; (if cond1
;; (if cond2
;; (let ((g (cond3 args)))
;; (if g
;; g
;; ()))
;; ())
;; ())
(if args
`(,if ,(first args)
,(apply and (rest args))
())
t))
(define-syntax (or . args)
;; (or cond1 cond2 (cond3 args))
;; ->
;; (if cond1
;; t
;; (if cond2
;; t
;; (if (cond3 args)
;; t
;; ())))
(if args
`(,if ,(first args)
t
,(apply or (rest args)))
()))
(define-syntax (when condition . body) (define-syntax (when condition . body)
"Special form for when multiple actions should be done if a "Special form for when multiple actions should be done if a
condition is true. condition is true.
src/built_ins.cpp
+10 -32
View File
@@ -543,6 +543,14 @@ namespace Slime {
return Memory::create_lisp_object(x); 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") { define_special((bound? var), "TODO") {
profile_with_name("(bound?)"); profile_with_name("(bound?)");
fetch(var); fetch(var);
@@ -807,40 +815,10 @@ namespace Slime {
expr = unquoteSomeExpressions(unquoteSomeExpressions, expr); expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
return expr; return expr;
}; };
define_special((and . args), "TODO") { define((not test), "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") {
profile_with_name("(not)"); profile_with_name("(not)");
fetch(test); fetch(test);
bool truthy; return is_truthy(test) ? Memory::nil : Memory::t;
in_caller_env {
try truthy = is_truthy(test);
}
return (truthy) ? Memory::nil : Memory::t;
}; };
// // // defun("while", "TODO", __LINE__, cLambda { // // // defun("while", "TODO", __LINE__, cLambda {
// // // try arguments_length = list_length(arguments); // // // try arguments_length = list_length(arguments);
src/env.cpp
+5 -1
View File
@@ -1,7 +1,11 @@
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(); 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); env->hm.set_object((void*)symbol, value);
} }
src/eval.cpp
+112 -163
View File
@@ -1,38 +1,18 @@
namespace Slime { namespace Slime {
proc create_extended_environment_for_function_application_nrc( 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, Lisp_Object* function,
int arg_start, int arg_start,
int arg_end) -> Environment* int arg_end) -> Environment*
{ {
profile_this(); 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; 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; 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; Array_List<Lisp_Object*> read_in_keywords;
read_in_keywords.alloc(); read_in_keywords.alloc();
defer { defer {
@@ -41,201 +21,173 @@ namespace Slime {
int obligatory_keywords_count = 0; int obligatory_keywords_count = 0;
int read_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 = [&] { // read positionals
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
sym = arg_spec->positional.symbols.data[i]; if (index_of_next_arg == arg_end) {
if (arg_pos == arg_end) { create_parsing_error(
create_parsing_error( "Not enough positional args supplied. Needed: %d suppied, %d.\n"
"Not enough positional args supplied. Needed: %d suppied, %d.\n" "Next missing arg is '%s'",
"Next missing arg is '%s'", arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
arg_spec->positional.symbols.next_index, arg_end-arg_pos, &arg_spec->positional.symbols.data[i]->value.symbol->data);
&sym->value.symbol->data); return nullptr;
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];
} }
}; // NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. To C functions we
proc read_keyword_args = [&] { // pass by reference for better performance and trust them
// debug_break(); // to not mutate the arguments because we expect c
// keyword arguments: use all given ones and keep track of the // programmers to know what they are doing. Bold claim I
// added ones (array list), if end of parameters in encountered or // know.
// something that is not a keyword is encountered or a keyword if (is_c_function) {
// that is not recognized is encoutered, jump out of the loop. define_symbol(arg_spec->positional.symbols.data[i], cs.data[index_of_next_arg], env);
} else {
if (arg_pos == arg_end) { define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
return;
} }
++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 // find out how many keyword args we /have/ to read
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arg_spec->keyword.values.data[i] == nullptr) if (arg_spec->keyword.values.data[i] == nullptr)
++obligatory_keywords_count; ++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 // check if this one is even an accepted keyword
bool accepted = false; bool accepted = false;
for (int i = 0; i < arg_spec->keyword.keywords.next_index; ++i) { 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; accepted = true;
break; break;
} }
} }
if (!accepted) { if (!accepted) {
// NOTE(Felix): if we are actually done with all the // if we read all we need then we are done here
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count) 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( create_generic_error(
"The function does not take the keyword argument ':%s'\n" "The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n" "and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.", "in to potentially count it as the rest argument.",
&(next_arg->value.symbol->data)); &(cs.data[index_of_next_arg]->value.symbol->data));
return; return nullptr;
} }
// This is an accepted kwarg; check if it was already
// check if it was already read in // read in
for (int i = 0; i < read_in_keywords.next_index; ++i) { 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 // if we already read it in but also finished
// necessary keywords then we have to count the rest // all other kwargs, then count it as rest and
// as :rest here, instead od always creating an error // be done here
// (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count) 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( create_generic_error(
"The function already read the keyword argument ':%s'", "The function already read the keyword argument ':%s'",
&(next_arg->value.symbol->data)); &(cs.data[index_of_next_arg]->value.symbol->data));
return; return nullptr;
} }
} }
// okay so we found a keyword that has to be read in and was // 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 // not already read in, is there a next element to actually
// set it to? // set it to?
if (arg_pos == arg_end) { if (index_of_next_arg+1 == arg_end) {
create_generic_error( create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.", "Attempting to set the keyword argument ':%s', but no value was supplied.",
&(next_arg->value.symbol->data)); &(cs.data[index_of_next_arg]->value.symbol->data));
return; return nullptr;
} }
// if not set it and then add it to the array list // if not set it and then add it to the array list
Lisp_Object* key = next_arg; Lisp_Object* key = cs.data[index_of_next_arg];
try_void sym = Memory::get_symbol(key->value.symbol); try sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_pos]; ++index_of_next_arg;
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) { if (is_c_function) {
try_void define_symbol(sym, next_arg); try define_symbol(sym, cs.data[index_of_next_arg], env);
} else { } else {
try_void define_symbol(sym, try define_symbol(sym, Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
Memory::copy_lisp_object_except_pairs(next_arg));
} }
read_in_keywords.append(key); read_in_keywords.append(key);
++read_obligatory_keywords_count; ++read_obligatory_keywords_count;
// overstep both for next one ++index_of_next_arg;
next_arg = cs->data[++arg_pos];
if (arg_pos == arg_end) { if (index_of_next_arg == arg_end) {
break; break;
} }
} }
}; }
proc check_keyword_args = [&]() -> void { kw_done:
// check if all necessary keywords have been read in // check keywords for completeness
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
auto defined_keyword = arg_spec->keyword.keywords.data[i]; auto defined_keyword = arg_spec->keyword.keywords.data[i];
bool was_set = false; bool was_set = false;
for (int j = 0; j < read_in_keywords.next_index; ++j) { for (int j = 0; j < read_in_keywords.next_index; ++j) {
if (read_in_keywords.data[j] == defined_keyword) { if (read_in_keywords.data[j] == defined_keyword) {
was_set = true; 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) {
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);
}
} }
} }
}; if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value
proc read_rest_arg = [&]() -> void { if (!was_set) {
if (arg_pos == arg_end) { create_generic_error(
if (arg_spec->rest) { "There was no value supplied for the required "
define_symbol(arg_spec->rest, Memory::nil); "keyword argument ':%s'.",
&defined_keyword->value.symbol->data);
return nullptr;
} }
} else { } else {
if (arg_spec->rest) { // this one does have a default value, lets see if we have
// to use it or if the user supplied his own
Lisp_Object* list; if (!was_set) {
try_void list = Memory::create_list(next_arg); try sym = Memory::get_symbol(defined_keyword->value.symbol);
Lisp_Object* head = list; if (is_c_function) {
for (++arg_pos;arg_pos < arg_end; ++arg_pos) { try val = arg_spec->keyword.values.data[i];
next_arg = cs->data[arg_pos]; } else {
try_void head->value.pair.rest = Memory::create_list(next_arg); try val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
head = head->value.pair.rest;
} }
define_symbol(arg_spec->rest, list); define_symbol(sym, val, 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;
} }
} }
}; }
try read_positional_args(); // read in rest arg
try read_keyword_args(); if (index_of_next_arg == arg_end) {
try check_keyword_args(); if (arg_spec->rest) {
try read_rest_arg(); 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; Environment* extended_env;
try extended_env = create_extended_environment_for_function_application_nrc( 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; cs.next_index = am;
push_environment(extended_env); push_environment(extended_env);
if (function->value.function->is_c) { if (function->value.function->is_c) {
@@ -558,11 +510,8 @@ namespace Slime {
return cs.data[--cs.next_index]; return cs.data[--cs.next_index];
} }
proc is_truthy(Lisp_Object* expression) -> bool { inline proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result; return expression != Memory::nil;
try result = eval_expr(expression);
return result != Memory::nil;
} }
proc interprete_file (char* file_name) -> Lisp_Object* { 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*); 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 define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true); 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(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*); void print_environment(Environment*);