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

pair hashing, work on generic-extend, Memory::reset works again

Browse Source
This commit is contained in:
FelixBrendel
2019-10-05 22:07:32 +02:00
parent 9cba9cafc0
commit b3023f259a
10 changed files with 150 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/built_ins.cpp
+30 -10
View File
@@ -26,8 +26,11 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
case Lisp_Object_Type::Nil: return true;
case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
case Lisp_Object_Type::Pair: {
return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
} break;
case Lisp_Object_Type::HashMap:
case Lisp_Object_Type::Pair:
case Lisp_Object_Type::Vector:
create_not_yet_implemented_error();
case Lisp_Object_Type::Symbol:
@@ -560,11 +563,6 @@ proc load_built_ins_into_environment() -> void {
push_environment(target_env);
{
printf("set!ing:: ");
print(sym);
printf(" to ");
print(val);
printf(" in %llu\n", (unsigned long long) target_env);
define_symbol(sym, val);
}
pop_environment();
@@ -607,6 +605,7 @@ proc load_built_ins_into_environment() -> void {
};
define_special((quasiquote expr), "TODO") {
fetch(expr);
Lisp_Object* quasiquote_sym = Memory::get_or_create_lisp_object_symbol("quasiquote");
Lisp_Object* unquote_sym = Memory::get_or_create_lisp_object_symbol("unquote");
Lisp_Object* unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing");
/* recursive lambdas in lambdas yay!! */
@@ -621,6 +620,11 @@ proc load_built_ins_into_environment() -> void {
// it is a pair!
Lisp_Object* originalPair = expr->value.pair.first;
// if we find quasiquote, uhu
if (originalPair == quasiquote_sym)
return expr;
if (originalPair == unquote_sym || originalPair == unquote_splicing_sym)
{
// eval replace the stuff
@@ -791,6 +795,18 @@ proc load_built_ins_into_environment() -> void {
fun->value.function.body = maybe_wrap_body_in_begin(body);
return fun;
};
define((apply fun args), "TODO") {
fetch(fun, args);
Lisp_Object* result;
// try assert_type(args, Lisp_Object_Type::Pair);
// HACK(Felix): this is probably a really nasty hack:
fluid_let (fun->value.function.type, Function_Type::Special_Lambda) {
try result = apply_arguments_to_function(args, fun);
}
return result;
};
define((eval expr), "TODO") {
fetch(expr);
Lisp_Object* result;
@@ -1061,10 +1077,14 @@ proc load_built_ins_into_environment() -> void {
Lisp_Object* result;
in_caller_env {
result = eval_expr(try_part);
if (Globals::error) {
delete_error();
try result = eval_expr(catch_part);
ignore_logging {
dont_break_on_errors {
result = eval_expr(try_part);
if (Globals::error) {
delete_error();
try result = eval_expr(catch_part);
}
}
}
}
return result;
src/env.cpp
+4 -4
View File
@@ -16,7 +16,7 @@ proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment
return env;
for_array_list (env->parents) {
if (Environment* ret = find_binding_environment(sym, it))
return it;
return ret;
}
return nullptr;
}
@@ -102,18 +102,18 @@ proc print_environment_indent(Environment* env, int indent) -> void {
print_indent(indent);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol.identifier->data));
print((Lisp_Object*)value);
printf(" (%lld)", (unsigned long long)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
}
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (%lld)", (long long)env->parents.data[i]);
printf("parent (0x%016llx)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
}
proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (%lld)\n", (long long)env);
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
print_environment_indent(env, 0);
}
src/eval.cpp
+2 -1
View File
@@ -233,13 +233,14 @@ proc create_extended_environment_for_function_application(
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function) -> Lisp_Object* {
profile_this;
Environment* new_env;
Lisp_Object* result;
try new_env = create_extended_environment_for_function_application(arguments, function);
push_environment(new_env);
defer {
pop_environment();
};
Lisp_Object* result;
// if c function:
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
try result = function->value.cFunction->body();
src/forward_decls.cpp
+9 -1
View File
@@ -101,9 +101,17 @@ u32 hm_hash(Lisp_Object* obj) {
case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer);
case Lisp_Object_Type::Number: return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes
case Lisp_Object_Type::String: return hm_hash((char*) &obj->value.string->data);
case Lisp_Object_Type::Pair: {
u32 hash = 1;
for_lisp_list (obj) {
hash <<= 1;
hash += hm_hash(it);
}
return hash;
} break;
case Lisp_Object_Type::Vector:
case Lisp_Object_Type::Pair:
case Lisp_Object_Type::HashMap:
default:
create_not_yet_implemented_error();
return 0;
}
src/memory.cpp
+12 -6
View File
@@ -18,7 +18,7 @@ namespace Memory {
// environments
// ------------------
int environment_memory_size;
Int_Array_List free_spots_in_environment_memory;
Environment_Array_List free_spots_in_environment_memory;
Environment* environment_memory;
int next_index_in_environment_memory = 0;
@@ -182,7 +182,7 @@ namespace Memory {
string_memory_size = sms;
free_spots_in_object_memory = create_Int_array_list();
free_spots_in_environment_memory = create_Int_array_list();
free_spots_in_environment_memory = create_Environment_array_list();
free_spots_in_string_memory = create_Void_Ptr_array_list();
object_memory = (Lisp_Object*)malloc(object_memory_size * sizeof(Lisp_Object));
@@ -203,6 +203,7 @@ namespace Memory {
Globals::Current_Execution::envi_stack.next_index = 0;
push_environment(create_built_ins_environment());
}
proc reset() -> void {
@@ -210,6 +211,11 @@ namespace Memory {
free_spots_in_environment_memory.next_index = 0;
free_spots_in_string_memory.next_index = 0;
global_symbol_table = create_String_hashmap();
global_keyword_table = create_String_hashmap();
try_void Parser::standard_in = create_string("stdin");
// because t and nil are always there we start the index at 2
next_index_in_object_memory = 2;
next_index_in_environment_memory = 0;
@@ -399,9 +405,10 @@ namespace Memory {
proc create_child_environment(Environment* parent) -> Environment* {
int index;
Environment* env;
// if we have no free spots then append at the end
if (free_spots_in_environment_memory.next_index == 0) {
int index;
// if we still have space
if (environment_memory_size == next_index_in_environment_memory) {
create_out_of_memory_error(
@@ -412,13 +419,12 @@ namespace Memory {
return nullptr;
}
index = next_index_in_environment_memory++;
env = environment_memory+index;
} else {
// else fill a free spot, and remove the free spot
index = free_spots_in_environment_memory.data[free_spots_in_environment_memory.next_index--];
env = free_spots_in_environment_memory.data[--free_spots_in_environment_memory.next_index];
}
Environment* env = environment_memory+index;
int start_capacity = 16;
env->parents = create_Environment_array_list();
src/testing.cpp
+11 -11
View File
@@ -212,7 +212,6 @@ proc test_eval_operands() -> testresult {
assert_equal_double(operands->value.pair.first->value.number, 3);
operands = operands->value.pair.rest;
assert_equal_type(operands, Lisp_Object_Type::Pair);
assert_equal_type(operands->value.pair.first, Lisp_Object_Type::String);
assert_equal_string(operands->value.pair.first->value.string, "okay");
@@ -585,17 +584,18 @@ proc test_singular_symbols() -> testresult {
}
proc test_file(const char* file) -> testresult {
// Memory::reset();
// assert_no_error();
// Environment* root_env = get_root_environment();
// Environment* user_env = Memory::create_child_environment(root_env);
// assert_no_error();
Memory::reset();
assert_no_error();
// push_environment(user_env);
// defer {
// pop_environment();
// };
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
assert_no_error();
push_environment(user_env);
defer {
pop_environment();
};
built_in_load(Memory::create_string(file));
assert_no_error();
@@ -607,7 +607,7 @@ proc run_all_tests() -> bool {
bool result = true;
Memory::init(200000, 10240, 409600);
Memory::init(200000, 102400, 409600);
Environment* root_env = get_root_environment();
Environment* user_env = Memory::create_child_environment(root_env);
push_environment(user_env);