From 1d6b9165dd1788eaece82efbd6f843db5eb1d587 Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Thu, 17 Oct 2019 23:37:03 +0200 Subject: [PATCH] made mode modular --- bin/slime.rdbg | Bin 71 -> 480 bytes src/assert.hpp | 82 ++++++++++++++++++++++ src/built_ins.cpp | 101 ++------------------------- src/define_macros.hpp | 112 +++++++++++++++++++++++++++++ src/defines.cpp | 109 ----------------------------- src/forward_decls.cpp | 159 +++++++++++++++--------------------------- src/globals.cpp | 75 ++++++++++++++++++++ src/io.cpp | 35 +++++++++- src/parse.cpp | 5 ++ src/slime.cpp | 5 +- src/slime.h | 5 +- src/slime_new.h | 6 +- 12 files changed, 383 insertions(+), 311 deletions(-) create mode 100644 src/assert.hpp create mode 100644 src/define_macros.hpp create mode 100644 src/globals.cpp diff --git a/bin/slime.rdbg b/bin/slime.rdbg index e7085e0218191c5950cf72ab3b95280a0fab5a23..27c535c3544ddbf8c0620032f7a5c7a56e41106a 100644 GIT binary patch literal 480 zcma)3u}%Xq49$Qji2tAry<=eO2$i~`&X$lbXD&fWE{c6s`}d8n9hf+Vrx!bZPtVC= z_r6~nV|H8k7<+=f7ee@ix6%U#9|=02uBVnx^i)Tirc9|3V&PhuRmF2fzXhuf!|afM zIdHK+M+~jaxmlbHp7Yn({g4$Eye^?zXf&m8r065120ssI2 diff --git a/src/assert.hpp b/src/assert.hpp new file mode 100644 index 0000000..bf1ed3f --- /dev/null +++ b/src/assert.hpp @@ -0,0 +1,82 @@ +/** + Usage of the create_error_macros: +*/ +#define __create_error(keyword, ...) \ + create_error( \ + __FILE__, __LINE__, \ + Memory::get_or_create_lisp_object_keyword(keyword), \ + __VA_ARGS__) + +#define create_out_of_memory_error(...) \ + __create_error("out-of-memory", __VA_ARGS__) + +#define create_generic_error(...) \ + __create_error("generic", __VA_ARGS__) + +#define create_not_yet_implemented_error() \ + __create_error("not-yet-implemented", "This feature has not yet been implemented.") + +#define create_parsing_error(...) \ + __create_error("parsing-error", __VA_ARGS__) + +#define create_symbol_undefined_error(...) \ + __create_error("symbol-undefined", __VA_ARGS__) + +#define create_type_missmatch_error(expected, actual) \ + __create_error("type-missmatch", \ + "Type missmatch: expected %s, got %s", \ + expected, actual) + +#define create_wrong_number_of_arguments_error(expected, actual) \ + __create_error("wrong-number-of-arguments", \ + "Wrong number of arguments: expected %d, got %d", \ + expected, actual) + +#define create_too_many_arguments_error(expected, actual) \ + __create_error("wrong-number-of-arguments", \ + "Wrong number of arguments: expected less or equal to %d, got %d", \ + expected, actual) + +#define create_too_few_arguments_error(expected, actual) \ + __create_error("wrong-number-of-arguments", \ + "Wrong number of arguments: expected greater or equal to %d, got %d", \ + expected, actual) + + +#define assert_arguments_length(expected, actual) \ + do { \ + if (expected != actual) { \ + create_wrong_number_of_arguments_error(expected, actual); \ + } \ + } while(0) + +#define assert_arguments_length_less_equal(expected, actual) \ + do { \ + if (expected < actual) { \ + create_too_many_arguments_error(expected, actual); \ + } \ + } while(0) + +#define assert_arguments_length_greater_equal(expected, actual) \ + do { \ + if (expected > actual) { \ + create_too_few_arguments_error(expected, actual); \ + } \ + } while(0) + + +#define assert_type(_node, _type) \ + do { \ + if (Memory::get_type(_node) != _type) { \ + create_type_missmatch_error( \ + Lisp_Object_Type_to_string(_type), \ + Lisp_Object_Type_to_string(Memory::get_type(_node))); \ + } \ + } while(0) + +#define assert(condition) \ + do { \ + if (!(condition)) { \ + create_generic_error("Assertion-error."); \ + } \ + } while(0) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index ce3e92f..cb3cd6f 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -104,100 +104,13 @@ proc built_in_import(String* file_name) -> Lisp_Object* { proc load_built_ins_into_environment() -> void { String* file_name_built_ins = Memory::create_string(__FILE__); - -#define fetch1(var) \ - Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \ - Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ - if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__) - -#define fetch2(var1, var2) fetch1(var1); fetch1(var2) -#define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) -#define fetch4(var1, var2, var3, var4) fetch3(var1, var2, var3); fetch1(var4) -#define fetch5(var1, var2, var3, var4, var5) fetch4(var1, var2, var3, var4); fetch1(var5) -#define fetch6(var1, var2, var3, var4, var5, var6) fetch5(var1, var2, var3, var4, var5); fetch1(var6) -#define fetch7(var1, var2, var3, var4, var5, var6, var7) fetch6(var1, var2, var3, var4, var5, var6); fetch1(var7) -#define fetch8(var1, var2, var3, var4, var5, var6, var7, var8) fetch7(var1, var2, var3, var4, var5, var6, var7); fetch1(var8) -#define fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9) fetch8(var1, var2, var3, var4, var5, var6, var7, var8); fetch1(var9) -#define fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10) fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9); fetch1(var10) -#define fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11) fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10); fetch1(var11) -#define fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12) fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11); fetch1(var12) -#define fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13) fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12); fetch1(var13) -#define fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14) fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13); fetch1(var14) -#define fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15) fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14); fetch1(var15) -#define fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16) fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15); fetch1(var16) -#define fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17) fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16); fetch1(var17) -#define fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18) fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17); fetch1(var18) -#define fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19) fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18); fetch1(var19) -#define fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20) fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19); fetch1(var20) -#define fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21) fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20); fetch1(var21) -#define fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22) fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21); fetch1(var22) -#define fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23) fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22); fetch1(var23) -#define fetch24(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23, var24) fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23); fetch1(var24) - -#define GET_MACRO( \ - _1, _2, _3, _4, _5, _6, \ - _7, _8, _9, _10, _11, _12, \ - _13, _14, _15, _16, _17, _18, \ - _19, _20, _21, _22, _23, _24, \ - NAME, ...) NAME -#ifdef _MSC_VER -#define EXPAND( x ) x -#define fetch(...) EXPAND( \ - GET_MACRO( \ - __VA_ARGS__, \ - fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ - fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ - fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ - fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ - )(__VA_ARGS__)) -#else -#define fetch(...) \ - GET_MACRO( \ - __VA_ARGS__, \ - fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ - fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ - fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ - fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ - )(__VA_ARGS__) -#endif - -// NOTE(Felix): we have to copy the string because we need -// it to be mutable for the parser to work, because the -// parser relys on being able to temporaily put in markers -// in the code -#define _define_helper(def, docs, special) \ - auto label(params,__LINE__) = Parser::parse_single_expression( \ - Memory::get_c_str(Memory::create_string(#def)) \ - ); \ - 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); \ - /*NOTE(Felix): for evaluating default args*/ \ - /*push_environment(get_root_environment());*/ \ - create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ - /*pop_environment(); */ \ - label(sfun,__LINE__)->sourceCodeLocation = new(Source_Code_Location); \ - label(sfun,__LINE__)->sourceCodeLocation->file = file_name_built_ins; \ - label(sfun,__LINE__)->sourceCodeLocation->line = __LINE__; \ - label(sfun,__LINE__)->sourceCodeLocation->column = 0; \ - label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ - define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ - label(sfun,__LINE__)->value.cFunction->body = (std::function)[&]() -> Lisp_Object* - -#define define(def, docs) _define_helper(def, docs, false) -#define define_special(def, docs) _define_helper(def, docs, true) -#define in_caller_env fluid_let( \ - Globals::Current_Execution::envi_stack.next_index, \ - Globals::Current_Execution::envi_stack.next_index-1) - - define((helper), "") { - return Memory::create_lisp_object_number(101); - }; - define((test (:k (helper))), "") { - fetch(k); - return k; - }; + define((helper), "") { + return Memory::create_lisp_object_number(101); + }; + define((test (:k (helper))), "") { + fetch(k); + return k; + }; define((= . args), "Takes 0 or more arguments and returns =t= if all arguments are equal " "and =()= otherwise.") diff --git a/src/define_macros.hpp b/src/define_macros.hpp new file mode 100644 index 0000000..6bcc734 --- /dev/null +++ b/src/define_macros.hpp @@ -0,0 +1,112 @@ +#define concat_( a, b) a##b +#define label(prefix, lnum) concat_(prefix,lnum) + +#define try_or_else_return(val) \ + if (1) \ + goto label(body,__LINE__); \ + else \ + while (1) \ + if (1) { \ + if (Globals::error) { \ + if (Globals::log_level == Log_Level::Debug) { \ + printf("in %s:%d\n", __FILE__, __LINE__); \ + } \ + return val; \ + } \ + break; \ + } \ + else label(body,__LINE__): + ; + +#define try_struct try_or_else_return({}) +#define try_void try_or_else_return() +#define try try_or_else_return(0) + +#define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false) +#define ignore_logging fluid_let(Globals::log_level, Log_Level::None) + +#define fetch1(var) \ + Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var); \ + Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ + if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__) + +#define fetch2(var1, var2) fetch1(var1); fetch1(var2) +#define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) +#define fetch4(var1, var2, var3, var4) fetch3(var1, var2, var3); fetch1(var4) +#define fetch5(var1, var2, var3, var4, var5) fetch4(var1, var2, var3, var4); fetch1(var5) +#define fetch6(var1, var2, var3, var4, var5, var6) fetch5(var1, var2, var3, var4, var5); fetch1(var6) +#define fetch7(var1, var2, var3, var4, var5, var6, var7) fetch6(var1, var2, var3, var4, var5, var6); fetch1(var7) +#define fetch8(var1, var2, var3, var4, var5, var6, var7, var8) fetch7(var1, var2, var3, var4, var5, var6, var7); fetch1(var8) +#define fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9) fetch8(var1, var2, var3, var4, var5, var6, var7, var8); fetch1(var9) +#define fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10) fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9); fetch1(var10) +#define fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11) fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10); fetch1(var11) +#define fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12) fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11); fetch1(var12) +#define fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13) fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12); fetch1(var13) +#define fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14) fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13); fetch1(var14) +#define fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15) fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14); fetch1(var15) +#define fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16) fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15); fetch1(var16) +#define fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17) fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16); fetch1(var17) +#define fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18) fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17); fetch1(var18) +#define fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19) fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18); fetch1(var19) +#define fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20) fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19); fetch1(var20) +#define fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21) fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20); fetch1(var21) +#define fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22) fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21); fetch1(var22) +#define fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23) fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22); fetch1(var23) +#define fetch24(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23, var24) fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23); fetch1(var24) + +#define GET_MACRO( \ + _1, _2, _3, _4, _5, _6, \ + _7, _8, _9, _10, _11, _12, \ + _13, _14, _15, _16, _17, _18, \ + _19, _20, _21, _22, _23, _24, \ + NAME, ...) NAME +#ifdef _MSC_VER +#define EXPAND( x ) x +#define fetch(...) EXPAND( \ + GET_MACRO( \ + __VA_ARGS__, \ + fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ + fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ + fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ + fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ + )(__VA_ARGS__)) +#else +#define fetch(...) \ + GET_MACRO( \ + __VA_ARGS__, \ + fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ + fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ + fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ + fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ + )(__VA_ARGS__) +#endif + +// NOTE(Felix): we have to copy the string because we need +// it to be mutable for the parser to work, because the +// parser relys on being able to temporaily put in markers +// in the code +#define _define_helper(def, docs, special) \ + auto label(params,__LINE__) = Parser::parse_single_expression( \ + Memory::get_c_str(Memory::create_string(#def)) \ + ); \ + 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); \ + /*NOTE(Felix): for evaluating default args*/ \ + /*push_environment(get_root_environment());*/ \ + create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ + /*pop_environment(); */ \ + label(sfun,__LINE__)->sourceCodeLocation = new(Source_Code_Location); \ + label(sfun,__LINE__)->sourceCodeLocation->file = file_name_built_ins; \ + label(sfun,__LINE__)->sourceCodeLocation->line = __LINE__; \ + label(sfun,__LINE__)->sourceCodeLocation->column = 0; \ + label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ + define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ + label(sfun,__LINE__)->value.cFunction->body = (std::function)[&]() -> Lisp_Object* + +#define define(def, docs) _define_helper(def, docs, false) +#define define_special(def, docs) _define_helper(def, docs, true) +#define in_caller_env fluid_let( \ + Globals::Current_Execution::envi_stack.next_index, \ + Globals::Current_Execution::envi_stack.next_index-1) diff --git a/src/defines.cpp b/src/defines.cpp index 1a25821..c83671d 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -18,34 +18,6 @@ # define if_linux if constexpr (true) #endif -#define concat_( a, b) a##b -#define label(prefix, lnum) concat_(prefix,lnum) - -#define try_or_else_return(val) \ - if (1) \ - goto label(body,__LINE__); \ - else \ - while (1) \ - if (1) { \ - if (Globals::error) { \ - if (Globals::log_level == Log_Level::Debug) { \ - printf("in %s:%d\n", __FILE__, __LINE__); \ - } \ - return val; \ - } \ - break; \ - } \ - else label(body,__LINE__): - ; - -#define try_struct try_or_else_return({}) -#define try_void try_or_else_return() -#define try try_or_else_return(0) - -#define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false) -#define ignore_logging fluid_let(Globals::log_level, Log_Level::None) - - /* * iterate over array lists */ @@ -75,88 +47,7 @@ Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ head = head->value.pair.rest, ++it_index) -/** - Usage of the create_error_macros: -*/ -#define __create_error(keyword, ...) \ - create_error( \ - __FILE__, __LINE__, \ - Memory::get_or_create_lisp_object_keyword(keyword), \ - __VA_ARGS__) - -#define create_out_of_memory_error(...) \ - __create_error("out-of-memory", __VA_ARGS__) - -#define create_generic_error(...) \ - __create_error("generic", __VA_ARGS__) - -#define create_not_yet_implemented_error() \ - __create_error("not-yet-implemented", "This feature has not yet been implemented.") - -#define create_parsing_error(...) \ - __create_error("parsing-error", __VA_ARGS__) - -#define create_symbol_undefined_error(...) \ - __create_error("symbol-undefined", __VA_ARGS__) - -#define create_type_missmatch_error(expected, actual) \ - __create_error("type-missmatch", \ - "Type missmatch: expected %s, got %s", \ - expected, actual) - -#define create_wrong_number_of_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected %d, got %d", \ - expected, actual) - -#define create_too_many_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected less or equal to %d, got %d", \ - expected, actual) - -#define create_too_few_arguments_error(expected, actual) \ - __create_error("wrong-number-of-arguments", \ - "Wrong number of arguments: expected greater or equal to %d, got %d", \ - expected, actual) - - -#define assert_arguments_length(expected, actual) \ - do { \ - if (expected != actual) { \ - create_wrong_number_of_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_less_equal(expected, actual) \ - do { \ - if (expected < actual) { \ - create_too_many_arguments_error(expected, actual); \ - } \ - } while(0) - -#define assert_arguments_length_greater_equal(expected, actual) \ - do { \ - if (expected > actual) { \ - create_too_few_arguments_error(expected, actual); \ - } \ - } while(0) - - -#define assert_type(_node, _type) \ - do { \ - if (Memory::get_type(_node) != _type) { \ - create_type_missmatch_error( \ - Lisp_Object_Type_to_string(_type), \ - Lisp_Object_Type_to_string(Memory::get_type(_node))); \ - } \ - } while(0) -#define assert(condition) \ - do { \ - if (!(condition)) { \ - create_generic_error("Assertion-error."); \ - } \ - } while(0) /* #define assert(cond) \ diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index 0344738..961191b 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -1,36 +1,55 @@ // proc assert_type(Lisp_Object*, Lisp_Object_Type) -> void; -proc add_to_load_path(const char*) -> void; -proc lisp_object_equal(Lisp_Object*,Lisp_Object*) -> bool; -proc built_in_load(String*) -> Lisp_Object*; -proc built_in_import(String*) -> Lisp_Object*; -proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void; -proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void; -proc create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line) -> void; -proc eval_arguments(Lisp_Object*) -> Lisp_Object*; -proc eval_expr(Lisp_Object*) -> Lisp_Object*; -proc is_truthy (Lisp_Object*) -> bool; -proc list_length(Lisp_Object*) -> int; -proc load_built_ins_into_environment() -> void; -proc create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function) -> void; - - -proc print_environment(Environment*) -> void; -inline proc get_root_environment() -> Environment*; -inline proc get_current_environment() -> Environment*; -inline proc push_environment(Environment*) -> void; -inline proc pop_environment() -> void; - -proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*; - -proc visualize_lisp_machine() -> void; -proc generate_docs(String* path) -> void; +void add_to_load_path(const char*); +bool lisp_object_equal(Lisp_Object*,Lisp_Object*); +Lisp_Object* built_in_load(String*); +Lisp_Object* built_in_import(String*); +void delete_error(); +void create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message); +void create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); +void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); +Lisp_Object* eval_arguments(Lisp_Object*); +Lisp_Object* eval_expr(Lisp_Object*); +bool is_truthy (Lisp_Object*); +int list_length(Lisp_Object*); +void load_built_ins_into_environment(); +void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); + +Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); +void define_symbol(Lisp_Object* symbol, Lisp_Object* value); +void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); + +void print_environment(Environment*); +inline Environment* get_root_environment(); +inline Environment* get_current_environment(); +inline void push_environment(Environment*); +inline void pop_environment(); + +const char* Lisp_Object_Type_to_string(Lisp_Object_Type type); + +void visualize_lisp_machine(); +void generate_docs(String* path); namespace Memory { - proc create_built_ins_environment() -> Environment*; - proc get_or_create_lisp_object_keyword(const char* identifier) -> Lisp_Object*; - inline proc get_type(Lisp_Object* node) -> Lisp_Object_Type; - proc init(int, int, int) -> void; - proc free_everything() -> void; + Environment* create_built_ins_environment(); + Lisp_Object* create_lisp_object_cfunction(bool is_special); + Lisp_Object* get_or_create_lisp_object_keyword(const char* identifier); + inline Lisp_Object_Type get_type(Lisp_Object* node); + void init(int, int, int); + char* get_c_str(String*); + void free_everything(); + String* create_string(const char*); + Lisp_Object* create_lisp_object_number(double); + Lisp_Object* get_or_create_lisp_object_symbol(String* identifier); + Lisp_Object* get_or_create_lisp_object_symbol(const char*); + Lisp_Object* get_or_create_lisp_object_keyword(String* identifier); + Lisp_Object* get_or_create_lisp_object_keyword(const char*); + Lisp_Object* create_lisp_object_string(const char*); + Lisp_Object* create_list(Lisp_Object*); + Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); + Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); + Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); + Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); + Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); } namespace Parser { @@ -41,81 +60,19 @@ namespace Parser { extern int parser_line; extern int parser_col; - proc parse_single_expression(char* text) -> Lisp_Object*; + Lisp_Object* parse_single_expression(char* text); + Lisp_Object* parse_single_expression(wchar_t* text); } namespace Globals { - char* bin_path = nullptr; - Log_Level log_level = Log_Level::Debug; - - Array_List load_path; + extern char* bin_path; + extern Log_Level log_level; + extern Array_List load_path; namespace Current_Execution { - Array_List call_stack; - Array_List envi_stack; + extern Array_List call_stack; + extern Array_List envi_stack; } -#ifdef _DONT_BREAK_ON_ERRORS - bool breaking_on_errors = false; -#else - bool breaking_on_errors = true; -#endif - Error* error = nullptr; -} - -unsigned int hm_hash(void* ptr) { - return ((unsigned long long)ptr * 2654435761) % 4294967296; -} - -unsigned int hm_hash(char* str) { - unsigned int value = str[0] << 7; - int i = 0; - while (str[i]) { - value = (10000003 * value) ^ str[i++]; - } - return value ^ i; -} - -bool hm_objects_match(char* a, char* b) { - return strcmp(a, b) == 0; -} - -bool hm_objects_match(void* a, void* b) { - return a == b; -} - -bool hm_objects_match(Lisp_Object* a, Lisp_Object* b) { - return lisp_object_equal(a, b); -} - -u32 hm_hash(Lisp_Object* obj) { - switch (Memory::get_type(obj)) { - // hash from adress: if two objects of these types have - // different addresses, they are different - case Lisp_Object_Type::CFunction: - case Lisp_Object_Type::Function: - case Lisp_Object_Type::Symbol: - case Lisp_Object_Type::Keyword: - case Lisp_Object_Type::Continuation: - case Lisp_Object_Type::Nil: - case Lisp_Object_Type::T: - return hm_hash((void*) obj); - // hash from contents: even if objects are themselved - // different, they cauld be equivalent: - case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer); - case Lisp_Object_Type::Number: return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes - case Lisp_Object_Type::String: return hm_hash((char*) &obj->value.string->data); - case Lisp_Object_Type::Pair: { - u32 hash = 1; - for_lisp_list (obj) { - hash <<= 1; - hash += hm_hash(it); - } - return hash; - } break; - case Lisp_Object_Type::Vector: - case Lisp_Object_Type::HashMap: - default: - create_not_yet_implemented_error(); - return 0; - } + extern Error* error; + extern bool breaking_on_errors; } diff --git a/src/globals.cpp b/src/globals.cpp new file mode 100644 index 0000000..91af3fa --- /dev/null +++ b/src/globals.cpp @@ -0,0 +1,75 @@ +namespace Globals { + char* bin_path = nullptr; + Log_Level log_level = Log_Level::Debug; + + Array_List load_path; + namespace Current_Execution { + Array_List call_stack; + Array_List envi_stack; + } + + Error* error = nullptr; +#ifdef _DONT_BREAK_ON_ERRORS + bool breaking_on_errors = false; +#else + bool breaking_on_errors = true; +#endif +} + +unsigned int hm_hash(void* ptr) { + return ((unsigned long long)ptr * 2654435761) % 4294967296; +} + +unsigned int hm_hash(char* str) { + unsigned int value = str[0] << 7; + int i = 0; + while (str[i]) { + value = (10000003 * value) ^ str[i++]; + } + return value ^ i; +} + +bool hm_objects_match(char* a, char* b) { + return strcmp(a, b) == 0; +} + +bool hm_objects_match(void* a, void* b) { + return a == b; +} + +bool hm_objects_match(Lisp_Object* a, Lisp_Object* b) { + return lisp_object_equal(a, b); +} + +u32 hm_hash(Lisp_Object* obj) { + switch (Memory::get_type(obj)) { + // hash from adress: if two objects of these types have + // different addresses, they are different + case Lisp_Object_Type::CFunction: + case Lisp_Object_Type::Function: + case Lisp_Object_Type::Symbol: + case Lisp_Object_Type::Keyword: + case Lisp_Object_Type::Continuation: + case Lisp_Object_Type::Nil: + case Lisp_Object_Type::T: + return hm_hash((void*) obj); + // hash from contents: even if objects are themselved + // different, they cauld be equivalent: + case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer); + case Lisp_Object_Type::Number: return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes + case Lisp_Object_Type::String: return hm_hash((char*) &obj->value.string->data); + case Lisp_Object_Type::Pair: { + u32 hash = 1; + for_lisp_list (obj) { + hash <<= 1; + hash += hm_hash(it); + } + return hash; + } break; + case Lisp_Object_Type::Vector: + case Lisp_Object_Type::HashMap: + default: + create_not_yet_implemented_error(); + return 0; + } +} diff --git a/src/io.cpp b/src/io.cpp index 6ccacc3..7ebf2b9 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -268,7 +268,40 @@ proc panic(char* message) -> void { exit(1); } -proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> void { +char* wchar_to_char(const wchar_t* pwchar) { + // get the number of characters in the string. + int currentCharIndex = 0; + char currentChar = (char)pwchar[currentCharIndex]; + + while (currentChar != '\0') + { + currentCharIndex++; + currentChar = (char)pwchar[currentCharIndex]; + } + + const int charCount = currentCharIndex + 1; + + // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes) + char* filePathC = (char*)malloc(sizeof(char) * charCount); + + for (int i = 0; i < charCount; i++) + { + // convert to char (1 byte) + char character = (char)pwchar[i]; + + *filePathC = character; + + filePathC += sizeof(char); + + } + filePathC += '\0'; + + filePathC -= (sizeof(char) * charCount); + + return filePathC; +} + +proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void { switch (Memory::get_type(node)) { case (Lisp_Object_Type::Nil): fputs("()", file); break; diff --git a/src/parse.cpp b/src/parse.cpp index 9132e20..4ecd10f 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -369,6 +369,11 @@ namespace Parser { return expression; } + proc parse_single_expression(wchar_t* text) -> Lisp_Object* { + char* res = wchar_to_char(text); + defer {free(res);}; + return parse_single_expression(res); + } proc parse_single_expression(char* text) -> Lisp_Object* { parser_file = standard_in; parser_line = 1; diff --git a/src/slime.cpp b/src/slime.cpp index b856a48..d1f2137 100644 --- a/src/slime.cpp +++ b/src/slime.cpp @@ -22,13 +22,16 @@ #include "./ftb/arraylist.hpp" #include "./ftb/macros.hpp" #include "./ftb/profiler.hpp" -#include "./ftb/hashmap.hpp" namespace Slime { +#include "./ftb/hashmap.hpp" # include "./defines.cpp" +# include "./assert.hpp" +# include "./define_macros.hpp" # include "./platform.cpp" # include "./structs.cpp" # include "./forward_decls.cpp" +# include "./globals.cpp" # include "./memory.cpp" # include "./gc.cpp" # include "./lisp_object.cpp" diff --git a/src/slime.h b/src/slime.h index e9bcbbc..5433ad3 100644 --- a/src/slime.h +++ b/src/slime.h @@ -27,12 +27,15 @@ #include "./ftb/arraylist.hpp" namespace Slime { -#include "./ftb/hashmap.hpp" +# include "./ftb/hashmap.hpp" # include "./defines.cpp" +# include "./assert.hpp" +# include "./define_macros.hpp" # include "./platform.cpp" # include "./structs.cpp" # include "./forward_decls.cpp" +# include "./globals.cpp" # include "./memory.cpp" # include "./gc.cpp" # include "./lisp_object.cpp" diff --git a/src/slime_new.h b/src/slime_new.h index 1fcbc67..8b41eb8 100644 --- a/src/slime_new.h +++ b/src/slime_new.h @@ -1,11 +1,9 @@ #include -#define _CRT_SECURE_NO_WARNINGS -#define _CRT_SECURE_NO_DEPRECATE + namespace Slime { -# include "./defines.cpp" # include "./ftb/hashmap.hpp" # include "./ftb/arraylist.hpp" +# include "./assert.hpp" # include "./structs.cpp" # include "./forward_decls.cpp" -# include "./undefines.cpp" }