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

nrc_eval first steps

Browse Source
This commit is contained in:
Felix Brendel
2020-01-08 11:03:49 +01:00
parent 14392a7212
commit f767736064
8 changed files with 591 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+1
View File
@@ -23,3 +23,4 @@ todo.html
/tests/libslime/main
/tests/fullslime/main
*.o
/bin/slime_d
3rd/ftb
+1 -1
Submodule 3rd/ftb updated: 635af49d52...7d8eabf479
build.sh
+36 -29
View File
@@ -2,43 +2,50 @@ TIMEFORMAT=%3lU
SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
pushd $SCRIPTPATH > /dev/null
echo ""
echo "----------------------"
echo " compiling libslime "
echo "----------------------"
time clang++ --std=c++17 \
src/libslime.cpp -c -o libslime.o \
-I3rd/ || exit 1
# echo ""
# echo "----------------------"
# echo " compiling libslime "
# echo "----------------------"
# time clang++ --std=c++17 \
# src/libslime.cpp -c -o libslime.o \
# -I3rd/ || exit 1
echo ""
echo "----------------------"
echo " compiling fullslime "
echo "----------------------"
# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
echo "------------------------------"
echo " compiling fullslime (debug) "
echo "------------------------------"
time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
src/main.cpp -g -o ./bin/slime --std=c++17 \
src/main.cpp -gfull -gdwarf -o ./bin/slime_d --std=c++17 \
-I3rd/ || exit 1
# time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \
# src/main.cpp -g -o ./bin/slime --std=c++17 \
# -I3rd/ || exit 1
pushd ./bin > /dev/null
# echo ""
# echo "--------------------------------"
# echo " compiling fullslime (release) "
# echo "--------------------------------"
# time clang++ -D_DONT_BREAK_ON_ERRORS -O3 \
# src/main.cpp -g -o ./bin/slime --std=c++17 \
# -I3rd/ || exit 1
echo ""
echo "----------------------"
echo " generating docs "
echo "----------------------"
time valgrind -q ./slime dd || exit 1
# pushd ./bin > /dev/null
echo ""
echo "----------------------"
echo " running tests "
echo "----------------------"
# echo ""
# echo "----------------------"
# echo " generating docs "
# echo "----------------------"
# time valgrind -q ./slime_d --generate-docs || exit 1
time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests
# echo ""
# echo "----------------------"
# echo " running tests "
# echo "----------------------"
# time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1
# echo ""
# echo "------------------------"
# echo " running benches "
# echo "------------------------"
# hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
popd > /dev/null
popd > /dev/null
# popd > /dev/null
unset TIMEFORMAT
src/built_ins.cpp
-7
View File
@@ -1,11 +1,4 @@
namespace Slime {
inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
Lisp_Object* begin_symbol = Memory::get_symbol("begin");
if (body->value.pair.rest == Memory::nil)
return body->value.pair.first;
else
return Memory::create_lisp_object_pair(begin_symbol, body);
}
proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
if (n1 == n2)
src/eval.cpp
+527 -24
View File
@@ -1,4 +1,246 @@
namespace Slime {
proc create_extended_environment_for_function_application_nrc(
Array_List<Lisp_Object*> cs,
Lisp_Object* function,
int arg_start,
int arg_count) -> Environment*
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
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;
} else {
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (arg_count == 0) {
return new_env;
}
// 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;
Lisp_Object* next_arg = cs.data[arg_start];
proc read_positional_args = [&] {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (arg_count == 0) {
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.
// TODO(Felix): Why did we decide this??
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) {
define_symbol(sym, next_arg);
} else {
define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(next_arg));
}
next_arg = cs[++arg_start];
--arg_count;
}
};
proc read_keyword_args = [&] {
// 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_count == 0) {
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;
}
while (Memory::get_type(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.values.next_index; ++i) {
if (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 (read_obligatory_keywords_count == obligatory_keywords_count)
return;
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;
}
// 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])
{
// 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 (read_obligatory_keywords_count == obligatory_keywords_count)
return;
create_generic_error(
"The function already read the keyword argument ':%s'",
&(next_arg->value.symbol->data));
return;
}
}
// 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_count == 0) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(next_arg->value.symbol->data));
return;
}
// if not set it and then add it to the array list
try_void sym = Memory::get_symbol(next_arg->value.symbol);
next_arg = cs[++arg_start];
--arg_count;
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) {
try_void define_symbol(sym, next_arg);
} else {
try_void define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(next_arg));
}
read_in_keywords.append(next_arg);
++read_obligatory_keywords_count;
// overstep both for next one
next_arg = cs[++arg_start];
--arg_count;
if (arg_count == 0) {
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);
}
}
}
};
proc read_rest_arg = [&]() -> void {
if (arg_count == 0) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
} else {
if (arg_spec->rest) {
Lisp_Object* list;
try_void list = Memory::create_list(next_arg);
Lisp_Object* head = list;
next_arg = cs[++arg_start];
--arg_count;
while (arg_count > 0) {
try_void head->value.pair.rest = Memory::create_list(next_arg);
head = head->value.pair.rest;
next_arg = cs[++arg_start];
--arg_count;
}
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;
}
}
};
try read_positional_args();
try read_keyword_args();
try check_keyword_args();
try read_rest_arg();
// TODO(Felix): fucking destructors
cs.data = nullptr;
return new_env;
}
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function,
@@ -246,13 +488,12 @@ namespace Slime {
return result;
}
/**
This parses the argument specification of funcitons into their
Function struct. It does this by allocating new
positional_arguments, keyword_arguments and rest_argument and
filling it in
*/
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
/* NOTE This parses the argument specification of funcitons
* into their Function struct. It does this by allocating new
* positional_arguments, keyword_arguments and rest_argument
* and filling it in
*/
Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
@@ -393,6 +634,280 @@ namespace Slime {
return evaluated_arguments;
}
proc pause() {
printf("\n-----------------------\n"
"Press ENTER to continue\n");
getchar();
}
inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
Lisp_Object* begin_symbol = Memory::get_symbol("begin");
if (body->value.pair.rest == Memory::nil)
return body->value.pair.first;
else
return Memory::create_lisp_object_pair(begin_symbol, body);
}
proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* {
enum struct Action {
Eval,
Step,
TM,
Pop,
If,
Define_Var,
Pop_Environment
};
Array_List<Lisp_Object*> cs;
Array_List<Lisp_Object*> pcs;
Array_List<Action> nas;
Array_List<int> ams;
proc debug_step = [&] {
printf("cs:\n ");
for (auto lo : cs) {
print(lo, true);
printf("\n ");
}
printf("\npcs:\n ");
for (auto lo : pcs) {
print(lo, true);
printf("\n ");
}
printf("\nnas:\n ");
for (auto na : nas) {
printf("%s\n ", [&]
{
switch(na) {
case Action::Pop_Environment: return "Pop_Environment";
case Action::Define_Var: return "Define_Var";
case Action::Eval: return "Eval";
case Action::Step: return "Step";
case Action::TM: return "TM";
case Action::Pop: return "Pop";
case Action::If: return "If";
}
}());
}
printf("\nams:\n ");
for (auto am : ams) {
printf("%d\n ", am);
}
pause();
};
proc handle_if = [&] {
/* | | | <test> |
| | -> | <then> |
| <if> | | <else> |
| .... | | ...... | */
--ams.next_index;
Lisp_Object* args = pcs.data[--pcs.next_index];
Lisp_Object* test = args->value.pair.first;
args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Pair);
Lisp_Object* consequence = args->value.pair.first;
args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Pair);
Lisp_Object* alternative = args->value.pair.first;
args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Nil);
--cs.next_index;
cs.append(alternative);
cs.append(consequence);
cs.append(test);
nas.append(Action::Eval);
nas.append(Action::If);
nas.append(Action::Eval);
};
proc handle_define = [&] {
--cs.next_index;
--ams.next_index;
Lisp_Object* form = pcs.data[--pcs.next_index];
Lisp_Object* definee = form->value.pair.first;
form = form->value.pair.rest;
try_void assert_type(form, Lisp_Object_Type::Pair);
Lisp_Object* thing = form->value.pair.first;
Lisp_Object* thing_cons = form;
form = form->value.pair.rest;
Lisp_Object_Type type = Memory::get_type(definee);
switch (type) {
case Lisp_Object_Type::Symbol: {
// BUG(Felix): Defining with doc string crashes
if (form != Memory::nil) {
Lisp_Object* doc = thing;
try_void assert_type(doc, Lisp_Object_Type::String);
try_void assert_type(form, Lisp_Object_Type::Pair);
form = form->value.pair.rest;
thing = form->value.pair.first;
try_void assert(form->value.pair.rest == Memory::nil);
// TODO docs
}
cs.append(definee);
cs.append(thing);
nas.append(Action::Define_Var);
nas.append(Action::Eval);
} break;
case Lisp_Object_Type::Pair: {
fflush(stdout);
try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
Lisp_Object* func;
try_void func = Memory::create_lisp_object_function(Function_Type::Lambda);
func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
func->value.function->body = maybe_wrap_body_in_begin(thing_cons);
define_symbol(definee->value.pair.first, func);
cs.append(Memory::t);
} break;
default: {
create_generic_error("you can only define symbols");
return;
}
}
};
proc handle_begin = [&] {
--cs.next_index;
--ams.next_index;
Lisp_Object* args = pcs[--pcs.next_index];
int length = list_length(args);
cs.reserve(length);
printf("aaaaaa\n\n");
for_lisp_list(args) {
cs.data[cs.next_index - 1 + (length - it_index)] = it;
nas.append(Action::Eval);
nas.append(Action::Pop);
}
--nas.next_index;
cs.next_index += length;
};
cs.append(expr);
nas.append(Action::Eval);
Action current_action;
Lisp_Object* pc;
while (nas.next_index > 0) {
debug_step();
current_action = nas.data[--nas.next_index];
switch (current_action) {
case Action::Pop: {
--cs.next_index;
} break;
case Action::Pop_Environment: {
pop_environment();
} break;
case Action::Eval: {
pc = cs.data[cs.next_index-1];
Lisp_Object_Type type = Memory::get_type(pc);
switch (type) {
case Lisp_Object_Type::Symbol: {
cs.data[cs.next_index-1] = lookup_symbol(pc, get_current_environment());
} break;
case Lisp_Object_Type::Pair: {
cs.data[cs.next_index-1] = pc->value.pair.first;
ams.append(cs.next_index-1);
pcs.append(pc->value.pair.rest);
nas.append(Action::TM);
nas.append(Action::Eval);
} break;
default: {
// NOTE(Felix): others are self evaluating
// so do nothing
}
}
} break;
case Action::TM: {
pc = cs.data[cs.next_index-1];
Lisp_Object_Type type = Memory::get_type(pc);
switch (type) {
case Lisp_Object_Type::CFunction: {
if (pc->value.cFunction->is_special_form) {
if (pc == Memory::_if) try handle_if();
else if (pc == Memory::_begin) try handle_begin();
else if (pc == Memory::_define) try handle_define();
else {
// push_pc_on_cs();
}
} else {
nas.append(Action::Step);
}
} break;
case Lisp_Object_Type::Function: {
if (pc->value.function->type == Function_Type::Macro) {
// push_pc_on_cs();
} else {
nas.append(Action::Step);
}
} break;
default: {
create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(type));
return nullptr;
}
}
} break;
case Action::Step: {
if (pcs.data[pcs.next_index-1] == Memory::nil) {
--pcs.next_index;
int am = ams.data[--ams.next_index];
Lisp_Object* function = cs.data[am];
Lisp_Object_Type type = Memory::get_type(function);
Environment* extended_env =
create_extended_environment_for_function_application_nrc(
cs, function, am+1, cs.next_index-am-1);
cs.next_index = am;
push_environment(extended_env);
if (type == Lisp_Object_Type::CFunction) {
try cs.append(function->value.cFunction->body());
pop_environment();
} else {
nas.append(Action::Pop_Environment);
nas.append(Action::Eval);
cs.append(function->value.function->body);
}
} else {
cs.append(pcs.data[pcs.next_index-1]->value.pair.first);
pcs.data[pcs.next_index-1] = pcs.data[pcs.next_index-1]->value.pair.rest;
nas.append(Action::Step);
nas.append(Action::Eval);
}
} break;
case Action::If: {
/* | <cond> |
| <then> |
| <else> |
| .... | */
cs.next_index -= 2;
// NOTE(Felix): for false it is sufficent to pop 2 for
// true we have to copy the then part to the new top
// of the stack
if (cs.data[cs.next_index+1] != Memory::nil) {
cs.data[cs.next_index-1] = cs.data[cs.next_index];
}
} break;
case Action::Define_Var: {
/* | <thing> |
| <symbol> |
| .... | */
cs.next_index -= 1;
try assert_type(cs.data[cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(cs.data[cs.next_index-1], cs.data[cs.next_index]);
cs.data[cs.next_index-1] = Memory::t;
}
}
}
debug_step();
return cs.data[--cs.next_index];
}
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
profile_this();
@@ -403,14 +918,6 @@ namespace Slime {
};
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());
@@ -471,11 +978,7 @@ namespace Slime {
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;
}
default: return node;
}
}
@@ -506,14 +1009,14 @@ namespace Slime {
Lisp_Object* parsed, * evaluated;
while (true) {
[&] {
delete_error();
// delete_error();
fputs("> ", stdout);
line = read_expression();
defer {
free(line);
};
// defer {
// free(line);
// };
try_void parsed = Parser::parse_single_expression(line);
try_void evaluated = eval_expr(parsed);
try_void evaluated = nrc_eval(parsed);
if (evaluated != Memory::nil) {
print(evaluated);
fputs("\n", stdout);
src/main.cpp
+3 -4
View File
@@ -2,21 +2,20 @@
int main(int argc, char* argv[]) {
if_windows {
#ifdef _MSC_VER
// enable colored terminal output for windows
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
}
#endif
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
return res ? 0 : 1;
}
if (Slime::string_equal(argv[1], "--generate-docs")) {
} else if (Slime::string_equal(argv[1], "--generate-docs")) {
Slime::Memory::init(4096 * 256* 100);
if (Slime::Globals::error) return 1;
Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
src/memory.cpp
+17 -2
View File
@@ -32,8 +32,13 @@ namespace Slime::Memory {
// ------------------
// immutables
// ------------------
Lisp_Object* nil = nullptr;
Lisp_Object* t = nullptr;
Lisp_Object* nil = nullptr;
Lisp_Object* t = nullptr;
Lisp_Object* _if = nullptr;
Lisp_Object* _define = nullptr;
Lisp_Object* _begin = nullptr;
proc print_status() {
// printf("Memory Status:\n"
@@ -136,6 +141,8 @@ namespace Slime::Memory {
environment_memory.for_each([](Environment* env){
env->~Environment();
});
// free the exe dir:
free(Globals::load_path.data[0]);
}
@@ -190,6 +197,10 @@ namespace Slime::Memory {
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
try_void _if = lookup_symbol(get_symbol("if"), env);
try_void _define = lookup_symbol(get_symbol("define"), env);
try_void _begin = lookup_symbol(get_symbol("begin"), env);
}
proc reset() -> void {
@@ -239,6 +250,10 @@ namespace Slime::Memory {
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
try_void _if = lookup_symbol(get_symbol("if"), env);
try_void _define = lookup_symbol(get_symbol("define"), env);
try_void _begin = lookup_symbol(get_symbol("begin"), env);
}
proc create_lisp_object(void* ptr) -> Lisp_Object* {
src/testing.cpp
+5 -3
View File
@@ -603,9 +603,11 @@ namespace Slime {
bool result = true;
try Memory::init(409600);
if_debug {
Slime::Memory::free_everything();
}
defer {
if_debug {
Slime::Memory::free_everything();
}
};
push_environment(Memory::create_child_environment(
get_current_environment()));