namespace Slime { proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { if (n1 == n2) return true; if (n1->type != n2->type) return false; switch (n1->type) { case Lisp_Object_Type::T: case Lisp_Object_Type::Nil: case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Function: // QUESTION(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: { auto n1_keys = n1->value.hashMap->get_all_keys(); auto n2_keys = n2->value.hashMap->get_all_keys(); defer { n1_keys.dealloc(); n2_keys.dealloc(); }; if (n1_keys.next_index != n2_keys.next_index) return false; n1_keys.sort(); n2_keys.sort(); for (u32 i = 0; i < n1_keys.next_index; ++i) { if (!lisp_object_equal(n1_keys[i], n2_keys[i])) return false; if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]), n2->value.hashMap->get_object(n2_keys[i]))) return false; } return true; } case Lisp_Object_Type::Vector: { if (n1->value.vector.length != n2->value.vector.length ) return false; for (u32 i = 0; i < n1->value.vector.length; ++i) { if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i)) return false; } return true; } break; default: create_not_yet_implemented_error(); } // we should never reach here return false; } proc add_to_load_path(const path_char* path) -> void { using Globals::load_path; load_path.append((path_char*)path); } proc built_in_load(String file_name) -> Lisp_Object* { profile_with_comment(file_name.data); char* file_content; path_char fullpath[MAX_PATH]; #ifdef UNICODE path_char* temp = char_to_path_char(Memory::get_c_str(file_name)); swprintf(fullpath, MAX_PATH,L"%s", temp); file_content = read_entire_file(temp); free(temp); #else sprintf(fullpath, "%s", Memory::get_c_str(file_name)); file_content = read_entire_file(Memory::get_c_str(file_name)); #endif if (!file_content) { for (auto it: Globals::load_path) { #ifdef UNICODE fullpath[0] = L'\0'; path_char* temp = char_to_path_char(Memory::get_c_str(file_name)); swprintf(fullpath, MAX_PATH, L"%s%s", it, temp); free(temp); #else fullpath[0] = '\0'; sprintf(fullpath, "%s%s", it, Memory::get_c_str(file_name)); #endif 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; } } Lisp_Object* result = Memory::nil; Array_List* program; #ifdef UNICODE char* temp_c = path_char_to_char(fullpath); String spath = Memory::create_string(temp_c); free(temp_c); #else String spath = Memory::create_string(fullpath); #endif defer { free(spath.data); }; try program = Parser::parse_program(spath, file_content); // NOTE(Felix): deferred so even if the eval failes, it will // run defer { program->dealloc(); free(program); free(file_content); }; for (auto expr : *program) { try result = eval_expr(expr); } return result; } proc built_in_import(String file_name) -> Lisp_Object* { profile_this(); Environment* new_env; try assert("You cannot use import inside of the root-env (parent cycle)", get_root_environment() != get_current_environment()); 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); } 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__); defer_free(file_name_built_ins.data); define_macro((call/cc fun), "TODO") { profile_with_name("(call/cc)"); using Globals::Current_Execution; Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index]; try_void assert_list_length(args, 1); Lisp_Object* fun = args->value.pair.first; // 2. push cont on the stack and call, the fun is already // there Current_Execution.ats.append([] { try_void assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1] , Lisp_Object_Type::Function); Lisp_Object* cont = Memory::create_lisp_object_continuation(); Current_Execution.ams.append(Current_Execution.cs.next_index-1); Current_Execution.pcs.append(Memory::nil); --cont->value.continuation->cs.next_index; Current_Execution.cs.append(cont); (Current_Execution.nass.end()-1)->append(NasAction::Step); }); (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action); // 1. resolve the function Current_Execution.cs.append(fun); (Current_Execution.nass.end()-1)->append(NasAction::Eval); }; define_macro((set! sym val), "TODO") { // NOTE(Felix): This COULD be a define_special in theory, // but because of call/cc, it cannot be anymore because // the define_symbol would not be a part of the // continuation. This happens for example in: /** (set! res (+ 2 (call/cc (lambda (cont) (set! add-5 cont) 1)) 3)) */ // So if 'set! WAS a define_special, then the param would // not be evaluated, but the whole call gets removed from // the stack, and in the body of 'set!, the 'val would be // recursively evaluated, and the 'call/cc would not see // the variable definition as part of the continuation. So // what we do istead, is writing 'set! as a macro and have // the variable definition as a and_then_action, so that // it is part of the continuation. profile_with_name("(set!)"); using Globals::Current_Execution; Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index]; try_void assert_list_length(args, 2); Lisp_Object* sym = args->value.pair.first; Lisp_Object* val = args->value.pair.rest->value.pair.first; try_void assert_type(sym, Lisp_Object_Type::Symbol); // 2. find the binding and rebind Current_Execution.cs.append(sym); Current_Execution.ats.append([] { using Globals::Current_Execution; Lisp_Object* val = Current_Execution.cs.data[--Current_Execution.cs.next_index]; Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1]; Environment* target_env = find_binding_environment(sym, get_current_environment()); if (!target_env) target_env = get_root_environment(); define_symbol(sym, val, target_env); }); (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action); // 1. eval the val Current_Execution.cs.append(val); (Current_Execution.nass.end()-1)->append(NasAction::Eval); }; define_macro((apply fun fun_args), "TODO") { // NOTE(Felix): is has to be a macro because apply by // itself cannot return the result, we have to invoke eval // and to prevent recursion, apply is a macro profile_with_name("(apply)"); using Globals::Current_Execution; Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index]; try_void assert_list_length(args, 2); Lisp_Object* fun = args->value.pair.first; Lisp_Object* fun_args = args->value.pair.rest->value.pair.first; // 3. push args on the stack and apply Current_Execution.ats.append([] { // BUG(Felix): we are not pushing on the ams, are we // doing it wrong? // Current_Execution.ams.append(Current_Execution.cs.next_index-2); Lisp_Object* args_as_list = Current_Execution.cs[--Current_Execution.cs.next_index]; for_lisp_list (args_as_list) { Current_Execution.cs.append(it); } Current_Execution.pcs.append(Memory::nil); (Current_Execution.nass.end()-1)->append(NasAction::Step); }); (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action); // 2. Eval fun_args and keep them on the stack Current_Execution.ats.append([] { // NOTE(Felix): Flip the top 2 elements on cs because // top is now the evaluated function, and below is the unevaluated args Lisp_Object* tmp = Current_Execution.cs[Current_Execution.cs.next_index-1]; Current_Execution.cs[Current_Execution.cs.next_index-1] = Current_Execution.cs[Current_Execution.cs.next_index-2]; Current_Execution.cs[Current_Execution.cs.next_index-2] = tmp; (Current_Execution.nass.end()-1)->append(NasAction::Eval); }); (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action); // 1. Eval function and keep it on the stack, below it // store the unevaluated argument list Current_Execution.ams.append(Current_Execution.cs.next_index); Current_Execution.cs.append(fun_args); Current_Execution.cs.append(fun); (Current_Execution.nass.end()-1)->append(NasAction::Eval); }; define((get-counter), "When called returns a procedure that represents\n" "a counter. Each time it is called it returns the\n" "next whole number.") { define_symbol( Memory::get_symbol("c"), Memory::create_lisp_object((f64)0)); String file_name_built_ins = Memory::create_string(__FILE__); define((lambda), "") { fetch(c); c->value.number++; return c; }; fetch(lambda); return lambda; }; define_macro((eval expr), "Takes one argument, and evaluates it two times.") { profile_with_name("(eval)"); using Globals::Current_Execution; // we know cs.data[cs.next_index] is allocated because the // macro cal lwas there just before Current_Execution.cs.data[Current_Execution.cs.next_index++] = Current_Execution.pcs[--Current_Execution.pcs.next_index]->value.pair.first; (Current_Execution.nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Eval); }; define_macro((begin . rest), "Takes any number of forms. Evaluates them in order, " "and returns the last result.") { profile_with_name("(begin)"); using Globals::Current_Execution; Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index]; u32 length = list_length(args); Current_Execution.cs.reserve(length); for_lisp_list(args) { Current_Execution.cs.data[Current_Execution.cs.next_index - 1 + (length - it_index)] = it; (Current_Execution.nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::Pop); } --(Current_Execution.nass.end()-1)->next_index; Current_Execution.cs.next_index += length; }; define_macro((if test then_part else_part), "Takes 3 arguments. If the first arguments evaluates to a truthy " "value, the if expression evaluates the second argument, else " "it will evaluete the third one and return them respectively.") { profile_with_name("(if)"); using Globals::Current_Execution; /* | | | | | | -> | | | | | | | .... | | ...... | */ Lisp_Object* args = Current_Execution.pcs.data[--Current_Execution.pcs.next_index]; Lisp_Object* test = args->value.pair.first; args = args->value.pair.rest; try_void assert_type(args, Lisp_Object_Type::Pair); Lisp_Object* consequence = args->value.pair.first; args = args->value.pair.rest; try_void assert_type(args, Lisp_Object_Type::Pair); Lisp_Object* alternative = args->value.pair.first; args = args->value.pair.rest; try_void assert_type(args, Lisp_Object_Type::Nil); Current_Execution.cs.append(alternative); Current_Execution.cs.append(consequence); Current_Execution.cs.append(test); (Current_Execution.nass.end()-1)->append(NasAction::Eval); (Current_Execution.nass.end()-1)->append(NasAction::If); (Current_Execution.nass.end()-1)->append(NasAction::Eval); }; define_macro((define definee . args), "") { // NOTE(Felix): define has to be a macro, because we need // to evaluate the value for definee in case it is a // simple variable (not a function). So ebcause we don't // want to recursivly evaluate the value, we use a macro // and a NasAction. profile_with_name("(define)"); using Globals::Current_Execution; Lisp_Object* form = Current_Execution.pcs.data[--Current_Execution.pcs.next_index]; Lisp_Object* definee = form->value.pair.first; form = form->value.pair.rest; if (definee->type == Lisp_Object_Type::Symbol) { try_void assert_type(form, Lisp_Object_Type::Pair); } Lisp_Object* thing = form->value.pair.first; Lisp_Object* thing_cons = form; form = form->value.pair.rest; Lisp_Object_Type type = definee->type; switch (type) { case Lisp_Object_Type::Symbol: { if (form != Memory::nil) { Lisp_Object* doc = thing; try_void assert_type(doc, Lisp_Object_Type::String); try_void assert_type(form, Lisp_Object_Type::Pair); thing = form->value.pair.first; try_void assert("list must end here.", form->value.pair.rest == Memory::nil); // TODO docs (maybe with hooks) we have to attach // the docs to the result of evaluating } Current_Execution.cs.append(definee); Current_Execution.cs.append(thing); (Current_Execution.nass.end()-1)->append(NasAction::Define_Var); (Current_Execution.nass.end()-1)->append(NasAction::Eval); } break; case Lisp_Object_Type::Pair: { try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); Lisp_Object* func; try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); func->value.function->parent_environment = get_current_environment(); create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); if (thing_cons->type == Lisp_Object_Type::Pair && // if there is stuff in the function body thing_cons->value.pair.first->type == Lisp_Object_Type::String && // if the first is a string thing_cons->value.pair.rest != Memory::nil // if it is not the last ) { // we found docs Globals::docs.set_object( func, Memory::duplicate_string( thing_cons->value.pair.first->value.string).data); thing_cons = thing_cons->value.pair.rest; } func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons); define_symbol(definee->value.pair.first, func); Current_Execution.cs.append(definee->value.pair.first); } break; default: { create_generic_error("you can only define symbols"); return; } } }; define((helper), "") { profile_with_name("(helper)"); return Memory::create_lisp_object(101.0); }; define((enable-debug-log), "") { profile_with_name("(enable-debug-log)"); Globals::debug_log = true; return Memory::t; }; define((disable-debug-log), "") { profile_with_name("(disable-debug-log)"); Globals::debug_log = false; return Memory::t; }; define_special((with-debug-log . rest), "") { profile_with_name("(enable-debug-log)"); fetch(rest); Lisp_Object* result = Memory::nil; Globals::debug_log = true; in_caller_env { for_lisp_list(rest) { // TODO(Felix): hooky would be really nice to // have. Then this would be a macro and we would // reset the debug log try result = eval_expr(it); } } Globals::debug_log = false; return result; }; 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); f64 last_number = strtod("Inf", 0); 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); f64 last_number = strtod("Inf", 0); 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); f64 last_number = strtod("-Inf", 0); 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); f64 last_number = strtod("-Inf", 0); 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); f64 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); f64 difference = args->value.pair.first->value.number; if (args->value.pair.rest == Memory::nil) { return Memory::create_lisp_object(-difference); } for_lisp_list (args->value.pair.rest) { try assert_type(it, Lisp_Object_Type::Number); difference -= it->value.number; } return Memory::create_lisp_object(difference); }; define((* . args), "TODO") { profile_with_name("(*)"); fetch(args); if (args == Memory::nil) { return Memory::create_lisp_object(1); } f64 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") { 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); f64 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((s32)a->value.number % (s32)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); f64 fa = a->value.number; f64 fb = b->value.number; f64 x = (f64)rand()/(f64)(RAND_MAX); x *= (fb - fa); x += fa; return Memory::create_lisp_object(x); }; define((gensym), "TODO") { profile_with_name("(gensym)"); Lisp_Object* node; try node = Memory::create_lisp_object(); node->type = Lisp_Object_Type::Symbol; node->value.symbol = Memory::create_string("gensym"); return node; }; 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_special((assert test), "TODO") { profile_with_name("(assert)"); fetch(test); // TODO(Felix): it's probably cleaner to have assert be a // macro + and_then_action to check for error. This is // also cool so we don't see an anditoinal recursive call // in the profiler in_caller_env { Lisp_Object* res; try res = eval_expr(test); if (is_truthy(res)) return Memory::t; } char* string = lisp_object_to_string(test, true); create_generic_error("Userland assertion. (%s)", string); free(string); return nullptr; }; define_special((define-macro form . body), "TODO") { profile_with_name("(define-macro)"); fetch(form, body); // TODO(Felix): Macros cannot have docs now if (form->type != 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(Lisp_Function_Type::Macro); 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.lisp_body = maybe_wrap_body_in_begin(body); define_symbol(symbol, func); } return Memory::nil; }; define((mutate! target source), "TODO") { profile_with_name("(mutate!)"); fetch(target, source); if (target == Memory::nil || target == Memory::t || target->type == Lisp_Object_Type::Keyword || target->type == 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 || source->type == Lisp_Object_Type::Keyword || source->type == 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((f64)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); s32 int_idx = ((s32)idx->value.number); try assert("vector access index must be >= 0", int_idx >= 0); try assert("vector access index must be < length", (u32)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); s32 int_idx = ((s32)idx->value.number); try assert("vector access index must be >= 0", int_idx >= 0); try assert("vector access index must be < length", (u32)int_idx < vec->value.vector.length); vec->value.vector.data[int_idx] = *val; 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((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 (expr->type != 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 (head->type == Lisp_Object_Type::Pair) { // if it is ,@ we have to actually do more work // and inline the result if (head->value.pair.first->type == 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((not test), "TODO") { profile_with_name("(not)"); fetch(test); return is_truthy(test) ? 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(Lisp_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.lisp_body = maybe_wrap_body_in_begin(body); return func; }; 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; u32 length = list_length(args); try ret = Memory::create_lisp_object_vector(length, args); return ret; }; define((cons car cdr), "TODO") { profile_with_name("(cons)"); fetch(car, cdr); Lisp_Object* ret; try ret = Memory::create_lisp_object_pair(car, cdr); return ret; }; define((car seq), "TODO") { profile_with_name("(car)"); fetch(seq); if (seq == Memory::nil) return Memory::nil; try assert_type(seq, Lisp_Object_Type::Pair); return seq->value.pair.first; }; define((cdr seq), "TODO") { profile_with_name("(cdr)"); 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); Globals::user_types.set_object(node, new_type); return node; }; define((delete-type! n), "TODO") { profile_with_name("(delete-type!)"); fetch(n); Globals::user_types.delete_object(n); return Memory::t; }; define((type n), "TODO") { profile_with_name("(type)"); fetch(n); if (Globals::user_types.key_exists(n)) { return (Lisp_Object*)Globals::user_types.get_object(n); } Lisp_Object_Type type = n->type; switch (type) { case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation"); case Lisp_Object_Type::Function: { Function* fun = n->value.function; if (fun->is_c) { switch (fun->type.c_function_type) { case C_Function_Type::cMacro: return Memory::get_keyword("cMacro"); case C_Function_Type::cFunction: return Memory::get_keyword("cFunction"); case C_Function_Type::cSpecial: return Memory::get_keyword("cSpecial"); default: return Memory::get_keyword("c??"); } } else { switch (fun->type.lisp_function_type) { case Lisp_Function_Type::Lambda: return Memory::get_keyword("lambda"); case Lisp_Function_Type::Macro: return Memory::get_keyword("macro"); default: return Memory::get_keyword("??"); } } } 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"); case(Lisp_Object_Type::Invalid_Garbage_Collected): return Memory::get_keyword("Invalid: Garbage Collected"); case(Lisp_Object_Type::Invalid_Under_Construction): return Memory::get_keyword("Invalid: Under Construction"); } return Memory::get_keyword("unknown"); }; define_special((info n), "TODO") { // 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 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(val->type)); printf("\nand is printed as: "); print(val); printf("\n\ndocs:\n=====\n %s\n\n", (Globals::docs.get_object(val)) ? Globals::docs.get_object(val) : "No docs avaliable"); if (val->type == Lisp_Object_Type::Function) { Arguments* args = &val->value.function->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 (u32 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 (u32 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); try assert("c-functoins cannot be shown", !n->value.function->is_c); puts("body:\n"); print(n->value.function->body.lisp_body); puts("\n"); printf("parent_env: %p\n", 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(&var); }; define((generate-docs-file file_name), "TODO") { profile_with_name("(generate-docs-file)"); 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") (:repr ()) . things), "TODO") { profile_with_name("(print)"); fetch(sep, end, repr, things); if (things != Memory::nil) { bool print_repr = (repr != Memory::nil); print(things->value.pair.first, print_repr); for_lisp_list(things->value.pair.rest) { print(sep); print(it, print_repr); } } 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((s32)code->value.number); }; define((show-environment), "TODO") { profile_with_name("(show-environment)"); 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((attempt try_part catch_part), "TODO") { profile_with_name("(attempt)"); 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); 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((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((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((concat-strings . strings), "TODO") { profile_with_name("(concat-strings)"); fetch(strings); u32 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); u32 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; } }