felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implemented cintinuations and call/cc

Browse Source
This commit is contained in:
FelixBrendel
2020-04-03 22:47:48 +02:00
parent 419d28f4f2
commit 7a780615f9
21 changed files with 422 additions and 203 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.dir-locals.el
+2
View File
@@ -34,4 +34,6 @@
(c++-mode . ((eval . (company-clang-set-prefix "slime.h")) (c++-mode . ((eval . (company-clang-set-prefix "slime.h"))
(eval . (flycheck-mode 0)) (eval . (flycheck-mode 0))
(eval . (company-mode 0))
(eval . (rainbow-mode 0))
(eval . (setq c-backslash-max-column 99))))) (eval . (setq c-backslash-max-column 99)))))
3rd/ftb
+1 -1
Submodule 3rd/ftb updated: f35d5c6d90...07e89f3841
bin/tests/continuations.slime
+36
View File
@@ -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
+2 -1
View File
@@ -3,7 +3,8 @@
(define (make-counter) (define (make-counter)
(let ((var 0)) (let ((var 0))
(lambda () (lambda ()
(set! var (+ 1 var))))) (set! var (+ 1 var))
var)))
(define counter1 (make-counter)) (define counter1 (make-counter))
bin/tests/regression.slime
+7 -1
View File
@@ -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
+2 -2
View File
@@ -7,9 +7,9 @@ set exeName=slime.exe
taskkill /F /IM %exeName% > NUL 2> NUL taskkill /F /IM %exeName% > NUL 2> NUL
echo ---------- Compiling ---------- echo ---------- Compiling ----------
call cl ^ call clang-cl ^
../src/main.cpp^ ../src/main.cpp^
/I../3rd/ /DEBUG:FULL ^ /I../3rd/ ^
/D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^
/Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc
src/built_ins.cpp
+130 -70
View File
@@ -149,49 +149,130 @@ namespace Slime {
String file_name_built_ins = Memory::create_string(__FILE__); String file_name_built_ins = Memory::create_string(__FILE__);
defer_free(file_name_built_ins.data); 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") { define_macro((apply fun fun_args), "TODO") {
// NOTE(Felix): is has to be a macro because apply by // NOTE(Felix): is has to be a macro because apply by
// itself cannot return the result, we have to invoke eval // itself cannot return the result, we have to invoke eval
// and to prevent recursion, apply is a macro // and to prevent recursion, apply is a macro
profile_with_name("(apply)"); 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); try_void assert_list_length(args, 2);
Lisp_Object* fun = args->value.pair.first; Lisp_Object* fun = args->value.pair.first;
Lisp_Object* fun_args = args->value.pair.rest->value.pair.first; Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;
// 3. push args on the stack and apply // 3. push args on the stack and apply
ats.append([] { Current_Execution.ats.append([] {
Lisp_Object* args_as_list = cs[--cs.next_index]; // 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) { for_lisp_list (args_as_list) {
cs.append(it); Current_Execution.cs.append(it);
} }
pcs.append(Memory::nil); Current_Execution.pcs.append(Memory::nil);
(nass.end()-1)->append(NasAction::Step); (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 // 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 // NOTE(Felix): Flip the top 2 elements on cs because
// top is now the evaluated function, and below is the unevaluated args // top is now the evaluated function, and below is the unevaluated args
Lisp_Object* tmp = cs[cs.next_index-1]; Lisp_Object* tmp = Current_Execution.cs[Current_Execution.cs.next_index-1];
cs[cs.next_index-1] = cs[cs.next_index-2]; Current_Execution.cs[Current_Execution.cs.next_index-1] = Current_Execution.cs[Current_Execution.cs.next_index-2];
cs[cs.next_index-2] = tmp; Current_Execution.cs[Current_Execution.cs.next_index-2] = tmp;
(nass.end()-1)->append(NasAction::Eval); (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 // 1. Eval function and keep it on the stack, below it
// store the unevaluated argument list // store the unevaluated argument list
ams.append(cs.next_index); Current_Execution.ams.append(Current_Execution.cs.next_index);
cs.append(fun_args); Current_Execution.cs.append(fun_args);
cs.append(fun); Current_Execution.cs.append(fun);
(nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
}; };
define((get-counter), define((get-counter),
@@ -215,12 +296,12 @@ namespace Slime {
"Takes one argument, and evaluates it two times.") "Takes one argument, and evaluates it two times.")
{ {
profile_with_name("(eval)"); profile_with_name("(eval)");
using namespace Globals::Current_Execution; using Globals::Current_Execution;
// we know cs.data[cs.next_index] is allocated because the // we know cs.data[cs.next_index] is allocated because the
// macro cal lwas there just before // macro cal lwas there just before
cs.data[cs.next_index++] = pcs[--pcs.next_index]->value.pair.first; Current_Execution.cs.data[Current_Execution.cs.next_index++] = Current_Execution.pcs[--Current_Execution.pcs.next_index]->value.pair.first;
(nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
}; };
define_macro((begin . rest), define_macro((begin . rest),
@@ -228,18 +309,18 @@ namespace Slime {
"and returns the last result.") "and returns the last result.")
{ {
profile_with_name("(begin)"); profile_with_name("(begin)");
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];
u32 length = list_length(args); u32 length = list_length(args);
cs.reserve(length); Current_Execution.cs.reserve(length);
for_lisp_list(args) { for_lisp_list(args) {
cs.data[cs.next_index - 1 + (length - it_index)] = it; Current_Execution.cs.data[Current_Execution.cs.next_index - 1 + (length - it_index)] = it;
(nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::Pop); (Current_Execution.nass.end()-1)->append(NasAction::Pop);
} }
--(nass.end()-1)->next_index; --(Current_Execution.nass.end()-1)->next_index;
cs.next_index += length; Current_Execution.cs.next_index += length;
}; };
define_macro((if test then_part else_part), define_macro((if test then_part else_part),
"Takes 3 arguments. If the first arguments evaluates to a truthy " "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.") "it will evaluete the third one and return them respectively.")
{ {
profile_with_name("(if)"); profile_with_name("(if)");
using namespace Globals::Current_Execution; using Globals::Current_Execution;
/* | | | <test> | /* | | | <test> |
| | -> | <then> | | | -> | <then> |
| <if> | | <else> | | <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; Lisp_Object* test = args->value.pair.first;
args = args->value.pair.rest; args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Pair); try_void assert_type(args, Lisp_Object_Type::Pair);
@@ -263,14 +344,13 @@ namespace Slime {
args = args->value.pair.rest; args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Nil); try_void assert_type(args, Lisp_Object_Type::Nil);
cs.append(alternative); Current_Execution.cs.append(alternative);
cs.append(consequence); Current_Execution.cs.append(consequence);
cs.append(test); Current_Execution.cs.append(test);
(nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::If);
(nass.end()-1)->append(NasAction::Eval);
(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), "") { define_macro((define definee . args), "") {
// NOTE(Felix): define has to be a macro, because we need // 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 // want to recursivly evaluate the value, we use a macro
// and a NasAction. // and a NasAction.
profile_with_name("(define)"); 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; Lisp_Object* definee = form->value.pair.first;
form = form->value.pair.rest; form = form->value.pair.rest;
if (definee->type == Lisp_Object_Type::Symbol) { if (definee->type == Lisp_Object_Type::Symbol) {
@@ -302,10 +382,10 @@ namespace Slime {
// TODO docs (maybe with hooks) we have to attach // TODO docs (maybe with hooks) we have to attach
// the docs to the result of evaluating // the docs to the result of evaluating
} }
cs.append(definee); Current_Execution.cs.append(definee);
cs.append(thing); Current_Execution.cs.append(thing);
(nass.end()-1)->append(NasAction::Define_Var); (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
(nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval);
} break; } break;
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); 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); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
define_symbol(definee->value.pair.first, func); define_symbol(definee->value.pair.first, func);
cs.append(definee->value.pair.first); Current_Execution.cs.append(definee->value.pair.first);
} break; } break;
default: { default: {
create_generic_error("you can only define symbols"); create_generic_error("you can only define symbols");
@@ -356,7 +436,7 @@ namespace Slime {
define_special((with-debug-log . rest), "") { define_special((with-debug-log . rest), "") {
profile_with_name("(enable-debug-log)"); profile_with_name("(enable-debug-log)");
fetch(rest); fetch(rest);
Lisp_Object* result; Lisp_Object* result = Memory::nil;
Globals::debug_log = true; Globals::debug_log = true;
in_caller_env { in_caller_env {
for_lisp_list(rest) { for_lisp_list(rest) {
@@ -679,26 +759,6 @@ namespace Slime {
return val; 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") { define((set-car! target source), "TODO") {
profile_with_name("(set-car!)"); profile_with_name("(set-car!)");
fetch(target, source); fetch(target, source);
@@ -1108,12 +1168,12 @@ namespace Slime {
fetch(sep, end, repr, things); fetch(sep, end, repr, things);
if (things != Memory::nil) { if (things != Memory::nil) {
bool print_repr = repr != Memory::nil; bool print_repr = (repr != Memory::nil);
print(things->value.pair.first, repr); print(things->value.pair.first, print_repr);
for_lisp_list(things->value.pair.rest) { for_lisp_list(things->value.pair.rest) {
print(sep); print(sep);
print(it, repr); print(it, print_repr);
} }
} }
src/define_macros.hpp
+2 -2
View File
@@ -130,8 +130,8 @@
#define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro, c_macro_body = []() -> void) #define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro, c_macro_body = []() -> void)
#define in_caller_env fluid_let( \ #define in_caller_env fluid_let( \
Globals::Current_Execution::envi_stack.next_index, \ Globals::Current_Execution.envi_stack.next_index, \
Globals::Current_Execution::envi_stack.next_index-1) Globals::Current_Execution.envi_stack.next_index-1)
/* /*
src/env.cpp
+5 -8
View File
@@ -54,23 +54,20 @@ namespace Slime {
} }
inline proc push_environment(Environment* env) -> void { inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution; Globals::Current_Execution.envi_stack.append(env);
envi_stack.append(env);
} }
inline proc pop_environment() -> void { inline proc pop_environment() -> void {
using namespace Globals::Current_Execution; --Globals::Current_Execution.envi_stack.next_index;
--envi_stack.next_index;
} }
inline proc get_root_environment() -> Environment* { inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution; return Globals::Current_Execution.envi_stack.data[0];
return envi_stack.data[0];
} }
inline proc get_current_environment() -> Environment* { inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution; return Globals::Current_Execution.envi_stack.data[
return envi_stack.data[envi_stack.next_index-1]; Globals::Current_Execution.envi_stack.next_index-1];
} }
proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
src/error.cpp
+5 -5
View File
@@ -10,17 +10,17 @@ namespace Slime {
proc create_error(const char* c_func_name, const char* c_file_name, proc create_error(const char* c_func_name, const char* c_file_name,
u32 c_file_line, Lisp_Object* type, String message) -> void u32 c_file_line, Lisp_Object* type, String message) -> void
{ {
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
}
using Globals::error; using Globals::error;
delete_error();
error = (Error*)malloc(sizeof(Error)) ; error = (Error*)malloc(sizeof(Error)) ;
error->type = type; error->type = type;
error->message = message; error->message = message;
log_error(); log_error();
if (Globals::breaking_on_errors) {
debug_break();
}
if (Globals::log_level > Log_Level::None) { if (Globals::log_level > Log_Level::None) {
// c error location // c error location
printf("in"); printf("in");
src/eval.cpp
+130 -60
View File
@@ -6,7 +6,7 @@ namespace Slime {
u32 arg_end) -> Environment* u32 arg_end) -> Environment*
{ {
profile_this(); profile_this();
using namespace Globals::Current_Execution; using Globals::Current_Execution;
u32 index_of_next_arg = arg_start; u32 index_of_next_arg = arg_start;
bool is_c_function = function->value.function->is_c; 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 // programmers to know what they are doing. Bold claim I
// know. // know.
if (is_c_function) { 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 { } 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; ++index_of_next_arg;
} }
@@ -56,11 +56,11 @@ namespace Slime {
++obligatory_keywords_count; ++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 // check if this one is even an accepted keyword
bool accepted = false; bool accepted = false;
for (u32 i = 0; i < arg_spec->keyword.keywords.next_index; ++i) { 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; accepted = true;
break; break;
} }
@@ -75,13 +75,13 @@ namespace Slime {
"The function does not take the keyword argument ':%s'\n" "The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n" "and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.", "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; return nullptr;
} }
// This is an accepted kwarg; check if it was already // This is an accepted kwarg; check if it was already
// read in // read in
for (u32 i = 0; i < read_in_keywords.next_index; ++i) { 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 // if we already read it in but also finished
// all other kwargs, then count it as rest and // all other kwargs, then count it as rest and
@@ -92,7 +92,7 @@ namespace Slime {
// in, it is an error // in, it is an error
create_generic_error( create_generic_error(
"The function already read the keyword argument ':%s'", "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; return nullptr;
} }
} }
@@ -102,19 +102,19 @@ namespace Slime {
if (index_of_next_arg+1 == arg_end) { if (index_of_next_arg+1 == arg_end) {
create_generic_error( create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.", "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; return nullptr;
} }
// if not set it and then add it to the array list // 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); try sym = Memory::get_symbol(key->value.symbol);
++index_of_next_arg; ++index_of_next_arg;
if (is_c_function) { 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 { } 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); read_in_keywords.append(key);
@@ -171,10 +171,10 @@ namespace Slime {
} else { } else {
if (arg_spec->rest) { if (arg_spec->rest) {
Lisp_Object* list; 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; Lisp_Object* head = list;
for (++index_of_next_arg;index_of_next_arg < arg_end; ++index_of_next_arg) { 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; head = head->value.pair.rest;
} }
define_symbol(arg_spec->rest, list, env); define_symbol(arg_spec->rest, list, env);
@@ -313,13 +313,13 @@ namespace Slime {
proc eval_expr(Lisp_Object* expr) -> Lisp_Object* { proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
profile_this(); profile_this();
using namespace Globals::Current_Execution; using Globals::Current_Execution;
nass.reserve(1); Current_Execution.nass.reserve(1);
Array_List<NasAction>* nas = nass.data+(nass.next_index++); Array_List<NasAction>* nas = Current_Execution.nass.data+(Current_Execution.nass.next_index++);
nas->alloc(); nas->alloc();
defer { defer {
--nass.next_index; --Current_Execution.nass.next_index;
nas->dealloc(); nas->dealloc();
}; };
@@ -332,13 +332,13 @@ namespace Slime {
}; };
proc push_pc_on_cs = [&] { proc push_pc_on_cs = [&] {
for_lisp_list (pcs.data[pcs.next_index-1]) { for_lisp_list (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]) {
cs.append(it); 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); nas->append(NasAction::Eval);
NasAction current_action; NasAction current_action;
@@ -350,35 +350,36 @@ namespace Slime {
current_action = nas->data[--nas->next_index]; current_action = nas->data[--nas->next_index];
switch (current_action) { switch (current_action) {
case NasAction::Pop: { case NasAction::Pop: {
--cs.next_index; --Current_Execution.cs.next_index;
} break; } break;
case NasAction::And_Then_Action: { case NasAction::And_Then_Action: {
ats.data[--ats.next_index](); Current_Execution.ats.data[--Current_Execution.ats.next_index]();
} break; } break;
case NasAction::Pop_Environment: { case NasAction::Pop_Environment: {
pop_environment(); pop_environment();
} break; } break;
case NasAction::Eval: { 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; Lisp_Object_Type type = pc->type;
switch (type) { switch (type) {
case Lisp_Object_Type::Symbol: { 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; } break;
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
cs.data[cs.next_index-1] = pc->value.pair.first; Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
ams.append(cs.next_index-1); Current_Execution.ams.append(Current_Execution.cs.next_index-1);
if_debug { if_debug {
if (ams.next_index >= 2) { if (Current_Execution.ams.next_index >= 2) {
assert("invalid ams state", assert("invalid ams state",
ams.data[ams.next_index-2] <= Current_Execution.ams.data[Current_Execution.ams.next_index-2] <=
ams.data[ams.next_index-1]); Current_Execution.ams.data[Current_Execution.ams.next_index-1]);
} }
} }
pcs.append(pc->value.pair.rest); Current_Execution.pcs.append(pc->value.pair.rest);
mes.append(pc); Current_Execution.mes.append(pc);
nas->append(NasAction::TM); nas->append(NasAction::TM);
nas->append(NasAction::Eval); nas->append(NasAction::Eval);
} break; } break;
@@ -389,18 +390,19 @@ namespace Slime {
} }
} break; } break;
case NasAction::Macro_Write_Back: { 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; } break;
case NasAction::TM: { 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; Lisp_Object_Type type = pc->type;
switch (type) { switch (type) {
case Lisp_Object_Type::Function: { case Lisp_Object_Type::Function: {
if(pc->value.function->is_c) { if(pc->value.function->is_c) {
if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) { if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
--cs.next_index; // remove the macro call from cs --Current_Execution.cs.next_index; // remove the macro call from cs
--ams.next_index; // remove the apply marker for the macro --Current_Execution.ams.next_index; // remove the apply marker for the macro
try pc->value.function->body.c_macro_body(); try pc->value.function->body.c_macro_body();
} else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial) } else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
{ {
@@ -412,7 +414,7 @@ namespace Slime {
} else { } else {
nas->append(NasAction::Step); nas->append(NasAction::Step);
} }
--mes.next_index; --Current_Execution.mes.next_index;
} else { } else {
if (pc->value.function->type.lisp_function_type == if (pc->value.function->type.lisp_function_type ==
Lisp_Function_Type::Macro) Lisp_Function_Type::Macro)
@@ -422,16 +424,74 @@ namespace Slime {
nas->append(NasAction::Macro_Write_Back); nas->append(NasAction::Macro_Write_Back);
nas->append(NasAction::Step); nas->append(NasAction::Step);
} else { } else {
--mes.next_index; --Current_Execution.mes.next_index;
nas->append(NasAction::Step); nas->append(NasAction::Step);
} }
} }
} break; } 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: { default: {
char* t = lisp_object_to_string(pc); char* t = lisp_object_to_string(pc);
defer { defer_free(t);
free(t);
};
create_generic_error("The first element of the pair was not a function but: %s in %s", create_generic_error("The first element of the pair was not a function but: %s in %s",
lisp_object_type_to_string(type), t); lisp_object_type_to_string(type), t);
return nullptr; return nullptr;
@@ -440,31 +500,31 @@ namespace Slime {
} break; } break;
case NasAction::Step: { case NasAction::Step: {
if (pcs.data[pcs.next_index-1] == Memory::nil) { if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
--pcs.next_index; --Current_Execution.pcs.next_index;
u32 am = ams.data[--ams.next_index]; u32 am = Current_Execution.ams.data[--Current_Execution.ams.next_index];
Lisp_Object* function = cs.data[am]; Lisp_Object* function = Current_Execution.cs.data[am];
try assert_type(function, Lisp_Object_Type::Function); try assert_type(function, Lisp_Object_Type::Function);
Environment* extended_env; Environment* extended_env;
try extended_env = create_extended_environment_for_function_application_nrc( try extended_env = create_extended_environment_for_function_application_nrc(
function, am+1, cs.next_index); function, am+1, Current_Execution.cs.next_index);
cs.next_index = am; Current_Execution.cs.next_index = am;
push_environment(extended_env); push_environment(extended_env);
if (function->value.function->is_c) { if (function->value.function->is_c) {
if (function->value.function->type.c_function_type == C_Function_Type::cMacro) if (function->value.function->type.c_function_type == C_Function_Type::cMacro)
try function->value.function->body.c_macro_body(); try function->value.function->body.c_macro_body();
else else
try cs.append(function->value.function->body.c_body()); try Current_Execution.cs.append(function->value.function->body.c_body());
pop_environment(); pop_environment();
} else { } else {
nas->append(NasAction::Pop_Environment); nas->append(NasAction::Pop_Environment);
nas->append(NasAction::Eval); nas->append(NasAction::Eval);
cs.append(function->value.function->body.lisp_body); Current_Execution.cs.append(function->value.function->body.lisp_body);
} }
} else { } else {
cs.append(pcs.data[pcs.next_index-1]->value.pair.first); Current_Execution.cs.append(Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.first);
pcs.data[pcs.next_index-1] = pcs.data[pcs.next_index-1]->value.pair.rest; 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::Step);
nas->append(NasAction::Eval); nas->append(NasAction::Eval);
} }
@@ -474,29 +534,29 @@ namespace Slime {
| <then> | | <then> |
| <else> | | <else> |
| .... | */ | .... | */
cs.next_index -= 2; Current_Execution.cs.next_index -= 2;
// NOTE(Felix): for false it is sufficent to pop 2 for // NOTE(Felix): for false it is sufficent to pop 2 for
// true we have to copy the then part to the new top // true we have to copy the then part to the new top
// of the stack // of the stack
if (cs.data[cs.next_index+1] != Memory::nil) { if (Current_Execution.cs.data[Current_Execution.cs.next_index+1] != Memory::nil) {
cs.data[cs.next_index-1] = cs.data[cs.next_index]; Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Current_Execution.cs.data[Current_Execution.cs.next_index];
} }
} break; } break;
case NasAction::Define_Var: { case NasAction::Define_Var: {
/* | <thing> | /* | <thing> |
| <symbol> | | <symbol> |
| .... | */ | .... | */
cs.next_index -= 1; Current_Execution.cs.next_index -= 1;
try assert_type(cs.data[cs.next_index-1], Lisp_Object_Type::Symbol); try assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(cs.data[cs.next_index-1], cs.data[cs.next_index]); try define_symbol(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Current_Execution.cs.data[Current_Execution.cs.next_index]);
cs.data[cs.next_index-1] = Memory::t; Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Memory::t;
} }
} }
} }
// debug_step(); // 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 { inline proc is_truthy(Lisp_Object* expression) -> bool {
@@ -506,6 +566,11 @@ namespace Slime {
proc interprete_file (char* file_name) -> Lisp_Object* { proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(); try Memory::init();
try Memory::load_pre(); try Memory::load_pre();
defer {
if_debug {
Slime::Memory::free_everything();
}
};
Lisp_Object* result; Lisp_Object* result;
@@ -517,6 +582,11 @@ namespace Slime {
proc interprete_stdin() -> void { proc interprete_stdin() -> void {
try_void Memory::init(); try_void Memory::init();
try_void Memory::load_pre(); try_void Memory::load_pre();
defer {
if_debug {
Slime::Memory::free_everything();
}
};
printf("Welcome to the lispy interpreter.\n%s\n", version_string); printf("Welcome to the lispy interpreter.\n%s\n", version_string);
src/forward_decls.cpp
+6 -4
View File
@@ -48,6 +48,7 @@ namespace Slime {
Lisp_Object* get_keyword(const char*); Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(f64); Lisp_Object* create_lisp_object(f64);
Lisp_Object* create_lisp_object(const char*); 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* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, 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 char* bin_path;
extern Log_Level log_level; extern Log_Level log_level;
extern Array_List<void*> load_path; extern Array_List<void*> load_path;
namespace Current_Execution { // namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack; // extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack; // extern Array_List<Environment*> envi_stack;
} // }
extern Continuation Current_Execution;
extern Error* error; extern Error* error;
extern bool breaking_on_errors; extern bool breaking_on_errors;
} }
src/gc.cpp
+3 -2
View File
@@ -79,11 +79,12 @@ namespace Slime::GC {
} }
proc garbage_collect() -> void { proc garbage_collect() -> void {
using Globals::Current_Execution;
profile_this(); profile_this();
++current_mark; ++current_mark;
for (auto it : protected_environments) maybe_mark(it); for (auto it : protected_environments) maybe_mark(it);
for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it); for (auto it : Current_Execution.envi_stack) maybe_mark(it);
} }
proc gc_init_and_go() -> void { proc gc_init_and_go() -> void {
src/globals.cpp
+1 -9
View File
@@ -24,15 +24,7 @@ namespace Slime::Globals {
Hash_Map<void*, Source_Code_Location> source_code_locations; Hash_Map<void*, Source_Code_Location> source_code_locations;
Hash_Map<void*, Lisp_Object*> user_types; Hash_Map<void*, Lisp_Object*> user_types;
namespace Current_Execution { Continuation 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;
}
Error* error = nullptr; Error* error = nullptr;
#ifdef _DONT_BREAK_ON_ERRORS #ifdef _DONT_BREAK_ON_ERRORS
src/io.cpp
+8 -10
View File
@@ -435,7 +435,7 @@ namespace Slime {
// first check if it is a quotation form, in that case we want // first check if it is a quotation form, in that case we want
// to print it prettier // to print it prettier
if (head->value.pair.first->type == Lisp_Object_Type::Symbol) { 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; auto symbol = head->value.pair.first;
@@ -525,23 +525,21 @@ namespace Slime {
} }
proc print_current_execution() -> void { proc print_current_execution() -> void {
using Globals::Current_Execution::cs; using Globals::Current_Execution;
using Globals::Current_Execution::pcs;
using Globals::Current_Execution::nass;
using Globals::Current_Execution::ams;
printf("cs:\n "); printf("cs:\n ");
for (u32 i = 0; i < cs.next_index; ++i) { for (u32 i = 0; i < Current_Execution.cs.next_index; ++i) {
char* t = lisp_object_to_string(cs.data[i], true); char* t = lisp_object_to_string(Current_Execution.cs.data[i], true);
defer_free(t); defer_free(t);
printf(" %d: %s\n ", i, t); printf(" %d: %s\n ", i, t);
} }
printf("\npcs:\n "); printf("\npcs:\n ");
for (auto lo : pcs) { for (auto lo : Current_Execution.pcs) {
print(lo, true); print(lo, true);
printf("\n "); printf("\n ");
} }
printf("\nnnas:\n "); printf("\nnnas:\n ");
for (auto nas: nass) { for (auto nas: Current_Execution.nass) {
printf("nas:\n "); printf("nas:\n ");
for (auto na : nas) { for (auto na : nas) {
printf(" - %s\n ", [&] printf(" - %s\n ", [&]
@@ -562,7 +560,7 @@ namespace Slime {
} }
} }
printf("\nams:\n "); printf("\nams:\n ");
for (auto am : ams) { for (auto am : Current_Execution.ams) {
printf("%d\n ", am); printf("%d\n ", am);
} }
} }
src/main.cpp
+5
View File
@@ -16,6 +16,11 @@ s32 main(s32 argc, char* argv[]) {
return res ? 0 : 1; return res ? 0 : 1;
} else if (Slime::string_equal(argv[1], "--generate-docs-file")) { } else if (Slime::string_equal(argv[1], "--generate-docs-file")) {
Slime::Memory::init(); Slime::Memory::init();
defer {
if_debug {
Slime::Memory::free_everything();
}
};
if (Slime::Globals::error) return 1; if (Slime::Globals::error) return 1;
Slime::built_in_load(Slime::Memory::create_string("generate-docs-file.slime")); Slime::built_in_load(Slime::Memory::create_string("generate-docs-file.slime"));
} else { } else {
src/memory.cpp
+38 -20
View File
@@ -131,13 +131,13 @@ namespace Slime::Memory {
// Globals::load_path.dealloc(); // Globals::load_path.dealloc();
Globals::user_types.dealloc(); Globals::user_types.dealloc();
Globals::docs.dealloc(); Globals::docs.dealloc();
Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution.envi_stack.dealloc();
Globals::Current_Execution::cs.dealloc(); Globals::Current_Execution.cs.dealloc();
Globals::Current_Execution::ams.dealloc(); Globals::Current_Execution.ams.dealloc();
Globals::Current_Execution::pcs.dealloc(); Globals::Current_Execution.pcs.dealloc();
Globals::Current_Execution::nass.dealloc(); Globals::Current_Execution.nass.dealloc();
Globals::Current_Execution::ats.dealloc(); Globals::Current_Execution.ats.dealloc();
Globals::Current_Execution::mes.dealloc(); Globals::Current_Execution.mes.dealloc();
free(Parser::standard_in.data); free(Parser::standard_in.data);
@@ -177,6 +177,7 @@ namespace Slime::Memory {
defer_free(file_name.data); defer_free(file_name.data);
try_void built_in_load(file_name); try_void built_in_load(file_name);
} }
proc init() -> void { proc init() -> void {
profile_this(); profile_this();
@@ -184,11 +185,6 @@ namespace Slime::Memory {
environment_memory.alloc(1024, 8); environment_memory.alloc(1024, 8);
hashmap_memory.alloc(256, 8); hashmap_memory.alloc(256, 8);
system_shutdown_hook << [&] {
if_debug {
Slime::Memory::free_everything();
}
};
char* exe_path = get_exe_dir(); char* exe_path = get_exe_dir();
@@ -196,13 +192,13 @@ namespace Slime::Memory {
global_keyword_table.alloc(); global_keyword_table.alloc();
file_to_env_map.alloc(); file_to_env_map.alloc();
Globals::Current_Execution::envi_stack.alloc(); Globals::Current_Execution.envi_stack.alloc();
Globals::Current_Execution::cs.alloc(); Globals::Current_Execution.cs.alloc();
Globals::Current_Execution::nass.alloc(); Globals::Current_Execution.nass.alloc();
Globals::Current_Execution::pcs.alloc(); Globals::Current_Execution.pcs.alloc();
Globals::Current_Execution::ams.alloc(); Globals::Current_Execution.ams.alloc();
Globals::Current_Execution::ats.alloc(); Globals::Current_Execution.ats.alloc();
Globals::Current_Execution::mes.alloc(); Globals::Current_Execution.mes.alloc();
Globals::docs.alloc(); Globals::docs.alloc();
Globals::user_types.alloc(); Globals::user_types.alloc();
@@ -221,7 +217,7 @@ namespace Slime::Memory {
try_void Parser::standard_in = create_string("stdin"); 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; Environment* env;
try_void env = create_built_ins_environment(); try_void env = create_built_ins_environment();
push_environment(env); push_environment(env);
@@ -271,6 +267,28 @@ namespace Slime::Memory {
return node; 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* { proc allocate_vector(u32 size) -> Lisp_Object* {
Lisp_Object* ret = object_memory.allocate(size); Lisp_Object* ret = object_memory.allocate(size);
if (!ret) { if (!ret) {
src/parse.cpp
+1 -1
View File
@@ -106,7 +106,7 @@ namespace Slime::Parser {
Lisp_Object* ret; Lisp_Object* ret;
try ret = Memory::create_lisp_object(0.0); 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); u32 atom_length = get_atom_text_length(text, index_in_text);
step_char(text, index_in_text, atom_length); step_char(text, index_in_text, atom_length);
src/structs.cpp
+7 -3
View File
@@ -20,7 +20,6 @@ namespace Slime {
Continuation, Continuation,
Pointer, Pointer,
HashMap, HashMap,
// OwningPointer,
Function, Function,
Invalid_Garbage_Collected, Invalid_Garbage_Collected,
Invalid_Under_Construction Invalid_Under_Construction
@@ -61,8 +60,13 @@ namespace Slime {
}; };
struct Continuation { struct Continuation {
Array_List<Lisp_Object*> call_stack; Array_List<Lisp_Object*> cs; // call stack
Array_List<Environment*> envi_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 { struct String {
src/testing.cpp
+8 -2
View File
@@ -47,13 +47,13 @@ namespace Slime {
#define assert_equal_f64(variable, value) \ #define assert_equal_f64(variable, value) \
if (fabs((f64)variable - (f64)value) > epsilon) { \ 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; \ return fail; \
} }
#define assert_not_equal_f64(variable, value) \ #define assert_not_equal_f64(variable, value) \
if (fabs((f64)variable - (f64)value) <= epsilon) { \ 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; \ return fail; \
} }
@@ -556,6 +556,11 @@ namespace Slime {
bool result = true; bool result = true;
try Memory::init(); try Memory::init();
try Memory::load_pre(); try Memory::load_pre();
defer {
if_debug {
Slime::Memory::free_everything();
}
};
push_environment(Memory::create_child_environment( push_environment(Memory::create_child_environment(
get_current_environment())); get_current_environment()));
printf("-- Util --\n"); printf("-- Util --\n");
@@ -579,6 +584,7 @@ namespace Slime {
printf("\n-- Test Files --\n"); printf("\n-- Test Files --\n");
invoke_test_script("regression"); invoke_test_script("regression");
invoke_test_script("continuations");
invoke_test_script("evaluation_of_default_args"); invoke_test_script("evaluation_of_default_args");
invoke_test_script("case_and_cond"); invoke_test_script("case_and_cond");
invoke_test_script("lexical_scope"); invoke_test_script("lexical_scope");
todo.org
+23 -2
View File
@@ -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 * DONE docs as a external dict to make LO smaller
CLOSED: [2020-03-29 So 20:00] CLOSED: [2020-03-29 So 20:00]
* DONE and_then_action NAS_Action * DONE and_then_action NAS_Action
@@ -24,12 +37,20 @@
CLOSED: [2020-03-31 Di 11:58] CLOSED: [2020-03-31 Di 11:58]
* DONE update header files * DONE update header files
CLOSED: [2020-03-31 Di 11:58] 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 * TODO define-syntax-shorthand
(define-syntax-shorthand [ vector ] ) (define-syntax-shorthand [ vector ] )
(define-syntax-shorthand { hash-map } ) (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 doc generation
* TODO assert list length for arguemns of macros
???
* TODO source code locations * TODO source code locations
* TODO function let * TODO function let
(let fac ([n 10]) (let fac ([n 10])