| @@ -12,7 +12,6 @@ namespace Slime { | |||
| 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? | |||
| @@ -347,7 +346,7 @@ namespace Slime { | |||
| // creating new lisp object and setting type | |||
| Lisp_Object* func; | |||
| try func = Memory::create_lisp_object_function(Function_Type::Macro); | |||
| try func = Memory::create_lisp_object_function(Lisp_Function_Type::Macro); | |||
| // Lisp_Object* func; | |||
| // try func = Memory::create_lisp_object(); | |||
| @@ -359,7 +358,7 @@ namespace Slime { | |||
| // 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); | |||
| func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body); | |||
| define_symbol(symbol, func); | |||
| } | |||
| return Memory::nil; | |||
| @@ -398,7 +397,7 @@ namespace Slime { | |||
| // creating new lisp object and setting type | |||
| Lisp_Object* func; | |||
| try func = Memory::create_lisp_object_function(Function_Type::Lambda); | |||
| try func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda); | |||
| if (doc) | |||
| func->docstring = doc->value.string; | |||
| @@ -407,7 +406,7 @@ namespace Slime { | |||
| // 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); | |||
| func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body); | |||
| define_symbol(symbol, func); | |||
| } | |||
| @@ -705,14 +704,14 @@ namespace Slime { | |||
| // creating new lisp object and setting type | |||
| Lisp_Object* func; | |||
| try func = Memory::create_lisp_object_function(Function_Type::Lambda); | |||
| 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 = maybe_wrap_body_in_begin(body); | |||
| func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body); | |||
| return func; | |||
| }; | |||
| define((apply fun args), "TODO") { | |||
| @@ -846,16 +845,22 @@ namespace Slime { | |||
| 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"); | |||
| 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"); | |||
| @@ -903,14 +908,10 @@ namespace Slime { | |||
| ? 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) | |||
| if (Memory::get_type(val) == Lisp_Object_Type::Function) | |||
| { | |||
| Arguments* args; | |||
| if (Memory::get_type(val) == Lisp_Object_Type::Function) | |||
| args = &val->value.function->args; | |||
| else | |||
| args = &val->value.cFunction->args; | |||
| Arguments* args = &val->value.function->args; | |||
| printf("Arguments:\n==========\n"); | |||
| printf("Postitional: {"); | |||
| @@ -956,9 +957,9 @@ namespace Slime { | |||
| profile_with_name("(show)"); | |||
| fetch(n); | |||
| try assert_type(n, Lisp_Object_Type::Function); | |||
| try assert(n->value.function->is_c); | |||
| puts("body:\n"); | |||
| print(n->value.function->body); | |||
| print(n->value.function->body.lisp_body); | |||
| puts("\n"); | |||
| printf("parent_env: %lld\n", | |||
| (long long)n->value.function->parent_environment); | |||
| @@ -108,7 +108,7 @@ | |||
| // mutable for the parser to work, because the parser relys on being | |||
| // able to temporaily put in markers in the code and also it will fill | |||
| // out the source code location | |||
| #define _define_helper(def, docs, special) \ | |||
| #define _define_helper(def, docs, type) \ | |||
| Parser::parser_file = file_name_built_ins; \ | |||
| Parser::parser_line = __LINE__; \ | |||
| Parser::parser_col = 0; \ | |||
| @@ -118,15 +118,17 @@ | |||
| assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ | |||
| assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ | |||
| auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \ | |||
| auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \ | |||
| auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(type); \ | |||
| create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ | |||
| if_error_log_location_and_return(nullptr); \ | |||
| label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ | |||
| label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \ | |||
| define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ | |||
| label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object* | |||
| label(sfun,__LINE__)->value.function->body.c_body = []() -> Lisp_Object* | |||
| #define define(def, docs) _define_helper(def, docs, false) | |||
| #define define_special(def, docs) _define_helper(def, docs, true) | |||
| #define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction) | |||
| #define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro) | |||
| #define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial) | |||
| #define in_caller_env fluid_let( \ | |||
| Globals::Current_Execution::envi_stack.next_index, \ | |||
| Globals::Current_Execution::envi_stack.next_index-1) | |||
| @@ -83,13 +83,9 @@ namespace Slime { | |||
| /* | |||
| * if function then print arguments | |||
| */ | |||
| if (type == Lisp_Object_Type::Function || | |||
| type == Lisp_Object_Type::CFunction) | |||
| if (type == Lisp_Object_Type::Function) | |||
| { | |||
| Arguments* args = | |||
| (type == Lisp_Object_Type::Function) | |||
| ? &value->value.function->args | |||
| : &value->value.cFunction->args; | |||
| Arguments* args = &value->value.function->args; | |||
| fprintf(f, "\n - arguments :: "); | |||
| // if no args at all | |||
| if (args->positional.symbols.next_index == 0 && | |||
| @@ -466,27 +466,28 @@ namespace Slime { | |||
| // 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; | |||
| return nullptr; | |||
| } | |||
| proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { | |||
| /* NOTE This parses the argument specification of funcitons | |||
| @@ -844,7 +845,9 @@ namespace Slime { | |||
| nas.append(Action::Step); | |||
| } | |||
| } else { | |||
| if (pc->value.function->type == Function_Type::Macro) { | |||
| if (pc->value.function->type.lisp_function_type == | |||
| Lisp_Function_Type::Macro) | |||
| { | |||
| push_pc_on_cs(); | |||
| nas.append(Action::Eval); | |||
| nas.append(Action::Step); | |||
| @@ -866,19 +869,19 @@ namespace Slime { | |||
| --pcs.next_index; | |||
| int am = ams.data[--ams.next_index]; | |||
| Lisp_Object* function = cs.data[am]; | |||
| Lisp_Object_Type type = Memory::get_type(function); | |||
| assert_type(function, Lisp_Object_Type::Function); | |||
| Environment* extended_env = | |||
| create_extended_environment_for_function_application_nrc( | |||
| &cs, function, am+1, cs.next_index-am-1); | |||
| cs.next_index = am; | |||
| push_environment(extended_env); | |||
| if (type == Lisp_Object_Type::CFunction) { | |||
| try cs.append(function->value.cFunction->body()); | |||
| if (function->value.function->is_c) { | |||
| try cs.append(function->value.function->body.c_body()); | |||
| pop_environment(); | |||
| } else { | |||
| nas.append(Action::Pop_Environment); | |||
| nas.append(Action::Eval); | |||
| cs.append(function->value.function->body); | |||
| cs.append(function->value.function->body.lisp_body); | |||
| } | |||
| } else { | |||
| cs.append(pcs.data[pcs.next_index-1]->value.pair.first); | |||
| @@ -445,14 +445,15 @@ namespace Slime { | |||
| } | |||
| 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("call stack cannot be printed."); | |||
| // 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"); | |||
| // } | |||
| } | |||
| proc log_error() -> void { | |||
| @@ -145,9 +145,11 @@ namespace Slime::Memory { | |||
| // free the exe dir: | |||
| free(Globals::load_path.data[0]); | |||
| Globals::load_path.dealloc(); | |||
| Globals::Current_Execution::call_stack.dealloc(); | |||
| // Globals::Current_Execution::call_stack.dealloc(); | |||
| Globals::Current_Execution::envi_stack.dealloc(); | |||
| Globals::Current_Execution::cs.dealloc(); | |||
| Globals::Current_Execution::ams.dealloc(); | |||
| Globals::Current_Execution::pcs.dealloc(); | |||
| } | |||
| @@ -436,6 +438,7 @@ namespace Slime::Memory { | |||
| node->value.function->args.keyword.keywords.alloc(); | |||
| node->value.function->args.keyword.values.alloc(); | |||
| node->value.function->args.positional.symbols.alloc(); | |||
| node->value.function->is_c = true; | |||
| return node; | |||
| } | |||
| @@ -448,6 +451,7 @@ namespace Slime::Memory { | |||
| func->value.function->args.keyword.values.alloc(); | |||
| func->value.function->args.positional.symbols.alloc(); | |||
| func->value.function->type.lisp_function_type = ft; | |||
| func->value.function->is_c = false; | |||
| return func; | |||
| } | |||
| @@ -208,38 +208,6 @@ namespace Slime { | |||
| 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); | |||
| 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); | |||
| 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); | |||
| 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::Keyword); | |||
| assert_equal_string(operands->value.pair.first->value.symbol, "haha"); | |||
| return pass; | |||
| } | |||
| proc test_parse_atom() -> testresult { | |||
| int index_in_text = 0; | |||
| char string[] = | |||
| @@ -634,9 +602,6 @@ namespace Slime { | |||
| // 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); | |||