| @@ -46,6 +46,22 @@ 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 = Memory::create_child_environment(Globals::root_environment); | |||||
| Environment* old_macro_env = Parser::environment_for_macros; | |||||
| Parser::environment_for_macros = new_env; | |||||
| Lisp_Object* res = built_in_load(file_name, new_env); | |||||
| Parser::environment_for_macros = old_macro_env; | |||||
| append_to_array_list(env->parents, new_env); | |||||
| return res; | |||||
| } | |||||
| proc load_built_ins_into_environment(Environment* env) -> void { | proc load_built_ins_into_environment(Environment* env) -> void { | ||||
| int arguments_length; | int arguments_length; | ||||
| Lisp_Object* evaluated_arguments; | Lisp_Object* evaluated_arguments; | ||||
| @@ -859,6 +875,17 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| return result; | return result; | ||||
| }); | |||||
| defun("import", cLambda { | |||||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | |||||
| try assert_arguments_length(1, arguments_length); | |||||
| try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); | |||||
| Lisp_Object* result; | |||||
| try result = built_in_import(evaluated_arguments->value.pair.first->value.string, env); | |||||
| return result; | |||||
| }); | }); | ||||
| defun("copy", cLambda { | defun("copy", cLambda { | ||||
| @@ -22,7 +22,7 @@ proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Ob | |||||
| return nullptr; | return nullptr; | ||||
| } | } | ||||
| proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| // first check current environment | // first check current environment | ||||
| String* identifier = node->value.identifier; | String* identifier = node->value.identifier; | ||||
| Lisp_Object* result; | Lisp_Object* result; | ||||
| @@ -30,8 +30,8 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| if (result) | if (result) | ||||
| return result; | return result; | ||||
| if (env->parent) { | |||||
| result = lookup_symbol(node, env->parent); | |||||
| for (int i = 0; i < env->parents->next_index; ++i) { | |||||
| result = try_lookup_symbol(node, env->parents->data[i]); | |||||
| if (result) | if (result) | ||||
| return result; | return result; | ||||
| @@ -44,11 +44,21 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| return Memory::t; | return Memory::t; | ||||
| } | } | ||||
| create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); | |||||
| return nullptr; | |||||
| } | |||||
| proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| Lisp_Object* result = try_lookup_symbol(node, env); | |||||
| if (result) | |||||
| return result; | |||||
| String* identifier = node->value.identifier; | |||||
| create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); | |||||
| return nullptr; | return nullptr; | ||||
| } | } | ||||
| proc print_indent(int indent) -> void { | proc print_indent(int indent) -> void { | ||||
| for (int i = 0; i < indent; ++i) { | for (int i = 0; i < indent; ++i) { | ||||
| printf(" "); | printf(" "); | ||||
| @@ -60,13 +70,13 @@ proc print_environment_indent(Environment* env, int indent) -> void { | |||||
| print_indent(indent); | print_indent(indent); | ||||
| print(env->values[i]); | print(env->values[i]); | ||||
| printf(" %s", env->keys[i]); | printf(" %s", env->keys[i]); | ||||
| printf("\n"); | |||||
| puts(""); | |||||
| } | } | ||||
| if (env->parent) { | |||||
| for (int i = 0; i < env->parents->next_index; ++i) { | |||||
| print_indent(indent); | print_indent(indent); | ||||
| printf("parent"); | |||||
| printf(":\n"); | |||||
| print_environment_indent(env->parent, indent+4); | |||||
| printf("parent (%lld)", (long long)env->parents->data[i]); | |||||
| puts(":"); | |||||
| print_environment_indent(env->parents->data[i], indent+4); | |||||
| } | } | ||||
| } | } | ||||
| @@ -428,28 +428,27 @@ proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { | |||||
| proc interprete_file (char* file_name) -> Lisp_Object* { | proc interprete_file (char* file_name) -> Lisp_Object* { | ||||
| Memory::init(4096 * 256, 4096 * 256); | Memory::init(4096 * 256, 4096 * 256); | ||||
| Environment* env = Memory::create_empty_environment(); | |||||
| Parser::init(env); | |||||
| Environment* root_env = Globals::root_environment; | |||||
| Environment* user_env = Memory::create_child_environment(root_env); | |||||
| Parser::environment_for_macros = user_env; | |||||
| char* file_content; | char* file_content; | ||||
| try file_content = read_entire_file(file_name); | try file_content = read_entire_file(file_name); | ||||
| load_built_ins_into_environment(env); | |||||
| built_in_load(Memory::create_string("pre.slime"), env); | |||||
| built_in_load(Memory::create_string("pre.slime"), root_env); | |||||
| Lisp_Object_Array_List* program; | Lisp_Object_Array_List* program; | ||||
| program = Parser::parse_program(Memory::create_string(file_name), file_content); | program = Parser::parse_program(Memory::create_string(file_name), file_content); | ||||
| Lisp_Object* result = Memory::nil; | Lisp_Object* result = Memory::nil; | ||||
| for (int i = 0; i < program->next_index; ++i) { | for (int i = 0; i < program->next_index; ++i) { | ||||
| result = eval_expr(program->data[i], env); | |||||
| result = eval_expr(program->data[i], user_env); | |||||
| if (Globals::error) { | |||||
| log_error(); | |||||
| delete_error(); | |||||
| return nullptr; | |||||
| } | |||||
| if (Globals::error) { | |||||
| log_error(); | |||||
| delete_error(); | |||||
| return nullptr; | |||||
| } | |||||
| } | } | ||||
| return result; | return result; | ||||
| @@ -457,14 +456,15 @@ proc interprete_file (char* file_name) -> Lisp_Object* { | |||||
| proc interprete_stdin() -> void { | proc interprete_stdin() -> void { | ||||
| Memory::init(4096 * 256, 4096 * 256); | Memory::init(4096 * 256, 4096 * 256); | ||||
| Environment* env = Memory::create_built_ins_environment(); | |||||
| Parser::init(env); | |||||
| Environment* root_env = Globals::root_environment; | |||||
| Environment* user_env = Memory::create_child_environment(root_env); | |||||
| Parser::environment_for_macros = user_env; | |||||
| printf("Welcome to the lispy interpreter.\n"); | printf("Welcome to the lispy interpreter.\n"); | ||||
| char* line; | char* line; | ||||
| built_in_load(Memory::create_string("pre.slime"), env); | |||||
| built_in_import(Memory::create_string("pre.slime"), user_env); | |||||
| if (Globals::error) { | if (Globals::error) { | ||||
| log_error(); | log_error(); | ||||
| @@ -482,7 +482,7 @@ proc interprete_stdin() -> void { | |||||
| delete_error(); | delete_error(); | ||||
| continue; | continue; | ||||
| } | } | ||||
| evaluated = eval_expr(parsed, env); | |||||
| evaluated = eval_expr(parsed, user_env); | |||||
| if (Globals::error) { | if (Globals::error) { | ||||
| log_error(); | log_error(); | ||||
| delete_error(); | delete_error(); | ||||
| @@ -1,5 +1,6 @@ | |||||
| // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void; | // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void; | ||||
| proc built_in_load(String*, Environment*) -> Lisp_Object*; | proc built_in_load(String*, Environment*) -> Lisp_Object*; | ||||
| proc built_in_import(String*, Environment*) -> Lisp_Object*; | |||||
| proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void; | proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void; | ||||
| proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void; | proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void; | ||||
| proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void; | proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void; | ||||
| @@ -14,12 +15,22 @@ proc print_environment(Environment*) -> void; | |||||
| proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; | proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; | ||||
| namespace Memory { | namespace Memory { | ||||
| proc create_built_ins_environment() -> Environment*; | |||||
| proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*; | proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*; | ||||
| inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type; | inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type; | ||||
| } | } | ||||
| namespace Parser { | |||||
| extern String* standard_in; | |||||
| } | |||||
| namespace Globals { | namespace Globals { | ||||
| Environment* root_environment; // contains the built-ins | |||||
| Log_Level log_level = Log_Level::Debug; | Log_Level log_level = Log_Level::Debug; | ||||
| // TODO(Felix): make this the callstack by using a arraylist | |||||
| // instead | |||||
| Lisp_Object* current_source_code = nullptr; | Lisp_Object* current_source_code = nullptr; | ||||
| Error* error = nullptr; | Error* error = nullptr; | ||||
| } | } | ||||
| @@ -1,4 +1,6 @@ | |||||
| proc string_equal(const char input[], const char check[]) -> bool { | proc string_equal(const char input[], const char check[]) -> bool { | ||||
| if (input == check) return true; | |||||
| int i; | int i; | ||||
| for(i = 0; input[i] != '\0' || check[i] != '\0'; i++) { | for(i = 0; input[i] != '\0' || check[i] != '\0'; i++) { | ||||
| if(input[i] != check[i]) { | if(input[i] != check[i]) { | ||||
| @@ -17,6 +19,9 @@ proc string_equal(const char check[], String* str) -> bool { | |||||
| } | } | ||||
| proc string_equal(String* str1, String* str2) -> bool { | proc string_equal(String* str1, String* str2) -> bool { | ||||
| if (str1 == str2) | |||||
| return true; | |||||
| return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2)); | return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2)); | ||||
| } | } | ||||
| @@ -157,6 +157,9 @@ namespace Memory { | |||||
| // init t | // init t | ||||
| try_void t = create_lisp_object(); | try_void t = create_lisp_object(); | ||||
| set_type(t, Lisp_Object_Type::T); | set_type(t, Lisp_Object_Type::T); | ||||
| Globals::root_environment = create_built_ins_environment(); | |||||
| Parser::standard_in = create_string("stdin"); | |||||
| } | } | ||||
| proc reset() -> void { | proc reset() -> void { | ||||
| @@ -164,6 +167,9 @@ namespace Memory { | |||||
| free_spots_in_string_memory->next_index = 0; | free_spots_in_string_memory->next_index = 0; | ||||
| next_index_in_object_memory = 2; // because t and nil are always there | next_index_in_object_memory = 2; // because t and nil are always there | ||||
| next_free_spot_in_string_memory = string_memory; | next_free_spot_in_string_memory = string_memory; | ||||
| Globals::root_environment->next_index = 0; | |||||
| Globals::root_environment->parents->next_index = 0; | |||||
| } | } | ||||
| proc create_lisp_object_number(double number) -> Lisp_Object* { | proc create_lisp_object_number(double number) -> Lisp_Object* { | ||||
| @@ -260,7 +266,11 @@ namespace Memory { | |||||
| int start_capacity = 16; | int start_capacity = 16; | ||||
| env->parent = parent; | |||||
| env->parents = create_Environment_array_list(); | |||||
| if (parent) | |||||
| append_to_array_list(env->parents, parent); | |||||
| env->capacity = start_capacity; | env->capacity = start_capacity; | ||||
| env->next_index = 0; | env->next_index = 0; | ||||
| env->keys = (char**)malloc(start_capacity * sizeof(char*)); | env->keys = (char**)malloc(start_capacity * sizeof(char*)); | ||||
| @@ -10,18 +10,17 @@ namespace Parser { | |||||
| // read-time. This should always be the global environment. | // read-time. This should always be the global environment. | ||||
| Environment* environment_for_macros; | Environment* environment_for_macros; | ||||
| proc init(Environment* env) -> void { | |||||
| // NOTE(Felix): it is important to keep the parser environment | |||||
| // up to date with the global environment. When doing tests, | |||||
| // or running a programm we have to reload it. | |||||
| // NOTE(Felix): For now we just allow executing built-ins at | |||||
| // read-time (while creating macros). If later we want to | |||||
| // change that, we have to define some funcions in this | |||||
| // environment. | |||||
| environment_for_macros = env; | |||||
| standard_in = Memory::create_string("stdin"); | |||||
| } | |||||
| // proc set_environment_for_macros(Environment* env) -> void { | |||||
| // // NOTE(Felix): it is important to keep the parser environment | |||||
| // // up to date with the global environment. When doing tests, | |||||
| // // or running a programm we have to reload it. | |||||
| // // NOTE(Felix): For now we just allow executing built-ins at | |||||
| // // read-time (while creating macros). If later we want to | |||||
| // // change that, we have to define some funcions in this | |||||
| // // environment. | |||||
| // environment_for_macros = env; | |||||
| // } | |||||
| proc inject_scl(Lisp_Object* lo) -> void { | proc inject_scl(Lisp_Object* lo) -> void { | ||||
| lo->sourceCodeLocation = new(Source_Code_Location); | lo->sourceCodeLocation = new(Source_Code_Location); | ||||
| @@ -364,8 +363,9 @@ namespace Parser { | |||||
| } | } | ||||
| // check if we have to create or delete or run macros | // check if we have to create or delete or run macros | ||||
| if (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) { | |||||
| if (string_equal("define-syntax", expression->value.pair.first->value.identifier)) { | |||||
| while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) { | |||||
| Lisp_Object* parsed_symbol = expression->value.pair.first; | |||||
| if (string_equal("define-syntax", parsed_symbol->value.identifier)) { | |||||
| // create a new macro | // create a new macro | ||||
| Lisp_Object* arguments = expression->value.pair.rest; | Lisp_Object* arguments = expression->value.pair.rest; | ||||
| Lisp_Object* body; | Lisp_Object* body; | ||||
| @@ -426,7 +426,7 @@ namespace Parser { | |||||
| // print_environment(environment_for_macros); | // print_environment(environment_for_macros); | ||||
| return Memory::nil; | return Memory::nil; | ||||
| } else if (string_equal("delete-syntax", expression->value.pair.first->value.identifier)) { | |||||
| } else if (string_equal("delete-syntax", parsed_symbol->value.identifier)) { | |||||
| /* --- deleting an existing macro --- */ | /* --- deleting an existing macro --- */ | ||||
| // TODO(Felix): this is a hard one because when | // TODO(Felix): this is a hard one because when | ||||
| // environments will be made from hashmaps, how can we | // environments will be made from hashmaps, how can we | ||||
| @@ -446,20 +446,16 @@ namespace Parser { | |||||
| // if threre is a macro named like this, then macroexpand | // if threre is a macro named like this, then macroexpand | ||||
| // if not it is regular code, dont touch. | // if not it is regular code, dont touch. | ||||
| for (int i = 0; i < environment_for_macros->next_index; ++i) { | |||||
| if (string_equal(expression->value.pair.first->value.identifier, environment_for_macros->keys[i]) && | |||||
| Memory::get_type(environment_for_macros->values[i]) == Lisp_Object_Type::Function && | |||||
| environment_for_macros->values[i]->value.function.type == Function_Type::Macro) | |||||
| { | |||||
| try { | |||||
| expression = eval_expr(expression, environment_for_macros); | |||||
| } | |||||
| } | |||||
| } | |||||
| Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros); | |||||
| if (macro && | |||||
| Memory::get_type(macro) == Lisp_Object_Type::Function && | |||||
| macro->value.function.type == Function_Type::Macro) | |||||
| { | |||||
| try expression = eval_expr(expression, environment_for_macros); | |||||
| } else break; | |||||
| } | } | ||||
| } | } | ||||
| return expression; | return expression; | ||||
| } | } | ||||
| @@ -3,6 +3,7 @@ struct String; | |||||
| struct Environment; | struct Environment; | ||||
| define_array_list(Lisp_Object*, Lisp_Object); | define_array_list(Lisp_Object*, Lisp_Object); | ||||
| define_array_list(Environment*, Environment); | |||||
| define_array_list(String*, String); | define_array_list(String*, String); | ||||
| define_array_list(int, Int); | define_array_list(int, Int); | ||||
| define_array_list(void*, Void_Ptr); | define_array_list(void*, Void_Ptr); | ||||
| @@ -126,7 +127,7 @@ struct Parsed_Arguments { | |||||
| }; | }; | ||||
| struct Environment { | struct Environment { | ||||
| Environment* parent; | |||||
| Environment_Array_List* parents; | |||||
| int capacity; | int capacity; | ||||
| int next_index; | int next_index; | ||||
| @@ -488,7 +488,7 @@ proc test_file(const char* file) -> testresult { | |||||
| Environment* env = Memory::create_built_ins_environment(); | Environment* env = Memory::create_built_ins_environment(); | ||||
| assert_no_error(); | assert_no_error(); | ||||
| Parser::init(env); | |||||
| Parser::environment_for_macros = env; | |||||
| assert_no_error(); | assert_no_error(); | ||||
| built_in_load(Memory::create_string("pre.slime"), env); | built_in_load(Memory::create_string("pre.slime"), env); | ||||
| @@ -502,7 +502,7 @@ proc test_file(const char* file) -> testresult { | |||||
| proc run_all_tests() -> bool { | proc run_all_tests() -> bool { | ||||
| Memory::init(4096 * 2000, 4096 * 16); | Memory::init(4096 * 2000, 4096 * 16); | ||||
| Parser::init(Memory::create_built_ins_environment()); | |||||
| Parser::environment_for_macros = Globals::root_environment; | |||||
| bool result = true; | bool result = true; | ||||
| @@ -1,5 +1,6 @@ | |||||
| * TODO rename slime to plisk | * TODO rename slime to plisk | ||||
| * TODO go through sicp and use the examples as test files | * TODO go through sicp and use the examples as test files | ||||
| * TODO test macro expanding to macro | |||||
| * TODO BUG 1: eval dot notation | * TODO BUG 1: eval dot notation | ||||
| #+BEGIN_SRC lisp | #+BEGIN_SRC lisp | ||||
| (eval `(+ . ,(list 1 2 3))) | (eval `(+ . ,(list 1 2 3))) | ||||