From 7a780615f9b3ad39de034575753652b9f2892cec Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Fri, 3 Apr 2020 22:47:48 +0200 Subject: [PATCH] Implemented cintinuations and call/cc --- .dir-locals.el | 2 + 3rd/ftb | 2 +- bin/tests/continuations.slime | 36 ++++++ bin/tests/lexical_scope.slime | 3 +- bin/tests/regression.slime | 8 +- build.bat | 4 +- src/built_ins.cpp | 200 ++++++++++++++++++++++------------ src/define_macros.hpp | 4 +- src/env.cpp | 13 +-- src/error.cpp | 10 +- src/eval.cpp | 190 ++++++++++++++++++++++---------- src/forward_decls.cpp | 10 +- src/gc.cpp | 5 +- src/globals.cpp | 10 +- src/io.cpp | 18 ++- src/main.cpp | 5 + src/memory.cpp | 58 ++++++---- src/parse.cpp | 2 +- src/structs.cpp | 10 +- src/testing.cpp | 10 +- todo.org | 25 ++++- 21 files changed, 422 insertions(+), 203 deletions(-) create mode 100644 bin/tests/continuations.slime diff --git a/.dir-locals.el b/.dir-locals.el index cf53c5f..6b3fa20 100644 --- a/.dir-locals.el +++ b/.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))))) diff --git a/3rd/ftb b/3rd/ftb index f35d5c6..07e89f3 160000 --- a/3rd/ftb +++ b/3rd/ftb @@ -1 +1 @@ -Subproject commit f35d5c6d900447fc8d29e68abe4838b788f067b9 +Subproject commit 07e89f384155abd4ec231edc173ce0d03244b1cf diff --git a/bin/tests/continuations.slime b/bin/tests/continuations.slime new file mode 100644 index 0000000..2e83130 --- /dev/null +++ b/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)) diff --git a/bin/tests/lexical_scope.slime b/bin/tests/lexical_scope.slime index 6aba474..b8be046 100644 --- a/bin/tests/lexical_scope.slime +++ b/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)) diff --git a/bin/tests/regression.slime b/bin/tests/regression.slime index 759c7ee..0261369 100644 --- a/bin/tests/regression.slime +++ b/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)) diff --git a/build.bat b/build.bat index 6a1f7eb..64a7964 100644 --- a/build.bat +++ b/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 diff --git a/src/built_ins.cpp b/src/built_ins.cpp index dfd928c..4d49dac 100644 --- a/src/built_ins.cpp +++ b/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; /* | | | | | | -> | | | | | | | .... | | ...... | */ - 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); } } diff --git a/src/define_macros.hpp b/src/define_macros.hpp index bcfe95d..478da18 100644 --- a/src/define_macros.hpp +++ b/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) /* diff --git a/src/env.cpp b/src/env.cpp index 1a36669..6e81979 100644 --- a/src/env.cpp +++ b/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* { diff --git a/src/error.cpp b/src/error.cpp index 2230c67..0ef4469 100644 --- a/src/error.cpp +++ b/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"); diff --git a/src/eval.cpp b/src/eval.cpp index 963e3c4..0a34b13 100644 --- a/src/eval.cpp +++ b/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* nas = nass.data+(nass.next_index++); + Current_Execution.nass.reserve(1); + Array_List* 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 { | | | | | .... | */ - 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: { /* | | | | | .... | */ - 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); diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index fec239c..5982bad 100644 --- a/src/forward_decls.cpp +++ b/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 load_path; - namespace Current_Execution { - extern Array_List call_stack; - extern Array_List envi_stack; - } + // namespace Current_Execution { + // extern Array_List call_stack; + // extern Array_List envi_stack; + // } + extern Continuation Current_Execution; extern Error* error; extern bool breaking_on_errors; } diff --git a/src/gc.cpp b/src/gc.cpp index 0537ce7..394e89d 100644 --- a/src/gc.cpp +++ b/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 { diff --git a/src/globals.cpp b/src/globals.cpp index 1eac348..9ddb8ce 100644 --- a/src/globals.cpp +++ b/src/globals.cpp @@ -24,15 +24,7 @@ namespace Slime::Globals { Hash_Map source_code_locations; Hash_Map user_types; - namespace Current_Execution { - Array_List cs; // call stack - Array_List pcs; // program counter stack - Array_List ams; // apply marker stack - Array_List> nass; // next action stack stack - Array_List> ats; // and then stack - Array_List mes; // macro expansion stack - Array_List envi_stack; - } + Continuation Current_Execution; Error* error = nullptr; #ifdef _DONT_BREAK_ON_ERRORS diff --git a/src/io.cpp b/src/io.cpp index 826c1db..2162f6a 100644 --- a/src/io.cpp +++ b/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); } } diff --git a/src/main.cpp b/src/main.cpp index 5647454..543a27e 100644 --- a/src/main.cpp +++ b/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 { diff --git a/src/memory.cpp b/src/memory.cpp index c872a19..2ef5c2b 100644 --- a/src/memory.cpp +++ b/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) { diff --git a/src/parse.cpp b/src/parse.cpp index a461235..710e7c4 100644 --- a/src/parse.cpp +++ b/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); diff --git a/src/structs.cpp b/src/structs.cpp index cc2b886..70d0b94 100644 --- a/src/structs.cpp +++ b/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 call_stack; - Array_List envi_stack; + Array_List cs; // call stack + Array_List pcs; // program counter stack + Array_List ams; // apply marker stack + Array_List> nass; // next action stack stack + Array_List> ats; // and then stack + Array_List mes; // macro expansion stack + Array_List envi_stack; }; struct String { diff --git a/src/testing.cpp b/src/testing.cpp index e4481de..611e7e9 100644 --- a/src/testing.cpp +++ b/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"); diff --git a/todo.org b/todo.org index 63ee385..998da51 100644 --- a/todo.org +++ b/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])