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

brefore implementing envi stack

Browse Source
This commit is contained in:
Felix Brendel
2019-07-17 21:17:24 +02:00
parent 02063bf6fb
commit e266667607
8 changed files with 99 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+1 -1
View File
@@ -72,7 +72,7 @@ proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* {
// create new empty environment
Environment* new_env;
try new_env = Memory::create_child_environment(Globals::root_environment);
try new_env = Memory::create_child_environment(get_root_environment());
append_to_array_list(env->parents, new_env);
Environment* old_macro_env = Parser::environment_for_macros;
src/env.cpp
+11 -1
View File
@@ -48,6 +48,16 @@ proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
return nullptr;
}
inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack->data[0];
}
inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack->data[envi_stack->next_index-1];
}
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
Lisp_Object* result = try_lookup_symbol(node, env);
@@ -68,7 +78,7 @@ proc print_indent(int indent) -> void {
}
proc print_environment_indent(Environment* env, int indent) -> void {
if(env == Globals::root_environment) {
if(env == get_root_environment()) {
print_indent(indent);
printf("[built-ins]-Environment (%lld)\n", (long long)env);
return;
src/eval.cpp
+19 -26
View File
@@ -216,7 +216,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
else {
create_parsing_error("A non recognized marker was found "
"in the lambda list: ':%s'",
&arguments->value.pair.first->value.symbol.identifier);
&arguments->value.pair.first->value.symbol.identifier->data);
return;
}
}
@@ -402,7 +402,16 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
}
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
Globals::current_source_code = node;
using namespace Globals::Current_Execution;
append_to_array_list(call_stack, node);
defer {
// NOTE(Felix): We only delete the current entry from the call
// stack, if we did not encounter an error, otherwise we neet
// to preserve the callstack to print it later. it will be
// cleared in log_error().
if (!Globals::error)
--call_stack->next_index;
};
switch (Memory::get_type(node)) {
case Lisp_Object_Type::T:
@@ -414,12 +423,11 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
case Lisp_Object_Type::CFunction:
return node;
case Lisp_Object_Type::Symbol: {
Lisp_Object* symbol;
try symbol = lookup_symbol(node, env);
return symbol;
Lisp_Object* value;
try value = lookup_symbol(node, env);
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)
@@ -482,7 +490,7 @@ proc is_truthy(Lisp_Object* expression, Environment* env) -> bool {
proc interprete_file (char* file_name) -> Lisp_Object* {
Memory::init(4096 * 256, 1024, 4096 * 256);
Environment* root_env = Globals::root_environment;
Environment* root_env = get_root_environment();
Environment* user_env;
try user_env = Memory::create_child_environment(root_env);
Parser::environment_for_macros = user_env;
@@ -494,14 +502,12 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
delete_error();
return nullptr;
}
// print(result);
return result;
}
proc interprete_stdin(bool is_emacs_repl = false) -> void {
proc interprete_stdin() -> void {
Memory::init(4096 * 256, 1024, 4096 * 256);
Environment* root_env = Globals::root_environment;
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
if (Globals::error) {
log_error();
@@ -515,11 +521,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void {
char* line;
if (Globals::error) {
log_error();
delete_error();
}
Lisp_Object* parsed, * evaluated;
while (true) {
printf("> ");
@@ -534,15 +535,7 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void {
continue;
}
evaluated = eval_expr(parsed, user_env);
if (is_emacs_repl) {
if (Globals::error) {
printf("((error \"%s\"))", &Globals::error->message->data);
} else {
printf("((result \"");
print(evaluated);
printf("\"))");
}
} else {
if (Globals::error) {
log_error();
delete_error();
@@ -552,6 +545,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void {
print(evaluated);
printf("\n");
}
}
}
}
src/forward_decls.cpp
+10 -7
View File
@@ -10,9 +10,12 @@ proc is_truthy (Lisp_Object*, Environment*) -> bool;
proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment(Environment*) -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void;
proc print_environment(Environment*) -> void;
// proc get_exe_dir() -> char*;
proc print_environment(Environment*) -> void;
inline proc get_root_environment() -> Environment*;
inline proc get_current_environment() -> Environment*;
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*;
@@ -25,7 +28,6 @@ namespace Memory {
inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type;
}
namespace Parser {
extern Environment* environment_for_macros;
@@ -36,11 +38,12 @@ namespace Parser {
}
namespace Globals {
Environment* root_environment; // contains the built-ins
Log_Level log_level = Log_Level::Debug;
// TODO(Felix): make this the callstack by using a arraylist
// instead
Lisp_Object* current_source_code = nullptr;
namespace Current_Execution {
Lisp_Object_Array_List* call_stack = create_Lisp_Object_array_list();
Environment_Array_List* envi_stack = create_Environment_array_list();
}
Error* error = nullptr;
}
src/io.cpp
+27 -13
View File
@@ -340,9 +340,9 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
putc('(', file);
// NOTE(Felix): We cold do a while true here, however in case
// NOTE(Felix): We cuold do a while true here, however in case
// we want to print a broken list (for logging the error) we
// should do mo checks.
// should do more checks.
while (head) {
print(head->value.pair.first, print_repr, file);
head = head->value.pair.rest;
@@ -363,27 +363,41 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
}
}
proc print_error_location() -> void {
if (Globals::current_source_code) {
printf("%s (line %d, position %d) code:" console_red "\n ",
proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
printf("%s (line %d, position %d)",
Memory::get_c_str(
Globals::current_source_code->sourceCodeLocation->file),
Globals::current_source_code->sourceCodeLocation->line,
Globals::current_source_code->sourceCodeLocation->column);
print(Globals::current_source_code);
obj->sourceCodeLocation->file),
obj->sourceCodeLocation->line,
obj->sourceCodeLocation->column);
} else {
fputs("no source code location avaliable", stdout);
}
}
proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack;
printf("callstack [%d] (most recent call last):\n", call_stack->next_index);
for (int i = 0; i < call_stack->next_index; ++i) {
printf("%2d -> ", i);
print_single_call(call_stack->data[i]);
printf("\n");
}
}
proc log_error() -> void {
fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal);
fputs(" in: " console_cyan, stdout);
print_error_location();
fputs(" in: ", stdout);
print_call_stack();
puts(console_normal);
}
Globals::Current_Execution::call_stack->next_index = 0;
}
src/memory.cpp
+5 -2
View File
@@ -182,8 +182,10 @@ namespace Memory {
try_void t = create_lisp_object();
set_type(t, Lisp_Object_Type::T);
try_void Globals::root_environment = create_built_ins_environment();
try_void Parser::standard_in = create_string("stdin");
try_void Globals::Current_Execution::envi_stack->data[0] = create_built_ins_environment();
try_void Globals::Current_Execution::envi_stack->next_index = 1;
}
proc reset() -> void {
@@ -196,7 +198,8 @@ namespace Memory {
next_index_in_environment_memory = 0;
next_free_spot_in_string_memory = string_memory;
Globals::root_environment = create_built_ins_environment();
try_void Globals::Current_Execution::envi_stack->data[0] = create_built_ins_environment();
try_void Globals::Current_Execution::envi_stack->next_index = 1;
}
proc create_lisp_object_number(double number) -> Lisp_Object* {
src/testing.cpp
+16 -16
View File
@@ -197,7 +197,7 @@ proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string);
int operands_length;
try operands = eval_arguments(operands, Globals::root_environment, &operands_length);
try operands = eval_arguments(operands, get_root_environment(), &operands_length);
assert_no_error();
assert_equal_int(list_length(operands), 4);
@@ -342,7 +342,7 @@ proc test_built_in_add() -> testresult {
char exp_string[] = "(+ 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -357,7 +357,7 @@ proc test_built_in_substract() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -372,7 +372,7 @@ proc test_built_in_multiply() -> testresult {
char exp_string[] = "(* 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -387,7 +387,7 @@ proc test_built_in_divide() -> testresult {
char exp_string[] = "(/ 20 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -402,7 +402,7 @@ proc test_built_in_if() -> testresult {
char exp_string1[] = "(if 1 4 5)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -411,7 +411,7 @@ proc test_built_in_if() -> testresult {
char exp_string2[] = "(if () 4 5)";
expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -425,7 +425,7 @@ proc test_built_in_and() -> testresult {
char exp_string1[] = "(and 1 \"asd\" 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -434,7 +434,7 @@ proc test_built_in_and() -> testresult {
// a false case
char exp_string2[] = "(and () \"asd\" 4)";
expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -447,7 +447,7 @@ proc test_built_in_or() -> testresult {
char exp_string1[] = "(or \"asd\" nil)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -456,7 +456,7 @@ proc test_built_in_or() -> testresult {
// a false case
char exp_string2[] = "(or () ())";
expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -470,7 +470,7 @@ proc test_built_in_not() -> testresult {
char exp_string1[] = "(not ())";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result;
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
// a true case
assert_no_error();
@@ -480,7 +480,7 @@ proc test_built_in_not() -> testresult {
// a false case
char exp_string2[] = "(not \"asd xD\")";
expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Globals::root_environment);
try result = eval_expr(expression, get_root_environment());
assert_no_error();
assert_not_null(result);
@@ -491,7 +491,7 @@ proc test_built_in_not() -> testresult {
proc test_built_in_type() -> testresult {
Environment* env;
try env = Globals::root_environment;
try env = get_root_environment();
// normal type testing
char exp_string1[] = "(begin (define a 10)(type a))";
@@ -539,7 +539,7 @@ proc test_built_in_type() -> testresult {
proc test_singular_t_and_nil() -> testresult {
Environment* env;
try env = Globals::root_environment;
try env = get_root_environment();
// nil testing
char exp_string1[] = "()";
@@ -576,7 +576,7 @@ proc test_file(const char* file) -> testresult {
Memory::reset();
assert_no_error();
Environment* root_env = Globals::root_environment;
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
assert_no_error();