From 04ea73b704a4e52a47b17feb12fb6967a3792fea Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Fri, 24 Jan 2020 11:28:28 +0100 Subject: [PATCH] update --- .dir-locals.el | 17 +-- bin/pre.slime | 2 + bin/slime.rdbg | Bin 173 -> 408 bytes build.bat | 18 +-- build.sh | 0 src/built_ins.cpp | 290 ++++++++++++++++++++++-------------------- src/define_macros.hpp | 11 +- src/eval.cpp | 206 +++++++++--------------------- src/globals.cpp | 7 +- src/memory.cpp | 7 +- src/structs.cpp | 12 ++ src/testing.cpp | 20 +-- vs/slime.vcxproj | 21 ++- 13 files changed, 280 insertions(+), 331 deletions(-) mode change 100755 => 100644 build.sh diff --git a/.dir-locals.el b/.dir-locals.el index 1aa7131..0453cfa 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -9,11 +9,14 @@ (context-mode 1) (defun start-debugger () - (async-shell-command - (concat - "cdbg64.exe" " -t " - (expand-windows-path (concat (projectile-project-root) - "bin/slime.exe"))))) + (interactive) + (let ((default-directory (expand-windows-path (concat (projectile-project-root) "bin/")))) + (unless (process-running-p "remedybg.exe") + (start-process "remedy" "*remedyout*" + "remedybg.exe" "open-session" + (expand-windows-path (concat (projectile-project-root) "bin/slime.rdbg")))) + + (start-process "remedy" "*remedyout*" "remedybg.exe" "start-debugging"))) (defhydra hydra-context (context-mode-map "") "Context Actions:" @@ -31,6 +34,4 @@ (c++-mode . ((eval . (company-clang-set-prefix "slime.h")) (eval . (flycheck-mode 0)) - (eval . (rainbow-mode 0)) - (eval . (setq c-backslash-max-column 99)) - ))) + (eval . (setq c-backslash-max-column 99))))) diff --git a/bin/pre.slime b/bin/pre.slime index 664a33a..16c5dde 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -18,6 +18,7 @@ (promise)) (define-syntax (mac a) (list + 1 1)) +(define-syntax (add . args) (pair '+ args)) (define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a @@ -38,6 +39,7 @@ condition is true. `(if ,condition ,@body nil) `(if ,condition (begin ,@body) nil))) + (define-syntax (unless condition . body) :doc "Special form for when multiple actions should be done if a condition is false." diff --git a/bin/slime.rdbg b/bin/slime.rdbg index 61b64ece3a70ff5b258ac732d6fca77cce91ccc7..ebc2d7d316b5d35128879769e9119bf40bdc6dec 100644 GIT binary patch literal 408 zcmaLTv1-FG5C&jD3mLL?>Dna4L!n-}dB_k7-ZKl#**e<-*%EhGle~RS?i>qFKPNs; zLf79*y*I{`mV=+L#2ae2uAS~jEmzqtI<$kA0PVlCOr1rdNM)DOX-iEwMY?Bp*kZUq z$mr`C`XOg~X)O@JJ$ROKOzGp9Uf(w_dE)1m5oGc6kX^Cm+CLwp@iS+s(B$8F)soTk xyJpcxnm`0y!$Lap`|Lm<6QF@ts&~C;KLh7T9lvSRA+`{>szL#x0fV%(y delta 47 wcmbQiyq0l-Gz&8W1H;6LdW?z_6=a#q5_2XxYKs7c7#M+=1&B*BGK)cc0O@)NPyhe` diff --git a/build.bat b/build.bat index 1fbc40e..d661a99 100644 --- a/build.bat +++ b/build.bat @@ -21,14 +21,14 @@ rem call ..\timecmd cl ^ rem call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc -if %errorlevel% == 0 ( - echo. - echo ---- Running Tests ---- - echo. - call slime.exe --run-tests -) else ( - echo. - echo Fuckin' ell -) +rem if %errorlevel% == 0 ( +rem echo. +rem echo ---- Running Tests ---- +rem echo. +rem call slime.exe --run-tests +rem ) else ( +rem echo. +rem echo Fuckin' ell +rem ) popd diff --git a/build.sh b/build.sh old mode 100755 new mode 100644 diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 9f82be5..5fbb3d5 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -1,5 +1,4 @@ namespace Slime { - proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { if (n1 == n2) return true; @@ -113,6 +112,123 @@ namespace Slime { profile_this(); String* file_name_built_ins = Memory::create_string(__FILE__); + // define_macro((apply fun args), "TODO") { + // profile_with_name("(apply)"); + // }; + define_macro((eval expr), + "Takes one argument, and evaluates it two times.") + { + profile_with_name("(eval)"); + using namespace Globals::Current_Execution; + cs.data[cs.next_index-1] = pcs[--pcs.next_index]->value.pair.first; + (nass.end()-1)->append(NasAction::Eval); + (nass.end()-1)->append(NasAction::Eval); + + }; + define_macro((begin . rest), + "Takes any number of forms. Evaluates them in order, " + "and returns the last result.") + { + profile_with_name("(begin)"); + using namespace Globals::Current_Execution; + --cs.next_index; + --ams.next_index; + Lisp_Object* args = pcs[--pcs.next_index]; + int length = list_length(args); + 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); + } + + --(nass.end()-1)->next_index; + cs.next_index += length; + }; + define_macro((if test then_part else_part), + "Takes 3 arguments. If the first arguments evaluates to a truthy " + "value, the if expression evaluates the second argument, else " + "it will evaluete the third one and return them respectively.") + { + profile_with_name("(if)"); + using namespace Globals::Current_Execution; + /* | | | | + | | -> | | + | | | | + | .... | | ...... | */ + --ams.next_index; + Lisp_Object* args = pcs.data[--pcs.next_index]; + Lisp_Object* test = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Pair); + Lisp_Object* consequence = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Pair); + Lisp_Object* alternative = args->value.pair.first; + args = args->value.pair.rest; + try_void assert_type(args, Lisp_Object_Type::Nil); + --cs.next_index; + 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); + + }; + define_macro((define definee . args), "") { + // NOTE(Felix): define has to be a macro, because we need + // to evaluate the value for definee in case it is a + // simple variable (not a function). So ebcause we don't + // want to recursivly evaluate the value, we use a macro + // and a NasAction. + profile_with_name("(define)"); + using namespace Globals::Current_Execution; + --cs.next_index; + --ams.next_index; + Lisp_Object* form = pcs.data[--pcs.next_index]; + Lisp_Object* definee = form->value.pair.first; + form = form->value.pair.rest; + try_void assert_type(form, Lisp_Object_Type::Pair); + Lisp_Object* thing = form->value.pair.first; + Lisp_Object* thing_cons = form; + form = form->value.pair.rest; + Lisp_Object_Type type = Memory::get_type(definee); + switch (type) { + case Lisp_Object_Type::Symbol: { + // BUG(Felix): Defining with doc string crashes + if (form != Memory::nil) { + Lisp_Object* doc = thing; + try_void assert_type(doc, Lisp_Object_Type::String); + try_void assert_type(form, Lisp_Object_Type::Pair); + form = form->value.pair.rest; + thing = form->value.pair.first; + try_void assert(form->value.pair.rest == Memory::nil); + // TODO docs + } + cs.append(definee); + cs.append(thing); + (nass.end()-1)->append(NasAction::Define_Var); + (nass.end()-1)->append(NasAction::Eval); + } break; + case Lisp_Object_Type::Pair: { + fflush(stdout); + try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); + Lisp_Object* func; + try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); + func->value.function->parent_environment = get_current_environment(); + create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); + func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons); + define_symbol(definee->value.pair.first, func); + cs.append(Memory::t); + } break; + default: { + create_generic_error("you can only define symbols"); + return; + } + } + }; define((helper), "") { profile_with_name("(helper)"); return Memory::create_lisp_object(101.0); @@ -141,8 +257,7 @@ namespace Slime { return Memory::t; }; - define((> . args), "TODO") - { + define((> . args), "TODO") { profile_with_name("(>)"); fetch(args); double last_number = strtod("Inf", NULL); @@ -347,11 +462,6 @@ namespace Slime { // creating new lisp object and setting type Lisp_Object* func; try func = Memory::create_lisp_object_function(Lisp_Function_Type::Macro); - - // Lisp_Object* func; - // try func = Memory::create_lisp_object(); - // Memory::set_type(func, Lisp_Object_Type::Function); - // func->value.function->type = Function_Type::Macro; if (doc) func->docstring = doc->value.string; in_caller_env { @@ -363,62 +473,6 @@ namespace Slime { } return Memory::nil; }; - define_special((define definee (:doc "") . body), "TODO") { - profile_with_name("(define)"); - fetch(definee, doc, body); - - // print_hm(get_current_environment()->hm); - try assert_type(doc, Lisp_Object_Type::String); - - // if no doc string, we dont have to store it - if (Memory::get_c_str(doc)[0] == '\0') { - doc = nullptr; - } - - if (Memory::get_type(definee) == Lisp_Object_Type::Symbol) { - if (body == Memory::nil) { - create_parsing_error("You at least have to put a value when " - "you are trying to define a variable."); - return nullptr; - } else if (body->value.pair.rest != Memory::nil) { - create_parsing_error("You cannot define more than one thing " - "for one variable."); - return nullptr; - } - auto value = body->value.pair.first; - in_caller_env { - try value = eval_expr(value); - define_symbol(definee, value); - } - } else if (Memory::get_type(definee) == Lisp_Object_Type::Pair) { - // definee: (sym . lambdalist) - Lisp_Object* symbol = definee->value.pair.first; - Lisp_Object* lambdalist = definee->value.pair.rest; - - // creating new lisp object and setting type - Lisp_Object* func; - try func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); - - if (doc) - func->docstring = doc->value.string; - - in_caller_env { - // setting parent env - func->value.function->parent_environment = get_current_environment(); - create_arguments_from_lambda_list_and_inject(lambdalist, func); - func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body); - define_symbol(symbol, func); - } - - } else { - create_parsing_error("The to be defined object has to be a " - "symbol or a list. But got a %s.", - Lisp_Object_Type_to_string( - Memory::get_type(definee))); - return nullptr; - } - return Memory::nil; - }; define((mutate target source), "TODO") { profile_with_name("(mutate)"); fetch(target, source); @@ -516,21 +570,6 @@ namespace Slime { *target->value.pair.rest = *source; return source; }; - define_special((if test then_part else_part), "TODO") { - profile_with_name("(if)"); - fetch(test, then_part, else_part); - - bool truthy; - Lisp_Object* result; - - in_caller_env { - try truthy = is_truthy(test); - if (truthy) try result = eval_expr(then_part); - else try result = eval_expr(else_part); - } - - return result; - }; define_special((quote datum), "TODO") { profile_with_name("(quote)"); fetch(datum); @@ -672,32 +711,32 @@ namespace Slime { } return (truthy) ? Memory::nil : Memory::t; }; - // // defun("while", "TODO", __LINE__, cLambda { - // // try arguments_length = list_length(arguments); - // // try assert(arguments_length >= 2); + // // // defun("while", "TODO", __LINE__, cLambda { + // // // try arguments_length = list_length(arguments); + // // // try assert(arguments_length >= 2); - // // Lisp_Object* condition_part = arguments->value.pair.first; - // // Lisp_Object* condition; - // // Lisp_Object* then_part = arguments->value.pair.rest; - // // Lisp_Object* wrapped_then_part; + // // // Lisp_Object* condition_part = arguments->value.pair.first; + // // // Lisp_Object* condition; + // // // Lisp_Object* then_part = arguments->value.pair.rest; + // // // Lisp_Object* wrapped_then_part; - // // try wrapped_then_part = Memory::create_lisp_object_pair( - // // Memory::get_symbol("begin"), - // // then_part); + // // // try wrapped_then_part = Memory::create_lisp_object_pair( + // // // Memory::get_symbol("begin"), + // // // then_part); - // // Lisp_Object* result = Memory::nil; + // // // Lisp_Object* result = Memory::nil; - // // while (true) { - // // try condition = eval_expr(condition_part); + // // // while (true) { + // // // try condition = eval_expr(condition_part); - // // if (condition == Memory::nil) - // // break; + // // // if (condition == Memory::nil) + // // // break; - // // try result = eval_expr(wrapped_then_part); - // // } - // // return result; + // // // try result = eval_expr(wrapped_then_part); + // // // } + // // // return result; - // // }); + // // // }); define_special((lambda args . body), "TODO") { profile_with_name("(lambda)"); fetch(args, body); @@ -714,37 +753,6 @@ namespace Slime { func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body); return func; }; - define((apply fun args), "TODO") { - profile_with_name("(apply)"); - fetch(fun, args); - Lisp_Object* result; - - try result = apply_arguments_to_function(args, fun, /*eval_args=*/false); - - return result; - }; - define((eval expr), "TODO") { - profile_with_name("(eval)"); - fetch(expr); - Lisp_Object* result; - - in_caller_env { - try result = eval_expr(expr); - } - - return result; - }; - define_special((begin . args), "TODO") { - profile_with_name("(begin)"); - fetch(args); - Lisp_Object* result = Memory::nil; - in_caller_env { - for_lisp_list(args) { - try result = eval_expr(it); - } - } - return result; - }; define((list . args), "TODO") { profile_with_name("(list)"); fetch(args); @@ -875,20 +883,20 @@ namespace Slime { } return Memory::get_keyword("unknown"); }; - define((mem-reset), "TODO") { - profile_with_name("(mem-reset)"); - Memory::reset(); - return Memory::nil; - }; - // NOTE(Felix): we need to define_special because the docstring is - // attached to the symbol. Because some object are singletons - // (symbols, keyowrds, nil, t) we dont want to store docs on the - // object. Otherwise (define k :doc "hallo" :keyword) would modify - // the global keyword - define_special((info n), "TODO") { + // define((mem-reset), "TODO") { + // profile_with_name("(mem-reset)"); + // Memory::reset(); + // return Memory::nil; + // }; + define_special((info n), "TODO") + { + // NOTE(Felix): we need to define_special because the docstring is + // attached to the symbol. Because some object are singletons + // (symbols, keyowrds, nil, t) we dont want to store docs on the + // object. Otherwise (define k :doc "hallo" :keyword) would modify + // // the global keyword profile_with_name("(info)"); fetch(n); - print(n); Lisp_Object* type; diff --git a/src/define_macros.hpp b/src/define_macros.hpp index d40d504..30b5b65 100644 --- a/src/define_macros.hpp +++ b/src/define_macros.hpp @@ -108,7 +108,7 @@ // mutable for the parser to work, because the parser relys on being // able to temporaily put in markers in the code and also it will fill // out the source code location -#define _define_helper(def, docs, type) \ +#define _define_helper(def, docs, type, ending) \ Parser::parser_file = file_name_built_ins; \ Parser::parser_line = __LINE__; \ Parser::parser_col = 0; \ @@ -124,11 +124,12 @@ label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \ define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ - label(sfun,__LINE__)->value.function->body.c_body = []() -> Lisp_Object* + label(sfun,__LINE__)->value.function->body. ending + +#define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction, c_body = []() -> Lisp_Object*) +#define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial, c_body = []() -> Lisp_Object*) +#define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro, c_macro_body = []() -> void) -#define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction) -#define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro) -#define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial) #define in_caller_env fluid_let( \ Globals::Current_Execution::envi_stack.next_index, \ Globals::Current_Execution::envi_stack.next_index-1) diff --git a/src/eval.cpp b/src/eval.cpp index 1bf1e83..a0b1841 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -645,18 +645,15 @@ namespace Slime { proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* { using namespace Globals::Current_Execution; - enum struct Action { - Eval, - Step, - TM, - Pop, - If, - Define_Var, - Pop_Environment - }; - Array_List nas; - nas.alloc(); + nass.reserve(1); + Array_List* nas = nass.data+(nass.next_index++); + nas->alloc(); + defer { + --nass.next_index; + nas->data = nullptr; + nas->dealloc(); + }; proc debug_step = [&] { return; @@ -671,27 +668,30 @@ namespace Slime { print(lo, true); printf("\n "); } - printf("\nnas:\n "); - for (auto na : nas) { - printf("%s\n ", [&] - { - switch(na) { - case Action::Pop_Environment: return "Pop_Environment"; - case Action::Define_Var: return "Define_Var"; - case Action::Eval: return "Eval"; - case Action::Step: return "Step"; - case Action::TM: return "TM"; - case Action::Pop: return "Pop"; - case Action::If: return "If"; - } - return "??"; - }()); + printf("\nnnas:\n "); + for (auto nas: nass) { + printf("nas:\n "); + for (auto na : nas) { + printf(" - %s\n ", [&] + { + switch(na) { + case NasAction::Pop_Environment: return "Pop_Environment"; + case NasAction::Define_Var: return "Define_Var"; + case NasAction::Eval: return "Eval"; + case NasAction::Step: return "Step"; + case NasAction::TM: return "TM"; + case NasAction::Pop: return "Pop"; + case NasAction::If: return "If"; + } + return "??"; + }()); + } } printf("\nams:\n "); for (auto am : ams) { printf("%d\n ", am); } - // pause(); + pause(); }; proc push_pc_on_cs = [&] { @@ -701,110 +701,24 @@ namespace Slime { pcs.data[pcs.next_index-1] = Memory::nil; }; - proc handle_if = [&] { - /* | | | | - | | -> | | - | | | | - | .... | | ...... | */ - --ams.next_index; - Lisp_Object* args = pcs.data[--pcs.next_index]; - Lisp_Object* test = args->value.pair.first; - args = args->value.pair.rest; - try_void assert_type(args, Lisp_Object_Type::Pair); - Lisp_Object* consequence = args->value.pair.first; - args = args->value.pair.rest; - try_void assert_type(args, Lisp_Object_Type::Pair); - Lisp_Object* alternative = args->value.pair.first; - args = args->value.pair.rest; - try_void assert_type(args, Lisp_Object_Type::Nil); - --cs.next_index; - cs.append(alternative); - cs.append(consequence); - cs.append(test); - nas.append(Action::Eval); - nas.append(Action::If); - nas.append(Action::Eval); - }; - - proc handle_define = [&] { - --cs.next_index; - --ams.next_index; - Lisp_Object* form = pcs.data[--pcs.next_index]; - Lisp_Object* definee = form->value.pair.first; - form = form->value.pair.rest; - try_void assert_type(form, Lisp_Object_Type::Pair); - Lisp_Object* thing = form->value.pair.first; - Lisp_Object* thing_cons = form; - form = form->value.pair.rest; - Lisp_Object_Type type = Memory::get_type(definee); - switch (type) { - case Lisp_Object_Type::Symbol: { - // BUG(Felix): Defining with doc string crashes - if (form != Memory::nil) { - Lisp_Object* doc = thing; - try_void assert_type(doc, Lisp_Object_Type::String); - try_void assert_type(form, Lisp_Object_Type::Pair); - form = form->value.pair.rest; - thing = form->value.pair.first; - try_void assert(form->value.pair.rest == Memory::nil); - // TODO docs - } - cs.append(definee); - cs.append(thing); - nas.append(Action::Define_Var); - nas.append(Action::Eval); - } break; - case Lisp_Object_Type::Pair: { - fflush(stdout); - try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); - Lisp_Object* func; - try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); - func->value.function->parent_environment = get_current_environment(); - create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); - func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons); - define_symbol(definee->value.pair.first, func); - cs.append(Memory::t); - } break; - default: { - create_generic_error("you can only define symbols"); - return; - } - } - }; - - proc handle_begin = [&] { - --cs.next_index; - --ams.next_index; - Lisp_Object* args = pcs[--pcs.next_index]; - int length = list_length(args); - cs.reserve(length); - for_lisp_list(args) { - cs.data[cs.next_index - 1 + (length - it_index)] = it; - nas.append(Action::Eval); - nas.append(Action::Pop); - } - - --nas.next_index; - cs.next_index += length; - }; - cs.append(expr); - nas.append(Action::Eval); + nas->append(NasAction::Eval); - Action current_action; + NasAction current_action; Lisp_Object* pc; - while (nas.next_index > 0) { + + while (nas->next_index > 0) { debug_step(); - current_action = nas.data[--nas.next_index]; + current_action = nas->data[--nas->next_index]; switch (current_action) { - case Action::Pop: { + case NasAction::Pop: { --cs.next_index; } break; - case Action::Pop_Environment: { + case NasAction::Pop_Environment: { pop_environment(); } break; - case Action::Eval: { + case NasAction::Eval: { pc = cs.data[cs.next_index-1]; Lisp_Object_Type type = Memory::get_type(pc); switch (type) { @@ -815,8 +729,8 @@ namespace Slime { cs.data[cs.next_index-1] = pc->value.pair.first; ams.append(cs.next_index-1); pcs.append(pc->value.pair.rest); - nas.append(Action::TM); - nas.append(Action::Eval); + nas->append(NasAction::TM); + nas->append(NasAction::Eval); } break; default: { // NOTE(Felix): others are self evaluating @@ -824,35 +738,34 @@ namespace Slime { } } } break; - case Action::TM: { + case NasAction::TM: { pc = cs.data[cs.next_index-1]; Lisp_Object_Type type = Memory::get_type(pc); 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) + if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) { + try pc->value.function->body.c_macro_body(); + } else if(pc->value.function->type.c_function_type == C_Function_Type::cSpecial) { - if (pc == Memory::_if) try handle_if(); - else if (pc == Memory::_begin) try handle_begin(); - else if (pc == Memory::_define) try handle_define(); - else { - push_pc_on_cs(); - nas.append(Action::Step); - } + // TODO(Felix): Why not call the function + // right away, and instead push step, so + // that step calls it? + push_pc_on_cs(); + nas->append(NasAction::Step); } else { - nas.append(Action::Step); + nas->append(NasAction::Step); } } else { if (pc->value.function->type.lisp_function_type == Lisp_Function_Type::Macro) { push_pc_on_cs(); - nas.append(Action::Eval); - nas.append(Action::Step); + nas->append(NasAction::Eval); + nas->append(NasAction::Step); } else { - nas.append(Action::Step); + nas->append(NasAction::Step); } } } break; @@ -864,7 +777,7 @@ namespace Slime { } } break; - case Action::Step: { + case NasAction::Step: { if (pcs.data[pcs.next_index-1] == Memory::nil) { --pcs.next_index; int am = ams.data[--ams.next_index]; @@ -876,21 +789,24 @@ namespace Slime { cs.next_index = am; push_environment(extended_env); if (function->value.function->is_c) { - try cs.append(function->value.function->body.c_body()); + 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()); pop_environment(); } else { - nas.append(Action::Pop_Environment); - nas.append(Action::Eval); + nas->append(NasAction::Pop_Environment); + nas->append(NasAction::Eval); 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; - nas.append(Action::Step); - nas.append(Action::Eval); + nas->append(NasAction::Step); + nas->append(NasAction::Eval); } } break; - case Action::If: { + case NasAction::If: { /* | | | | | | @@ -903,7 +819,7 @@ namespace Slime { cs.data[cs.next_index-1] = cs.data[cs.next_index]; } } break; - case Action::Define_Var: { + case NasAction::Define_Var: { /* | | | | | .... | */ diff --git a/src/globals.cpp b/src/globals.cpp index cc4bf71..ad83607 100644 --- a/src/globals.cpp +++ b/src/globals.cpp @@ -4,9 +4,10 @@ namespace Slime::Globals { Array_List load_path; namespace Current_Execution { - Array_List cs; - Array_List pcs; - Array_List ams; + Array_List cs; + Array_List pcs; + Array_List ams; + Array_List> nass; // Array_List call_stack; Array_List envi_stack; } diff --git a/src/memory.cpp b/src/memory.cpp index ec340d0..afb61ea 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -181,6 +181,7 @@ namespace Slime::Memory { // Globals::Current_Execution::call_stack.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(); @@ -211,9 +212,9 @@ namespace Slime::Memory { try_void user_env = Memory::create_child_environment(env); push_environment(user_env); - try_void _if = lookup_symbol(get_symbol("if"), env); + /* try_void _if = lookup_symbol(get_symbol("if"), env); try_void _define = lookup_symbol(get_symbol("define"), env); - try_void _begin = lookup_symbol(get_symbol("begin"), env); + try_void _begin = lookup_symbol(get_symbol("begin"), env);*/ } proc reset() -> void { @@ -499,7 +500,7 @@ namespace Slime::Memory { }; try load_built_ins_into_environment(); - try built_in_load(Memory::create_string("pre.slime")); + // try built_in_load(Memory::create_string("pre.slime")); return ret; } diff --git a/src/structs.cpp b/src/structs.cpp index a468aed..51199a2 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -31,11 +31,22 @@ namespace Slime { Under_Construction = 1 << 6, }; + enum struct NasAction { + Eval, + Step, + TM, + Pop, + If, + Define_Var, + Pop_Environment + }; + enum struct Lisp_Function_Type { Lambda, // normal evaluation order Macro // args are not evaluated, a new programm is returned // that will be executed again }; + enum struct C_Function_Type { cFunction, // normal evaluation order cSpecial, // args are not evaluated, but result is returned @@ -118,6 +129,7 @@ namespace Slime { union { Lisp_Object* lisp_body; Lisp_Object* (*c_body)(); + void (*c_macro_body)(); } body; }; diff --git a/src/testing.cpp b/src/testing.cpp index 42afd49..b371d82 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -620,17 +620,17 @@ namespace Slime { // pop_environment(); printf("\n-- Test Files --\n"); - // invoke_test_script("evaluation_of_default_args"); - // invoke_test_script("alists"); - // invoke_test_script("case_and_cond"); - // invoke_test_script("lexical_scope"); - // invoke_test_script("class_macro"); - // invoke_test_script("import_and_load"); - // invoke_test_script("macro_expand"); - // invoke_test_script("automata"); + invoke_test_script("evaluation_of_default_args"); + invoke_test_script("alists"); + invoke_test_script("case_and_cond"); + invoke_test_script("lexical_scope"); + invoke_test_script("class_macro"); + invoke_test_script("import_and_load"); + invoke_test_script("macro_expand"); + invoke_test_script("automata"); invoke_test_script("sicp"); - // invoke_test_script("hashmaps"); - // invoke_test_script("singular_imports"); + invoke_test_script("hashmaps"); + invoke_test_script("singular_imports"); return result; } diff --git a/vs/slime.vcxproj b/vs/slime.vcxproj index e0bae6d..7fd1d06 100644 --- a/vs/slime.vcxproj +++ b/vs/slime.vcxproj @@ -30,45 +30,45 @@ 15.0 {1A47A3ED-871F-4CB4-875B-8CAA385B1771} slime - 10.0.15063.0 + 10.0 slime Application true - v141 + v142 MultiByte Application true - v141 + v142 MultiByte Application false - v141 + v142 true MultiByte Application true - v141 + v142 MultiByte Application true - v141 + v142 MultiByte Application false - v141 + v142 true MultiByte @@ -98,6 +98,13 @@ $(SolutionDir)$(Platform)\$(Configuration)\ + $(SolutionDir)..\3rd;$(IncludePath) + + + $(SolutionDir)..\3rd;$(IncludePath) + + + $(SolutionDir)..\3rd;$(IncludePath)