felix
/
slime
1
0
Rozštěpit 0
Zdrojový kód Úkoly 0 Požadavky na natažení 0 Vydání 0 Wiki Aktivita
Procházet zdrojové kódy

Implemented cintinuations and call/cc

master
FelixBrendel před 6 roky
rodič
419d28f4f2
revize
7a780615f9
21 změnil soubory, kde provedl 422 přidání a 203 odebrání
Rozdělené zobrazení
Diff Options
Zobrazit statistiky Stáhněte soubor opravy Stáhněte rozdílový soubor
  1. +2
    -0
      .dir-locals.el
  2. +1
    -1
      3rd/ftb
  3. +36
    -0
      bin/tests/continuations.slime
  4. +2
    -1
      bin/tests/lexical_scope.slime
  5. +7
    -1
      bin/tests/regression.slime
  6. +2
    -2
      build.bat
  7. +130
    -70
      src/built_ins.cpp
  8. +2
    -2
      src/define_macros.hpp
  9. +5
    -8
      src/env.cpp
  10. +5
    -5
      src/error.cpp
  11. +130
    -60
      src/eval.cpp
  12. +6
    -4
      src/forward_decls.cpp
  13. +3
    -2
      src/gc.cpp
  14. +1
    -9
      src/globals.cpp
  15. +8
    -10
      src/io.cpp
  16. +5
    -0
      src/main.cpp
  17. +38
    -20
      src/memory.cpp
  18. +1
    -1
      src/parse.cpp
  19. +7
    -3
      src/structs.cpp
  20. +8
    -2
      src/testing.cpp
  21. +23
    -2
      todo.org

+ 2
- 0
.dir-locals.el Zobrazit soubor

@@ -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)))))

+ 1
- 1
3rd/ftb

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

+ 36
- 0
bin/tests/continuations.slime Zobrazit soubor

@@ -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))

+ 2
- 1
bin/tests/lexical_scope.slime Zobrazit soubor

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


+ 7
- 1
bin/tests/regression.slime Zobrazit soubor

@@ -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))

+ 2
- 2
build.bat Zobrazit soubor

@@ -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


+ 130
- 70
src/built_ins.cpp Zobrazit soubor

