Implemented cintinuations and call/cc

.dir-locals.el

@@ -34,4 +34,6 @@
 
  (c++-mode . ((eval . (company-clang-set-prefix "slime.h"))
               (eval . (flycheck-mode 0))
+              (eval . (company-mode 0))
+              (eval . (rainbow-mode 0))
               (eval . (setq c-backslash-max-column 99)))))

3rd/ftb

@@ -1 +1 @@
-Subproject commit f35d5c6d900447fc8d29e68abe4838b788f067b9
+Subproject commit 07e89f384155abd4ec231edc173ce0d03244b1cf

bin/tests/continuations.slime

@@ -0,0 +1,36 @@
+(define add-5 '())
+(define res 1)
+
+(mutate! res (+ 2 (call/cc (lambda (cont) (set! add-5 cont) 1)) 3))
+(assert (= res 6))
+
+(add-5 100)
+(assert (= res 105))
+
+(add-5 10)
+(assert (= res 15))
+
+
+;; ----------- works until here ---------------
+
+
+(set! res (+ 2 (call/cc (lambda (cont) (set! add-5 cont) 1)) 3))
+;; (print)
+;; (print res 6)
+(assert (= res 6))
+
+(add-5 100)
+;; (print res 105)
+(assert (= res 105))
+
+(add-5 10)
+(assert (= res 15))
+;; (print res 15)
+
+;; (define fun '())
+
+;; (mutate! res (apply (call/cc (lambda (k) (set! fun k) +)) (list 1 2 3)))
+
+;; (assert (= res 6))
+;; (fun -)
+;; (assert (= res -1))

bin/tests/lexical_scope.slime

@@ -3,7 +3,8 @@
 (define (make-counter)
   (let ((var 0))
     (lambda ()
-      (set! var (+ 1 var)))))
+      (set! var (+ 1 var))
+      var)))
 
 (define counter1 (make-counter))
 

bin/tests/regression.slime

@@ -1 +1,7 @@
-;; (define (empty-function-body-test))
+(define (empty-function-body-test))
+
+;; test that arguments to apply are only evaled once
+(define counter 0)
+(assert (= (apply (lambda (x) x) (begin (mutate! counter (+ 1 counter)) (list +)))
+           +))
+(assert (= counter 1))

build.bat

@@ -7,9 +7,9 @@ set exeName=slime.exe
 taskkill /F /IM %exeName% > NUL 2> NUL
 
 echo ---------- Compiling ----------
-call cl  ^
+call clang-cl  ^
      ../src/main.cpp^
-     /I../3rd/ /DEBUG:FULL ^
+     /I../3rd/ ^
      /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^
      /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc
 

src/built_ins.cpp

