importing and macros can expand to macros

src/built_ins.cpp

@@ -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 {
     int arguments_length;
     Lisp_Object* evaluated_arguments;
@@ -859,6 +875,17 @@ proc load_built_ins_into_environment(Environment* env) -> void {
 
             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 {
 

src/env.cpp

@@ -22,7 +22,7 @@ proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Ob
     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
     String* identifier = node->value.identifier;
     Lisp_Object* result;
@@ -30,8 +30,8 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
     if (result)
         return result;
 
-    if (env->parent) {
+    for (int i = 0; i < env->parents->next_index; ++i) {
-        result = lookup_symbol(node, env->parent);
+        result = try_lookup_symbol(node, env->parents->data[i]);
 
         if (result)
             return result;
@@ -44,11 +44,21 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
         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;
+}
+
+
 proc print_indent(int indent) -> void {
     for (int i = 0; i < indent; ++i) {
         printf(" ");
@@ -60,13 +70,13 @@ proc print_environment_indent(Environment* env, int indent) -> void {
         print_indent(indent);
         print(env->values[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);
-        printf("parent");
+        printf("parent (%lld)", (long long)env->parents->data[i]);
-        printf(":\n");
+        puts(":");
-        print_environment_indent(env->parent, indent+4);
+        print_environment_indent(env->parents->data[i], indent+4);
     }
 }
 

src/eval.cpp

@@ -428,28 +428,27 @@ proc is_truthy(Lisp_Object* expression, Environment* env) -> bool {
 
 proc interprete_file (char* file_name) -> Lisp_Object* {
     Memory::init(4096 * 256, 4096 * 256);
-    Environment* env = Memory::create_empty_environment();
+    Environment* root_env = Globals::root_environment;
-    Parser::init(env);
+    Environment* user_env = Memory::create_child_environment(root_env);
+    Parser::environment_for_macros = user_env;
 
     char* file_content;
     try file_content = read_entire_file(file_name);
 
-    load_built_ins_into_environment(env);
+    built_in_load(Memory::create_string("pre.slime"), root_env);
-
-    built_in_load(Memory::create_string("pre.slime"), env);
 
     Lisp_Object_Array_List* program;
     program = Parser::parse_program(Memory::create_string(file_name), file_content);
 
     Lisp_Object* result = Memory::nil;
     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) {
+        if (Globals::error) {
-			log_error();
+            log_error();
-			delete_error();
+            delete_error();
-			return nullptr;
+            return nullptr;
-		}
+        }
     }
 
     return result;
@@ -457,14 +456,15 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
 
 proc interprete_stdin() -> void {
     Memory::init(4096 * 256, 4096 * 256);
-    Environment* env = Memory::create_built_ins_environment();
+    Environment* root_env = Globals::root_environment;
-    Parser::init(env);
+    Environment* user_env = Memory::create_child_environment(root_env);
+    Parser::environment_for_macros = user_env;
 
     printf("Welcome to the lispy interpreter.\n");
 
     char* line;
 
-    built_in_load(Memory::create_string("pre.slime"), env);
+    built_in_import(Memory::create_string("pre.slime"), user_env);
 
     if (Globals::error) {
         log_error();
@@ -482,7 +482,7 @@ proc interprete_stdin() -> void {
             delete_error();
             continue;
         }
-        evaluated = eval_expr(parsed, env);
+        evaluated = eval_expr(parsed, user_env);
         if (Globals::error) {
             log_error();
             delete_error();

src/forward_decls.cpp

@@ -1,5 +1,6 @@
 // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void;
 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, const char* format, ...) -> 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*;
 
 namespace Memory {
+    proc create_built_ins_environment() -> Environment*;
     proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*;
     inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type;
 }
 
+
+namespace Parser {
+    extern String* standard_in;
+}
+
 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;
     Error* error = nullptr;
 }

src/io.cpp

@@ -1,4 +1,6 @@
 proc string_equal(const char input[], const char check[]) -> bool {
+    if (input == check) return true;
+
     int i;
     for(i = 0; input[i] != '\0' || check[i] != '\0'; 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 {
+    if (str1 == str2)
+        return true;
+    
     return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
 }
 

src/memory.cpp

@@ -157,6 +157,9 @@ namespace Memory {
         // init t
         try_void t = create_lisp_object();
         set_type(t, Lisp_Object_Type::T);
+
+        Globals::root_environment = create_built_ins_environment();
+        Parser::standard_in = create_string("stdin");
     }
 
     proc reset() -> void {
@@ -164,6 +167,9 @@ namespace Memory {
         free_spots_in_string_memory->next_index = 0;
         next_index_in_object_memory = 2; // because t and nil are always there
         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* {
@@ -260,7 +266,11 @@ namespace Memory {
 
         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->next_index = 0;
         env->keys       =        (char**)malloc(start_capacity * sizeof(char*));

src/parse.cpp

@@ -10,18 +10,17 @@ namespace Parser {
     // read-time. This should always be the global environment.
     Environment* environment_for_macros;
 
-    proc init(Environment* env) -> void {
+    // proc set_environment_for_macros(Environment* env) -> void {
-        // NOTE(Felix): it is important to keep the parser environment
+    //     // NOTE(Felix): it is important to keep the parser environment
-        // up to date with the global environment. When doing tests,
+    //     // up to date with the global environment. When doing tests,
-        // or running a programm we have to reload it.
+    //     // or running a programm we have to reload it.
 
-        // NOTE(Felix): For now we just allow executing built-ins at
+    //     // NOTE(Felix): For now we just allow executing built-ins at
-        // read-time (while creating macros). If later we want to
+    //     // read-time (while creating macros). If later we want to
-        // change that, we have to define some funcions in this
+    //     // change that, we have to define some funcions in this
-        // environment.
+    //     // environment.
-        environment_for_macros = env;
+    //     environment_for_macros = env;
-        standard_in = Memory::create_string("stdin");
+    // }
-    }
 
     proc inject_scl(Lisp_Object* lo) -> void {
         lo->sourceCodeLocation = new(Source_Code_Location);
@@ -364,8 +363,9 @@ namespace Parser {
         }
 
         // check if we have to create or delete or run macros
-        if (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
+        while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
-            if (string_equal("define-syntax", expression->value.pair.first->value.identifier)) {
+            Lisp_Object* parsed_symbol = expression->value.pair.first;
+            if (string_equal("define-syntax", parsed_symbol->value.identifier)) {
                 // create a new macro
                 Lisp_Object* arguments = expression->value.pair.rest;
                 Lisp_Object* body;
@@ -426,7 +426,7 @@ namespace Parser {
                 // print_environment(environment_for_macros);
                 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 --- */
                 // TODO(Felix): this is a hard one because when
                 // 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 not it is regular code, dont touch.
 
-                for (int i = 0; i < environment_for_macros->next_index; ++i) {
+                Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros);
-                    if (string_equal(expression->value.pair.first->value.identifier, environment_for_macros->keys[i]) &&
+                if (macro &&
-                        Memory::get_type(environment_for_macros->values[i]) == Lisp_Object_Type::Function &&
+                    Memory::get_type(macro) == Lisp_Object_Type::Function &&
-                        environment_for_macros->values[i]->value.function.type == Function_Type::Macro)
+                    macro->value.function.type == Function_Type::Macro)
-                    {
+                {
-                        try {
+                    try expression = eval_expr(expression, environment_for_macros);
-                            expression = eval_expr(expression, environment_for_macros);
+                } else break;
-                        }
-                    }
-                }
             }
         }
 
-
         return expression;
     }
 

src/structs.cpp

@@ -3,6 +3,7 @@ struct String;
 struct Environment;
 
 define_array_list(Lisp_Object*, Lisp_Object);
+define_array_list(Environment*, Environment);
 define_array_list(String*, String);
 define_array_list(int, Int);
 define_array_list(void*, Void_Ptr);
@@ -126,7 +127,7 @@ struct Parsed_Arguments {
 };
 
 struct Environment {
-    Environment* parent;
+    Environment_Array_List* parents;
 
     int       capacity;
     int       next_index;

src/testing.cpp

@@ -488,7 +488,7 @@ proc test_file(const char* file) -> testresult {
     Environment* env = Memory::create_built_ins_environment();
     assert_no_error();
 
-    Parser::init(env);
+    Parser::environment_for_macros = env;
     assert_no_error();
 
     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 {
     Memory::init(4096 * 2000, 4096 * 16);
-    Parser::init(Memory::create_built_ins_environment());
+    Parser::environment_for_macros = Globals::root_environment;
 
     bool result = true;
 

todo.org

@@ -1,5 +1,6 @@
 * TODO rename slime to plisk
 * TODO go through sicp and use the examples as test files
+* TODO test macro expanding to macro
 * TODO BUG 1: eval dot notation
 #+BEGIN_SRC lisp
   (eval `(+ . ,(list 1 2 3)))