before arguments refactor

This commit is contained in:
Felix Brendel
2019-09-07 22:43:55 +02:00
parent 6c80382cd0
commit aceb801ada
15 changed files with 386 additions and 90 deletions
+9 -15
View File
@@ -464,7 +464,7 @@ proc load_built_ins_into_environment() -> void {
try assert_type(vec, Lisp_Object_Type::Vector);
try assert_type(idx, Lisp_Object_Type::Number);
int int_idx = ((size_t)idx->value.number);
int int_idx = ((int)idx->value.number);
try assert(int_idx >= 0);
try assert(int_idx < vec->value.vector.length);
@@ -482,7 +482,7 @@ proc load_built_ins_into_environment() -> void {
try assert_type(vec, Lisp_Object_Type::Vector);
try assert_type(idx, Lisp_Object_Type::Number);
int int_idx = ((size_t)idx->value.number);
int int_idx = ((int)idx->value.number);
try assert(int_idx >= 0);
try assert(int_idx < vec->value.vector.length);
@@ -598,6 +598,7 @@ proc load_built_ins_into_environment() -> void {
Lisp_Object* newPair = Memory::nil;
Lisp_Object* newPairHead = newPair;
Lisp_Object* head = expr;
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
// if it is ,@ we have to actually do more work
// and inline the result
@@ -1150,25 +1151,18 @@ proc load_built_ins_into_environment() -> void {
int resulting_string_len = 0;
Lisp_Object* head = evaluated_arguments;
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
try assert_type(head->value.pair.first, Lisp_Object_Type::String);
resulting_string_len += head->value.pair.first->value.string->length;
head = head->value.pair.rest;
for_lisp_list (evaluated_arguments) {
try assert_type(it, Lisp_Object_Type::String);
resulting_string_len += it->value.string->length;
}
head = evaluated_arguments;
String* resulting_string = Memory::create_string("", resulting_string_len);
int index_in_string = 0;
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
for_lisp_list (evaluated_arguments) {
strcpy((&resulting_string->data)+index_in_string,
Memory::get_c_str(head->value.pair.first->value.string));
index_in_string += head->value.pair.first->value.string->length;
head = head->value.pair.rest;
Memory::get_c_str(it->value.string));
index_in_string += it->value.string->length;
}
return Memory::create_lisp_object_string(resulting_string);
+37 -1
View File
@@ -142,7 +142,43 @@
/*
Usage of the create_error_macros:
* iterate over array lists
*/
#define for_array_list(l) \
if (!l); \
else \
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))
/*
* 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)
/**
Usage of the create_error_macros:
*/
#define __create_error(keyword, ...) \
create_error( \
+1 -9
View File
@@ -349,6 +349,7 @@ proc list_length(Lisp_Object* node) -> int {
assert_type(node, Lisp_Object_Type::Pair);
int len = 0;
while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
@@ -360,15 +361,6 @@ proc list_length(Lisp_Object* node) -> int {
return 0;
}
proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* {
// NOTE(Felix): This will be a hashmap lookup later
for (int i = 0; i < args->keyword_keys->next_index; ++i) {
if (string_equal(args->keyword_keys->data[i]->value.symbol.identifier, keyword))
return args->keyword_values->data[i];
}
return nullptr;
}
proc eval_arguments(Lisp_Object* arguments, int *out_arguments_length) -> Lisp_Object* {
int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
+1 -1
Submodule src/ftb updated: 5d6da78c90...63f8554200
+81
View File
@@ -0,0 +1,81 @@
namespace GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
Lisp_Object_Array_List* marked_objects;
String_Array_List* marked_strings;
Environment_Array_List* marked_environments;
Environment_Array_List* protected_environments;
proc marked(Lisp_Object* node) -> bool {
return false;
}
proc marked(Environment* env) -> bool {
return false;
}
proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node))
return;
append_to_array_list(marked_objects, node);
switch (Memory::get_type(node)) {
case Lisp_Object_Type::Pair: {
for_lisp_list (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::Vector: {
for_lisp_vector (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::String: {
append_to_array_list(marked_strings, node->value.string);
} break;
case Lisp_Object_Type::Function: {
maybe_mark(node->value.function.parent_environment);
maybe_mark(node->value.function.body);
} break;
}
}
proc maybe_mark(Environment* env) -> void {
if (marked(env))
return;
append_to_array_list(marked_environments, env);
for_array_list (env->parents) {
maybe_mark(it);
}
Lisp_Object* it = env->values[0];
for (int i = 0; i < env->next_index; it = env->values[++i]) {
maybe_mark(it);
}
}
proc garbage_collect() -> void {
profile_this;
++current_mark;
for_array_list (protected_environments) maybe_mark(it);
for_array_list (Globals::Current_Execution::envi_stack) maybe_mark(it);
}
proc gc_init_and_go() -> void {
current_mark = 0;
marked_objects = create_Lisp_Object_array_list(1024);
marked_environments = create_Environment_array_list(1024);
while (1) {
garbage_collect();
}
}
}
+1 -1
View File
@@ -1,7 +1,7 @@
#include "slime.h"
int main(int argc, char* argv[]) {
if (argc > 1) {
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
return Slime::run_all_tests() ? 0 : 1;
}
-17
View File
@@ -1,17 +0,0 @@
// namespace Profiler {
// proc init() -> void {
// out_file = fopen("profiler.report", "w");
// if (!out_file)
// create_generic_error("couldnt create prfiler file.");
// }
// proc exit() -> void {
// fclose(out_file);
// }
// proc log_entry(const char* func, const char* file, int line) -> void {
// fprintf(out_file,"%d -> %s %s %d %ld\n", Globals::thread_type, func, file, line, clock());
// }
// proc log_exit() -> void {
// fprintf(out_file, "%d <- %ld\n", Globals::thread_type, clock());
// }
// }
+2 -1
View File
@@ -24,7 +24,7 @@
#undef _CRT_SECURE_NO_DEPRECATE
#undef _CRT_SECURE_NO_WARNINGS
#include "./ftb/macros.h"
#include "./ftb/macros.hpp"
#include "./ftb/profiler.hpp"
namespace Slime {
@@ -34,6 +34,7 @@ namespace Slime {
# include "./forward_decls.cpp"
# include "./profiler.cpp"
# include "./memory.cpp"
# include "./gc.cpp"
# include "./lisp_object.cpp"
# include "./error.cpp"
# include "./io.cpp"
+11 -10
View File
@@ -36,7 +36,8 @@ typedef uint64_t u64;
enum class Lisp_Object_Flags : u64
{
// bits 1 to 5 (including) will be reserved for the type
aliveness = 1 << 5,
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};
enum struct Function_Type {
@@ -103,6 +104,15 @@ struct Keyword_Arguments {
Lisp_Object_Array_List* values;
};
struct Arguments {
// NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol
Lisp_Object* rest_argument;
Keyword_Arguments keyword_arguments;
Positional_Arguments positional_arguments;
};
struct Function {
Function_Type type;
Positional_Arguments* positional_arguments;
@@ -135,17 +145,8 @@ struct Lisp_Object {
} value;
};
struct Parsed_Arguments {
Lisp_Object_Array_List* positional_arguments;
// TODO(Felix): Really use hashmap (keyword[sting] ->
// value[Lisp_Object*]) here
Lisp_Object_Array_List* keyword_keys;
Lisp_Object_Array_List* keyword_values;
};
struct Environment {
Environment_Array_List* parents;
int capacity;
int next_index;
+1
View File
@@ -516,6 +516,7 @@ proc test_built_in_type() -> testresult {
// trying to set invalid user type
char exp_string3[] = "(begin (set-type a \"wrong tpye\")(type a))";
expression = Parser::parse_single_expression(exp_string3);
assert_no_error();
ignore_logging {
dont_break_on_errors {