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: // 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: { 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 (int 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 (int 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 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; } } Lisp_Object* result = Memory::nil; Array_List* program; String spath = Memory::create_string(fullpath); 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; 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((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") { return Memory::nil; }; define((remove_when_double_free_is_fixed_2 (:k1 ()) (:k2 ()) . rest), "") { return Memory::nil; }; 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 namespace Globals::Current_Execution; --cs.next_index; --ams.next_index; Lisp_Object* args = pcs[--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 ats.append([] { Lisp_Object* args_as_list = cs[--cs.next_index]; for_lisp_list (args_as_list) { cs.append(it); } pcs.append(Memory::nil); (nass.end()-1)->append(NasAction::Step); }); (nass.end()-1)->append(NasAction::And_Then_Action); // 2. Eval fun_args and keep them on the stack 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 = cs[cs.next_index-1]; cs[cs.next_index-1] = cs[cs.next_index-2]; cs[cs.next_index-2] = tmp; (nass.end()-1)->append(NasAction::Eval); }); (nass.end()-1)->append(NasAction::And_Then_Action); // 1. Eval function and keep it on the stack, below it // store the unevaluated argument list ams.append(cs.next_index); cs.append(fun_args); cs.append(fun); (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((double)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 namespace Globals::Current_Execution; cs.data[cs.next_index-1] = pcs[--pcs.next_index]->value.pair.first; (nass.end()-1)->append(NasAction::Eval); (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 namespace Globals::Current_Execution; --cs.next_index; --ams.next_index; Lisp_Object* args = pcs[--pcs.next_index]; int length = list_length(args); cs.reserve(length); for_lisp_list(args) { cs.data[cs.next_index - 1 + (length - it_index)] = it; (nass.end()-1)->append(NasAction::Eval); (nass.end()-1)->append(NasAction::Pop); } --(nass.end()-1)->next_index; 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 namespace Globals::Current_Execution; /* | | | | | | -> | | | | | | | .... | | ...... | */ --ams.next_index; Lisp_Object* args = pcs.data[--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); --cs.next_index; cs.append(alternative); cs.append(consequence); cs.append(test); (nass.end()-1)->append(NasAction::Eval); (nass.end()-1)->append(NasAction::If); (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 namespace Globals::Current_Execution; --cs.next_index; --ams.next_index; Lisp_Object* form = pcs.data[--pcs.next_index]; Lisp_Object* definee = form->value.pair.first; form = form->value.pair.rest; 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 } cs.append(definee); cs.append(thing); (nass.end()-1)->append(NasAction::Define_Var); (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->value.pair.first->type == Lisp_Object_Type::String && thing_cons->value.pair.rest != Memory::nil) { // extract 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); cs.append(Memory::t); } 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; 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); 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 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); } 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") { 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((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); 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-syntax form . body), "TODO") { profile_with_name("(define-syntax)"); 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((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("vector access index must be >= 0", int_idx >= 0); try assert("vector access index must be < length", 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("vector access index must be >= 0", int_idx >= 0); try assert("vector access index must be < length", 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((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; 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); // TODO(Felix): Enable again when we have user types again: // node->userType = new_type; return node; }; define((delete-type! n), "TODO") { profile_with_name("(delete-type!)"); fetch(n); // TODO(Felix): Enable again when we have user types again: // n->userType = nullptr; return Memory::t; }; define((type n), "TODO") { profile_with_name("(type)"); fetch(n); // TODO(Felix): Enable again when we have user types again: // if (n->userType) { // return n->userType; // } 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((mem-reset), "TODO") { // profile_with_name("(mem-reset)"); // Memory::reset(); // return Memory::nil; // }; 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 (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); 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_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") (: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, repr); for_lisp_list(things->value.pair.rest) { print(sep); print(it, 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((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; } }