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

now use global symbol tables so symbols and keywords are finally unique

Browse Source
This commit is contained in:
FelixBrendel
2019-10-03 18:28:17 +02:00
parent 2cc076fa43
commit 64c1511a89
6 changed files with 180 additions and 260 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+3 -3
View File
@@ -106,9 +106,9 @@ proc load_built_ins_into_environment() -> void {
String* file_name_built_ins = Memory::create_string(__FILE__);
#define fetch1(var) \
Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
#define fetch1(var) \
static Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \
Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__)
#define fetch2(var1, var2) fetch1(var1); fetch1(var2)
src/defines.cpp
+113 -117
View File
@@ -36,6 +36,7 @@
break; \
} \
else label(body,__LINE__):
;
#define try_struct try_or_else_return({})
#define try_void try_or_else_return()
@@ -44,138 +45,133 @@
#define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false)
#define ignore_logging fluid_let(Globals::log_level, Log_Level::None)
#define define_array_list(type, name) \
struct name##_Array_List { \
type* data; \
int length; \
int next_index; \
}; \
\
proc remove_index_from_array_list(name##_Array_List* arraylist, int index) -> void { \
arraylist->data[index] = \
arraylist->data[--(arraylist->next_index)]; \
} \
\
proc append_to_array_list(name##_Array_List* arraylist, type element) -> void { \
if (arraylist->next_index == arraylist->length) { \
arraylist->length *= 2; \
arraylist->data = \
(type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \
} \
arraylist->data[arraylist->next_index] = element; \
arraylist->next_index++; \
} \
\
proc _merge_array_lists(name##_Array_List* arr, int start, int mid, int end) -> void { \
int start2 = mid + 1; \
\
/* If the direct merge is already sorted */ \
if ((size_t)arr->data[mid] <= (size_t)arr->data[start2]) { \
return; \
} \
\
/* Two pointers to maintain start of both arrays to merge */ \
while (start <= mid && start2 <= end) { \
if ((size_t)arr->data[start] <= (size_t)arr->data[start2]) { \
start++; \
} \
else { \
type value = arr->data[start2]; \
int index = start2; \
\
/* Shift all the elements between element 1; element 2, right by 1. */ \
while (index != start) { \
arr->data[index] = arr->data[index - 1]; \
index--; \
} \
arr->data[start] = value; \
\
/* Update all the pointers */ \
start++; \
mid++; \
start2++; \
} \
} \
} \
\
proc sort_array_list(name##_Array_List* arraylist, int left=-1, int right=-1) -> void { \
if (left == -1) { \
sort_array_list(arraylist, 0, arraylist->next_index - 1); \
return; \
} else if (left == right) { \
return; \
} \
\
int middle = left + (right-left) / 2; \
\
sort_array_list(arraylist, left, middle); \
sort_array_list(arraylist, middle+1, right); \
\
_merge_array_lists(arraylist, left, middle, right); \
} \
\
#define define_array_list(type, name) \
\
struct name##_Array_List { \
type* data; \
int length; \
int next_index; \
}; \
\
proc remove_index_from_array_list(name##_Array_List* arraylist, int index) -> void { \
arraylist->data[index] = \
arraylist->data[--(arraylist->next_index)]; \
} \
\
proc append_to_array_list(name##_Array_List* arraylist, type element) -> void { \
if (arraylist->next_index == arraylist->length) { \
arraylist->length *= 2; \
arraylist->data = \
(type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \
} \
arraylist->data[arraylist->next_index] = element; \
arraylist->next_index++; \
} \
\
proc _merge_array_lists(name##_Array_List* arr, int start, int mid, int end) -> void { \
int start2 = mid + 1; \
\
/* If the direct merge is already sorted */ \
if ((size_t)arr->data[mid] <= (size_t)arr->data[start2]) { \
return; \
} \
\
/* Two pointers to maintain start of both arrays to merge */ \
while (start <= mid && start2 <= end) { \
if ((size_t)arr->data[start] <= (size_t)arr->data[start2]) { \
start++; \
} \
else { \
type value = arr->data[start2]; \
int index = start2; \
\
/* Shift all the elements between element 1; element 2, right by 1. */ \
while (index != start) { \
arr->data[index] = arr->data[index - 1]; \
index--; \
} \
arr->data[start] = value; \
\
/* Update all the pointers */ \
start++; \
mid++; \
start2++; \
} \
} \
} \
\
proc sort_array_list(name##_Array_List* arraylist, int left=-1, int right=-1) -> void { \
if (left == -1) { \
sort_array_list(arraylist, 0, arraylist->next_index - 1); \
return; \
} else if (left == right) { \
return; \
} \
\
int middle = left + (right-left) / 2; \
\
sort_array_list(arraylist, left, middle); \
sort_array_list(arraylist, middle+1, right); \
\
_merge_array_lists(arraylist, left, middle, right); \
} \
\
proc sorted_array_list_find(name##_Array_List* arraylist, type elem, int left=-1, int right=-1) -> int { \
if (left == -1) { \
return sorted_array_list_find(arraylist, elem, 0, arraylist->next_index - 1); \
} else if (left == right) { \
if ((size_t)arraylist->data[left] == (size_t)elem) \
return left; \
return -1; \
} else if (right < left) \
return -1; \
\
int middle = left + (right-left) / 2; \
\
if ((size_t)arraylist->data[middle] < (size_t)elem) \
return sorted_array_list_find(arraylist, elem, middle+1, right); \
if ((size_t)arraylist->data[middle] > (size_t)elem) \
return sorted_array_list_find(arraylist, elem, left, middle-1); \
return middle; \
} \
\
proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List { \
name##_Array_List ret; \
ret.data = (type*)malloc(initial_capacity * sizeof(type)); \
ret.next_index = 0; \
ret.length = initial_capacity; \
return ret; \
if (left == -1) { \
return sorted_array_list_find(arraylist, elem, 0, arraylist->next_index - 1); \
} else if (left == right) { \
if ((size_t)arraylist->data[left] == (size_t)elem) \
return left; \
return -1; \
} else if (right < left) \
return -1; \
\
int middle = left + (right-left) / 2; \
\
if ((size_t)arraylist->data[middle] < (size_t)elem) \
return sorted_array_list_find(arraylist, elem, middle+1, right); \
if ((size_t)arraylist->data[middle] > (size_t)elem) \
return sorted_array_list_find(arraylist, elem, left, middle-1); \
return middle; \
} \
\
proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List { \
name##_Array_List ret; \
ret.data = (type*)malloc(initial_capacity * sizeof(type)); \
ret.next_index = 0; \
ret.length = initial_capacity; \
return ret; \
}
/*
* iterate over array lists
*/
#define for_array_list(l) \
if (int it_index = 0); \
else \
for (auto it = (l).data[0]; \
it_index < (l).next_index; \
it=(l).data[++it_index])
#define for_array_list(l) \
if (int it_index = 0); else \
for (auto it = (l).data[0]; \
it_index < (l).next_index; \
it=(l).data[++it_index])
/*
* iterate over lisp vectors
*/
#define for_lisp_vector(v) \
if (!v); \
else \
if (int it_index = 0); \
else \
for (auto it = v->value.vector.data; \
it_index < v->value.vector.length; \
it=v->value.vector.data+(++it_index))
#define for_lisp_vector(v) \
if (!v); else \
if (int it_index = 0); else \
for (auto it = v->value.vector.data; \
it_index < v->value.vector.length; \
it=v->value.vector.data+(++it_index))
/*
* iterate over lisp lists
*/
#define for_lisp_list(l) \
if (!l); \
else \
if (int it_index = 0); \
else \
for (Lisp_Object* head = l, *it; \
Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
head = head->value.pair.rest, ++it_index)
#define for_lisp_list(l) \
if (!l); else \
if (int it_index = 0); else \
for (Lisp_Object* head = l, *it; \
Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
head = head->value.pair.rest, ++it_index)
/**
Usage of the create_error_macros:
src/memory.cpp
+46 -21
View File
@@ -1,5 +1,11 @@
namespace Memory {
// ------------------
// global symbol / keyword table
// ------------------
String_Hash_Map* global_symbol_table;
String_Hash_Map* global_keyword_table;
// ------------------
// lisp_objects
// ------------------
@@ -159,7 +165,18 @@ namespace Memory {
return object;
}
proc free_everything() {
free(global_symbol_table);
free(global_keyword_table);
free(object_memory);
free(environment_memory);
free(string_memory);
}
proc init(int oms, int ems, int sms) {
global_symbol_table = create_String_hashmap();
global_keyword_table = create_String_hashmap();
object_memory_size = oms;
environment_memory_size = ems;
string_memory_size = sms;
@@ -274,44 +291,52 @@ namespace Memory {
return node;
}
proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
// TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one
proc create_new_lisp_object_symbol(String* identifier) -> Lisp_Object* {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Symbol);
// node->value.symbol = new(Symbol);
node->value.symbol.identifier = identifier;
node->value.symbol.hash = hash(identifier);
hm_set(global_symbol_table, get_c_str(identifier), node);
return node;
}
proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* {
// TODO(Felix): This is really bad: we create a new string
// even if the symbol/keyword is already existing, just to
// check IF it exists and then never deleting it.
return get_or_create_lisp_object_symbol(
Memory::create_string(identifier));
}
proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* {
// TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one
proc create_new_lisp_object_keyword(String* keyword) -> Lisp_Object* {
Lisp_Object* node;
try node = create_lisp_object();
set_type(node, Lisp_Object_Type::Keyword);
// node->value.keyword = new(Keyword);
node->value.symbol.identifier = keyword;
node->value.symbol.hash = hash(keyword);
hm_set(global_keyword_table, get_c_str(keyword), node);
return node;
}
proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
if (auto ret = hm_get_object(global_symbol_table, get_c_str(identifier)))
return (Lisp_Object*)ret;
else
return create_new_lisp_object_symbol(identifier);
}
proc get_or_create_lisp_object_symbol(const char* identifier) -> Lisp_Object* {
if (auto ret = hm_get_object(global_symbol_table, (char*)identifier))
return (Lisp_Object*)ret;
else
return create_new_lisp_object_symbol(Memory::create_string(identifier));
}
proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* {
if (auto ret = hm_get_object(global_keyword_table, get_c_str(keyword)))
return (Lisp_Object*)ret;
else
return create_new_lisp_object_keyword(keyword);
}
proc get_or_create_lisp_object_keyword(const char* keyword) -> Lisp_Object* {
// TODO(Felix): This is really bad: we create a new string
// even if the symbol/keyword is already existing, just to
// check IF it exists and then never deleting it.
return get_or_create_lisp_object_keyword(
Memory::create_string(keyword));
if (auto ret = hm_get_object(global_keyword_table, (char*)keyword))
return (Lisp_Object*)ret;
else
return create_new_lisp_object_keyword(Memory::create_string(keyword));
}
proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* {
src/parse.cpp
+3 -116
View File
@@ -340,7 +340,9 @@ namespace Parser {
++parser_col;
++(*index_in_text);
break;
} else if (text[(*index_in_text)] == '.') {
} else if (text[(*index_in_text) ] == '.' &&
text[(*index_in_text)+1] == ' ')
{
++parser_col;
++(*index_in_text);
eat_until_code(text, index_in_text);
@@ -364,121 +366,6 @@ namespace Parser {
head = head->value.pair.rest;
}
}
// check if we have to create or delete or run macros
// while (Memory::get_type(expression->value.pair.first) == Lisp_Object_Type::Symbol) {
// Lisp_Object* parsed_symbol = expression->value.pair.first;
// if (string_equal("define-syntax", parsed_symbol->value.symbol.identifier)) {
// // create a new macro
// Lisp_Object* arguments = expression->value.pair.rest;
// Lisp_Object* body;
// int arguments_length;
// // HACK(Felix): almost code duplicate from
// // `built_ins.cpp`: special-lambda
// try arguments_length = list_length(arguments);
// // (define-syntax (defun name args :rest body) (...))
// if (arguments_length < 2) {
// create_wrong_number_of_arguments_error(3, arguments_length);
// return nullptr;
// }
// assert_type(arguments->value.pair.first, Lisp_Object_Type::Pair);
// // extract the name
// Lisp_Object* symbol_for_macro = arguments->value.pair.first->value.pair.first;
// body = arguments->value.pair.rest;
// arguments = arguments->value.pair.first->value.pair.rest;
// // Function* function = new(Function);
// Lisp_Object* macro;
// try macro = Memory::create_lisp_object();
// Memory::set_type(macro, Lisp_Object_Type::Function);
// macro->value.function.parent_environment = get_current_environment();
// macro->value.function.type = Function_Type::Macro;
// // if parameters were specified
// if (arguments != Memory::nil) {
// try assert_type(arguments, Lisp_Object_Type::Pair);
// try create_arguments_from_lambda_list_and_inject(arguments, macro);
// } else {
// macro->value.function.args.positional = create_positional_argument_list(1);
// macro->value.function.args.keyword = create_keyword_argument_list(1);
// macro->value.function.args.rest = nullptr;
// }
// // arguments = arguments->value.pair.rest;
// // if there is a docstring, use it
// if (Memory::get_type(body->value.pair.first) == Lisp_Object_Type::String) {
// macro->docstring = body->value.pair.first->value.string;
// body = body->value.pair.rest;
// } else {
// macro->docstring = nullptr;
// }
// // we are now in the function body, just wrap it in an
// // implicit begin
// try macro->value.function.body = Memory::create_lisp_object_pair(
// Memory::get_or_create_lisp_object_symbol("begin"),
// body);
// inject_scl(macro);
// // macro->value.function = function;
// define_symbol(symbol_for_macro, macro);
// // print_environment(environment_for_macros);
// return Memory::nil;
// } else if (string_equal("delete-syntax", parsed_symbol->value.symbol.identifier)) {
// /* --- deleting an existing macro --- */
// // TODO(Felix): this is a hard one because when
// // environments will be made from hashmaps, how can we
// // delete stuff from hashmaps? If we do probing on
// // collision and then delte the first colliding entry,
// // how can we find the second one? How many probes do
// // we have to do to know for sure that an elemenet is
// // not in the hashmap? It would be much easier if we
// // never deleted any elements from the hashmap, so
// // that, when an entry is not found immidiately, we
// // know for sure that it does not exist in the table.
// create_generic_error("deleting macros has not yet be implemented,"
// "and I don't know if it is a good idea to do so.");
// return nullptr;
// } else {
// // if threre is a macro named like this, then macroexpand
// // if not it is regular code, dont touch.
// break;
// Lisp_Object* macro = try_lookup_symbol(parsed_symbol, get_current_environment());
// if (macro &&
// Memory::get_type(macro) == Lisp_Object_Type::Function &&
// macro->value.function.type == Function_Type::Macro)
// {
// // printf("pretending to expand macro at %s %d %d: ",
// // Memory::get_c_str(parser_file),
// // parser_line, parser_col);
// // print(parsed_symbol);
// // printf("\n");
// // NOTE(Felix): Execute it as a special lambda,
// // because if we keep it as a macro, the evaluator
// // will think it is a stray macro that was not yet
// // expanded, and attempt to evaluate it twice (1.
// // for expanding, and 2. for evaluating)
// macro->value.function.type = Function_Type::Special_Lambda;
// // NOTE(Felix): deferred so even if eval expr
// // fails, and returns, the type will be be
// // resetted to macro.
// defer {
// macro->value.function.type = Function_Type::Macro;
// };
// try expression = eval_expr(expression);
// break;
// } else break;
// }
// }
return expression;
}
src/testing.cpp
+14 -3
View File
@@ -540,9 +540,6 @@ proc test_built_in_type() -> testresult {
}
proc test_singular_t_and_nil() -> testresult {
Environment* env;
try env = get_root_environment();
// nil testing
char exp_string1[] = "()";
char exp_string2[] = "nil";
@@ -574,6 +571,19 @@ proc test_singular_t_and_nil() -> testresult {
return pass;
}
proc test_singular_symbols() -> testresult {
auto cc_s_aa = Memory::get_or_create_lisp_object_symbol("aa");
auto cc_s_aa2 = Memory::get_or_create_lisp_object_symbol("aa2");
auto s_s_aa = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa"));
auto s_s_aa2 = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa2"));
assert_equal_int(cc_s_aa, s_s_aa);
assert_equal_int(cc_s_aa2, s_s_aa2);
assert_not_equal_int(cc_s_aa, cc_s_aa2);
return pass;
}
proc test_file(const char* file) -> testresult {
// Memory::reset();
// assert_no_error();
@@ -630,6 +640,7 @@ proc run_all_tests() -> bool {
printf("\n-- Memory management --\n");
invoke_test(test_singular_t_and_nil);
invoke_test(test_singular_symbols);
printf("\n-- Test Files --\n");