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

More cleanup

Browse Source
This commit is contained in:
Felix Brendel
2019-11-14 00:36:12 +01:00
parent 8dbff42bdf
commit 650eba7f18
23 changed files with 4086 additions and 2737 deletions
Download Patch File Download Diff File Expand all files Collapse all files
3rd/ftb
+1 -1
Submodule 3rd/ftb updated: abbd0b6280...3959dd2fc1
bin/generate-docs.slime
+3
View File
@@ -1,5 +1,8 @@
(import "alist.slime") (import "alist.slime")
(import "automata.slime")
(import "interpolation.slime")
(import "oo.slime") (import "oo.slime")
(import "math.slime") (import "math.slime")
(import "sets.slime")
(generate-docs "../manual/built-in-docs.org") (generate-docs "../manual/built-in-docs.org")
bin/import1.slime
-4
View File
@@ -1,4 +0,0 @@
(define a 10)
(define (get-a-1)
a)
bin/import2.slime
-8
View File
@@ -1,8 +0,0 @@
(import "import1.slime")
(define (set-a-2 s)
(set! a s))
(define (get-a-2)
a)
bin/interpolation.slime
-4
View File
@@ -43,7 +43,3 @@
(point-lerp (lerper1 t) (point-lerp (lerper1 t)
(lerper2 t) t)))) (lerper2 t) t))))
) )
(define sl1 (interpolation::stepped-lerper 0 1 5))
(define sl2 (interpolation::stepped-lerper 10 -10 20))
build.sh
+6 -6
View File
@@ -19,17 +19,17 @@ echo "----------------------"
echo "" echo ""
# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 # time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \ # time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
src/main.cpp -g -o ./bin/slime --std=c++17 \
-I3rd/ || exit 1
# time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \
# src/main.cpp -g -o ./bin/slime --std=c++17 \ # src/main.cpp -g -o ./bin/slime --std=c++17 \
# -I3rd/ || exit 1 # -I3rd/ || exit 1
time clang++ -O3 -D_DONT_BREAK_ON_ERRORS \
src/main.cpp -g -o ./bin/slime --std=c++17 \
-I3rd/ || exit 1
echo "" echo ""
pushd ./bin > /dev/null pushd ./bin > /dev/null
time valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests # time valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime --run-tests
# time ./slime --run-tests time ./slime --run-tests
popd > /dev/null popd > /dev/null
popd > /dev/null popd > /dev/null
manual/build.sh
Regular → Executable
View File
manual/built-in-docs.org
+1761 -856
View File
File diff suppressed because it is too large Load Diff
manual/manual.html
+2034 -1520
View File
File diff suppressed because it is too large Load Diff
manual/manual.org
+2 -2
View File
@@ -945,11 +945,11 @@ embedded scripting language.
# end: # end:
#+author: Felix Brendel #+author: Felix Brendel
#+mail: felix.brendel@airmail.cc #+mail: felixbrendel@airmail.cc
#+options: H:2 toc:nil #+options: H:2 toc:nil
#+macro: slime_header (eval (concat "#+header: :cache yes :exports both" "\n" "#+attr_latex: :options keywordstyle=\\color{slimeKeyword}, commentstyle=\\color{slimeComment}, stringstyle=\\color{slimeString}")) #+macro: slime_header (eval (concat "#+header: :cache yes :exports both" "\n" "#+attr_latex: :options keywordstyle=\\color{slimeKeyword}, commentstyle=\\color{slimeComment}, stringstyle=\\color{slimeString}"))
#+macro: ditaa_header (eval (concat "#+header: :exports results :cmdline --no-separation --no-shadows")) #+macro: ditaa_header (eval (concat "#+header: :cache yes :exports results :cmdline --no-separation --no-shadows"))
#+latex_class:article #+latex_class:article
src/built_ins.cpp
+13 -11
View File
@@ -726,7 +726,7 @@ proc load_built_ins_into_environment() -> void {
fetch(hm, key); fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap); try assert_type(hm, Lisp_Object_Type::HashMap);
Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap.get_object(key); Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key);
if (!ret) if (!ret)
create_symbol_undefined_error("The key was not set in the hashmap"); create_symbol_undefined_error("The key was not set in the hashmap");
@@ -735,13 +735,13 @@ proc load_built_ins_into_environment() -> void {
define((hash-map-set! hm key value), "TODO") { define((hash-map-set! hm key value), "TODO") {
fetch(hm, key, value); fetch(hm, key, value);
try assert_type(hm, Lisp_Object_Type::HashMap); try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap.set_object(key, value); hm->value.hashMap->set_object(key, value);
return Memory::nil; return Memory::nil;
}; };
define((hash-map-delete! hm key), "TODO") { define((hash-map-delete! hm key), "TODO") {
fetch(hm, key); fetch(hm, key);
try assert_type(hm, Lisp_Object_Type::HashMap); try assert_type(hm, Lisp_Object_Type::HashMap);
hm->value.hashMap.delete_object(key); hm->value.hashMap->delete_object(key);
return Memory::nil; return Memory::nil;
}; };
define((vector . args), "TODO") { define((vector . args), "TODO") {
@@ -862,17 +862,17 @@ proc load_built_ins_into_environment() -> void {
printf("Postitional: {"); printf("Postitional: {");
if (args->positional.symbols.next_index != 0) { if (args->positional.symbols.next_index != 0) {
printf("%s", printf("%s",
Memory::get_c_str(args->positional.symbols.data[0]->value.symbol.identifier)); Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
for (int i = 1; i < args->positional.symbols.next_index; ++i) { for (int i = 1; i < args->positional.symbols.next_index; ++i) {
printf(", %s", printf(", %s",
Memory::get_c_str(args->positional.symbols.data[i]->value.symbol.identifier)); Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
} }
} }
printf("}\n"); printf("}\n");
printf("Keyword: {"); printf("Keyword: {");
if (args->keyword.values.next_index != 0) { if (args->keyword.values.next_index != 0) {
printf("%s", printf("%s",
Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol.identifier)); Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
if (args->keyword.values.data[0]) { if (args->keyword.values.data[0]) {
printf(" ("); printf(" (");
print(args->keyword.values.data[0], true); print(args->keyword.values.data[0], true);
@@ -880,7 +880,7 @@ proc load_built_ins_into_environment() -> void {
} }
for (int i = 1; i < args->keyword.values.next_index; ++i) { for (int i = 1; i < args->keyword.values.next_index; ++i) {
printf(", %s", printf(", %s",
Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol.identifier)); Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) { if (args->keyword.values.data[i]) {
printf(" ("); printf(" (");
print(args->keyword.values.data[i], true); print(args->keyword.values.data[i], true);
@@ -892,7 +892,7 @@ proc load_built_ins_into_environment() -> void {
printf("Rest: {"); printf("Rest: {");
if (args->rest) if (args->rest)
printf("%s", printf("%s",
Memory::get_c_str(args->rest->value.symbol.identifier)); Memory::get_c_str(args->rest->value.symbol));
printf("}\n"); printf("}\n");
} }
@@ -918,7 +918,9 @@ proc load_built_ins_into_environment() -> void {
define((generate-docs file_name), "TODO") { define((generate-docs file_name), "TODO") {
fetch(file_name); fetch(file_name);
try assert_type(file_name, Lisp_Object_Type::String); try assert_type(file_name, Lisp_Object_Type::String);
// try generate_docs(file_name->value.string); in_caller_env {
try generate_docs(file_name->value.string);
}
return Memory::t; return Memory::t;
}; };
define((print (:sep " ") (:end "\n") . things), "TODO") { define((print (:sep " ") (:end "\n") . things), "TODO") {
@@ -1025,7 +1027,7 @@ proc load_built_ins_into_environment() -> void {
define((symbol->keyword sym), "TODO") { define((symbol->keyword sym), "TODO") {
fetch(sym); fetch(sym);
try assert_type(sym, Lisp_Object_Type::Symbol); try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::get_or_create_lisp_object_keyword(sym->value.symbol.identifier); return Memory::get_or_create_lisp_object_keyword(sym->value.symbol);
}; };
define((string->symbol str), "TODO") { define((string->symbol str), "TODO") {
fetch(str); fetch(str);
@@ -1041,7 +1043,7 @@ proc load_built_ins_into_environment() -> void {
try assert_type(sym, Lisp_Object_Type::Symbol); try assert_type(sym, Lisp_Object_Type::Symbol);
return Memory::create_lisp_object_string( return Memory::create_lisp_object_string(
Memory::duplicate_string(sym->value.symbol.identifier)); Memory::duplicate_string(sym->value.symbol));
}; };
define((concat-strings . strings), "TODO") { define((concat-strings . strings), "TODO") {
fetch(strings); fetch(strings);
src/define_macros.hpp
+4 -4
View File
@@ -5,7 +5,7 @@
do { \ do { \
if (Globals::log_level == Log_Level::Debug) { \ if (Globals::log_level == Log_Level::Debug) { \
printf("in"); \ printf("in"); \
int spacing = 30-(int)strlen(__FILE__); \ int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\
if (spacing < 1) spacing = 1; \ if (spacing < 1) spacing = 1; \
for (int i = 0; i < spacing;++i) \ for (int i = 0; i < spacing;++i) \
printf(" "); \ printf(" "); \
@@ -14,11 +14,11 @@
} \ } \
} while(0) } while(0)
#define if_error_log_location_and_return() \ #define if_error_log_location_and_return(val) \
do { \ do { \
if (Globals::error) { \ if (Globals::error) { \
log_location(); \ log_location(); \
return; \ return val; \
} \ } \
} while(0) } while(0)
@@ -51,7 +51,7 @@
#define fetch1(var) \ #define fetch1(var) \
Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \ Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__) if_error_log_location_and_return(nullptr)
#define fetch2(var1, var2) fetch1(var1); fetch1(var2) #define fetch2(var1, var2) fetch1(var1); fetch1(var2)
#define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) #define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3)
src/docgeneration.cpp
+135 -146
View File
@@ -1,157 +1,146 @@
// proc generate_docs(String* path) -> void { proc generate_docs(String* path) -> void {
// FILE *f = fopen(Memory::get_c_str(path), "w"); FILE *f = fopen(Memory::get_c_str(path), "w");
// if (!f) { if (!f) {
// create_generic_error("The file for writing the documentation (%s) " create_generic_error("The file for writing the documentation (%s) "
// "could not be opened for writing.", Memory::get_c_str(path)); "could not be opened for writing.", Memory::get_c_str(path));
// return; return;
// } }
// defer { defer {
// fclose(f); fclose(f);
// }; };
// Environment_Array_List visited = create_Environment_array_list(); Array_List<Environment*> visited;
// // recursive inner funciton const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
// std::function<void(Environment*, char* prefix)> print_this_env; bool we_already_printed = false;
// print_this_env = [&](Environment* env, char* prefix) -> void { // TODO(Felix): Make a generic array_list_contains function
// bool we_already_printed = false; for(auto it : visited) {
// // TODO(Felix): Make a generic array_list_contains function if (it == env) {
// for_array_list(visited) { we_already_printed = true;
// if (it == env) { break;
// we_already_printed = true; }
// break; }
// } if (!we_already_printed) {
// } // printf("Working on env::::");
// if (!we_already_printed) {
// printf("Working ion env::::");
// print_environment(env); // print_environment(env);
// printf("\n--------------------------------\n"); // printf("\n--------------------------------\n");
// append_to_array_list(&visited, env); visited.append(env);
// push_environment(env); push_environment(env);
// defer { defer {
// pop_environment(); pop_environment();
// }; };
// for (int i = 0; i < env->next_index; ++i) { for_hash_map(env->hm) {
// fprintf(f, "\\hrule\n* =%s%s= \n" try_void fprintf(f,
// // " :PROPERTIES:\n" "#+latex: \\hrule\n"
// // " :UNNUMBERED: t\n" "#+html: <hr/>\n"
// // " :END:" "* =%s%s= \n"
// ,prefix, env->keys[i]); " :PROPERTIES:\n"
// /* " :UNNUMBERED: t\n"
// * sourcecodeLocation " :END:"
// */ ,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
// if (env->values[i]->sourceCodeLocation) { /*
// try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", * sourcecodeLocation
// Memory::get_c_str(env->values[i]->sourceCodeLocation->file), */
// env->values[i]->sourceCodeLocation->line, if (value->sourceCodeLocation) {
// env->values[i]->sourceCodeLocation->column); try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
// } Memory::get_c_str(value->sourceCodeLocation->file),
// /* value->sourceCodeLocation->line,
// * type value->sourceCodeLocation->column);
// */ }
// Lisp_Object_Type type = Memory::get_type(env->values[i]); /*
// Lisp_Object* LOtype; * type
// try_void LOtype = eval_expr(Memory::create_list( */
// Memory::get_or_create_lisp_object_symbol("type"), Lisp_Object_Type type = Memory::get_type(value);
// env->values[i])); Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(
Memory::get_or_create_lisp_object_symbol("type"),
value);
try_void LOtype = eval_expr(type_expr);
// fprintf(f, "\n - type :: ="); fprintf(f, "\n - type :: =");
// print(LOtype, true, f); print(LOtype, true, f);
// fprintf(f, "="); fprintf(f, "=");
// /* /*
// * if printable value -> print it * if printable value -> print it
// */ */
// switch (type) { switch (type) {
// case(Lisp_Object_Type::Nil): case(Lisp_Object_Type::Nil):
// case(Lisp_Object_Type::T): case(Lisp_Object_Type::T):
// case(Lisp_Object_Type::Number): case(Lisp_Object_Type::Number):
// case(Lisp_Object_Type::String): case(Lisp_Object_Type::String):
// case(Lisp_Object_Type::Pair): case(Lisp_Object_Type::Pair):
// case(Lisp_Object_Type::Symbol): case(Lisp_Object_Type::Symbol):
// case(Lisp_Object_Type::Keyword): { case(Lisp_Object_Type::Keyword): {
// fprintf(f, "\n - value :: ="); fprintf(f, "\n - value :: =");
// print(env->values[i], true, f); print(value, true, f);
// fprintf(f, "="); fprintf(f, "=");
// } break; } break;
// default: break; default: break;
// } }
// /* /*
// * if function then print arguments * if function then print arguments
// */ */
// if (type == Lisp_Object_Type::Function) { if (type == Lisp_Object_Type::Function ||
// Lisp_Object* fun = env->values[i]; type == Lisp_Object_Type::CFunction)
// bool printed_at_least_some_args = false; {
// fprintf(f, "\n - arguments :: "); Arguments* args =
// if (fun->value.function.args.positional.symbols.next_index != 0) { (type == Lisp_Object_Type::Function)
// if (!printed_at_least_some_args) ? &value->value.function->args
// fprintf(f, ":"); : &value->value.cFunction->args;
// fprintf(f, "\n - postitional :: "); fprintf(f, "\n - arguments :: ");
// try_void fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[0]->value.symbol.identifier)); // if no args at all
// for (int i = 1; i < fun->value.function.args.positional.symbols.next_index; ++i) { if (args->positional.symbols.next_index == 0 &&
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.positional.symbols.data[i]->value.symbol.identifier)); args->keyword.values.next_index == 0 &&
// } !args->rest)
// } {
// if (fun->value.function.args.keyword.values.next_index != 0) { fprintf(f, "none.");
// if (!printed_at_least_some_args) } else {
// fprintf(f, ":"); if (args->positional.symbols.next_index != 0) {
// fprintf(f, "\n - keyword :: "); fprintf(f, "\n - postitional :: ");
// fprintf(f, "=%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[0]->value.symbol.identifier)); fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
// if (fun->value.function.args.keyword.values.data[0]) { for (int i = 1; i < args->positional.symbols.next_index; ++i) {
// fprintf(f, " =("); fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
// print(fun->value.function.args.keyword.values.data[0], true, f); }
// fprintf(f, ")="); }
// } if (args->keyword.values.next_index != 0) {
// for (int i = 1; i < fun->value.function.args.keyword.values.next_index; ++i) { fprintf(f, "\n - keyword :: ");
// fprintf(f, ", =%s=", Memory::get_c_str(fun->value.function.args.keyword.keywords.data[i]->value.symbol.identifier)); fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
// if (fun->value.function.args.keyword.values.data[i]) { if (args->keyword.values.data[0]) {
// fprintf(f, " =("); fprintf(f, " =(");
// print(fun->value.function.args.keyword.values.data[i], true, f); print(args->keyword.values.data[0], true, f);
// fprintf(f, ")="); fprintf(f, ")=");
// } }
// } for (int i = 1; i < args->keyword.values.next_index; ++i) {
// } fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
// if (fun->value.function.args.rest) { if (args->keyword.values.data[i]) {
// if (!printed_at_least_some_args) fprintf(f, " =(");
// fprintf(f, ":"); print(args->keyword.values.data[i], true, f);
// fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(fun->value.function.args.rest->value.symbol.identifier)); fprintf(f, ")=");
// } }
// // if no args at all }
// if (fun->value.function.args.positional.symbols.next_index == 0 && }
// fun->value.function.args.keyword.values.next_index == 0 && if (args->rest) {
// !fun->value.function.args.rest) fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
// { }
// fprintf(f, "none."); }
// } }
// } fprintf(f, "\n - docu :: ");
// fprintf(f, "\n - docu :: "); if (value->docstring)
// if (env->values[i]->docstring) fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", Memory::get_c_str(value->docstring));
// Memory::get_c_str(env->values[i]->docstring)); else
// else fprintf(f, "none\n");
// fprintf(f, "none\n"); }
}
// // if (Memory::get_type(env->values[i]) == Lisp_Object_Type::Function && for (int i = 0; i < env->parents.next_index; ++i) {
// // env->values[i]->userType && try_void rec(rec, env->parents.data[i], prefix);
// // (string_equal(env->values[i]->userType->value.symbol.identifier, "package") || }
// // string_equal(env->values[i]->userType->value.symbol.identifier, "constructor"))) };
// // {
// // char new_prefix[200];
// // strcpy(new_prefix, prefix);
// // strcat(new_prefix, env->keys[i]);
// // strcat(new_prefix, " ");
// // print_this_env(env->values[i]->value.function.parent_environment, new_prefix);
// // }
// }
// }
// for (int i = 0; i < env->parents.next_index; ++i) { print_this_env(print_this_env, get_current_environment(), (char*)"");
// print_this_env(env->parents.data[i], prefix); }
// }
// };
// print_this_env(get_current_environment(), (char*)"");
// }
src/env.cpp
+2 -2
View File
@@ -77,7 +77,7 @@ proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
if (result) if (result)
return result; return result;
String* identifier = node->value.symbol.identifier; String* identifier = node->value.symbol;
print_environment(env); print_environment(env);
printf("\n"); printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
@@ -100,7 +100,7 @@ proc print_environment_indent(Environment* env, int indent) -> void {
for_hash_map (env->hm) { for_hash_map (env->hm) {
print_indent(indent); print_indent(indent);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol.identifier->data)); printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value); print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value); printf(" (0x%016llx)", (unsigned long long)value);
puts(""); puts("");
src/error.cpp
+8 -13
View File
@@ -11,17 +11,16 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
debug_break(); debug_break();
} }
if (Globals::log_level > Log_Level::None) { using Globals::error;
// pretty error sign error = (Error*)malloc(sizeof(Error)) ;
for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i) error->type = type;
printf("-"); error->message = message;
printf("\n Error - %s\n", Memory::get_c_str(message));
for (int i = 0; i < 10+strlen(Memory::get_c_str(message));++i)
printf("-");
log_error();
if (Globals::log_level > Log_Level::None) {
// c error location // c error location
printf("\nin"); printf("in");
int spacing = 30-((int)strlen(c_file_name) - (int)log10(c_file_line)); int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line));
if (spacing < 1) spacing = 1; if (spacing < 1) spacing = 1;
for (int i = 0; i < spacing; ++i) for (int i = 0; i < spacing; ++i)
printf(" "); printf(" ");
@@ -30,10 +29,6 @@ proc create_error(const char* c_func_name,const char* c_file_name, int c_file_li
} }
// visualize_lisp_machine(); // visualize_lisp_machine();
using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
error->message = message;
} }
proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
src/eval.cpp
+17 -51
View File
@@ -103,7 +103,7 @@ proc create_extended_environment_for_function_application(
"The function does not take the keyword argument ':%s'\n" "The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n" "and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.", "in to potentially count it as the rest argument.",
&(arguments->value.pair.first->value.symbol.identifier->data)); &(arguments->value.pair.first->value.symbol->data));
return; return;
} }
@@ -119,7 +119,7 @@ proc create_extended_environment_for_function_application(
return; return;
create_generic_error( create_generic_error(
"The function already read the keyword argument ':%s'", "The function already read the keyword argument ':%s'",
&(arguments->value.pair.first->value.symbol.identifier->data)); &(arguments->value.pair.first->value.symbol->data));
return; return;
} }
} }
@@ -130,12 +130,12 @@ proc create_extended_environment_for_function_application(
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error( create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.", "Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->value.symbol.identifier->data)); &(arguments->value.pair.first->value.symbol->data));
return; return;
} }
// if not set it and then add it to the array list // if not set it and then add it to the array list
try_void sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier); try_void sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol);
// 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...
if (is_c_function) { if (is_c_function) {
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first);
@@ -176,14 +176,14 @@ proc create_extended_environment_for_function_application(
create_generic_error( create_generic_error(
"There was no value supplied for the required " "There was no value supplied for the required "
"keyword argument ':%s'.", "keyword argument ':%s'.",
&defined_keyword->value.symbol.identifier->data); &defined_keyword->value.symbol->data);
return; return;
} }
} else { } else {
// this one does have a default value, lets see if we have // this one does have a default value, lets see if we have
// to use it or if the user supplied his own // to use it or if the user supplied his own
if (!was_set) { if (!was_set) {
try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword->value.symbol.identifier); try_void sym = Memory::get_or_create_lisp_object_symbol(defined_keyword->value.symbol);
if (is_c_function) { if (is_c_function) {
try_void val = arg_spec->keyword.values.data[i]; try_void val = arg_spec->keyword.values.data[i];
} else { } else {
@@ -398,11 +398,6 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
using namespace Globals::Current_Execution; using namespace Globals::Current_Execution;
call_stack.append(node); call_stack.append(node);
defer { defer {
// NOTE(Felix): We only delete the current entry from the call
// stack, if we did not encounter an error, otherwise we neet
// to preserve the callstack to print it later. it will be
// cleared in log_error().
if (!Globals::error)
--call_stack.next_index; --call_stack.next_index;
}; };
@@ -492,37 +487,16 @@ proc is_truthy(Lisp_Object* expression) -> bool {
proc interprete_file (char* file_name) -> Lisp_Object* { proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256); try Memory::init(4096 * 256);
Environment* root_env = get_root_environment();
Environment* user_env;
try user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer {
pop_environment();
};
Lisp_Object* result = built_in_load(Memory::create_string(file_name)); Lisp_Object* result;
try result = built_in_load(Memory::create_string(file_name));
if (Globals::error) {
log_error();
delete_error();
return nullptr;
}
return result; return result;
} }
proc interprete_stdin() -> void { proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100); try_void Memory::init(4096 * 256* 100);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer {
pop_environment();
};
if (Globals::error) {
log_error();
delete_error();
return;
}
printf("Welcome to the lispy interpreter.\n"); printf("Welcome to the lispy interpreter.\n");
@@ -530,27 +504,19 @@ proc interprete_stdin() -> void {
Lisp_Object* parsed, * evaluated; Lisp_Object* parsed, * evaluated;
while (true) { while (true) {
printf("> "); [&] {
delete_error();
fputs("> ", stdout);
line = read_expression(); line = read_expression();
defer { defer {
free(line); free(line);
}; };
parsed = Parser::parse_single_expression(line); try_void parsed = Parser::parse_single_expression(line);
if (Globals::error) { try_void evaluated = eval_expr(parsed);
log_error();
delete_error();
continue;
}
evaluated = eval_expr(parsed);
if (Globals::error) {
log_error();
delete_error();
continue;
}
if (evaluated != Memory::nil) { if (evaluated != Memory::nil) {
print(evaluated); print(evaluated);
printf("\n"); fputs("\n", stdout);
} }
}();
} }
} }
src/forward_decls.cpp
+1
View File
@@ -29,6 +29,7 @@ const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
void visualize_lisp_machine(); void visualize_lisp_machine();
void generate_docs(String* path); void generate_docs(String* path);
void log_error();
namespace Memory { namespace Memory {
Environment* create_built_ins_environment(); Environment* create_built_ins_environment();
src/io.cpp
+5 -5
View File
@@ -311,12 +311,12 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
fprintf(file, "%f", node->value.number); fprintf(file, "%f", node->value.number);
} 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)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); 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::Pointer): fputs("[pointer]", file); break; case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): { case (Lisp_Object_Type::HashMap): {
for_hash_map (node->value.hashMap) { for_hash_map (*(node->value.hashMap)) {
fputs(" ", file); fputs(" ", file);
print(key, true, file); print(key, true, file);
fputs(" -> ", file); fputs(" -> ", file);
@@ -347,7 +347,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
} break; } break;
case (Lisp_Object_Type::Function): { case (Lisp_Object_Type::Function): {
if (node->userType) { if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier)); fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break; break;
} }
if (node->value.function->type == Function_Type::Lambda) if (node->value.function->type == Function_Type::Lambda)
@@ -365,7 +365,7 @@ proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
// first check if it is a quotation form, in that case we want // first check if it is a quotation form, in that case we want
// to print it prettier // to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol.identifier; String* identifier = head->value.pair.first->value.symbol;
auto symbol = head->value.pair.first; auto symbol = head->value.pair.first;
@@ -458,5 +458,5 @@ proc log_error() -> void {
puts(console_normal); puts(console_normal);
// HACK(Felix): we should control the stack size in eval_expr not here // HACK(Felix): we should control the stack size in eval_expr not here
Globals::Current_Execution::call_stack.next_index = 0; // Globals::Current_Execution::call_stack.next_index = 0;
} }
src/lisp_object.cpp
+1 -1
View File
@@ -34,7 +34,7 @@ Lisp_Object::~Lisp_Object() {
switch (Memory::get_type(this)) { switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: { case Lisp_Object_Type::HashMap: {
this->value.hashMap.~Hash_Map(); delete this->value.hashMap;
} break; } break;
case Lisp_Object_Type::CFunction: { case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List(); this->value.cFunction->args.positional.symbols.~Array_List();
src/main.cpp
+1 -1
View File
@@ -4,8 +4,8 @@ int main(int argc, char* argv[]) {
if (argc > 1) { if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) { if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests(); int res = Slime::run_all_tests();
// Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
Slime::Memory::free_everything(); Slime::Memory::free_everything();
// Slime::interprete_file((char*)"generate-docs.slime");
#ifdef _MSC_VER #ifdef _MSC_VER
_CrtDumpMemoryLeaks(); _CrtDumpMemoryLeaks();
#endif #endif
src/memory.cpp
+35 -28
View File
@@ -138,6 +138,28 @@ namespace Memory {
}); });
} }
proc create_child_environment(Environment* parent) -> Environment* {
Environment* env = environment_memory.allocate();
// inject a new array list;
new(&env->parents) Array_List<Environment*>;
if (parent)
env->parents.append(parent);
new(&env->hm) Hash_Map<void*, Lisp_Object*>;
return env;
}
proc create_empty_environment() -> Environment* {
Environment* ret;
try ret = create_child_environment(nullptr);
return ret;
}
proc init(int sms) -> void { proc init(int sms) -> void {
char* exe_path = get_exe_dir(); char* exe_path = get_exe_dir();
defer {free(exe_path);}; defer {free(exe_path);};
@@ -163,6 +185,10 @@ namespace Memory {
Environment* env; Environment* env;
try_void env = create_built_ins_environment(); try_void env = create_built_ins_environment();
push_environment(env); push_environment(env);
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
} }
proc reset() -> void { proc reset() -> void {
@@ -189,8 +215,8 @@ namespace Memory {
object_memory.~Bucket_Allocator(); object_memory.~Bucket_Allocator();
environment_memory.~Bucket_Allocator(); environment_memory.~Bucket_Allocator();
::new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8); new(&object_memory) Bucket_Allocator<Lisp_Object>(1024, 8);
::new(&environment_memory) Bucket_Allocator<Environment>(1024, 8); new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
next_free_spot_in_string_memory = string_memory; next_free_spot_in_string_memory = string_memory;
@@ -207,6 +233,10 @@ namespace Memory {
Environment* env; Environment* env;
try_void env = create_built_ins_environment(); try_void env = create_built_ins_environment();
push_environment(env); push_environment(env);
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
} }
proc create_lisp_object_pointer(void* ptr) -> Lisp_Object* { proc create_lisp_object_pointer(void* ptr) -> Lisp_Object* {
@@ -221,7 +251,7 @@ namespace Memory {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::HashMap); set_type(node, Lisp_Object_Type::HashMap);
::new((&node->value.hashMap)) Hash_Map<Lisp_Object*, Lisp_Object*>; node->value.hashMap = new Hash_Map<Lisp_Object*, Lisp_Object*>;
return node; return node;
} }
@@ -284,8 +314,7 @@ namespace Memory {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Symbol); set_type(node, Lisp_Object_Type::Symbol);
node->value.symbol.identifier = identifier; node->value.symbol = identifier;
node->value.symbol.hash = hash(identifier);
global_symbol_table.set_object(get_c_str(identifier), node); global_symbol_table.set_object(get_c_str(identifier), node);
return node; return node;
} }
@@ -294,8 +323,7 @@ namespace Memory {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Keyword); set_type(node, Lisp_Object_Type::Keyword);
node->value.symbol.identifier = keyword; node->value.symbol = keyword;
node->value.symbol.hash = hash(keyword);
global_keyword_table.set_object(get_c_str(keyword), node); global_keyword_table.set_object(get_c_str(keyword), node);
return node; return node;
} }
@@ -388,27 +416,6 @@ namespace Memory {
return copy_lisp_object(n); return copy_lisp_object(n);
} }
proc create_child_environment(Environment* parent) -> Environment* {
Environment* env = environment_memory.allocate();
// inject a new array list;
::new(&env->parents) Array_List<Environment*>;
if (parent)
env->parents.append(parent);
::new(&env->hm) Hash_Map<void*, Lisp_Object*>;
return env;
}
proc create_empty_environment() -> Environment* {
Environment* ret;
try ret = create_child_environment(nullptr);
return ret;
}
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();
src/structs.cpp
+3 -13
View File
@@ -60,16 +60,6 @@ struct Source_Code_Location {
int column; int column;
}; };
struct Symbol {
String* identifier;
u64 hash;
};
struct Keyword {
String* identifier;
u64 hash;
};
struct Pair { struct Pair {
Lisp_Object* first; Lisp_Object* first;
Lisp_Object* rest; Lisp_Object* rest;
@@ -129,7 +119,7 @@ struct Lisp_Object {
Lisp_Object* userType; // keyword Lisp_Object* userType; // keyword
String* docstring; String* docstring;
union value { union value {
Symbol symbol; // used for symbols and keywords String* symbol; // used for symbols and keywords
double number; double number;
String* string; String* string;
Pair pair; Pair pair;
@@ -137,8 +127,8 @@ struct Lisp_Object {
Function* function; Function* function;
cFunction* cFunction; cFunction* cFunction;
void* pointer; void* pointer;
Continuation continuation; Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*> hashMap; Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {} ~value() {}
} value; } value;
~Lisp_Object(); ~Lisp_Object();
src/testing.cpp
+27 -34
View File
@@ -219,7 +219,7 @@ proc test_eval_operands() -> testresult {
assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword);
assert_equal_string(operands->value.pair.first->value.symbol.identifier, "haha"); assert_equal_string(operands->value.pair.first->value.symbol, "haha");
return pass; return pass;
} }
@@ -256,26 +256,26 @@ proc test_parse_atom() -> testresult {
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "key1"); assert_equal_string(result->value.symbol, "key1");
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "key:2"); assert_equal_string(result->value.symbol, "key:2");
// test symbols // test symbols
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol.identifier, "sym"); assert_equal_string(result->value.symbol, "sym");
++index_in_text; ++index_in_text;
result = Parser::parse_atom(string, &index_in_text); result = Parser::parse_atom(string, &index_in_text);
assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_type(result, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.symbol.identifier, "+"); assert_equal_string(result->value.symbol, "+");
return pass; return pass;
} }
@@ -289,13 +289,13 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun"); assert_equal_string(result->value.pair.first->value.symbol, "fun");
result = result->value.pair.rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "+"); assert_equal_string(result->value.pair.first->value.symbol, "+");
result = result->value.pair.rest; result = result->value.pair.rest;
@@ -315,20 +315,20 @@ proc test_parse_expression() -> testresult {
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "define"); assert_equal_string(result->value.pair.first->value.symbol, "define");
result = result->value.pair.rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.symbol.identifier, "fun"); assert_equal_string(result->value.pair.first->value.symbol, "fun");
result = result->value.pair.rest; result = result->value.pair.rest;
assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair);
assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol);
assert_equal_string(result->value.pair.first->value.pair.first->value.symbol.identifier, "lambda"); assert_equal_string(result->value.pair.first->value.pair.first->value.symbol, "lambda");
result = result->value.pair.rest; result = result->value.pair.rest;
@@ -498,7 +498,7 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "number"); assert_equal_string(result->value.symbol, "number");
// 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))";
@@ -508,21 +508,21 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "my-type"); assert_equal_string(result->value.symbol, "my-type");
// trying to set invalid user type // // trying to set invalid user type
char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))"; // char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3); // expression = Parser::parse_single_expression(exp_string3);
assert_no_error(); // assert_no_error();
ignore_logging { // ignore_logging {
dont_break_on_errors { // dont_break_on_errors {
result = eval_expr(expression); // result = eval_expr(expression);
} // }
} // }
assert_error(); // assert_error();
delete_error(); // delete_error();
// deleting user type // deleting user type
char exp_string4[] = "(begin (delete-type! a)(type a))"; char exp_string4[] = "(begin (delete-type! a)(type a))";
@@ -532,7 +532,7 @@ proc test_built_in_type() -> testresult {
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_type(result, Lisp_Object_Type::Keyword);
assert_equal_string(result->value.symbol.identifier, "number"); assert_equal_string(result->value.symbol, "number");
return pass; return pass;
} }
@@ -607,17 +607,11 @@ proc run_all_tests() -> bool {
bool result = true; bool result = true;
try Memory::init(409600); try Memory::init(409600);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);
defer{
pop_environment();
};
printf("-- Util --\n"); printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing); // invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting); // invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching); // invoke_test(test_array_lists_searching);
printf("\n -- Parsing --\n"); printf("\n -- Parsing --\n");
invoke_test(test_parse_atom); invoke_test(test_parse_atom);
@@ -643,7 +637,6 @@ proc run_all_tests() -> bool {
printf("\n-- Test Files --\n"); printf("\n-- Test Files --\n");
// print_environment(get_current_environment());
invoke_test_script("evaluation_of_default_args"); invoke_test_script("evaluation_of_default_args");
invoke_test_script("alists"); invoke_test_script("alists");
invoke_test_script("case_and_cond"); invoke_test_script("case_and_cond");