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

everything broke, we'll make cMacros now

Browse Source
This commit is contained in:
fumfar hiwi
2020-01-15 14:28:06 +01:00
parent b83a479533
commit f12994cbfe
11 changed files with 636 additions and 638 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/eval.cpp
+351 -363
View File
@@ -10,22 +10,14 @@ namespace Slime {
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
Arguments* arg_spec;
bool is_c_function = function->value.function->is_c;
Environment* new_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
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;
}
@@ -145,7 +137,8 @@ namespace Slime {
}
// if not set it and then add it to the array list
try_void sym = Memory::get_symbol(next_arg->value.symbol);
Lisp_Object* key = next_arg;
try_void sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_start];
--arg_count;
@@ -157,7 +150,7 @@ namespace Slime {
Memory::copy_lisp_object_except_pairs(next_arg));
}
read_in_keywords.append(next_arg);
read_in_keywords.append(key);
++read_obligatory_keywords_count;
// overstep both for next one
@@ -243,256 +236,257 @@ namespace Slime {
return new_env;
}
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function,
bool should_evaluate) -> Environment*
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
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;
} else {
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (should_evaluate) {
try arguments = eval_arguments(arguments);
}
// proc create_extended_environment_for_function_application(
// Lisp_Object* unevaluated_arguments,
// Lisp_Object* function,
// bool should_evaluate) -> Environment*
// {
// profile_this();
// bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
// Environment* new_env;
// Lisp_Object* arguments = unevaluated_arguments;
// Arguments* arg_spec;
// 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 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 (should_evaluate) {
// 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
// // 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 {
read_in_keywords.dealloc();
};
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;
// Lisp_Object* sym, *val; // used as temp storage to use `try`
// Array_List<Lisp_Object*> read_in_keywords;
// read_in_keywords.alloc();
// defer {
// read_in_keywords.dealloc();
// };
// int obligatory_keywords_count = 0;
// int read_obligatory_keywords_count = 0;
proc read_positional_args = [&]() -> void {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
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...
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));
}
// proc read_positional_args = [&]() -> void {
// for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
// if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
// 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...
// 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;
}
};
// arguments = arguments->value.pair.rest;
// }
// };
proc read_keyword_args = [&]() -> void {
// 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.
// proc read_keyword_args = [&]() -> void {
// // 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 (arguments == Memory::nil)
return;
// if (arguments == Memory::nil)
// 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;
}
// // 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(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 < arg_spec->keyword.values.next_index; ++i) {
if (arguments->value.pair.first == 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.",
&(arguments->value.pair.first->value.symbol->data));
return;
}
// 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 < arg_spec->keyword.values.next_index; ++i) {
// if (arguments->value.pair.first == 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.",
// &(arguments->value.pair.first->value.symbol->data));
// return;
// }
// check if it was already read in
for (int i = 0; i < read_in_keywords.next_index; ++i) {
if (arguments->value.pair.first == 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'",
&(arguments->value.pair.first->value.symbol->data));
return;
}
}
// // check if it was already read in
// for (int i = 0; i < read_in_keywords.next_index; ++i) {
// if (arguments->value.pair.first == 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'",
// &(arguments->value.pair.first->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 (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->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 (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
// create_generic_error(
// "Attempting to set the keyword argument ':%s', but no value was supplied.",
// &(arguments->value.pair.first->value.symbol->data));
// return;
// }
// if not set it and then add it to the array list
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
// NOTE(Felix): It seems we do not need to evaluate the argument here...
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));
}
// // if not set it and then add it to the array list
// try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
// // NOTE(Felix): It seems we do not need to evaluate the argument here...
// 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));
// }
read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count;
// read_in_keywords.append(arguments->value.pair.first);
// ++read_obligatory_keywords_count;
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
// // overstep both for next one
// arguments = arguments->value.pair.rest->value.pair.rest;
if (arguments == Memory::nil) {
break;
}
}
};
// if (arguments == Memory::nil) {
// 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 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 (arguments == Memory::nil) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
} else {
if (arg_spec->rest) {
define_symbol(
arg_spec->rest,
// NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it...
arguments);
} 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;
}
}
};
// proc read_rest_arg = [&]() -> void {
// if (arguments == Memory::nil) {
// if (arg_spec->rest) {
// define_symbol(arg_spec->rest, Memory::nil);
// }
// } else {
// if (arg_spec->rest) {
// define_symbol(
// arg_spec->rest,
// // NOTE(Felix): arguments will be a list, and I THINK
// // we do not need to copy it...
// arguments);
// } 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();
// try read_positional_args();
// try read_keyword_args();
// try check_keyword_args();
// try read_rest_arg();
return new_env;
}
// return new_env;
// }
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this();
Environment* new_env;
Lisp_Object* result;
// proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
// profile_this();
// Environment* new_env;
// Lisp_Object* result;
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env);
defer {
pop_environment();
};
// try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
// push_environment(new_env);
// defer {
// pop_environment();
// };
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else
// if lisp function
try result = eval_expr(function->value.function->body);
// if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// // if c function:
// try result = function->value.cFunction->body();
// else
// // if lisp function
// try result = eval_expr(function->value.function->body);
return result;
}
// return result;
// }
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
/* NOTE This parses the argument specification of funcitons
@@ -500,12 +494,7 @@ namespace Slime {
* 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;
} else {
result = &function->value.function->args;
}
Arguments* result = &function->value.function->args;;
// first init the fields
result->rest = nullptr;
@@ -604,41 +593,41 @@ namespace Slime {
return nullptr;
}
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this();
// int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
// *(out_arguments_length) = 0;
return arguments;
}
// proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
// profile_this();
// // int my_out_arguments_length = 0;
// if (arguments == Memory::nil) {
// // *(out_arguments_length) = 0;
// return arguments;
// }
Lisp_Object* evaluated_arguments;
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
// Lisp_Object* evaluated_arguments;
// try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
Lisp_Object* evaluated_arguments_head = evaluated_arguments;
Lisp_Object* current_head = arguments;
// Lisp_Object* evaluated_arguments_head = evaluated_arguments;
// Lisp_Object* current_head = arguments;
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
// while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
// try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
evaluated_arguments_head->value.pair.first->sourceCodeLocation =
copy_scl(current_head->value.pair.first->sourceCodeLocation);
current_head = current_head->value.pair.rest;
// evaluated_arguments_head->value.pair.first->sourceCodeLocation =
// copy_scl(current_head->value.pair.first->sourceCodeLocation);
// current_head = current_head->value.pair.rest;
if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head == Memory::nil) {
evaluated_arguments_head->value.pair.rest = current_head;
} else {
create_parsing_error("Attempting to evaluate ill formed argument list.");
return nullptr;
}
// ++my_out_arguments_length;
}
// *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
}
// if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
// try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
// evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
// } else if (current_head == Memory::nil) {
// evaluated_arguments_head->value.pair.rest = current_head;
// } else {
// create_parsing_error("Attempting to evaluate ill formed argument list.");
// return nullptr;
// }
// // ++my_out_arguments_length;
// }
// // *(out_arguments_length) = my_out_arguments_length;
// return evaluated_arguments;
// }
proc pause() {
printf("\n-----------------------\n"
@@ -654,6 +643,7 @@ namespace Slime {
}
proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* {
using namespace Globals::Current_Execution;
enum struct Action {
Eval,
Step,
@@ -664,17 +654,12 @@ namespace Slime {
Pop_Environment
};
Array_List<Lisp_Object*> cs;
Array_List<Lisp_Object*> pcs;
Array_List<Action> nas;
Array_List<int> ams;
cs.alloc();
pcs.alloc();
nas.alloc();
ams.alloc();
proc debug_step = [&] {
return;
// printf("%d\n", cs.next_index);
printf("cs:\n ");
for (auto lo : cs) {
print(lo, true);
@@ -705,7 +690,7 @@ namespace Slime {
for (auto am : ams) {
printf("%d\n ", am);
}
pause();
// pause();
};
proc push_pc_on_cs = [&] {
@@ -772,10 +757,10 @@ namespace Slime {
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);
try_void func = Memory::create_lisp_object_function(Lisp_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);
func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
define_symbol(definee->value.pair.first, func);
cs.append(Memory::t);
} break;
@@ -808,7 +793,7 @@ namespace Slime {
Action current_action;
Lisp_Object* pc;
while (nas.next_index > 0) {
// debug_step();
debug_step();
current_action = nas.data[--nas.next_index];
switch (current_action) {
@@ -843,26 +828,29 @@ namespace Slime {
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();
case Lisp_Object_Type::Function: {
if(pc->value.function->is_c) {
if (pc->value.function->type.c_function_type ==
C_Function_Type::cMacro)
{
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();
nas.append(Action::Step);
}
} else {
nas.append(Action::Step);
}
} else {
nas.append(Action::Step);
}
} break;
case Lisp_Object_Type::Function: {
if (pc->value.function->type == Function_Type::Macro) {
push_pc_on_cs();
nas.append(Action::Eval);
nas.append(Action::Step);
} else {
nas.append(Action::Step);
if (pc->value.function->type == Function_Type::Macro) {
push_pc_on_cs();
nas.append(Action::Eval);
nas.append(Action::Step);
} else {
nas.append(Action::Step);
}
}
} break;
default: {
@@ -931,77 +919,77 @@ namespace Slime {
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
return nrc_eval(node);
profile_this();
// profile_this();
using namespace Globals::Current_Execution;
call_stack.append(node);
defer {
--call_stack.next_index;
};
// using namespace Globals::Current_Execution;
// call_stack.append(node);
// defer {
// --call_stack.next_index;
// };
switch (Memory::get_type(node)) {
case Lisp_Object_Type::Symbol: {
Lisp_Object* value;
try value = lookup_symbol(node, get_current_environment());
return value;
}
case Lisp_Object_Type::Pair: {
Lisp_Object* lispOperator;
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{
try lispOperator = eval_expr(node->value.pair.first);
} else {
lispOperator = node->value.pair.first;
}
// switch (Memory::get_type(node)) {
// case Lisp_Object_Type::Symbol: {
// Lisp_Object* value;
// try value = lookup_symbol(node, get_current_environment());
// return value;
// }
// case Lisp_Object_Type::Pair: {
// Lisp_Object* lispOperator;
// if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
// Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
// {
// try lispOperator = eval_expr(node->value.pair.first);
// } else {
// lispOperator = node->value.pair.first;
// }
Lisp_Object* arguments = node->value.pair.rest;
// check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
!lispOperator->value.cFunction->is_special_form);
return result;
}
// Lisp_Object* arguments = node->value.pair.rest;
// // check for c function
// if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
// Lisp_Object* result;
// try result = apply_arguments_to_function(
// arguments,
// lispOperator,
// !lispOperator->value.cFunction->is_special_form);
// return result;
// }
// check for lisp function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before
// apllying, for the other types, special-lambda and macro
// we do not need.
// // check for lisp function
// if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// // only for lambdas we evaluate the arguments before
// // apllying, for the other types, special-lambda and macro
// // we do not need.
Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
lispOperator->value.function->type == Function_Type::Lambda);
// Lisp_Object* result;
// try result = apply_arguments_to_function(
// arguments,
// lispOperator,
// lispOperator->value.function->type == Function_Type::Lambda);
// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
// (because at read time, they are not imported yet, this
// is done at runtime...). That is why we sometimes have
// stray macros fying around, in that case, we expand them
// 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 = *Memory::copy_lisp_object(result);
result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// eval again because macro
try result = eval_expr(result);
}
// // NOTE(Felix): The parser does not understnad (import ..)
// // so it cannot expand imported macros at read time
// // (because at read time, they are not imported yet, this
// // is done at runtime...). That is why we sometimes have
// // stray macros fying around, in that case, we expand them
// // 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 = *Memory::copy_lisp_object(result);
// result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// // eval again because macro
// try result = eval_expr(result);
// }
return result;
}
// return result;
// }
create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
return nullptr;
}
default: return node;
}
// create_generic_error("The first element of the pair was not a function but: %s",
// Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
// return nullptr;
// }
// default: return node;
// }
}
proc is_truthy(Lisp_Object* expression) -> bool {
src/gc.cpp
+3 -1
View File
@@ -47,7 +47,9 @@ namespace Slime::GC {
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function->parent_environment);
maybe_mark(node->value.function->body);
if (!node->value.function->is_c) {
maybe_mark(node->value.function->body.lisp_body);
}
// mark the default arguemnt values:
for (auto it : node->value.function->args.keyword.values) {
if (it)
src/globals.cpp
+4 -1
View File
@@ -4,7 +4,10 @@ namespace Slime::Globals {
Array_List<void*> load_path;
namespace Current_Execution {
Array_List<Lisp_Object*> call_stack;
Array_List<Lisp_Object*> cs;
Array_List<Lisp_Object*> pcs;
Array_List<int> ams;
// Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
}
src/io.cpp
+14 -9
View File
@@ -315,7 +315,6 @@ namespace Slime {
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) {
@@ -352,14 +351,20 @@ namespace Slime {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break;
}
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function->type == Function_Type::Special_Lambda)
// fputs("[special-lambda]", file);
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
if (node->value.function->is_c) {
switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: {fputs("[c-function]", file);} break;
case C_Function_Type::cSpecial: {fputs("[c-special]", file);} break;
case C_Function_Type::cMacro: {fputs("[c-macro]", file);} break;
default: {fputs("[c-??]", file);}
}
} else {
switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: {fputs("[lambda]", file);} break;
case Lisp_Function_Type::Macro: {fputs("[macro]", file);} break;
default: {fputs("[??]", file);}
}
}
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;
src/libslime.cpp
-1
View File
@@ -76,7 +76,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) {
switch (Memory::get_type(obj)) {
// hash from adress: if two objects of these types have
// different addresses, they are different
case Lisp_Object_Type::CFunction:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword:
src/lisp_object.cpp
-7
View File
@@ -19,7 +19,6 @@ namespace Slime {
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::CFunction): return "C-function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
@@ -37,12 +36,6 @@ namespace Slime {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.dealloc();
this->value.cFunction->args.keyword.keywords.dealloc();
this->value.cFunction->args.keyword.values.dealloc();
free(this->value.cFunction);
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.dealloc();
this->value.function->args.keyword.keywords.dealloc();
src/memory.cpp
+14 -12
View File
@@ -176,8 +176,11 @@ namespace Slime::Memory {
char* exe_path = get_exe_dir();
// don't free exe path because it will be used until end of time
Globals::load_path.alloc();
Globals::Current_Execution::call_stack.alloc();
// Globals::Current_Execution::call_stack.alloc();
Globals::Current_Execution::envi_stack.alloc();
Globals::Current_Execution::cs.alloc();
Globals::Current_Execution::pcs.alloc();
Globals::Current_Execution::ams.alloc();
add_to_load_path(exe_path);
add_to_load_path("../bin/");
@@ -424,19 +427,19 @@ namespace Slime::Memory {
}
}
proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* {
proc create_lisp_object_cfunction(C_Function_Type type) -> Lisp_Object* {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::CFunction);
node->value.cFunction = (cFunction*)malloc(sizeof(cFunction));
node->value.cFunction->args.keyword.keywords.alloc();
node->value.cFunction->args.keyword.values.alloc();
node->value.cFunction->args.positional.symbols.alloc();
node->value.cFunction->is_special_form = is_special;
set_type(node, Lisp_Object_Type::Function);
node->value.function = (Function*)malloc(sizeof(Function));
node->value.function->type.c_function_type = type;
node->value.function->args.keyword.keywords.alloc();
node->value.function->args.keyword.values.alloc();
node->value.function->args.positional.symbols.alloc();
return node;
}
proc create_lisp_object_function(Function_Type ft) -> Lisp_Object* {
proc create_lisp_object_function(Lisp_Function_Type ft) -> Lisp_Object* {
Lisp_Object* func;
try func = Memory::create_lisp_object();
Memory::set_type(func, Lisp_Object_Type::Function);
@@ -444,7 +447,7 @@ namespace Slime::Memory {
func->value.function->args.keyword.keywords.alloc();
func->value.function->args.keyword.values.alloc();
func->value.function->args.positional.symbols.alloc();
func->value.function->type = ft;
func->value.function->type.lisp_function_type = ft;
return func;
}
@@ -465,8 +468,7 @@ namespace Slime::Memory {
if (n == Memory::nil || n == Memory::t ||
Memory::get_type(n) == Lisp_Object_Type::Symbol ||
Memory::get_type(n) == Lisp_Object_Type::Keyword ||
Memory::get_type(n) == Lisp_Object_Type::Function ||
Memory::get_type(n) == Lisp_Object_Type::CFunction)
Memory::get_type(n) == Lisp_Object_Type::Function)
{
return n;
}
src/structs.cpp
+21 -14
View File
@@ -22,7 +22,6 @@ namespace Slime {
HashMap,
// OwningPointer,
Function,
CFunction,
};
enum class Lisp_Object_Flags
@@ -32,9 +31,17 @@ namespace Slime {
Under_Construction = 1 << 6,
};
enum struct Function_Type {
Lambda,
Macro
enum struct Lisp_Function_Type {
Lambda, // normal evaluation order
Macro // args are not evaluated, a new programm is returned
// that will be executed again
};
enum struct C_Function_Type {
cFunction, // normal evaluation order
cSpecial, // args are not evaluated, but result is returned
// as you would expect
cMacro // No return value, but the current_execution is
// modified
};
enum struct Log_Level {
@@ -101,16 +108,17 @@ namespace Slime {
};
struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};
struct cFunction {
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
Environment* parent_environment;
bool is_c;
union {
Lisp_Function_Type lisp_function_type;
C_Function_Type c_function_type;
} type;
union {
Lisp_Object* lisp_body;
Lisp_Object* (*c_body)();
} body;
};
struct Lisp_Object {
@@ -125,7 +133,6 @@ namespace Slime {
Pair pair;
Vector vector;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
src/testing.cpp
+35 -35
View File
@@ -623,49 +623,49 @@ namespace Slime {
}
};
push_environment(Memory::create_child_environment(
get_current_environment()));
printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching);
// push_environment(Memory::create_child_environment(
// get_current_environment()));
// printf("-- Util --\n");
// invoke_test(test_array_lists_adding_and_removing);
// invoke_test(test_array_lists_sorting);
// invoke_test(test_array_lists_searching);
printf("\n -- Parsing --\n");
invoke_test(test_parse_atom);
invoke_test(test_parse_expression);
// printf("\n -- Parsing --\n");
// invoke_test(test_parse_atom);
// invoke_test(test_parse_expression);
printf("\n-- Basic evaluating --\n");
invoke_test(test_eval_operands);
// printf("\n-- Basic evaluating --\n");
// invoke_test(test_eval_operands);
printf("\n-- Built ins --\n");
invoke_test(test_built_in_add);
invoke_test(test_built_in_substract);
invoke_test(test_built_in_multiply);
invoke_test(test_built_in_divide);
invoke_test(test_built_in_if);
invoke_test(test_built_in_and);
invoke_test(test_built_in_or);
invoke_test(test_built_in_not);
invoke_test(test_built_in_type);
// printf("\n-- Built ins --\n");
// invoke_test(test_built_in_add);
// invoke_test(test_built_in_substract);
// invoke_test(test_built_in_multiply);
// invoke_test(test_built_in_divide);
// invoke_test(test_built_in_if);
// invoke_test(test_built_in_and);
// invoke_test(test_built_in_or);
// invoke_test(test_built_in_not);
// invoke_test(test_built_in_type);
printf("\n-- Memory management --\n");
invoke_test(test_singular_t_and_nil);
invoke_test(test_singular_symbols);
// printf("\n-- Memory management --\n");
// invoke_test(test_singular_t_and_nil);
// invoke_test(test_singular_symbols);
pop_environment();
// pop_environment();
printf("\n-- Test Files --\n");
invoke_test_script("evaluation_of_default_args");
invoke_test_script("alists");
invoke_test_script("case_and_cond");
invoke_test_script("lexical_scope");
invoke_test_script("class_macro");
invoke_test_script("import_and_load");
invoke_test_script("macro_expand");
invoke_test_script("automata");
// invoke_test_script("evaluation_of_default_args");
// invoke_test_script("alists");
// invoke_test_script("case_and_cond");
// invoke_test_script("lexical_scope");
// invoke_test_script("class_macro");
// invoke_test_script("import_and_load");
// invoke_test_script("macro_expand");
// invoke_test_script("automata");
invoke_test_script("sicp");
invoke_test_script("hashmaps");
invoke_test_script("singular_imports");
// invoke_test_script("hashmaps");
// invoke_test_script("singular_imports");
return result;
}