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

implemented callstack and envistack

Browse Source
This commit is contained in:
Felix Brendel
2019-07-17 23:20:07 +02:00
parent e266667607
commit 7cebcd1823
14 changed files with 259 additions and 221 deletions
Download Patch File Download Diff File Expand all files Collapse all files
build.bat
+2 -2
View File
@@ -9,8 +9,8 @@ pushd bin
taskkill /F /IM %exeName% > NUL 2> NUL taskkill /F /IM %exeName% > NUL 2> NUL
echo ---------- Compiling ---------- echo ---------- Compiling ----------
call ..\timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib rem call ..\timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib
rem call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc call ..\timecmd clang-cl ../src/main.cpp -o %exeName% /O2 /std:c++latest /W3 /Zi /EHsc
popd popd
if %errorlevel% == 0 ( if %errorlevel% == 0 (
manual/built-in-docs.org
+53 -53
View File
@@ -1,7 +1,7 @@
\hrule \hrule
* === * ===
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:158:0= - defined in :: =../src/./built_ins.cpp:160:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -10,7 +10,7 @@ Takes 0 or more arguments and returns =t= if all arguments are equal and =()= ot
\hrule \hrule
* =>= * =>=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:174:0= - defined in :: =../src/./built_ins.cpp:176:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -19,7 +19,7 @@ TODO
\hrule \hrule
* =>== * =>==
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:191:0= - defined in :: =../src/./built_ins.cpp:193:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -28,7 +28,7 @@ TODO
\hrule \hrule
* =<= * =<=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:208:0= - defined in :: =../src/./built_ins.cpp:210:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -37,7 +37,7 @@ TODO
\hrule \hrule
* =<== * =<==
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:227:0= - defined in :: =../src/./built_ins.cpp:229:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -46,7 +46,7 @@ TODO
\hrule \hrule
* =+= * =+=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:244:0= - defined in :: =../src/./built_ins.cpp:246:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -55,7 +55,7 @@ TODO
\hrule \hrule
* =-= * =-=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:256:0= - defined in :: =../src/./built_ins.cpp:258:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -64,7 +64,7 @@ TODO
\hrule \hrule
* =*= * =*=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:278:0= - defined in :: =../src/./built_ins.cpp:280:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -73,7 +73,7 @@ TODO
\hrule \hrule
* =/= * =/=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:298:0= - defined in :: =../src/./built_ins.cpp:300:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -82,7 +82,7 @@ TODO
\hrule \hrule
* =**= * =**=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:318:0= - defined in :: =../src/./built_ins.cpp:320:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -91,7 +91,7 @@ TODO
\hrule \hrule
* =%= * =%=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:333:0= - defined in :: =../src/./built_ins.cpp:335:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -100,7 +100,7 @@ TODO
\hrule \hrule
* =assert= * =assert=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:348:0= - defined in :: =../src/./built_ins.cpp:350:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -109,7 +109,7 @@ TODO
\hrule \hrule
* =define= * =define=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:359:0= - defined in :: =../src/./built_ins.cpp:361:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -118,7 +118,7 @@ TODO
\hrule \hrule
* =mutate= * =mutate=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:421:0= - defined in :: =../src/./built_ins.cpp:423:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -127,7 +127,7 @@ TODO
\hrule \hrule
* =if= * =if=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:446:0= - defined in :: =../src/./built_ins.cpp:448:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -136,7 +136,7 @@ TODO
\hrule \hrule
* =quote= * =quote=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:466:0= - defined in :: =../src/./built_ins.cpp:468:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -145,7 +145,7 @@ TODO
\hrule \hrule
* =quasiquote= * =quasiquote=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:471:0= - defined in :: =../src/./built_ins.cpp:473:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -154,7 +154,7 @@ TODO
\hrule \hrule
* =and= * =and=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:568:0= - defined in :: =../src/./built_ins.cpp:569:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -163,7 +163,7 @@ TODO
\hrule \hrule
* =or= * =or=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:579:0= - defined in :: =../src/./built_ins.cpp:580:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -172,7 +172,7 @@ TODO
\hrule \hrule
* =not= * =not=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:590:0= - defined in :: =../src/./built_ins.cpp:591:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -181,7 +181,7 @@ TODO
\hrule \hrule
* =while= * =while=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:600:0= - defined in :: =../src/./built_ins.cpp:601:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -190,7 +190,7 @@ TODO
\hrule \hrule
* =lambda= * =lambda=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:678:0= - defined in :: =../src/./built_ins.cpp:679:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -199,7 +199,7 @@ TODO
\hrule \hrule
* =special-lambda= * =special-lambda=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:690:0= - defined in :: =../src/./built_ins.cpp:691:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -208,7 +208,7 @@ TODO
\hrule \hrule
* =eval= * =eval=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:698:0= - defined in :: =../src/./built_ins.cpp:699:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -217,7 +217,7 @@ TODO
\hrule \hrule
* =begin= * =begin=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:710:0= - defined in :: =../src/./built_ins.cpp:711:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -226,7 +226,7 @@ TODO
\hrule \hrule
* =list= * =list=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:726:0= - defined in :: =../src/./built_ins.cpp:727:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -235,7 +235,7 @@ TODO
\hrule \hrule
* =pair= * =pair=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:730:0= - defined in :: =../src/./built_ins.cpp:731:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -244,7 +244,7 @@ TODO
\hrule \hrule
* =first= * =first=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:740:0= - defined in :: =../src/./built_ins.cpp:741:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -253,7 +253,7 @@ TODO
\hrule \hrule
* =rest= * =rest=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:751:0= - defined in :: =../src/./built_ins.cpp:752:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -262,7 +262,7 @@ TODO
\hrule \hrule
* =set-type= * =set-type=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:762:0= - defined in :: =../src/./built_ins.cpp:763:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -271,7 +271,7 @@ TODO
\hrule \hrule
* =delete-type= * =delete-type=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:774:0= - defined in :: =../src/./built_ins.cpp:775:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -280,7 +280,7 @@ TODO
\hrule \hrule
* =type= * =type=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:781:0= - defined in :: =../src/./built_ins.cpp:782:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -289,7 +289,7 @@ TODO
\hrule \hrule
* =info= * =info=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:813:0= - defined in :: =../src/./built_ins.cpp:815:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -298,7 +298,7 @@ TODO
\hrule \hrule
* =show= * =show=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:895:0= - defined in :: =../src/./built_ins.cpp:896:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -307,7 +307,7 @@ TODO
\hrule \hrule
* =addr-of= * =addr-of=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:907:0= - defined in :: =../src/./built_ins.cpp:908:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -316,7 +316,7 @@ TODO
\hrule \hrule
* =generate-docs= * =generate-docs=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:913:0= - defined in :: =../src/./built_ins.cpp:914:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -325,7 +325,7 @@ TODO
\hrule \hrule
* =print= * =print=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:922:0= - defined in :: =../src/./built_ins.cpp:923:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -334,7 +334,7 @@ TODO
\hrule \hrule
* =read= * =read=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:930:0= - defined in :: =../src/./built_ins.cpp:931:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -343,7 +343,7 @@ TODO
\hrule \hrule
* =exit= * =exit=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:947:0= - defined in :: =../src/./built_ins.cpp:948:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -352,7 +352,7 @@ TODO
\hrule \hrule
* =break= * =break=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:958:0= - defined in :: =../src/./built_ins.cpp:959:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -361,7 +361,7 @@ TODO
\hrule \hrule
* =memstat= * =memstat=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:963:0= - defined in :: =../src/./built_ins.cpp:964:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -370,7 +370,7 @@ TODO
\hrule \hrule
* =try= * =try=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:967:0= - defined in :: =../src/./built_ins.cpp:968:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -379,7 +379,7 @@ TODO
\hrule \hrule
* =load= * =load=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:982:0= - defined in :: =../src/./built_ins.cpp:983:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -388,7 +388,7 @@ TODO
\hrule \hrule
* =import= * =import=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:993:0= - defined in :: =../src/./built_ins.cpp:994:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -397,7 +397,7 @@ TODO
\hrule \hrule
* =copy= * =copy=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1004:0= - defined in :: =../src/./built_ins.cpp:1005:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -406,7 +406,7 @@ TODO
\hrule \hrule
* =error= * =error=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1012:0= - defined in :: =../src/./built_ins.cpp:1013:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -415,7 +415,7 @@ TODO
\hrule \hrule
* =symbol->keyword= * =symbol->keyword=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1019:0= - defined in :: =../src/./built_ins.cpp:1020:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -424,7 +424,7 @@ TODO
\hrule \hrule
* =string->symbol= * =string->symbol=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1028:0= - defined in :: =../src/./built_ins.cpp:1029:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -433,7 +433,7 @@ TODO
\hrule \hrule
* =symbol->string= * =symbol->string=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1040:0= - defined in :: =../src/./built_ins.cpp:1041:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -442,7 +442,7 @@ TODO
\hrule \hrule
* =concat-strings= * =concat-strings=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:1049:0= - defined in :: =../src/./built_ins.cpp:1050:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -1073,7 +1073,7 @@ be printed after the last argument (=end=).
\hrule \hrule
* =cons= * =cons=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:730:0= - defined in :: =../src/./built_ins.cpp:731:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -1082,7 +1082,7 @@ TODO
\hrule \hrule
* =car= * =car=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:740:0= - defined in :: =../src/./built_ins.cpp:741:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
@@ -1091,7 +1091,7 @@ TODO
\hrule \hrule
* =cdr= * =cdr=
- defined in :: =d:\code\gitlab\slime\src\./built_ins.cpp:751:0= - defined in :: =../src/./built_ins.cpp:752:0=
- type :: =:cfunction= - type :: =:cfunction=
- docu :: - docu ::
#+BEGIN: #+BEGIN:
src/built_ins.cpp
+78 -77
View File
@@ -9,7 +9,8 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
case Lisp_Object_Type::CFunction: // if they have the same case Lisp_Object_Type::CFunction: // if they have the same
// pointer, true is returned a // pointer, true is returned a
// few lines above // few lines above
case Lisp_Object_Type::Function: return false; case Lisp_Object_Type::Function:
case Lisp_Object_Type::Continuation: return false;
case Lisp_Object_Type::T: // code for t and nil should never be case Lisp_Object_Type::T: // code for t and nil should never be
// reached since they are memory unique // reached since they are memory unique
case Lisp_Object_Type::Nil: return true; case Lisp_Object_Type::Nil: return true;
@@ -29,7 +30,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
return false; return false;
} }
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* { proc built_in_load(String* file_name) -> Lisp_Object* {
// char* full_file_name = find_slime_file(file_name); // char* full_file_name = find_slime_file(file_name);
char* file_content; char* file_content;
char fullpath[4096]; char fullpath[4096];
@@ -64,33 +65,33 @@ proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
try program = Parser::parse_program(Memory::create_string(fullpath), file_content); try program = Parser::parse_program(Memory::create_string(fullpath), file_content);
for (int i = 0; i < program->next_index; ++i) { for (int i = 0; i < program->next_index; ++i) {
try result = eval_expr(program->data[i], env); try result = eval_expr(program->data[i]);
} }
return result; return result;
} }
proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* { proc built_in_import(String* file_name) -> Lisp_Object* {
// create new empty environment // create new empty environment
Environment* new_env; Environment* new_env;
try new_env = Memory::create_child_environment(get_root_environment()); try new_env = Memory::create_child_environment(get_root_environment());
append_to_array_list(env->parents, new_env); append_to_array_list(get_current_environment()->parents, new_env);
Environment* old_macro_env = Parser::environment_for_macros; push_environment(new_env);
Parser::environment_for_macros = new_env; defer {
pop_environment();
};
Lisp_Object* res = built_in_load(file_name, new_env); Lisp_Object* res = built_in_load(file_name);
Parser::environment_for_macros = old_macro_env;
return res; return res;
} }
proc load_built_ins_into_environment(Environment* env) -> void { proc load_built_ins_into_environment() -> void {
int arguments_length = 0; int arguments_length = 0;
Lisp_Object* evaluated_arguments = nullptr; Lisp_Object* evaluated_arguments = nullptr;
String* file_name_built_ins = Memory::create_string(__FILE__); String* file_name_built_ins = Memory::create_string(__FILE__);
#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object* #define cLambda [=](Lisp_Object* arguments) mutable -> Lisp_Object*
proc defun = [&](const char* name, const char* docs, int linenum, auto fun) { proc defun = [&](const char* name, const char* docs, int linenum, auto fun) {
auto sym = Memory::get_or_create_lisp_object_symbol(name); auto sym = Memory::get_or_create_lisp_object_symbol(name);
@@ -102,10 +103,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
sfun->sourceCodeLocation->column = 0; sfun->sourceCodeLocation->column = 0;
sfun->docstring = Memory::create_string(docs); sfun->docstring = Memory::create_string(docs);
define_symbol(sym, sfun, env); define_symbol(sym, sfun);
}; };
proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* { proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, bool is_special = false) -> Lisp_Object* {
Environment* env = get_current_environment();
// Function* function = new(Function); // Function* function = new(Function);
Lisp_Object* ret; Lisp_Object* ret;
try ret = Memory::create_lisp_object(); try ret = Memory::create_lisp_object();
@@ -156,7 +158,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
"Takes 0 or more arguments and returns =t= if all arguments are equal " "Takes 0 or more arguments and returns =t= if all arguments are equal "
"and =()= otherwise.", "and =()= otherwise.",
__LINE__, cLambda { __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
if (arguments == Memory::nil) if (arguments == Memory::nil)
return Memory::t; return Memory::t;
@@ -172,7 +174,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::t; return Memory::t;
}); });
defun(">", "TODO", __LINE__, cLambda { defun(">", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
double last_number = strtod("Inf", NULL); double last_number = strtod("Inf", NULL);
@@ -189,7 +191,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::t; return Memory::t;
}); });
defun(">=", "TODO", __LINE__, cLambda { defun(">=", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
double last_number = strtod("Inf", NULL); double last_number = strtod("Inf", NULL);
@@ -207,7 +209,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
}); });
defun("<", "TODO", __LINE__, cLambda { defun("<", "TODO", __LINE__, cLambda {
try { try {
arguments = eval_arguments(arguments, env, &arguments_length); arguments = eval_arguments(arguments, &arguments_length);
} }
double last_number = strtod("-Inf", NULL); double last_number = strtod("-Inf", NULL);
@@ -225,7 +227,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::t; return Memory::t;
}); });
defun("<=", "TODO", __LINE__, cLambda { defun("<=", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
double last_number = strtod("-Inf", NULL); double last_number = strtod("-Inf", NULL);
@@ -242,7 +244,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::t; return Memory::t;
}); });
defun("+", "TODO", __LINE__, cLambda { defun("+", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
double sum = 0; double sum = 0;
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
@@ -254,7 +256,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_number(sum); return Memory::create_lisp_object_number(sum);
}); });
defun("-", "TODO", __LINE__, cLambda { defun("-", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
if (arguments_length == 0) if (arguments_length == 0)
return Memory::create_lisp_object_number(0); return Memory::create_lisp_object_number(0);
@@ -276,7 +278,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_number(difference); return Memory::create_lisp_object_number(difference);
}); });
defun("*", "TODO", __LINE__, cLambda { defun("*", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
if (arguments_length == 0) { if (arguments_length == 0) {
return Memory::create_lisp_object_number(1); return Memory::create_lisp_object_number(1);
@@ -296,7 +298,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_number(product); return Memory::create_lisp_object_number(product);
}); });
defun("/", "TODO", __LINE__, cLambda { defun("/", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
if (arguments_length == 0) { if (arguments_length == 0) {
return Memory::create_lisp_object_number(1); return Memory::create_lisp_object_number(1);
@@ -316,7 +318,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_number(quotient); return Memory::create_lisp_object_number(quotient);
}); });
defun("**", "TODO", __LINE__, cLambda { defun("**", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
@@ -331,7 +333,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_number(pow(base, exponent)); return Memory::create_lisp_object_number(pow(base, exponent));
}); });
defun("%", "TODO", __LINE__, cLambda { defun("%", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number);
@@ -347,10 +349,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
}); });
defun("assert", "TODO", __LINE__, cLambda { defun("assert", "TODO", __LINE__, cLambda {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
try assert(arguments_length == 1); try assert(arguments_length == 1);
if (is_truthy(arguments->value.pair.first, env)) if (is_truthy(arguments->value.pair.first))
return Memory::t; return Memory::t;
create_generic_error("Userland assertion."); create_generic_error("Userland assertion.");
@@ -393,7 +395,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
symbol ->value.pair.rest, symbol ->value.pair.rest,
arguments->value.pair.rest); arguments->value.pair.rest);
value = parse_lambda_starting_from_args(fake_lambda, env); value = parse_lambda_starting_from_args(fake_lambda);
symbol = real_symbol; symbol = real_symbol;
} else { } else {
try assert_arguments_length_greater_equal(2, arguments_length); try assert_arguments_length_greater_equal(2, arguments_length);
@@ -409,17 +411,17 @@ proc load_built_ins_into_environment(Environment* env) -> void {
value = arguments->value.pair.rest->value.pair.first; value = arguments->value.pair.rest->value.pair.first;
try value = eval_expr(value, env); try value = eval_expr(value);
if (doc) if (doc)
value->docstring = doc; value->docstring = doc;
} }
define_symbol(symbol, value, env); define_symbol(symbol, value);
return value; return value;
}); });
defun("mutate", "TODO", __LINE__, cLambda { defun("mutate", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
Lisp_Object* target = evaluated_arguments->value.pair.first; Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
@@ -453,13 +455,13 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* else_part = then_part->value.pair.rest; Lisp_Object* else_part = then_part->value.pair.rest;
bool truthy; bool truthy;
try truthy = is_truthy(condition, env); try truthy = is_truthy(condition);
// printf("arg len is: %d\n", arguments_length); // printf("arg len is: %d\n", arguments_length);
Lisp_Object* result; Lisp_Object* result;
if (truthy) if (truthy)
try result = eval_expr(then_part->value.pair.first, env); try result = eval_expr(then_part->value.pair.first);
else else
try result = eval_expr(else_part->value.pair.first, env); try result = eval_expr(else_part->value.pair.first);
return result; return result;
}); });
@@ -471,7 +473,6 @@ proc load_built_ins_into_environment(Environment* env) -> void {
defun("quasiquote", "TODO", __LINE__, cLambda { defun("quasiquote", "TODO", __LINE__, cLambda {
try arguments_length = list_length(arguments); try arguments_length = list_length(arguments);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
// print(arguments); // print(arguments);
// printf("\n"); // printf("\n");
@@ -480,7 +481,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// with a garbage lambda, so that we can then overwrite it // with a garbage lambda, so that we can then overwrite it
// a recursive lambda // a recursive lambda
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;}; std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* { unquoteSomeExpressions = [&unquoteSomeExpressions] (Lisp_Object* expr) -> Lisp_Object* {
// if it is an atom, return it // if it is an atom, return it
if (Memory::get_type(expr) != Lisp_Object_Type::Pair) if (Memory::get_type(expr) != Lisp_Object_Type::Pair)
return Memory::copy_lisp_object(expr); return Memory::copy_lisp_object(expr);
@@ -492,7 +493,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
string_equal(originalPair->value.symbol.identifier, "unquote-splicing"))) string_equal(originalPair->value.symbol.identifier, "unquote-splicing")))
{ {
// eval replace the stuff // eval replace the stuff
return eval_expr(expr->value.pair.rest->value.pair.first, env); return eval_expr(expr->value.pair.rest->value.pair.first);
} }
// it is a list but not starting with the symbol // it is a list but not starting with the symbol
@@ -569,7 +570,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
bool result = true; bool result = true;
while (arguments != Memory::nil) { while (arguments != Memory::nil) {
try assert_type(arguments, Lisp_Object_Type::Pair); try assert_type(arguments, Lisp_Object_Type::Pair);
try result &= is_truthy(arguments->value.pair.first, env); try result &= is_truthy(arguments->value.pair.first);
arguments = arguments->value.pair.rest; arguments = arguments->value.pair.rest;
if (!result) return Memory::nil; if (!result) return Memory::nil;
@@ -580,7 +581,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
bool result = false; bool result = false;
while (arguments != Memory::nil) { while (arguments != Memory::nil) {
try assert_type(arguments, Lisp_Object_Type::Pair); try assert_type(arguments, Lisp_Object_Type::Pair);
try result |= is_truthy(arguments->value.pair.first, env); try result |= is_truthy(arguments->value.pair.first);
arguments = arguments->value.pair.rest; arguments = arguments->value.pair.rest;
if (result) return Memory::t; if (result) return Memory::t;
@@ -593,7 +594,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
bool truthy; bool truthy;
try truthy = is_truthy(arguments->value.pair.first, env); try truthy = is_truthy(arguments->value.pair.first);
return (truthy) ? Memory::nil : Memory::t; return (truthy) ? Memory::nil : Memory::t;
}); });
@@ -613,12 +614,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* result = Memory::nil; Lisp_Object* result = Memory::nil;
while (true) { while (true) {
try condition = eval_expr(condition_part, env); try condition = eval_expr(condition_part);
if (condition == Memory::nil) if (condition == Memory::nil)
break; break;
try result = eval_expr(wrapped_then_part, env); try result = eval_expr(wrapped_then_part);
} }
return result; return result;
@@ -683,7 +684,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try arguments_length = list_length(arguments); try arguments_length = list_length(arguments);
try assert_arguments_length_greater_equal(1, arguments_length); try assert_arguments_length_greater_equal(1, arguments_length);
Lisp_Object* function = parse_lambda_starting_from_args(arguments, env, false); Lisp_Object* function = parse_lambda_starting_from_args(arguments, false);
return function; return function;
}); });
@@ -691,24 +692,24 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try arguments_length = list_length(arguments); try arguments_length = list_length(arguments);
try assert_arguments_length_greater_equal(1, arguments_length); try assert_arguments_length_greater_equal(1, arguments_length);
Lisp_Object* function = parse_lambda_starting_from_args(arguments, env, true); Lisp_Object* function = parse_lambda_starting_from_args(arguments, true);
return function; return function;
}); });
defun("eval", "TODO", __LINE__, cLambda { defun("eval", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(evaluated_arguments->value.pair.first, env); try result = eval_expr(evaluated_arguments->value.pair.first);
return result; return result;
}); });
defun("begin", "TODO", __LINE__, cLambda { defun("begin", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
if (evaluated_arguments == Memory::nil) if (evaluated_arguments == Memory::nil)
return Memory::nil; return Memory::nil;
@@ -724,11 +725,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair.first; return evaluated_arguments->value.pair.first;
}); });
defun("list", "TODO", __LINE__, cLambda { defun("list", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
return evaluated_arguments; return evaluated_arguments;
}); });
defun("pair", "TODO", __LINE__, cLambda { defun("pair", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
Lisp_Object* ret; Lisp_Object* ret;
@@ -738,7 +739,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return ret; return ret;
}); });
defun("first", "TODO", __LINE__, cLambda { defun("first", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
if (evaluated_arguments->value.pair.first == Memory::nil) if (evaluated_arguments->value.pair.first == Memory::nil)
@@ -749,7 +750,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair.first->value.pair.first; return evaluated_arguments->value.pair.first->value.pair.first;
}); });
defun("rest", "TODO", __LINE__, cLambda { defun("rest", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
if (evaluated_arguments->value.pair.first == Memory::nil) if (evaluated_arguments->value.pair.first == Memory::nil)
@@ -760,7 +761,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair.first->value.pair.rest; return evaluated_arguments->value.pair.first->value.pair.rest;
}); });
defun("set-type", "TODO", __LINE__, cLambda { defun("set-type", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
Lisp_Object* object = evaluated_arguments->value.pair.first; Lisp_Object* object = evaluated_arguments->value.pair.first;
@@ -772,14 +773,14 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return object; return object;
}); });
defun("delete-type", "TODO", __LINE__, cLambda { defun("delete-type", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
evaluated_arguments->value.pair.first->userType = nullptr; evaluated_arguments->value.pair.first->userType = nullptr;
return Memory::t; return Memory::t;
}); });
defun("type", "TODO", __LINE__, cLambda { defun("type", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
if (evaluated_arguments->value.pair.first->userType) { if (evaluated_arguments->value.pair.first->userType) {
@@ -789,6 +790,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first); Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first);
switch (type) { switch (type) {
case Lisp_Object_Type::Continuation: return Memory::get_or_create_lisp_object_keyword("continuation");
case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
case Lisp_Object_Type::Function: { case Lisp_Object_Type::Function: {
Function* fun = &evaluated_arguments->value.pair.first->value.function; Function* fun = &evaluated_arguments->value.pair.first->value.function;
@@ -820,11 +822,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try type = eval_expr( try type = eval_expr(
Memory::create_lisp_object_pair( Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("type"), Memory::get_or_create_lisp_object_symbol("type"),
Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)), Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)));
env);
if (type) { if (type) {
Lisp_Object* val = eval_expr(arguments->value.pair.first, env); Lisp_Object* val = eval_expr(arguments->value.pair.first);
printf(" is of type "); printf(" is of type ");
print(type); print(type);
printf("\nand is printed as: "); printf("\nand is printed as: ");
@@ -840,7 +841,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
string_equal(type->value.symbol.identifier, "special-lambda") || string_equal(type->value.symbol.identifier, "special-lambda") ||
string_equal(type->value.symbol.identifier, "macro"))) string_equal(type->value.symbol.identifier, "macro")))
{ {
Lisp_Object* fun = eval_expr(arguments->value.pair.first, env); Lisp_Object* fun = eval_expr(arguments->value.pair.first);
if (fun->docstring) if (fun->docstring)
printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->docstring)); printf("Docstring:\n==========\n%s\n\n", Memory::get_c_str(fun->docstring));
@@ -893,7 +894,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::nil; return Memory::nil;
}); });
defun("show", "TODO", __LINE__, cLambda { defun("show", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Function); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Function);
@@ -905,7 +906,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::nil; return Memory::nil;
}); });
defun("addr-of", "TODO", __LINE__, cLambda { defun("addr-of", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
return Memory::create_lisp_object_number((float)((u64)&(evaluated_arguments->value.pair.first->value))); return Memory::create_lisp_object_number((float)((u64)&(evaluated_arguments->value.pair.first->value)));
@@ -915,12 +916,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(arguments->value.pair.first, Lisp_Object_Type::String); try assert_type(arguments->value.pair.first, Lisp_Object_Type::String);
generate_docs(env, arguments->value.pair.first->value.string); generate_docs(arguments->value.pair.first->value.string);
return Memory::t; return Memory::t;
}); });
defun("print", "TODO", __LINE__, cLambda { defun("print", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
print(evaluated_arguments->value.pair.first); print(evaluated_arguments->value.pair.first);
@@ -928,7 +929,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::nil; return Memory::nil;
}); });
defun("read", "TODO", __LINE__, cLambda { defun("read", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length_less_equal(1, arguments_length); try assert_arguments_length_less_equal(1, arguments_length);
if (arguments_length == 1) { if (arguments_length == 1) {
@@ -945,7 +946,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_string(strLine); return Memory::create_lisp_object_string(strLine);
}); });
defun("exit", "TODO", __LINE__, cLambda { defun("exit", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length_less_equal(1, arguments_length); try assert_arguments_length_less_equal(1, arguments_length);
if (arguments_length == 1) { if (arguments_length == 1) {
@@ -956,7 +957,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
exit(0); exit(0);
}); });
defun("break", "TODO", __LINE__, cLambda { defun("break", "TODO", __LINE__, cLambda {
print_environment(env); print_environment(get_current_environment());
debug_break(); debug_break();
return Memory::nil; return Memory::nil;
}); });
@@ -972,31 +973,31 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first; Lisp_Object* catch_part = arguments->value.pair.rest->value.pair.first;
Lisp_Object* result; Lisp_Object* result;
result = eval_expr(try_part, env); result = eval_expr(try_part);
if (Globals::error) { if (Globals::error) {
delete_error(); delete_error();
try result = eval_expr(catch_part, env); try result = eval_expr(catch_part);
} }
return result; return result;
}); });
defun("load", "TODO", __LINE__, cLambda { defun("load", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String);
Lisp_Object* result; Lisp_Object* result;
try result = built_in_load(evaluated_arguments->value.pair.first->value.string, env); try result = built_in_load(evaluated_arguments->value.pair.first->value.string);
return result; return result;
}); });
defun("import", "TODO", __LINE__, cLambda { defun("import", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String);
Lisp_Object* result; Lisp_Object* result;
try result = built_in_import(evaluated_arguments->value.pair.first->value.string, env); try result = built_in_import(evaluated_arguments->value.pair.first->value.string);
return result; return result;
@@ -1004,20 +1005,20 @@ proc load_built_ins_into_environment(Environment* env) -> void {
defun("copy", "TODO", __LINE__, cLambda { defun("copy", "TODO", __LINE__, cLambda {
// TODO(Felix): if we are copying string nodes, then // TODO(Felix): if we are copying string nodes, then
// shouldn't the string itself also get copied?? // shouldn't the string itself also get copied??
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
return Memory::copy_lisp_object(evaluated_arguments->value.pair.first); return Memory::copy_lisp_object(evaluated_arguments->value.pair.first);
}); });
defun("error", "TODO", __LINE__, cLambda { defun("error", "TODO", __LINE__, cLambda {
// TODO(Felix): make the error function useful // TODO(Felix): make the error function useful
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(0, arguments_length); try assert_arguments_length(0, arguments_length);
create_generic_error("Userlanderror"); create_generic_error("Userlanderror");
return nullptr; return nullptr;
}); });
defun("symbol->keyword", "TODO", __LINE__, cLambda { defun("symbol->keyword", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol);
@@ -1029,7 +1030,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// TODO(Felix): do some sanity checks on the string. For // TODO(Felix): do some sanity checks on the string. For
// example, numbers are not valid symbols. // example, numbers are not valid symbols.
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::String);
@@ -1038,7 +1039,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::get_or_create_lisp_object_symbol(Memory::duplicate_string(source->value.string)); return Memory::get_or_create_lisp_object_symbol(Memory::duplicate_string(source->value.string));
}); });
defun("symbol->string", "TODO", __LINE__, cLambda { defun("symbol->string", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length(1, arguments_length); try assert_arguments_length(1, arguments_length);
try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol); try assert_type(evaluated_arguments->value.pair.first, Lisp_Object_Type::Symbol);
@@ -1047,7 +1048,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol.identifier)); return Memory::create_lisp_object_string(Memory::duplicate_string(source->value.symbol.identifier));
}); });
defun("concat-strings", "TODO", __LINE__, cLambda { defun("concat-strings", "TODO", __LINE__, cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try evaluated_arguments = eval_arguments(arguments, &arguments_length);
try assert_arguments_length_greater_equal(1, arguments_length); try assert_arguments_length_greater_equal(1, arguments_length);
int resulting_string_len = 0; int resulting_string_len = 0;
src/docgeneration.cpp
+3 -3
View File
@@ -1,4 +1,4 @@
proc generate_docs(Environment* env, String* path) -> void { proc generate_docs(String* path) -> void {
// save the current working directory // save the current working directory
char* cwd = get_cwd(); char* cwd = get_cwd();
// get the direction of the exe // get the direction of the exe
@@ -58,7 +58,7 @@ proc generate_docs(Environment* env, String* path) -> void {
Lisp_Object* LOtype; Lisp_Object* LOtype;
try_void LOtype = eval_expr(Memory::create_list( try_void LOtype = eval_expr(Memory::create_list(
Memory::get_or_create_lisp_object_symbol("type"), Memory::get_or_create_lisp_object_symbol("type"),
env->values[i]), env); env->values[i]));
fprintf(f, "\n - type :: ="); fprintf(f, "\n - type :: =");
print(LOtype, true, f); print(LOtype, true, f);
@@ -156,5 +156,5 @@ proc generate_docs(Environment* env, String* path) -> void {
} }
}; };
print_this_env(env, (char*)""); print_this_env(get_current_environment(), (char*)"");
} }
src/env.cpp
+12 -1
View File
@@ -1,9 +1,10 @@
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void { proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
// NOTE(Felix): right now we are simply adding the symol at the // NOTE(Felix): right now we are simply adding the symol at the
// back of the list without checking if it already exists but are // back of the list without checking if it already exists but are
// also searching for thesymbol from the back, so we will find the // also searching for thesymbol from the back, so we will find the
// latest defined one first, but a bit messy. Later we should use // latest defined one first, but a bit messy. Later we should use
// a hashmap here. @refactor // a hashmap here. @refactor
Environment* env = get_current_environment();
if (env->next_index == env->capacity) { if (env->next_index == env->capacity) {
env->capacity *= 2; env->capacity *= 2;
@@ -48,6 +49,16 @@ proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
return nullptr; return nullptr;
} }
inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution;
append_to_array_list(envi_stack, env);
}
inline proc pop_environment() -> void {
using namespace Globals::Current_Execution;
--envi_stack->next_index;
}
inline proc get_root_environment() -> Environment* { inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution; using namespace Globals::Current_Execution;
return envi_stack->data[0]; return envi_stack->data[0];
src/eval.cpp
+37 -25
View File
@@ -1,13 +1,17 @@
proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* {
Environment* new_env; Environment* new_env;
try new_env = Memory::create_child_environment(function->parent_environment); try new_env = Memory::create_child_environment(function->parent_environment);
push_environment(new_env);
defer {
pop_environment();
};
Lisp_Object* sym, *val; // used as temp storage to use `try` Lisp_Object* sym, *val; // used as temp storage to use `try`
String_Array_List* read_in_keywords; String_Array_List* read_in_keywords;
int obligatory_keywords_count = 0; int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0; int read_obligatory_keywords_count = 0;
proc read_poitional_args = [&]() -> void { proc read_positional_args = [&]() -> void {
for (int i = 0; i < function->positional_arguments->next_index; ++i) { for (int i = 0; i < function->positional_arguments->next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i); create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i);
@@ -22,8 +26,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
try_void sym = function->positional_arguments->symbols[i]; try_void sym = function->positional_arguments->symbols[i];
define_symbol( define_symbol(
sym, sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first), Memory::copy_lisp_object_except_pairs(arguments->value.pair.first));
new_env);
arguments = arguments->value.pair.rest; arguments = arguments->value.pair.rest;
} }
@@ -109,8 +112,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
// NOTE(Felix): It seems we do not need to evaluate the argument here... // NOTE(Felix): It seems we do not need to evaluate the argument here...
try_void define_symbol( try_void define_symbol(
sym, sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first), Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
new_env);
append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier); append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier);
++read_obligatory_keywords_count; ++read_obligatory_keywords_count;
@@ -153,7 +155,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
if (!was_set) { if (!was_set) {
try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
try_void val = Memory::copy_lisp_object_except_pairs(function->keyword_arguments->values->data[i]); try_void val = Memory::copy_lisp_object_except_pairs(function->keyword_arguments->values->data[i]);
define_symbol(sym, val, new_env); define_symbol(sym, val);
} }
} }
} }
@@ -163,7 +165,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
if (arguments == Memory::nil) { if (arguments == Memory::nil) {
if (function->rest_argument) { if (function->rest_argument) {
try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
define_symbol(sym, Memory::nil, new_env); define_symbol(sym, Memory::nil);
} }
} else { } else {
if (function->rest_argument) { if (function->rest_argument) {
@@ -172,8 +174,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
sym, sym,
// NOTE(Felix): arguments will be a list, and I THINK // NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it... // we do not need to copy it...
arguments, arguments);
new_env);
} else { } else {
// rest was not declared but additional arguments were found // rest was not declared but additional arguments were found
create_generic_error( create_generic_error(
@@ -184,13 +185,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
} }
}; };
try read_poitional_args(); try read_positional_args();
try read_keyword_args(); try read_keyword_args();
try check_keyword_args(); try check_keyword_args();
try read_rest_arg(); try read_rest_arg();
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(function->body, new_env); try result = eval_expr(function->body);
return result; return result;
} }
@@ -291,7 +292,11 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
next = next->value.pair.rest; next = next->value.pair.rest;
if (Memory::get_type(next) == Lisp_Object_Type::Pair) { if (Memory::get_type(next) == Lisp_Object_Type::Pair) {
Lisp_Object* ret; Lisp_Object* ret;
try_void ret = eval_expr(next->value.pair.first, function->parent_environment); push_environment(function->parent_environment);
defer {
pop_environment();
};
try_void ret = eval_expr(next->value.pair.first);
append_to_keyword_argument_list(function->keyword_arguments, append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair.first, arguments->value.pair.first,
ret); ret);
@@ -367,7 +372,7 @@ proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object
return nullptr; return nullptr;
} }
proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* { proc eval_arguments(Lisp_Object* arguments, int *out_arguments_length) -> Lisp_Object* {
int my_out_arguments_length = 0; int my_out_arguments_length = 0;
if (arguments == Memory::nil) { if (arguments == Memory::nil) {
*(out_arguments_length) = 0; *(out_arguments_length) = 0;
@@ -381,7 +386,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
Lisp_Object* current_head = arguments; Lisp_Object* current_head = arguments;
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env); try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
current_head = current_head->value.pair.rest; current_head = current_head->value.pair.rest;
@@ -401,7 +406,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
return evaluated_arguments; return evaluated_arguments;
} }
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
using namespace Globals::Current_Execution; using namespace Globals::Current_Execution;
append_to_array_list(call_stack, node); append_to_array_list(call_stack, node);
defer { defer {
@@ -424,7 +429,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
return node; return node;
case Lisp_Object_Type::Symbol: { case Lisp_Object_Type::Symbol: {
Lisp_Object* value; Lisp_Object* value;
try value = lookup_symbol(node, env); try value = lookup_symbol(node, get_current_environment());
return value; return value;
} }
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
@@ -432,7 +437,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{ {
try lispOperator = eval_expr(node->value.pair.first, env); try lispOperator = eval_expr(node->value.pair.first);
} else { } else {
lispOperator = node->value.pair.first; lispOperator = node->value.pair.first;
} }
@@ -443,7 +448,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// check for c function // check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result; Lisp_Object* result;
try result = lispOperator->value.cFunction->function(arguments, env); try result = lispOperator->value.cFunction->function(arguments);
return result; return result;
} }
@@ -453,7 +458,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// apllying, for the other types, special-lambda and macro // apllying, for the other types, special-lambda and macro
// we do not need. // we do not need.
if (lispOperator->value.function.type == Function_Type::Lambda) { if (lispOperator->value.function.type == Function_Type::Lambda) {
try arguments = eval_arguments(arguments, env, &arguments_length); try arguments = eval_arguments(arguments, &arguments_length);
} }
Lisp_Object* result; Lisp_Object* result;
@@ -468,7 +473,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// later again. We will call this "lazy macro expansion" // later again. We will call this "lazy macro expansion"
if (lispOperator->value.function.type == Function_Type::Macro) { if (lispOperator->value.function.type == Function_Type::Macro) {
*node = *result; *node = *result;
try result = eval_expr(result, env); try result = eval_expr(result);
} }
return result; return result;
@@ -481,9 +486,9 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
} }
} }
proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, env); try result = eval_expr(expression);
return result != Memory::nil; return result != Memory::nil;
} }
@@ -493,9 +498,12 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
Environment* root_env = get_root_environment(); Environment* root_env = get_root_environment();
Environment* user_env; Environment* user_env;
try user_env = Memory::create_child_environment(root_env); try user_env = Memory::create_child_environment(root_env);
Parser::environment_for_macros = user_env; push_environment(user_env);
defer {
pop_environment();
};
Lisp_Object* result = built_in_load(Memory::create_string(file_name), user_env); Lisp_Object* result = built_in_load(Memory::create_string(file_name));
if (Globals::error) { if (Globals::error) {
log_error(); log_error();
@@ -509,6 +517,10 @@ proc interprete_stdin() -> void {
Memory::init(4096 * 256, 1024, 4096 * 256); Memory::init(4096 * 256, 1024, 4096 * 256);
Environment* root_env = get_root_environment(); Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env); Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer {
pop_environment();
};
if (Globals::error) { if (Globals::error) {
log_error(); log_error();
delete_error(); delete_error();
@@ -534,7 +546,7 @@ proc interprete_stdin() -> void {
delete_error(); delete_error();
continue; continue;
} }
evaluated = eval_expr(parsed, user_env); evaluated = eval_expr(parsed);
if (Globals::error) { if (Globals::error) {
log_error(); log_error();
src/forward_decls.cpp
+9 -8
View File
@@ -1,26 +1,27 @@
// proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void; // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void;
proc built_in_load(String*, Environment*) -> Lisp_Object*; proc built_in_load(String*) -> Lisp_Object*;
proc built_in_import(String*, Environment*) -> Lisp_Object*; proc built_in_import(String*) -> Lisp_Object*;
proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void; proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void;
proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void; proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void;
proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void; proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void;
proc eval_arguments(Lisp_Object*, Environment*, int*) -> Lisp_Object*; proc eval_arguments(Lisp_Object*, int*) -> Lisp_Object*;
proc eval_expr(Lisp_Object*, Environment*) -> Lisp_Object*; proc eval_expr(Lisp_Object*) -> Lisp_Object*;
proc is_truthy (Lisp_Object*, Environment*) -> bool; proc is_truthy (Lisp_Object*) -> bool;
proc list_length(Lisp_Object*) -> int; proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment(Environment*) -> void; proc load_built_ins_into_environment() -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void; proc parse_argument_list(Lisp_Object*, Function*) -> void;
proc print_environment(Environment*) -> void; proc print_environment(Environment*) -> void;
inline proc get_root_environment() -> Environment*; inline proc get_root_environment() -> Environment*;
inline proc get_current_environment() -> Environment*; inline proc get_current_environment() -> Environment*;
inline proc push_environment(Environment*) -> void;
inline proc pop_environment() -> void;
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*;
proc visualize_lisp_machine() -> void; proc visualize_lisp_machine() -> void;
proc generate_docs(Environment* env, String* path) -> void; proc generate_docs(String* path) -> void;
namespace Memory { namespace Memory {
proc create_built_ins_environment() -> Environment*; proc create_built_ins_environment() -> Environment*;
src/io.cpp
+2 -1
View File
@@ -281,6 +281,7 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
} break; } break;
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break; case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol.identifier)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break; case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::String): { case (Lisp_Object_Type::String): {
if (print_repr) { if (print_repr) {
@@ -398,6 +399,6 @@ proc log_error() -> void {
fputs(" in: ", stdout); fputs(" in: ", stdout);
print_call_stack(); print_call_stack();
puts(console_normal); puts(console_normal);
Globals::Current_Execution::call_stack->next_index = 0; Globals::Current_Execution::call_stack->next_index = 0;
} }
src/lisp_object.cpp
+10 -9
View File
@@ -11,15 +11,16 @@ proc create_source_code_location(String* file, int line, int col) -> Source_Code
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) { switch (type) {
case(Lisp_Object_Type::Nil): return "nil"; case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t"; case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number"; case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string"; case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol"; case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword"; case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function"; case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::CFunction): return "C-function"; case(Lisp_Object_Type::CFunction): return "C-function";
case(Lisp_Object_Type::Pair): return "pair"; case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
} }
return "unknown"; return "unknown";
} }
src/memory.cpp
+9 -5
View File
@@ -266,7 +266,7 @@ namespace Memory {
Memory::create_string(keyword)); Memory::create_string(keyword));
} }
proc create_lisp_object_cfunction(std::function<Lisp_Object* (Lisp_Object*, Environment*)> function) -> Lisp_Object* { proc create_lisp_object_cfunction(std::function<Lisp_Object* (Lisp_Object*)> function) -> Lisp_Object* {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::CFunction); set_type(node, Lisp_Object_Type::CFunction);
@@ -355,13 +355,19 @@ namespace Memory {
proc create_built_ins_environment() -> Environment* { proc create_built_ins_environment() -> Environment* {
Environment* ret; Environment* ret;
try ret = create_empty_environment(); try ret = create_empty_environment();
load_built_ins_into_environment(ret); push_environment(ret);
defer {
pop_environment();
};
load_built_ins_into_environment();
Parser::environment_for_macros = ret; Parser::environment_for_macros = ret;
// save the current working directory // save the current working directory
char* cwd = get_cwd(); char* cwd = get_cwd();
defer { defer {
change_cwd(cwd);
free(cwd); free(cwd);
}; };
@@ -370,9 +376,7 @@ namespace Memory {
change_cwd(exe_path); change_cwd(exe_path);
free(exe_path); free(exe_path);
built_in_load(Memory::create_string("pre.slime"), ret); built_in_load(Memory::create_string("pre.slime"));
change_cwd(cwd);
return ret; return ret;
} }
src/parse.cpp
+3 -3
View File
@@ -426,7 +426,7 @@ namespace Parser {
inject_scl(macro); inject_scl(macro);
// macro->value.function = function; // macro->value.function = function;
define_symbol(symbol_for_macro, macro, environment_for_macros); define_symbol(symbol_for_macro, macro);
// print_environment(environment_for_macros); // print_environment(environment_for_macros);
return Memory::nil; return Memory::nil;
@@ -452,7 +452,7 @@ namespace Parser {
// if not it is regular code, dont touch. // if not it is regular code, dont touch.
break; break;
Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros); Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment());
if (macro && if (macro &&
Memory::get_type(macro) == Lisp_Object_Type::Function && Memory::get_type(macro) == Lisp_Object_Type::Function &&
macro->value.function.type == Function_Type::Macro) macro->value.function.type == Function_Type::Macro)
@@ -474,7 +474,7 @@ namespace Parser {
defer { defer {
macro->value.function.type = Function_Type::Macro; macro->value.function.type = Function_Type::Macro;
}; };
try expression = eval_expr(expression, environment_for_macros); try expression = eval_expr(expression);
break; break;
} else break; } else break;
} }
src/structs.cpp
+14 -7
View File
@@ -16,6 +16,7 @@ enum struct Lisp_Object_Type {
Number, Number,
String, String,
Pair, Pair,
Continuation,
// Pointer, // Pointer,
// OwningPointer, // OwningPointer,
Function, Function,
@@ -44,6 +45,11 @@ enum struct Log_Level {
Debug, Debug,
}; };
struct Continuation {
Lisp_Object_Array_List* call_stack;
Environment_Array_List* envi_stack;
};
struct String { struct String {
int length; int length;
char data; char data;
@@ -96,7 +102,7 @@ struct Function {
}; };
struct cFunction { struct cFunction {
std::function<Lisp_Object* (Lisp_Object*, Environment*)> function; std::function<Lisp_Object* (Lisp_Object*)> function;
}; };
struct Lisp_Object { struct Lisp_Object {
@@ -105,12 +111,13 @@ struct Lisp_Object {
Lisp_Object* userType; Lisp_Object* userType;
String* docstring; String* docstring;
union { union {
Symbol symbol; // used for symbols and keywords Symbol symbol; // used for symbols and keywords
double number; double number;
String* string; String* string;
Pair pair; Pair pair;
Function function; Function function;
cFunction* cFunction; cFunction* cFunction;
Continuation continuation;
} value; } value;
}; };
src/testing.cpp
+27 -24
View File
@@ -197,7 +197,7 @@ proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string); Lisp_Object* operands = Parser::parse_single_expression(operands_string);
int operands_length; int operands_length;
try operands = eval_arguments(operands, get_root_environment(), &operands_length); try operands = eval_arguments(operands, &operands_length);
assert_no_error(); assert_no_error();
assert_equal_int(list_length(operands), 4); assert_equal_int(list_length(operands), 4);
@@ -342,7 +342,7 @@ proc test_built_in_add() -> testresult {
char exp_string[] = "(+ 10 4)"; char exp_string[] = "(+ 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -357,7 +357,7 @@ proc test_built_in_substract() -> testresult {
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -372,7 +372,7 @@ proc test_built_in_multiply() -> testresult {
char exp_string[] = "(* 10 4)"; char exp_string[] = "(* 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -387,7 +387,7 @@ proc test_built_in_divide() -> testresult {
char exp_string[] = "(/ 20 4)"; char exp_string[] = "(/ 20 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -402,7 +402,7 @@ proc test_built_in_if() -> testresult {
char exp_string1[] = "(if 1 4 5)"; char exp_string1[] = "(if 1 4 5)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -411,7 +411,7 @@ proc test_built_in_if() -> testresult {
char exp_string2[] = "(if () 4 5)"; char exp_string2[] = "(if () 4 5)";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -425,7 +425,7 @@ proc test_built_in_and() -> testresult {
char exp_string1[] = "(and 1 \"asd\" 4)"; char exp_string1[] = "(and 1 \"asd\" 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -434,7 +434,7 @@ proc test_built_in_and() -> testresult {
// a false case // a false case
char exp_string2[] = "(and () \"asd\" 4)"; char exp_string2[] = "(and () \"asd\" 4)";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -447,7 +447,7 @@ proc test_built_in_or() -> testresult {
char exp_string1[] = "(or \"asd\" nil)"; char exp_string1[] = "(or \"asd\" nil)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -456,7 +456,7 @@ proc test_built_in_or() -> testresult {
// a false case // a false case
char exp_string2[] = "(or () ())"; char exp_string2[] = "(or () ())";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -470,7 +470,7 @@ proc test_built_in_not() -> testresult {
char exp_string1[] = "(not ())"; char exp_string1[] = "(not ())";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
// a true case // a true case
assert_no_error(); assert_no_error();
@@ -480,7 +480,7 @@ proc test_built_in_not() -> testresult {
// a false case // a false case
char exp_string2[] = "(not \"asd xD\")"; char exp_string2[] = "(not \"asd xD\")";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, get_root_environment()); try result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -490,13 +490,13 @@ proc test_built_in_not() -> testresult {
} }
proc test_built_in_type() -> testresult { proc test_built_in_type() -> testresult {
Environment* env; // Environment* env;
try env = get_root_environment(); // try env = get_root_environment();
// normal type testing // normal type testing
char exp_string1[] = "(begin (define a 10)(type a))"; char exp_string1[] = "(begin (define a 10)(type a))";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, env); Lisp_Object* result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -506,7 +506,7 @@ proc test_built_in_type() -> testresult {
// setting user type // setting user type
char exp_string2[] = "(begin (set-type a :my-type)(type a))"; char exp_string2[] = "(begin (set-type a :my-type)(type a))";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
result = eval_expr(expression, env); result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -518,7 +518,7 @@ proc test_built_in_type() -> testresult {
expression = Parser::parse_single_expression(exp_string3); expression = Parser::parse_single_expression(exp_string3);
without_logging { without_logging {
result = eval_expr(expression, env); result = eval_expr(expression);
} }
assert_error(); assert_error();
@@ -527,7 +527,7 @@ proc test_built_in_type() -> testresult {
// deleting user type // deleting user type
char exp_string4[] = "(begin (delete-type a)(type a))"; char exp_string4[] = "(begin (delete-type a)(type a))";
expression = Parser::parse_single_expression(exp_string4); expression = Parser::parse_single_expression(exp_string4);
result = eval_expr(expression, env); result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -545,7 +545,7 @@ proc test_singular_t_and_nil() -> testresult {
char exp_string1[] = "()"; char exp_string1[] = "()";
char exp_string2[] = "nil"; char exp_string2[] = "nil";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result = eval_expr(expression, env); Lisp_Object* result = eval_expr(expression);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -553,7 +553,7 @@ proc test_singular_t_and_nil() -> testresult {
assert_equal_int(expression, result); assert_equal_int(expression, result);
Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2); Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2);
Lisp_Object* result2 = eval_expr(expression2, env); Lisp_Object* result2 = eval_expr(expression2);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -564,7 +564,7 @@ proc test_singular_t_and_nil() -> testresult {
// t testing // t testing
char exp_string3[] = "t"; char exp_string3[] = "t";
Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3); Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3);
Lisp_Object* result3 = eval_expr(expression3, env); Lisp_Object* result3 = eval_expr(expression3);
assert_no_error(); assert_no_error();
assert_not_null(result3); assert_not_null(result3);
@@ -580,9 +580,12 @@ proc test_file(const char* file) -> testresult {
Environment* user_env = Memory::create_child_environment(root_env); Environment* user_env = Memory::create_child_environment(root_env);
assert_no_error(); assert_no_error();
Parser::environment_for_macros = user_env; push_environment(user_env);
defer {
pop_environment();
};
built_in_load(Memory::create_string(file), user_env); built_in_load(Memory::create_string(file));
assert_no_error(); assert_no_error();
return pass; return pass;
todo.org
-3
View File
@@ -1,9 +1,7 @@
* TODO create global environment- and callstack
* TODO rename slime to plisk * TODO rename slime to plisk
* TODO rename modifying functions to prefix '!' * TODO rename modifying functions to prefix '!'
* TODO go through sicp and use the examples as test files * TODO go through sicp and use the examples as test files
* TODO test macro expanding to macro * TODO test macro expanding to macro
* TODO BUG 1: eval dot notation * TODO BUG 1: eval dot notation
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
@@ -20,4 +18,3 @@
;; should output 6 ;; should output 6
;; outputs 0 ;; outputs 0
#+END_SRC #+END_SRC