| @@ -1,22 +0,0 @@ | |||
| ACME_MODULE( | |||
| #========================================================================== | |||
| # general module information | |||
| #========================================================================== | |||
| NAME TSE_LispIntegration | |||
| TYPE LIBRARY | |||
| #========================================================================== | |||
| # files of this module | |||
| #========================================================================== | |||
| INCLUDE_BASE src | |||
| bin | |||
| FILES_PRIVATE_HEADER src/*.h | |||
| FILES_SOURCE src/main.cpp | |||
| #DEPENDENCIES TSE_Engine | |||
| ) | |||
| file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/bin/pre.slime | |||
| DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) | |||
| file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/bin/test.slime | |||
| DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) | |||
| @@ -1,9 +0,0 @@ | |||
| @echo off | |||
| pushd %~dp0\bin | |||
| call ..\build.bat | |||
| if %errorlevel% == 0 ( | |||
| echo ---------- Running ---------- | |||
| call timecmd slime.exe | |||
| ) | |||
| popd | |||
| @@ -1,4 +1,4 @@ | |||
| bool lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) { | |||
| proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { | |||
| if (n1 == n2) | |||
| return true; | |||
| if (n1->type != n2->type) | |||
| @@ -42,7 +42,7 @@ bool lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) { | |||
| return false; | |||
| } | |||
| Lisp_Object* built_in_equals(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_equals(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -62,7 +62,7 @@ Lisp_Object* built_in_equals(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_t(); | |||
| } | |||
| Lisp_Object* built_in_greater(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_greater(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -85,7 +85,7 @@ Lisp_Object* built_in_greater(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_t(); | |||
| } | |||
| Lisp_Object* built_in_greater_equal(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_greater_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -108,7 +108,7 @@ Lisp_Object* built_in_greater_equal(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_t(); | |||
| } | |||
| Lisp_Object* built_in_less(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_less(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -131,7 +131,7 @@ Lisp_Object* built_in_less(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_t(); | |||
| } | |||
| Lisp_Object* built_in_less_equal(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_less_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -154,7 +154,7 @@ Lisp_Object* built_in_less_equal(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_t(); | |||
| } | |||
| Lisp_Object* built_in_add(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_add(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -172,7 +172,7 @@ Lisp_Object* built_in_add(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_number(sum); | |||
| } | |||
| Lisp_Object* built_in_substract(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_substract(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -195,7 +195,7 @@ Lisp_Object* built_in_substract(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_number(difference); | |||
| } | |||
| Lisp_Object* built_in_multiply(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_multiply(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -218,7 +218,7 @@ Lisp_Object* built_in_multiply(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_number(product); | |||
| } | |||
| Lisp_Object* built_in_divide(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_divide(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -241,7 +241,7 @@ Lisp_Object* built_in_divide(Lisp_Object* arguments, Environment* env) { | |||
| return Memory::create_lisp_object_number(quotient); | |||
| } | |||
| Lisp_Object* built_in_exponentiate(Lisp_Object* arguments, Environment* env) { | |||
| proc built_in_exponentiate(Lisp_Object* arguments, Environment* env) -> Lisp_Object* { | |||
| int arguments_length; | |||
| try { | |||
| arguments = eval_arguments(arguments, env, &arguments_length); | |||
| @@ -270,7 +270,7 @@ Lisp_Object* built_in_exponentiate(Lisp_Object* arguments, Environment* env) { | |||
| } | |||
| Lisp_Object* built_in_load(char* file_name, Environment* env) { | |||
| proc built_in_load(char* file_name, Environment* env) -> Lisp_Object* { | |||
| char* file_content = read_entire_file(file_name); | |||
| if (file_content) { | |||
| Lisp_Object* result = Memory::create_lisp_object_nil(); | |||
| @@ -290,7 +290,7 @@ Lisp_Object* built_in_load(char* file_name, Environment* env) { | |||
| } | |||
| } | |||
| void load_built_ins_into_environment(Environment* env) { | |||
| proc load_built_ins_into_environment(Environment* env) -> void { | |||
| int arguments_length; | |||
| Lisp_Object* evaluated_arguments; | |||
| @@ -300,7 +300,7 @@ void load_built_ins_into_environment(Environment* env) { | |||
| return nullptr; \ | |||
| } | |||
| auto defun = [&](char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) { | |||
| proc defun = [&](char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) { | |||
| define_symbol( | |||
| Memory::create_lisp_object_symbol(name), | |||
| Memory::create_lisp_object_cfunction(fun), | |||
| @@ -0,0 +1,79 @@ | |||
| #define new(type) new type | |||
| #define proc auto | |||
| #ifdef _DEBUG | |||
| constexpr bool is_debug_build = true; | |||
| #else | |||
| constexpr bool is_debug_build = false; | |||
| #endif | |||
| #define if_debug if constexpr (is_debug_build) | |||
| #define assert(cond) \ | |||
| if_debug { \ | |||
| if (!cond) { \ | |||
| printf("Assertion failed: %s %d", __FILE__, __LINE__); \ | |||
| __debugbreak(); \ | |||
| } \ | |||
| } else {} \ | |||
| #define concat_( a, b) a##b | |||
| #define label(prefix, lnum) concat_(prefix,lnum) | |||
| #define try \ | |||
| if (1) \ | |||
| goto label(body,__LINE__); \ | |||
| else \ | |||
| while (1) \ | |||
| if (1) { \ | |||
| if(error) return 0; \ | |||
| break; \ | |||
| } \ | |||
| else label(body,__LINE__): | |||
| #define try_void \ | |||
| if (1) \ | |||
| goto label(body,__LINE__); \ | |||
| else \ | |||
| while (1) \ | |||
| if (1) { \ | |||
| if(error) return; \ | |||
| break; \ | |||
| } \ | |||
| else label(body,__LINE__): | |||
| #define define_array_list(type, name) \ | |||
| struct name##_Array_List { \ | |||
| type* data; \ | |||
| int length; \ | |||
| int next_index; \ | |||
| }; \ | |||
| \ | |||
| \ | |||
| proc append_to_##name##_array_list(name##_Array_List* arraylist, type element) -> void { \ | |||
| if (arraylist->next_index == arraylist->length) { \ | |||
| arraylist->length *= 2; \ | |||
| arraylist->data = \ | |||
| (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \ | |||
| } \ | |||
| arraylist->data[arraylist->next_index++] = element; \ | |||
| } \ | |||
| \ | |||
| \ | |||
| proc create_##name##_array_list(int initial_capacity = 16) -> name##_Array_List* { \ | |||
| name##_Array_List* ret = new(name##_Array_List); \ | |||
| ret->data = (type*)malloc(initial_capacity * sizeof(type)); \ | |||
| ret->next_index = 0; \ | |||
| ret->length = initial_capacity; \ | |||
| return ret; \ | |||
| } | |||
| // #define console_normal "\x1B[0m" | |||
| // #define console_red "\x1B[31m" | |||
| // #define console_green "\x1B[32m" | |||
| // #define console_cyan "\x1B[36m" | |||
| #define console_normal "" | |||
| #define console_red "" | |||
| #define console_green "" | |||
| #define console_cyan "" | |||
| @@ -1,5 +1,5 @@ | |||
| void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) { | |||
| proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) -> void { | |||
| // NOTE(Felix): right now we are simply adding the symol at the | |||
| // back of the list without checking if it already exists but are | |||
| // also searching for thesymbol from the back, so we will find the | |||
| @@ -16,16 +16,14 @@ void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) { | |||
| ++env->next_index; | |||
| } | |||
| void print_environment(Environment* env); | |||
| Lisp_Object* lookup_symbol_in_this_envt(Symbol* sym, Environment* env) { | |||
| proc lookup_symbol_in_this_envt(Symbol* sym, Environment* env) -> Lisp_Object* { | |||
| for (int i = env->next_index - 1; i >= 0; --i) | |||
| if (string_equal(env->keys[i], sym->identifier)) | |||
| return env->values[i]; | |||
| return nullptr; | |||
| } | |||
| Lisp_Object* lookup_symbol(Lisp_Object* node, Environment* env) { | |||
| proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||
| // first check current environment | |||
| Symbol* sym = node->value.symbol; | |||
| Lisp_Object* result; | |||
| @@ -51,13 +49,14 @@ Lisp_Object* lookup_symbol(Lisp_Object* node, Environment* env) { | |||
| printf("%s\n", sym->identifier); | |||
| return nullptr; | |||
| } | |||
| void print_indent(int indent) { | |||
| proc print_indent(int indent) -> void { | |||
| for (int i = 0; i < indent; ++i) { | |||
| printf(" "); | |||
| } | |||
| } | |||
| void print_environment_indent(Environment* env, int indent) { | |||
| proc print_environment_indent(Environment* env, int indent) -> void { | |||
| for (int i = 0; i < env->next_index; ++i) { | |||
| print_indent(indent); | |||
| print(env->values[i]); | |||
| @@ -72,7 +71,7 @@ void print_environment_indent(Environment* env, int indent) { | |||
| } | |||
| } | |||
| void print_environment(Environment* env) { | |||
| proc print_environment(Environment* env) -> void { | |||
| printf("\n=== Environment ===\n"); | |||
| print_environment_indent(env, 0); | |||
| } | |||
| @@ -1,21 +1,23 @@ | |||
| Error* error; | |||
| void delete_error() { | |||
| proc delete_error() -> void { | |||
| if (error) { | |||
| free(error); | |||
| error = nullptr; | |||
| } | |||
| } | |||
| void create_error(Error_Type type, Source_Code_Location* location) { | |||
| proc create_error(Error_Type type, Source_Code_Location* location) -> void { | |||
| delete_error(); | |||
| __debugbreak(); | |||
| if_debug { | |||
| __debugbreak(); | |||
| } | |||
| error = new(Error); | |||
| error->type = type; | |||
| error->location = location; | |||
| } | |||
| char* Error_Type_to_string(Error_Type type) { | |||
| proc Error_Type_to_string(Error_Type type) -> char* { | |||
| switch (type) { | |||
| case Error_Type::Ill_Formed_Arguments: return "Evaluation-error: Ill formed arguments"; | |||
| case Error_Type::Ill_Formed_Lambda_List: return "Evaluation-error: Ill formed lambda list"; | |||
| @@ -35,7 +37,7 @@ char* Error_Type_to_string(Error_Type type) { | |||
| } | |||
| } | |||
| void assert_type(Lisp_Object* node, Lisp_Object_Type type) { | |||
| proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void { | |||
| if (!node) | |||
| create_error(Error_Type::Unknown_Error, nullptr); | |||
| if (node->type == type) return; | |||
| @@ -1,6 +1,4 @@ | |||
| Lisp_Object* eval_expr(Lisp_Object*, Environment*); | |||
| Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* function) { | |||
| proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { | |||
| Environment* new_env = Memory::create_child_environment(function->parent_environment); | |||
| // positional arguments | |||
| @@ -22,7 +20,7 @@ Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* funct | |||
| String_Array_List* read_in_keywords = create_String_array_list(16); | |||
| if (arguments->type == Lisp_Object_Type::Nil) | |||
| if (arguments->type == Lisp_Object_Type::Nil) | |||
| goto checks; | |||
| // keyword arguments: use all given ones and keep track of the | |||
| // added ones (array list), if end of parameters in encountered or | |||
| @@ -162,7 +160,7 @@ Lisp_Object* apply_arguments_to_function(Lisp_Object* arguments, Function* funct | |||
| positional_arguments, keyword_arguments and rest_argument and | |||
| filling it in | |||
| */ | |||
| void parse_argument_list(Lisp_Object* arguments, Function* function) { | |||
| proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { | |||
| // first init the fields | |||
| function->positional_arguments = create_positional_argument_list(16); | |||
| function->keyword_arguments = create_keyword_argument_list(16); | |||
| @@ -288,7 +286,7 @@ void parse_argument_list(Lisp_Object* arguments, Function* function) { | |||
| } | |||
| int list_length(Lisp_Object* node) { | |||
| proc list_length(Lisp_Object* node) -> int { | |||
| if (node->type == Lisp_Object_Type::Nil) | |||
| return 0; | |||
| @@ -309,9 +307,7 @@ int list_length(Lisp_Object* node) { | |||
| return 0; | |||
| } | |||
| bool is_truthy (Lisp_Object* expression, Environment* env); | |||
| Lisp_Object* extract_keyword_value(char* keyword, Parsed_Arguments* args) { | |||
| proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* { | |||
| // NOTE(Felix): This will be a hashmap lookup later | |||
| for (int i = 0; i < args->keyword_keys->next_index; ++i) { | |||
| if (string_equal(args->keyword_keys->data[i]->value.keyword->identifier, keyword)) | |||
| @@ -320,7 +316,7 @@ Lisp_Object* extract_keyword_value(char* keyword, Parsed_Arguments* args) { | |||
| return nullptr; | |||
| } | |||
| Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) { | |||
| proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* { | |||
| int my_out_arguments_length = 0; | |||
| if (arguments->type == Lisp_Object_Type::Nil) { | |||
| return arguments; | |||
| @@ -351,7 +347,7 @@ Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_a | |||
| return evaluated_arguments; | |||
| } | |||
| Lisp_Object* eval_expr(Lisp_Object* node, Environment* env) { | |||
| proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||
| #define report_error(_type) { \ | |||
| create_error(_type, node->sourceCodeLocation); \ | |||
| return nullptr; \ | |||
| @@ -420,7 +416,7 @@ Lisp_Object* eval_expr(Lisp_Object* node, Environment* env) { | |||
| #undef report_error | |||
| } | |||
| bool is_truthy (Lisp_Object* expression, Environment* env) { | |||
| proc is_truthy (Lisp_Object* expression, Environment* env) -> bool { | |||
| Lisp_Object* result; | |||
| try { | |||
| result = eval_expr(expression, env); | |||
| @@ -428,5 +424,73 @@ bool is_truthy (Lisp_Object* expression, Environment* env) { | |||
| if (result->type == Lisp_Object_Type::Nil) | |||
| return false; | |||
| return true; | |||
| } | |||
| proc interprete_file (char* file_name) -> Lisp_Object* { | |||
| Memory::init(); | |||
| Environment* env = Memory::create_empty_environment(); | |||
| Parser::init(env); | |||
| char* file_content = read_entire_file(file_name); | |||
| if (!file_content) { | |||
| create_error(Error_Type::Unknown_Error, nullptr); | |||
| } | |||
| load_built_ins_into_environment(env); | |||
| try { | |||
| built_in_load("pre.slime", env); | |||
| } | |||
| Lisp_Object_Array_List* program; | |||
| try { | |||
| program = Parser::parse_program(file_name, file_content); | |||
| } | |||
| Lisp_Object* result = Memory::create_lisp_object_nil(); | |||
| for (int i = 0; i < program->next_index; ++i) { | |||
| try { | |||
| result = eval_expr(program->data[i], env); | |||
| } | |||
| } | |||
| return result; | |||
| } | |||
| proc interprete_stdin() -> void { | |||
| Memory::init(); | |||
| Environment* env = Memory::create_built_ins_environment(); | |||
| Parser::init(env); | |||
| printf("Welcome to the lispy interpreter.\n"); | |||
| char* line; | |||
| built_in_load("pre.slime", env); | |||
| built_in_load("test.slime", env); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| } | |||
| Lisp_Object* parsed, * evaluated; | |||
| while (true) { | |||
| printf(">"); | |||
| line = read_expression(); | |||
| parsed = Parser::parse_single_expression(line); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| evaluated = eval_expr(parsed, env); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| print(evaluated); | |||
| printf("\n"); | |||
| } | |||
| } | |||
| @@ -1,6 +1,7 @@ | |||
| Lisp_Object* eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length); | |||
| Lisp_Object* eval_expr(Lisp_Object*, Environment*); | |||
| bool is_truthy (Lisp_Object* expression, Environment* env); | |||
| int list_length(Lisp_Object*); | |||
| void load_built_ins_into_environment(Environment*); | |||
| void parse_argument_list(Lisp_Object*, Function*); | |||
| proc print_environment(Environment* env) -> void; | |||
| proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object*; | |||
| proc eval_expr(Lisp_Object*, Environment*) -> Lisp_Object*; | |||
| proc is_truthy (Lisp_Object* expression, Environment* env) -> bool; | |||
| proc list_length(Lisp_Object*) -> int; | |||
| proc load_built_ins_into_environment(Environment*) -> void; | |||
| proc parse_argument_list(Lisp_Object*, Function*) -> void; | |||
| @@ -1,313 +0,0 @@ | |||
| #define new(type) new type | |||
| #ifdef _DEBUG | |||
| constexpr bool is_debug_build = true; | |||
| #else | |||
| constexpr bool is_debug_build = false; | |||
| #endif | |||
| #define if_debug if constexpr (is_debug_build) | |||
| #define assert(cond) \ | |||
| if_debug { \ | |||
| if (!cond) { \ | |||
| printf("Assertion failed: %s %d", __FILE__, __LINE__); \ | |||
| __debugbreak(); \ | |||
| } \ | |||
| } else {} \ | |||
| #define concat_( a, b) a##b | |||
| #define label(prefix, lnum) concat_(prefix,lnum) | |||
| #define try \ | |||
| if (1) \ | |||
| goto label(body,__LINE__); \ | |||
| else \ | |||
| while (1) \ | |||
| if (1) { \ | |||
| if(error) return 0; \ | |||
| break; \ | |||
| } \ | |||
| else label(body,__LINE__): | |||
| #define try_void \ | |||
| if (1) \ | |||
| goto label(body,__LINE__); \ | |||
| else \ | |||
| while (1) \ | |||
| if (1) { \ | |||
| if(error) return; \ | |||
| break; \ | |||
| } \ | |||
| else label(body,__LINE__): | |||
| #define define_array_list(type, name) \ | |||
| struct name##_Array_List { \ | |||
| type* data; \ | |||
| int length; \ | |||
| int next_index; \ | |||
| }; \ | |||
| \ | |||
| \ | |||
| void append_to_##name##_array_list(name##_Array_List* arraylist, type element) { \ | |||
| if (arraylist->next_index == arraylist->length) { \ | |||
| arraylist->length *= 2; \ | |||
| arraylist->data = \ | |||
| (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \ | |||
| } \ | |||
| arraylist->data[arraylist->next_index++] = element; \ | |||
| } \ | |||
| \ | |||
| \ | |||
| name##_Array_List* create_##name##_array_list(int initial_capacity = 16) { \ | |||
| name##_Array_List* ret = new(name##_Array_List); \ | |||
| ret->data = (type*)malloc(initial_capacity * sizeof(type)); \ | |||
| ret->next_index = 0; \ | |||
| ret->length = initial_capacity; \ | |||
| return ret; \ | |||
| } | |||
| int string_equal(char input[],char check[]) | |||
| { | |||
| int i,result=1; | |||
| for(i=0; input[i]!='\0' || check[i]!='\0'; i++) { | |||
| if(input[i] != check[i]) { | |||
| result=0; | |||
| break; | |||
| } | |||
| } | |||
| return result; | |||
| } | |||
| // asprintf implementation | |||
| int _vscprintf_so(const char * format, va_list pargs) { | |||
| int retval; | |||
| va_list argcopy; | |||
| va_copy(argcopy, pargs); | |||
| retval = vsnprintf(nullptr, 0, format, argcopy); | |||
| va_end(argcopy); | |||
| return retval; | |||
| } | |||
| int vasprintf(char **strp, const char *fmt, va_list ap) { | |||
| int len = _vscprintf_so(fmt, ap); | |||
| if (len == -1) return -1; | |||
| char *str = (char *)malloc((size_t) len + 1); | |||
| if (!str) return -1; | |||
| int r = vsnprintf(str, len + 1, fmt, ap); /* "secure" version of vsprintf */ | |||
| if (r == -1) return free(str), -1; | |||
| *strp = str; | |||
| return r; | |||
| } | |||
| int asprintf(char *strp[], const char *fmt, ...) { | |||
| va_list ap; | |||
| va_start(ap, fmt); | |||
| int r = vasprintf(strp, fmt, ap); | |||
| va_end(ap); | |||
| return r; | |||
| } | |||
| // asprintf implementation end | |||
| static char get_nibble(char c) { | |||
| if (c >= 'A' && c <= 'F') | |||
| return (c - 'a') + 10; | |||
| else if (c >= 'a' && c <= 'f') | |||
| return (c - 'A') + 10; | |||
| return (c - '0'); | |||
| } | |||
| bool unescape_string(char* in) { | |||
| if (!in) | |||
| return true; | |||
| char *out = in, *p = in; | |||
| const char *int_err = nullptr; | |||
| while (*p && !int_err) { | |||
| if (*p != '\\') { | |||
| /* normal case */ | |||
| *out++ = *p++; | |||
| } else { | |||
| /* escape sequence */ | |||
| switch (*++p) { | |||
| case 'a': *out++ = '\a'; ++p; break; | |||
| case 'b': *out++ = '\b'; ++p; break; | |||
| case 'f': *out++ = '\f'; ++p; break; | |||
| case 'n': *out++ = '\n'; ++p; break; | |||
| case 'r': *out++ = '\r'; ++p; break; | |||
| case 't': *out++ = '\t'; ++p; break; | |||
| case 'v': *out++ = '\v'; ++p; break; | |||
| case '"': | |||
| case '\'': | |||
| case '\\': | |||
| *out++ = *p++; | |||
| case '?': | |||
| break; | |||
| case 'x': | |||
| case 'X': | |||
| if (!isxdigit(p[1]) || !isxdigit(p[2])) { | |||
| int_err = "Invalid character on hexadecimal escape."; | |||
| } else { | |||
| *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); | |||
| p += 3; | |||
| } | |||
| break; | |||
| default: | |||
| int_err = "Unexpected '\\' with no escape sequence."; | |||
| break; | |||
| } | |||
| } | |||
| } | |||
| /* Set the end of string. */ | |||
| *out = '\0'; | |||
| if (int_err) | |||
| return false; | |||
| return true; | |||
| } | |||
| char* read_entire_file (char* filename) { | |||
| char *fileContent = nullptr; | |||
| FILE *fp = fopen(filename, "r"); | |||
| if (fp) { | |||
| /* Go to the end of the file. */ | |||
| if (fseek(fp, 0L, SEEK_END) == 0) { | |||
| /* Get the size of the file. */ | |||
| long bufsize = ftell(fp); | |||
| if (bufsize == -1) { | |||
| fputs("Empty file", stderr); | |||
| goto closeFile; | |||
| } | |||
| /* Go back to the start of the file. */ | |||
| if (fseek(fp, 0L, SEEK_SET) != 0) { | |||
| fputs("Error reading file", stderr); | |||
| goto closeFile; | |||
| } | |||
| /* Allocate our buffer to that size. */ | |||
| fileContent = (char*)calloc(bufsize, sizeof(char)); | |||
| /* Read the entire file into memory. */ | |||
| size_t newLen = fread(fileContent, sizeof(char), bufsize, fp); | |||
| fileContent[newLen] = '\0'; | |||
| if ( ferror( fp ) != 0 ) { | |||
| fputs("Error reading file", stderr); | |||
| } | |||
| } | |||
| closeFile: | |||
| fclose(fp); | |||
| } | |||
| return fileContent; | |||
| /* Don't forget to call free() later! */ | |||
| } | |||
| char* read_expression() { | |||
| char* line = (char*)malloc(100), * linep = line; | |||
| size_t lenmax = 100, len = lenmax; | |||
| int c; | |||
| int nesting = 0; | |||
| if(line == NULL) | |||
| return NULL; | |||
| for(;;) { | |||
| c = fgetc(stdin); | |||
| if(c == EOF) | |||
| break; | |||
| if(--len == 0) { | |||
| len = lenmax; | |||
| char * linen = (char*)realloc(linep, lenmax *= 2); | |||
| if(linen == NULL) { | |||
| free(linep); | |||
| return NULL; | |||
| } | |||
| line = linen + (line - linep); | |||
| linep = linen; | |||
| } | |||
| *line++; | |||
| if((*line = (char)c) == '(') | |||
| ++nesting; | |||
| else if((*line = (char)c) == ')') | |||
| --nesting; | |||
| else if((*line = (char)c) == '\n') | |||
| if (nesting == 0) | |||
| break; | |||
| } | |||
| (*line)--; // we dont want the \n actually | |||
| *line = '\0'; | |||
| // BUG(Felix): Why do we have to add 1 here? | |||
| return linep + 1; | |||
| } | |||
| char* read_line() { | |||
| char* line = (char*)malloc(100), * linep = line; | |||
| size_t lenmax = 100, len = lenmax; | |||
| int c; | |||
| int nesting = 0; | |||
| if(line == NULL) | |||
| return NULL; | |||
| for(;;) { | |||
| c = fgetc(stdin); | |||
| if(c == EOF) | |||
| break; | |||
| if(--len == 0) { | |||
| len = lenmax; | |||
| char* linen = (char*)realloc(linep, lenmax *= 2); | |||
| if(linen == NULL) { | |||
| free(linep); | |||
| return NULL; | |||
| } | |||
| line = linen + (line - linep); | |||
| linep = linen; | |||
| } | |||
| *line++; | |||
| if((*line = (char)c) == '(') | |||
| ++nesting; | |||
| else if((*line = (char)c) == ')') | |||
| --nesting; | |||
| else if((*line = (char)c) == '\n') | |||
| if (nesting == 0) | |||
| break; | |||
| } | |||
| (*line)--; // we dont want the \n actually | |||
| *line = '\0'; | |||
| // BUG(Felix): Why do we have to add 1 here? | |||
| return linep + 1; | |||
| } | |||
| struct Source_Code_Location { | |||
| char* file; | |||
| int line; | |||
| int column; | |||
| }; | |||
| Source_Code_Location* create_source_code_location(char* file, int line, int col) { | |||
| if (!file) | |||
| return nullptr; | |||
| Source_Code_Location* ret = new(Source_Code_Location); | |||
| ret->file = file; | |||
| ret->line = line; | |||
| ret->column = col; | |||
| return ret; | |||
| } | |||
| @@ -1,16 +1,198 @@ | |||
| // #define console_normal "\x1B[0m" | |||
| // #define console_red "\x1B[31m" | |||
| // #define console_green "\x1B[32m" | |||
| // #define console_cyan "\x1B[36m" | |||
| proc string_equal(char input[],char check[]) -> bool { | |||
| int i; | |||
| for(i = 0; input[i] != '\0' || check[i] != '\0'; i++) { | |||
| if(input[i] != check[i]) { | |||
| return false; | |||
| } | |||
| } | |||
| return true; | |||
| } | |||
| proc get_nibble(char c) -> char { | |||
| if (c >= 'A' && c <= 'F') | |||
| return (c - 'a') + 10; | |||
| else if (c >= 'a' && c <= 'f') | |||
| return (c - 'A') + 10; | |||
| return (c - '0'); | |||
| } | |||
| proc unescape_string(char* in) -> bool { | |||
| if (!in) | |||
| return true; | |||
| char *out = in, *p = in; | |||
| const char *int_err = nullptr; | |||
| while (*p && !int_err) { | |||
| if (*p != '\\') { | |||
| /* normal case */ | |||
| *out++ = *p++; | |||
| } else { | |||
| /* escape sequence */ | |||
| switch (*++p) { | |||
| case 'a': *out++ = '\a'; ++p; break; | |||
| case 'b': *out++ = '\b'; ++p; break; | |||
| case 'f': *out++ = '\f'; ++p; break; | |||
| case 'n': *out++ = '\n'; ++p; break; | |||
| case 'r': *out++ = '\r'; ++p; break; | |||
| case 't': *out++ = '\t'; ++p; break; | |||
| case 'v': *out++ = '\v'; ++p; break; | |||
| case '"': | |||
| case '\'': | |||
| case '\\': | |||
| *out++ = *p++; | |||
| case '?': | |||
| break; | |||
| // case 'x': | |||
| // case 'X': | |||
| // if (!isxdigit(p[1]) || !isxdigit(p[2])) { | |||
| // int_err = "Invalid character on hexadecimal escape."; | |||
| // } else { | |||
| // *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2])); | |||
| // p += 3; | |||
| // } | |||
| // break; | |||
| default: | |||
| int_err = "Unexpected '\\' with no escape sequence."; | |||
| break; | |||
| } | |||
| } | |||
| } | |||
| /* Set the end of string. */ | |||
| *out = '\0'; | |||
| if (int_err) | |||
| return false; | |||
| return true; | |||
| } | |||
| proc read_entire_file (char* filename) -> char* { | |||
| char *fileContent = nullptr; | |||
| FILE *fp = fopen(filename, "r"); | |||
| if (fp) { | |||
| /* Go to the end of the file. */ | |||
| if (fseek(fp, 0L, SEEK_END) == 0) { | |||
| /* Get the size of the file. */ | |||
| long bufsize = ftell(fp); | |||
| if (bufsize == -1) { | |||
| fputs("Empty file", stderr); | |||
| goto closeFile; | |||
| } | |||
| /* Go back to the start of the file. */ | |||
| if (fseek(fp, 0L, SEEK_SET) != 0) { | |||
| fputs("Error reading file", stderr); | |||
| goto closeFile; | |||
| } | |||
| /* Allocate our buffer to that size. */ | |||
| fileContent = (char*)calloc(bufsize, sizeof(char)); | |||
| /* Read the entire file into memory. */ | |||
| size_t newLen = fread(fileContent, sizeof(char), bufsize, fp); | |||
| fileContent[newLen] = '\0'; | |||
| if ( ferror( fp ) != 0 ) { | |||
| fputs("Error reading file", stderr); | |||
| } | |||
| } | |||
| closeFile: | |||
| fclose(fp); | |||
| } | |||
| return fileContent; | |||
| /* Don't forget to call free() later! */ | |||
| } | |||
| proc read_expression() -> char* { | |||
| char* line = (char*)malloc(100), * linep = line; | |||
| size_t lenmax = 100, len = lenmax; | |||
| int c; | |||
| int nesting = 0; | |||
| if(line == NULL) | |||
| return NULL; | |||
| for(;;) { | |||
| c = fgetc(stdin); | |||
| if(c == EOF) | |||
| break; | |||
| if(--len == 0) { | |||
| len = lenmax; | |||
| char * linen = (char*)realloc(linep, lenmax *= 2); | |||
| if(linen == NULL) { | |||
| free(linep); | |||
| return NULL; | |||
| } | |||
| line = linen + (line - linep); | |||
| linep = linen; | |||
| } | |||
| *line++; | |||
| if((*line = (char)c) == '(') | |||
| ++nesting; | |||
| else if((*line = (char)c) == ')') | |||
| --nesting; | |||
| else if((*line = (char)c) == '\n') | |||
| if (nesting == 0) | |||
| break; | |||
| } | |||
| (*line)--; // we dont want the \n actually | |||
| *line = '\0'; | |||
| // BUG(Felix): Why do we have to add 1 here? | |||
| return linep + 1; | |||
| } | |||
| proc read_line() -> char* { | |||
| char* line = (char*)malloc(100), * linep = line; | |||
| size_t lenmax = 100, len = lenmax; | |||
| int c; | |||
| int nesting = 0; | |||
| if(line == NULL) | |||
| return NULL; | |||
| for(;;) { | |||
| c = fgetc(stdin); | |||
| if(c == EOF) | |||
| break; | |||
| if(--len == 0) { | |||
| len = lenmax; | |||
| char* linen = (char*)realloc(linep, lenmax *= 2); | |||
| if(linen == NULL) { | |||
| free(linep); | |||
| return NULL; | |||
| } | |||
| line = linen + (line - linep); | |||
| linep = linen; | |||
| } | |||
| *line++; | |||
| if((*line = (char)c) == '(') | |||
| ++nesting; | |||
| else if((*line = (char)c) == ')') | |||
| --nesting; | |||
| else if((*line = (char)c) == '\n') | |||
| if (nesting == 0) | |||
| break; | |||
| } | |||
| (*line)--; // we dont want the \n actually | |||
| *line = '\0'; | |||
| // BUG(Felix): Why do we have to add 1 here? | |||
| return linep + 1; | |||
| } | |||
| #define console_normal "" | |||
| #define console_red "" | |||
| #define console_green "" | |||
| #define console_cyan "" | |||
| Log_Level log_level = Log_Level::Debug; | |||
| void log_message(Log_Level type, char* message) { | |||
| proc log_message(Log_Level type, char* message) -> void { | |||
| if (type > log_level) | |||
| return; | |||
| @@ -25,12 +207,12 @@ void log_message(Log_Level type, char* message) { | |||
| printf("%s: %s\n",prefix, message); | |||
| } | |||
| void panic(char* message) { | |||
| proc panic(char* message) -> void { | |||
| log_message(Log_Level::Critical, message); | |||
| exit(1); | |||
| } | |||
| void print(Lisp_Object* node) { | |||
| proc print(Lisp_Object* node) -> void { | |||
| switch (node->type) { | |||
| case (Lisp_Object_Type::Nil): { | |||
| printf("nil"); | |||
| @@ -91,7 +273,7 @@ void print(Lisp_Object* node) { | |||
| } | |||
| // XXX(Felix): obv code dublicate | |||
| void fprint(FILE* f, Lisp_Object* node) { | |||
| proc fprint(FILE* f, Lisp_Object* node) -> void { | |||
| switch (node->type) { | |||
| case (Lisp_Object_Type::Nil): { | |||
| fprintf(f, "nil"); | |||
| @@ -151,7 +333,7 @@ void fprint(FILE* f, Lisp_Object* node) { | |||
| } | |||
| } | |||
| void print_error_location() { | |||
| proc print_error_location() -> void { | |||
| if (error->location) { | |||
| printf("%s (line %d, position %d)", | |||
| error->location->file, | |||
| @@ -162,7 +344,7 @@ void print_error_location() { | |||
| } | |||
| } | |||
| void log_error() { | |||
| proc log_error() -> void { | |||
| printf("%s%s%s\n", console_red, | |||
| Error_Type_to_string(error->type), | |||
| console_normal); | |||
| @@ -1,4 +1,15 @@ | |||
| char* Lisp_Object_Type_to_string(Lisp_Object_Type type) { | |||
| proc create_source_code_location(char* file, int line, int col) -> Source_Code_Location* { | |||
| if (!file) | |||
| return nullptr; | |||
| Source_Code_Location* ret = new(Source_Code_Location); | |||
| ret->file = file; | |||
| ret->line = line; | |||
| ret->column = col; | |||
| return ret; | |||
| } | |||
| proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> char* { | |||
| switch (type) { | |||
| case(Lisp_Object_Type::Nil): return "nil"; | |||
| case(Lisp_Object_Type::T): return "t"; | |||
| @@ -13,7 +24,7 @@ char* Lisp_Object_Type_to_string(Lisp_Object_Type type) { | |||
| return "unknown"; | |||
| } | |||
| Positional_Arguments* create_positional_argument_list(int initial_capacity) { | |||
| proc create_positional_argument_list(int initial_capacity) -> Positional_Arguments* { | |||
| Positional_Arguments* ret = new(Positional_Arguments); | |||
| ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*)); | |||
| ret->next_index = 0; | |||
| @@ -21,7 +32,7 @@ Positional_Arguments* create_positional_argument_list(int initial_capacity) { | |||
| return ret; | |||
| } | |||
| void append_to_positional_argument_list(Positional_Arguments* args, char* identifier) { | |||
| proc append_to_positional_argument_list(Positional_Arguments* args, char* identifier) -> void { | |||
| if (args->next_index == args->length) { | |||
| args->length *= 2; | |||
| args->identifiers = (char**)realloc(args->identifiers, args->length * sizeof(char*)); | |||
| @@ -29,7 +40,7 @@ void append_to_positional_argument_list(Positional_Arguments* args, char* identi | |||
| args->identifiers[args->next_index++] = identifier; | |||
| } | |||
| Keyword_Arguments* create_keyword_argument_list(int initial_capacity) { | |||
| proc create_keyword_argument_list(int initial_capacity) -> Keyword_Arguments* { | |||
| Keyword_Arguments* ret = new(Keyword_Arguments); | |||
| ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*)); | |||
| ret->values = create_Lisp_Object_array_list(initial_capacity); | |||
| @@ -38,9 +49,9 @@ Keyword_Arguments* create_keyword_argument_list(int initial_capacity) { | |||
| return ret; | |||
| } | |||
| void append_to_keyword_argument_list(Keyword_Arguments* args, | |||
| proc append_to_keyword_argument_list(Keyword_Arguments* args, | |||
| char* identifier, | |||
| struct Lisp_Object* default_value) | |||
| struct Lisp_Object* default_value) -> void | |||
| { | |||
| if (args->next_index == args->length) { | |||
| args->length *= 2; | |||
| @@ -1,97 +1,6 @@ | |||
| #pragma once | |||
| #define _CRT_SECURE_NO_DEPRECATE | |||
| #include <stdio.h> | |||
| #include <string.h> | |||
| #include <stdlib.h> | |||
| #include <stdarg.h> /* needed for va_list */ | |||
| #include <ctype.h> | |||
| #include <math.h> | |||
| #include <functional> | |||
| #include "slime.h" | |||
| #include "./helpers.cpp" | |||
| #include "./structs.cpp" | |||
| #include "./forward_decls.cpp" | |||
| #include "./lisp_object.cpp" | |||
| #include "./error.cpp" | |||
| #include "./io.cpp" | |||
| #include "./memory.cpp" | |||
| #include "./env.cpp" | |||
| #include "./parse.cpp" | |||
| #include "./built_ins.cpp" | |||
| #include "./eval.cpp" | |||
| #include "./testing.cpp" | |||
| Lisp_Object* interprete_file (char* file_name) { | |||
| Memory::init(); | |||
| Environment* env = Memory::create_empty_environment(); | |||
| Parser::init(env); | |||
| char* file_content = read_entire_file(file_name); | |||
| if (!file_content) { | |||
| create_error(Error_Type::Unknown_Error, nullptr); | |||
| } | |||
| load_built_ins_into_environment(env); | |||
| try { | |||
| built_in_load("pre.slime", env); | |||
| } | |||
| Lisp_Object_Array_List* program; | |||
| try { | |||
| program = Parser::parse_program(file_name, file_content); | |||
| } | |||
| Lisp_Object* result = Memory::create_lisp_object_nil(); | |||
| for (int i = 0; i < program->next_index; ++i) { | |||
| try { | |||
| result = eval_expr(program->data[i], env); | |||
| } | |||
| } | |||
| return result; | |||
| } | |||
| int interprete_stdin () { | |||
| Memory::init(); | |||
| Environment* env = Memory::create_built_ins_environment(); | |||
| Parser::init(env); | |||
| printf("Welcome to the lispy interpreter.\n"); | |||
| char* line; | |||
| built_in_load("pre.slime", env); | |||
| built_in_load("test.slime", env); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| } | |||
| Lisp_Object* parsed, * evaluated; | |||
| while (true) { | |||
| printf(">"); | |||
| line = read_expression(); | |||
| parsed = Parser::parse_single_expression(line); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| evaluated = eval_expr(parsed, env); | |||
| if (error) { | |||
| log_error(); | |||
| delete_error(); | |||
| continue; | |||
| } | |||
| print(evaluated); | |||
| printf("\n"); | |||
| } | |||
| return 0; | |||
| } | |||
| int main (int argc, char *argv[]) { | |||
| int main(int argc, char* argv[]) { | |||
| if (argc > 1) { | |||
| interprete_file(argv[1]); | |||
| if (error) { | |||
| @@ -99,7 +8,7 @@ int main (int argc, char *argv[]) { | |||
| return 1; | |||
| } | |||
| } else { | |||
| // run_all_tests(); | |||
| run_all_tests(); | |||
| return interprete_stdin(); | |||
| } | |||
| } | |||
| @@ -5,13 +5,13 @@ namespace Memory { | |||
| Lisp_Object* memory; | |||
| int nextFreeSpot = 0; | |||
| void init() { | |||
| proc init() -> void { | |||
| memory = (Lisp_Object*)malloc(maxLispObjects * sizeof(Lisp_Object)); | |||
| freeSpots = create_Int_array_list(); | |||
| } | |||
| void print_status() { | |||
| printf("Memory Status:\n" | |||
| proc print_status() -> void { | |||
| printf("Memory Status:\n" | |||
| " - %f%% of the memory is used\n" | |||
| " - %d of %d total Lisp_Objects are in use\n" | |||
| " - %d holes in used memory (fragmentation)\n", | |||
| @@ -20,7 +20,7 @@ namespace Memory { | |||
| freeSpots->next_index); | |||
| } | |||
| Lisp_Object* create_lisp_object() { | |||
| proc create_lisp_object() -> Lisp_Object* { | |||
| int index; | |||
| // if we have no free spots then append at the end | |||
| if (freeSpots->next_index == 0) { | |||
| @@ -39,21 +39,21 @@ namespace Memory { | |||
| return object; | |||
| } | |||
| Lisp_Object* create_lisp_object_nil() { | |||
| proc create_lisp_object_nil() -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::Nil; | |||
| node->value.pair = nullptr; | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_t() { | |||
| proc create_lisp_object_t() -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::T; | |||
| node->value.pair = nullptr; | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_number(double number) { | |||
| proc create_lisp_object_number(double number) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::Number; | |||
| node->value.number = new(Number); | |||
| @@ -61,7 +61,7 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_string(char* str, int length) { | |||
| proc create_lisp_object_string(char* str, int length) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::String; | |||
| node->value.string = new(String); | |||
| @@ -70,7 +70,7 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_symbol(char* identifier) { | |||
| proc create_lisp_object_symbol(char* identifier) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::Symbol; | |||
| node->value.symbol = new(Symbol); | |||
| @@ -78,7 +78,7 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_keyword(char* keyword) { | |||
| proc create_lisp_object_keyword(char* keyword) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::Keyword; | |||
| node->value.keyword = new(Keyword); | |||
| @@ -86,7 +86,7 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_cfunction(std::function<Lisp_Object*(Lisp_Object*, Environment*)> function) { | |||
| proc create_lisp_object_cfunction(std::function<Lisp_Object*(Lisp_Object*, Environment*)> function) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::CFunction; | |||
| node->value.cfunction = new(CFunction); | |||
| @@ -94,7 +94,7 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) { | |||
| proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { | |||
| Lisp_Object* node = create_lisp_object(); | |||
| node->type = Lisp_Object_Type::Pair; | |||
| node->value.pair = new(Pair); | |||
| @@ -103,15 +103,13 @@ namespace Memory { | |||
| return node; | |||
| } | |||
| Lisp_Object* copy_lisp_object(Lisp_Object* n) { | |||
| proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | |||
| Lisp_Object* target = create_lisp_object(); | |||
| *target = *n; | |||
| return target; | |||
| } | |||
| // environments | |||
| Environment* create_child_environment(Environment* parent) { | |||
| proc create_child_environment(Environment* parent) -> Environment* { | |||
| Environment* env = new(Environment); | |||
| int start_capacity = 16; | |||
| @@ -125,11 +123,11 @@ namespace Memory { | |||
| return env; | |||
| } | |||
| Environment* create_empty_environment() { | |||
| proc create_empty_environment() -> Environment* { | |||
| return create_child_environment(nullptr); | |||
| } | |||
| Environment* create_built_ins_environment() { | |||
| proc create_built_ins_environment() -> Environment* { | |||
| Environment* ret = create_child_environment(nullptr); | |||
| load_built_ins_into_environment(ret); | |||
| return ret; | |||
| @@ -0,0 +1,20 @@ | |||
| #pragma once | |||
| #define _CRT_SECURE_NO_DEPRECATE | |||
| #include <functional> | |||
| #include "./defines.cpp" | |||
| #include "./structs.cpp" | |||
| #include "./forward_decls.cpp" | |||
| #include "./lisp_object.cpp" | |||
| #include "./error.cpp" | |||
| #include "./io.cpp" | |||
| #include "./memory.cpp" | |||
| #include "./env.cpp" | |||
| #include "./parse.cpp" | |||
| #include "./built_ins.cpp" | |||
| #include "./eval.cpp" | |||
| #include "./testing.cpp" | |||
| #include "./undefines.cpp" | |||
| #undef _CRT_SECURE_NO_DEPRECATE | |||
| @@ -17,6 +17,30 @@ enum struct Lisp_Object_Type { | |||
| CFunction, | |||
| }; | |||
| enum struct Function_Type { | |||
| Lambda, | |||
| Special_Lambda, | |||
| Macro | |||
| }; | |||
| enum struct Error_Type { | |||
| Ill_Formed_Arguments, | |||
| Ill_Formed_Lambda_List, | |||
| Ill_Formed_List, | |||
| Not_A_Function, | |||
| Not_Yet_Implemented, | |||
| Symbol_Not_Defined, | |||
| Syntax_Error, | |||
| Trailing_Garbage, | |||
| Type_Missmatch, | |||
| Unbalanced_Parenthesis, | |||
| Unexpected_Eof, | |||
| Unknown_Error, | |||
| Unknown_Keyword_Argument, | |||
| Wrong_Number_Of_Arguments, | |||
| Out_Of_Memory, | |||
| }; | |||
| enum struct Log_Level { | |||
| None, | |||
| Critical, | |||
| @@ -25,6 +49,12 @@ enum struct Log_Level { | |||
| Debug, | |||
| }; | |||
| struct Source_Code_Location { | |||
| char* file; | |||
| int line; | |||
| int column; | |||
| }; | |||
| struct Symbol { | |||
| char* identifier; | |||
| }; | |||
| @@ -64,12 +94,6 @@ struct Keyword_Arguments { | |||
| int length; | |||
| }; | |||
| enum struct Function_Type { | |||
| Lambda, | |||
| Special_Lambda, | |||
| Macro | |||
| }; | |||
| struct Function { | |||
| Function_Type type; | |||
| char* docstring; | |||
| @@ -118,24 +142,6 @@ struct Environment { | |||
| Lisp_Object** values; | |||
| }; | |||
| enum struct Error_Type { | |||
| Ill_Formed_Arguments, | |||
| Ill_Formed_Lambda_List, | |||
| Ill_Formed_List, | |||
| Not_A_Function, | |||
| Not_Yet_Implemented, | |||
| Symbol_Not_Defined, | |||
| Syntax_Error, | |||
| Trailing_Garbage, | |||
| Type_Missmatch, | |||
| Unbalanced_Parenthesis, | |||
| Unexpected_Eof, | |||
| Unknown_Error, | |||
| Unknown_Keyword_Argument, | |||
| Wrong_Number_Of_Arguments, | |||
| Out_Of_Memory, | |||
| }; | |||
| struct Error { | |||
| Error_Type type; | |||
| Source_Code_Location* location; | |||
| @@ -85,7 +85,7 @@ | |||
| } \ | |||
| } \ | |||
| testresult test_eval_operands() { | |||
| proc test_eval_operands() -> testresult { | |||
| char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; | |||
| Lisp_Object* operands = Parser::parse_single_expression(operands_string); | |||
| int operands_length; | |||
| @@ -119,7 +119,7 @@ testresult test_eval_operands() { | |||
| return pass; | |||
| } | |||
| testresult test_parse_atom() { | |||
| proc test_parse_atom() -> testresult { | |||
| int index_in_text = 0; | |||
| char string[] = | |||
| "123 -1.23e-2 " // numbers | |||
| @@ -175,7 +175,7 @@ testresult test_parse_atom() { | |||
| return pass; | |||
| } | |||
| testresult test_parse_expression() { | |||
| proc test_parse_expression() -> testresult { | |||
| int index_in_text = 0; | |||
| char string[] = "(fun + 12)"; | |||
| @@ -230,7 +230,7 @@ testresult test_parse_expression() { | |||
| return pass; | |||
| } | |||
| testresult test_built_in_add() { | |||
| proc test_built_in_add() -> testresult { | |||
| char exp_string[] = "(+ 10 4)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -243,7 +243,7 @@ testresult test_built_in_add() { | |||
| return pass; | |||
| } | |||
| testresult test_built_in_substract() { | |||
| proc test_built_in_substract() -> testresult { | |||
| char exp_string[] = "(- 10 4)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -257,7 +257,7 @@ testresult test_built_in_substract() { | |||
| } | |||
| testresult test_built_in_multiply() { | |||
| proc test_built_in_multiply() -> testresult { | |||
| char exp_string[] = "(* 10 4)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -271,7 +271,7 @@ testresult test_built_in_multiply() { | |||
| } | |||
| testresult test_built_in_divide() { | |||
| proc test_built_in_divide() -> testresult { | |||
| char exp_string[] = "(/ 20 4)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -285,7 +285,7 @@ testresult test_built_in_divide() { | |||
| } | |||
| testresult test_built_in_if() { | |||
| proc test_built_in_if() -> testresult { | |||
| char exp_string1[] = "(if 1 4 5)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string1); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -307,7 +307,7 @@ testresult test_built_in_if() { | |||
| return pass; | |||
| } | |||
| testresult test_built_in_and() { | |||
| proc test_built_in_and() -> testresult { | |||
| char exp_string1[] = "(and 1 \"asd\" 4)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string1); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -328,7 +328,7 @@ testresult test_built_in_and() { | |||
| return pass; | |||
| } | |||
| testresult test_built_in_or() { | |||
| proc test_built_in_or() -> testresult { | |||
| char exp_string1[] = "(or \"asd\" nil)"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string1); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -350,7 +350,7 @@ testresult test_built_in_or() { | |||
| } | |||
| testresult test_built_in_not() { | |||
| proc test_built_in_not() -> testresult { | |||
| char exp_string1[] = "(not ())"; | |||
| Lisp_Object* expression = Parser::parse_single_expression(exp_string1); | |||
| Lisp_Object* result = eval_expr(expression, Memory::create_built_ins_environment()); | |||
| @@ -372,7 +372,7 @@ testresult test_built_in_not() { | |||
| return pass; | |||
| } | |||
| void run_all_tests() { | |||
| proc run_all_tests() -> void { | |||
| log_level = Log_Level::None; | |||
| Memory::init(); | |||
| Parser::init(Memory::create_built_ins_environment()); | |||
| @@ -393,5 +393,22 @@ void run_all_tests() { | |||
| invoke_test(test_built_in_and); | |||
| invoke_test(test_built_in_or); | |||
| invoke_test(test_built_in_not); | |||
| } | |||
| #undef epsilon | |||
| #undef testresult | |||
| #undef pass | |||
| #undef fail | |||
| #undef print_assert_equal_fail | |||
| #undef print_assert_not_equal_fail | |||
| #undef assert_no_error | |||
| #undef assert_equal_int | |||
| #undef assert_not_equal_int | |||
| #undef assert_equal_double | |||
| #undef assert_not_equal_double | |||
| #undef assert_equal_string | |||
| #undef assert_equal_type | |||
| #undef assert_null | |||
| #undef assert_not_null | |||
| #undef invoke_test | |||
| @@ -0,0 +1,17 @@ | |||
| #undef new | |||
| #undef proc | |||
| #undef if_debug | |||
| #undef assert | |||
| #undef concat_ | |||
| #undef label | |||
| #undef try | |||
| #undef try_void | |||
| #undef define_array_list | |||
| #undef console_normal | |||
| #undef console_red | |||
| #undef console_green | |||
| #undef console_cyan | |||
| @@ -1,10 +0,0 @@ | |||
| @echo off | |||
| pushd %~dp0\bin | |||
| call ..\build.bat | |||
| if %errorlevel% == 0 ( | |||
| echo ---------- Testing ---------- | |||
| call timecmd ..\build\slime.exe test.slime | |||
| ) | |||
| popd | |||