| @@ -12,7 +12,6 @@ namespace Slime { | |||||
| case Lisp_Object_Type::Nil: | case Lisp_Object_Type::Nil: | ||||
| case Lisp_Object_Type::Symbol: | case Lisp_Object_Type::Symbol: | ||||
| case Lisp_Object_Type::Keyword: | case Lisp_Object_Type::Keyword: | ||||
| case Lisp_Object_Type::CFunction: | |||||
| case Lisp_Object_Type::Function: | case Lisp_Object_Type::Function: | ||||
| // TODO(Felix): should a pointer | // TODO(Felix): should a pointer | ||||
| // object compare the pointer? | // object compare the pointer? | ||||
| @@ -347,7 +346,7 @@ namespace Slime { | |||||
| // creating new lisp object and setting type | // creating new lisp object and setting type | ||||
| Lisp_Object* func; | 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; | // Lisp_Object* func; | ||||
| // try func = Memory::create_lisp_object(); | // try func = Memory::create_lisp_object(); | ||||
| @@ -359,7 +358,7 @@ namespace Slime { | |||||
| // setting parent env | // setting parent env | ||||
| func->value.function->parent_environment = get_current_environment(); | func->value.function->parent_environment = get_current_environment(); | ||||
| create_arguments_from_lambda_list_and_inject(lambdalist, func); | 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); | define_symbol(symbol, func); | ||||
| } | } | ||||
| return Memory::nil; | return Memory::nil; | ||||
| @@ -398,7 +397,7 @@ namespace Slime { | |||||
| // creating new lisp object and setting type | // creating new lisp object and setting type | ||||
| Lisp_Object* func; | 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) | if (doc) | ||||
| func->docstring = doc->value.string; | func->docstring = doc->value.string; | ||||
| @@ -407,7 +406,7 @@ namespace Slime { | |||||
| // setting parent env | // setting parent env | ||||
| func->value.function->parent_environment = get_current_environment(); | func->value.function->parent_environment = get_current_environment(); | ||||
| create_arguments_from_lambda_list_and_inject(lambdalist, func); | 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); | define_symbol(symbol, func); | ||||
| } | } | ||||
| @@ -705,14 +704,14 @@ namespace Slime { | |||||
| // creating new lisp object and setting type | // creating new lisp object and setting type | ||||
| Lisp_Object* func; | 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 { | in_caller_env { | ||||
| func->value.function->parent_environment = get_current_environment(); | func->value.function->parent_environment = get_current_environment(); | ||||
| } | } | ||||
| try create_arguments_from_lambda_list_and_inject(args, func); | 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; | return func; | ||||
| }; | }; | ||||
| define((apply fun args), "TODO") { | define((apply fun args), "TODO") { | ||||
| @@ -846,16 +845,22 @@ namespace Slime { | |||||
| switch (type) { | switch (type) { | ||||
| case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation"); | 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: { | case Lisp_Object_Type::Function: { | ||||
| Function* fun = n->value.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::HashMap: return Memory::get_keyword("hashmap"); | ||||
| case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword"); | case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword"); | ||||
| @@ -903,14 +908,10 @@ namespace Slime { | |||||
| ? Memory::get_c_str(val->docstring) | ? Memory::get_c_str(val->docstring) | ||||
| : "No docs avaliable"); | : "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("Arguments:\n==========\n"); | ||||
| printf("Postitional: {"); | printf("Postitional: {"); | ||||
| @@ -956,9 +957,9 @@ namespace Slime { | |||||
| profile_with_name("(show)"); | profile_with_name("(show)"); | ||||
| fetch(n); | fetch(n); | ||||
| try assert_type(n, Lisp_Object_Type::Function); | try assert_type(n, Lisp_Object_Type::Function); | ||||
| try assert(n->value.function->is_c); | |||||
| puts("body:\n"); | puts("body:\n"); | ||||
| print(n->value.function->body); | |||||
| print(n->value.function->body.lisp_body); | |||||
| puts("\n"); | puts("\n"); | ||||
| printf("parent_env: %lld\n", | printf("parent_env: %lld\n", | ||||
| (long long)n->value.function->parent_environment); | (long long)n->value.function->parent_environment); | ||||
| @@ -108,7 +108,7 @@ | |||||
| // mutable for the parser to work, because the parser relys on being | // 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 | // able to temporaily put in markers in the code and also it will fill | ||||
| // out the source code location | // 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_file = file_name_built_ins; \ | ||||
| Parser::parser_line = __LINE__; \ | Parser::parser_line = __LINE__; \ | ||||
| Parser::parser_col = 0; \ | Parser::parser_col = 0; \ | ||||
| @@ -118,15 +118,17 @@ | |||||
| assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ | assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ | ||||
| assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ | assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ | ||||
| auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \ | 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__)); \ | create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ | ||||
| if_error_log_location_and_return(nullptr); \ | if_error_log_location_and_return(nullptr); \ | ||||
| label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ | 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__)); \ | 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( \ | #define in_caller_env fluid_let( \ | ||||
| Globals::Current_Execution::envi_stack.next_index, \ | Globals::Current_Execution::envi_stack.next_index, \ | ||||
| Globals::Current_Execution::envi_stack.next_index-1) | Globals::Current_Execution::envi_stack.next_index-1) | ||||
| @@ -83,13 +83,9 @@ namespace Slime { | |||||
| /* | /* | ||||
| * if function then print arguments | * 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 :: "); | fprintf(f, "\n - arguments :: "); | ||||
| // if no args at all | // if no args at all | ||||
| if (args->positional.symbols.next_index == 0 && | if (args->positional.symbols.next_index == 0 && | ||||
| @@ -466,27 +466,28 @@ namespace Slime { | |||||
| // 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; | |||||
| return nullptr; | |||||
| } | |||||
| proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { | proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { | ||||
| /* NOTE This parses the argument specification of funcitons | /* NOTE This parses the argument specification of funcitons | ||||
| @@ -844,7 +845,9 @@ namespace Slime { | |||||
| nas.append(Action::Step); | nas.append(Action::Step); | ||||
| } | } | ||||
| } else { | } 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(); | push_pc_on_cs(); | ||||
| nas.append(Action::Eval); | nas.append(Action::Eval); | ||||
| nas.append(Action::Step); | nas.append(Action::Step); | ||||
| @@ -866,19 +869,19 @@ namespace Slime { | |||||
| --pcs.next_index; | --pcs.next_index; | ||||
| int am = ams.data[--ams.next_index]; | int am = ams.data[--ams.next_index]; | ||||
| Lisp_Object* function = cs.data[am]; | Lisp_Object* function = cs.data[am]; | ||||
| Lisp_Object_Type type = Memory::get_type(function); | |||||
| assert_type(function, Lisp_Object_Type::Function); | |||||
| Environment* extended_env = | Environment* extended_env = | ||||
| create_extended_environment_for_function_application_nrc( | create_extended_environment_for_function_application_nrc( | ||||
| &cs, function, am+1, cs.next_index-am-1); | &cs, function, am+1, cs.next_index-am-1); | ||||
| cs.next_index = am; | cs.next_index = am; | ||||
| push_environment(extended_env); | 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(); | pop_environment(); | ||||
| } else { | } else { | ||||
| nas.append(Action::Pop_Environment); | nas.append(Action::Pop_Environment); | ||||
| nas.append(Action::Eval); | nas.append(Action::Eval); | ||||
| cs.append(function->value.function->body); | |||||
| cs.append(function->value.function->body.lisp_body); | |||||
| } | } | ||||
| } else { | } else { | ||||
| cs.append(pcs.data[pcs.next_index-1]->value.pair.first); | cs.append(pcs.data[pcs.next_index-1]->value.pair.first); | ||||
| @@ -445,14 +445,15 @@ namespace Slime { | |||||
| } | } | ||||
| proc print_call_stack() -> void { | 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 { | proc log_error() -> void { | ||||
| @@ -145,9 +145,11 @@ namespace Slime::Memory { | |||||
| // free the exe dir: | // free the exe dir: | ||||
| free(Globals::load_path.data[0]); | free(Globals::load_path.data[0]); | ||||
| Globals::load_path.dealloc(); | 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::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.keywords.alloc(); | ||||
| node->value.function->args.keyword.values.alloc(); | node->value.function->args.keyword.values.alloc(); | ||||
| node->value.function->args.positional.symbols.alloc(); | node->value.function->args.positional.symbols.alloc(); | ||||
| node->value.function->is_c = true; | |||||
| return node; | return node; | ||||
| } | } | ||||
| @@ -448,6 +451,7 @@ namespace Slime::Memory { | |||||
| func->value.function->args.keyword.values.alloc(); | func->value.function->args.keyword.values.alloc(); | ||||
| func->value.function->args.positional.symbols.alloc(); | func->value.function->args.positional.symbols.alloc(); | ||||
| func->value.function->type.lisp_function_type = ft; | func->value.function->type.lisp_function_type = ft; | ||||
| func->value.function->is_c = false; | |||||
| return func; | return func; | ||||
| } | } | ||||
| @@ -208,38 +208,6 @@ namespace Slime { | |||||
| 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); | |||||
| 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 { | proc test_parse_atom() -> testresult { | ||||
| int index_in_text = 0; | int index_in_text = 0; | ||||
| char string[] = | char string[] = | ||||
| @@ -634,9 +602,6 @@ namespace Slime { | |||||
| // invoke_test(test_parse_atom); | // invoke_test(test_parse_atom); | ||||
| // invoke_test(test_parse_expression); | // invoke_test(test_parse_expression); | ||||
| // printf("\n-- Basic evaluating --\n"); | |||||
| // invoke_test(test_eval_operands); | |||||
| // printf("\n-- Built ins --\n"); | // printf("\n-- Built ins --\n"); | ||||
| // invoke_test(test_built_in_add); | // invoke_test(test_built_in_add); | ||||
| // invoke_test(test_built_in_substract); | // invoke_test(test_built_in_substract); | ||||