Fixed a bug where cs was accessed out of bouds, gensyms, 'and and 'or are now macros

bin/pre.slime

@@ -25,6 +25,39 @@
 (define-syntax (mac a) (list + 1 1))
 (define-syntax (add . args) (pair '+ args))
 
+(define-syntax (and . args)
+  ;; (and cond1 cond2 (cond3 args))
+  ;; ->
+  ;; (if cond1
+  ;;     (if cond2
+  ;;         (let ((g (cond3 args)))
+  ;;           (if g
+  ;;               g
+  ;;             ()))
+  ;;       ())
+  ;;   ())
+  (if args
+      `(,if ,(first args)
+           ,(apply and (rest args))
+         ())
+    t))
+
+(define-syntax (or . args)
+  ;; (or cond1 cond2 (cond3 args))
+  ;; ->
+  ;; (if cond1
+  ;;     t
+  ;;   (if cond2
+  ;;       t
+  ;;     (if (cond3 args)
+  ;;         t
+  ;;       ())))
+  (if args
+      `(,if ,(first args)
+           t
+         ,(apply or (rest args)))
+    ()))
+
 (define-syntax (when condition . body)
   "Special form for when multiple actions should be done if a
 condition is true.

src/built_ins.cpp

@@ -543,6 +543,14 @@ namespace Slime {
 
             return Memory::create_lisp_object(x);
         };
+        define((gensym), "TODO") {
+            profile_with_name("(gensym)");
+            Lisp_Object* node;
+            try node = Memory::create_lisp_object();
+            Memory::set_type(node, Lisp_Object_Type::Symbol);
+            node->value.symbol = Memory::create_string("gensym");
+            return node;
+        };
         define_special((bound? var), "TODO") {
             profile_with_name("(bound?)");
             fetch(var);
@@ -807,40 +815,10 @@ namespace Slime {
             expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
             return expr;
         };
-        define_special((and . args), "TODO") {
-            profile_with_name("(and)");
-            fetch(args);
-            bool result = true;
-            in_caller_env {
-                for_lisp_list (args) {
-                    try result &= is_truthy(it);
-                    if (!result)
-                        return Memory::nil;
-                }
-            }
-            return Memory::t;
-        };
-        define_special((or . args), "TODO") {
-            profile_with_name("(or)");
-            fetch(args);
-            bool result = false;
-            in_caller_env {
-                for_lisp_list (args) {
-                    try result |= is_truthy(it);
-                    if (result)
-                        return Memory::t;
-                }
-            }
-            return Memory::nil;
-        };
-        define_special((not test), "TODO") {
+        define((not test), "TODO") {
             profile_with_name("(not)");
             fetch(test);
-            bool truthy;
-            in_caller_env {
-                try truthy = is_truthy(test);
-            }
-            return (truthy) ? Memory::nil : Memory::t;
+            return is_truthy(test) ? Memory::nil : Memory::t;
         };
         // // // defun("while", "TODO", __LINE__, cLambda {
         // // //         try arguments_length = list_length(arguments);

src/env.cpp

@@ -1,7 +1,11 @@
 namespace Slime {
     proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
         profile_with_comment(&symbol->value.symbol->data);
-        Environment* env = get_current_environment();
+        define_symbol(symbol, value, get_current_environment());
+    }
+
+    proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void {
+        profile_with_comment(&symbol->value.symbol->data);
         env->hm.set_object((void*)symbol, value);
     }
 

src/eval.cpp

@@ -1,38 +1,18 @@
 namespace Slime {
 
     proc create_extended_environment_for_function_application_nrc(
-        // TODO(Felix): pass cs as value as soon as we got rid of
-        // destructors, to prevent destroying it on scope exit
-        Array_List<Lisp_Object*>* cs,
         Lisp_Object* function,
         int arg_start,
         int arg_end) -> Environment*
     {
         profile_this();
+        using namespace Globals::Current_Execution;
 
-        int arg_pos = arg_start;
+        int index_of_next_arg = arg_start;
         bool is_c_function = function->value.function->is_c;
-        Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
+        Environment* 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
-
-        // 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
-
-        Lisp_Object* sym, *val; // used as temp storage to use `try`
         Array_List<Lisp_Object*> read_in_keywords;
         read_in_keywords.alloc();
         defer {
@@ -41,201 +21,173 @@ namespace Slime {
         int obligatory_keywords_count = 0;
         int read_obligatory_keywords_count = 0;
 
-        Lisp_Object* next_arg = cs->data[arg_pos];
-
-        proc read_positional_args = [&] {
-            for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
-                sym = arg_spec->positional.symbols.data[i];
-                if (arg_pos == arg_end) {
-                    create_parsing_error(
-                        "Not enough positional args supplied. Needed: %d suppied, %d.\n"
-                        "Next missing arg is '%s'",
-                        arg_spec->positional.symbols.next_index, arg_end-arg_pos,
-                        &sym->value.symbol->data);
-                    return;
-                }
-                // NOTE(Felix): We have to copy all the arguments,
-                // otherwise we change the program code.
-                // XXX(Felix): To C functions we pass by reference.
-                // TODO(Felix): Why did we decide this??
-                if (is_c_function) {
-                    define_symbol(sym, next_arg);
-                } else {
-                    define_symbol(
-                        sym,
-                        Memory::copy_lisp_object_except_pairs(next_arg));
-                }
-                assert("cs access index out of range",
-                       arg_pos+1 < cs->next_index);
-                next_arg = cs->data[++arg_pos];
+        Lisp_Object* sym;
+        Lisp_Object* val;
+
+        // read positionals
+        for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
+            if (index_of_next_arg == arg_end) {
+                create_parsing_error(
+                    "Not enough positional args supplied. Needed: %d suppied, %d.\n"
+                    "Next missing arg is '%s'",
+                    arg_spec->positional.symbols.next_index, arg_end-index_of_next_arg,
+                    &arg_spec->positional.symbols.data[i]->value.symbol->data);
+                return nullptr;
             }
-        };
-
-        proc read_keyword_args = [&] {
-            // debug_break();
-            // 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 (arg_pos == arg_end) {
-                return;
+            // NOTE(Felix): We have to copy all the arguments,
+            // otherwise we change the program code. To C functions we
+            // pass by reference for better performance and trust them
+            // to not mutate the arguments because we expect c
+            // programmers to know what they are doing. Bold claim I
+            // know.
+            if (is_c_function) {
+                define_symbol(arg_spec->positional.symbols.data[i], cs.data[index_of_next_arg], env);
+            } else {
+                define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
             }
+            ++index_of_next_arg;
+        }
 
+        // if there are some left read keywords and rest
+        if (index_of_next_arg != arg_end) {
             // 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(next_arg) == Lisp_Object_Type::Keyword) {
+            while (Memory::get_type(cs.data[index_of_next_arg]) == Lisp_Object_Type::Keyword) {
                 // check if this one is even an accepted keyword
                 bool accepted = false;
                 for (int i = 0; i < arg_spec->keyword.keywords.next_index; ++i) {
-                    if (next_arg == arg_spec->keyword.keywords.data[i])
-                    {
+                    if (cs.data[index_of_next_arg] == 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 we read all we need then we are done here
                     if (read_obligatory_keywords_count == obligatory_keywords_count)
-                        return;
+                        break;
+                    // otherwise we would have to read more but there
+                    // was a not accepted kwarg, so signal the error
                     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.",
-                        &(next_arg->value.symbol->data));
-                    return;
+                        &(cs.data[index_of_next_arg]->value.symbol->data));
+                    return nullptr;
                 }
-
-                // check if it was already read in
+                // This is an accepted kwarg; check if it was already
+                // read in
                 for (int i = 0; i < read_in_keywords.next_index; ++i) {
-                    if (next_arg == read_in_keywords.data[i])
+                    if (cs.data[index_of_next_arg] == 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 we already read it in but also finished
+                        // all other kwargs, then count it as rest and
+                        // be done here
                         if (read_obligatory_keywords_count == obligatory_keywords_count)
-                            return;
+                            goto kw_done;
+                        // If there are some kwargs left to be read
+                        // in, it is an error
                         create_generic_error(
                             "The function already read the keyword argument ':%s'",
-                            &(next_arg->value.symbol->data));
-                        return;
+                            &(cs.data[index_of_next_arg]->value.symbol->data));
+                        return nullptr;
                     }
                 }
-
                 // 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 (arg_pos == arg_end) {
+                if (index_of_next_arg+1 == arg_end) {
                     create_generic_error(
                         "Attempting to set the keyword argument ':%s', but no value was supplied.",
-                        &(next_arg->value.symbol->data));
-                    return;
+                        &(cs.data[index_of_next_arg]->value.symbol->data));
+                    return nullptr;
                 }
 
                 // if not set it and then add it to the array list
-                Lisp_Object* key = next_arg;
-                try_void sym = Memory::get_symbol(key->value.symbol);
-                next_arg = cs->data[++arg_pos];
+                Lisp_Object* key = cs.data[index_of_next_arg];
+                try sym = Memory::get_symbol(key->value.symbol);
+                ++index_of_next_arg;
 
-                // NOTE(Felix): It seems we do not need to evaluate the argument here...
                 if (is_c_function) {
-                    try_void define_symbol(sym, next_arg);
+                    try define_symbol(sym, cs.data[index_of_next_arg], env);
                 } else {
-                    try_void define_symbol(sym,
-                        Memory::copy_lisp_object_except_pairs(next_arg));
+                    try define_symbol(sym, Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
                 }
 
                 read_in_keywords.append(key);
                 ++read_obligatory_keywords_count;
 
-                // overstep both for next one
-                next_arg = cs->data[++arg_pos];
+                ++index_of_next_arg;
 
-                if (arg_pos == arg_end) {
+                if (index_of_next_arg == arg_end) {
                     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);
-                    }
+      kw_done:
+        // check keywords for completeness
+        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;
                 }
             }
-        };
-
-        proc read_rest_arg = [&]() -> void {
-            if (arg_pos == arg_end) {
-                if (arg_spec->rest) {
-                    define_symbol(arg_spec->rest, Memory::nil);
+            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 nullptr;
                 }
             } else {
-                if (arg_spec->rest) {
-
-                    Lisp_Object* list;
-                    try_void list = Memory::create_list(next_arg);
-                    Lisp_Object* head = list;
-                    for (++arg_pos;arg_pos < arg_end; ++arg_pos) {
-                        next_arg = cs->data[arg_pos];
-                        try_void head->value.pair.rest = Memory::create_list(next_arg);
-                        head = head->value.pair.rest;
+                // 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 sym = Memory::get_symbol(defined_keyword->value.symbol);
+                    if (is_c_function) {
+                        try val = arg_spec->keyword.values.data[i];
+                    } else {
+                        try val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
                     }
-                    define_symbol(arg_spec->rest, list);
-                } 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;
+                    define_symbol(sym, val, env);
                 }
             }
-        };
+        }
 
-        try read_positional_args();
-        try read_keyword_args();
-        try check_keyword_args();
-        try read_rest_arg();
+        // read in rest arg
+        if (index_of_next_arg == arg_end) {
+            if (arg_spec->rest) {
+                define_symbol(arg_spec->rest, Memory::nil, env);
+            }
+        } else {
+            if (arg_spec->rest) {
+                Lisp_Object* list;
+                try list = Memory::create_list(cs.data[index_of_next_arg]);
+                Lisp_Object* head = list;
+                for (++index_of_next_arg;index_of_next_arg < arg_end; ++index_of_next_arg) {
+                    try head->value.pair.rest = Memory::create_list(cs.data[index_of_next_arg]);
+                    head = head->value.pair.rest;
+                }
+                define_symbol(arg_spec->rest, list, env);
+            } 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 nullptr;
+            }
+        }
 
-        return new_env;
+        return env;
     }
 
 
@@ -507,7 +459,7 @@ namespace Slime {
 
                     Environment* extended_env;
                     try extended_env = create_extended_environment_for_function_application_nrc(
-                            &cs, function, am+1, cs.next_index);
+                            function, am+1, cs.next_index);
                     cs.next_index = am;
                     push_environment(extended_env);
                     if (function->value.function->is_c) {
@@ -558,11 +510,8 @@ namespace Slime {
         return cs.data[--cs.next_index];
     }
 
-    proc is_truthy(Lisp_Object* expression) -> bool {
-        Lisp_Object* result;
-        try result = eval_expr(expression);
-
-        return result != Memory::nil;
+    inline proc is_truthy(Lisp_Object* expression) -> bool {
+        return expression != Memory::nil;
     }
 
     proc interprete_file (char* file_name) -> Lisp_Object* {

src/forward_decls.cpp

@@ -16,6 +16,7 @@ namespace Slime {
 
     Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
     void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
+    void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
     char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
     void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
     void print_environment(Environment*);