more steps towards that

This commit is contained in:
Felix Brendel
2020-01-21 09:34:41 +01:00
parent f12994cbfe
commit 79ef622eec
8 changed files with 73 additions and 101 deletions
Regular → Executable
View File
+25 -24
View File
@@ -12,7 +12,6 @@ namespace Slime {
case Lisp_Object_Type::Nil: case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::CFunction:
case Lisp_Object_Type::Function: case Lisp_Object_Type::Function:
// TODO(Felix): should a pointer // TODO(Felix): should a pointer
// object compare the pointer? // object compare the pointer?
@@ -347,7 +346,7 @@ namespace Slime {
// creating new lisp object and setting type // creating new lisp object and setting type
Lisp_Object* func; Lisp_Object* func;
try func = Memory::create_lisp_object_function(Function_Type::Macro); try func = Memory::create_lisp_object_function(Lisp_Function_Type::Macro);
// Lisp_Object* func; // Lisp_Object* func;
// try func = Memory::create_lisp_object(); // try func = Memory::create_lisp_object();
@@ -359,7 +358,7 @@ namespace Slime {
// setting parent env // setting parent env
func->value.function->parent_environment = get_current_environment(); func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(lambdalist, func); create_arguments_from_lambda_list_and_inject(lambdalist, func);
func->value.function->body = maybe_wrap_body_in_begin(body); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
define_symbol(symbol, func); define_symbol(symbol, func);
} }
return Memory::nil; return Memory::nil;
@@ -398,7 +397,7 @@ namespace Slime {
// creating new lisp object and setting type // creating new lisp object and setting type
Lisp_Object* func; Lisp_Object* func;
try func = Memory::create_lisp_object_function(Function_Type::Lambda); try func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
if (doc) if (doc)
func->docstring = doc->value.string; func->docstring = doc->value.string;
@@ -407,7 +406,7 @@ namespace Slime {
// setting parent env // setting parent env
func->value.function->parent_environment = get_current_environment(); func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(lambdalist, func); create_arguments_from_lambda_list_and_inject(lambdalist, func);
func->value.function->body = maybe_wrap_body_in_begin(body); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
define_symbol(symbol, func); define_symbol(symbol, func);
} }
@@ -705,14 +704,14 @@ namespace Slime {
// creating new lisp object and setting type // creating new lisp object and setting type
Lisp_Object* func; Lisp_Object* func;
try func = Memory::create_lisp_object_function(Function_Type::Lambda); try func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
in_caller_env { in_caller_env {
func->value.function->parent_environment = get_current_environment(); func->value.function->parent_environment = get_current_environment();
} }
try create_arguments_from_lambda_list_and_inject(args, func); try create_arguments_from_lambda_list_and_inject(args, func);
func->value.function->body = maybe_wrap_body_in_begin(body); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
return func; return func;
}; };
define((apply fun args), "TODO") { define((apply fun args), "TODO") {
@@ -846,16 +845,22 @@ namespace Slime {
switch (type) { switch (type) {
case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation"); case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation");
case Lisp_Object_Type::CFunction: return Memory::get_keyword("cfunction");
case Lisp_Object_Type::Function: { case Lisp_Object_Type::Function: {
Function* fun = n->value.function; Function* fun = n->value.function;
if (fun->type == Function_Type::Lambda) if (fun->is_c) {
return Memory::get_keyword("lambda"); switch (fun->type.c_function_type) {
// else if (fun->type == Function_Type::Special_Lambda) case C_Function_Type::cMacro: return Memory::get_keyword("cMacro");
// return Memory::get_keyword("special-lambda"); case C_Function_Type::cFunction: return Memory::get_keyword("cFunction");
else if (fun->type == Function_Type::Macro) case C_Function_Type::cSpecial: return Memory::get_keyword("cSpecial");
return Memory::get_keyword("macro"); default: return Memory::get_keyword("c??");
else return Memory::get_keyword("unknown"); }
} else {
switch (fun->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: return Memory::get_keyword("lambda");
case Lisp_Function_Type::Macro: return Memory::get_keyword("macro");
default: return Memory::get_keyword("??");
}
}
} }
case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap"); case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap");
case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword"); case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword");
@@ -903,14 +908,10 @@ namespace Slime {
? Memory::get_c_str(val->docstring) ? Memory::get_c_str(val->docstring)
: "No docs avaliable"); : "No docs avaliable");
if (Memory::get_type(val) == Lisp_Object_Type::Function || if (Memory::get_type(val) == Lisp_Object_Type::Function)
Memory::get_type(val) == Lisp_Object_Type::CFunction)
{ {
Arguments* args; Arguments* args = &val->value.function->args;
if (Memory::get_type(val) == Lisp_Object_Type::Function)
args = &val->value.function->args;
else
args = &val->value.cFunction->args;
printf("Arguments:\n==========\n"); printf("Arguments:\n==========\n");
printf("Postitional: {"); printf("Postitional: {");
@@ -956,9 +957,9 @@ namespace Slime {
profile_with_name("(show)"); profile_with_name("(show)");
fetch(n); fetch(n);
try assert_type(n, Lisp_Object_Type::Function); try assert_type(n, Lisp_Object_Type::Function);
try assert(n->value.function->is_c);
puts("body:\n"); puts("body:\n");
print(n->value.function->body); print(n->value.function->body.lisp_body);
puts("\n"); puts("\n");
printf("parent_env: %lld\n", printf("parent_env: %lld\n",
(long long)n->value.function->parent_environment); (long long)n->value.function->parent_environment);
+7 -5
View File
@@ -108,7 +108,7 @@
// mutable for the parser to work, because the parser relys on being // mutable for the parser to work, because the parser relys on being
// able to temporaily put in markers in the code and also it will fill // able to temporaily put in markers in the code and also it will fill
// out the source code location // out the source code location
#define _define_helper(def, docs, special) \ #define _define_helper(def, docs, type) \
Parser::parser_file = file_name_built_ins; \ Parser::parser_file = file_name_built_ins; \
Parser::parser_line = __LINE__; \ Parser::parser_line = __LINE__; \
Parser::parser_col = 0; \ Parser::parser_col = 0; \
@@ -118,15 +118,17 @@
assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \
assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \
auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \ auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \ auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(type); \
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
if_error_log_location_and_return(nullptr); \ if_error_log_location_and_return(nullptr); \
label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ label(sfun,__LINE__)->docstring = Memory::create_string(docs); \
label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object* label(sfun,__LINE__)->value.function->body.c_body = []() -> Lisp_Object*
#define define(def, docs) _define_helper(def, docs, false) #define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction)
#define define_special(def, docs) _define_helper(def, docs, true) #define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro)
#define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial)
#define in_caller_env fluid_let( \ #define in_caller_env fluid_let( \
Globals::Current_Execution::envi_stack.next_index, \ Globals::Current_Execution::envi_stack.next_index, \
Globals::Current_Execution::envi_stack.next_index-1) Globals::Current_Execution::envi_stack.next_index-1)
+2 -6
View File
@@ -83,13 +83,9 @@ namespace Slime {
/* /*
* if function then print arguments * if function then print arguments
*/ */
if (type == Lisp_Object_Type::Function || if (type == Lisp_Object_Type::Function)
type == Lisp_Object_Type::CFunction)
{ {
Arguments* args = Arguments* args = &value->value.function->args;
(type == Lisp_Object_Type::Function)
? &value->value.function->args
: &value->value.cFunction->args;
fprintf(f, "\n - arguments :: "); fprintf(f, "\n - arguments :: ");
// if no args at all // if no args at all
if (args->positional.symbols.next_index == 0 && if (args->positional.symbols.next_index == 0 &&
+25 -22
View File
@@ -466,27 +466,28 @@ namespace Slime {
// return new_env; // return new_env;
// } // }
// proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
// profile_this(); // profile_this();
// Environment* new_env; // Environment* new_env;
// Lisp_Object* result; // Lisp_Object* result;
// try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args); // try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
// push_environment(new_env); // push_environment(new_env);
// defer { // defer {
// pop_environment(); // pop_environment();
// }; // };
// if (Memory::get_type(function) == Lisp_Object_Type::CFunction) // if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// // if c function: // // if c function:
// try result = function->value.cFunction->body(); // try result = function->value.cFunction->body();
// else // else
// // if lisp function // // if lisp function
// try result = eval_expr(function->value.function->body); // try result = eval_expr(function->value.function->body);
// return result; // return result;
// } return nullptr;
}
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
/* NOTE This parses the argument specification of funcitons /* NOTE This parses the argument specification of funcitons
@@ -844,7 +845,9 @@ namespace Slime {
nas.append(Action::Step); nas.append(Action::Step);
} }
} else { } else {
if (pc->value.function->type == Function_Type::Macro) { if (pc->value.function->type.lisp_function_type ==
Lisp_Function_Type::Macro)
{
push_pc_on_cs(); push_pc_on_cs();
nas.append(Action::Eval); nas.append(Action::Eval);
nas.append(Action::Step); nas.append(Action::Step);
@@ -866,19 +869,19 @@ namespace Slime {
--pcs.next_index; --pcs.next_index;
int am = ams.data[--ams.next_index]; int am = ams.data[--ams.next_index];
Lisp_Object* function = cs.data[am]; Lisp_Object* function = cs.data[am];
Lisp_Object_Type type = Memory::get_type(function); assert_type(function, Lisp_Object_Type::Function);
Environment* extended_env = Environment* extended_env =
create_extended_environment_for_function_application_nrc( create_extended_environment_for_function_application_nrc(
&cs, function, am+1, cs.next_index-am-1); &cs, function, am+1, cs.next_index-am-1);
cs.next_index = am; cs.next_index = am;
push_environment(extended_env); push_environment(extended_env);
if (type == Lisp_Object_Type::CFunction) { if (function->value.function->is_c) {
try cs.append(function->value.cFunction->body()); try cs.append(function->value.function->body.c_body());
pop_environment(); pop_environment();
} else { } else {
nas.append(Action::Pop_Environment); nas.append(Action::Pop_Environment);
nas.append(Action::Eval); nas.append(Action::Eval);
cs.append(function->value.function->body); cs.append(function->value.function->body.lisp_body);
} }
} else { } else {
cs.append(pcs.data[pcs.next_index-1]->value.pair.first); cs.append(pcs.data[pcs.next_index-1]->value.pair.first);
+8 -7
View File
@@ -445,14 +445,15 @@ namespace Slime {
} }
proc print_call_stack() -> void { proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack; printf("call stack cannot be printed.");
// using Globals::Current_Execution::call_stack;
printf("callstack [%d] (most recent call last):\n", call_stack.next_index); // printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
for (int i = 0; i < call_stack.next_index; ++i) { // for (int i = 0; i < call_stack.next_index; ++i) {
printf("%2d -> ", i); // printf("%2d -> ", i);
print_single_call(call_stack.data[i]); // print_single_call(call_stack.data[i]);
printf("\n"); // printf("\n");
} // }
} }
proc log_error() -> void { proc log_error() -> void {
+6 -2
View File
@@ -145,9 +145,11 @@ namespace Slime::Memory {
// free the exe dir: // free the exe dir:
free(Globals::load_path.data[0]); free(Globals::load_path.data[0]);
Globals::load_path.dealloc(); Globals::load_path.dealloc();
Globals::Current_Execution::call_stack.dealloc(); // Globals::Current_Execution::call_stack.dealloc();
Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution::envi_stack.dealloc();
Globals::Current_Execution::cs.dealloc();
Globals::Current_Execution::ams.dealloc();
Globals::Current_Execution::pcs.dealloc();
} }
@@ -436,6 +438,7 @@ namespace Slime::Memory {
node->value.function->args.keyword.keywords.alloc(); node->value.function->args.keyword.keywords.alloc();
node->value.function->args.keyword.values.alloc(); node->value.function->args.keyword.values.alloc();
node->value.function->args.positional.symbols.alloc(); node->value.function->args.positional.symbols.alloc();
node->value.function->is_c = true;
return node; return node;
} }
@@ -448,6 +451,7 @@ namespace Slime::Memory {
func->value.function->args.keyword.values.alloc(); func->value.function->args.keyword.values.alloc();
func->value.function->args.positional.symbols.alloc(); func->value.function->args.positional.symbols.alloc();
func->value.function->type.lisp_function_type = ft; func->value.function->type.lisp_function_type = ft;
func->value.function->is_c = false;
return func; return func;
} }
-35
View File
@@ -208,38 +208,6 @@ namespace Slime {
return pass; return pass;
} }
proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string);
try operands = eval_arguments(operands);
assert_no_error();
assert_equal_int(list_length(operands), 4);
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number);
assert_equal_double(operands->value.pair.first->value.number, 1);
operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number);
assert_equal_double(operands->value.pair.first->value.number, 3);
operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::String);
assert_equal_string(operands->value.pair.first->value.string, "okay");
operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword);
assert_equal_string(operands->value.pair.first->value.symbol, "haha");
return pass;
}
proc test_parse_atom() -> testresult { proc test_parse_atom() -> testresult {
int index_in_text = 0; int index_in_text = 0;
char string[] = char string[] =
@@ -634,9 +602,6 @@ namespace Slime {
// invoke_test(test_parse_atom); // invoke_test(test_parse_atom);
// invoke_test(test_parse_expression); // invoke_test(test_parse_expression);
// printf("\n-- Basic evaluating --\n");
// invoke_test(test_eval_operands);
// printf("\n-- Built ins --\n"); // printf("\n-- Built ins --\n");
// invoke_test(test_built_in_add); // invoke_test(test_built_in_add);
// invoke_test(test_built_in_substract); // invoke_test(test_built_in_substract);