@@ -149,49 +149,130 @@ namespace Slime {
String file_name_built_ins = Memory::create_string(__FILE__);
defer_free(file_name_built_ins.data);

define_macro((call/cc fun), "TODO") {
profile_with_name("(call/cc)");

using Globals::Current_Execution;
Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
try_void assert_list_length(args, 1);

Lisp_Object* fun = args->value.pair.first;

// 2. push cont on the stack and call, the fun is already
// there
Current_Execution.ats.append([] {
try_void assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1]
, Lisp_Object_Type::Function);
Lisp_Object* cont = Memory::create_lisp_object_continuation();

Current_Execution.ams.append(Current_Execution.cs.next_index-1);
Current_Execution.pcs.append(Memory::nil);
--cont->value.continuation->cs.next_index;
Current_Execution.cs.append(cont);
(Current_Execution.nass.end()-1)->append(NasAction::Step);
});
(Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

// 1. resolve the function
Current_Execution.cs.append(fun);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);

};
define_macro((set! sym val), "TODO") {
// NOTE(Felix): This COULD be a define_special in theory,
// but because of call/cc, it cannot be anymore because
// the define_symbol would not be a part of the
// continuation. This happens for example in:
/**
(set! res (+ 2 (call/cc (lambda (cont)
(set! add-5 cont) 1))
3))
*/
// So if 'set! WAS a define_special, then the param would
// not be evaluated, but the whole call gets removed from
// the stack, and in the body of 'set!, the 'val would be
// recursively evaluated, and the 'call/cc would not see
// the variable definition as part of the continuation. So
// what we do istead, is writing 'set! as a macro and have
// the variable definition as a and_then_action, so that
// it is part of the continuation.
profile_with_name("(set!)");
using Globals::Current_Execution;

Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
try_void assert_list_length(args, 2);

Lisp_Object* sym = args->value.pair.first;
Lisp_Object* val = args->value.pair.rest->value.pair.first;

try_void assert_type(sym, Lisp_Object_Type::Symbol);

// 2. find the binding and rebind
Current_Execution.cs.append(sym);
Current_Execution.ats.append([] {
using Globals::Current_Execution;
Lisp_Object* val = Current_Execution.cs.data[--Current_Execution.cs.next_index];
Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1];

Environment* target_env = find_binding_environment(sym, get_current_environment());
if (!target_env)
target_env = get_root_environment();
define_symbol(sym, val, target_env);
});
(Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

// 1. eval the val
Current_Execution.cs.append(val);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);

};
define_macro((apply fun fun_args), "TODO") {
// NOTE(Felix): is has to be a macro because apply by
// itself cannot return the result, we have to invoke eval
// and to prevent recursion, apply is a macro

profile_with_name("(apply)");
using namespace Globals::Current_Execution;
using Globals::Current_Execution;

Lisp_Object* args = pcs[--pcs.next_index];
Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
try_void assert_list_length(args, 2);

Lisp_Object* fun = args->value.pair.first;
Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;

// 3. push args on the stack and apply
ats.append([] {
Lisp_Object* args_as_list = cs[--cs.next_index];
Current_Execution.ats.append([] {
// BUG(Felix): we are not pushing on the ams, are we
// doing it wrong?
// Current_Execution.ams.append(Current_Execution.cs.next_index-2);

Lisp_Object* args_as_list = Current_Execution.cs[--Current_Execution.cs.next_index];
for_lisp_list (args_as_list) {
cs.append(it);
Current_Execution.cs.append(it);
}
pcs.append(Memory::nil);
(nass.end()-1)->append(NasAction::Step);
Current_Execution.pcs.append(Memory::nil);
(Current_Execution.nass.end()-1)->append(NasAction::Step);
});
(nass.end()-1)->append(NasAction::And_Then_Action);
(Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

// 2. Eval fun_args and keep them on the stack
ats.append([] {
Current_Execution.ats.append([] {
// NOTE(Felix): Flip the top 2 elements on cs because
// top is now the evaluated function, and below is the unevaluated args
Lisp_Object* tmp = cs[cs.next_index-1];
cs[cs.next_index-1] = cs[cs.next_index-2];
cs[cs.next_index-2] = tmp;
(nass.end()-1)->append(NasAction::Eval);
Lisp_Object* tmp = Current_Execution.cs[Current_Execution.cs.next_index-1];
Current_Execution.cs[Current_Execution.cs.next_index-1] = Current_Execution.cs[Current_Execution.cs.next_index-2];
Current_Execution.cs[Current_Execution.cs.next_index-2] = tmp;
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
});
(nass.end()-1)->append(NasAction::And_Then_Action);
(Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);


// 1. Eval function and keep it on the stack, below it
// store the unevaluated argument list
ams.append(cs.next_index);
cs.append(fun_args);
cs.append(fun);
(nass.end()-1)->append(NasAction::Eval);
Current_Execution.ams.append(Current_Execution.cs.next_index);
Current_Execution.cs.append(fun_args);
Current_Execution.cs.append(fun);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);

};
define((get-counter),
@@ -215,12 +296,12 @@ namespace Slime {
"Takes one argument, and evaluates it two times.")
{
profile_with_name("(eval)");
using namespace Globals::Current_Execution;
using Globals::Current_Execution;
// we know cs.data[cs.next_index] is allocated because the
// macro cal lwas there just before
cs.data[cs.next_index++] = pcs[--pcs.next_index]->value.pair.first;
(nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::Eval);
Current_Execution.cs.data[Current_Execution.cs.next_index++] = Current_Execution.pcs[--Current_Execution.pcs.next_index]->value.pair.first;
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);

};
define_macro((begin . rest),
@@ -228,18 +309,18 @@ namespace Slime {
"and returns the last result.")
{
profile_with_name("(begin)");
using namespace Globals::Current_Execution;
Lisp_Object* args = pcs[--pcs.next_index];
using Globals::Current_Execution;
Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
u32 length = list_length(args);
cs.reserve(length);
Current_Execution.cs.reserve(length);
for_lisp_list(args) {
cs.data[cs.next_index - 1 + (length - it_index)] = it;
(nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::Pop);
Current_Execution.cs.data[Current_Execution.cs.next_index - 1 + (length - it_index)] = it;
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
(Current_Execution.nass.end()-1)->append(NasAction::Pop);
}

--(nass.end()-1)->next_index;
cs.next_index += length;
--(Current_Execution.nass.end()-1)->next_index;
Current_Execution.cs.next_index += length;
};
define_macro((if test then_part else_part),
"Takes 3 arguments. If the first arguments evaluates to a truthy "
@@ -247,12 +328,12 @@ namespace Slime {
"it will evaluete the third one and return them respectively.")
{
profile_with_name("(if)");
using namespace Globals::Current_Execution;
using Globals::Current_Execution;
/* | | | <test> |
| | -> | <then> |
| <if> | | <else> |
| .... | | ...... | */
Lisp_Object* args = pcs.data[--pcs.next_index];
Lisp_Object* args = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
Lisp_Object* test = args->value.pair.first;
args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Pair);
@@ -263,14 +344,13 @@ namespace Slime {
args = args->value.pair.rest;
try_void assert_type(args, Lisp_Object_Type::Nil);

cs.append(alternative);
cs.append(consequence);
cs.append(test);

(nass.end()-1)->append(NasAction::Eval);
(nass.end()-1)->append(NasAction::If);
(nass.end()-1)->append(NasAction::Eval);
Current_Execution.cs.append(alternative);
Current_Execution.cs.append(consequence);
Current_Execution.cs.append(test);

(Current_Execution.nass.end()-1)->append(NasAction::Eval);
(Current_Execution.nass.end()-1)->append(NasAction::If);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
};
define_macro((define definee . args), "") {
// NOTE(Felix): define has to be a macro, because we need
@@ -279,9 +359,9 @@ namespace Slime {
// want to recursivly evaluate the value, we use a macro
// and a NasAction.
profile_with_name("(define)");
using namespace Globals::Current_Execution;
using Globals::Current_Execution;

Lisp_Object* form = pcs.data[--pcs.next_index];
Lisp_Object* form = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
Lisp_Object* definee = form->value.pair.first;
form = form->value.pair.rest;
if (definee->type == Lisp_Object_Type::Symbol) {
@@ -302,10 +382,10 @@ namespace Slime {
// TODO docs (maybe with hooks) we have to attach
// the docs to the result of evaluating
}
cs.append(definee);
cs.append(thing);
(nass.end()-1)->append(NasAction::Define_Var);
(nass.end()-1)->append(NasAction::Eval);
Current_Execution.cs.append(definee);
Current_Execution.cs.append(thing);
(Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
} break;
case Lisp_Object_Type::Pair: {
try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
@@ -331,7 +411,7 @@ namespace Slime {
func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);

define_symbol(definee->value.pair.first, func);
cs.append(definee->value.pair.first);
Current_Execution.cs.append(definee->value.pair.first);
} break;
default: {
create_generic_error("you can only define symbols");
@@ -356,7 +436,7 @@ namespace Slime {
define_special((with-debug-log . rest), "") {
profile_with_name("(enable-debug-log)");
fetch(rest);
Lisp_Object* result;
Lisp_Object* result = Memory::nil;
Globals::debug_log = true;
in_caller_env {
for_lisp_list(rest) {
@@ -679,26 +759,6 @@ namespace Slime {

return val;
};
define_special((set! sym val), "TODO") {
profile_with_name("(set!)");
fetch(sym, val);

try assert_type(sym, Lisp_Object_Type::Symbol);
Environment* target_env;
in_caller_env {
val = eval_expr(val);
target_env = find_binding_environment(sym, get_current_environment());
if (!target_env)
target_env = get_root_environment();
}


push_environment(target_env);
define_symbol(sym, val);
pop_environment();

return val;
};
define((set-car! target source), "TODO") {
profile_with_name("(set-car!)");
fetch(target, source);
@@ -1108,12 +1168,12 @@ namespace Slime {
fetch(sep, end, repr, things);

if (things != Memory::nil) {
bool print_repr = repr != Memory::nil;
print(things->value.pair.first, repr);
bool print_repr = (repr != Memory::nil);
print(things->value.pair.first, print_repr);

for_lisp_list(things->value.pair.rest) {
print(sep);
print(it, repr);
print(it, print_repr);
}
}



+ 2
- 2
src/define_macros.hpp Zobrazit soubor

@@ -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)


/*


+ 5
- 8
src/env.cpp Zobrazit soubor

@@ -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* {


+ 5
- 5
src/error.cpp Zobrazit soubor

@@ -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");


+ 130
- 60
src/eval.cpp Zobrazit soubor

@@ -6,7 +6,7 @@ namespace Slime {
u32 arg_end) -> Environment*
{
profile_this();
using namespace Globals::Current_Execution;
using Globals::Current_Execution;

u32 index_of_next_arg = arg_start;
bool is_c_function = function->value.function->is_c;
@@ -41,9 +41,9 @@ namespace Slime {
// programmers to know what they are doing. Bold claim I
// know.
if (is_c_function) {
define_symbol(arg_spec->positional.symbols.data[i], cs.data[index_of_next_arg], env);
define_symbol(arg_spec->positional.symbols.data[i], Current_Execution.cs.data[index_of_next_arg], env);
} else {
define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
define_symbol(arg_spec->positional.symbols.data[i], Memory::copy_lisp_object_except_pairs(Current_Execution.cs.data[index_of_next_arg]), env);
}
++index_of_next_arg;
}
@@ -56,11 +56,11 @@ namespace Slime {
++obligatory_keywords_count;
}

while (cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) {
while (Current_Execution.cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
for (u32 i = 0; i < arg_spec->keyword.keywords.next_index; ++i) {
if (cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) {
if (Current_Execution.cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) {
accepted = true;
break;
}
@@ -75,13 +75,13 @@ namespace Slime {
"The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.",
cs.data[index_of_next_arg]->value.symbol.data);
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr;
}
// This is an accepted kwarg; check if it was already
// read in
for (u32 i = 0; i < read_in_keywords.next_index; ++i) {
if (cs.data[index_of_next_arg] == read_in_keywords.data[i])
if (Current_Execution.cs.data[index_of_next_arg] == read_in_keywords.data[i])
{
// if we already read it in but also finished
// all other kwargs, then count it as rest and
@@ -92,7 +92,7 @@ namespace Slime {
// in, it is an error
create_generic_error(
"The function already read the keyword argument ':%s'",
cs.data[index_of_next_arg]->value.symbol.data);
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr;
}
}
@@ -102,19 +102,19 @@ namespace Slime {
if (index_of_next_arg+1 == arg_end) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
cs.data[index_of_next_arg]->value.symbol.data);
Current_Execution.cs.data[index_of_next_arg]->value.symbol.data);
return nullptr;
}

// if not set it and then add it to the array list
Lisp_Object* key = cs.data[index_of_next_arg];
Lisp_Object* key = Current_Execution.cs.data[index_of_next_arg];
try sym = Memory::get_symbol(key->value.symbol);
++index_of_next_arg;

if (is_c_function) {
try define_symbol(sym, cs.data[index_of_next_arg], env);
try define_symbol(sym, Current_Execution.cs.data[index_of_next_arg], env);
} else {
try define_symbol(sym, Memory::copy_lisp_object_except_pairs(cs.data[index_of_next_arg]), env);
try define_symbol(sym, Memory::copy_lisp_object_except_pairs(Current_Execution.cs.data[index_of_next_arg]), env);
}

read_in_keywords.append(key);
@@ -171,10 +171,10 @@ namespace Slime {
} else {
if (arg_spec->rest) {
Lisp_Object* list;
try list = Memory::create_list(cs.data[index_of_next_arg]);
try list = Memory::create_list(Current_Execution.cs.data[index_of_next_arg]);
Lisp_Object* head = list;
for (++index_of_next_arg;index_of_next_arg < arg_end; ++index_of_next_arg) {
try head->value.pair.rest = Memory::create_list(cs.data[index_of_next_arg]);
try head->value.pair.rest = Memory::create_list(Current_Execution.cs.data[index_of_next_arg]);
head = head->value.pair.rest;
}
define_symbol(arg_spec->rest, list, env);
@@ -313,13 +313,13 @@ namespace Slime {

proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
profile_this();
using namespace Globals::Current_Execution;
using Globals::Current_Execution;

nass.reserve(1);
Array_List<NasAction>* nas = nass.data+(nass.next_index++);
Current_Execution.nass.reserve(1);
Array_List<NasAction>* nas = Current_Execution.nass.data+(Current_Execution.nass.next_index++);
nas->alloc();
defer {
--nass.next_index;
--Current_Execution.nass.next_index;
nas->dealloc();
};

@@ -332,13 +332,13 @@ namespace Slime {
};

proc push_pc_on_cs = [&] {
for_lisp_list (pcs.data[pcs.next_index-1]) {
cs.append(it);
for_lisp_list (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]) {
Current_Execution.cs.append(it);
}
pcs.data[pcs.next_index-1] = Memory::nil;
Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Memory::nil;
};

cs.append(expr);
Current_Execution.cs.append(expr);
nas->append(NasAction::Eval);

NasAction current_action;
@@ -350,35 +350,36 @@ namespace Slime {
current_action = nas->data[--nas->next_index];
switch (current_action) {
case NasAction::Pop: {
--cs.next_index;
--Current_Execution.cs.next_index;
} break;
case NasAction::And_Then_Action: {
ats.data[--ats.next_index]();
Current_Execution.ats.data[--Current_Execution.ats.next_index]();
} break;
case NasAction::Pop_Environment: {
pop_environment();
} break;
case NasAction::Eval: {
pc = cs.data[cs.next_index-1];
pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];
Lisp_Object_Type type = pc->type;
switch (type) {
case Lisp_Object_Type::Symbol: {
cs.data[cs.next_index-1] = lookup_symbol(pc, get_current_environment());
Current_Execution.cs.data[Current_Execution.cs.next_index-1]
= lookup_symbol(pc, get_current_environment());
} break;
case Lisp_Object_Type::Pair: {
cs.data[cs.next_index-1] = pc->value.pair.first;
ams.append(cs.next_index-1);
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = pc->value.pair.first;
Current_Execution.ams.append(Current_Execution.cs.next_index-1);

if_debug {
if (ams.next_index >= 2) {
if (Current_Execution.ams.next_index >= 2) {
assert("invalid ams state",
ams.data[ams.next_index-2] <=
ams.data[ams.next_index-1]);
Current_Execution.ams.data[Current_Execution.ams.next_index-2] <=
Current_Execution.ams.data[Current_Execution.ams.next_index-1]);
}
}

pcs.append(pc->value.pair.rest);
mes.append(pc);
Current_Execution.pcs.append(pc->value.pair.rest);
Current_Execution.mes.append(pc);
nas->append(NasAction::TM);
nas->append(NasAction::Eval);
} break;
@@ -389,18 +390,19 @@ namespace Slime {
}
} break;
case NasAction::Macro_Write_Back: {
*mes.data[--mes.next_index] = *cs[cs.next_index-1];
*(Current_Execution.mes.data[--Current_Execution.mes.next_index])
= *Current_Execution.cs[Current_Execution.cs.next_index-1];
} break;
case NasAction::TM: {
pc = cs.data[cs.next_index-1];
pc = Current_Execution.cs.data[Current_Execution.cs.next_index-1];

Lisp_Object_Type type = pc->type;
switch (type) {
case Lisp_Object_Type::Function: {
if(pc->value.function->is_c) {
if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
--cs.next_index; // remove the macro call from cs
--ams.next_index; // remove the apply marker for the macro
--Current_Execution.cs.next_index; // remove the macro call from cs
--Current_Execution.ams.next_index; // remove the apply marker for the macro
try pc->value.function->body.c_macro_body();
} else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
{
@@ -412,7 +414,7 @@ namespace Slime {
} else {
nas->append(NasAction::Step);
}
--mes.next_index;
--Current_Execution.mes.next_index;
} else {
if (pc->value.function->type.lisp_function_type ==
Lisp_Function_Type::Macro)
@@ -422,16 +424,74 @@ namespace Slime {
nas->append(NasAction::Macro_Write_Back);
nas->append(NasAction::Step);
} else {
--mes.next_index;
--Current_Execution.mes.next_index;
nas->append(NasAction::Step);
}
}
} break;
case Lisp_Object_Type::Continuation: {
--Current_Execution.mes.next_index;
--Current_Execution.ams.next_index;
Lisp_Object* param = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
try assert_list_length(param, 1);
param = param->value.pair.first;
// NOTE(Felix): we could first get value and eval
// it and restore the cont on an and_then_action
// OR we could restore the cont now and push the
// new unevaluated val on the stack and leave a
// NAS_Actoin::Eval behind. So that's what we
// gonna do.

Globals::Current_Execution.cs.clear();
Globals::Current_Execution.ams.clear();
Globals::Current_Execution.pcs.clear();
Globals::Current_Execution.nass.clear();
Globals::Current_Execution.envi_stack.clear();
Globals::Current_Execution.ats.clear();
Globals::Current_Execution.mes.clear();

// TODO(Felix): This seems super inefficient
for (auto it: pc->value.continuation->cs) {
Globals::Current_Execution.cs.append(it);
}
for (auto it: pc->value.continuation->ams) {
Globals::Current_Execution.ams.append(it);
}
for (auto it: pc->value.continuation->pcs) {
Globals::Current_Execution.pcs.append(it);
}
for (auto it: pc->value.continuation->envi_stack) {
Globals::Current_Execution.envi_stack.append(it);
}
for (auto it: pc->value.continuation->ats) {
Globals::Current_Execution.ats.append(it);
}
for (auto it: pc->value.continuation->mes) {
Globals::Current_Execution.mes.append(it);
}
{
Globals::Current_Execution.nass.reserve(pc->value.continuation->nass.next_index);
Globals::Current_Execution.nass.next_index = pc->value.continuation->nass.next_index;

for (int i = 0; i < pc->value.continuation->nass.next_index; ++i) {
Globals::Current_Execution.nass.data[i].alloc();
for (Globals::Current_Execution.nass.data[i].next_index = 0;
Globals::Current_Execution.nass.data[i].next_index < pc->value.continuation->nass.data[i].next_index;)
{
Globals::Current_Execution.nass.data[i].append(
pc->value.continuation->nass.data[i].data[Globals::Current_Execution.nass.data[i].next_index]);
}
}
}

Globals::Current_Execution.cs.append(param);
(Current_Execution.nass.end()-1)->append(NasAction::Eval);
// debug_break();
} break;
default: {
char* t = lisp_object_to_string(pc);
defer {
free(t);
};
defer_free(t);

create_generic_error("The first element of the pair was not a function but: %s in %s",
lisp_object_type_to_string(type), t);
return nullptr;
@@ -440,31 +500,31 @@ namespace Slime {

} break;
case NasAction::Step: {
if (pcs.data[pcs.next_index-1] == Memory::nil) {
--pcs.next_index;
u32 am = ams.data[--ams.next_index];
Lisp_Object* function = cs.data[am];
if (Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] == Memory::nil) {
--Current_Execution.pcs.next_index;
u32 am = Current_Execution.ams.data[--Current_Execution.ams.next_index];
Lisp_Object* function = Current_Execution.cs.data[am];
try assert_type(function, Lisp_Object_Type::Function);

Environment* extended_env;
try extended_env = create_extended_environment_for_function_application_nrc(
function, am+1, cs.next_index);
cs.next_index = am;
function, am+1, Current_Execution.cs.next_index);
Current_Execution.cs.next_index = am;
push_environment(extended_env);
if (function->value.function->is_c) {
if (function->value.function->type.c_function_type == C_Function_Type::cMacro)
try function->value.function->body.c_macro_body();
else
try cs.append(function->value.function->body.c_body());
try Current_Execution.cs.append(function->value.function->body.c_body());
pop_environment();
} else {
nas->append(NasAction::Pop_Environment);
nas->append(NasAction::Eval);
cs.append(function->value.function->body.lisp_body);
Current_Execution.cs.append(function->value.function->body.lisp_body);
}
} else {
cs.append(pcs.data[pcs.next_index-1]->value.pair.first);
pcs.data[pcs.next_index-1] = pcs.data[pcs.next_index-1]->value.pair.rest;
Current_Execution.cs.append(Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.first);
Current_Execution.pcs.data[Current_Execution.pcs.next_index-1] = Current_Execution.pcs.data[Current_Execution.pcs.next_index-1]->value.pair.rest;
nas->append(NasAction::Step);
nas->append(NasAction::Eval);
}
@@ -474,29 +534,29 @@ namespace Slime {
| <then> |
| <else> |
| .... | */
cs.next_index -= 2;
Current_Execution.cs.next_index -= 2;
// NOTE(Felix): for false it is sufficent to pop 2 for
// true we have to copy the then part to the new top
// of the stack
if (cs.data[cs.next_index+1] != Memory::nil) {
cs.data[cs.next_index-1] = cs.data[cs.next_index];
if (Current_Execution.cs.data[Current_Execution.cs.next_index+1] != Memory::nil) {
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Current_Execution.cs.data[Current_Execution.cs.next_index];
}
} break;
case NasAction::Define_Var: {
/* | <thing> |
| <symbol> |
| .... | */
cs.next_index -= 1;
try assert_type(cs.data[cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(cs.data[cs.next_index-1], cs.data[cs.next_index]);
cs.data[cs.next_index-1] = Memory::t;
Current_Execution.cs.next_index -= 1;
try assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Lisp_Object_Type::Symbol);
try define_symbol(Current_Execution.cs.data[Current_Execution.cs.next_index-1], Current_Execution.cs.data[Current_Execution.cs.next_index]);
Current_Execution.cs.data[Current_Execution.cs.next_index-1] = Memory::t;
}
}

}
// debug_step();

return cs.data[--cs.next_index];
return Current_Execution.cs.data[--Current_Execution.cs.next_index];
}

inline proc is_truthy(Lisp_Object* expression) -> bool {
@@ -506,6 +566,11 @@ namespace Slime {
proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init();
try Memory::load_pre();
defer {
if_debug {
Slime::Memory::free_everything();
}
};

Lisp_Object* result;

@@ -517,6 +582,11 @@ namespace Slime {
proc interprete_stdin() -> void {
try_void Memory::init();
try_void Memory::load_pre();
defer {
if_debug {
Slime::Memory::free_everything();
}
};

printf("Welcome to the lispy interpreter.\n%s\n", version_string);



+ 6
- 4
src/forward_decls.cpp Zobrazit soubor

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


+ 3
- 2
src/gc.cpp Zobrazit soubor

@@ -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 {


+ 1
- 9
src/globals.cpp Zobrazit soubor

@@ -24,15 +24,7 @@ namespace Slime::Globals {
Hash_Map<void*, Source_Code_Location> source_code_locations;
Hash_Map<void*, Lisp_Object*> user_types;

namespace Current_Execution {
Array_List<Lisp_Object*> cs; // call stack
Array_List<Lisp_Object*> pcs; // program counter stack
Array_List<int> ams; // apply marker stack
Array_List<Array_List<NasAction>> nass; // next action stack stack
Array_List<Lambda<void()>> ats; // and then stack
Array_List<Lisp_Object*> mes; // macro expansion stack
Array_List<Environment*> envi_stack;
}
Continuation Current_Execution;

Error* error = nullptr;
#ifdef _DONT_BREAK_ON_ERRORS


+ 8
- 10
src/io.cpp Zobrazit soubor

@@ -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);
}
}


+ 5
- 0
src/main.cpp Zobrazit soubor

@@ -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 {


+ 38
- 20
src/memory.cpp Zobrazit soubor

@@ -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) {


+ 1
- 1
src/parse.cpp Zobrazit soubor

@@ -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);


+ 7
- 3
src/structs.cpp Zobrazit soubor

@@ -20,7 +20,6 @@ namespace Slime {
Continuation,
Pointer,
HashMap,
// OwningPointer,
Function,
Invalid_Garbage_Collected,
Invalid_Under_Construction
@@ -61,8 +60,13 @@ namespace Slime {
};

struct Continuation {
Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
Array_List<Lisp_Object*> cs; // call stack
Array_List<Lisp_Object*> pcs; // program counter stack
Array_List<int> ams; // apply marker stack
Array_List<Array_List<NasAction>> nass; // next action stack stack
Array_List<Lambda<void()>> ats; // and then stack
Array_List<Lisp_Object*> mes; // macro expansion stack
Array_List<Environment*> envi_stack;
};

struct String {


+ 8
- 2
src/testing.cpp Zobrazit soubor

@@ -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");


+ 23
- 2
todo.org Zobrazit soubor

@@ -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])


Zapsat Náhled
Načítá se…
Zrušit
Uložit