felix
/
slime
1
0
Fork 0
Código Incidencias 0 Pull Requests 0 Lanzamientos 0 Wiki Actividad
Explorar el Código

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

master
Felix Brendel hace 6 años
padre
aac3985a61
commit
e22ffb7354
Se han modificado 5 ficheros con 162 adiciones y 197 borrados
Dividir vista
Opciones de diferencias
Mostrar estadísticas Descargar archivo de parche Descargar archivo de diferencias
  1. +33
    -0
      bin/pre.slime
  2. +10
    -32
      src/built_ins.cpp
  3. +5
    -1
      src/env.cpp
  4. +113
    -164
      src/eval.cpp
  5. +1
    -0
      src/forward_decls.cpp

+ 33
- 0
bin/pre.slime Ver fichero

@@ -25,6 +25,39 @@
(define-syntax (mac a) (list + 1 1))
(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)
"Special form for when multiple actions should be done if a
condition is true.


+ 10
- 32
src/built_ins.cpp Ver fichero

@@ -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);


+ 5
- 1
src/env.cpp Ver fichero

@@ -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);
}


+ 113
- 164
src/eval.cpp Ver fichero

@@ -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];
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];
Lisp_Object* sym;
Lisp_Object* val;
// 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* {


+ 1
- 0
src/forward_decls.cpp Ver fichero

@@ -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*);


Escribir Vista previa
Cargando…
Cancelar
Guardar