@@ -149,49 +149,130 @@ namespace Slime {
         String file_name_built_ins = Memory::create_string(__FILE__);
         defer_free(file_name_built_ins.data);
 
+        define_macro((call/cc fun), "TODO") {
+            profile_with_name("(call/cc)");
+
+            using Globals::Current_Execution;
+            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
+            try_void assert_list_length(args, 1);
+
+            Lisp_Object* fun = args->value.pair.first;
+
+            // 2. push cont on the stack and call, the fun is already
+            // there
+            Current_Execution.ats.append([] {
+                try_void assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1]
+                                     , Lisp_Object_Type::Function);
+                Lisp_Object* cont = Memory::create_lisp_object_continuation();
+
+                Current_Execution.ams.append(Current_Execution.cs.next_index-1);
+                Current_Execution.pcs.append(Memory::nil);
+                --cont->value.continuation->cs.next_index;
+                Current_Execution.cs.append(cont);
+                (Current_Execution.nass.end()-1)->append(NasAction::Step);
+            });
+            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
+
+            // 1. resolve the function
+            Current_Execution.cs.append(fun);
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+
+        };
+        define_macro((set! sym val), "TODO") {
+            // NOTE(Felix): This COULD be a define_special in theory,
+            // but because of call/cc, it cannot be anymore because
+            // the define_symbol would not be a part of the
+            // continuation. This happens for example in:
+            /**
+              (set! res (+ 2 (call/cc (lambda (cont)
+                                         (set! add-5 cont) 1))
+                           3))
+            */
+            // So if 'set! WAS a define_special, then the param would
+            // not be evaluated, but the whole call gets removed from
+            // the stack, and in the body of 'set!, the 'val would be
+            // recursively evaluated, and the 'call/cc would not see
+            // the variable definition as part of the continuation. So
+            // what we do istead, is writing 'set! as a macro and have
+            // the variable definition as a and_then_action, so that
+            // it is part of the continuation.
+            profile_with_name("(set!)");
+            using Globals::Current_Execution;
+
+            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
+            try_void assert_list_length(args, 2);
+
+            Lisp_Object* sym = args->value.pair.first;
+            Lisp_Object* val = args->value.pair.rest->value.pair.first;
+
+            try_void assert_type(sym, Lisp_Object_Type::Symbol);
+
+            // 2. find the binding and rebind
+            Current_Execution.cs.append(sym);
+            Current_Execution.ats.append([] {
+                using Globals::Current_Execution;
+                Lisp_Object* val = Current_Execution.cs.data[--Current_Execution.cs.next_index];
+                Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
+
+                Environment* target_env = find_binding_environment(sym, get_current_environment());
+                    if (!target_env)
+                        target_env = get_root_environment();
+                define_symbol(sym, val, target_env);
+            });
+            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
+
+            // 1. eval the val
+            Current_Execution.cs.append(val);
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+
+        };
         define_macro((apply fun fun_args), "TODO") {
             // NOTE(Felix): is has to be a macro because apply by
             // itself cannot return the result, we have to invoke eval
             // and to prevent recursion, apply is a macro
 
             profile_with_name("(apply)");
-            using namespace Globals::Current_Execution;
+            using Globals::Current_Execution;
 
-            Lisp_Object* args = pcs[--pcs.next_index];
+            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
             try_void assert_list_length(args, 2);
 
             Lisp_Object* fun      = args->value.pair.first;
             Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;
 
             // 3. push args on the stack and apply
-            ats.append([] {
-                Lisp_Object* args_as_list = cs[--cs.next_index];
+            Current_Execution.ats.append([] {
+                // BUG(Felix): we are not pushing on the ams, are we
+                // doing it wrong?
+                // Current_Execution.ams.append(Current_Execution.cs.next_index-2);
+
+                Lisp_Object* args_as_list = Current_Execution.cs[--Current_Execution.cs.next_index];
                 for_lisp_list (args_as_list) {
-                    cs.append(it);
+                    Current_Execution.cs.append(it);
                 }
-                pcs.append(Memory::nil);
-                (nass.end()-1)->append(NasAction::Step);
+                Current_Execution.pcs.append(Memory::nil);
+                (Current_Execution.nass.end()-1)->append(NasAction::Step);
             });
-            (nass.end()-1)->append(NasAction::And_Then_Action);
+            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
 
             // 2. Eval fun_args and keep them on the stack
-            ats.append([] {
+            Current_Execution.ats.append([] {
                 // NOTE(Felix): Flip the top 2 elements on cs because
                 // top is now the evaluated function, and below is the unevaluated args
-                Lisp_Object* tmp = cs[cs.next_index-1];
-                cs[cs.next_index-1] = cs[cs.next_index-2];
-                cs[cs.next_index-2] = tmp;
-                (nass.end()-1)->append(NasAction::Eval);
+                Lisp_Object* tmp = Current_Execution.cs[Current_Execution.cs.next_index-1];
+                Current_Execution.cs[Current_Execution.cs.next_index-1] = Current_Execution.cs[Current_Execution.cs.next_index-2];
+                Current_Execution.cs[Current_Execution.cs.next_index-2] = tmp;
+                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
             });
-            (nass.end()-1)->append(NasAction::And_Then_Action);
+            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);
 
 
             // 1. Eval function and keep it on the stack, below it
             // store the unevaluated argument list
-            ams.append(cs.next_index);
-            cs.append(fun_args);
-            cs.append(fun);
-            (nass.end()-1)->append(NasAction::Eval);
+            Current_Execution.ams.append(Current_Execution.cs.next_index);
+            Current_Execution.cs.append(fun_args);
+            Current_Execution.cs.append(fun);
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
 
         };
         define((get-counter),
@@ -215,12 +296,12 @@ namespace Slime {
                      "Takes one argument, and evaluates it two times.")
         {
             profile_with_name("(eval)");
-            using namespace Globals::Current_Execution;
+            using Globals::Current_Execution;
             // we know cs.data[cs.next_index] is allocated because the
             // macro cal lwas there just before
-            cs.data[cs.next_index++] = pcs[--pcs.next_index]->value.pair.first;
-            (nass.end()-1)->append(NasAction::Eval);
-            (nass.end()-1)->append(NasAction::Eval);
+            Current_Execution.cs.data[Current_Execution.cs.next_index++] = Current_Execution.pcs[--Current_Execution.pcs.next_index]->value.pair.first;
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
 
         };
         define_macro((begin . rest),
@@ -228,18 +309,18 @@ namespace Slime {
                      "and returns the last result.")
         {
             profile_with_name("(begin)");
-            using namespace Globals::Current_Execution;
-            Lisp_Object* args = pcs[--pcs.next_index];
+            using Globals::Current_Execution;
+            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
             u32 length = list_length(args);
-            cs.reserve(length);
+            Current_Execution.cs.reserve(length);
             for_lisp_list(args) {
-                cs.data[cs.next_index - 1 + (length - it_index)] = it;
-                (nass.end()-1)->append(NasAction::Eval);
-                (nass.end()-1)->append(NasAction::Pop);
+                Current_Execution.cs.data[Current_Execution.cs.next_index - 1 + (length - it_index)] = it;
+                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+                (Current_Execution.nass.end()-1)->append(NasAction::Pop);
             }
 
-            --(nass.end()-1)->next_index;
-            cs.next_index += length;
+            --(Current_Execution.nass.end()-1)->next_index;
+            Current_Execution.cs.next_index += length;
         };
         define_macro((if test then_part else_part),
                      "Takes 3 arguments. If the first arguments evaluates to a truthy  "
@@ -247,12 +328,12 @@ namespace Slime {
                      "it will evaluete the third one and return them respectively.")
         {
             profile_with_name("(if)");
-            using namespace Globals::Current_Execution;
+            using Globals::Current_Execution;
             /* |          |    |   <test>  |
                |          | -> |   <then>  |
                |   <if>   |    |   <else>  |
                |   ....   |    |   ......  | */
-            Lisp_Object* args = pcs.data[--pcs.next_index];
+            Lisp_Object* args = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
             Lisp_Object* test = args->value.pair.first;
             args = args->value.pair.rest;
             try_void assert_type(args, Lisp_Object_Type::Pair);
@@ -263,14 +344,13 @@ namespace Slime {
             args = args->value.pair.rest;
             try_void assert_type(args, Lisp_Object_Type::Nil);
 
-            cs.append(alternative);
-            cs.append(consequence);
-            cs.append(test);
-
-            (nass.end()-1)->append(NasAction::Eval);
-            (nass.end()-1)->append(NasAction::If);
-            (nass.end()-1)->append(NasAction::Eval);
+            Current_Execution.cs.append(alternative);
+            Current_Execution.cs.append(consequence);
+            Current_Execution.cs.append(test);
 
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+            (Current_Execution.nass.end()-1)->append(NasAction::If);
+            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
         };
         define_macro((define definee . args), "") {
             // NOTE(Felix): define has to be a macro, because we need
@@ -279,9 +359,9 @@ namespace Slime {
             // want to recursivly evaluate the value, we use a macro
             // and a NasAction.
             profile_with_name("(define)");
-            using namespace Globals::Current_Execution;
+            using Globals::Current_Execution;
 
-            Lisp_Object* form    = pcs.data[--pcs.next_index];
+            Lisp_Object* form    = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
             Lisp_Object* definee = form->value.pair.first;
             form = form->value.pair.rest;
             if (definee->type == Lisp_Object_Type::Symbol) {
@@ -302,10 +382,10 @@ namespace Slime {
                     // TODO docs (maybe with hooks) we have to attach
                     // the docs to the result of evaluating
                 }
-                cs.append(definee);
-                cs.append(thing);
-                (nass.end()-1)->append(NasAction::Define_Var);
-                (nass.end()-1)->append(NasAction::Eval);
+                Current_Execution.cs.append(definee);
+                Current_Execution.cs.append(thing);
+                (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
+                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
             } break;
             case Lisp_Object_Type::Pair: {
                 try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
@@ -331,7 +411,7 @@ namespace Slime {
                 func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
 
                 define_symbol(definee->value.pair.first, func);
-                cs.append(definee->value.pair.first);
+                Current_Execution.cs.append(definee->value.pair.first);
             } break;
             default: {
                 create_generic_error("you can only define symbols");
@@ -356,7 +436,7 @@ namespace Slime {
         define_special((with-debug-log . rest), "") {
             profile_with_name("(enable-debug-log)");
             fetch(rest);
-            Lisp_Object* result;
+            Lisp_Object* result = Memory::nil;
             Globals::debug_log = true;
             in_caller_env {
                 for_lisp_list(rest) {
@@ -679,26 +759,6 @@ namespace Slime {
 
             return val;
         };
-        define_special((set! sym val), "TODO") {
-            profile_with_name("(set!)");
-            fetch(sym, val);
-
-            try assert_type(sym, Lisp_Object_Type::Symbol);
-            Environment* target_env;
-            in_caller_env {
-                val = eval_expr(val);
-                target_env = find_binding_environment(sym, get_current_environment());
-                if (!target_env)
-                    target_env = get_root_environment();
-            }
-
-
-            push_environment(target_env);
-            define_symbol(sym, val);
-            pop_environment();
-
-            return val;
-        };
         define((set-car! target source), "TODO") {
             profile_with_name("(set-car!)");
             fetch(target, source);
@@ -1108,12 +1168,12 @@ namespace Slime {
             fetch(sep, end, repr, things);
 
             if (things != Memory::nil) {
-                bool print_repr = repr != Memory::nil;
-                print(things->value.pair.first, repr);
+                bool print_repr = (repr != Memory::nil);
+                print(things->value.pair.first, print_repr);
 
                 for_lisp_list(things->value.pair.rest) {
                     print(sep);
-                    print(it, repr);
+                    print(it, print_repr);
                 }
             }
 

src/define_macros.hpp

@@ -130,8 +130,8 @@
 #define define_macro(def, docs)   _define_helper(def, docs, Slime::C_Function_Type::cMacro,    c_macro_body = []() -> void)
 
 #define in_caller_env fluid_let(                                \
-        Globals::Current_Execution::envi_stack.next_index,      \
-        Globals::Current_Execution::envi_stack.next_index-1)
+        Globals::Current_Execution.envi_stack.next_index,      \
+        Globals::Current_Execution.envi_stack.next_index-1)
 
 
 /*

src/env.cpp

@@ -54,23 +54,20 @@ namespace Slime {
     }
 
     inline proc push_environment(Environment* env) -> void {
-        using namespace Globals::Current_Execution;
-        envi_stack.append(env);
+        Globals::Current_Execution.envi_stack.append(env);
     }
 
     inline proc pop_environment() -> void {
-        using namespace Globals::Current_Execution;
-        --envi_stack.next_index;
+        --Globals::Current_Execution.envi_stack.next_index;
     }
 
     inline proc get_root_environment() -> Environment* {
-        using namespace Globals::Current_Execution;
-        return envi_stack.data[0];
+        return Globals::Current_Execution.envi_stack.data[0];
     }
 
     inline proc get_current_environment() -> Environment* {
-        using namespace Globals::Current_Execution;
-        return envi_stack.data[envi_stack.next_index-1];
+        return Globals::Current_Execution.envi_stack.data[
+            Globals::Current_Execution.envi_stack.next_index-1];
     }
 
     proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {

src/error.cpp

@@ -10,17 +10,17 @@ namespace Slime {
     proc create_error(const char* c_func_name, const char* c_file_name,
                       u32 c_file_line, Lisp_Object* type, String message) -> void
     {
-        delete_error();
-        if (Globals::breaking_on_errors) {
-            debug_break();
-        }
-
         using Globals::error;
+        delete_error();
         error = (Error*)malloc(sizeof(Error)) ;
         error->type = type;
         error->message = message;
 
         log_error();
+
+        if (Globals::breaking_on_errors) {
+            debug_break();
+        }
         if (Globals::log_level > Log_Level::None) {
             // c error location
             printf("in");

src/eval.cpp

@@ -6,7 +6,7 @@ namespace Slime {
         u32 arg_end) -> Environment*
     {
         profile_this();
-        using namespace Globals::Current_Execution;
+        using Globals::Current_Execution;
 
         u32 index_of_next_arg = arg_start;
         bool is_c_function = function->value.function->is_c;
@@ -41,9 +41,9 @@ namespace Slime {
             // 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);
+                define_symbol(arg_spec->positional.symbols.data[i], Current_Execution.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);
+                define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(Current_Execution.cs.data[index_of_next_arg]), env);
             }
             ++index_of_next_arg;
         }
@@ -56,11 +56,11 @@ namespace Slime {
                     ++obligatory_keywords_count;
             }
 
-            while (cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) {
+            while (Current_Execution.cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) {
                 // check if this one is even an accepted keyword
                 bool accepted = false;
                 for (u32 i = 0; i < arg_spec->keyword.keywords.next_index; ++i) {
-                    if (cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) {
+                    if (Current_Execution.cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) {
                         accepted = true;
                         break;
                     }
@@ -75,13 +75,13 @@ namespace Slime {
                         "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.",
-                        cs.data[index_of_next_arg]->value.symbol.data);
+                        Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
                     return nullptr;
                 }
                 // This is an accepted kwarg; check if it was already
                 // read in
                 for (u32 i = 0; i < read_in_keywords.next_index; ++i) {
-                    if (cs.data[index_of_next_arg] == read_in_keywords.data[i])
+                    if (Current_Execution.cs.data[index_of_next_arg] == read_in_keywords.data[i])
                     {
                         // if we already read it in but also finished
                         // all other kwargs, then count it as rest and
@@ -92,7 +92,7 @@ namespace Slime {
                         // in, it is an error
                         create_generic_error(
                             "The function already read the keyword argument ':%s'",
-                            cs.data[index_of_next_arg]->value.symbol.data);
+                            Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
                         return nullptr;
                     }
                 }
@@ -102,19 +102,19 @@ namespace Slime {
                 if (index_of_next_arg+1 == arg_end) {
                     create_generic_error(
                         "Attempting to set the keyword argument ':%s', but no value was supplied.",
-                        cs.data[index_of_next_arg]->value.symbol.data);
+                        Current_Execution.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 = cs.data[index_of_next_arg];
+                Lisp_Object* key = Current_Execution.cs.data[index_of_next_arg];
                 try sym = Memory::get_symbol(key->value.symbol);
                 ++index_of_next_arg;
 
                 if (is_c_function) {
-                    try define_symbol(sym, cs.data[index_of_next_arg], env);
+                    try define_symbol(sym, Current_Execution.cs.data[index_of_next_arg], env);
                 } else {
-                    try define_symbol(sym, Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
+                    try define_symbol(sym, Memory::copy_lisp_object_except_pairs(Current_Execution.cs.data[index_of_next_arg]), env);
                 }
 
                 read_in_keywords.append(key);
@@ -171,10 +171,10 @@ namespace Slime {
         } else {
             if (arg_spec->rest) {
                 Lisp_Object* list;
-                try list = Memory::create_list(cs.data[index_of_next_arg]);
+                try list = Memory::create_list(Current_Execution.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]);
+                    try head->value.pair.rest = Memory::create_list(Current_Execution.cs.data[index_of_next_arg]);
                     head = head->value.pair.rest;
                 }
                 define_symbol(arg_spec->rest, list, env);
@@ -313,13 +313,13 @@ namespace Slime {
 
     proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
         profile_this();
-        using namespace Globals::Current_Execution;
+        using Globals::Current_Execution;
 
-        nass.reserve(1);
-        Array_List<NasAction>* nas = nass.data+(nass.next_index++);
+        Current_Execution.nass.reserve(1);
+        Array_List<NasAction>* nas = Current_Execution.nass.data+(Current_Execution.nass.next_index++);
         nas->alloc();
         defer {
-            --nass.next_index;
+            --Current_Execution.nass.next_index;
             nas->dealloc();
         };
 
@@ -332,13 +332,13 @@ namespace Slime {
         };
 
         proc push_pc_on_cs = [&] {
-            for_lisp_list (pcs.data[pcs.next_index-1]) {
-                cs.append(it);
+            for_lisp_list (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]) {
+                Current_Execution.cs.append(it);
             }
-            pcs.data[pcs.next_index-1] = Memory::nil;
+            Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Memory::nil;
         };
 
-        cs.append(expr);
+        Current_Execution.cs.append(expr);
         nas->append(NasAction::Eval);
 
         NasAction current_action;
@@ -350,35 +350,36 @@ namespace Slime {
             current_action = nas->data[--nas->next_index];
             switch (current_action) {
             case NasAction::Pop: {
-                --cs.next_index;
+                --Current_Execution.cs.next_index;
             } break;
             case NasAction::And_Then_Action: {
-                ats.data[--ats.next_index]();
+                Current_Execution.ats.data[--Current_Execution.ats.next_index]();
             } break;
             case NasAction::Pop_Environment: {
                 pop_environment();
             } break;
             case NasAction::Eval: {
-                pc = cs.data[cs.next_index-1];
+                pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
                 Lisp_Object_Type type = pc->type;
                 switch (type) {
                 case Lisp_Object_Type::Symbol: {
-                    cs.data[cs.next_index-1] = lookup_symbol(pc, get_current_environment());
+                    Current_Execution.cs.data[Current_Execution.cs.next_index-1]
+                        = lookup_symbol(pc, get_current_environment());
                 } break;
                 case Lisp_Object_Type::Pair: {
-                    cs.data[cs.next_index-1] = pc->value.pair.first;
-                    ams.append(cs.next_index-1);
+                    Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
+                    Current_Execution.ams.append(Current_Execution.cs.next_index-1);
 
                     if_debug {
-                        if (ams.next_index >= 2) {
+                        if (Current_Execution.ams.next_index >= 2) {
                             assert("invalid ams state",
-                                   ams.data[ams.next_index-2] <=
-                                   ams.data[ams.next_index-1]);
+                                   Current_Execution.ams.data[Current_Execution.ams.next_index-2] <=
+                                   Current_Execution.ams.data[Current_Execution.ams.next_index-1]);
                         }
                     }
 
-                    pcs.append(pc->value.pair.rest);
-                    mes.append(pc);
+                    Current_Execution.pcs.append(pc->value.pair.rest);
+                    Current_Execution.mes.append(pc);
                     nas->append(NasAction::TM);
                     nas->append(NasAction::Eval);
                 } break;
@@ -389,18 +390,19 @@ namespace Slime {
                 }
             } break;
             case NasAction::Macro_Write_Back: {
-                *mes.data[--mes.next_index] = *cs[cs.next_index-1];
+                *(Current_Execution.mes.data[--Current_Execution.mes.next_index])
+                    = *Current_Execution.cs[Current_Execution.cs.next_index-1];
             } break;
             case NasAction::TM: {
-                pc = cs.data[cs.next_index-1];
+                pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
 
                 Lisp_Object_Type type = pc->type;
                 switch (type) {
                 case Lisp_Object_Type::Function: {
                     if(pc->value.function->is_c) {
                         if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
-                            --cs.next_index;  // remove the macro call from cs
-                            --ams.next_index; // remove the apply marker for the macro
+                            --Current_Execution.cs.next_index;  // remove the macro call from cs
+                            --Current_Execution.ams.next_index; // remove the apply marker for the macro
                             try pc->value.function->body.c_macro_body();
                         } else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
                         {
@@ -412,7 +414,7 @@ namespace Slime {
                         } else {
                             nas->append(NasAction::Step);
                         }
-                        --mes.next_index;
+                        --Current_Execution.mes.next_index;
                     } else {
                         if (pc->value.function->type.lisp_function_type ==
                             Lisp_Function_Type::Macro)
@@ -422,16 +424,74 @@ namespace Slime {
                             nas->append(NasAction::Macro_Write_Back);
                             nas->append(NasAction::Step);
                         } else {
-                            --mes.next_index;
+                            --Current_Execution.mes.next_index;
                             nas->append(NasAction::Step);
                         }
                     }
                 } break;
+                case Lisp_Object_Type::Continuation: {
+                    --Current_Execution.mes.next_index;
+                    --Current_Execution.ams.next_index;
+                    Lisp_Object* param = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
+                    try assert_list_length(param, 1);
+                    param = param->value.pair.first;
+                    // NOTE(Felix): we could first get value and eval
+                    // it and restore the cont on an and_then_action
+                    // OR we could restore the cont now and push the
+                    // new unevaluated val on the stack and leave a
+                    // NAS_Actoin::Eval behind. So that's what we
+                    // gonna do.
+
+                    Globals::Current_Execution.cs.clear();
+                    Globals::Current_Execution.ams.clear();
+                    Globals::Current_Execution.pcs.clear();
+                    Globals::Current_Execution.nass.clear();
+                    Globals::Current_Execution.envi_stack.clear();
+                    Globals::Current_Execution.ats.clear();
+                    Globals::Current_Execution.mes.clear();
+
+                    // TODO(Felix): This seems super inefficient
+                    for (auto it: pc->value.continuation->cs) {
+                        Globals::Current_Execution.cs.append(it);
+                    }
+                    for (auto it: pc->value.continuation->ams) {
+                        Globals::Current_Execution.ams.append(it);
+                    }
+                    for (auto it: pc->value.continuation->pcs) {
+                        Globals::Current_Execution.pcs.append(it);
+                    }
+                    for (auto it: pc->value.continuation->envi_stack) {
+                        Globals::Current_Execution.envi_stack.append(it);
+                    }
+                    for (auto it: pc->value.continuation->ats) {
+                        Globals::Current_Execution.ats.append(it);
+                    }
+                    for (auto it: pc->value.continuation->mes) {
+                        Globals::Current_Execution.mes.append(it);
+                    }
+                    {
+                        Globals::Current_Execution.nass.reserve(pc->value.continuation->nass.next_index);
+                        Globals::Current_Execution.nass.next_index = pc->value.continuation->nass.next_index;
+
+                        for (int i = 0; i < pc->value.continuation->nass.next_index; ++i) {
+                            Globals::Current_Execution.nass.data[i].alloc();
+                            for (Globals::Current_Execution.nass.data[i].next_index = 0;
+                                 Globals::Current_Execution.nass.data[i].next_index < pc->value.continuation->nass.data[i].next_index;)
+                            {
+                                Globals::Current_Execution.nass.data[i].append(
+                                    pc->value.continuation->nass.data[i].data[Globals::Current_Execution.nass.data[i].next_index]);
+                            }
+                        }
+                    }
+
+                    Globals::Current_Execution.cs.append(param);
+                    (Current_Execution.nass.end()-1)->append(NasAction::Eval);
+                    // debug_break();
+                } break;
                 default: {
                     char* t = lisp_object_to_string(pc);
-                    defer {
-                        free(t);
-                    };
+                    defer_free(t);
+
                     create_generic_error("The first element of the pair was not a function but: %s in %s",
                                          lisp_object_type_to_string(type), t);
                     return nullptr;
@@ -440,31 +500,31 @@ namespace Slime {
 
             } break;
             case NasAction::Step: {
-                if (pcs.data[pcs.next_index-1] == Memory::nil) {
-                    --pcs.next_index;
-                    u32 am = ams.data[--ams.next_index];
-                    Lisp_Object* function = cs.data[am];
+                if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
+                    --Current_Execution.pcs.next_index;
+                    u32 am = Current_Execution.ams.data[--Current_Execution.ams.next_index];
+                    Lisp_Object* function = Current_Execution.cs.data[am];
                     try assert_type(function, Lisp_Object_Type::Function);
 
                     Environment* extended_env;
                     try extended_env = create_extended_environment_for_function_application_nrc(
-                            function, am+1, cs.next_index);
-                    cs.next_index = am;
+                        function, am+1, Current_Execution.cs.next_index);
+                    Current_Execution.cs.next_index = am;
                     push_environment(extended_env);
                     if (function->value.function->is_c) {
                         if (function->value.function->type.c_function_type == C_Function_Type::cMacro)
                             try function->value.function->body.c_macro_body();
                         else
-                            try cs.append(function->value.function->body.c_body());
+                            try Current_Execution.cs.append(function->value.function->body.c_body());
                         pop_environment();
                     } else {
                         nas->append(NasAction::Pop_Environment);
                         nas->append(NasAction::Eval);
-                        cs.append(function->value.function->body.lisp_body);
+                        Current_Execution.cs.append(function->value.function->body.lisp_body);
                     }
                 } else {
-                    cs.append(pcs.data[pcs.next_index-1]->value.pair.first);
-                    pcs.data[pcs.next_index-1] = pcs.data[pcs.next_index-1]->value.pair.rest;
+                    Current_Execution.cs.append(Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.first);
+                    Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.rest;
                     nas->append(NasAction::Step);
                     nas->append(NasAction::Eval);
                 }
@@ -474,29 +534,29 @@ namespace Slime {
                    |  <then>  |
                    |  <else>  |
                    |   ....   | */
-                cs.next_index -= 2;
+                Current_Execution.cs.next_index -= 2;
                 // NOTE(Felix): for false it is sufficent to pop 2 for
                 // true we have to copy the then part to the new top
                 // of the stack
-                if (cs.data[cs.next_index+1] != Memory::nil) {
-                    cs.data[cs.next_index-1] = cs.data[cs.next_index];
+                if (Current_Execution.cs.data[Current_Execution.cs.next_index+1] != Memory::nil) {
+                    Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Current_Execution.cs.data[Current_Execution.cs.next_index];
                 }
             } break;
             case NasAction::Define_Var: {
                 /* |  <thing>   |
                    |  <symbol>  |
                    |    ....    | */
-                cs.next_index -= 1;
-                try assert_type(cs.data[cs.next_index-1], Lisp_Object_Type::Symbol);
-                try define_symbol(cs.data[cs.next_index-1], cs.data[cs.next_index]);
-                cs.data[cs.next_index-1] = Memory::t;
+                Current_Execution.cs.next_index -= 1;
+                try assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Lisp_Object_Type::Symbol);
+                try define_symbol(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Current_Execution.cs.data[Current_Execution.cs.next_index]);
+                Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Memory::t;
             }
             }
 
         }
         // debug_step();
 
-        return cs.data[--cs.next_index];
+        return Current_Execution.cs.data[--Current_Execution.cs.next_index];
     }
 
     inline proc is_truthy(Lisp_Object* expression) -> bool {
@@ -506,6 +566,11 @@ namespace Slime {
     proc interprete_file (char* file_name) -> Lisp_Object* {
         try Memory::init();
         try Memory::load_pre();
+        defer {
+            if_debug {
+                Slime::Memory::free_everything();
+            }
+        };
 
         Lisp_Object* result;
 
@@ -517,6 +582,11 @@ namespace Slime {
     proc interprete_stdin() -> void {
         try_void Memory::init();
         try_void Memory::load_pre();
+        defer {
+            if_debug {
+                Slime::Memory::free_everything();
+            }
+        };
 
         printf("Welcome to the lispy interpreter.\n%s\n", version_string);
 

src/forward_decls.cpp

@@ -48,6 +48,7 @@ namespace Slime {
         Lisp_Object* get_keyword(const char*);
         Lisp_Object* create_lisp_object(f64);
         Lisp_Object* create_lisp_object(const char*);
+        Lisp_Object* create_lisp_object_continuation();
         Lisp_Object* create_lisp_object_vector(Lisp_Object*);
         Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
         Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
@@ -79,10 +80,11 @@ namespace Slime {
         extern char* bin_path;
         extern Log_Level log_level;
         extern Array_List<void*> load_path;
-        namespace Current_Execution {
-            extern Array_List<Lisp_Object*> call_stack;
-            extern Array_List<Environment*> envi_stack;
-        }
+        // namespace Current_Execution {
+            // extern Array_List<Lisp_Object*> call_stack;
+            // extern Array_List<Environment*> envi_stack;
+        // }
+        extern Continuation Current_Execution;
         extern Error* error;
         extern bool breaking_on_errors;
     }

src/gc.cpp

@@ -79,11 +79,12 @@ namespace Slime::GC {
     }
 
     proc garbage_collect() -> void {
+        using Globals::Current_Execution;
         profile_this();
         ++current_mark;
 
-        for (auto it : protected_environments)                 maybe_mark(it);
-        for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it);
+        for (auto it : protected_environments)   maybe_mark(it);
+        for (auto it : Current_Execution.envi_stack)               maybe_mark(it);
     }
 
     proc gc_init_and_go() -> void {

src/globals.cpp

@@ -24,15 +24,7 @@ namespace Slime::Globals {
     Hash_Map<void*, Source_Code_Location> source_code_locations;
     Hash_Map<void*, Lisp_Object*>         user_types;
 
-    namespace Current_Execution {
-        Array_List<Lisp_Object*>            cs; // call stack
-        Array_List<Lisp_Object*>           pcs; // program counter stack
-        Array_List<int>                    ams; // apply marker stack
-        Array_List<Array_List<NasAction>> nass; // next action stack stack
-        Array_List<Lambda<void()>>         ats; // and then stack
-        Array_List<Lisp_Object*>           mes; // macro expansion stack
-        Array_List<Environment*> envi_stack;
-    }
+    Continuation Current_Execution;
 
     Error* error = nullptr;
 #ifdef _DONT_BREAK_ON_ERRORS

src/io.cpp

@@ -435,7 +435,7 @@ namespace Slime {
             // first check if it is a quotation form, in that case we want
             // to print it prettier
             if (head->value.pair.first->type == Lisp_Object_Type::Symbol) {
-                String identifier = head->value.pair.first->value.symbol;
+                // String identifier = head->value.pair.first->value.symbol;
 
 
                 auto symbol = head->value.pair.first;
@@ -525,23 +525,21 @@ namespace Slime {
     }
 
     proc print_current_execution() -> void {
-        using Globals::Current_Execution::cs;
-        using Globals::Current_Execution::pcs;
-        using Globals::Current_Execution::nass;
-        using Globals::Current_Execution::ams;
+        using Globals::Current_Execution;
+
         printf("cs:\n ");
-        for (u32 i = 0; i < cs.next_index; ++i)  {
-            char* t = lisp_object_to_string(cs.data[i], true);
+        for (u32 i = 0; i < Current_Execution.cs.next_index; ++i)  {
+            char* t = lisp_object_to_string(Current_Execution.cs.data[i], true);
             defer_free(t);
             printf(" %d: %s\n ", i, t);
         }
         printf("\npcs:\n ");
-        for (auto lo : pcs)  {
+        for (auto lo : Current_Execution.pcs)  {
             print(lo, true);
             printf("\n ");
         }
         printf("\nnnas:\n ");
-        for (auto nas: nass) {
+        for (auto nas: Current_Execution.nass) {
             printf("nas:\n ");
             for (auto na : nas)  {
                 printf("  - %s\n ", [&]
@@ -562,7 +560,7 @@ namespace Slime {
             }
         }
         printf("\nams:\n ");
-        for (auto am : ams)  {
+        for (auto am : Current_Execution.ams)  {
             printf("%d\n ", am);
         }
     }

src/main.cpp

@@ -16,6 +16,11 @@ s32 main(s32 argc, char* argv[]) {
             return res ? 0 : 1;
         } else if (Slime::string_equal(argv[1], "--generate-docs-file")) {
             Slime::Memory::init();
+            defer {
+                if_debug {
+                    Slime::Memory::free_everything();
+                }
+            };
             if (Slime::Globals::error) return 1;
             Slime::built_in_load(Slime::Memory::create_string("generate-docs-file.slime"));
         } else {

src/memory.cpp

@@ -131,13 +131,13 @@ namespace Slime::Memory {
         // Globals::load_path.dealloc();
         Globals::user_types.dealloc();
         Globals::docs.dealloc();
-        Globals::Current_Execution::envi_stack.dealloc();
-        Globals::Current_Execution::cs.dealloc();
-        Globals::Current_Execution::ams.dealloc();
-        Globals::Current_Execution::pcs.dealloc();
-        Globals::Current_Execution::nass.dealloc();
-        Globals::Current_Execution::ats.dealloc();
-        Globals::Current_Execution::mes.dealloc();
+        Globals::Current_Execution.envi_stack.dealloc();
+        Globals::Current_Execution.cs.dealloc();
+        Globals::Current_Execution.ams.dealloc();
+        Globals::Current_Execution.pcs.dealloc();
+        Globals::Current_Execution.nass.dealloc();
+        Globals::Current_Execution.ats.dealloc();
+        Globals::Current_Execution.mes.dealloc();
 
         free(Parser::standard_in.data);
 
@@ -177,6 +177,7 @@ namespace Slime::Memory {
         defer_free(file_name.data);
         try_void built_in_load(file_name);
     }
+
     proc init() -> void {
         profile_this();
 
@@ -184,11 +185,6 @@ namespace Slime::Memory {
         environment_memory.alloc(1024, 8);
         hashmap_memory.alloc(256, 8);
 
-        system_shutdown_hook << [&] {
-            if_debug {
-                Slime::Memory::free_everything();
-            }
-        };
         char* exe_path = get_exe_dir();
 
 
@@ -196,13 +192,13 @@ namespace Slime::Memory {
         global_keyword_table.alloc();
         file_to_env_map.alloc();
 
-        Globals::Current_Execution::envi_stack.alloc();
-        Globals::Current_Execution::cs.alloc();
-        Globals::Current_Execution::nass.alloc();
-        Globals::Current_Execution::pcs.alloc();
-        Globals::Current_Execution::ams.alloc();
-        Globals::Current_Execution::ats.alloc();
-        Globals::Current_Execution::mes.alloc();
+        Globals::Current_Execution.envi_stack.alloc();
+        Globals::Current_Execution.cs.alloc();
+        Globals::Current_Execution.nass.alloc();
+        Globals::Current_Execution.pcs.alloc();
+        Globals::Current_Execution.ams.alloc();
+        Globals::Current_Execution.ats.alloc();
+        Globals::Current_Execution.mes.alloc();
 
         Globals::docs.alloc();
         Globals::user_types.alloc();
@@ -221,7 +217,7 @@ namespace Slime::Memory {
 
         try_void Parser::standard_in = create_string("stdin");
 
-        Globals::Current_Execution::envi_stack.next_index = 0;
+        Globals::Current_Execution.envi_stack.next_index = 0;
         Environment* env;
         try_void env = create_built_ins_environment();
         push_environment(env);
@@ -271,6 +267,28 @@ namespace Slime::Memory {
         return node;
     }
 
+
+    proc create_lisp_object_continuation() -> Lisp_Object* {
+        using Globals::Current_Execution;
+        Lisp_Object* node;
+        try node = create_lisp_object();
+        node->type = Lisp_Object_Type::Continuation;
+        node->value.continuation = (Continuation*)malloc(sizeof(Continuation));
+        node->value.continuation->cs = Current_Execution.cs.clone();
+        node->value.continuation->pcs = Current_Execution.pcs.clone();
+        node->value.continuation->ams = Current_Execution.ams.clone();
+        node->value.continuation->ats = Current_Execution.ats.clone();
+        node->value.continuation->mes = Current_Execution.mes.clone();
+        node->value.continuation->envi_stack = Current_Execution.envi_stack.clone();
+
+        node->value.continuation->nass = Current_Execution.nass.clone();
+        for (u32 i = 0; i < node->value.continuation->nass.next_index; ++i) {
+            node->value.continuation->nass.data[i] = node->value.continuation->nass.data[i].clone();
+        }
+        return node;
+    }
+
+
     proc allocate_vector(u32 size) -> Lisp_Object* {
         Lisp_Object* ret = object_memory.allocate(size);
         if (!ret) {

src/parse.cpp

@@ -106,7 +106,7 @@ namespace Slime::Parser {
         Lisp_Object* ret;
         try ret = Memory::create_lisp_object(0.0);
 
-        sscanf(text+*index_in_text, "%lf", &ret->value.number);
+        sscanf(text+*index_in_text, "%Lf", &ret->value.number);
 
         u32 atom_length = get_atom_text_length(text, index_in_text);
         step_char(text, index_in_text, atom_length);

src/structs.cpp

@@ -20,7 +20,6 @@ namespace Slime {
         Continuation,
         Pointer,
         HashMap,
-        // OwningPointer,
         Function,
         Invalid_Garbage_Collected,
         Invalid_Under_Construction
@@ -61,8 +60,13 @@ namespace Slime {
     };
 
     struct Continuation {
-        Array_List<Lisp_Object*> call_stack;
-        Array_List<Environment*> envi_stack;
+        Array_List<Lisp_Object*>            cs; // call stack
+        Array_List<Lisp_Object*>           pcs; // program counter stack
+        Array_List<int>                    ams; // apply marker stack
+        Array_List<Array_List<NasAction>> nass; // next action stack stack
+        Array_List<Lambda<void()>>         ats; // and then stack
+        Array_List<Lisp_Object*>           mes; // macro expansion stack
+        Array_List<Environment*>           envi_stack;
     };
 
     struct String {

src/testing.cpp

@@ -47,13 +47,13 @@ namespace Slime {
 
 #define assert_equal_f64(variable, value)                       \
     if (fabs((f64)variable - (f64)value) > epsilon) {           \
-        print_assert_equal_fail(variable, value, f64, "%f");    \
+        print_assert_equal_fail(variable, value, f64, "%Lf");   \
         return fail;                                            \
     }
 
 #define assert_not_equal_f64(variable, value)                           \
     if (fabs((f64)variable - (f64)value) <= epsilon) {                  \
-        print_assert_not_equal_fail(variable, value, f64, "%f");        \
+        print_assert_not_equal_fail(variable, value, f64, "L%f");       \
         return fail;                                                    \
     }
 
@@ -556,6 +556,11 @@ namespace Slime {
         bool result = true;
         try Memory::init();
         try Memory::load_pre();
+        defer {
+            if_debug {
+                Slime::Memory::free_everything();
+            }
+        };
         push_environment(Memory::create_child_environment(
                              get_current_environment()));
         printf("-- Util --\n");
@@ -579,6 +584,7 @@ namespace Slime {
         printf("\n-- Test Files --\n");
 
         invoke_test_script("regression");
+        invoke_test_script("continuations");
         invoke_test_script("evaluation_of_default_args");
         invoke_test_script("case_and_cond");
         invoke_test_script("lexical_scope");

todo.org

@@ -1,3 +1,16 @@
+* DONE continuation test1
+  CLOSED: [2020-03-31 Di 23:07]
+
+#+begin_src scheme
+  (define add-2 ())
+  (+ 2 (call/cc (lambda (cont) (set! add-2 cont) 3)))
+  ;; = 5
+  (add-2 10)
+  ;; 12
+  (add-2 100)
+  ;; 102
+#+end_src
+
 * DONE docs as a external dict to make LO smaller
   CLOSED: [2020-03-29 So 20:00]
 * DONE and_then_action NAS_Action
@@ -24,12 +37,20 @@
   CLOSED: [2020-03-31 Di 11:58]
 * DONE update header files
   CLOSED: [2020-03-31 Di 11:58]
+* TODO assert list length for arguemns of macros
+  because all the args are in last of pcs, so we can assert length
+* TODO rename cs to stack
+* TODO #f #t #void
 * TODO define-syntax-shorthand
 (define-syntax-shorthand [ vector ] )
 (define-syntax-shorthand { hash-map } )
+* TODO revert ats to use funciton pointers if capturs are not working anyways
+ use the stack to store immediate results, so no captures are necessary
+* TODO continuation test2
+let a cont have a not expanded macro in cs and before calling the cont, expand the macro and let it
+bake in
+
 * TODO doc generation
-* TODO assert list length for arguemns of macros
- ???
 * TODO source code locations
 * TODO function let
 (let fac ([n 10])