diff --git a/bin/tests/import1.slime b/bin/tests/import1.slime index 2057106..3f94e47 100644 --- a/bin/tests/import1.slime +++ b/bin/tests/import1.slime @@ -1,3 +1,3 @@ -(define a 10) +(define a 1111) (define (get-a-1) a) diff --git a/bin/tests/singular_imports.slime b/bin/tests/singular_imports.slime index dd6af52..ce7935b 100644 --- a/bin/tests/singular_imports.slime +++ b/bin/tests/singular_imports.slime @@ -1,27 +1,20 @@ (import "tests/import1.slime") -(print) -(print ">" a) -(assert (= a 10)) -(print ">" (get-a-1)) -(assert (= (get-a-1) 10)) +(assert (= a 1111)) +(assert (= (get-a-1) 1111)) (import "tests/import2.slime") -(print ">" a) -(assert (= a 10)) -(print ">" (get-a-1)) -(assert (= (get-a-1) 10)) -(print ">" (get-a-2)) -(assert (= (get-a-2) 10)) + +(assert (= a 1111)) +(assert (= (get-a-1) 1111)) +(assert (= (get-a-2) 1111)) (set-a-2 11) -(print "> should be 11 from now on") -(print ">" a) (assert (= a 11)) -(print ">" (get-a-1)) + (assert (= (get-a-1) 11)) -(print ">" (get-a-2)) + (assert (= (get-a-2) 11)) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 89a3aec..30cf613 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -1,1146 +1,1146 @@ namespace Slime { - inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { - Lisp_Object* begin_symbol = Memory::get_symbol("begin"); - if (body->value.pair.rest == Memory::nil) - return body->value.pair.first; - else - return Memory::create_lisp_object_pair(begin_symbol, body); - } - - proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { - if (n1 == n2) - return true; - if (Memory::get_type(n1) != Memory::get_type(n2)) - return false; - - switch (Memory::get_type(n1)) { - - case Lisp_Object_Type::T: - case Lisp_Object_Type::Nil: - case Lisp_Object_Type::Symbol: - case Lisp_Object_Type::Keyword: - case Lisp_Object_Type::CFunction: - case Lisp_Object_Type::Function: - // TODO(Felix): should a pointer - // object compare the pointer? - case Lisp_Object_Type::Pointer: - case Lisp_Object_Type::Continuation: return false; - 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::Vector: - create_not_yet_implemented_error(); + inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* { + Lisp_Object* begin_symbol = Memory::get_symbol("begin"); + if (body->value.pair.rest == Memory::nil) + return body->value.pair.first; + else + return Memory::create_lisp_object_pair(begin_symbol, body); } - // we should never reach here - return false; - } - - proc add_to_load_path(const char* path) -> void { - using Globals::load_path; - - load_path.append((void*)path); - } - - proc built_in_load(String* file_name) -> Lisp_Object* { - profile_with_comment(&file_name->data); - char* file_content; - char fullpath[4096]; - sprintf(fullpath, "%s", Memory::get_c_str(file_name)); - file_content = read_entire_file(Memory::get_c_str(file_name)); - - if (!file_content) { - for (auto it: Globals::load_path) { - fullpath[0] = '\0'; - sprintf(fullpath, "%s%s", (char*)it, Memory::get_c_str(file_name)); - file_content = read_entire_file(fullpath); - if (file_content) - break; - } - if (!file_content) { - printf("Load path:\n"); - for (auto it : Globals::load_path) { - printf(" - %s\n", (char*) it); - } - create_generic_error("The file to load '%s' was not found in the load path.", - Memory::get_c_str(file_name)); - return nullptr; - } + proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { + if (n1 == n2) + return true; + if (Memory::get_type(n1) != Memory::get_type(n2)) + return false; + + switch (Memory::get_type(n1)) { + + case Lisp_Object_Type::T: + case Lisp_Object_Type::Nil: + case Lisp_Object_Type::Symbol: + case Lisp_Object_Type::Keyword: + case Lisp_Object_Type::CFunction: + case Lisp_Object_Type::Function: + // TODO(Felix): should a pointer + // object compare the pointer? + case Lisp_Object_Type::Pointer: + case Lisp_Object_Type::Continuation: return false; + 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::Vector: + create_not_yet_implemented_error(); + } + // we should never reach here + return false; } + proc add_to_load_path(const char* path) -> void { + using Globals::load_path; - Lisp_Object* result = Memory::nil; - Array_List* program; - try program = Parser::parse_program(Memory::create_string(fullpath), file_content); - - for (auto expr : *program) { - // print(expr); - // puts(""); - try result = eval_expr(expr); + load_path.append((void*)path); } - delete program; - free(file_content); - - return result; - } - - proc built_in_import(String* file_name) -> Lisp_Object* { - profile_this(); - Environment* new_env; - - new_env = Memory::file_to_env_map.get_object(Memory::get_c_str(file_name)); + proc built_in_load(String* file_name) -> Lisp_Object* { + profile_with_comment(&file_name->data); + char* file_content; + char fullpath[4096]; + sprintf(fullpath, "%s", Memory::get_c_str(file_name)); + file_content = read_entire_file(Memory::get_c_str(file_name)); + + if (!file_content) { + for (auto it: Globals::load_path) { + fullpath[0] = '\0'; + sprintf(fullpath, "%s%s", (char*)it, Memory::get_c_str(file_name)); + file_content = read_entire_file(fullpath); + if (file_content) + break; + } + if (!file_content) { + printf("Load path:\n"); + for (auto it : Globals::load_path) { + printf(" - %s\n", (char*) it); + } + create_generic_error("The file to load '%s' was not found in the load path.", + Memory::get_c_str(file_name)); + return nullptr; + } - if (!new_env) { - // create new empty environment - try new_env = Memory::create_child_environment(get_root_environment()); - // TODO(Felix): check absoulute paths in the map, not just - // relative ones - Memory::file_to_env_map.set_object(Memory::get_c_str(file_name), new_env); - push_environment(new_env); - defer { - pop_environment(); - }; - - Lisp_Object* res; - try res = built_in_load(file_name); - } - - get_current_environment()->parents.append(new_env); - - return Memory::nil; - } - - proc load_built_ins_into_environment() -> void* { - profile_this(); - String* file_name_built_ins = Memory::create_string(__FILE__); - - define((helper), "") { - profile_with_name("(helper)"); - return Memory::create_lisp_object(101.0); - }; - define((test (:k (helper))), "") { - profile_with_name("(test)"); - fetch(k); - return k; - }; - define((= . args), - "Takes 0 or more arguments and returns =t= if all arguments are equal " - "and =()= otherwise.") - { - profile_with_name("(=)"); - fetch(args); - - if (args == Memory::nil) - return Memory::t; - - Lisp_Object* first = args->value.pair.first; - - for_lisp_list (args) { - if (!lisp_object_equal(it, first)) - return Memory::nil; } - return Memory::t; - }; - define((> . args), "TODO") - { - profile_with_name("(>)"); - fetch(args); - double last_number = strtod("Inf", NULL); - - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - if (it->value.number >= last_number) - return Memory::nil; - last_number = it->value.number; - } - return Memory::t; - }; - define((>= . args), "TODO") - { - profile_with_name("(>=)"); - fetch(args); - double last_number = strtod("Inf", NULL); - - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - if (it->value.number > last_number) - return Memory::nil; - last_number = it->value.number; - } + Lisp_Object* result = Memory::nil; + Array_List* program; + try program = Parser::parse_program(Memory::create_string(fullpath), file_content); - return Memory::t; - }; - define((< . args), "TODO") - { - profile_with_name("(<)"); - fetch(args); - double last_number = strtod("-Inf", NULL); - - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - if (it->value.number <= last_number) - return Memory::nil; - last_number = it->value.number; + for (auto expr : *program) { + // print(expr); + // puts(""); + try result = eval_expr(expr); } - return Memory::t; - }; - define((<= . args), "TODO") - { - profile_with_name("(<=)"); - fetch(args); - double last_number = strtod("-Inf", NULL); - - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - if (it->value.number < last_number) - return Memory::nil; - last_number = it->value.number; - } - - return Memory::t; - }; - define((+ . args), "TODO") - { - profile_with_name("(+)"); - fetch(args); - double sum = 0; - - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - sum += it->value.number; - } - - return Memory::create_lisp_object(sum); - }; - define((- . args), "TODO") - { - profile_with_name("(-)"); - fetch(args); - if (args == Memory::nil) - return Memory::create_lisp_object(0.0); - + delete program; + free(file_content); - try assert_type(args->value.pair.first, Lisp_Object_Type::Number); - double difference = args->value.pair.first->value.number; + return result; + } - if (args->value.pair.rest == Memory::nil) { - return Memory::create_lisp_object(-difference); + proc built_in_import(String* file_name) -> Lisp_Object* { + profile_this(); + Environment* new_env; + + new_env = Memory::file_to_env_map.get_object(Memory::get_c_str(file_name)); + + if (!new_env) { + // create new empty environment + try new_env = Memory::create_child_environment(get_root_environment()); + // TODO(Felix): check absoulute paths in the map, not just + // relative ones + Memory::file_to_env_map.set_object(Memory::get_c_str(file_name), new_env); + push_environment(new_env); + defer { + pop_environment(); + }; + + Lisp_Object* res; + try res = built_in_load(file_name); } - for_lisp_list (args->value.pair.rest) { - try assert_type(it, Lisp_Object_Type::Number); - difference -= it->value.number; - } + get_current_environment()->parents.append(new_env); - return Memory::create_lisp_object(difference); - }; - define((* . args), "TODO") - { - profile_with_name("(*)"); - fetch(args); - if (args == Memory::nil) { - return Memory::create_lisp_object(1); - } + return Memory::nil; + } - double product = 1; + proc load_built_ins_into_environment() -> void* { + profile_this(); + String* file_name_built_ins = Memory::create_string(__FILE__); + + define((helper), "") { + profile_with_name("(helper)"); + return Memory::create_lisp_object(101.0); + }; + define((test (:k (helper))), "") { + profile_with_name("(test)"); + fetch(k); + return k; + }; + define((= . args), + "Takes 0 or more arguments and returns =t= if all arguments are equal " + "and =()= otherwise.") + { + profile_with_name("(=)"); + fetch(args); - for_lisp_list (args) { - try assert_type(it, Lisp_Object_Type::Number); - product *= it->value.number; - } + if (args == Memory::nil) + return Memory::t; - return Memory::create_lisp_object(product); - }; - define((/ . args), "TODO") - { - profile_with_name("(/)"); - fetch(args); + Lisp_Object* first = args->value.pair.first; - if (args == Memory::nil) { - return Memory::create_lisp_object(1); - } + for_lisp_list (args) { + if (!lisp_object_equal(it, first)) + return Memory::nil; + } + + return Memory::t; + }; + define((> . args), "TODO") + { + profile_with_name("(>)"); + fetch(args); + double last_number = strtod("Inf", NULL); + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + if (it->value.number >= last_number) + return Memory::nil; + last_number = it->value.number; + } + + return Memory::t; + }; + define((>= . args), "TODO") + { + profile_with_name("(>=)"); + fetch(args); + double last_number = strtod("Inf", NULL); + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + if (it->value.number > last_number) + return Memory::nil; + last_number = it->value.number; + } + + return Memory::t; + }; + define((< . args), "TODO") + { + profile_with_name("(<)"); + fetch(args); + double last_number = strtod("-Inf", NULL); + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + if (it->value.number <= last_number) + return Memory::nil; + last_number = it->value.number; + } + + return Memory::t; + }; + define((<= . args), "TODO") + { + profile_with_name("(<=)"); + fetch(args); + double last_number = strtod("-Inf", NULL); + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + if (it->value.number < last_number) + return Memory::nil; + last_number = it->value.number; + } + + return Memory::t; + }; + define((+ . args), "TODO") + { + profile_with_name("(+)"); + fetch(args); + double sum = 0; + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + sum += it->value.number; + } + + return Memory::create_lisp_object(sum); + }; + define((- . args), "TODO") + { + profile_with_name("(-)"); + fetch(args); + if (args == Memory::nil) + return Memory::create_lisp_object(0.0); - try assert_type(args->value.pair.first, Lisp_Object_Type::Number); - double quotient = args->value.pair.first->value.number; + try assert_type(args->value.pair.first, Lisp_Object_Type::Number); + double difference = args->value.pair.first->value.number; - for_lisp_list (args->value.pair.rest) { - try assert_type(it, Lisp_Object_Type::Number); - quotient /= it->value.number; - } + if (args->value.pair.rest == Memory::nil) { + return Memory::create_lisp_object(-difference); + } - return Memory::create_lisp_object(quotient); - }; - define((** a b), "TODO") { - profile_with_name("(**)"); - fetch(a, b); - try assert_type(a, Lisp_Object_Type::Number); - try assert_type(b, Lisp_Object_Type::Number); - return Memory::create_lisp_object(pow(a->value.number, - b->value.number)); - }; - define((% a b), "TODO") { - profile_with_name("(%)"); - fetch(a, b); - try assert_type(a, Lisp_Object_Type::Number); - try assert_type(b, Lisp_Object_Type::Number); - return Memory::create_lisp_object((int)a->value.number % - (int)b->value.number); - }; - define((get-random-between a b), "TODO") { - profile_with_name("(get-random-between)"); - fetch(a, b); - try assert_type(a, Lisp_Object_Type::Number); - try assert_type(b, Lisp_Object_Type::Number); - - double fa = a->value.number; - double fb = b->value.number; - double x = (double)rand()/(double)(RAND_MAX); - x *= (fb - fa); - x += fa; - - return Memory::create_lisp_object(x); - }; - define_special((bound? var), "TODO") { - profile_with_name("(bound?)"); - fetch(var); - try assert_type(var, Lisp_Object_Type::Symbol); - - Lisp_Object* res; - in_caller_env { - res = try_lookup_symbol(var, get_current_environment()); - } - if (res) - return Memory::t; - return Memory::nil; - }; - define((assert test), "TODO") { - profile_with_name("(assert)"); - fetch(test); - - if (is_truthy(test)) - return Memory::t; - - create_generic_error("Userland assertion."); - return nullptr; - }; - define_special((define-syntax form (:doc "") . body), "TODO") { - profile_with_name("(define-syntax)"); - fetch(form, doc, body); - - try assert_type(doc, Lisp_Object_Type::String); - // if no doc string, we dont have to store it - if (Memory::get_c_str(doc)[0] == '\0') { - doc = nullptr; - } - - if (Memory::get_type(form) != Lisp_Object_Type::Pair) { - create_parsing_error("You can only create function macros."); - return nullptr; - } - - Lisp_Object* symbol = form->value.pair.first; - Lisp_Object* lambdalist = form->value.pair.rest; - - // creating new lisp object and setting type - Lisp_Object* func; - try func = Memory::create_lisp_object_function(Function_Type::Macro); - - // Lisp_Object* func; - // try func = Memory::create_lisp_object(); - // Memory::set_type(func, Lisp_Object_Type::Function); - // func->value.function->type = Function_Type::Macro; - if (doc) func->docstring = doc->value.string; - - in_caller_env { - // setting parent env - func->value.function->parent_environment = get_current_environment(); - create_arguments_from_lambda_list_and_inject(lambdalist, func); - func->value.function->body = maybe_wrap_body_in_begin(body); - define_symbol(symbol, func); - } - return Memory::nil; - }; - define_special((define definee (:doc "") . body), "TODO") { - profile_with_name("(define)"); - fetch(definee, doc, body); - - // print_hm(get_current_environment()->hm); - try assert_type(doc, Lisp_Object_Type::String); - - // if no doc string, we dont have to store it - if (Memory::get_c_str(doc)[0] == '\0') { - doc = nullptr; - } - - if (Memory::get_type(definee) == Lisp_Object_Type::Symbol) { - if (body == Memory::nil) { - create_parsing_error("You at least have to put a value when " - "you are trying to define a variable."); - return nullptr; - } else if (body->value.pair.rest != Memory::nil) { - create_parsing_error("You cannot define more than one thing " - "for one variable."); - return nullptr; - } - auto value = body->value.pair.first; - in_caller_env { - try value = eval_expr(value); - define_symbol(definee, value); - } - } else if (Memory::get_type(definee) == Lisp_Object_Type::Pair) { - // definee: (sym . lambdalist) - Lisp_Object* symbol = definee->value.pair.first; - Lisp_Object* lambdalist = definee->value.pair.rest; - - // creating new lisp object and setting type - Lisp_Object* func; - try func = Memory::create_lisp_object_function(Function_Type::Lambda); - - if (doc) - func->docstring = doc->value.string; - - in_caller_env { - // setting parent env - func->value.function->parent_environment = get_current_environment(); - create_arguments_from_lambda_list_and_inject(lambdalist, func); - func->value.function->body = maybe_wrap_body_in_begin(body); - define_symbol(symbol, func); - } - - } else { - create_parsing_error("The to be defined object has to be a " - "symbol or a list. But got a %s.", - Lisp_Object_Type_to_string( - Memory::get_type(definee))); - return nullptr; - } - return Memory::nil; - }; - define((mutate target source), "TODO") { - profile_with_name("(mutate)"); - fetch(target, source); - - if (target == Memory::nil || - target == Memory::t || - Memory::get_type(target) == Lisp_Object_Type::Keyword || - Memory::get_type(target) == Lisp_Object_Type::Symbol) - { - create_generic_error("You cannot mutate to nil, t, keywords or symbols because they have to be unique"); - } + for_lisp_list (args->value.pair.rest) { + try assert_type(it, Lisp_Object_Type::Number); + difference -= it->value.number; + } - if (source == Memory::nil || - source == Memory::t || - Memory::get_type(source) == Lisp_Object_Type::Keyword || - Memory::get_type(source) == Lisp_Object_Type::Symbol) + return Memory::create_lisp_object(difference); + }; + define((* . args), "TODO") { - create_generic_error("You cannot mutate nil, t, keywords or symbols"); - } - - *target = *source; - return target; - }; - define((vector-length v), "TODO") { - profile_with_name("(vector-length)"); - fetch(v); - try assert_type(v, Lisp_Object_Type::Vector); - return Memory::create_lisp_object((double)v->value.vector.length); - }; - define((vector-ref vec idx), "TODO") { - profile_with_name("(vector-ref)"); - fetch(vec, idx); - - try assert_type(vec, Lisp_Object_Type::Vector); - try assert_type(idx, Lisp_Object_Type::Number); - - int int_idx = ((int)idx->value.number); - - try assert(int_idx >= 0); - try assert(int_idx < vec->value.vector.length); - - return vec->value.vector.data+int_idx; - }; - define((vector-set! vec idx val), "TODO") { - profile_with_name("(vector-set!)"); - fetch(vec, idx, val); - - try assert_type(vec, Lisp_Object_Type::Vector); - try assert_type(idx, Lisp_Object_Type::Number); - - int int_idx = ((int)idx->value.number); - - try assert(int_idx >= 0); - try assert(int_idx < vec->value.vector.length); - - vec->value.vector.data[int_idx] = *val; - - return val; - }; - define_special((set! sym val), "TODO") { - profile_with_name("(set!)"); - fetch(sym, val); - - try assert_type(sym, Lisp_Object_Type::Symbol); - Environment* target_env; - in_caller_env { - val = eval_expr(val); - target_env = find_binding_environment(sym, get_current_environment()); - if (!target_env) - target_env = get_root_environment(); - } - - - push_environment(target_env); - define_symbol(sym, val); - pop_environment(); - - return val; - }; - define((set-car! target source), "TODO") { - profile_with_name("(set-car!)"); - fetch(target, source); - - try assert_type(target, Lisp_Object_Type::Pair); - - *target->value.pair.first = *source; - return source; - }; - define((set-cdr! target source), "TODO") { - profile_with_name("(set-cdr!)"); - fetch(target, source); - - try assert_type(target, Lisp_Object_Type::Pair); - - *target->value.pair.rest = *source; - return source; - }; - define_special((if test then_part else_part), "TODO") { - profile_with_name("(if)"); - fetch(test, then_part, else_part); - - bool truthy; - Lisp_Object* result; - - in_caller_env { - try truthy = is_truthy(test); - if (truthy) try result = eval_expr(then_part); - else try result = eval_expr(else_part); - } - - return result; - }; - define_special((quote datum), "TODO") { - profile_with_name("(quote)"); - fetch(datum); - return datum; - }; - define_special((quasiquote expr), "TODO") { - profile_with_name("(quasiquote)"); - fetch(expr); - Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote"); - Lisp_Object* unquote_sym = Memory::get_symbol("unquote"); - Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); - // NOTE(Felix): first we have to initialize the variable - // with a garbage lambda, so that we can then overwrite it - // a recursive lambda - const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* { - // if it is an atom, return it - if (Memory::get_type(expr) != Lisp_Object_Type::Pair) - return Memory::copy_lisp_object(expr); - - // 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 - - Lisp_Object* ret; - in_caller_env { - try ret = eval_expr(expr->value.pair.rest->value.pair.first); - } - - return ret; - } - - // it is a list but not starting with the symbol - // unquote, so search in there for stuff to unquote. - // While copying the list - - //NOTE(Felix): Of fucking course we have to copy the - // list. The quasiquote will be part of the body of a - // funciton, we can't just modify it because otherwise - // we modify the body of the function and would bake - // in the result... - 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 - if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Pair && - head->value.pair.first->value.pair.first == unquote_splicing_sym) - { - Lisp_Object* spliced = self(self, head->value.pair.first); - - if (spliced == Memory::nil) { - head = head->value.pair.rest; - continue; - } - - try assert_type(spliced, Lisp_Object_Type::Pair); - if (newPair == Memory::nil) { - try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - newPairHead = newPair; - } else { - try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - newPairHead = newPairHead->value.pair.rest; - newPairHead->value.pair.first = spliced->value.pair.first; - newPairHead->value.pair.rest = spliced->value.pair.rest; - - // now skip to the end - while (newPairHead->value.pair.rest != Memory::nil) { - newPairHead = newPairHead->value.pair.rest; - } - } - - } else { - if (newPair == Memory::nil) { - try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - newPairHead = newPair; - } else { - try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - newPairHead = newPairHead->value.pair.rest; - } - newPairHead->value.pair.first = self(self, head->value.pair.first); - } - - // if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) { - // break; - // } - - head = head->value.pair.rest; - - } - newPairHead->value.pair.rest = Memory::nil; - - return newPair; - }; - - expr = unquoteSomeExpressions(unquoteSomeExpressions, expr); - return expr; - }; - define_special((and . args), "TODO") { - profile_with_name("(and)"); - fetch(args); - bool result = true; - in_caller_env { - for_lisp_list (args) { - try result &= is_truthy(it); - if (!result) - return Memory::nil; - } - } - return Memory::t; - }; - define_special((or . args), "TODO") { - profile_with_name("(or)"); - fetch(args); - bool result = false; - in_caller_env { - for_lisp_list (args) { - try result |= is_truthy(it); - if (result) - return Memory::t; - } - } - return Memory::nil; - }; - define_special((not test), "TODO") { - profile_with_name("(not)"); - fetch(test); - bool truthy; - in_caller_env { - try truthy = is_truthy(test); - } - return (truthy) ? Memory::nil : Memory::t; - }; - // // defun("while", "TODO", __LINE__, cLambda { - // // try arguments_length = list_length(arguments); - // // try assert(arguments_length >= 2); - - // // Lisp_Object* condition_part = arguments->value.pair.first; - // // Lisp_Object* condition; - // // Lisp_Object* then_part = arguments->value.pair.rest; - // // Lisp_Object* wrapped_then_part; - - // // try wrapped_then_part = Memory::create_lisp_object_pair( - // // Memory::get_symbol("begin"), - // // then_part); - - // // Lisp_Object* result = Memory::nil; - - // // while (true) { - // // try condition = eval_expr(condition_part); - - // // if (condition == Memory::nil) - // // break; - - // // try result = eval_expr(wrapped_then_part); - // // } - // // return result; - - // // }); - define_special((lambda args . body), "TODO") { - profile_with_name("(lambda)"); - fetch(args, body); - - // creating new lisp object and setting type - Lisp_Object* func; - try func = Memory::create_lisp_object_function(Function_Type::Lambda); - - in_caller_env { - func->value.function->parent_environment = get_current_environment(); - } - - try create_arguments_from_lambda_list_and_inject(args, func); - func->value.function->body = maybe_wrap_body_in_begin(body); - return func; - }; - define((apply fun args), "TODO") { - profile_with_name("(apply)"); - fetch(fun, args); - Lisp_Object* result; - - try result = apply_arguments_to_function(args, fun, /*eval_args=*/false); - - return result; - }; - define((eval expr), "TODO") { - profile_with_name("(eval)"); - fetch(expr); - Lisp_Object* result; - - in_caller_env { - try result = eval_expr(expr); - } - - return result; - }; - define_special((begin . args), "TODO") { - profile_with_name("(begin)"); - fetch(args); - Lisp_Object* result = Memory::nil; - in_caller_env { - for_lisp_list(args) { - try result = eval_expr(it); - } - } - return result; - }; - define((list . args), "TODO") { - profile_with_name("(list)"); - fetch(args); - return args; - }; - define((hash-map . args), "TODO") { - profile_with_name("(hash-map)"); - fetch(args); - Lisp_Object* ret; - try ret = Memory::create_lisp_object_hash_map(); - for_lisp_list (args) { - try assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); - head = head->value.pair.rest; - ret->value.hashMap->set_object(it, head->value.pair.first); - } - - return ret; - }; - define((hash-map-get hm key), "TODO") { - profile_with_name("(hash-map-get)"); - fetch(hm, key); - try assert_type(hm, Lisp_Object_Type::HashMap); - - Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key); - if (!ret) - create_symbol_undefined_error("The key was not set in the hashmap"); - - return ret; - }; - define((hash-map-set! hm key value), "TODO") { - profile_with_name("(hash-map-set!)"); - fetch(hm, key, value); - try assert_type(hm, Lisp_Object_Type::HashMap); - hm->value.hashMap->set_object(key, value); - return Memory::nil; - }; - define((hash-map-delete! hm key), "TODO") { - profile_with_name("(hash-map-delete!)"); - fetch(hm, key); - try assert_type(hm, Lisp_Object_Type::HashMap); - hm->value.hashMap->delete_object(key); - return Memory::nil; - }; - define((vector . args), "TODO") { - profile_with_name("(vector)"); - fetch(args); - Lisp_Object* ret; - int length = list_length(args); - try ret = Memory::create_lisp_object_vector(length, args); - return ret; - }; - define((pair car cdr), "TODO") { - profile_with_name("(pair)"); - fetch(car, cdr); - - Lisp_Object* ret; - try ret = Memory::create_lisp_object_pair(car, cdr); - return ret; - }; - define((first seq), "TODO") { - profile_with_name("(first)"); - fetch(seq); - if (seq == Memory::nil) - return Memory::nil; - try assert_type(seq, Lisp_Object_Type::Pair); - return seq->value.pair.first; - }; - define((rest seq), "TODO") { - profile_with_name("(rest)"); - fetch(seq); - if (seq == Memory::nil) - return Memory::nil; - try assert_type(seq, Lisp_Object_Type::Pair); - return seq->value.pair.rest; - }; - define((set-type! node new_type), "TODO") { - profile_with_name("(set-type!)"); - fetch(node, new_type); - try assert_type(new_type, Lisp_Object_Type::Keyword); - node->userType = new_type; - return node; - }; - define((delete-type! n), "TODO") { - profile_with_name("(delete-type!)"); - fetch(n); - n->userType = nullptr; - return Memory::t; - }; - define((type n), "TODO") { - profile_with_name("(type)"); - fetch(n); - - if (n->userType) { - return n->userType; - } - - Lisp_Object_Type type = Memory::get_type(n); - - switch (type) { - case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation"); - case Lisp_Object_Type::CFunction: return Memory::get_keyword("cfunction"); - case Lisp_Object_Type::Function: { - Function* fun = n->value.function; - if (fun->type == Function_Type::Lambda) - return Memory::get_keyword("lambda"); - // else if (fun->type == Function_Type::Special_Lambda) - // return Memory::get_keyword("special-lambda"); - else if (fun->type == Function_Type::Macro) - return Memory::get_keyword("macro"); - else return Memory::get_keyword("unknown"); - } - case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap"); - case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword"); - case Lisp_Object_Type::Nil: return Memory::get_keyword("nil"); - case Lisp_Object_Type::Number: return Memory::get_keyword("number"); - case Lisp_Object_Type::Pair: return Memory::get_keyword("pair"); - case Lisp_Object_Type::Pointer: return Memory::get_keyword("pointer"); - case Lisp_Object_Type::String: return Memory::get_keyword("string"); - case Lisp_Object_Type::Symbol: return Memory::get_keyword("symbol"); - case Lisp_Object_Type::T: return Memory::get_keyword("t"); - case Lisp_Object_Type::Vector: return Memory::get_keyword("vector"); - } - return Memory::get_keyword("unknown"); - }; - define((mem-reset), "TODO") { - profile_with_name("(mem-reset)"); - Memory::reset(); - return Memory::nil; - }; - // NOTE(Felix): we need to define_special because the docstring is - // attached to the symbol. Because some object are singletons - // (symbols, keyowrds, nil, t) we dont want to store docs on the - // object. Otherwise (define k :doc "hallo" :keyword) would modify - // the global keyword - define_special((info n), "TODO") { - profile_with_name("(info)"); - fetch(n); - - print(n); - - Lisp_Object* type; - Lisp_Object* val; - in_caller_env { - try type = eval_expr(Memory::create_list(Memory::get_symbol("type"), n)); - try val = eval_expr(n); - } - - printf(" is of type "); - print(type); - printf(" (internal: %s)", Lisp_Object_Type_to_string(Memory::get_type(val))); - printf("\nand is printed as: "); - print(val); - printf("\n\ndocs: \n %s\n", - (val->docstring) - ? Memory::get_c_str(val->docstring) - : "No docs avaliable"); - - if (Memory::get_type(val) == Lisp_Object_Type::Function || - Memory::get_type(val) == Lisp_Object_Type::CFunction) + profile_with_name("(*)"); + fetch(args); + if (args == Memory::nil) { + return Memory::create_lisp_object(1); + } + + double product = 1; + + for_lisp_list (args) { + try assert_type(it, Lisp_Object_Type::Number); + product *= it->value.number; + } + + return Memory::create_lisp_object(product); + }; + define((/ . args), "TODO") { - Arguments* args; - if (Memory::get_type(val) == Lisp_Object_Type::Function) - args = &val->value.function->args; - else - args = &val->value.cFunction->args; - - printf("Arguments:\n==========\n"); - printf("Postitional: {"); - if (args->positional.symbols.next_index != 0) { - printf("%s", - Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); - for (int i = 1; i < args->positional.symbols.next_index; ++i) { - printf(", %s", - Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); - } - } - printf("}\n"); - printf("Keyword: {"); - if (args->keyword.values.next_index != 0) { - printf("%s", - Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); - if (args->keyword.values.data[0]) { - printf(" ("); - print(args->keyword.values.data[0], true); - printf(")"); - } - for (int i = 1; i < args->keyword.values.next_index; ++i) { - printf(", %s", - Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); - if (args->keyword.values.data[i]) { - printf(" ("); - print(args->keyword.values.data[i], true); - printf(")"); - } - } - } - printf("}\n"); - printf("Rest: {"); - if (args->rest) - printf("%s", - Memory::get_c_str(args->rest->value.symbol)); - printf("}\n"); - - } - return Memory::nil; - }; - define((show n), "TODO") { - profile_with_name("(show)"); - fetch(n); - try assert_type(n, Lisp_Object_Type::Function); - - puts("body:\n"); - print(n->value.function->body); - puts("\n"); - printf("parent_env: %lld\n", - (long long)n->value.function->parent_environment); - - return Memory::nil; - }; - define((addr-of var), "TODO") { - profile_with_name("(addr-of-var)"); - fetch(var); - return Memory::create_lisp_object( - (float)((u64)&(var))); - }; - define((generate-docs file_name), "TODO") { - profile_with_name("(generate-docs)"); - fetch(file_name); - try assert_type(file_name, Lisp_Object_Type::String); - in_caller_env { - try generate_docs(file_name->value.string); - } - return Memory::t; - }; - define((print (:sep " ") (:end "\n") . things), "TODO") { - profile_with_name("(print)"); - fetch(sep, end, things); - - if (things != Memory::nil) { - print(things->value.pair.first); - - for_lisp_list(things->value.pair.rest) { - print(sep); - print(it); - } - } - - print(end); - return Memory::nil; - }; - define((read (:prompt ">")), "TODO") { - profile_with_name("(read)"); - fetch(prompt); - print(prompt); - - // TODO(Felix): make read_line return a String* - char* line = read_line(); - defer { - free(line); - }; - String* strLine = Memory::create_string(line); - return Memory::create_lisp_object(strLine); - }; - define((exit (:code 0)), "TODO") { - profile_with_name("(exit)"); - fetch(code); - try assert_type(code, Lisp_Object_Type::Number); - exit((int)code->value.number); - }; - define((break), "TODO") { - profile_with_name("(break)"); - in_caller_env { - print_environment(get_current_environment()); - } - return Memory::nil; - }; - define((memstat), "TODO") { - profile_with_name("(memstat)"); - Memory::print_status(); - return Memory::nil; - }; - define_special((mytry try_part catch_part), "TODO") { - profile_with_name("(mytry)"); - fetch(try_part, catch_part); - - Lisp_Object* result; - - in_caller_env { - ignore_logging { - dont_break_on_errors { - result = eval_expr(try_part); - if (Globals::error) { - delete_error(); - try result = eval_expr(catch_part); - } - } - } - } - return result; - }; - define((load file), "TODO") { - profile_with_name("(load)"); - fetch(file); - try assert_type(file, Lisp_Object_Type::String); - - Lisp_Object* result; - in_caller_env { - try result = built_in_load(file->value.string); - } - return result; - }; - define((import f), "TODO") { - profile_with_name("(import)"); - fetch(f); - try assert_type(f, Lisp_Object_Type::String); - - Lisp_Object *result; - in_caller_env { - try result = built_in_import(f->value.string); - } - - return Memory::t; - }; - define((copy obj), "TODO") { - profile_with_name("(copy)"); - fetch(obj); - // TODO(Felix): if we are copying string nodes, then - // shouldn't the string itself also get copied?? - return Memory::copy_lisp_object(obj); - }; - define((error type message), "TODO") { - profile_with_name("(error)"); - fetch(type, message); - // TODO(Felix): make the error function useful - try assert_type(type, Lisp_Object_Type::Keyword); - try assert_type(message, Lisp_Object_Type::String); - - using Globals::error; - error = new(Error); - error->type = type; - error->message = message->value.string; - - create_generic_error("Userlanderror"); - return nullptr; - }; - define((symbol->keyword sym), "TODO") { - profile_with_name("(symbol->keyword)"); - fetch(sym); - try assert_type(sym, Lisp_Object_Type::Symbol); - return Memory::get_keyword(sym->value.symbol); - }; - define((string->symbol str), "TODO") { - profile_with_name("(string->symbol)"); - fetch(str); - // TODO(Felix): do some sanity checks on the string. For - // example, numbers are not valid symbols. - - try assert_type(str, Lisp_Object_Type::String); - return Memory::get_symbol(Memory::duplicate_string(str->value.string)); - }; - define((symbol->string sym), "TODO") { - profile_with_name("(symbol->string)"); - fetch(sym); - - try assert_type(sym, Lisp_Object_Type::Symbol); - return Memory::create_lisp_object( - Memory::duplicate_string(sym->value.symbol)); - }; - define((concat-strings . strings), "TODO") { - profile_with_name("(concat-strings)"); - fetch(strings); - - int resulting_string_len = 0; - for_lisp_list (strings) { - try assert_type(it, Lisp_Object_Type::String); - resulting_string_len += it->value.string->length; - } - - String* resulting_string = Memory::create_string("", resulting_string_len); - int index_in_string = 0; - - for_lisp_list (strings) { - strcpy((&resulting_string->data)+index_in_string, - Memory::get_c_str(it->value.string)); - index_in_string += it->value.string->length; - } - - return Memory::create_lisp_object(resulting_string); - }; - return nullptr; - } + profile_with_name("(/)"); + fetch(args); + + if (args == Memory::nil) { + return Memory::create_lisp_object(1); + } + + try assert_type(args->value.pair.first, Lisp_Object_Type::Number); + + double quotient = args->value.pair.first->value.number; + + for_lisp_list (args->value.pair.rest) { + try assert_type(it, Lisp_Object_Type::Number); + quotient /= it->value.number; + } + + return Memory::create_lisp_object(quotient); + }; + define((** a b), "TODO") { + profile_with_name("(**)"); + fetch(a, b); + try assert_type(a, Lisp_Object_Type::Number); + try assert_type(b, Lisp_Object_Type::Number); + return Memory::create_lisp_object(pow(a->value.number, + b->value.number)); + }; + define((% a b), "TODO") { + profile_with_name("(%)"); + fetch(a, b); + try assert_type(a, Lisp_Object_Type::Number); + try assert_type(b, Lisp_Object_Type::Number); + return Memory::create_lisp_object((int)a->value.number % + (int)b->value.number); + }; + define((get-random-between a b), "TODO") { + profile_with_name("(get-random-between)"); + fetch(a, b); + try assert_type(a, Lisp_Object_Type::Number); + try assert_type(b, Lisp_Object_Type::Number); + + double fa = a->value.number; + double fb = b->value.number; + double x = (double)rand()/(double)(RAND_MAX); + x *= (fb - fa); + x += fa; + + return Memory::create_lisp_object(x); + }; + define_special((bound? var), "TODO") { + profile_with_name("(bound?)"); + fetch(var); + try assert_type(var, Lisp_Object_Type::Symbol); + + Lisp_Object* res; + in_caller_env { + res = try_lookup_symbol(var, get_current_environment()); + } + if (res) + return Memory::t; + return Memory::nil; + }; + define((assert test), "TODO") { + profile_with_name("(assert)"); + fetch(test); + + if (is_truthy(test)) + return Memory::t; + + create_generic_error("Userland assertion."); + return nullptr; + }; + define_special((define-syntax form (:doc "") . body), "TODO") { + profile_with_name("(define-syntax)"); + fetch(form, doc, body); + + try assert_type(doc, Lisp_Object_Type::String); + // if no doc string, we dont have to store it + if (Memory::get_c_str(doc)[0] == '\0') { + doc = nullptr; + } + + if (Memory::get_type(form) != Lisp_Object_Type::Pair) { + create_parsing_error("You can only create function macros."); + return nullptr; + } + + Lisp_Object* symbol = form->value.pair.first; + Lisp_Object* lambdalist = form->value.pair.rest; + + // creating new lisp object and setting type + Lisp_Object* func; + try func = Memory::create_lisp_object_function(Function_Type::Macro); + + // Lisp_Object* func; + // try func = Memory::create_lisp_object(); + // Memory::set_type(func, Lisp_Object_Type::Function); + // func->value.function->type = Function_Type::Macro; + if (doc) func->docstring = doc->value.string; + + in_caller_env { + // setting parent env + func->value.function->parent_environment = get_current_environment(); + create_arguments_from_lambda_list_and_inject(lambdalist, func); + func->value.function->body = maybe_wrap_body_in_begin(body); + define_symbol(symbol, func); + } + return Memory::nil; + }; + define_special((define definee (:doc "") . body), "TODO") { + profile_with_name("(define)"); + fetch(definee, doc, body); + + // print_hm(get_current_environment()->hm); + try assert_type(doc, Lisp_Object_Type::String); + + // if no doc string, we dont have to store it + if (Memory::get_c_str(doc)[0] == '\0') { + doc = nullptr; + } + + if (Memory::get_type(definee) == Lisp_Object_Type::Symbol) { + if (body == Memory::nil) { + create_parsing_error("You at least have to put a value when " + "you are trying to define a variable."); + return nullptr; + } else if (body->value.pair.rest != Memory::nil) { + create_parsing_error("You cannot define more than one thing " + "for one variable."); + return nullptr; + } + auto value = body->value.pair.first; + in_caller_env { + try value = eval_expr(value); + define_symbol(definee, value); + } + } else if (Memory::get_type(definee) == Lisp_Object_Type::Pair) { + // definee: (sym . lambdalist) + Lisp_Object* symbol = definee->value.pair.first; + Lisp_Object* lambdalist = definee->value.pair.rest; + + // creating new lisp object and setting type + Lisp_Object* func; + try func = Memory::create_lisp_object_function(Function_Type::Lambda); + + if (doc) + func->docstring = doc->value.string; + + in_caller_env { + // setting parent env + func->value.function->parent_environment = get_current_environment(); + create_arguments_from_lambda_list_and_inject(lambdalist, func); + func->value.function->body = maybe_wrap_body_in_begin(body); + define_symbol(symbol, func); + } + + } else { + create_parsing_error("The to be defined object has to be a " + "symbol or a list. But got a %s.", + Lisp_Object_Type_to_string( + Memory::get_type(definee))); + return nullptr; + } + return Memory::nil; + }; + define((mutate target source), "TODO") { + profile_with_name("(mutate)"); + fetch(target, source); + + if (target == Memory::nil || + target == Memory::t || + Memory::get_type(target) == Lisp_Object_Type::Keyword || + Memory::get_type(target) == Lisp_Object_Type::Symbol) + { + create_generic_error("You cannot mutate to nil, t, keywords or symbols because they have to be unique"); + } + + if (source == Memory::nil || + source == Memory::t || + Memory::get_type(source) == Lisp_Object_Type::Keyword || + Memory::get_type(source) == Lisp_Object_Type::Symbol) + { + create_generic_error("You cannot mutate nil, t, keywords or symbols"); + } + + *target = *source; + return target; + }; + define((vector-length v), "TODO") { + profile_with_name("(vector-length)"); + fetch(v); + try assert_type(v, Lisp_Object_Type::Vector); + return Memory::create_lisp_object((double)v->value.vector.length); + }; + define((vector-ref vec idx), "TODO") { + profile_with_name("(vector-ref)"); + fetch(vec, idx); + + try assert_type(vec, Lisp_Object_Type::Vector); + try assert_type(idx, Lisp_Object_Type::Number); + + int int_idx = ((int)idx->value.number); + + try assert(int_idx >= 0); + try assert(int_idx < vec->value.vector.length); + + return vec->value.vector.data+int_idx; + }; + define((vector-set! vec idx val), "TODO") { + profile_with_name("(vector-set!)"); + fetch(vec, idx, val); + + try assert_type(vec, Lisp_Object_Type::Vector); + try assert_type(idx, Lisp_Object_Type::Number); + + int int_idx = ((int)idx->value.number); + + try assert(int_idx >= 0); + try assert(int_idx < vec->value.vector.length); + + vec->value.vector.data[int_idx] = *val; + + return val; + }; + define_special((set! sym val), "TODO") { + profile_with_name("(set!)"); + fetch(sym, val); + + try assert_type(sym, Lisp_Object_Type::Symbol); + Environment* target_env; + in_caller_env { + val = eval_expr(val); + target_env = find_binding_environment(sym, get_current_environment()); + if (!target_env) + target_env = get_root_environment(); + } + + + push_environment(target_env); + define_symbol(sym, val); + pop_environment(); + + return val; + }; + define((set-car! target source), "TODO") { + profile_with_name("(set-car!)"); + fetch(target, source); + + try assert_type(target, Lisp_Object_Type::Pair); + + *target->value.pair.first = *source; + return source; + }; + define((set-cdr! target source), "TODO") { + profile_with_name("(set-cdr!)"); + fetch(target, source); + + try assert_type(target, Lisp_Object_Type::Pair); + + *target->value.pair.rest = *source; + return source; + }; + define_special((if test then_part else_part), "TODO") { + profile_with_name("(if)"); + fetch(test, then_part, else_part); + + bool truthy; + Lisp_Object* result; + + in_caller_env { + try truthy = is_truthy(test); + if (truthy) try result = eval_expr(then_part); + else try result = eval_expr(else_part); + } + + return result; + }; + define_special((quote datum), "TODO") { + profile_with_name("(quote)"); + fetch(datum); + return datum; + }; + define_special((quasiquote expr), "TODO") { + profile_with_name("(quasiquote)"); + fetch(expr); + Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote"); + Lisp_Object* unquote_sym = Memory::get_symbol("unquote"); + Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); + // NOTE(Felix): first we have to initialize the variable + // with a garbage lambda, so that we can then overwrite it + // a recursive lambda + const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* { + // if it is an atom, return it + if (Memory::get_type(expr) != Lisp_Object_Type::Pair) + return Memory::copy_lisp_object(expr); + + // 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 + + Lisp_Object* ret; + in_caller_env { + try ret = eval_expr(expr->value.pair.rest->value.pair.first); + } + + return ret; + } + + // it is a list but not starting with the symbol + // unquote, so search in there for stuff to unquote. + // While copying the list + + //NOTE(Felix): Of fucking course we have to copy the + // list. The quasiquote will be part of the body of a + // funciton, we can't just modify it because otherwise + // we modify the body of the function and would bake + // in the result... + 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 + if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Pair && + head->value.pair.first->value.pair.first == unquote_splicing_sym) + { + Lisp_Object* spliced = self(self, head->value.pair.first); + + if (spliced == Memory::nil) { + head = head->value.pair.rest; + continue; + } + + try assert_type(spliced, Lisp_Object_Type::Pair); + if (newPair == Memory::nil) { + try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + newPairHead = newPair; + } else { + try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + newPairHead = newPairHead->value.pair.rest; + newPairHead->value.pair.first = spliced->value.pair.first; + newPairHead->value.pair.rest = spliced->value.pair.rest; + + // now skip to the end + while (newPairHead->value.pair.rest != Memory::nil) { + newPairHead = newPairHead->value.pair.rest; + } + } + + } else { + if (newPair == Memory::nil) { + try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + newPairHead = newPair; + } else { + try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + newPairHead = newPairHead->value.pair.rest; + } + newPairHead->value.pair.first = self(self, head->value.pair.first); + } + + // if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) { + // break; + // } + + head = head->value.pair.rest; + + } + newPairHead->value.pair.rest = Memory::nil; + + return newPair; + }; + + expr = unquoteSomeExpressions(unquoteSomeExpressions, expr); + return expr; + }; + define_special((and . args), "TODO") { + profile_with_name("(and)"); + fetch(args); + bool result = true; + in_caller_env { + for_lisp_list (args) { + try result &= is_truthy(it); + if (!result) + return Memory::nil; + } + } + return Memory::t; + }; + define_special((or . args), "TODO") { + profile_with_name("(or)"); + fetch(args); + bool result = false; + in_caller_env { + for_lisp_list (args) { + try result |= is_truthy(it); + if (result) + return Memory::t; + } + } + return Memory::nil; + }; + define_special((not test), "TODO") { + profile_with_name("(not)"); + fetch(test); + bool truthy; + in_caller_env { + try truthy = is_truthy(test); + } + return (truthy) ? Memory::nil : Memory::t; + }; + // // defun("while", "TODO", __LINE__, cLambda { + // // try arguments_length = list_length(arguments); + // // try assert(arguments_length >= 2); + + // // Lisp_Object* condition_part = arguments->value.pair.first; + // // Lisp_Object* condition; + // // Lisp_Object* then_part = arguments->value.pair.rest; + // // Lisp_Object* wrapped_then_part; + + // // try wrapped_then_part = Memory::create_lisp_object_pair( + // // Memory::get_symbol("begin"), + // // then_part); + + // // Lisp_Object* result = Memory::nil; + + // // while (true) { + // // try condition = eval_expr(condition_part); + + // // if (condition == Memory::nil) + // // break; + + // // try result = eval_expr(wrapped_then_part); + // // } + // // return result; + + // // }); + define_special((lambda args . body), "TODO") { + profile_with_name("(lambda)"); + fetch(args, body); + + // creating new lisp object and setting type + Lisp_Object* func; + try func = Memory::create_lisp_object_function(Function_Type::Lambda); + + in_caller_env { + func->value.function->parent_environment = get_current_environment(); + } + + try create_arguments_from_lambda_list_and_inject(args, func); + func->value.function->body = maybe_wrap_body_in_begin(body); + return func; + }; + define((apply fun args), "TODO") { + profile_with_name("(apply)"); + fetch(fun, args); + Lisp_Object* result; + + try result = apply_arguments_to_function(args, fun, /*eval_args=*/false); + + return result; + }; + define((eval expr), "TODO") { + profile_with_name("(eval)"); + fetch(expr); + Lisp_Object* result; + + in_caller_env { + try result = eval_expr(expr); + } + + return result; + }; + define_special((begin . args), "TODO") { + profile_with_name("(begin)"); + fetch(args); + Lisp_Object* result = Memory::nil; + in_caller_env { + for_lisp_list(args) { + try result = eval_expr(it); + } + } + return result; + }; + define((list . args), "TODO") { + profile_with_name("(list)"); + fetch(args); + return args; + }; + define((hash-map . args), "TODO") { + profile_with_name("(hash-map)"); + fetch(args); + Lisp_Object* ret; + try ret = Memory::create_lisp_object_hash_map(); + for_lisp_list (args) { + try assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); + head = head->value.pair.rest; + ret->value.hashMap->set_object(it, head->value.pair.first); + } + + return ret; + }; + define((hash-map-get hm key), "TODO") { + profile_with_name("(hash-map-get)"); + fetch(hm, key); + try assert_type(hm, Lisp_Object_Type::HashMap); + + Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key); + if (!ret) + create_symbol_undefined_error("The key was not set in the hashmap"); + + return ret; + }; + define((hash-map-set! hm key value), "TODO") { + profile_with_name("(hash-map-set!)"); + fetch(hm, key, value); + try assert_type(hm, Lisp_Object_Type::HashMap); + hm->value.hashMap->set_object(key, value); + return Memory::nil; + }; + define((hash-map-delete! hm key), "TODO") { + profile_with_name("(hash-map-delete!)"); + fetch(hm, key); + try assert_type(hm, Lisp_Object_Type::HashMap); + hm->value.hashMap->delete_object(key); + return Memory::nil; + }; + define((vector . args), "TODO") { + profile_with_name("(vector)"); + fetch(args); + Lisp_Object* ret; + int length = list_length(args); + try ret = Memory::create_lisp_object_vector(length, args); + return ret; + }; + define((pair car cdr), "TODO") { + profile_with_name("(pair)"); + fetch(car, cdr); + + Lisp_Object* ret; + try ret = Memory::create_lisp_object_pair(car, cdr); + return ret; + }; + define((first seq), "TODO") { + profile_with_name("(first)"); + fetch(seq); + if (seq == Memory::nil) + return Memory::nil; + try assert_type(seq, Lisp_Object_Type::Pair); + return seq->value.pair.first; + }; + define((rest seq), "TODO") { + profile_with_name("(rest)"); + fetch(seq); + if (seq == Memory::nil) + return Memory::nil; + try assert_type(seq, Lisp_Object_Type::Pair); + return seq->value.pair.rest; + }; + define((set-type! node new_type), "TODO") { + profile_with_name("(set-type!)"); + fetch(node, new_type); + try assert_type(new_type, Lisp_Object_Type::Keyword); + node->userType = new_type; + return node; + }; + define((delete-type! n), "TODO") { + profile_with_name("(delete-type!)"); + fetch(n); + n->userType = nullptr; + return Memory::t; + }; + define((type n), "TODO") { + profile_with_name("(type)"); + fetch(n); + + if (n->userType) { + return n->userType; + } + + Lisp_Object_Type type = Memory::get_type(n); + + switch (type) { + case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation"); + case Lisp_Object_Type::CFunction: return Memory::get_keyword("cfunction"); + case Lisp_Object_Type::Function: { + Function* fun = n->value.function; + if (fun->type == Function_Type::Lambda) + return Memory::get_keyword("lambda"); + // else if (fun->type == Function_Type::Special_Lambda) + // return Memory::get_keyword("special-lambda"); + else if (fun->type == Function_Type::Macro) + return Memory::get_keyword("macro"); + else return Memory::get_keyword("unknown"); + } + case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap"); + case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword"); + case Lisp_Object_Type::Nil: return Memory::get_keyword("nil"); + case Lisp_Object_Type::Number: return Memory::get_keyword("number"); + case Lisp_Object_Type::Pair: return Memory::get_keyword("pair"); + case Lisp_Object_Type::Pointer: return Memory::get_keyword("pointer"); + case Lisp_Object_Type::String: return Memory::get_keyword("string"); + case Lisp_Object_Type::Symbol: return Memory::get_keyword("symbol"); + case Lisp_Object_Type::T: return Memory::get_keyword("t"); + case Lisp_Object_Type::Vector: return Memory::get_keyword("vector"); + } + return Memory::get_keyword("unknown"); + }; + define((mem-reset), "TODO") { + profile_with_name("(mem-reset)"); + Memory::reset(); + return Memory::nil; + }; + // NOTE(Felix): we need to define_special because the docstring is + // attached to the symbol. Because some object are singletons + // (symbols, keyowrds, nil, t) we dont want to store docs on the + // object. Otherwise (define k :doc "hallo" :keyword) would modify + // the global keyword + define_special((info n), "TODO") { + profile_with_name("(info)"); + fetch(n); + + print(n); + + Lisp_Object* type; + Lisp_Object* val; + in_caller_env { + try type = eval_expr(Memory::create_list(Memory::get_symbol("type"), n)); + try val = eval_expr(n); + } + + printf(" is of type "); + print(type); + printf(" (internal: %s)", Lisp_Object_Type_to_string(Memory::get_type(val))); + printf("\nand is printed as: "); + print(val); + printf("\n\ndocs: \n %s\n", + (val->docstring) + ? Memory::get_c_str(val->docstring) + : "No docs avaliable"); + + if (Memory::get_type(val) == Lisp_Object_Type::Function || + Memory::get_type(val) == Lisp_Object_Type::CFunction) + { + Arguments* args; + if (Memory::get_type(val) == Lisp_Object_Type::Function) + args = &val->value.function->args; + else + args = &val->value.cFunction->args; + + printf("Arguments:\n==========\n"); + printf("Postitional: {"); + if (args->positional.symbols.next_index != 0) { + printf("%s", + Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); + for (int i = 1; i < args->positional.symbols.next_index; ++i) { + printf(", %s", + Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); + } + } + printf("}\n"); + printf("Keyword: {"); + if (args->keyword.values.next_index != 0) { + printf("%s", + Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); + if (args->keyword.values.data[0]) { + printf(" ("); + print(args->keyword.values.data[0], true); + printf(")"); + } + for (int i = 1; i < args->keyword.values.next_index; ++i) { + printf(", %s", + Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); + if (args->keyword.values.data[i]) { + printf(" ("); + print(args->keyword.values.data[i], true); + printf(")"); + } + } + } + printf("}\n"); + printf("Rest: {"); + if (args->rest) + printf("%s", + Memory::get_c_str(args->rest->value.symbol)); + printf("}\n"); + + } + return Memory::nil; + }; + define((show n), "TODO") { + profile_with_name("(show)"); + fetch(n); + try assert_type(n, Lisp_Object_Type::Function); + + puts("body:\n"); + print(n->value.function->body); + puts("\n"); + printf("parent_env: %lld\n", + (long long)n->value.function->parent_environment); + + return Memory::nil; + }; + define((addr-of var), "TODO") { + profile_with_name("(addr-of-var)"); + fetch(var); + return Memory::create_lisp_object( + (float)((u64)&(var))); + }; + define((generate-docs file_name), "TODO") { + profile_with_name("(generate-docs)"); + fetch(file_name); + try assert_type(file_name, Lisp_Object_Type::String); + in_caller_env { + try generate_docs(file_name->value.string); + } + return Memory::t; + }; + define((print (:sep " ") (:end "\n") . things), "TODO") { + profile_with_name("(print)"); + fetch(sep, end, things); + + if (things != Memory::nil) { + print(things->value.pair.first); + + for_lisp_list(things->value.pair.rest) { + print(sep); + print(it); + } + } + + print(end); + return Memory::nil; + }; + define((read (:prompt ">")), "TODO") { + profile_with_name("(read)"); + fetch(prompt); + print(prompt); + + // TODO(Felix): make read_line return a String* + char* line = read_line(); + defer { + free(line); + }; + String* strLine = Memory::create_string(line); + return Memory::create_lisp_object(strLine); + }; + define((exit (:code 0)), "TODO") { + profile_with_name("(exit)"); + fetch(code); + try assert_type(code, Lisp_Object_Type::Number); + exit((int)code->value.number); + }; + define((break), "TODO") { + profile_with_name("(break)"); + in_caller_env { + print_environment(get_current_environment()); + } + return Memory::nil; + }; + define((memstat), "TODO") { + profile_with_name("(memstat)"); + Memory::print_status(); + return Memory::nil; + }; + define_special((mytry try_part catch_part), "TODO") { + profile_with_name("(mytry)"); + fetch(try_part, catch_part); + + Lisp_Object* result; + + in_caller_env { + ignore_logging { + dont_break_on_errors { + result = eval_expr(try_part); + if (Globals::error) { + delete_error(); + try result = eval_expr(catch_part); + } + } + } + } + return result; + }; + define((load file), "TODO") { + profile_with_name("(load)"); + fetch(file); + try assert_type(file, Lisp_Object_Type::String); + + Lisp_Object* result; + in_caller_env { + try result = built_in_load(file->value.string); + } + return result; + }; + define((import f), "TODO") { + profile_with_name("(import)"); + fetch(f); + try assert_type(f, Lisp_Object_Type::String); + + Lisp_Object *result; + in_caller_env { + try result = built_in_import(f->value.string); + } + + return Memory::t; + }; + define((copy obj), "TODO") { + profile_with_name("(copy)"); + fetch(obj); + // TODO(Felix): if we are copying string nodes, then + // shouldn't the string itself also get copied?? + return Memory::copy_lisp_object(obj); + }; + define((error type message), "TODO") { + profile_with_name("(error)"); + fetch(type, message); + // TODO(Felix): make the error function useful + try assert_type(type, Lisp_Object_Type::Keyword); + try assert_type(message, Lisp_Object_Type::String); + + using Globals::error; + error = new(Error); + error->type = type; + error->message = message->value.string; + + create_generic_error("Userlanderror"); + return nullptr; + }; + define((symbol->keyword sym), "TODO") { + profile_with_name("(symbol->keyword)"); + fetch(sym); + try assert_type(sym, Lisp_Object_Type::Symbol); + return Memory::get_keyword(sym->value.symbol); + }; + define((string->symbol str), "TODO") { + profile_with_name("(string->symbol)"); + fetch(str); + // TODO(Felix): do some sanity checks on the string. For + // example, numbers are not valid symbols. + + try assert_type(str, Lisp_Object_Type::String); + return Memory::get_symbol(Memory::duplicate_string(str->value.string)); + }; + define((symbol->string sym), "TODO") { + profile_with_name("(symbol->string)"); + fetch(sym); + + try assert_type(sym, Lisp_Object_Type::Symbol); + return Memory::create_lisp_object( + Memory::duplicate_string(sym->value.symbol)); + }; + define((concat-strings . strings), "TODO") { + profile_with_name("(concat-strings)"); + fetch(strings); + + int resulting_string_len = 0; + for_lisp_list (strings) { + try assert_type(it, Lisp_Object_Type::String); + resulting_string_len += it->value.string->length; + } + + String* resulting_string = Memory::create_string("", resulting_string_len); + int index_in_string = 0; + + for_lisp_list (strings) { + strcpy((&resulting_string->data)+index_in_string, + Memory::get_c_str(it->value.string)); + index_in_string += it->value.string->length; + } + + return Memory::create_lisp_object(resulting_string); + }; + return nullptr; + } } diff --git a/src/docgeneration.cpp b/src/docgeneration.cpp index 18d122f..2d4a59a 100644 --- a/src/docgeneration.cpp +++ b/src/docgeneration.cpp @@ -1,144 +1,146 @@ -proc generate_docs(String* path) -> void { - FILE *f = fopen(Memory::get_c_str(path), "w"); - if (!f) { - create_generic_error("The file for writing the documentation (%s) " - "could not be opened for writing.", Memory::get_c_str(path)); - return; - } - defer { - fclose(f); - }; - - Array_List visited; - - const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void { - bool we_already_printed = false; - // TODO(Felix): Make a generic array_list_contains function - for(auto it : visited) { - if (it == env) { - we_already_printed = true; - break; - } +namespace Slime { + proc generate_docs(String* path) -> void { + FILE *f = fopen(Memory::get_c_str(path), "w"); + if (!f) { + create_generic_error("The file for writing the documentation (%s) " + "could not be opened for writing.", Memory::get_c_str(path)); + return; } - if (!we_already_printed) { - // printf("Working on env::::"); - // print_environment(env); - // printf("\n--------------------------------\n"); - visited.append(env); + defer { + fclose(f); + }; - push_environment(env); - defer { - pop_environment(); - }; + Array_List visited; - for_hash_map(env->hm) { - try_void fprintf(f, - "#+latex: \\hrule\n" - "#+html:
\n" - "* =%s%s= \n" - " :PROPERTIES:\n" - " :UNNUMBERED: t\n" - " :END:" - ,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol)); - /* - * sourcecodeLocation - */ - if (value->sourceCodeLocation) { - try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", - Memory::get_c_str(value->sourceCodeLocation->file), - value->sourceCodeLocation->line, - value->sourceCodeLocation->column); + const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void { + bool we_already_printed = false; + // TODO(Felix): Make a generic array_list_contains function + for(auto it : visited) { + if (it == env) { + we_already_printed = true; + break; } - /* - * type - */ - Lisp_Object_Type type = Memory::get_type(value); - Lisp_Object* LOtype; - Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value); - try_void LOtype = eval_expr(type_expr); + } + if (!we_already_printed) { + // printf("Working on env::::"); + // print_environment(env); + // printf("\n--------------------------------\n"); + visited.append(env); - fprintf(f, "\n - type :: ="); - print(LOtype, true, f); - fprintf(f, "="); + push_environment(env); + defer { + pop_environment(); + }; + for_hash_map(env->hm) { + try_void fprintf(f, + "#+latex: \\hrule\n" + "#+html:
\n" + "* =%s%s= \n" + " :PROPERTIES:\n" + " :UNNUMBERED: t\n" + " :END:" + ,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol)); + /* + * sourcecodeLocation + */ + if (value->sourceCodeLocation) { + try_void fprintf(f, "\n - defined in :: =%s:%d:%d=", + Memory::get_c_str(value->sourceCodeLocation->file), + value->sourceCodeLocation->line, + value->sourceCodeLocation->column); + } + /* + * type + */ + Lisp_Object_Type type = Memory::get_type(value); + Lisp_Object* LOtype; + Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value); + try_void LOtype = eval_expr(type_expr); - /* - * if printable value -> print it - */ - switch (type) { - case(Lisp_Object_Type::Nil): - case(Lisp_Object_Type::T): - case(Lisp_Object_Type::Number): - case(Lisp_Object_Type::String): - case(Lisp_Object_Type::Pair): - case(Lisp_Object_Type::Symbol): - case(Lisp_Object_Type::Keyword): { - fprintf(f, "\n - value :: ="); - print(value, true, f); + fprintf(f, "\n - type :: ="); + print(LOtype, true, f); fprintf(f, "="); - } break; - default: break; - } - /* - * if function then print arguments - */ - if (type == Lisp_Object_Type::Function || - type == Lisp_Object_Type::CFunction) - { - Arguments* args = - (type == Lisp_Object_Type::Function) - ? &value->value.function->args - : &value->value.cFunction->args; - fprintf(f, "\n - arguments :: "); - // if no args at all - if (args->positional.symbols.next_index == 0 && - args->keyword.values.next_index == 0 && - !args->rest) + + + /* + * if printable value -> print it + */ + switch (type) { + case(Lisp_Object_Type::Nil): + case(Lisp_Object_Type::T): + case(Lisp_Object_Type::Number): + case(Lisp_Object_Type::String): + case(Lisp_Object_Type::Pair): + case(Lisp_Object_Type::Symbol): + case(Lisp_Object_Type::Keyword): { + fprintf(f, "\n - value :: ="); + print(value, true, f); + fprintf(f, "="); + } break; + default: break; + } + /* + * if function then print arguments + */ + if (type == Lisp_Object_Type::Function || + type == Lisp_Object_Type::CFunction) { - fprintf(f, "none."); - } else { - if (args->positional.symbols.next_index != 0) { - fprintf(f, "\n - postitional :: "); - fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); - for (int i = 1; i < args->positional.symbols.next_index; ++i) { - fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); - } - } - if (args->keyword.values.next_index != 0) { - fprintf(f, "\n - keyword :: "); - fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); - if (args->keyword.values.data[0]) { - fprintf(f, " =("); - print(args->keyword.values.data[0], true, f); - fprintf(f, ")="); + Arguments* args = + (type == Lisp_Object_Type::Function) + ? &value->value.function->args + : &value->value.cFunction->args; + fprintf(f, "\n - arguments :: "); + // if no args at all + if (args->positional.symbols.next_index == 0 && + args->keyword.values.next_index == 0 && + !args->rest) + { + fprintf(f, "none."); + } else { + if (args->positional.symbols.next_index != 0) { + fprintf(f, "\n - postitional :: "); + fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); + for (int i = 1; i < args->positional.symbols.next_index; ++i) { + fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); + } } - 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 (args->keyword.values.data[i]) { + if (args->keyword.values.next_index != 0) { + fprintf(f, "\n - keyword :: "); + fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); + if (args->keyword.values.data[0]) { fprintf(f, " =("); - print(args->keyword.values.data[i], true, f); + print(args->keyword.values.data[0], true, 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 (args->keyword.values.data[i]) { + fprintf(f, " =("); + print(args->keyword.values.data[i], true, f); + fprintf(f, ")="); + } + } + } + if (args->rest) { + fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); } - } - if (args->rest) { - fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); } } + fprintf(f, "\n - docu :: "); + if (value->docstring) + fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", + Memory::get_c_str(value->docstring)); + else + fprintf(f, "none\n"); } - fprintf(f, "\n - docu :: "); - if (value->docstring) - fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", - Memory::get_c_str(value->docstring)); - else - fprintf(f, "none\n"); } - } - for (int i = 0; i < env->parents.next_index; ++i) { - try_void rec(rec, env->parents.data[i], prefix); - } - }; + for (int i = 0; i < env->parents.next_index; ++i) { + try_void rec(rec, env->parents.data[i], prefix); + } + }; - print_this_env(print_this_env, get_current_environment(), (char*)""); + print_this_env(print_this_env, get_current_environment(), (char*)""); + } } diff --git a/src/env.cpp b/src/env.cpp index a70447b..bcfd1c1 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -1,126 +1,126 @@ namespace Slime { - proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { - profile_with_comment(&symbol->value.symbol->data); - Environment* env = get_current_environment(); - env->hm.set_object((void*)symbol, value); - } - - inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* { - return (Lisp_Object*)env->hm.get_object((void*)sym); - } - - proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool { - return lookup_symbol_in_this_envt(sym, env) != nullptr; - } - - proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* { - if (environment_binds_symbol(sym, env)) - return env; - for (auto it : env->parents) { - if (Environment* ret = find_binding_environment(sym, it)) - return ret; + proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { + profile_with_comment(&symbol->value.symbol->data); + Environment* env = get_current_environment(); + env->hm.set_object((void*)symbol, value); } - return nullptr; - } - - proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { - // first check current environment - - Lisp_Object* result; - result = lookup_symbol_in_this_envt(node, env); - if (result) - return result; - - for (int i = 0; i < env->parents.next_index; ++i) { - result = try_lookup_symbol(node, env->parents.data[i]); - - if (result) - return result; + + inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* { + return (Lisp_Object*)env->hm.get_object((void*)sym); + } + + proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool { + return lookup_symbol_in_this_envt(sym, env) != nullptr; } - auto nil_sym = Memory::get_symbol("nil"); - auto t_sym = Memory::get_symbol("t"); + proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* { + if (environment_binds_symbol(sym, env)) + return env; + for (auto it : env->parents) { + if (Environment* ret = find_binding_environment(sym, it)) + return ret; + } + return nullptr; + } + + proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { + // first check current environment + + Lisp_Object* result; + result = lookup_symbol_in_this_envt(node, env); + if (result) + return result; - if (node == nil_sym) { - return Memory::nil; + for (int i = 0; i < env->parents.next_index; ++i) { + result = try_lookup_symbol(node, env->parents.data[i]); + + if (result) + return result; + } + + auto nil_sym = Memory::get_symbol("nil"); + auto t_sym = Memory::get_symbol("t"); + + if (node == nil_sym) { + return Memory::nil; + } + if (node == t_sym) { + return Memory::t; + } + + return nullptr; } - if (node == t_sym) { - return Memory::t; + + inline proc push_environment(Environment* env) -> void { + using namespace Globals::Current_Execution; + envi_stack.append(env); } - return nullptr; - } - - inline proc push_environment(Environment* env) -> void { - using namespace Globals::Current_Execution; - envi_stack.append(env); - } - - inline proc pop_environment() -> void { - using namespace Globals::Current_Execution; - --envi_stack.next_index; - } - - inline proc get_root_environment() -> Environment* { - using namespace Globals::Current_Execution; - return envi_stack.data[0]; - } - - inline proc get_current_environment() -> Environment* { - using namespace Globals::Current_Execution; - return envi_stack.data[envi_stack.next_index-1]; - } - - proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { - profile_with_comment(&node->value.symbol->data); - // print(node); - assert_type(node, Lisp_Object_Type::Symbol); - - Lisp_Object* result = try_lookup_symbol(node, env); - - if (result) - return result; - - String* identifier = node->value.symbol; - print_environment(env); - printf("\n"); - create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); - return nullptr; - } - - - proc print_environment_indent(Environment* env, int indent) -> void { - proc print_indent = [](int indent) { - for (int i = 0; i < indent; ++i) { - printf(" "); - } - }; - - // if(env == get_root_environment()) { - // print_indent(indent); - // printf("[built-ins]-Environment (%lld)\n", (long long)env); - // return; - // } - - for_hash_map (env->hm) { - print_indent(indent); - printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data)); - print((Lisp_Object*)value); - printf(" (0x%016llx)", (unsigned long long)value); - puts(""); + inline proc pop_environment() -> void { + using namespace Globals::Current_Execution; + --envi_stack.next_index; } - for (int i = 0; i < env->parents.next_index; ++i) { - print_indent(indent); - printf("parent (0x%016llx)", (long long)env->parents.data[i]); - puts(":"); - print_environment_indent(env->parents.data[i], indent+4); + + inline proc get_root_environment() -> Environment* { + using namespace Globals::Current_Execution; + return envi_stack.data[0]; } - } - proc print_environment(Environment* env) -> void { - printf("\n=== Environment === (0x%016llx)\n", (long long)env); - print_environment_indent(env, 0); - } + inline proc get_current_environment() -> Environment* { + using namespace Globals::Current_Execution; + return envi_stack.data[envi_stack.next_index-1]; + } + + proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { + profile_with_comment(&node->value.symbol->data); + // print(node); + assert_type(node, Lisp_Object_Type::Symbol); + + Lisp_Object* result = try_lookup_symbol(node, env); + + if (result) + return result; + + String* identifier = node->value.symbol; + print_environment(env); + printf("\n"); + create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); + return nullptr; + } + + + proc print_environment_indent(Environment* env, int indent) -> void { + proc print_indent = [](int indent) { + for (int i = 0; i < indent; ++i) { + printf(" "); + } + }; + + if(env == get_root_environment()) { + print_indent(indent); + printf("[built-ins]-Environment (%lld)\n", (long long)env); + return; + } + + for_hash_map (env->hm) { + print_indent(indent); + printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data)); + print((Lisp_Object*)value); + printf(" (0x%016llx)", (unsigned long long)value); + puts(""); + } + for (int i = 0; i < env->parents.next_index; ++i) { + print_indent(indent); + 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 === (0x%016llx)\n", (long long)env); + print_environment_indent(env, 0); + } } diff --git a/src/error.cpp b/src/error.cpp index 015ad06..da73efa 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -1,54 +1,57 @@ -proc delete_error() -> void { - using Globals::error; +namespace Slime { - free(error); - error = nullptr; -} - -proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void { - delete_error(); - if (Globals::breaking_on_errors) { - debug_break(); - } + proc delete_error() -> void { + using Globals::error; - using Globals::error; - error = (Error*)malloc(sizeof(Error)) ; - error->type = type; - error->message = message; - - log_error(); - if (Globals::log_level > Log_Level::None) { - // c error location - printf("in"); - int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line)); - if (spacing < 1) spacing = 1; - for (int i = 0; i < spacing; ++i) - printf(" "); - printf("%s (%d) ", c_file_name, c_file_line); - printf("-> %s\n", c_func_name); + free(error); + error = nullptr; } - // visualize_lisp_machine(); -} + proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void { + delete_error(); + if (Globals::breaking_on_errors) { + debug_break(); + } -proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { - using Globals::error; - - int length = 200; - String* formatted_string = Memory::create_string("", length); - if (error) { - error = new(Error); + using Globals::error; + error = (Error*)malloc(sizeof(Error)) ; error->type = type; + error->message = message; + + log_error(); + if (Globals::log_level > Log_Level::None) { + // c error location + printf("in"); + int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line)); + if (spacing < 1) spacing = 1; + for (int i = 0; i < spacing; ++i) + printf(" "); + printf("%s (%d) ", c_file_name, c_file_line); + printf("-> %s\n", c_func_name); + } + + // visualize_lisp_machine(); + } + + proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { + using Globals::error; + + int length = 200; + String* formatted_string = Memory::create_string("", length); + if (error) { + error = new(Error); + error->type = type; + } + int written_length; + va_list args; + char* out_msg; + va_start(args, format); + written_length = vasprintf(&out_msg, format, args); + va_end(args); + + formatted_string->length = written_length; + strcpy(&formatted_string->data, out_msg); + free(out_msg); + create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); } - int written_length; - va_list args; - char* out_msg; - va_start(args, format); - written_length = vasprintf(&out_msg, format, args); - va_end(args); - - formatted_string->length = written_length; - strcpy(&formatted_string->data, out_msg); - free(out_msg); - create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); } diff --git a/src/eval.cpp b/src/eval.cpp index 3dad835..1343e51 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -1,116 +1,99 @@ -proc create_extended_environment_for_function_application( - Lisp_Object* unevaluated_arguments, - Lisp_Object* function, - bool should_evaluate) -> Environment* -{ - profile_this(); - bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; - Environment* new_env; - Lisp_Object* arguments = unevaluated_arguments; - Arguments* arg_spec; - - // NOTE(Felix): Step 1. - // - setting the parent environment - // - setting the arg_spec - // - potentially evaluating the arguments - if (is_c_function) { - new_env = Memory::create_child_environment(get_root_environment()); - arg_spec = &function->value.cFunction->args; - } else { - new_env = Memory::create_child_environment(function->value.function->parent_environment); - arg_spec = &function->value.function->args; - } - if (should_evaluate) { - try arguments = eval_arguments(arguments); - } - - // NOTE(Felix): Even though we will return the environment at the - // end, for defining symbols here for the parameters, it has to be - // on the envi stack. - push_environment(new_env); - defer { - pop_environment(); - }; - +namespace Slime { + proc create_extended_environment_for_function_application( + Lisp_Object* unevaluated_arguments, + Lisp_Object* function, + bool should_evaluate) -> Environment* + { + profile_this(); + bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; + Environment* new_env; + Lisp_Object* arguments = unevaluated_arguments; + Arguments* arg_spec; + + // NOTE(Felix): Step 1. + // - setting the parent environment + // - setting the arg_spec + // - potentially evaluating the arguments + if (is_c_function) { + new_env = Memory::create_child_environment(get_root_environment()); + arg_spec = &function->value.cFunction->args; + } else { + new_env = Memory::create_child_environment(function->value.function->parent_environment); + arg_spec = &function->value.function->args; + } + if (should_evaluate) { + try arguments = eval_arguments(arguments); + } - // NOTE(Felix): Step 2. - // Reading the argument spec and fill in the environment - // for the function call + // NOTE(Felix): Even though we will return the environment at the + // end, for defining symbols here for the parameters, it has to be + // on the envi stack. + push_environment(new_env); + defer { + pop_environment(); + }; - Lisp_Object* sym, *val; // used as temp storage to use `try` - Array_List read_in_keywords; - int obligatory_keywords_count = 0; - int read_obligatory_keywords_count = 0; - proc read_positional_args = [&]() -> void { - for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { - if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { - create_parsing_error("Wrong number of arguments."); - return; - } - // NOTE(Felix): We have to copy all the arguments, - // otherwise we change the program code. XXX(Felix): T C - // functions we pass by reference... - sym = arg_spec->positional.symbols.data[i]; - if (is_c_function) { - define_symbol(sym, arguments->value.pair.first); - } else { - define_symbol( - sym, - Memory::copy_lisp_object_except_pairs(arguments->value.pair.first)); - } + // NOTE(Felix): Step 2. + // Reading the argument spec and fill in the environment + // for the function call - arguments = arguments->value.pair.rest; - } - }; + Lisp_Object* sym, *val; // used as temp storage to use `try` + Array_List read_in_keywords; + int obligatory_keywords_count = 0; + int read_obligatory_keywords_count = 0; - proc read_keyword_args = [&]() -> void { - // keyword arguments: use all given ones and keep track of the - // added ones (array list), if end of parameters in encountered or - // something that is not a keyword is encountered or a keyword - // that is not recognized is encoutered, jump out of the loop. + proc read_positional_args = [&]() -> void { + for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { + create_parsing_error("Wrong number of arguments."); + return; + } + // NOTE(Felix): We have to copy all the arguments, + // otherwise we change the program code. XXX(Felix): T C + // functions we pass by reference... + sym = arg_spec->positional.symbols.data[i]; + if (is_c_function) { + define_symbol(sym, arguments->value.pair.first); + } else { + define_symbol( + sym, + Memory::copy_lisp_object_except_pairs(arguments->value.pair.first)); + } - if (arguments == Memory::nil) - return; + arguments = arguments->value.pair.rest; + } + }; - // find out how many keyword args we /have/ to read - for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { - if (arg_spec->keyword.values.data[i] == nullptr) - ++obligatory_keywords_count; - else - break; - } + proc read_keyword_args = [&]() -> void { + // keyword arguments: use all given ones and keep track of the + // added ones (array list), if end of parameters in encountered or + // something that is not a keyword is encountered or a keyword + // that is not recognized is encoutered, jump out of the loop. + if (arguments == Memory::nil) + return; - while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { - // check if this one is even an accepted keyword - bool accepted = false; + // find out how many keyword args we /have/ to read for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { - if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i]) - { - accepted = true; + if (arg_spec->keyword.values.data[i] == nullptr) + ++obligatory_keywords_count; + else break; - } - } - if (!accepted) { - // NOTE(Felix): if we are actually done with all the - // necessary keywords then we have to count the rest - // as :rest here, instead od always creating an error - // (special case with default variables) - if (read_obligatory_keywords_count == obligatory_keywords_count) - return; - create_generic_error( - "The function does not take the keyword argument ':%s'\n" - "and not all required keyword arguments have been read\n" - "in to potentially count it as the rest argument.", - &(arguments->value.pair.first->value.symbol->data)); - return; } - // check if it was already read in - for (int i = 0; i < read_in_keywords.next_index; ++i) { - if (arguments->value.pair.first == read_in_keywords.data[i]) - { + + while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { + // check if this one is even an accepted keyword + bool accepted = false; + for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { + if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i]) + { + accepted = true; + break; + } + } + if (!accepted) { // NOTE(Felix): if we are actually done with all the // necessary keywords then we have to count the rest // as :rest here, instead od always creating an error @@ -118,132 +101,150 @@ proc create_extended_environment_for_function_application( if (read_obligatory_keywords_count == obligatory_keywords_count) return; create_generic_error( - "The function already read the keyword argument ':%s'", + "The function does not take the keyword argument ':%s'\n" + "and not all required keyword arguments have been read\n" + "in to potentially count it as the rest argument.", &(arguments->value.pair.first->value.symbol->data)); return; } - } - // okay so we found a keyword that has to be read in and was - // not already read in, is there a next element to actually - // set it to? - if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { - create_generic_error( - "Attempting to set the keyword argument ':%s', but no value was supplied.", - &(arguments->value.pair.first->value.symbol->data)); - return; - } + // check if it was already read in + for (int i = 0; i < read_in_keywords.next_index; ++i) { + if (arguments->value.pair.first == read_in_keywords.data[i]) + { + // NOTE(Felix): if we are actually done with all the + // necessary keywords then we have to count the rest + // as :rest here, instead od always creating an error + // (special case with default variables) + if (read_obligatory_keywords_count == obligatory_keywords_count) + return; + create_generic_error( + "The function already read the keyword argument ':%s'", + &(arguments->value.pair.first->value.symbol->data)); + return; + } + } - // if not set it and then add it to the array list - try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol); - // NOTE(Felix): It seems we do not need to evaluate the argument here... - if (is_c_function) { - try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); - } else { - try_void define_symbol( - sym, - Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); - } + // okay so we found a keyword that has to be read in and was + // not already read in, is there a next element to actually + // set it to? + if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { + create_generic_error( + "Attempting to set the keyword argument ':%s', but no value was supplied.", + &(arguments->value.pair.first->value.symbol->data)); + return; + } - read_in_keywords.append(arguments->value.pair.first); - ++read_obligatory_keywords_count; + // if not set it and then add it to the array list + try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol); + // NOTE(Felix): It seems we do not need to evaluate the argument here... + if (is_c_function) { + try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); + } else { + try_void define_symbol( + sym, + Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); + } - // overstep both for next one - arguments = arguments->value.pair.rest->value.pair.rest; + read_in_keywords.append(arguments->value.pair.first); + ++read_obligatory_keywords_count; - if (arguments == Memory::nil) { - break; - } - } - }; - - proc check_keyword_args = [&]() -> void { - // check if all necessary keywords have been read in - for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { - auto defined_keyword = arg_spec->keyword.keywords.data[i]; - bool was_set = false; - for (int j = 0; j < read_in_keywords.next_index; ++j) { - if (read_in_keywords.data[j] == defined_keyword) { - was_set = true; + // overstep both for next one + arguments = arguments->value.pair.rest->value.pair.rest; + + if (arguments == Memory::nil) { break; } } - if (arg_spec->keyword.values.data[i] == nullptr) { - // if this one does not have a default value - if (!was_set) { - create_generic_error( - "There was no value supplied for the required " - "keyword argument ':%s'.", - &defined_keyword->value.symbol->data); - return; + }; + + proc check_keyword_args = [&]() -> void { + // check if all necessary keywords have been read in + for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { + auto defined_keyword = arg_spec->keyword.keywords.data[i]; + bool was_set = false; + for (int j = 0; j < read_in_keywords.next_index; ++j) { + if (read_in_keywords.data[j] == defined_keyword) { + was_set = true; + break; + } } - } else { - // this one does have a default value, lets see if we have - // to use it or if the user supplied his own - if (!was_set) { - try_void sym = Memory::get_symbol(defined_keyword->value.symbol); - if (is_c_function) { - try_void val = arg_spec->keyword.values.data[i]; - } else { - try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]); + if (arg_spec->keyword.values.data[i] == nullptr) { + // if this one does not have a default value + if (!was_set) { + create_generic_error( + "There was no value supplied for the required " + "keyword argument ':%s'.", + &defined_keyword->value.symbol->data); + return; + } + } else { + // this one does have a default value, lets see if we have + // to use it or if the user supplied his own + if (!was_set) { + try_void sym = Memory::get_symbol(defined_keyword->value.symbol); + if (is_c_function) { + try_void val = arg_spec->keyword.values.data[i]; + } else { + try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]); + } + define_symbol(sym, val); } - define_symbol(sym, val); } } - } - }; + }; - proc read_rest_arg = [&]() -> void { - if (arguments == Memory::nil) { - if (arg_spec->rest) { - define_symbol(arg_spec->rest, Memory::nil); - } - } else { - if (arg_spec->rest) { - define_symbol( - arg_spec->rest, - // NOTE(Felix): arguments will be a list, and I THINK - // we do not need to copy it... - arguments); + proc read_rest_arg = [&]() -> void { + if (arguments == Memory::nil) { + if (arg_spec->rest) { + define_symbol(arg_spec->rest, Memory::nil); + } } else { - // rest was not declared but additional arguments were found - create_generic_error( - "A rest argument was not declared " - "but the function was called with additional arguments."); - return; + if (arg_spec->rest) { + define_symbol( + arg_spec->rest, + // NOTE(Felix): arguments will be a list, and I THINK + // we do not need to copy it... + arguments); + } else { + // rest was not declared but additional arguments were found + create_generic_error( + "A rest argument was not declared " + "but the function was called with additional arguments."); + return; + } } - } - }; + }; - try read_positional_args(); - try read_keyword_args(); - try check_keyword_args(); - try read_rest_arg(); + try read_positional_args(); + try read_keyword_args(); + try check_keyword_args(); + try read_rest_arg(); - return new_env; -} + return new_env; + } -proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { - profile_this(); - Environment* new_env; - Lisp_Object* result; + proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { + profile_this(); + Environment* new_env; + Lisp_Object* result; - try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args); - push_environment(new_env); - defer { - pop_environment(); - }; + try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args); + push_environment(new_env); + defer { + pop_environment(); + }; - if (Memory::get_type(function) == Lisp_Object_Type::CFunction) - // if c function: - try result = function->value.cFunction->body(); - else - // if lisp function - try result = eval_expr(function->value.function->body); + if (Memory::get_type(function) == Lisp_Object_Type::CFunction) + // if c function: + try result = function->value.cFunction->body(); + else + // if lisp function + try result = eval_expr(function->value.function->body); - return result; -} + return result; + } /** This parses the argument specification of funcitons into their @@ -251,272 +252,273 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, positional_arguments, keyword_arguments and rest_argument and filling it in */ -proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { - Arguments* result; - if (Memory::get_type(function) == Lisp_Object_Type::CFunction) { - result = &function->value.cFunction->args; - } else { - result = &function->value.function->args; - } + proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { + Arguments* result; + if (Memory::get_type(function) == Lisp_Object_Type::CFunction) { + result = &function->value.cFunction->args; + } else { + result = &function->value.function->args; + } - // first init the fields - result->rest = nullptr; + // first init the fields + result->rest = nullptr; - // okay let's try to read some positional arguments - while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { - // if we encounter a keyword or a list (for keywords with - // defualt args), the positionals are done - if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword || - Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) { + // okay let's try to read some positional arguments + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { + // if we encounter a keyword or a list (for keywords with + // defualt args), the positionals are done + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword || + Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) { break; - } + } - // if we encounter something that is neither a symbol nor a - // keyword arg, it's an error - if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) { - create_parsing_error("Only symbols and keywords " - "(with or without default args) " - "can be parsed here, but found '%s'", - Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first))); - return; - } + // if we encounter something that is neither a symbol nor a + // keyword arg, it's an error + if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) { + create_parsing_error("Only symbols and keywords " + "(with or without default args) " + "can be parsed here, but found '%s'", + Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first))); + return; + } - // okay we found an actual symbol - result->positional.symbols.append(arguments->value.pair.first); + // okay we found an actual symbol + result->positional.symbols.append(arguments->value.pair.first); - arguments = arguments->value.pair.rest; - } + arguments = arguments->value.pair.rest; + } - // if we reach here, we are on a keyword or a pair wher a keyword - // should be in first - while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { - if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { - // if we are on a actual keyword (with no default arg) - auto keyword = arguments->value.pair.first; - result->keyword.keywords.append(keyword); - result->keyword.values.append(nullptr); - } else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) { - // if we are on a keyword with a default value - - auto keyword = arguments->value.pair.first->value.pair.first; - if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) { - create_parsing_error("Default args must be keywords"); - } - if (Memory::get_type(arguments->value.pair.first->value.pair.rest) - != Lisp_Object_Type::Pair) - { - create_parsing_error("Default args must be a list of 2."); - } - auto value = arguments->value.pair.first->value.pair.rest->value.pair.first; - try_void value = eval_expr(value); - if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) { - create_parsing_error("Default args must be a list of 2."); + // if we reach here, we are on a keyword or a pair wher a keyword + // should be in first + while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { + if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { + // if we are on a actual keyword (with no default arg) + auto keyword = arguments->value.pair.first; + result->keyword.keywords.append(keyword); + result->keyword.values.append(nullptr); + } else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) { + // if we are on a keyword with a default value + + auto keyword = arguments->value.pair.first->value.pair.first; + if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) { + create_parsing_error("Default args must be keywords"); + } + if (Memory::get_type(arguments->value.pair.first->value.pair.rest) + != Lisp_Object_Type::Pair) + { + create_parsing_error("Default args must be a list of 2."); + } + auto value = arguments->value.pair.first->value.pair.rest->value.pair.first; + try_void value = eval_expr(value); + if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) { + create_parsing_error("Default args must be a list of 2."); + } + + result->keyword.keywords.append(keyword); + result->keyword.values.append(value); } + arguments = arguments->value.pair.rest; + } - result->keyword.keywords.append(keyword); - result->keyword.values.append(value); + // Now we are also done with keyword arguments, lets check for + // if there is a rest argument + if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { + if (arguments == Memory::nil) + return; + if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol) + result->rest = arguments; + else + create_parsing_error("The rest argument must be a symbol."); } - arguments = arguments->value.pair.rest; } - // Now we are also done with keyword arguments, lets check for - // if there is a rest argument - if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { - if (arguments == Memory::nil) - return; - if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol) - result->rest = arguments; - else - create_parsing_error("The rest argument must be a symbol."); - } -} + proc list_length(Lisp_Object* node) -> int { + if (node == Memory::nil) + return 0; -proc list_length(Lisp_Object* node) -> int { - if (node == Memory::nil) - return 0; + assert_type(node, Lisp_Object_Type::Pair); - assert_type(node, Lisp_Object_Type::Pair); + int len = 0; - int len = 0; + while (Memory::get_type(node) == Lisp_Object_Type::Pair) { + ++len; + node = node->value.pair.rest; + if (node == Memory::nil) + return len; + } - while (Memory::get_type(node) == Lisp_Object_Type::Pair) { - ++len; - node = node->value.pair.rest; - if (node == Memory::nil) - return len; + create_parsing_error("Can't calculate length of ill formed list."); + return 0; } - create_parsing_error("Can't calculate length of ill formed list."); - return 0; -} - -proc copy_scl(Source_Code_Location*) -> Source_Code_Location* { - // TODO(Felix): - return nullptr; -} - -proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* { - profile_this(); - // int my_out_arguments_length = 0; - if (arguments == Memory::nil) { - // *(out_arguments_length) = 0; - return arguments; + proc copy_scl(Source_Code_Location*) -> Source_Code_Location* { + // TODO(Felix): + return nullptr; } - Lisp_Object* evaluated_arguments; - try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* { + profile_this(); + // int my_out_arguments_length = 0; + if (arguments == Memory::nil) { + // *(out_arguments_length) = 0; + return arguments; + } - Lisp_Object* evaluated_arguments_head = evaluated_arguments; - Lisp_Object* current_head = arguments; + Lisp_Object* evaluated_arguments; + try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { - try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first); + Lisp_Object* evaluated_arguments_head = evaluated_arguments; + Lisp_Object* current_head = arguments; - evaluated_arguments_head->value.pair.first->sourceCodeLocation = - copy_scl(current_head->value.pair.first->sourceCodeLocation); - current_head = current_head->value.pair.rest; + while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { + try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first); - if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { - try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); - evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; - } else if (current_head == Memory::nil) { - evaluated_arguments_head->value.pair.rest = current_head; - } else { - create_parsing_error("Attempting to evaluate ill formed argument list."); - return nullptr; + evaluated_arguments_head->value.pair.first->sourceCodeLocation = + copy_scl(current_head->value.pair.first->sourceCodeLocation); + current_head = current_head->value.pair.rest; + + if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { + try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); + evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; + } else if (current_head == Memory::nil) { + evaluated_arguments_head->value.pair.rest = current_head; + } else { + create_parsing_error("Attempting to evaluate ill formed argument list."); + return nullptr; + } + // ++my_out_arguments_length; } - // ++my_out_arguments_length; + // *(out_arguments_length) = my_out_arguments_length; + return evaluated_arguments; } - // *(out_arguments_length) = my_out_arguments_length; - return evaluated_arguments; -} -proc eval_expr(Lisp_Object* node) -> Lisp_Object* { - profile_this(); - - using namespace Globals::Current_Execution; - call_stack.append(node); - defer { - --call_stack.next_index; - }; - - switch (Memory::get_type(node)) { - case Lisp_Object_Type::T: - case Lisp_Object_Type::Nil: - case Lisp_Object_Type::Number: - case Lisp_Object_Type::Keyword: - case Lisp_Object_Type::String: - case Lisp_Object_Type::Function: - case Lisp_Object_Type::CFunction: - return node; - case Lisp_Object_Type::Symbol: { - Lisp_Object* value; - try value = lookup_symbol(node, get_current_environment()); - return value; - } - case Lisp_Object_Type::Pair: { - Lisp_Object* lispOperator; - if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && - Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) - { - try lispOperator = eval_expr(node->value.pair.first); - } else { - lispOperator = node->value.pair.first; + proc eval_expr(Lisp_Object* node) -> Lisp_Object* { + profile_this(); + + using namespace Globals::Current_Execution; + call_stack.append(node); + defer { + --call_stack.next_index; + }; + + switch (Memory::get_type(node)) { + case Lisp_Object_Type::T: + case Lisp_Object_Type::Nil: + case Lisp_Object_Type::Number: + case Lisp_Object_Type::Keyword: + case Lisp_Object_Type::String: + case Lisp_Object_Type::Function: + case Lisp_Object_Type::CFunction: + return node; + case Lisp_Object_Type::Symbol: { + Lisp_Object* value; + try value = lookup_symbol(node, get_current_environment()); + return value; } + case Lisp_Object_Type::Pair: { + Lisp_Object* lispOperator; + if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && + Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) + { + try lispOperator = eval_expr(node->value.pair.first); + } else { + lispOperator = node->value.pair.first; + } - Lisp_Object* arguments = node->value.pair.rest; - // check for c function - if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { - Lisp_Object* result; - try result = apply_arguments_to_function( - arguments, - lispOperator, - !lispOperator->value.cFunction->is_special_form); - return result; - } + Lisp_Object* arguments = node->value.pair.rest; + // check for c function + if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { + Lisp_Object* result; + try result = apply_arguments_to_function( + arguments, + lispOperator, + !lispOperator->value.cFunction->is_special_form); + return result; + } + + // check for lisp function + if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { + // only for lambdas we evaluate the arguments before + // apllying, for the other types, special-lambda and macro + // we do not need. + + Lisp_Object* result; + try result = apply_arguments_to_function( + arguments, + lispOperator, + lispOperator->value.function->type == Function_Type::Lambda); + + // NOTE(Felix): The parser does not understnad (import ..) + // so it cannot expand imported macros at read time + // (because at read time, they are not imported yet, this + // is done at runtime...). That is why we sometimes have + // stray macros fying around, in that case, we expand them + // and bake them in, so they do not have to be expanded + // later again. We will call this "lazy macro expansion" + if (lispOperator->value.function->type == Function_Type::Macro) { + // bake in the macro expansion: + *node = *Memory::copy_lisp_object(result); + result->sourceCodeLocation = copy_scl(result->sourceCodeLocation); + // eval again because macro + try result = eval_expr(result); + } - // check for lisp function - if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { - // only for lambdas we evaluate the arguments before - // apllying, for the other types, special-lambda and macro - // we do not need. - - Lisp_Object* result; - try result = apply_arguments_to_function( - arguments, - lispOperator, - lispOperator->value.function->type == Function_Type::Lambda); - - // NOTE(Felix): The parser does not understnad (import ..) - // so it cannot expand imported macros at read time - // (because at read time, they are not imported yet, this - // is done at runtime...). That is why we sometimes have - // stray macros fying around, in that case, we expand them - // and bake them in, so they do not have to be expanded - // later again. We will call this "lazy macro expansion" - if (lispOperator->value.function->type == Function_Type::Macro) { - // bake in the macro expansion: - *node = *Memory::copy_lisp_object(result); - result->sourceCodeLocation = copy_scl(result->sourceCodeLocation); - // eval again because macro - try result = eval_expr(result); + return result; } - return result; + create_generic_error("The first element of the pair was not a function but: %s", + Lisp_Object_Type_to_string(Memory::get_type(lispOperator))); + return nullptr; + } + default: { + create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); + return nullptr; } - create_generic_error("The first element of the pair was not a function but: %s", - Lisp_Object_Type_to_string(Memory::get_type(lispOperator))); - return nullptr; - } - default: { - create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); - return nullptr; + } } - } -} + proc is_truthy(Lisp_Object* expression) -> bool { + Lisp_Object* result; + try result = eval_expr(expression); -proc is_truthy(Lisp_Object* expression) -> bool { - Lisp_Object* result; - try result = eval_expr(expression); - - return result != Memory::nil; -} + return result != Memory::nil; + } -proc interprete_file (char* file_name) -> Lisp_Object* { - try Memory::init(4096 * 256); + proc interprete_file (char* file_name) -> Lisp_Object* { + try Memory::init(4096 * 256); - Lisp_Object* result; + Lisp_Object* result; - try result = built_in_load(Memory::create_string(file_name)); + try result = built_in_load(Memory::create_string(file_name)); - return result; -} + return result; + } -proc interprete_stdin() -> void { - try_void Memory::init(4096 * 256* 100); - - printf("Welcome to the lispy interpreter.\n"); - - char* line; - - Lisp_Object* parsed, * evaluated; - while (true) { - [&] { - delete_error(); - fputs("> ", stdout); - line = read_expression(); - defer { - free(line); - }; - try_void parsed = Parser::parse_single_expression(line); - try_void evaluated = eval_expr(parsed); - if (evaluated != Memory::nil) { - print(evaluated); - fputs("\n", stdout); - } - }(); + proc interprete_stdin() -> void { + try_void Memory::init(4096 * 256* 100); + + printf("Welcome to the lispy interpreter.\n"); + + char* line; + + Lisp_Object* parsed, * evaluated; + while (true) { + [&] { + delete_error(); + fputs("> ", stdout); + line = read_expression(); + defer { + free(line); + }; + try_void parsed = Parser::parse_single_expression(line); + try_void evaluated = eval_expr(parsed); + if (evaluated != Memory::nil) { + print(evaluated); + fputs("\n", stdout); + } + }(); + } } } diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index cb28885..a5816ec 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -1,83 +1,85 @@ -void add_to_load_path(const char*); -bool lisp_object_equal(Lisp_Object*,Lisp_Object*); -Lisp_Object* built_in_load(String*); -Lisp_Object* built_in_import(String*); -void delete_error(); -void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); -void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message); -void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); -Lisp_Object* eval_arguments(Lisp_Object*); -Lisp_Object* eval_expr(Lisp_Object*); -bool is_truthy (Lisp_Object*); -int list_length(Lisp_Object*); -void* load_built_ins_into_environment(); -void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); +namespace Slime { + void add_to_load_path(const char*); + bool lisp_object_equal(Lisp_Object*,Lisp_Object*); + Lisp_Object* built_in_load(String*); + Lisp_Object* built_in_import(String*); + void delete_error(); + void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); + void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message); + void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); + Lisp_Object* eval_arguments(Lisp_Object*); + Lisp_Object* eval_expr(Lisp_Object*); + bool is_truthy (Lisp_Object*); + int list_length(Lisp_Object*); + void* load_built_ins_into_environment(); + void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); -Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); -void define_symbol(Lisp_Object* symbol, Lisp_Object* value); -void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); -void print_environment(Environment*); + Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); + void define_symbol(Lisp_Object* symbol, Lisp_Object* value); + void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); + void print_environment(Environment*); -bool run_all_tests(); + bool run_all_tests(); -inline Environment* get_root_environment(); -inline Environment* get_current_environment(); -inline void push_environment(Environment*); -inline void pop_environment(); + inline Environment* get_root_environment(); + inline Environment* get_current_environment(); + inline void push_environment(Environment*); + inline void pop_environment(); -const char* Lisp_Object_Type_to_string(Lisp_Object_Type type); + const char* Lisp_Object_Type_to_string(Lisp_Object_Type type); -void visualize_lisp_machine(); -void generate_docs(String* path); -void log_error(); + void visualize_lisp_machine(); + void generate_docs(String* path); + void log_error(); -namespace Memory { - Environment* create_built_ins_environment(); - Lisp_Object* create_lisp_object_cfunction(bool is_special); - inline Lisp_Object_Type get_type(Lisp_Object* node); - void init(int); - char* get_c_str(String*); - void free_everything(); - String* create_string(const char*); - Lisp_Object* get_symbol(String* identifier); - Lisp_Object* get_symbol(const char*); - Lisp_Object* get_keyword(String* identifier); - Lisp_Object* get_keyword(const char*); - Lisp_Object* create_lisp_object(double); - Lisp_Object* create_lisp_object(const char*); - Lisp_Object* create_lisp_object_vector(Lisp_Object*); - Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); - Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*); - Lisp_Object* create_lisp_object_vector(int, Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); - inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); -} + namespace Memory { + Environment* create_built_ins_environment(); + Lisp_Object* create_lisp_object_cfunction(bool is_special); + inline Lisp_Object_Type get_type(Lisp_Object* node); + void init(int); + char* get_c_str(String*); + void free_everything(); + String* create_string(const char*); + Lisp_Object* get_symbol(String* identifier); + Lisp_Object* get_symbol(const char*); + Lisp_Object* get_keyword(String* identifier); + Lisp_Object* get_keyword(const char*); + Lisp_Object* create_lisp_object(double); + Lisp_Object* create_lisp_object(const char*); + Lisp_Object* create_lisp_object_vector(Lisp_Object*); + Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); + Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*); + Lisp_Object* create_lisp_object_vector(int, Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); + inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); + } -namespace Parser { - // extern Environment* environment_for_macros; + namespace Parser { + // extern Environment* environment_for_macros; - extern String* standard_in; - extern String* parser_file; - extern int parser_line; - extern int parser_col; + extern String* standard_in; + extern String* parser_file; + extern int parser_line; + extern int parser_col; - Lisp_Object* parse_expression(char* text, int* index_in_text); - Lisp_Object* parse_single_expression(char* text); - Lisp_Object* parse_single_expression(wchar_t* text); -} + Lisp_Object* parse_expression(char* text, int* index_in_text); + Lisp_Object* parse_single_expression(char* text); + Lisp_Object* parse_single_expression(wchar_t* text); + } -namespace Globals { - extern char* bin_path; - extern Log_Level log_level; - extern Array_List load_path; - namespace Current_Execution { - extern Array_List call_stack; - extern Array_List envi_stack; + namespace Globals { + extern char* bin_path; + extern Log_Level log_level; + extern Array_List load_path; + namespace Current_Execution { + extern Array_List call_stack; + extern Array_List envi_stack; + } + extern Error* error; + extern bool breaking_on_errors; } - extern Error* error; - extern bool breaking_on_errors; } diff --git a/src/gc.cpp b/src/gc.cpp index 5a892de..2b78417 100644 --- a/src/gc.cpp +++ b/src/gc.cpp @@ -1,4 +1,4 @@ -namespace GC { +namespace Slime::GC { proc maybe_mark(Environment* env) -> void; int current_mark; diff --git a/src/globals.cpp b/src/globals.cpp index f1e3e35..f652db8 100644 --- a/src/globals.cpp +++ b/src/globals.cpp @@ -1,4 +1,4 @@ -namespace Globals { +namespace Slime::Globals { char* bin_path = nullptr; Log_Level log_level = Log_Level::Debug; diff --git a/src/io.cpp b/src/io.cpp index 3e1d30a..ca5ef6f 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -1,460 +1,462 @@ -proc string_equal(const char input[], const char check[]) -> bool { - if (input == check) return true; +namespace Slime { + proc string_equal(const char input[], const char check[]) -> bool { + if (input == check) return true; - for(int i = 0; input[i] == check[i]; i++) { - if (input[i] == '\0') - return true; - } + for(int i = 0; input[i] == check[i]; i++) { + if (input[i] == '\0') + return true; + } - return false; -} + return false; + } -proc string_equal(String* str, const char check[]) -> bool { - return string_equal(Memory::get_c_str(str), check); -} + proc string_equal(String* str, const char check[]) -> bool { + return string_equal(Memory::get_c_str(str), check); + } -proc string_equal(const char check[], String* str) -> bool { - return string_equal(Memory::get_c_str(str), check); -} + proc string_equal(const char check[], String* str) -> bool { + return string_equal(Memory::get_c_str(str), check); + } -proc string_equal(String* str1, String* str2) -> bool { - if (str1 == str2) - return true; + proc string_equal(String* str1, String* str2) -> bool { + if (str1 == str2) + return true; - return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2)); -} + return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2)); + } -proc get_nibble(char c) -> char { - if (c >= 'A' && c <= 'F') - return (c - 'A') + 10; - else if (c >= 'a' && c <= 'f') - return (c - 'a') + 10; - return (c - '0'); -} + proc get_nibble(char c) -> char { + if (c >= 'A' && c <= 'F') + return (c - 'A') + 10; + else if (c >= 'a' && c <= 'f') + return (c - 'a') + 10; + return (c - '0'); + } -proc escape_string(char* in) -> char* { - // TODO(Felix): add more escape sequences - int i = 0, count = 0; - while (in[i] != '\0') { - switch (in[i]) { - case '\\': - case '\n': - case '\t': - ++count; - default: break; + proc escape_string(char* in) -> char* { + // TODO(Felix): add more escape sequences + int i = 0, count = 0; + while (in[i] != '\0') { + switch (in[i]) { + case '\\': + case '\n': + case '\t': + ++count; + default: break; + } + ++i; } - ++i; - } - char* ret = (char*)malloc((i+count+1)*sizeof(char)); - - // copy in - i = 0; - int j = 0; - while (in[i] != '\0') { - switch (in[i]) { - case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break; - case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break; - case '\t': ret[j++] = '\\'; ret[j++] = 't'; break; - default: ret[j++] = in[i]; + char* ret = (char*)malloc((i+count+1)*sizeof(char)); + + // copy in + i = 0; + int j = 0; + while (in[i] != '\0') { + switch (in[i]) { + case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break; + case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break; + case '\t': ret[j++] = '\\'; ret[j++] = 't'; break; + default: ret[j++] = in[i]; + } + ++i; } - ++i; + ret[j++] = '\0'; + return ret; } - ret[j++] = '\0'; - return ret; -} -proc unescape_string(char* in) -> int { - if (!in) return 0; + proc unescape_string(char* in) -> int { + if (!in) return 0; - char *out = in, *p = in; - const char *int_err = nullptr; + char *out = in, *p = in; + const char *int_err = nullptr; - while (*p && !int_err) { - if (*p != '\\') { - /* normal case */ - *out++ = *p++; - } else { - /* escape sequence */ - switch (*++p) { - case '0': *out++ = '\a'; ++p; break; - case 'a': *out++ = '\a'; ++p; break; - case 'b': *out++ = '\b'; ++p; break; - case 'f': *out++ = '\f'; ++p; break; - case 'n': *out++ = '\n'; ++p; break; - case 'r': *out++ = '\r'; ++p; break; - case 't': *out++ = '\t'; ++p; break; - case 'v': *out++ = '\v'; ++p; break; - case '"': - case '\'': - case '\\': + while (*p && !int_err) { + if (*p != '\\') { + /* normal case */ *out++ = *p++; - case '?': - break; - case 'x': - case 'X': - if (!isxdigit(p[1]) || !isxdigit(p[2])) { + } else { + /* escape sequence */ + switch (*++p) { + case '0': *out++ = '\a'; ++p; break; + case 'a': *out++ = '\a'; ++p; break; + case 'b': *out++ = '\b'; ++p; break; + case 'f': *out++ = '\f'; ++p; break; + case 'n': *out++ = '\n'; ++p; break; + case 'r': *out++ = '\r'; ++p; break; + case 't': *out++ = '\t'; ++p; break; + case 'v': *out++ = '\v'; ++p; break; + case '"': + case '\'': + case '\\': + *out++ = *p++; + case '?': + break; + case 'x': + case 'X': + if (!isxdigit(p[1]) || !isxdigit(p[2])) { + create_parsing_error( + "The string '%s' at %s:%d:%d could not be unescaped. " + "(Invalid character on hexadecimal escape at char %d)", + in, Parser::parser_file, Parser::parser_line, Parser::parser_col, + (p+1)-in); + } else { + *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); + p += 3; + } + break; + default: create_parsing_error( "The string '%s' at %s:%d:%d could not be unescaped. " - "(Invalid character on hexadecimal escape at char %d)", + "(Unexpected '\\' with no escape sequence at char %d)", in, Parser::parser_file, Parser::parser_line, Parser::parser_col, (p+1)-in); - } else { - *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); - p += 3; } - break; - default: - create_parsing_error( - "The string '%s' at %s:%d:%d could not be unescaped. " - "(Unexpected '\\' with no escape sequence at char %d)", - in, Parser::parser_file, Parser::parser_line, Parser::parser_col, - (p+1)-in); } } - } - /* Set the end of string. */ - *out = '\0'; - return (int)(out - in); -} + /* Set the end of string. */ + *out = '\0'; + return (int)(out - in); + } -proc read_entire_file(char* filename) -> char* { - profile_with_comment(filename); - char *fileContent = nullptr; - FILE *fp = fopen(filename, "r"); - if (fp) { - /* Go to the end of the file. */ - if (fseek(fp, 0L, SEEK_END) == 0) { - /* Get the size of the file. */ - long bufsize = ftell(fp) + 1; - if (bufsize == 0) { - fputs("Empty file", stderr); - goto closeFile; - } + proc read_entire_file(char* filename) -> char* { + profile_with_comment(filename); + char *fileContent = nullptr; + FILE *fp = fopen(filename, "r"); + if (fp) { + /* Go to the end of the file. */ + if (fseek(fp, 0L, SEEK_END) == 0) { + /* Get the size of the file. */ + long bufsize = ftell(fp) + 1; + if (bufsize == 0) { + fputs("Empty file", stderr); + goto closeFile; + } - /* Go back to the start of the file. */ - if (fseek(fp, 0L, SEEK_SET) != 0) { - fputs("Error reading file", stderr); - goto closeFile; - } + /* Go back to the start of the file. */ + if (fseek(fp, 0L, SEEK_SET) != 0) { + fputs("Error reading file", stderr); + goto closeFile; + } - /* Allocate our buffer to that size. */ - fileContent = (char*)calloc(bufsize, sizeof(char)); + /* Allocate our buffer to that size. */ + fileContent = (char*)calloc(bufsize, sizeof(char)); - /* Read the entire file into memory. */ - size_t newLen = fread(fileContent, sizeof(char), bufsize, fp); + /* Read the entire file into memory. */ + size_t newLen = fread(fileContent, sizeof(char), bufsize, fp); - fileContent[newLen] = '\0'; - if (ferror(fp) != 0) { - fputs("Error reading file", stderr); + fileContent[newLen] = '\0'; + if (ferror(fp) != 0) { + fputs("Error reading file", stderr); + } } + closeFile: + fclose(fp); } - closeFile: - fclose(fp); - } - return fileContent; - /* Don't forget to call free() later! */ -} + return fileContent; + /* Don't forget to call free() later! */ + } -proc read_expression() -> char* { - char* line = (char*)malloc(100); + proc read_expression() -> char* { + char* line = (char*)malloc(100); - if(line == nullptr) - return nullptr; + if(line == nullptr) + return nullptr; - char* linep = line; - size_t lenmax = 100, len = lenmax; - int c; + char* linep = line; + size_t lenmax = 100, len = lenmax; + int c; - int nesting = 0; + int nesting = 0; - while (true) { - c = fgetc(stdin); - if(c == EOF) - break; + while (true) { + c = fgetc(stdin); + if(c == EOF) + break; - if(--len == 0) { - len = lenmax; - char * linen = (char*)realloc(linep, lenmax *= 2); + if(--len == 0) { + len = lenmax; + char * linen = (char*)realloc(linep, lenmax *= 2); - if(linen == nullptr) { - free(linep); - return nullptr; + if(linen == nullptr) { + free(linep); + return nullptr; + } + line = linen + (line - linep); + linep = linen; } - line = linen + (line - linep); - linep = linen; + + *line = (char)c; + if(*line == '(') + ++nesting; + else if(*line == ')') + --nesting; + else if(*line == '\n') + if (nesting == 0) + break; + line++; } + (*line)--; // we dont want the \n actually + *line = '\0'; - *line = (char)c; - if(*line == '(') - ++nesting; - else if(*line == ')') - --nesting; - else if(*line == '\n') - if (nesting == 0) - break; - line++; + return linep; } - (*line)--; // we dont want the \n actually - *line = '\0'; - return linep; -} + proc read_line() -> char* { + char* line = (char*)malloc(100), * linep = line; + size_t lenmax = 100, len = lenmax; + int c; -proc read_line() -> char* { - char* line = (char*)malloc(100), * linep = line; - size_t lenmax = 100, len = lenmax; - int c; + int nesting = 0; - int nesting = 0; + if(line == nullptr) + return nullptr; - if(line == nullptr) - return nullptr; - - for(;;) { - c = fgetc(stdin); - if(c == EOF) - break; + for(;;) { + c = fgetc(stdin); + if(c == EOF) + break; - if(--len == 0) { - len = lenmax; - char* linen = (char*)realloc(linep, lenmax *= 2); + if(--len == 0) { + len = lenmax; + char* linen = (char*)realloc(linep, lenmax *= 2); - if(linen == nullptr) { - free(linep); - return nullptr; + if(linen == nullptr) { + free(linep); + return nullptr; + } + line = linen + (line - linep); + linep = linen; } - line = linen + (line - linep); - linep = linen; + + *line = (char)c; + if(*line == '(') + ++nesting; + else if(*line == ')') + --nesting; + else if(*line == '\n') + if (nesting == 0) + break; + line++; } + (*line)--; // we dont want the \n actually + *line = '\0'; - *line = (char)c; - if(*line == '(') - ++nesting; - else if(*line == ')') - --nesting; - else if(*line == '\n') - if (nesting == 0) - break; - line++; + return linep; } - (*line)--; // we dont want the \n actually - *line = '\0'; - return linep; -} - -proc log_message(Log_Level type, const char* message) -> void { - if (type > Globals::log_level) - return; - - const char* prefix; - switch (type) { - case Log_Level::Critical: prefix = "CRITICAL"; break; - case Log_Level::Warning: prefix = "WARNING"; break; - case Log_Level::Info: prefix = "INFO"; break; - case Log_Level::Debug: prefix = "DEBUG"; break; - default: return; + proc log_message(Log_Level type, const char* message) -> void { + if (type > Globals::log_level) + return; + + const char* prefix; + switch (type) { + case Log_Level::Critical: prefix = "CRITICAL"; break; + case Log_Level::Warning: prefix = "WARNING"; break; + case Log_Level::Info: prefix = "INFO"; break; + case Log_Level::Debug: prefix = "DEBUG"; break; + default: return; + } + printf("%s: %s\n",prefix, message); } - printf("%s: %s\n",prefix, message); -} -char* wchar_to_char(const wchar_t* pwchar) { - // get the number of characters in the string. - int currentCharIndex = 0; - char currentChar = (char)pwchar[currentCharIndex]; + char* wchar_to_char(const wchar_t* pwchar) { + // get the number of characters in the string. + int currentCharIndex = 0; + char currentChar = (char)pwchar[currentCharIndex]; - while (currentChar != '\0') - { - currentCharIndex++; - currentChar = (char)pwchar[currentCharIndex]; - } + while (currentChar != '\0') + { + currentCharIndex++; + currentChar = (char)pwchar[currentCharIndex]; + } - const int charCount = currentCharIndex + 1; + const int charCount = currentCharIndex + 1; - // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes) - char* filePathC = (char*)malloc(sizeof(char) * charCount); + // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes) + char* filePathC = (char*)malloc(sizeof(char) * charCount); - for (int i = 0; i < charCount; i++) - { - // convert to char (1 byte) - char character = (char)pwchar[i]; + for (int i = 0; i < charCount; i++) + { + // convert to char (1 byte) + char character = (char)pwchar[i]; - *filePathC = character; + *filePathC = character; - filePathC += sizeof(char); + filePathC += sizeof(char); - } - filePathC += '\0'; + } + filePathC += '\0'; - filePathC -= (sizeof(char) * charCount); + filePathC -= (sizeof(char) * charCount); - return filePathC; -} + return filePathC; + } -const wchar_t* char_to_wchar(const char* c) { - const size_t cSize = strlen(c)+1; - wchar_t* wc = new wchar_t[cSize]; - mbstowcs (wc, c, cSize); + const wchar_t* char_to_wchar(const char* c) { + const size_t cSize = strlen(c)+1; + wchar_t* wc = new wchar_t[cSize]; + mbstowcs (wc, c, cSize); - return wc; -} -proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { - switch (Memory::get_type(node)) { - case (Lisp_Object_Type::Nil): fputs("()", file); break; - case (Lisp_Object_Type::T): fputs("t", file); break; - case (Lisp_Object_Type::Number): { - if (abs(node->value.number - (int)node->value.number) < 0.000001f) - fprintf(file, "%d", (int)node->value.number); - else - fprintf(file, "%f", node->value.number); - } break; - 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)); break; - case (Lisp_Object_Type::Continuation): fputs("[continuation]", 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::HashMap): { - for_hash_map (*(node->value.hashMap)) { - fputs(" ", file); - print(key, true, file); - fputs(" -> ", file); - print((Lisp_Object*)value, true, file); - fputs("\n", file); - } - } break; - case (Lisp_Object_Type::String): { - if (print_repr) { - putc('\"', file); - char* escaped = escape_string(Memory::get_c_str(node->value.string)); - fputs(escaped, file); - putc('\"', file); - free(escaped); - } - else - fputs(Memory::get_c_str(node->value.string), file); - } break; - case (Lisp_Object_Type::Vector): { - fputs("[", file); - if (node->value.vector.length > 0) - print(node->value.vector.data, print_repr, file); - for (int i = 1; i < node->value.vector.length; ++i) { - fputs(" ", file); - print(node->value.vector.data+i, print_repr, file); - } - fputs("]", file); - } break; - case (Lisp_Object_Type::Function): { - if (node->userType) { - fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol)); - break; - } - if (node->value.function->type == Function_Type::Lambda) - fputs("[lambda]", file); - // else if (node->value.function->type == Function_Type::Special_Lambda) - // fputs("[special-lambda]", file); - else if (node->value.function->type == Function_Type::Macro) - fputs("[macro]", file); - else - assert(false); - } break; - case (Lisp_Object_Type::Pair): { - Lisp_Object* head = node; - - // first check if it is a quotation form, in that case we want - // to print it prettier - if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { - String* identifier = head->value.pair.first->value.symbol; - - - auto symbol = head->value.pair.first; - auto quote_sym = Memory::get_symbol("quote"); - auto unquote_sym = Memory::get_symbol("unquote"); - auto quasiquote_sym = Memory::get_symbol("quasiquote"); - auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); - if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) - { - if (symbol == quote_sym) - putc('\'', file); - else if (symbol == unquote_sym) - putc(',', file); - else if (symbol == unquote_splicing_sym) - fputs(",@", file); - - assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); - assert(head->value.pair.rest->value.pair.rest == Memory::nil); - - print(head->value.pair.rest->value.pair.first, print_repr, file); - break; + return wc; + } + proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { + switch (Memory::get_type(node)) { + case (Lisp_Object_Type::Nil): fputs("()", file); break; + case (Lisp_Object_Type::T): fputs("t", file); break; + case (Lisp_Object_Type::Number): { + if (abs(node->value.number - (int)node->value.number) < 0.000001f) + fprintf(file, "%d", (int)node->value.number); + else + fprintf(file, "%f", node->value.number); + } break; + 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)); break; + case (Lisp_Object_Type::Continuation): fputs("[continuation]", 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::HashMap): { + for_hash_map (*(node->value.hashMap)) { + fputs(" ", file); + print(key, true, file); + fputs(" -> ", file); + print((Lisp_Object*)value, true, file); + fputs("\n", file); } - else if (symbol == quasiquote_sym) { - putc('`', file); - assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); - print(head->value.pair.rest->value.pair.first, print_repr, file); + } break; + case (Lisp_Object_Type::String): { + if (print_repr) { + putc('\"', file); + char* escaped = escape_string(Memory::get_c_str(node->value.string)); + fputs(escaped, file); + putc('\"', file); + free(escaped); + } + else + fputs(Memory::get_c_str(node->value.string), file); + } break; + case (Lisp_Object_Type::Vector): { + fputs("[", file); + if (node->value.vector.length > 0) + print(node->value.vector.data, print_repr, file); + for (int i = 1; i < node->value.vector.length; ++i) { + fputs(" ", file); + print(node->value.vector.data+i, print_repr, file); + } + fputs("]", file); + } break; + case (Lisp_Object_Type::Function): { + if (node->userType) { + fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol)); break; } - } + if (node->value.function->type == Function_Type::Lambda) + fputs("[lambda]", file); + // else if (node->value.function->type == Function_Type::Special_Lambda) + // fputs("[special-lambda]", file); + else if (node->value.function->type == Function_Type::Macro) + fputs("[macro]", file); + else + assert(false); + } break; + case (Lisp_Object_Type::Pair): { + Lisp_Object* head = node; + + // first check if it is a quotation form, in that case we want + // to print it prettier + if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) { + String* identifier = head->value.pair.first->value.symbol; + + + auto symbol = head->value.pair.first; + auto quote_sym = Memory::get_symbol("quote"); + auto unquote_sym = Memory::get_symbol("unquote"); + auto quasiquote_sym = Memory::get_symbol("quasiquote"); + auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); + if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) + { + if (symbol == quote_sym) + putc('\'', file); + else if (symbol == unquote_sym) + putc(',', file); + else if (symbol == unquote_splicing_sym) + fputs(",@", file); + + assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); + assert(head->value.pair.rest->value.pair.rest == Memory::nil); + + print(head->value.pair.rest->value.pair.first, print_repr, file); + break; + } + else if (symbol == quasiquote_sym) { + putc('`', file); + assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); + print(head->value.pair.rest->value.pair.first, print_repr, file); + break; + } + } - putc('(', file); - - // NOTE(Felix): We could do a while true here, however in case - // we want to print a broken list (for logging the error) we - // should do more checks. - while (head) { - print(head->value.pair.first, print_repr, file); - head = head->value.pair.rest; - if (!head) - return; - if (Memory::get_type(head) != Lisp_Object_Type::Pair) - break; - putc(' ', file); - } + putc('(', file); + + // NOTE(Felix): We could do a while true here, however in case + // we want to print a broken list (for logging the error) we + // should do more checks. + while (head) { + print(head->value.pair.first, print_repr, file); + head = head->value.pair.rest; + if (!head) + return; + if (Memory::get_type(head) != Lisp_Object_Type::Pair) + break; + putc(' ', file); + } - if (Memory::get_type(head) != Lisp_Object_Type::Nil) { - fputs(" . ", file); - print(head, print_repr, file); - } + if (Memory::get_type(head) != Lisp_Object_Type::Nil) { + fputs(" . ", file); + print(head, print_repr, file); + } - putc(')', file); - } break; + putc(')', file); + } break; + } } -} -proc print_single_call(Lisp_Object* obj) -> void { - printf(console_cyan); - print(obj, true); - printf(console_normal); - printf("\n at "); - if (obj->sourceCodeLocation) { - printf("%s (line %d, position %d)", - Memory::get_c_str( - obj->sourceCodeLocation->file), - obj->sourceCodeLocation->line, - obj->sourceCodeLocation->column); - } else { - fputs("no source code location avaliable", stdout); + proc print_single_call(Lisp_Object* obj) -> void { + printf(console_cyan); + print(obj, true); + printf(console_normal); + printf("\n at "); + if (obj->sourceCodeLocation) { + printf("%s (line %d, position %d)", + Memory::get_c_str( + obj->sourceCodeLocation->file), + obj->sourceCodeLocation->line, + obj->sourceCodeLocation->column); + } else { + fputs("no source code location avaliable", stdout); + } } -} -proc print_call_stack() -> void { - using Globals::Current_Execution::call_stack; + proc print_call_stack() -> void { + using Globals::Current_Execution::call_stack; - printf("callstack [%d] (most recent call last):\n", call_stack.next_index); - for (int i = 0; i < call_stack.next_index; ++i) { - printf("%2d -> ", i); - print_single_call(call_stack.data[i]); - printf("\n"); + printf("callstack [%d] (most recent call last):\n", call_stack.next_index); + for (int i = 0; i < call_stack.next_index; ++i) { + printf("%2d -> ", i); + print_single_call(call_stack.data[i]); + printf("\n"); + } } -} -proc log_error() -> void { - fputs(console_red, stdout); - fputs(Memory::get_c_str(Globals::error->message), stdout); - puts(console_normal); + proc log_error() -> void { + fputs(console_red, stdout); + fputs(Memory::get_c_str(Globals::error->message), stdout); + puts(console_normal); - fputs(" in: ", stdout); - print_call_stack(); - puts(console_normal); + fputs(" in: ", stdout); + print_call_stack(); + puts(console_normal); + } } diff --git a/src/libslime.cpp b/src/libslime.cpp index 4e69e72..9b07a0e 100644 --- a/src/libslime.cpp +++ b/src/libslime.cpp @@ -39,14 +39,14 @@ unsigned int hm_hash(void* ptr); unsigned int hm_hash(Slime::Lisp_Object* obj); #include "ftb/hashmap.hpp" -namespace Slime { + # include "defines.cpp" # include "assert.hpp" # include "define_macros.hpp" # include "platform.cpp" # include "structs.cpp" # include "forward_decls.cpp" -} + bool hm_objects_match(char* a, char* b) { return strcmp(a, b) == 0; @@ -107,7 +107,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) { } } -namespace Slime { # include "globals.cpp" # include "memory.cpp" # include "gc.cpp" @@ -122,4 +121,4 @@ namespace Slime { # include "built_ins.cpp" # include "testing.cpp" // # include "undefines.cpp" -} + diff --git a/src/lisp_object.cpp b/src/lisp_object.cpp index f204811..08cda75 100644 --- a/src/lisp_object.cpp +++ b/src/lisp_object.cpp @@ -1,53 +1,55 @@ -proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* { - if (!file) - return nullptr; +namespace Slime { + proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* { + if (!file) + return nullptr; - Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location)); - ret->file = file; - ret->line = line; - ret->column = col; - return ret; -} + Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location)); + ret->file = file; + ret->line = line; + ret->column = col; + return ret; + } -proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { - switch (type) { - case(Lisp_Object_Type::Nil): return "nil"; - case(Lisp_Object_Type::T): return "t"; - case(Lisp_Object_Type::Number): return "number"; - case(Lisp_Object_Type::String): return "string"; - case(Lisp_Object_Type::Symbol): return "symbol"; - case(Lisp_Object_Type::Keyword): return "keyword"; - case(Lisp_Object_Type::Function): return "function"; - case(Lisp_Object_Type::CFunction): return "C-function"; - case(Lisp_Object_Type::Continuation): return "continuation"; - case(Lisp_Object_Type::Pair): return "pair"; - case(Lisp_Object_Type::Vector): return "vector"; - case(Lisp_Object_Type::Pointer): return "pointer"; - case(Lisp_Object_Type::HashMap): return "hashmap"; + proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { + switch (type) { + case(Lisp_Object_Type::Nil): return "nil"; + case(Lisp_Object_Type::T): return "t"; + case(Lisp_Object_Type::Number): return "number"; + case(Lisp_Object_Type::String): return "string"; + case(Lisp_Object_Type::Symbol): return "symbol"; + case(Lisp_Object_Type::Keyword): return "keyword"; + case(Lisp_Object_Type::Function): return "function"; + case(Lisp_Object_Type::CFunction): return "C-function"; + case(Lisp_Object_Type::Continuation): return "continuation"; + case(Lisp_Object_Type::Pair): return "pair"; + case(Lisp_Object_Type::Vector): return "vector"; + case(Lisp_Object_Type::Pointer): return "pointer"; + case(Lisp_Object_Type::HashMap): return "hashmap"; + } + return "unknown"; } - return "unknown"; -} -Lisp_Object::~Lisp_Object() { - free(sourceCodeLocation); - sourceCodeLocation = 0; + Lisp_Object::~Lisp_Object() { + free(sourceCodeLocation); + sourceCodeLocation = 0; - switch (Memory::get_type(this)) { - case Lisp_Object_Type::HashMap: { - delete this->value.hashMap; - } break; - case Lisp_Object_Type::CFunction: { - this->value.cFunction->args.positional.symbols.~Array_List(); - this->value.cFunction->args.keyword.keywords.~Array_List(); - this->value.cFunction->args.keyword.values.~Array_List(); - delete this->value.cFunction; - } break; - case Lisp_Object_Type::Function:{ - this->value.function->args.positional.symbols.~Array_List(); - this->value.function->args.keyword.keywords.~Array_List(); - this->value.function->args.keyword.values.~Array_List(); - delete this->value.function; - } break; - default: break; + switch (Memory::get_type(this)) { + case Lisp_Object_Type::HashMap: { + delete this->value.hashMap; + } break; + case Lisp_Object_Type::CFunction: { + this->value.cFunction->args.positional.symbols.~Array_List(); + this->value.cFunction->args.keyword.keywords.~Array_List(); + this->value.cFunction->args.keyword.values.~Array_List(); + delete this->value.cFunction; + } break; + case Lisp_Object_Type::Function:{ + this->value.function->args.positional.symbols.~Array_List(); + this->value.function->args.keyword.keywords.~Array_List(); + this->value.function->args.keyword.values.~Array_List(); + delete this->value.function; + } break; + default: break; + } } } diff --git a/src/memory.cpp b/src/memory.cpp index 9ea0ca5..7f7f5f1 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -1,4 +1,4 @@ -namespace Memory { +namespace Slime::Memory { // ------------------ // global symbol / keyword table diff --git a/src/parse.cpp b/src/parse.cpp index 846e75e..0e66852 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -1,4 +1,4 @@ -namespace Parser { +namespace Slime::Parser { String* standard_in; String* parser_file; int parser_line; diff --git a/src/platform.cpp b/src/platform.cpp index c39b290..61c620a 100644 --- a/src/platform.cpp +++ b/src/platform.cpp @@ -1,167 +1,170 @@ -inline proc get_cwd() -> char* { - const int buf_size = 2048; - char* res = (char*)malloc(buf_size * sizeof(char)); +namespace Slime { + + inline proc get_cwd() -> char* { + const int buf_size = 2048; + char* res = (char*)malloc(buf_size * sizeof(char)); #ifdef _MSC_VER - _getcwd(res, buf_size); + _getcwd(res, buf_size); #else - getcwd(res, buf_size); + getcwd(res, buf_size); #endif - return res; -} + return res; + } -inline proc change_cwd(char* dir) -> void { + inline proc change_cwd(char* dir) -> void { #ifdef _MSC_VER - _chdir(dir); + _chdir(dir); #else - chdir(dir); + chdir(dir); #endif -} + } #ifdef _MSC_VER -int vasprintf(char **strp, const char *fmt, va_list ap) { - // _vscprintf tells you how big the buffer needs to be - int len = _vscprintf(fmt, ap); - if (len == -1) { - return -1; - } - size_t size = (size_t)len + 1; - char *str = (char*)malloc(size); - if (!str) { - return -1; - } - // _vsprintf_s is the "secure" version of vsprintf - int r = vsprintf_s(str, len + 1, fmt, ap); - if (r == -1) { - free(str); - return -1; + int vasprintf(char **strp, const char *fmt, va_list ap) { + // _vscprintf tells you how big the buffer needs to be + int len = _vscprintf(fmt, ap); + if (len == -1) { + return -1; + } + size_t size = (size_t)len + 1; + char *str = (char*)malloc(size); + if (!str) { + return -1; + } + // _vsprintf_s is the "secure" version of vsprintf + int r = vsprintf_s(str, len + 1, fmt, ap); + if (r == -1) { + free(str); + return -1; + } + *strp = str; + return r; } - *strp = str; - return r; -} -int asprintf(char **strp, const char *fmt, ...) { - va_list ap; - va_start(ap, fmt); - int r = vasprintf(strp, fmt, ap); - va_end(ap); - return r; -} + int asprintf(char **strp, const char *fmt, ...) { + va_list ap; + va_start(ap, fmt); + int r = vasprintf(strp, fmt, ap); + va_end(ap); + return r; + } #endif -proc get_exe_dir() -> char* { + proc get_exe_dir() -> char* { #ifdef _MSC_VER - DWORD last_error; - DWORD result; - DWORD path_size = 1024; - char* path = (char*)malloc(1024); - - while (true) { - memset(path, 0, path_size); - result = GetModuleFileName(0, path, path_size - 1); - last_error = GetLastError(); - - if (0 == result) { - free(path); - path = 0; - break; - } - else if (result == path_size - 1) { - free(path); - /* May need to also check for ERROR_SUCCESS here if XP/2K */ - if (ERROR_INSUFFICIENT_BUFFER != last_error) { + DWORD last_error; + DWORD result; + DWORD path_size = 1024; + char* path = (char*)malloc(1024); + + while (true) { + memset(path, 0, path_size); + result = GetModuleFileName(0, path, path_size - 1); + last_error = GetLastError(); + + if (0 == result) { + free(path); path = 0; break; } - path_size = path_size * 2; - path = (char*)malloc(path_size); + else if (result == path_size - 1) { + free(path); + /* May need to also check for ERROR_SUCCESS here if XP/2K */ + if (ERROR_INSUFFICIENT_BUFFER != last_error) { + path = 0; + break; + } + path_size = path_size * 2; + path = (char*)malloc(path_size); + } + else + break; } - else - break; - } - if (!path) { - fprintf(stderr, "Failure: %ld\n", last_error); - return nullptr; - } - else { - // remove the exe name, so we are only left with the path + if (!path) { + fprintf(stderr, "Failure: %ld\n", last_error); + return nullptr; + } + else { + // remove the exe name, so we are only left with the path - int index_in_path = -1; - int last_backslash = -1; + int index_in_path = -1; + int last_backslash = -1; - char c; - while ((c = path[++index_in_path]) != '\0') { - if (c == '\\') - last_backslash = index_in_path; - } + char c; + while ((c = path[++index_in_path]) != '\0') { + if (c == '\\') + last_backslash = index_in_path; + } - // we are assuming there are some backslashes - path[last_backslash+1] = '\0'; + // we are assuming there are some backslashes + path[last_backslash+1] = '\0'; - return path; - } + return path; + } #else - ssize_t size = 512, i, n; - char *path, *temp; + ssize_t size = 512, i, n; + char *path, *temp; - while (1) { - size_t used; + while (1) { + size_t used; - path = (char*)malloc(size); - if (!path) { - errno = ENOMEM; - return NULL; - } + path = (char*)malloc(size); + if (!path) { + errno = ENOMEM; + return NULL; + } - used = readlink("/proc/self/exe", path, size); + used = readlink("/proc/self/exe", path, size); - if (used == -1) { - const int saved_errno = errno; - free(path); - errno = saved_errno; - return NULL; - } else - if (used < 1) { + if (used == -1) { + const int saved_errno = errno; free(path); - errno = EIO; + errno = saved_errno; return NULL; + } else + if (used < 1) { + free(path); + errno = EIO; + return NULL; + } + + if ((size_t)used >= size) { + free(path); + size = (size | 2047) + 2049; + continue; } - if ((size_t)used >= size) { - free(path); - size = (size | 2047) + 2049; - continue; + size = (size_t)used; + break; } - size = (size_t)used; - break; - } - - /* Find final slash. */ - n = 0; - for (i = 0; i < size; i++) - if (path[i] == '/') - n = i; - - /* Optimize allocated size, - ensuring there is room for - a final slash and a - string-terminating '\0', */ - temp = path; - path = (char*)realloc(temp, n + 2); - if (!path) { - free(temp); - errno = ENOMEM; - return NULL; - } + /* Find final slash. */ + n = 0; + for (i = 0; i < size; i++) + if (path[i] == '/') + n = i; + + /* Optimize allocated size, + ensuring there is room for + a final slash and a + string-terminating '\0', */ + temp = path; + path = (char*)realloc(temp, n + 2); + if (!path) { + free(temp); + errno = ENOMEM; + return NULL; + } - /* and properly trim and terminate the path string. */ - path[n+0] = '/'; - path[n+1] = '\0'; + /* and properly trim and terminate the path string. */ + path[n+0] = '/'; + path[n+1] = '\0'; - return path; + return path; #endif + } } diff --git a/src/structs.cpp b/src/structs.cpp index 37512a5..7204160 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -1,142 +1,144 @@ -struct Lisp_Object; -struct String; -struct Environment; - -enum struct Thread_Type { - Main, - GarbageCollection -}; - -enum struct Lisp_Object_Type { - Nil, - T, - Symbol, - Keyword, - Number, - String, - Pair, - Vector, - Continuation, - Pointer, - HashMap, - // OwningPointer, - Function, - CFunction, -}; - -enum class Lisp_Object_Flags -{ - // bits 1 to 5 (including) will be reserved for the type - Already_Garbage_Collected = 1 << 5, - Under_Construction = 1 << 6, -}; - -enum struct Function_Type { - Lambda, - Macro -}; - -enum struct Log_Level { - None, - Critical, - Warning, - Info, - Debug, -}; - -struct Continuation { - Array_List call_stack; - Array_List envi_stack; -}; - -struct String { - int length; - char data; -}; - -struct Source_Code_Location { - String* file; - int line; - int column; -}; - -struct Pair { - Lisp_Object* first; - Lisp_Object* rest; -}; - -struct Vector { - int length; - Lisp_Object* data; -}; - -struct Positional_Arguments { - Array_List symbols; -}; - -struct Keyword_Arguments { - // Array of Pointers to Lisp_Object - Array_List keywords; - // NOTE(Felix): values[i] will be nullptr if no defalut value was - // declared for key identifiers[i] - Array_List values; -}; - -struct Arguments { - Positional_Arguments positional; - Keyword_Arguments keyword; - // NOTE(Felix): rest_argument will be nullptr if no rest argument - // is declared otherwise its a symbol - Lisp_Object* rest; -}; - -struct Environment { - Array_List parents; - Hash_Map hm; - - ~Environment() { - parents.~Array_List(); - hm.~Hash_Map(); - } -}; - -struct Function { - Function_Type type; - Arguments args; - Lisp_Object* body; // maybe implicit begin - Environment* parent_environment; // we are doing closures now!! -}; - -struct cFunction { - Lisp_Object* (*body)(); - Arguments args; - bool is_special_form; -}; - -struct Lisp_Object { - Source_Code_Location* sourceCodeLocation; - u64 flags; - Lisp_Object* userType; // keyword - String* docstring; - union value { - String* symbol; // used for symbols and keywords - double number; - String* string; - Pair pair; - Vector vector; - Function* function; - cFunction* cFunction; - void* pointer; - Continuation* continuation; - Hash_Map* hashMap; - ~value() {} - } value; - ~Lisp_Object(); -}; - -struct Error { - Lisp_Object* position; - // type has to be a keyword - Lisp_Object* type; - String* message; -}; +namespace Slime { + struct Lisp_Object; + struct String; + struct Environment; + + enum struct Thread_Type { + Main, + GarbageCollection + }; + + enum struct Lisp_Object_Type { + Nil, + T, + Symbol, + Keyword, + Number, + String, + Pair, + Vector, + Continuation, + Pointer, + HashMap, + // OwningPointer, + Function, + CFunction, + }; + + enum class Lisp_Object_Flags + { + // bits 1 to 5 (including) will be reserved for the type + Already_Garbage_Collected = 1 << 5, + Under_Construction = 1 << 6, + }; + + enum struct Function_Type { + Lambda, + Macro + }; + + enum struct Log_Level { + None, + Critical, + Warning, + Info, + Debug, + }; + + struct Continuation { + Array_List call_stack; + Array_List envi_stack; + }; + + struct String { + int length; + char data; + }; + + struct Source_Code_Location { + String* file; + int line; + int column; + }; + + struct Pair { + Lisp_Object* first; + Lisp_Object* rest; + }; + + struct Vector { + int length; + Lisp_Object* data; + }; + + struct Positional_Arguments { + Array_List symbols; + }; + + struct Keyword_Arguments { + // Array of Pointers to Lisp_Object + Array_List keywords; + // NOTE(Felix): values[i] will be nullptr if no defalut value was + // declared for key identifiers[i] + Array_List values; + }; + + struct Arguments { + Positional_Arguments positional; + Keyword_Arguments keyword; + // NOTE(Felix): rest_argument will be nullptr if no rest argument + // is declared otherwise its a symbol + Lisp_Object* rest; + }; + + struct Environment { + Array_List parents; + Hash_Map hm; + + ~Environment() { + parents.~Array_List(); + hm.~Hash_Map(); + } + }; + + struct Function { + Function_Type type; + Arguments args; + Lisp_Object* body; // maybe implicit begin + Environment* parent_environment; // we are doing closures now!! + }; + + struct cFunction { + Lisp_Object* (*body)(); + Arguments args; + bool is_special_form; + }; + + struct Lisp_Object { + Source_Code_Location* sourceCodeLocation; + u64 flags; + Lisp_Object* userType; // keyword + String* docstring; + union value { + String* symbol; // used for symbols and keywords + double number; + String* string; + Pair pair; + Vector vector; + Function* function; + cFunction* cFunction; + void* pointer; + Continuation* continuation; + Hash_Map* hashMap; + ~value() {} + } value; + ~Lisp_Object(); + }; + + struct Error { + Lisp_Object* position; + // type has to be a keyword + Lisp_Object* type; + String* message; + }; +} diff --git a/src/testing.cpp b/src/testing.cpp index 140fc68..7cd4772 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -1,14 +1,16 @@ +namespace Slime { + #define epsilon 2.2204460492503131E-16 #define testresult int #define pass 1 #define fail 0 -#define print_assert_equal_fail(variable, value, type, format) \ - printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ - "\n\texpected: " format \ - "\n\tgot: " format "\n", \ - __FILE__, __LINE__, (type)value, (type)variable) +#define print_assert_equal_fail(variable, value, type, format) \ + printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ + "\n\texpected: " format \ + "\n\tgot: " format "\n", \ + __FILE__, __LINE__, (type)value, (type)variable) #define print_assert_not_equal_fail(variable, value, type, format) \ printf("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ @@ -43,12 +45,12 @@ printf("\nExpected an error to occur," \ " but no error occured:\n"); \ return fail; \ - } \ + } \ -#define assert_equal_double(variable, value) \ - if (fabs((double)variable - (double)value) > epsilon) { \ - print_assert_equal_fail(variable, value, double, "%f"); \ - return fail; \ +#define assert_equal_double(variable, value) \ + if (fabs((double)variable - (double)value) > epsilon) { \ + print_assert_equal_fail(variable, value, double, "%f"); \ + return fail; \ } #define assert_not_equal_double(variable, value) \ @@ -59,17 +61,17 @@ #define assert_equal_string(variable, value) \ if (!string_equal(variable, value)) { \ - print_assert_equal_fail(&variable->data, value, char*, "%s"); \ + print_assert_equal_fail(&variable->data, value, char*, "%s"); \ return fail; \ } -#define assert_equal_type(node, _type) \ - if (Memory::get_type(node) != _type) { \ - print_assert_equal_fail( \ - Lisp_Object_Type_to_string(Memory::get_type(node)), \ - Lisp_Object_Type_to_string(_type), char*, "%s"); \ - return fail; \ - } \ +#define assert_equal_type(node, _type) \ + if (Memory::get_type(node) != _type) { \ + print_assert_equal_fail( \ + Lisp_Object_Type_to_string(Memory::get_type(node)), \ + Lisp_Object_Type_to_string(_type), char*, "%s"); \ + return fail; \ + } \ #define assert_null(variable) \ assert_equal_int(variable, nullptr) @@ -77,574 +79,577 @@ #define assert_not_null(variable) \ assert_not_equal_int(variable, nullptr) -#define invoke_test(name) \ - fputs("" #name ":", stdout); \ - if (name() == pass) { \ - for(size_t i = strlen(#name); i < 70; ++i) \ - fputs((i%3==1)? "." : " ", stdout); \ - fputs(console_green "passed\n" console_normal, stdout); \ - } \ - else { \ - result = false; \ - for(int i = -1; i < 70; ++i) \ - fputs((i%3==1)? "." : " ", stdout); \ - fputs(console_red "failed\n" console_normal, stdout); \ - if(Globals::error) { \ - free(Globals::error); \ - Globals::error = nullptr; \ - } \ - } \ - -#define invoke_test_script(name) \ - fputs("" name ":", stdout); \ - if (test_file("tests/" name ".slime") == pass) { \ - for(size_t i = strlen(name); i < 70; ++i) \ - fputs((i%3==1)? "." : " ", stdout); \ - fputs(console_green "passed\n" console_normal, stdout); \ - } \ - else { \ - result = false; \ - for(int i = -1; i < 70; ++i) \ - fputs((i%3==1)? "." : " ", stdout); \ - fputs(console_red "failed\n" console_normal, stdout); \ - if(Globals::error) { \ - free(Globals::error); \ - Globals::error = nullptr; \ - } \ +#define invoke_test(name) \ + fputs("" #name ":", stdout); \ + if (name() == pass) { \ + for(size_t i = strlen(#name); i < 70; ++i) \ + fputs((i%3==1)? "." : " ", stdout); \ + fputs(console_green "passed\n" console_normal, stdout); \ + } \ + else { \ + result = false; \ + for(int i = -1; i < 70; ++i) \ + fputs((i%3==1)? "." : " ", stdout); \ + fputs(console_red "failed\n" console_normal, stdout); \ + if(Globals::error) { \ + free(Globals::error); \ + Globals::error = nullptr; \ + } \ + } \ + +#define invoke_test_script(name) \ + fputs("" name ":", stdout); \ + if (test_file("tests/" name ".slime") == pass) { \ + for(size_t i = strlen(name); i < 70; ++i) \ + fputs((i%3==1)? "." : " ", stdout); \ + fputs(console_green "passed\n" console_normal, stdout); \ + } \ + else { \ + result = false; \ + for(int i = -1; i < 70; ++i) \ + fputs((i%3==1)? "." : " ", stdout); \ + fputs(console_red "failed\n" console_normal, stdout); \ + if(Globals::error) { \ + free(Globals::error); \ + Globals::error = nullptr; \ + } \ } -proc test_array_lists_adding_and_removing() -> testresult { - // test adding and removing - Array_List list; - list.append(1); - list.append(2); - list.append(3); - list.append(4); + proc test_array_lists_adding_and_removing() -> testresult { + // test adding and removing + Array_List list; + list.append(1); + list.append(2); + list.append(3); + list.append(4); - assert_equal_int(list.next_index, 4); + assert_equal_int(list.next_index, 4); - list.remove_index(0); + list.remove_index(0); - assert_equal_int(list.next_index, 3); - assert_equal_int(list[0], 4); - assert_equal_int(list[1], 2); - assert_equal_int(list[2], 3); + assert_equal_int(list.next_index, 3); + assert_equal_int(list[0], 4); + assert_equal_int(list[1], 2); + assert_equal_int(list[2], 3); - list.remove_index(2); + list.remove_index(2); - assert_equal_int(list.next_index, 2); - assert_equal_int(list[0], 4); - assert_equal_int(list[1], 2); + assert_equal_int(list.next_index, 2); + assert_equal_int(list[0], 4); + assert_equal_int(list[1], 2); - return pass; -} + return pass; + } -proc test_array_lists_sorting() -> testresult { - // test adding and removing - Array_List list; - list.append(1); - list.append(2); - list.append(3); - list.append(4); + proc test_array_lists_sorting() -> testresult { + // test adding and removing + Array_List list; + list.append(1); + list.append(2); + list.append(3); + list.append(4); - list.sort(); + list.sort(); - assert_equal_int(list.next_index, 4); + assert_equal_int(list.next_index, 4); - assert_equal_int(list[0], 1); - assert_equal_int(list[1], 2); - assert_equal_int(list[2], 3); - assert_equal_int(list[3], 4); + assert_equal_int(list[0], 1); + assert_equal_int(list[1], 2); + assert_equal_int(list[2], 3); + assert_equal_int(list[3], 4); - list.append(0); - list.append(5); + list.append(0); + list.append(5); - assert_equal_int(list.next_index, 6); + assert_equal_int(list.next_index, 6); - list.sort(); + list.sort(); - assert_equal_int(list[0], 0); - assert_equal_int(list[1], 1); - assert_equal_int(list[2], 2); - assert_equal_int(list[3], 3); - assert_equal_int(list[4], 4); - assert_equal_int(list[5], 5); + assert_equal_int(list[0], 0); + assert_equal_int(list[1], 1); + assert_equal_int(list[2], 2); + assert_equal_int(list[3], 3); + assert_equal_int(list[4], 4); + assert_equal_int(list[5], 5); - return pass; -} + return pass; + } -proc test_array_lists_searching() -> testresult { - Array_List list; - list.append(1); - list.append(2); - list.append(3); - list.append(4); + proc test_array_lists_searching() -> testresult { + Array_List list; + list.append(1); + list.append(2); + list.append(3); + list.append(4); - int index = list.sorted_find(3); - assert_equal_int(index, 2); + int index = list.sorted_find(3); + assert_equal_int(index, 2); - index = list.sorted_find(1); - assert_equal_int(index, 0); + index = list.sorted_find(1); + assert_equal_int(index, 0); - index = list.sorted_find(5); - assert_equal_int(index, -1); + index = list.sorted_find(5); + assert_equal_int(index, -1); - return pass; -} + return pass; + } -proc test_eval_operands() -> testresult { - char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; - Lisp_Object* operands = Parser::parse_single_expression(operands_string); - try operands = eval_arguments(operands); + proc test_eval_operands() -> testresult { + char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; + Lisp_Object* operands = Parser::parse_single_expression(operands_string); + try operands = eval_arguments(operands); - assert_no_error(); - assert_equal_int(list_length(operands), 4); + assert_no_error(); + assert_equal_int(list_length(operands), 4); - assert_equal_type(operands, Lisp_Object_Type::Pair); - assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); - assert_equal_double(operands->value.pair.first->value.number, 1); + assert_equal_type(operands, Lisp_Object_Type::Pair); + assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); + assert_equal_double(operands->value.pair.first->value.number, 1); - operands = operands->value.pair.rest; + operands = operands->value.pair.rest; - assert_equal_type(operands, Lisp_Object_Type::Pair); - assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); - assert_equal_double(operands->value.pair.first->value.number, 3); + assert_equal_type(operands, Lisp_Object_Type::Pair); + assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); + 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"); + 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"); - operands = operands->value.pair.rest; + operands = operands->value.pair.rest; - assert_equal_type(operands, Lisp_Object_Type::Pair); - assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword); - assert_equal_string(operands->value.pair.first->value.symbol, "haha"); + assert_equal_type(operands, Lisp_Object_Type::Pair); + assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword); + assert_equal_string(operands->value.pair.first->value.symbol, "haha"); - return pass; -} + return pass; + } -proc test_parse_atom() -> testresult { - int index_in_text = 0; - char string[] = - "123 -1.23e-2 " // numbers - "\"asd\" " // strings - ":key1 :key:2 " // keywords - "sym +"; // symbols + proc test_parse_atom() -> testresult { + int index_in_text = 0; + char string[] = + "123 -1.23e-2 " // numbers + "\"asd\" " // strings + ":key1 :key:2 " // keywords + "sym +"; // symbols - // test numbers - Lisp_Object* result = Parser::parse_atom(string, &index_in_text); + // test numbers + Lisp_Object* result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 123); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 123); - ++index_in_text; + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, -1.23e-2); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, -1.23e-2); - // test strings - ++index_in_text; + // test strings + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::String); - assert_equal_string(result->value.string, "asd"); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::String); + assert_equal_string(result->value.string, "asd"); - // test keywords - ++index_in_text; + // test keywords + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Keyword); - assert_equal_string(result->value.symbol, "key1"); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::Keyword); + assert_equal_string(result->value.symbol, "key1"); - ++index_in_text; + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Keyword); - assert_equal_string(result->value.symbol, "key:2"); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::Keyword); + assert_equal_string(result->value.symbol, "key:2"); - // test symbols - ++index_in_text; + // test symbols + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.symbol, "sym"); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::Symbol); + assert_equal_string(result->value.symbol, "sym"); - ++index_in_text; + ++index_in_text; - result = Parser::parse_atom(string, &index_in_text); - assert_equal_type(result, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.symbol, "+"); + result = Parser::parse_atom(string, &index_in_text); + assert_equal_type(result, Lisp_Object_Type::Symbol); + assert_equal_string(result->value.symbol, "+"); - return pass; -} + return pass; + } -proc test_parse_expression() -> testresult { - int index_in_text = 0; - char string[] = "(fun + 12)"; + proc test_parse_expression() -> testresult { + int index_in_text = 0; + char string[] = "(fun + 12)"; - Lisp_Object* result = Parser::parse_expression(string, &index_in_text); - assert_no_error(); + Lisp_Object* result = Parser::parse_expression(string, &index_in_text); + assert_no_error(); - assert_equal_type(result, Lisp_Object_Type::Pair); - assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.pair.first->value.symbol, "fun"); + assert_equal_type(result, Lisp_Object_Type::Pair); + assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); + 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->value.pair.first, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.pair.first->value.symbol, "+"); + assert_equal_type(result, Lisp_Object_Type::Pair); + assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); + assert_equal_string(result->value.pair.first->value.symbol, "+"); - result = result->value.pair.rest; + result = result->value.pair.rest; - assert_equal_type(result, Lisp_Object_Type::Pair); - assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number); - assert_equal_double(result->value.pair.first->value.number, 12); + assert_equal_type(result, Lisp_Object_Type::Pair); + assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number); + assert_equal_double(result->value.pair.first->value.number, 12); - result = result->value.pair.rest; + result = result->value.pair.rest; - assert_equal_type(result, Lisp_Object_Type::Nil); + assert_equal_type(result, Lisp_Object_Type::Nil); - char string2[] = "(define fun (lambda (x) (+ 5 (* x x ))))"; - index_in_text = 0; + char string2[] = "(define fun (lambda (x) (+ 5 (* x x ))))"; + index_in_text = 0; - result = Parser::parse_expression(string2, &index_in_text); - assert_no_error(); + result = Parser::parse_expression(string2, &index_in_text); + assert_no_error(); - assert_equal_type(result, Lisp_Object_Type::Pair); - assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.pair.first->value.symbol, "define"); + assert_equal_type(result, Lisp_Object_Type::Pair); + assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); + 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->value.pair.first, Lisp_Object_Type::Symbol); - assert_equal_string(result->value.pair.first->value.symbol, "fun"); + assert_equal_type(result, Lisp_Object_Type::Pair); + assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); + 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->value.pair.first, Lisp_Object_Type::Pair); - 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, "lambda"); + 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->value.pair.first, Lisp_Object_Type::Symbol); + assert_equal_string(result->value.pair.first->value.pair.first->value.symbol, "lambda"); - result = result->value.pair.rest; + result = result->value.pair.rest; - return pass; -} + return pass; + } -proc test_built_in_add() -> testresult { - char exp_string[] = "(+ 10 4)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_add() -> testresult { + char exp_string[] = "(+ 10 4)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 14); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 14); - return pass; -} + return pass; + } -proc test_built_in_substract() -> testresult { - char exp_string[] = "(- 10 4)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string); - Lisp_Object* result; + proc test_built_in_substract() -> testresult { + char exp_string[] = "(- 10 4)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string); + Lisp_Object* result; - try result = eval_expr(expression); + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 6); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 6); - return pass; -} + return pass; + } -proc test_built_in_multiply() -> testresult { - char exp_string[] = "(* 10 4)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_multiply() -> testresult { + char exp_string[] = "(* 10 4)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 40); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 40); - return pass; -} + return pass; + } -proc test_built_in_divide() -> testresult { - char exp_string[] = "(/ 20 4)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_divide() -> testresult { + char exp_string[] = "(/ 20 4)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 5); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 5); - return pass; -} + return pass; + } -proc test_built_in_if() -> testresult { - char exp_string1[] = "(if 1 4 5)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_if() -> testresult { + char exp_string1[] = "(if 1 4 5)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 4); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 4); - char exp_string2[] = "(if () 4 5)"; - expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression); + char exp_string2[] = "(if () 4 5)"; + expression = Parser::parse_single_expression(exp_string2); + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 5); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Number); + assert_equal_double(result->value.number, 5); - return pass; -} + return pass; + } -proc test_built_in_and() -> testresult { - char exp_string1[] = "(and 1 \"asd\" 4)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_and() -> testresult { + char exp_string1[] = "(and 1 \"asd\" 4)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::T); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::T); - // a false case - char exp_string2[] = "(and () \"asd\" 4)"; - expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression); + // a false case + char exp_string2[] = "(and () \"asd\" 4)"; + expression = Parser::parse_single_expression(exp_string2); + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Nil); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Nil); - return pass; -} + return pass; + } -proc test_built_in_or() -> testresult { - char exp_string1[] = "(or \"asd\" nil)"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_or() -> testresult { + char exp_string1[] = "(or \"asd\" nil)"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result; + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::T); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::T); - // a false case - char exp_string2[] = "(or () ())"; - expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression); + // a false case + char exp_string2[] = "(or () ())"; + expression = Parser::parse_single_expression(exp_string2); + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Nil); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Nil); - return pass; -} + return pass; + } -proc test_built_in_not() -> testresult { - char exp_string1[] = "(not ())"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result; - try result = eval_expr(expression); + proc test_built_in_not() -> testresult { + char exp_string1[] = "(not ())"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result; + try result = eval_expr(expression); - // a true case - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::T); + // a true case + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::T); - // a false case - char exp_string2[] = "(not \"asd xD\")"; - expression = Parser::parse_single_expression(exp_string2); - try result = eval_expr(expression); + // a false case + char exp_string2[] = "(not \"asd xD\")"; + expression = Parser::parse_single_expression(exp_string2); + try result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Nil); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Nil); - return pass; -} + return pass; + } -proc test_built_in_type() -> testresult { - // Environment* env; - // try env = get_root_environment(); - - // normal type testing - char exp_string1[] = "(begin (define a 10)(type a))"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result = eval_expr(expression); - - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Keyword); - assert_equal_string(result->value.symbol, "number"); - - // setting user type - char exp_string2[] = "(begin (set-type! a :my-type)(type a))"; - expression = Parser::parse_single_expression(exp_string2); - result = eval_expr(expression); - - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Keyword); - assert_equal_string(result->value.symbol, "my-type"); - - // // 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 { - // result = eval_expr(expression); - // } - // } - - // assert_error(); - // delete_error(); - - // deleting user type - char exp_string4[] = "(begin (delete-type! a)(type a))"; - expression = Parser::parse_single_expression(exp_string4); - result = eval_expr(expression); - - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Keyword); - assert_equal_string(result->value.symbol, "number"); - - return pass; -} + proc test_built_in_type() -> testresult { + // Environment* env; + // try env = get_root_environment(); + + // normal type testing + char exp_string1[] = "(begin (define a 10)(type a))"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result = eval_expr(expression); + + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Keyword); + assert_equal_string(result->value.symbol, "number"); + + // setting user type + char exp_string2[] = "(begin (set-type! a :my-type)(type a))"; + expression = Parser::parse_single_expression(exp_string2); + result = eval_expr(expression); + + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Keyword); + assert_equal_string(result->value.symbol, "my-type"); + + // // 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 { + // result = eval_expr(expression); + // } + // } + + // assert_error(); + // delete_error(); + + // deleting user type + char exp_string4[] = "(begin (delete-type! a)(type a))"; + expression = Parser::parse_single_expression(exp_string4); + result = eval_expr(expression); + + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Keyword); + assert_equal_string(result->value.symbol, "number"); + + return pass; + } -proc test_singular_t_and_nil() -> testresult { - // nil testing - char exp_string1[] = "()"; - char exp_string2[] = "nil"; - Lisp_Object* expression = Parser::parse_single_expression(exp_string1); - Lisp_Object* result = eval_expr(expression); + proc test_singular_t_and_nil() -> testresult { + // nil testing + char exp_string1[] = "()"; + char exp_string2[] = "nil"; + Lisp_Object* expression = Parser::parse_single_expression(exp_string1); + Lisp_Object* result = eval_expr(expression); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Nil); - assert_equal_int(expression, result); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Nil); + assert_equal_int(expression, result); - Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2); - Lisp_Object* result2 = eval_expr(expression2); + Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2); + Lisp_Object* result2 = eval_expr(expression2); - assert_no_error(); - assert_not_null(result); - assert_equal_type(result, Lisp_Object_Type::Nil); - assert_equal_int(result, result2); - assert_equal_int(expression, Memory::nil); + assert_no_error(); + assert_not_null(result); + assert_equal_type(result, Lisp_Object_Type::Nil); + assert_equal_int(result, result2); + assert_equal_int(expression, Memory::nil); - // t testing - char exp_string3[] = "t"; - Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3); - Lisp_Object* result3 = eval_expr(expression3); + // t testing + char exp_string3[] = "t"; + Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3); + Lisp_Object* result3 = eval_expr(expression3); - assert_no_error(); - assert_not_null(result3); + assert_no_error(); + assert_not_null(result3); - return pass; -} + return pass; + } -proc test_singular_symbols() -> testresult { - auto cc_s_aa = Memory::get_symbol("aa"); - auto cc_s_aa2 = Memory::get_symbol("aa2"); - auto s_s_aa = Memory::get_symbol(Memory::create_string("aa")); - auto s_s_aa2 = Memory::get_symbol(Memory::create_string("aa2")); + proc test_singular_symbols() -> testresult { + auto cc_s_aa = Memory::get_symbol("aa"); + auto cc_s_aa2 = Memory::get_symbol("aa2"); + auto s_s_aa = Memory::get_symbol(Memory::create_string("aa")); + auto s_s_aa2 = Memory::get_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); + 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; -} + return pass; + } -proc test_file(const char* file) -> testresult { - profile_with_name(file); - // Memory::reset(); - // assert_no_error(); + proc test_file(const char* file) -> testresult { + profile_with_name(file); + // Memory::reset(); + // assert_no_error(); - push_environment(Memory::create_child_environment(get_current_environment())); - built_in_load(Memory::create_string(file)); - assert_no_error(); - pop_environment(); + push_environment(Memory::create_child_environment(get_current_environment())); + built_in_load(Memory::create_string(file)); + assert_no_error(); + pop_environment(); - return pass; -} + return pass; + } -proc run_all_tests() -> bool { - profile_this(); - - bool result = true; - - try Memory::init(409600); - - printf("-- Util --\n"); - invoke_test(test_array_lists_adding_and_removing); - invoke_test(test_array_lists_sorting); - invoke_test(test_array_lists_searching); - - printf("\n -- Parsing --\n"); - invoke_test(test_parse_atom); - invoke_test(test_parse_expression); - - printf("\n-- Basic evaluating --\n"); - invoke_test(test_eval_operands); - - printf("\n-- Built ins --\n"); - invoke_test(test_built_in_add); - invoke_test(test_built_in_substract); - invoke_test(test_built_in_multiply); - invoke_test(test_built_in_divide); - invoke_test(test_built_in_if); - invoke_test(test_built_in_and); - invoke_test(test_built_in_or); - invoke_test(test_built_in_not); - invoke_test(test_built_in_type); - - printf("\n-- Memory management --\n"); - invoke_test(test_singular_t_and_nil); - invoke_test(test_singular_symbols); - - printf("\n-- Test Files --\n"); - - invoke_test_script("evaluation_of_default_args"); - invoke_test_script("alists"); - invoke_test_script("case_and_cond"); - invoke_test_script("lexical_scope"); - invoke_test_script("class_macro"); - invoke_test_script("import_and_load"); - invoke_test_script("macro_expand"); - invoke_test_script("automata"); - invoke_test_script("sicp"); - invoke_test_script("hashmaps"); - invoke_test_script("singular_imports"); - - return result; -} + proc run_all_tests() -> bool { + profile_this(); + + bool result = true; + + try Memory::init(409600); + + push_environment(Memory::create_child_environment( + get_current_environment())); + printf("-- Util --\n"); + invoke_test(test_array_lists_adding_and_removing); + invoke_test(test_array_lists_sorting); + invoke_test(test_array_lists_searching); + + printf("\n -- Parsing --\n"); + invoke_test(test_parse_atom); + invoke_test(test_parse_expression); + + printf("\n-- Basic evaluating --\n"); + invoke_test(test_eval_operands); + + printf("\n-- Built ins --\n"); + invoke_test(test_built_in_add); + invoke_test(test_built_in_substract); + invoke_test(test_built_in_multiply); + invoke_test(test_built_in_divide); + invoke_test(test_built_in_if); + invoke_test(test_built_in_and); + invoke_test(test_built_in_or); + invoke_test(test_built_in_not); + invoke_test(test_built_in_type); + + printf("\n-- Memory management --\n"); + invoke_test(test_singular_t_and_nil); + invoke_test(test_singular_symbols); + + pop_environment(); + printf("\n-- Test Files --\n"); + + invoke_test_script("evaluation_of_default_args"); + invoke_test_script("alists"); + invoke_test_script("case_and_cond"); + invoke_test_script("lexical_scope"); + invoke_test_script("class_macro"); + invoke_test_script("import_and_load"); + invoke_test_script("macro_expand"); + invoke_test_script("automata"); + invoke_test_script("sicp"); + invoke_test_script("hashmaps"); + invoke_test_script("singular_imports"); + + return result; + } #undef epsilon #undef testresult @@ -664,3 +669,4 @@ proc run_all_tests() -> bool { #undef assert_not_null #undef invoke_test #undef invoke_test_script +} diff --git a/src/visualization.cpp b/src/visualization.cpp index 9e349bf..e3fe7ae 100644 --- a/src/visualization.cpp +++ b/src/visualization.cpp @@ -1,497 +1,498 @@ -proc visualize_lisp_machine() -> void { - - // // save the current working directory - // char* cwd = get_cwd(); - - // // get the direction of the exe - // char* exe_path = get_exe_dir(); - // // switch to the exe directory for loading pre.slime - // change_cwd(exe_path); - - // defer { - // // switch back to the users directory - // change_cwd(cwd); - // free(cwd); - // free(exe_path); - // }; - - // struct Drawn_Area { - // int x; - // int y; - // int width; - // int height; - // }; - - // log_message(Log_Level::Info, "Drawing visualization..."); - - // defer { - // log_message(Log_Level::Info, "Done drawing visualization!"); - // }; - - // const int padding = 40; - // const int margin = 20; - - // const char* draw_text_template = " \n %s%s%s\n \n"; - // const char* draw_integer_template = " \n %d\n \n"; - // const char* draw_float_template = " \n %012.6f\n \n"; - - - // FILE *f = fopen("visualization.svg", "w"); - // if (!f) { - // create_generic_error("The file for writing the visualization " - // "could not be opened for writing"); - // return; - // } - // defer { - // fclose(f); - // }; - - // int max_x = 0, - // max_y = 0, - // write_x = 0, - // write_y = 0; - - - // proc draw_margin = [&](int count = 1) -> Drawn_Area { - // write_x += margin * count; - // return { - // write_x - margin * count, - // write_y, - // margin * count, - // write_y - // }; - // }; - // proc draw_new_line = [&](int count = 1) { - // write_x = 0; - // write_y += 25 * count; - // }; - // proc draw_text = [&](const char* text, const char* color = "#000000", bool draw_quotes = false, int max_length = 200) -> Drawn_Area { - // // take care of escaping sensitive chars - // int text_length = 0; - // int extra_needed_chars = draw_quotes ? 10 : 0; - // char* new_text = nullptr; - // char char_at_max_length = 0; - - // char source; - // while ((source = text[text_length++]) != '\0') { - // switch (source) { - // case '\n': - // extra_needed_chars += 1; - // case '<': - // case '>': - // extra_needed_chars += 3; - // break; - // case '&': - // extra_needed_chars += 4; - // break; - // case '\'': - // case '"': - // extra_needed_chars += 5; - // } - // } - // // last char was \0 but we don't count it - // --text_length; - - // if (text_length > max_length) { - // char_at_max_length = ((char*)text)[max_length]; - // ((char*)text)[max_length] = '\0'; - // text_length = max_length; - // } - // defer { - // if (char_at_max_length) - // ((char*)text)[max_length] = char_at_max_length; - // }; - - // // if we need to replace some chars - // if (extra_needed_chars > 0) { - // new_text = (char*)malloc((text_length + extra_needed_chars) * sizeof(char)); - - // int index_in_text = 0, - // index_in_new_text = 0; - - // char source; - // while ((source = text[index_in_text++]) != '\0') { - // switch (source) { - // case '\n': new_text[index_in_new_text++] = '\\'; new_text[index_in_new_text++] = 'n'; break; - // case '<': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'l'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; - // case '>': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'g'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; - // case '&': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'a'; new_text[index_in_new_text++] = 'm'; new_text[index_in_new_text++] = 'p'; new_text[index_in_new_text++] = ';'; break; - // case '"': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'q'; new_text[index_in_new_text++] = 'u'; new_text[index_in_new_text++] = 'o'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; - // case '\'': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'a'; new_text[index_in_new_text++] = 'p'; new_text[index_in_new_text++] = 'o'; new_text[index_in_new_text++] = 's'; new_text[index_in_new_text++] = ';'; break; - // default: new_text[index_in_new_text++] = source; - // } - // } - // new_text[index_in_new_text] = '\0'; - // } - - // int text_width = 12 * (text_length + (draw_quotes ? 2 : 0)); - // if (write_x + text_width > max_x) max_x = write_x + text_width; - // if (write_y + 12 > max_y) max_y = write_y + 12; - - // const char* quote = draw_quotes ? """ : ""; - // if (extra_needed_chars) { - // fprintf(f, draw_text_template, write_x, write_y+12, color, quote, new_text, quote); - // free(new_text); - // } else { - // fprintf(f, draw_text_template, write_x, write_y+12, color, quote, text, quote, color); - // } - - // // write_x += text_width; - - // return { - // write_x - text_width, - // write_y, - // text_width, - // 12 - // }; - // }; - // proc draw_integer = [&](int number) -> Drawn_Area { - // int text_width = 12 * ((int)log10(number)+1); - - // if (write_x + text_width > max_x) max_x = write_x + text_width; - // if (write_y > max_y) max_y = write_y; - - // fprintf(f, draw_integer_template, write_x, write_y+12, number); - - // return { - // write_x, - // write_y, - // text_width, - // 12 - // }; - // }; - // proc draw_float = [&](float number) -> Drawn_Area { - // int text_width = 12 * 12; - - // if (write_x + text_width > max_x) max_x = write_x + text_width; - // if (write_y > max_y) max_y = write_y; - - // fprintf(f, draw_float_template, write_x, write_y+12, number); - - // return { - // write_x, - // write_y, - // text_width, - // 12 - // }; - // }; - // std::function draw_pair; - // proc draw_lisp_object = [&](Lisp_Object* obj) -> Drawn_Area { - // switch (Memory::get_type(obj)) { - // case Lisp_Object_Type::T: return draw_text("t"); - // case Lisp_Object_Type::Nil: return draw_text("()"); - // case Lisp_Object_Type::Pair: return draw_pair(obj); - // case Lisp_Object_Type::Number: return draw_float((float)obj->value.number); - // case Lisp_Object_Type::Symbol: return draw_text(&obj->value.string->data); - // case Lisp_Object_Type::Keyword: { - // Drawn_Area colon = draw_text(":", "#c61b6e"); - // write_x += colon.width; - // Drawn_Area text = draw_text(&obj->value.symbol.identifier->data, "#c61b6e"); - // write_x -= colon.width; - // return { - // colon.x, - // colon.y, - // colon.width + text.width, - // colon.height - // }; - // } - // case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20); - // case Lisp_Object_Type::Function: return draw_text("Function", "#aa1100"); - // case Lisp_Object_Type::CFunction: return draw_text("CFunction", "#11aa00"); - // default: - // fprintf(stderr, "Do not know hot to visualize type %d\n", (int)Memory::get_type(obj)); - // return {0}; - // } - // }; - // draw_pair = [&](Lisp_Object* pair) -> Drawn_Area { - // Drawn_Area ret; - // Drawn_Area child; - - // ret.x = write_x; - // ret.y = write_y; - // ret.width = 100; - // ret.height = 100; - - // fprintf(f, - // " " - // " ", - // write_x, write_y, write_x+50, write_y, write_x+50, write_y+50); - - // // arrow to first - // fprintf(f, - // " ", - // write_x+25, write_y+25, write_x+25, write_y+100); - - // write_y += 110; - // child = draw_lisp_object(pair->value.pair.first); - // if (ret.width < child.width) - // ret.width = child.width; - // if (ret.height < child.height) - // ret.height = child.height; - - // write_y -= 110; - - // if (pair->value.pair.rest == Memory::nil) { - // fprintf(f, - // " ", - // write_x+50, write_y+50, write_x+100, write_y); - // } else { - // // arrow to rest - // int x_offset = 150; - // if (child.width+margin > x_offset) - // x_offset = child.width+margin; - - // fprintf(f, - // " ", - // write_x+75, write_y+25, write_x+75+x_offset, write_y+25); - - // write_x += x_offset; - // ret.width += 50; - - // child = draw_lisp_object(pair->value.pair.rest); - // ret.width += child.width; - // if (ret.height < 70 + child.height) - // ret.height = 70 + child.height; - - // write_x -= x_offset; - // } - - // fprintf(f, "\n"); - - // if (max_x < ret.x + ret.width) - // max_x = ret.x + ret.width; - // if (max_y < ret.y + ret.height) - // max_y = ret.y + ret.height; - - // return ret; - // }; - // proc draw_header = [&]() { - // proc draw_separator = [&]() { - // draw_margin(); - // draw_text("|"); - // draw_margin(); - // }; - - // time_t t = time(NULL); - // struct tm tm = *localtime(&t); - - // write_y = 12; - - // // ------------------- - // // Date - // // ------------------- - // char date[12]; - // snprintf(date, 12, "%02d.%02d.%d", tm.tm_mday, tm.tm_mon + 1, tm.tm_year + 1900); - - // write_x += draw_text("Date: ").width; - // write_x += draw_text(date).width; - - // draw_separator(); - - // // ------------------- - // // Time - // // ------------------- - // char time[12]; - // snprintf(time, 12, "%02d:%02d:%02d", tm.tm_hour, tm.tm_min, tm.tm_sec); - - // write_x += draw_text("Time: ").width; - // write_x += draw_text(time).width; - - // draw_separator(); - - // // ------------------- - // // String Memory - // // ------------------- - // draw_new_line(); - - // int free_string_memory = (int)(Memory::next_free_spot_in_string_memory - Memory::string_memory); - // for (int i = 0; i < Memory::free_spots_in_string_memory.next_index; ++i) { - // free_string_memory += ((String*)(Memory::free_spots_in_string_memory.data[i]))->length; - // } - // int used_string_memory = Memory::string_memory_size - free_string_memory; - - // write_x += draw_text("String Memory:").width; - // draw_margin(); - // write_x += draw_text("[allocated chars] ").width; - // write_x += draw_integer(Memory::string_memory_size).width; - // draw_margin(); - // write_x += draw_text("[free] ").width; - // write_x += draw_integer(free_string_memory).width; - // draw_margin(); - // write_x += draw_text("[used] ").width; - // write_x += draw_integer(used_string_memory).width; - // draw_margin(); - // write_x += draw_text("[%free] ").width; - // write_x += draw_float(100.0f * free_string_memory / Memory::string_memory_size).width; - // draw_margin(); - // write_x += draw_text("[%used] ").width; - // write_x += draw_float(100.0f * used_string_memory / Memory::string_memory_size).width; - - // draw_separator(); - // draw_new_line(); - - // // ------------------- - // // Object Memory - // // ------------------- - - // int free_object_memory_cells = Memory::object_memory_size - (Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory.next_index); - // int used_object_memory_cells = Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory.next_index; - - // write_x += draw_text("Object Memory:").width; - // draw_margin(); - // write_x += draw_text("[#allocated] ").width; - // write_x += draw_integer(Memory::object_memory_size).width; - // draw_margin(); - // write_x += draw_text("[#free] ").width; - // write_x += draw_integer(free_object_memory_cells).width; - // draw_margin(); - // write_x += draw_text("[#used] ").width; - // write_x += draw_integer(used_object_memory_cells).width; - // draw_margin(); - // write_x += draw_text("[%free] ").width; - // write_x += draw_float(100.0f * free_object_memory_cells / Memory::object_memory_size).width; - // draw_margin(); - // write_x += draw_text("[%used] ").width; - // write_x += draw_float(100.0f * used_object_memory_cells / Memory::object_memory_size).width; - - // draw_separator(); - - // draw_new_line(3); - // }; - // proc draw_symbols_keywords_and_numbers = [&]() { - // Array_List symbols; - // Array_List keywords; - // Array_List numbers; - // Array_List strings; - // Array_List pairs; - // Array_List lists; - - // // loop over all used memory - // for (int i = 0; i < Memory::next_index_in_object_memory; ++i) { - // for (int j = 0; j < Memory::free_spots_in_object_memory.next_index; ++j) { - // if (i == Memory::free_spots_in_object_memory.data[j]) - // goto next; - // } - - // switch (Memory::get_type(Memory::object_memory+i)) { - // case Lisp_Object_Type::Symbol: symbols .append(Memory::object_memory+i); break; - // case Lisp_Object_Type::String: strings .append(Memory::object_memory+i); break; - // case Lisp_Object_Type::Keyword: keywords.append(Memory::object_memory+i); break; - // case Lisp_Object_Type::Number : numbers .append(Memory::object_memory+i); break; - // case Lisp_Object_Type::Pair : pairs .append(Memory::object_memory+i); break; - // default: break; - // } - - // next: ; - // } - - // // create the lists-list by filtering the pairs-list. - // Array_List pairs_to_filter; - - // // helper lambda: - // proc remove_doubles_from_lisp_object_array_list = [&](Array_List list) -> void { - // if (list.next_index == 0) - // return; - - // list.sort(); - // Array_List indices_to_filter; - - // size_t last = (size_t)list.data[0]; - // for (int i = 1; i < list.next_index; ++i) { - // if ((size_t)list.data[i] == last) - // indices_to_filter.append(i); - // else - // last = (size_t)list.data[i]; - // } - - // for (int i = indices_to_filter.next_index; i >= 0; --i) { - // list.remove_index(indices_to_filter.data[i]); - // } - - // // sort again as removing items destroys the order - // list.sort(); - // }; - - // // recursive lambda - // std::function filter_pair_and_children; - // filter_pair_and_children = [&](Lisp_Object* pair) { - // pairs_to_filter.append(pair); - - // if (Memory::get_type(pair->value.pair.first) == Lisp_Object_Type::Pair) - // filter_pair_and_children(pair->value.pair.first); - - // if (Memory::get_type(pair->value.pair.rest) == Lisp_Object_Type::Pair) - // filter_pair_and_children(pair->value.pair.rest); - // }; - // for (int i = 0; i < pairs.next_index; ++i) { - // if (Memory::get_type(pairs.data[i]->value.pair.first) == Lisp_Object_Type::Pair) - // filter_pair_and_children(pairs.data[i]->value.pair.first); - - // if (Memory::get_type(pairs.data[i]->value.pair.rest) == Lisp_Object_Type::Pair) - // filter_pair_and_children(pairs.data[i]->value.pair.rest); - - // } - - // remove_doubles_from_lisp_object_array_list(pairs_to_filter); - // // fprintf(stderr, "removing %d pairs\n", pairs_to_filter->next_index); - // // okay, so pairs_to_filter now only the pairs once each that - // // we want to filter from the pairs list - // for (int i = 0; i < pairs.next_index; ++i) { - // if (pairs_to_filter.sorted_find(pairs.data[i]) == -1) { - // lists.append(pairs.data[i]); - // } - // } - - // draw_text("Memory Contents:"); - // draw_new_line(); - // draw_new_line(); - - // int start_x = write_x, - // start_y = write_y; - - // write_x += draw_text("Symbols: ").width; - // draw_integer(symbols.next_index); - // draw_new_line(); - // write_x = start_x; - - // for (int i = 0; i < symbols.next_index; ++i) { - // draw_new_line(); - // write_x = start_x; - - // draw_text(&symbols.data[i]->value.symbol.identifier->data); - // } - - - // write_x = start_x + 300; - // write_y = start_y; +namespace Slime { + proc visualize_lisp_machine() -> void { + + // // save the current working directory + // char* cwd = get_cwd(); + + // // get the direction of the exe + // char* exe_path = get_exe_dir(); + // // switch to the exe directory for loading pre.slime + // change_cwd(exe_path); + + // defer { + // // switch back to the users directory + // change_cwd(cwd); + // free(cwd); + // free(exe_path); + // }; + + // struct Drawn_Area { + // int x; + // int y; + // int width; + // int height; + // }; + + // log_message(Log_Level::Info, "Drawing visualization..."); + + // defer { + // log_message(Log_Level::Info, "Done drawing visualization!"); + // }; + + // const int padding = 40; + // const int margin = 20; + + // const char* draw_text_template = " \n %s%s%s\n \n"; + // const char* draw_integer_template = " \n %d\n \n"; + // const char* draw_float_template = " \n %012.6f\n \n"; + + + // FILE *f = fopen("visualization.svg", "w"); + // if (!f) { + // create_generic_error("The file for writing the visualization " + // "could not be opened for writing"); + // return; + // } + // defer { + // fclose(f); + // }; + + // int max_x = 0, + // max_y = 0, + // write_x = 0, + // write_y = 0; + + + // proc draw_margin = [&](int count = 1) -> Drawn_Area { + // write_x += margin * count; + // return { + // write_x - margin * count, + // write_y, + // margin * count, + // write_y + // }; + // }; + // proc draw_new_line = [&](int count = 1) { + // write_x = 0; + // write_y += 25 * count; + // }; + // proc draw_text = [&](const char* text, const char* color = "#000000", bool draw_quotes = false, int max_length = 200) -> Drawn_Area { + // // take care of escaping sensitive chars + // int text_length = 0; + // int extra_needed_chars = draw_quotes ? 10 : 0; + // char* new_text = nullptr; + // char char_at_max_length = 0; + + // char source; + // while ((source = text[text_length++]) != '\0') { + // switch (source) { + // case '\n': + // extra_needed_chars += 1; + // case '<': + // case '>': + // extra_needed_chars += 3; + // break; + // case '&': + // extra_needed_chars += 4; + // break; + // case '\'': + // case '"': + // extra_needed_chars += 5; + // } + // } + // // last char was \0 but we don't count it + // --text_length; + + // if (text_length > max_length) { + // char_at_max_length = ((char*)text)[max_length]; + // ((char*)text)[max_length] = '\0'; + // text_length = max_length; + // } + // defer { + // if (char_at_max_length) + // ((char*)text)[max_length] = char_at_max_length; + // }; + + // // if we need to replace some chars + // if (extra_needed_chars > 0) { + // new_text = (char*)malloc((text_length + extra_needed_chars) * sizeof(char)); + + // int index_in_text = 0, + // index_in_new_text = 0; + + // char source; + // while ((source = text[index_in_text++]) != '\0') { + // switch (source) { + // case '\n': new_text[index_in_new_text++] = '\\'; new_text[index_in_new_text++] = 'n'; break; + // case '<': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'l'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; + // case '>': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'g'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; + // case '&': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'a'; new_text[index_in_new_text++] = 'm'; new_text[index_in_new_text++] = 'p'; new_text[index_in_new_text++] = ';'; break; + // case '"': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'q'; new_text[index_in_new_text++] = 'u'; new_text[index_in_new_text++] = 'o'; new_text[index_in_new_text++] = 't'; new_text[index_in_new_text++] = ';'; break; + // case '\'': new_text[index_in_new_text++] = '&'; new_text[index_in_new_text++] = 'a'; new_text[index_in_new_text++] = 'p'; new_text[index_in_new_text++] = 'o'; new_text[index_in_new_text++] = 's'; new_text[index_in_new_text++] = ';'; break; + // default: new_text[index_in_new_text++] = source; + // } + // } + // new_text[index_in_new_text] = '\0'; + // } + + // int text_width = 12 * (text_length + (draw_quotes ? 2 : 0)); + // if (write_x + text_width > max_x) max_x = write_x + text_width; + // if (write_y + 12 > max_y) max_y = write_y + 12; + + // const char* quote = draw_quotes ? """ : ""; + // if (extra_needed_chars) { + // fprintf(f, draw_text_template, write_x, write_y+12, color, quote, new_text, quote); + // free(new_text); + // } else { + // fprintf(f, draw_text_template, write_x, write_y+12, color, quote, text, quote, color); + // } + + // // write_x += text_width; + + // return { + // write_x - text_width, + // write_y, + // text_width, + // 12 + // }; + // }; + // proc draw_integer = [&](int number) -> Drawn_Area { + // int text_width = 12 * ((int)log10(number)+1); + + // if (write_x + text_width > max_x) max_x = write_x + text_width; + // if (write_y > max_y) max_y = write_y; + + // fprintf(f, draw_integer_template, write_x, write_y+12, number); + + // return { + // write_x, + // write_y, + // text_width, + // 12 + // }; + // }; + // proc draw_float = [&](float number) -> Drawn_Area { + // int text_width = 12 * 12; + + // if (write_x + text_width > max_x) max_x = write_x + text_width; + // if (write_y > max_y) max_y = write_y; + + // fprintf(f, draw_float_template, write_x, write_y+12, number); + + // return { + // write_x, + // write_y, + // text_width, + // 12 + // }; + // }; + // std::function draw_pair; + // proc draw_lisp_object = [&](Lisp_Object* obj) -> Drawn_Area { + // switch (Memory::get_type(obj)) { + // case Lisp_Object_Type::T: return draw_text("t"); + // case Lisp_Object_Type::Nil: return draw_text("()"); + // case Lisp_Object_Type::Pair: return draw_pair(obj); + // case Lisp_Object_Type::Number: return draw_float((float)obj->value.number); + // case Lisp_Object_Type::Symbol: return draw_text(&obj->value.string->data); + // case Lisp_Object_Type::Keyword: { + // Drawn_Area colon = draw_text(":", "#c61b6e"); + // write_x += colon.width; + // Drawn_Area text = draw_text(&obj->value.symbol.identifier->data, "#c61b6e"); + // write_x -= colon.width; + // return { + // colon.x, + // colon.y, + // colon.width + text.width, + // colon.height + // }; + // } + // case Lisp_Object_Type::String: return draw_text(&obj->value.string->data, "#2aa198", true, 20); + // case Lisp_Object_Type::Function: return draw_text("Function", "#aa1100"); + // case Lisp_Object_Type::CFunction: return draw_text("CFunction", "#11aa00"); + // default: + // fprintf(stderr, "Do not know hot to visualize type %d\n", (int)Memory::get_type(obj)); + // return {0}; + // } + // }; + // draw_pair = [&](Lisp_Object* pair) -> Drawn_Area { + // Drawn_Area ret; + // Drawn_Area child; + + // ret.x = write_x; + // ret.y = write_y; + // ret.width = 100; + // ret.height = 100; + + // fprintf(f, + // " " + // " ", + // write_x, write_y, write_x+50, write_y, write_x+50, write_y+50); + + // // arrow to first + // fprintf(f, + // " ", + // write_x+25, write_y+25, write_x+25, write_y+100); + + // write_y += 110; + // child = draw_lisp_object(pair->value.pair.first); + // if (ret.width < child.width) + // ret.width = child.width; + // if (ret.height < child.height) + // ret.height = child.height; + + // write_y -= 110; + + // if (pair->value.pair.rest == Memory::nil) { + // fprintf(f, + // " ", + // write_x+50, write_y+50, write_x+100, write_y); + // } else { + // // arrow to rest + // int x_offset = 150; + // if (child.width+margin > x_offset) + // x_offset = child.width+margin; + + // fprintf(f, + // " ", + // write_x+75, write_y+25, write_x+75+x_offset, write_y+25); + + // write_x += x_offset; + // ret.width += 50; + + // child = draw_lisp_object(pair->value.pair.rest); + // ret.width += child.width; + // if (ret.height < 70 + child.height) + // ret.height = 70 + child.height; + + // write_x -= x_offset; + // } + + // fprintf(f, "\n"); + + // if (max_x < ret.x + ret.width) + // max_x = ret.x + ret.width; + // if (max_y < ret.y + ret.height) + // max_y = ret.y + ret.height; + + // return ret; + // }; + // proc draw_header = [&]() { + // proc draw_separator = [&]() { + // draw_margin(); + // draw_text("|"); + // draw_margin(); + // }; + + // time_t t = time(NULL); + // struct tm tm = *localtime(&t); + + // write_y = 12; + + // // ------------------- + // // Date + // // ------------------- + // char date[12]; + // snprintf(date, 12, "%02d.%02d.%d", tm.tm_mday, tm.tm_mon + 1, tm.tm_year + 1900); + + // write_x += draw_text("Date: ").width; + // write_x += draw_text(date).width; + + // draw_separator(); + + // // ------------------- + // // Time + // // ------------------- + // char time[12]; + // snprintf(time, 12, "%02d:%02d:%02d", tm.tm_hour, tm.tm_min, tm.tm_sec); + + // write_x += draw_text("Time: ").width; + // write_x += draw_text(time).width; + + // draw_separator(); + + // // ------------------- + // // String Memory + // // ------------------- + // draw_new_line(); + + // int free_string_memory = (int)(Memory::next_free_spot_in_string_memory - Memory::string_memory); + // for (int i = 0; i < Memory::free_spots_in_string_memory.next_index; ++i) { + // free_string_memory += ((String*)(Memory::free_spots_in_string_memory.data[i]))->length; + // } + // int used_string_memory = Memory::string_memory_size - free_string_memory; + + // write_x += draw_text("String Memory:").width; + // draw_margin(); + // write_x += draw_text("[allocated chars] ").width; + // write_x += draw_integer(Memory::string_memory_size).width; + // draw_margin(); + // write_x += draw_text("[free] ").width; + // write_x += draw_integer(free_string_memory).width; + // draw_margin(); + // write_x += draw_text("[used] ").width; + // write_x += draw_integer(used_string_memory).width; + // draw_margin(); + // write_x += draw_text("[%free] ").width; + // write_x += draw_float(100.0f * free_string_memory / Memory::string_memory_size).width; + // draw_margin(); + // write_x += draw_text("[%used] ").width; + // write_x += draw_float(100.0f * used_string_memory / Memory::string_memory_size).width; + + // draw_separator(); + // draw_new_line(); + + // // ------------------- + // // Object Memory + // // ------------------- + + // int free_object_memory_cells = Memory::object_memory_size - (Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory.next_index); + // int used_object_memory_cells = Memory::next_index_in_object_memory - Memory::free_spots_in_object_memory.next_index; + + // write_x += draw_text("Object Memory:").width; + // draw_margin(); + // write_x += draw_text("[#allocated] ").width; + // write_x += draw_integer(Memory::object_memory_size).width; + // draw_margin(); + // write_x += draw_text("[#free] ").width; + // write_x += draw_integer(free_object_memory_cells).width; + // draw_margin(); + // write_x += draw_text("[#used] ").width; + // write_x += draw_integer(used_object_memory_cells).width; + // draw_margin(); + // write_x += draw_text("[%free] ").width; + // write_x += draw_float(100.0f * free_object_memory_cells / Memory::object_memory_size).width; + // draw_margin(); + // write_x += draw_text("[%used] ").width; + // write_x += draw_float(100.0f * used_object_memory_cells / Memory::object_memory_size).width; + + // draw_separator(); + + // draw_new_line(3); + // }; + // proc draw_symbols_keywords_and_numbers = [&]() { + // Array_List symbols; + // Array_List keywords; + // Array_List numbers; + // Array_List strings; + // Array_List pairs; + // Array_List lists; + + // // loop over all used memory + // for (int i = 0; i < Memory::next_index_in_object_memory; ++i) { + // for (int j = 0; j < Memory::free_spots_in_object_memory.next_index; ++j) { + // if (i == Memory::free_spots_in_object_memory.data[j]) + // goto next; + // } + + // switch (Memory::get_type(Memory::object_memory+i)) { + // case Lisp_Object_Type::Symbol: symbols .append(Memory::object_memory+i); break; + // case Lisp_Object_Type::String: strings .append(Memory::object_memory+i); break; + // case Lisp_Object_Type::Keyword: keywords.append(Memory::object_memory+i); break; + // case Lisp_Object_Type::Number : numbers .append(Memory::object_memory+i); break; + // case Lisp_Object_Type::Pair : pairs .append(Memory::object_memory+i); break; + // default: break; + // } + + // next: ; + // } + + // // create the lists-list by filtering the pairs-list. + // Array_List pairs_to_filter; + + // // helper lambda: + // proc remove_doubles_from_lisp_object_array_list = [&](Array_List list) -> void { + // if (list.next_index == 0) + // return; + + // list.sort(); + // Array_List indices_to_filter; + + // size_t last = (size_t)list.data[0]; + // for (int i = 1; i < list.next_index; ++i) { + // if ((size_t)list.data[i] == last) + // indices_to_filter.append(i); + // else + // last = (size_t)list.data[i]; + // } + + // for (int i = indices_to_filter.next_index; i >= 0; --i) { + // list.remove_index(indices_to_filter.data[i]); + // } + + // // sort again as removing items destroys the order + // list.sort(); + // }; + + // // recursive lambda + // std::function filter_pair_and_children; + // filter_pair_and_children = [&](Lisp_Object* pair) { + // pairs_to_filter.append(pair); + + // if (Memory::get_type(pair->value.pair.first) == Lisp_Object_Type::Pair) + // filter_pair_and_children(pair->value.pair.first); + + // if (Memory::get_type(pair->value.pair.rest) == Lisp_Object_Type::Pair) + // filter_pair_and_children(pair->value.pair.rest); + // }; + // for (int i = 0; i < pairs.next_index; ++i) { + // if (Memory::get_type(pairs.data[i]->value.pair.first) == Lisp_Object_Type::Pair) + // filter_pair_and_children(pairs.data[i]->value.pair.first); + + // if (Memory::get_type(pairs.data[i]->value.pair.rest) == Lisp_Object_Type::Pair) + // filter_pair_and_children(pairs.data[i]->value.pair.rest); + + // } + + // remove_doubles_from_lisp_object_array_list(pairs_to_filter); + // // fprintf(stderr, "removing %d pairs\n", pairs_to_filter->next_index); + // // okay, so pairs_to_filter now only the pairs once each that + // // we want to filter from the pairs list + // for (int i = 0; i < pairs.next_index; ++i) { + // if (pairs_to_filter.sorted_find(pairs.data[i]) == -1) { + // lists.append(pairs.data[i]); + // } + // } + + // draw_text("Memory Contents:"); + // draw_new_line(); + // draw_new_line(); + + // int start_x = write_x, + // start_y = write_y; + + // write_x += draw_text("Symbols: ").width; + // draw_integer(symbols.next_index); + // draw_new_line(); + // write_x = start_x; + + // for (int i = 0; i < symbols.next_index; ++i) { + // draw_new_line(); + // write_x = start_x; + + // draw_text(&symbols.data[i]->value.symbol.identifier->data); + // } + + + // write_x = start_x + 300; + // write_y = start_y; - // write_x += draw_text("Keywords: ").width; - // draw_integer(keywords.next_index); - // draw_new_line(); - // write_x = start_x + 300; + // write_x += draw_text("Keywords: ").width; + // draw_integer(keywords.next_index); + // draw_new_line(); + // write_x = start_x + 300; - // for (int i = 0; i < keywords.next_index; ++i) { - // draw_new_line(); - // write_x = start_x + 300; + // for (int i = 0; i < keywords.next_index; ++i) { + // draw_new_line(); + // write_x = start_x + 300; - // draw_lisp_object(keywords.data[i]); - // } + // draw_lisp_object(keywords.data[i]); + // } - // write_x = start_x + 600; - // write_y = start_y; + // write_x = start_x + 600; + // write_y = start_y; - // write_x += draw_text("Numbers: ").width; - // draw_integer(numbers.next_index); - // draw_new_line(); - // write_x = start_x + 600; + // write_x += draw_text("Numbers: ").width; + // draw_integer(numbers.next_index); + // draw_new_line(); + // write_x = start_x + 600; // for (int i = 0; i < numbers.next_index; ++i) { - // draw_new_line(); - // write_x = start_x + 600; + // draw_new_line(); + // write_x = start_x + 600; - // draw_float((float)(numbers.data[i]->value.number)); + // draw_float((float)(numbers.data[i]->value.number)); // } // write_x = start_x + 900; @@ -503,10 +504,10 @@ proc visualize_lisp_machine() -> void { // write_x = start_x + 900; // for (int i = 0; i < strings.next_index; ++i) { - // draw_new_line(); - // write_x = start_x + 900; + // draw_new_line(); + // write_x = start_x + 900; - // draw_text(&strings.data[i]->value.string->data, "#2aa198", true, 75); + // draw_text(&strings.data[i]->value.string->data, "#2aa198", true, 75); // } @@ -521,34 +522,35 @@ proc visualize_lisp_machine() -> void { // write_x = start_x + 2000; // for (int i = 0; i < lists.next_index; ++i) { - // draw_new_line(3); - // write_x = start_x + 2000; + // draw_new_line(3); + // write_x = start_x + 2000; - // write_y += draw_pair(lists.data[i]).height; + // write_y += draw_pair(lists.data[i]).height; // } - // }; + // }; - // fprintf(f, - // "\n" - // "\n\n", -padding, -padding, 0, 0); + // fprintf(f, + // "\n" + // "\n\n", -padding, -padding, 0, 0); - // draw_header(); - // draw_symbols_keywords_and_numbers(); - // draw_text("DoEun", "#00aaaa", true); + // draw_header(); + // draw_symbols_keywords_and_numbers(); + // draw_text("DoEun", "#00aaaa", true); - // fprintf(f, "\n\n"); + // fprintf(f, "\n\n"); - // // fill in the correct viewBox - // rewind(f); + // // fill in the correct viewBox + // rewind(f); - // fprintf(f, - // "\n" - // "", -padding, -padding, max_x + 2*padding, max_y + 2*padding); + // fprintf(f, + // "\n" + // "", -padding, -padding, max_x + 2*padding, max_y + 2*padding); + } }