Work transfer
This commit is contained in:
Felix Brendel
+54
-54
@@ -1,54 +1,54 @@
|
||||
/**
|
||||
Usage of the create_error_macros:
|
||||
*/
|
||||
#define __create_error(keyword, ...) \
|
||||
create_error( \
|
||||
__FUNCTION__, __FILE__, __LINE__, \
|
||||
Memory::get_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)
|
||||
|
||||
#ifdef _DEBUG
|
||||
|
||||
#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)
|
||||
|
||||
#else
|
||||
# define assert_arguments_length(expected, actual) do {} while (0)
|
||||
# define assert_arguments_length_less_equal(expected, actual) do {} while (0)
|
||||
# define assert_arguments_length_greater_equal(expected, actual) do {} while (0)
|
||||
# define assert_type(_node, _type) do {} while (0)
|
||||
# define assert(condition) do {} while (0)
|
||||
#endif
|
||||
/**
|
||||
Usage of the create_error_macros:
|
||||
*/
|
||||
#define __create_error(keyword, ...) \
|
||||
create_error( \
|
||||
__FUNCTION__, __FILE__, __LINE__, \
|
||||
Memory::get_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)
|
||||
|
||||
#ifdef _DEBUG
|
||||
|
||||
#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)
|
||||
|
||||
#else
|
||||
# define assert_arguments_length(expected, actual) do {} while (0)
|
||||
# define assert_arguments_length_less_equal(expected, actual) do {} while (0)
|
||||
# define assert_arguments_length_greater_equal(expected, actual) do {} while (0)
|
||||
# define assert_type(_node, _type) do {} while (0)
|
||||
# define assert(condition) do {} while (0)
|
||||
#endif
|
||||
|
||||
+154
-154
@@ -1,154 +1,154 @@
|
||||
#define concat_( a, b) a##b
|
||||
#define label(prefix, lnum) concat_(prefix,lnum)
|
||||
|
||||
#define log_location() \
|
||||
do { \
|
||||
if (Globals::log_level == Log_Level::Debug) { \
|
||||
printf("in"); \
|
||||
int spacing = 30-(int)strlen(__FILE__); \
|
||||
if (spacing < 1) spacing = 1; \
|
||||
for (int i = 0; i < spacing;++i) \
|
||||
printf(" "); \
|
||||
printf("%s (%d) ", __FILE__, __LINE__); \
|
||||
printf("-> %s\n",__FUNCTION__); \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#define if_error_log_location_and_return(val) \
|
||||
do { \
|
||||
if (Globals::error) { \
|
||||
log_location(); \
|
||||
return val; \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#ifdef _DEBUG
|
||||
#define try_or_else_return(val) \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if (Globals::error) { \
|
||||
log_location(); \
|
||||
return val; \
|
||||
} \
|
||||
break; \
|
||||
} \
|
||||
else label(body,__LINE__):
|
||||
;
|
||||
#else
|
||||
#define try_or_else_return(val)
|
||||
#endif
|
||||
|
||||
#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_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 and also it will fill
|
||||
// out the source code location
|
||||
#define _define_helper(def, docs, special) \
|
||||
Parser::parser_file = file_name_built_ins; \
|
||||
Parser::parser_line = __LINE__; \
|
||||
Parser::parser_col = 0; \
|
||||
auto label(params,__LINE__) = Parser::parse_single_expression( \
|
||||
Memory::get_c_str(Memory::create_string(#def))); \
|
||||
if_error_log_location_and_return(nullptr); \
|
||||
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); \
|
||||
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
|
||||
if_error_log_location_and_return(nullptr); \
|
||||
label(sfun,__LINE__)->docstring = Memory::create_string(docs); \
|
||||
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
|
||||
label(sfun,__LINE__)->value.cFunction->body = []() -> 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)
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* iterate over lisp vectors
|
||||
*/
|
||||
#define for_lisp_vector(v) \
|
||||
if (!v); else \
|
||||
if (int it_index = 0); else \
|
||||
for (auto it = v->value.vector.data; \
|
||||
it_index < v->value.vector.length; \
|
||||
it=v->value.vector.data+(++it_index))
|
||||
|
||||
/*
|
||||
* iterate over lisp lists
|
||||
*/
|
||||
#define for_lisp_list(l) \
|
||||
if (!l); else \
|
||||
if (int it_index = 0); else \
|
||||
for (Lisp_Object* head = l, *it; \
|
||||
Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
|
||||
head = head->value.pair.rest, ++it_index)
|
||||
#define concat_( a, b) a##b
|
||||
#define label(prefix, lnum) concat_(prefix,lnum)
|
||||
|
||||
#define log_location() \
|
||||
do { \
|
||||
if (Globals::log_level == Log_Level::Debug) { \
|
||||
printf("in"); \
|
||||
int spacing = 30-(int)strlen(__FILE__); \
|
||||
if (spacing < 1) spacing = 1; \
|
||||
for (int i = 0; i < spacing;++i) \
|
||||
printf(" "); \
|
||||
printf("%s (%d) ", __FILE__, __LINE__); \
|
||||
printf("-> %s\n",__FUNCTION__); \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#define if_error_log_location_and_return(val) \
|
||||
do { \
|
||||
if (Globals::error) { \
|
||||
log_location(); \
|
||||
return val; \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#ifdef _DEBUG
|
||||
#define try_or_else_return(val) \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if (Globals::error) { \
|
||||
log_location(); \
|
||||
return val; \
|
||||
} \
|
||||
break; \
|
||||
} \
|
||||
else label(body,__LINE__):
|
||||
;
|
||||
#else
|
||||
#define try_or_else_return(val)
|
||||
#endif
|
||||
|
||||
#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_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 and also it will fill
|
||||
// out the source code location
|
||||
#define _define_helper(def, docs, special) \
|
||||
Parser::parser_file = file_name_built_ins; \
|
||||
Parser::parser_line = __LINE__; \
|
||||
Parser::parser_col = 0; \
|
||||
auto label(params,__LINE__) = Parser::parse_single_expression( \
|
||||
Memory::get_c_str(Memory::create_string(#def))); \
|
||||
if_error_log_location_and_return(nullptr); \
|
||||
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); \
|
||||
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
|
||||
if_error_log_location_and_return(nullptr); \
|
||||
label(sfun,__LINE__)->docstring = Memory::create_string(docs); \
|
||||
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
|
||||
label(sfun,__LINE__)->value.cFunction->body = []() -> 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)
|
||||
|
||||
|
||||
|
||||
/*
|
||||
* iterate over lisp vectors
|
||||
*/
|
||||
#define for_lisp_vector(v) \
|
||||
if (!v); else \
|
||||
if (int it_index = 0); else \
|
||||
for (auto it = v->value.vector.data; \
|
||||
it_index < v->value.vector.length; \
|
||||
it=v->value.vector.data+(++it_index))
|
||||
|
||||
/*
|
||||
* iterate over lisp lists
|
||||
*/
|
||||
#define for_lisp_list(l) \
|
||||
if (!l); else \
|
||||
if (int it_index = 0); else \
|
||||
for (Lisp_Object* head = l, *it; \
|
||||
Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
|
||||
head = head->value.pair.rest, ++it_index)
|
||||
|
||||
+237
-237
@@ -1,237 +1,237 @@
|
||||
#pragma once
|
||||
|
||||
// #include <functional>
|
||||
#include "ftb/arraylist.hpp"
|
||||
#include "ftb/hashmap.hpp"
|
||||
|
||||
namespace Slime {
|
||||
struct Lisp_Object;
|
||||
struct String;
|
||||
struct Environment;
|
||||
|
||||
enum struct Thread_Type {
|
||||
Main,
|
||||
GarbageCollection
|
||||
};
|
||||
|
||||
enum struct Lisp_Object_Type {
|
||||
Nil,
|
||||
T,
|
||||
Symbol,
|
||||
Keyword,
|
||||
Number,
|
||||
String,
|
||||
Pair,
|
||||
Vector,
|
||||
Continuation,
|
||||
Pointer,
|
||||
HashMap,
|
||||
// OwningPointer,
|
||||
Function,
|
||||
CFunction,
|
||||
};
|
||||
|
||||
enum class Lisp_Object_Flags
|
||||
{
|
||||
// bits 1 to 5 (including) will be reserved for the type
|
||||
Already_Garbage_Collected = 1 << 5,
|
||||
Under_Construction = 1 << 6,
|
||||
};
|
||||
|
||||
enum struct Function_Type {
|
||||
Lambda,
|
||||
Macro
|
||||
};
|
||||
|
||||
enum struct Log_Level {
|
||||
None,
|
||||
Critical,
|
||||
Warning,
|
||||
Info,
|
||||
Debug,
|
||||
};
|
||||
|
||||
struct Continuation {
|
||||
Array_List<Lisp_Object*> call_stack;
|
||||
Array_List<Environment*> envi_stack;
|
||||
};
|
||||
|
||||
struct String {
|
||||
int length;
|
||||
char data;
|
||||
};
|
||||
|
||||
struct Source_Code_Location {
|
||||
String* file;
|
||||
int line;
|
||||
int column;
|
||||
};
|
||||
|
||||
struct Pair {
|
||||
Lisp_Object* first;
|
||||
Lisp_Object* rest;
|
||||
};
|
||||
|
||||
struct Vector {
|
||||
int length;
|
||||
Lisp_Object* data;
|
||||
};
|
||||
|
||||
struct Positional_Arguments {
|
||||
Array_List<Lisp_Object*> symbols;
|
||||
};
|
||||
|
||||
struct Keyword_Arguments {
|
||||
// Array of Pointers to Lisp_Object<Keyword>
|
||||
Array_List<Lisp_Object*> keywords;
|
||||
// NOTE(Felix): values[i] will be nullptr if no defalut value was
|
||||
// declared for key identifiers[i]
|
||||
Array_List<Lisp_Object*> values;
|
||||
};
|
||||
|
||||
struct Arguments {
|
||||
Positional_Arguments positional;
|
||||
Keyword_Arguments keyword;
|
||||
// NOTE(Felix): rest_argument will be nullptr if no rest argument
|
||||
// is declared otherwise its a symbol
|
||||
Lisp_Object* rest;
|
||||
};
|
||||
|
||||
struct Environment {
|
||||
Array_List<Environment*> parents;
|
||||
Hash_Map<void*, Lisp_Object*> hm;
|
||||
|
||||
~Environment() {
|
||||
parents.~Array_List();
|
||||
hm.~Hash_Map();
|
||||
}
|
||||
};
|
||||
|
||||
struct Function {
|
||||
Function_Type type;
|
||||
Arguments args;
|
||||
Lisp_Object* body; // maybe implicit begin
|
||||
Environment* parent_environment; // we are doing closures now!!
|
||||
};
|
||||
|
||||
struct cFunction {
|
||||
Lisp_Object* (*body)();
|
||||
Arguments args;
|
||||
bool is_special_form;
|
||||
};
|
||||
|
||||
struct Lisp_Object {
|
||||
Source_Code_Location* sourceCodeLocation;
|
||||
u64 flags;
|
||||
Lisp_Object* userType; // keyword
|
||||
String* docstring;
|
||||
union value {
|
||||
String* symbol; // used for symbols and keywords
|
||||
double number;
|
||||
String* string;
|
||||
Pair pair;
|
||||
Vector vector;
|
||||
Function* function;
|
||||
cFunction* cFunction;
|
||||
void* pointer;
|
||||
Continuation* continuation;
|
||||
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
|
||||
~value() {}
|
||||
} value;
|
||||
~Lisp_Object();
|
||||
};
|
||||
|
||||
struct Error {
|
||||
Lisp_Object* position;
|
||||
// type has to be a keyword
|
||||
Lisp_Object* type;
|
||||
String* message;
|
||||
};
|
||||
|
||||
|
||||
const wchar_t* char_to_wchar(const char* c);
|
||||
char* read_entire_file(char* filename);
|
||||
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_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
|
||||
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
|
||||
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*);
|
||||
|
||||
bool run_all_tests();
|
||||
|
||||
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);
|
||||
void log_error();
|
||||
|
||||
namespace Memory {
|
||||
Environment* create_built_ins_environment();
|
||||
Lisp_Object* create_lisp_object_cfunction(bool is_special);
|
||||
inline Lisp_Object_Type get_type(Lisp_Object* node);
|
||||
void init(int);
|
||||
char* get_c_str(String*);
|
||||
void free_everything();
|
||||
String* create_string(const char*);
|
||||
Lisp_Object* get_symbol(String* identifier);
|
||||
Lisp_Object* get_symbol(const char*);
|
||||
Lisp_Object* get_keyword(String* identifier);
|
||||
Lisp_Object* get_keyword(const char*);
|
||||
Lisp_Object* create_lisp_object(double);
|
||||
Lisp_Object* create_lisp_object(const char*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
}
|
||||
|
||||
namespace Parser {
|
||||
// extern Environment* environment_for_macros;
|
||||
|
||||
extern String* standard_in;
|
||||
extern String* parser_file;
|
||||
extern int parser_line;
|
||||
extern int parser_col;
|
||||
|
||||
Lisp_Object* parse_single_expression(char* text);
|
||||
Lisp_Object* parse_single_expression(wchar_t* text);
|
||||
}
|
||||
|
||||
namespace Globals {
|
||||
extern char* bin_path;
|
||||
extern Log_Level log_level;
|
||||
extern Array_List<void*> load_path;
|
||||
namespace Current_Execution {
|
||||
extern Array_List<Lisp_Object*> call_stack;
|
||||
extern Array_List<Environment*> envi_stack;
|
||||
}
|
||||
|
||||
extern Error* error;
|
||||
extern bool breaking_on_errors;
|
||||
}
|
||||
}
|
||||
#pragma once
|
||||
|
||||
// #include <functional>
|
||||
#include "ftb/arraylist.hpp"
|
||||
#include "ftb/hashmap.hpp"
|
||||
|
||||
namespace Slime {
|
||||
struct Lisp_Object;
|
||||
struct String;
|
||||
struct Environment;
|
||||
|
||||
enum struct Thread_Type {
|
||||
Main,
|
||||
GarbageCollection
|
||||
};
|
||||
|
||||
enum struct Lisp_Object_Type {
|
||||
Nil,
|
||||
T,
|
||||
Symbol,
|
||||
Keyword,
|
||||
Number,
|
||||
String,
|
||||
Pair,
|
||||
Vector,
|
||||
Continuation,
|
||||
Pointer,
|
||||
HashMap,
|
||||
// OwningPointer,
|
||||
Function,
|
||||
CFunction,
|
||||
};
|
||||
|
||||
enum class Lisp_Object_Flags
|
||||
{
|
||||
// bits 1 to 5 (including) will be reserved for the type
|
||||
Already_Garbage_Collected = 1 << 5,
|
||||
Under_Construction = 1 << 6,
|
||||
};
|
||||
|
||||
enum struct Function_Type {
|
||||
Lambda,
|
||||
Macro
|
||||
};
|
||||
|
||||
enum struct Log_Level {
|
||||
None,
|
||||
Critical,
|
||||
Warning,
|
||||
Info,
|
||||
Debug,
|
||||
};
|
||||
|
||||
struct Continuation {
|
||||
Array_List<Lisp_Object*> call_stack;
|
||||
Array_List<Environment*> envi_stack;
|
||||
};
|
||||
|
||||
struct String {
|
||||
int length;
|
||||
char data;
|
||||
};
|
||||
|
||||
struct Source_Code_Location {
|
||||
String* file;
|
||||
int line;
|
||||
int column;
|
||||
};
|
||||
|
||||
struct Pair {
|
||||
Lisp_Object* first;
|
||||
Lisp_Object* rest;
|
||||
};
|
||||
|
||||
struct Vector {
|
||||
int length;
|
||||
Lisp_Object* data;
|
||||
};
|
||||
|
||||
struct Positional_Arguments {
|
||||
Array_List<Lisp_Object*> symbols;
|
||||
};
|
||||
|
||||
struct Keyword_Arguments {
|
||||
// Array of Pointers to Lisp_Object<Keyword>
|
||||
Array_List<Lisp_Object*> keywords;
|
||||
// NOTE(Felix): values[i] will be nullptr if no defalut value was
|
||||
// declared for key identifiers[i]
|
||||
Array_List<Lisp_Object*> values;
|
||||
};
|
||||
|
||||
struct Arguments {
|
||||
Positional_Arguments positional;
|
||||
Keyword_Arguments keyword;
|
||||
// NOTE(Felix): rest_argument will be nullptr if no rest argument
|
||||
// is declared otherwise its a symbol
|
||||
Lisp_Object* rest;
|
||||
};
|
||||
|
||||
struct Environment {
|
||||
Array_List<Environment*> parents;
|
||||
Hash_Map<void*, Lisp_Object*> hm;
|
||||
|
||||
~Environment() {
|
||||
parents.~Array_List();
|
||||
hm.~Hash_Map();
|
||||
}
|
||||
};
|
||||
|
||||
struct Function {
|
||||
Function_Type type;
|
||||
Arguments args;
|
||||
Lisp_Object* body; // maybe implicit begin
|
||||
Environment* parent_environment; // we are doing closures now!!
|
||||
};
|
||||
|
||||
struct cFunction {
|
||||
Lisp_Object* (*body)();
|
||||
Arguments args;
|
||||
bool is_special_form;
|
||||
};
|
||||
|
||||
struct Lisp_Object {
|
||||
Source_Code_Location* sourceCodeLocation;
|
||||
u64 flags;
|
||||
Lisp_Object* userType; // keyword
|
||||
String* docstring;
|
||||
union value {
|
||||
String* symbol; // used for symbols and keywords
|
||||
double number;
|
||||
String* string;
|
||||
Pair pair;
|
||||
Vector vector;
|
||||
Function* function;
|
||||
cFunction* cFunction;
|
||||
void* pointer;
|
||||
Continuation* continuation;
|
||||
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
|
||||
~value() {}
|
||||
} value;
|
||||
~Lisp_Object();
|
||||
};
|
||||
|
||||
struct Error {
|
||||
Lisp_Object* position;
|
||||
// type has to be a keyword
|
||||
Lisp_Object* type;
|
||||
String* message;
|
||||
};
|
||||
|
||||
|
||||
const wchar_t* char_to_wchar(const char* c);
|
||||
char* read_entire_file(char* filename);
|
||||
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_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
|
||||
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
|
||||
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*);
|
||||
|
||||
bool run_all_tests();
|
||||
|
||||
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);
|
||||
void log_error();
|
||||
|
||||
namespace Memory {
|
||||
Environment* create_built_ins_environment();
|
||||
Lisp_Object* create_lisp_object_cfunction(bool is_special);
|
||||
inline Lisp_Object_Type get_type(Lisp_Object* node);
|
||||
void init(int);
|
||||
char* get_c_str(String*);
|
||||
void free_everything();
|
||||
String* create_string(const char*);
|
||||
Lisp_Object* get_symbol(String* identifier);
|
||||
Lisp_Object* get_symbol(const char*);
|
||||
Lisp_Object* get_keyword(String* identifier);
|
||||
Lisp_Object* get_keyword(const char*);
|
||||
Lisp_Object* create_lisp_object(double);
|
||||
Lisp_Object* create_lisp_object(const char*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
|
||||
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||
}
|
||||
|
||||
namespace Parser {
|
||||
// extern Environment* environment_for_macros;
|
||||
|
||||
extern String* standard_in;
|
||||
extern String* parser_file;
|
||||
extern int parser_line;
|
||||
extern int parser_col;
|
||||
|
||||
Lisp_Object* parse_single_expression(char* text);
|
||||
Lisp_Object* parse_single_expression(wchar_t* text);
|
||||
}
|
||||
|
||||
namespace Globals {
|
||||
extern char* bin_path;
|
||||
extern Log_Level log_level;
|
||||
extern Array_List<void*> load_path;
|
||||
namespace Current_Execution {
|
||||
extern Array_List<Lisp_Object*> call_stack;
|
||||
extern Array_List<Environment*> envi_stack;
|
||||
}
|
||||
|
||||
extern Error* error;
|
||||
extern bool breaking_on_errors;
|
||||
}
|
||||
}
|
||||
|
||||
+398
-398
@@ -1,398 +1,398 @@
|
||||
namespace Parser {
|
||||
String* standard_in;
|
||||
String* parser_file;
|
||||
int parser_line;
|
||||
int parser_col;
|
||||
|
||||
proc eat_comment_line(char* text, int* index_in_text) -> void {
|
||||
// safety check if we are actually starting a comment here
|
||||
if (text[*index_in_text] != ';')
|
||||
return;
|
||||
|
||||
// eat the comment line
|
||||
do {
|
||||
++(*index_in_text);
|
||||
++parser_col;
|
||||
} while (text[(*index_in_text)] != '\n' &&
|
||||
text[(*index_in_text)] != '\r' &&
|
||||
text[(*index_in_text)] != '\0');
|
||||
}
|
||||
|
||||
proc step_char(char* text, int* index_in_text, int steps = 1) {
|
||||
for (int i = 0; i < steps; ++i) {
|
||||
if (text[(*index_in_text)] == '\n') {
|
||||
++parser_line;
|
||||
parser_col = 0;
|
||||
}
|
||||
++parser_col;
|
||||
++(*index_in_text);
|
||||
}
|
||||
}
|
||||
|
||||
proc eat_whitespace(char* text, int* index_in_text) -> void {
|
||||
// skip whitespaces
|
||||
while (text[(*index_in_text)] == ' ' ||
|
||||
text[(*index_in_text)] == '\t' ||
|
||||
text[(*index_in_text)] == '\n' ||
|
||||
text[(*index_in_text)] == '\r')
|
||||
{
|
||||
step_char(text, index_in_text);
|
||||
}
|
||||
}
|
||||
|
||||
proc eat_until_code(char* text, int* index_in_text) -> void {
|
||||
profile_this();
|
||||
int position_before;
|
||||
do {
|
||||
position_before = *index_in_text;
|
||||
eat_comment_line(text, index_in_text);
|
||||
eat_whitespace(text, index_in_text);
|
||||
} while (position_before != *index_in_text);
|
||||
}
|
||||
|
||||
proc step_char_and_eat_until_code(char* text, int* index_in_text) {
|
||||
step_char(text, index_in_text);
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
|
||||
proc parse_fancy_delimiter(char* text, int* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* {
|
||||
profile_this();
|
||||
if (text[*index_in_text] != l_delimiter) {
|
||||
create_parsing_error("a fancy cannot be parsed here");
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
Lisp_Object* ret;
|
||||
Lisp_Object* head;
|
||||
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
||||
head = ret;
|
||||
|
||||
step_char(text, index_in_text);
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
while (text[*index_in_text] != r_delimiter) {
|
||||
Lisp_Object* element;
|
||||
try element = parse_expression(text, index_in_text);
|
||||
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
||||
head = head->value.pair.rest;
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
|
||||
step_char(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc get_atom_text_length(char* text, int* index_in_text) -> int {
|
||||
int atom_length = 0;
|
||||
while (text[*index_in_text+atom_length] != ' ' &&
|
||||
text[*index_in_text+atom_length] != ')' &&
|
||||
text[*index_in_text+atom_length] != '(' &&
|
||||
text[*index_in_text+atom_length] != '[' &&
|
||||
text[*index_in_text+atom_length] != ']' &&
|
||||
text[*index_in_text+atom_length] != '{' &&
|
||||
text[*index_in_text+atom_length] != '}' &&
|
||||
text[*index_in_text+atom_length] != '\0' &&
|
||||
text[*index_in_text+atom_length] != '\n' &&
|
||||
text[*index_in_text+atom_length] != '\r' &&
|
||||
text[*index_in_text+atom_length] != '\t')
|
||||
{
|
||||
++atom_length;
|
||||
}
|
||||
return atom_length;
|
||||
}
|
||||
|
||||
proc parse_number(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(0.0);
|
||||
|
||||
sscanf(text+*index_in_text, "%lf", &ret->value.number);
|
||||
|
||||
int atom_length = get_atom_text_length(text, index_in_text);
|
||||
step_char(text, index_in_text, atom_length);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
bool keyword = false;
|
||||
if (text[*index_in_text] == ':') {
|
||||
keyword = true;
|
||||
step_char(text, index_in_text);
|
||||
}
|
||||
|
||||
int atom_length = get_atom_text_length(text, index_in_text);
|
||||
char orig = text[*index_in_text+atom_length];
|
||||
text[*index_in_text+atom_length] = '\0';
|
||||
|
||||
|
||||
String* str_keyword;
|
||||
Lisp_Object* ret;
|
||||
try str_keyword = Memory::create_string("", atom_length);
|
||||
strcpy(&str_keyword->data, text+*index_in_text);
|
||||
|
||||
if (keyword) {
|
||||
try ret = Memory::get_keyword(str_keyword);
|
||||
} else {
|
||||
try ret = Memory::get_symbol(str_keyword);
|
||||
}
|
||||
|
||||
|
||||
text[*index_in_text+atom_length] = orig;
|
||||
step_char(text, index_in_text, atom_length);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_string(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
// the first character is the '"'
|
||||
step_char(text, index_in_text);
|
||||
|
||||
// now we are at the first letter, if this is the closing '"' then
|
||||
// it's easy
|
||||
if (text[*index_in_text] == '"') {
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(Memory::create_string("", 0));
|
||||
// inject_scl(ret);
|
||||
|
||||
// plus one because we want to go after the quotes
|
||||
step_char(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
// okay so the first letter was not actually closing the string...
|
||||
int string_length = 0;
|
||||
bool escaping = false;
|
||||
while (escaping || text[*index_in_text+string_length] != '"') {
|
||||
if (escaping) {
|
||||
escaping = false;
|
||||
}
|
||||
else
|
||||
if (text[*index_in_text+string_length] == '\\')
|
||||
escaping = true;
|
||||
|
||||
++string_length;
|
||||
}
|
||||
|
||||
// we found the end of the string
|
||||
text[*index_in_text+string_length] = '\0';
|
||||
|
||||
// NOTE(Felix): Tactic: Through unescaping the string will
|
||||
// only get shorter, so we replace it inplace and later jump
|
||||
// to the original end of the string.
|
||||
int new_len;
|
||||
try new_len = unescape_string(text+(*index_in_text));
|
||||
|
||||
String* string = Memory::create_string("", new_len);
|
||||
|
||||
strcpy(&string->data, text+(*index_in_text));
|
||||
// printf("------ %s\n", &string->data);
|
||||
|
||||
text[*index_in_text+string_length] = '"';
|
||||
|
||||
// plus one because we want to go after the quotes
|
||||
step_char(text, index_in_text, string_length+1);
|
||||
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(string);
|
||||
|
||||
// inject_scl(ret);
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* ret;
|
||||
// numbers
|
||||
if ((text[*index_in_text] <= 57 && // if number
|
||||
text[*index_in_text] >= 48)
|
||||
||
|
||||
((text[*index_in_text] == '+' || // or if sign and then number
|
||||
text[*index_in_text] == '-')
|
||||
&&
|
||||
(text[*index_in_text +1] <= 57 &&
|
||||
text[*index_in_text +1] >= 48))
|
||||
||
|
||||
((text[*index_in_text] == '.') // or if . and then number
|
||||
&&
|
||||
(text[*index_in_text +1] <= 57 &&
|
||||
text[*index_in_text +1] >= 48)))
|
||||
{
|
||||
try ret = parse_number(text, index_in_text);
|
||||
}
|
||||
|
||||
else if (text[*index_in_text] == '"')
|
||||
try ret = parse_string(text, index_in_text);
|
||||
else
|
||||
try ret = parse_symbol_or_keyword(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
|
||||
proc parse_list(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
if (text[*index_in_text] != '(') {
|
||||
create_parsing_error("a list cannot be parsed here");
|
||||
return nullptr;
|
||||
}
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
|
||||
if (text[*index_in_text] == ')') {
|
||||
step_char(text, index_in_text);
|
||||
return Memory::nil;
|
||||
}
|
||||
|
||||
Lisp_Object* first_elem;
|
||||
Lisp_Object* ret;
|
||||
Lisp_Object* head;
|
||||
|
||||
|
||||
try first_elem = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
||||
head = ret;
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
while (text[*index_in_text] != ')') {
|
||||
Lisp_Object* element;
|
||||
|
||||
if (text[*index_in_text+0] == '.' &&
|
||||
text[*index_in_text+1] == ' ')
|
||||
{
|
||||
step_char(text, index_in_text, 2);
|
||||
try element = parse_expression(text, index_in_text);
|
||||
head->value.pair.rest = element;
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
if (text[*index_in_text] != ')') {
|
||||
create_parsing_error("expected the list to end after the dotted end.");
|
||||
return nullptr;
|
||||
}
|
||||
step_char(text, index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
try element = parse_expression(text, index_in_text);
|
||||
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
||||
head = head->value.pair.rest;
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
step_char(text, index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* vector_sym = Memory::get_symbol("vector");
|
||||
Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map");
|
||||
|
||||
Lisp_Object* quote_sym = Memory::get_symbol("quote");
|
||||
Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote");
|
||||
Lisp_Object* unquote_sym = Memory::get_symbol("unquote");
|
||||
Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
|
||||
|
||||
Lisp_Object* ret = nullptr;
|
||||
Lisp_Object* expr;
|
||||
|
||||
switch (text[*index_in_text]) {
|
||||
case '\'': {
|
||||
// quote
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(quote_sym, ret);
|
||||
} break;
|
||||
case '`': {
|
||||
// quasiquote
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(quasiquote_sym, ret);
|
||||
} break;
|
||||
case ',': {
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
if (text[*index_in_text] == '@') {
|
||||
// unquote-splicing
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, ret);
|
||||
} else {
|
||||
// unquote
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(unquote_sym, ret);
|
||||
}
|
||||
} break;
|
||||
case '[': {
|
||||
// vector
|
||||
try ret = parse_fancy_delimiter(text, index_in_text, '[', ']', vector_sym);
|
||||
} break;
|
||||
case '{': {
|
||||
// hashmap
|
||||
try ret = parse_fancy_delimiter(text, index_in_text, '{', '}', hash_map_sym);
|
||||
} break;
|
||||
default: break;
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* ret;
|
||||
eat_until_code(text, index_in_text);
|
||||
try ret = maybe_expand_short_form(text, index_in_text);
|
||||
if (ret)
|
||||
return ret;
|
||||
|
||||
if (text[*index_in_text] == '(') {
|
||||
try ret = parse_list(text, index_in_text);
|
||||
} else {
|
||||
try ret = parse_atom(text, index_in_text);
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
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;
|
||||
parser_col = 1;
|
||||
|
||||
int index_in_text = 0;
|
||||
Lisp_Object* ret;
|
||||
try ret = parse_expression(text, &index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
proc parse_program(String* file_name, char* text) -> Array_List<Lisp_Object*>* {
|
||||
profile_this();
|
||||
parser_file = file_name;
|
||||
parser_line = 1;
|
||||
parser_col = 0;
|
||||
|
||||
Array_List<Lisp_Object*>* program = new Array_List<Lisp_Object*>;
|
||||
|
||||
int index_in_text = 0;
|
||||
Lisp_Object* parsed;
|
||||
|
||||
eat_until_code(text, &index_in_text);
|
||||
while (text[index_in_text] != '\0') {
|
||||
try parsed = parse_expression(text, &index_in_text);
|
||||
program->append(parsed);
|
||||
eat_until_code(text, &index_in_text);
|
||||
}
|
||||
return program;
|
||||
}
|
||||
|
||||
}
|
||||
namespace Parser {
|
||||
String* standard_in;
|
||||
String* parser_file;
|
||||
int parser_line;
|
||||
int parser_col;
|
||||
|
||||
proc eat_comment_line(char* text, int* index_in_text) -> void {
|
||||
// safety check if we are actually starting a comment here
|
||||
if (text[*index_in_text] != ';')
|
||||
return;
|
||||
|
||||
// eat the comment line
|
||||
do {
|
||||
++(*index_in_text);
|
||||
++parser_col;
|
||||
} while (text[(*index_in_text)] != '\n' &&
|
||||
text[(*index_in_text)] != '\r' &&
|
||||
text[(*index_in_text)] != '\0');
|
||||
}
|
||||
|
||||
proc step_char(char* text, int* index_in_text, int steps = 1) {
|
||||
for (int i = 0; i < steps; ++i) {
|
||||
if (text[(*index_in_text)] == '\n') {
|
||||
++parser_line;
|
||||
parser_col = 0;
|
||||
}
|
||||
++parser_col;
|
||||
++(*index_in_text);
|
||||
}
|
||||
}
|
||||
|
||||
proc eat_whitespace(char* text, int* index_in_text) -> void {
|
||||
// skip whitespaces
|
||||
while (text[(*index_in_text)] == ' ' ||
|
||||
text[(*index_in_text)] == '\t' ||
|
||||
text[(*index_in_text)] == '\n' ||
|
||||
text[(*index_in_text)] == '\r')
|
||||
{
|
||||
step_char(text, index_in_text);
|
||||
}
|
||||
}
|
||||
|
||||
proc eat_until_code(char* text, int* index_in_text) -> void {
|
||||
profile_this();
|
||||
int position_before;
|
||||
do {
|
||||
position_before = *index_in_text;
|
||||
eat_comment_line(text, index_in_text);
|
||||
eat_whitespace(text, index_in_text);
|
||||
} while (position_before != *index_in_text);
|
||||
}
|
||||
|
||||
proc step_char_and_eat_until_code(char* text, int* index_in_text) {
|
||||
step_char(text, index_in_text);
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
|
||||
proc parse_fancy_delimiter(char* text, int* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* {
|
||||
profile_this();
|
||||
if (text[*index_in_text] != l_delimiter) {
|
||||
create_parsing_error("a fancy cannot be parsed here");
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
Lisp_Object* ret;
|
||||
Lisp_Object* head;
|
||||
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
||||
head = ret;
|
||||
|
||||
step_char(text, index_in_text);
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
while (text[*index_in_text] != r_delimiter) {
|
||||
Lisp_Object* element;
|
||||
try element = parse_expression(text, index_in_text);
|
||||
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
||||
head = head->value.pair.rest;
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
|
||||
step_char(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc get_atom_text_length(char* text, int* index_in_text) -> int {
|
||||
int atom_length = 0;
|
||||
while (text[*index_in_text+atom_length] != ' ' &&
|
||||
text[*index_in_text+atom_length] != ')' &&
|
||||
text[*index_in_text+atom_length] != '(' &&
|
||||
text[*index_in_text+atom_length] != '[' &&
|
||||
text[*index_in_text+atom_length] != ']' &&
|
||||
text[*index_in_text+atom_length] != '{' &&
|
||||
text[*index_in_text+atom_length] != '}' &&
|
||||
text[*index_in_text+atom_length] != '\0' &&
|
||||
text[*index_in_text+atom_length] != '\n' &&
|
||||
text[*index_in_text+atom_length] != '\r' &&
|
||||
text[*index_in_text+atom_length] != '\t')
|
||||
{
|
||||
++atom_length;
|
||||
}
|
||||
return atom_length;
|
||||
}
|
||||
|
||||
proc parse_number(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(0.0);
|
||||
|
||||
sscanf(text+*index_in_text, "%lf", &ret->value.number);
|
||||
|
||||
int atom_length = get_atom_text_length(text, index_in_text);
|
||||
step_char(text, index_in_text, atom_length);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
bool keyword = false;
|
||||
if (text[*index_in_text] == ':') {
|
||||
keyword = true;
|
||||
step_char(text, index_in_text);
|
||||
}
|
||||
|
||||
int atom_length = get_atom_text_length(text, index_in_text);
|
||||
char orig = text[*index_in_text+atom_length];
|
||||
text[*index_in_text+atom_length] = '\0';
|
||||
|
||||
|
||||
String* str_keyword;
|
||||
Lisp_Object* ret;
|
||||
try str_keyword = Memory::create_string("", atom_length);
|
||||
strcpy(&str_keyword->data, text+*index_in_text);
|
||||
|
||||
if (keyword) {
|
||||
try ret = Memory::get_keyword(str_keyword);
|
||||
} else {
|
||||
try ret = Memory::get_symbol(str_keyword);
|
||||
}
|
||||
|
||||
|
||||
text[*index_in_text+atom_length] = orig;
|
||||
step_char(text, index_in_text, atom_length);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_string(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
// the first character is the '"'
|
||||
step_char(text, index_in_text);
|
||||
|
||||
// now we are at the first letter, if this is the closing '"' then
|
||||
// it's easy
|
||||
if (text[*index_in_text] == '"') {
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(Memory::create_string("", 0));
|
||||
// inject_scl(ret);
|
||||
|
||||
// plus one because we want to go after the quotes
|
||||
step_char(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
// okay so the first letter was not actually closing the string...
|
||||
int string_length = 0;
|
||||
bool escaping = false;
|
||||
while (escaping || text[*index_in_text+string_length] != '"') {
|
||||
if (escaping) {
|
||||
escaping = false;
|
||||
}
|
||||
else
|
||||
if (text[*index_in_text+string_length] == '\\')
|
||||
escaping = true;
|
||||
|
||||
++string_length;
|
||||
}
|
||||
|
||||
// we found the end of the string
|
||||
text[*index_in_text+string_length] = '\0';
|
||||
|
||||
// NOTE(Felix): Tactic: Through unescaping the string will
|
||||
// only get shorter, so we replace it inplace and later jump
|
||||
// to the original end of the string.
|
||||
int new_len;
|
||||
try new_len = unescape_string(text+(*index_in_text));
|
||||
|
||||
String* string = Memory::create_string("", new_len);
|
||||
|
||||
strcpy(&string->data, text+(*index_in_text));
|
||||
// printf("------ %s\n", &string->data);
|
||||
|
||||
text[*index_in_text+string_length] = '"';
|
||||
|
||||
// plus one because we want to go after the quotes
|
||||
step_char(text, index_in_text, string_length+1);
|
||||
|
||||
Lisp_Object* ret;
|
||||
try ret = Memory::create_lisp_object(string);
|
||||
|
||||
// inject_scl(ret);
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* ret;
|
||||
// numbers
|
||||
if ((text[*index_in_text] <= 57 && // if number
|
||||
text[*index_in_text] >= 48)
|
||||
||
|
||||
((text[*index_in_text] == '+' || // or if sign and then number
|
||||
text[*index_in_text] == '-')
|
||||
&&
|
||||
(text[*index_in_text +1] <= 57 &&
|
||||
text[*index_in_text +1] >= 48))
|
||||
||
|
||||
((text[*index_in_text] == '.') // or if . and then number
|
||||
&&
|
||||
(text[*index_in_text +1] <= 57 &&
|
||||
text[*index_in_text +1] >= 48)))
|
||||
{
|
||||
try ret = parse_number(text, index_in_text);
|
||||
}
|
||||
|
||||
else if (text[*index_in_text] == '"')
|
||||
try ret = parse_string(text, index_in_text);
|
||||
else
|
||||
try ret = parse_symbol_or_keyword(text, index_in_text);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
|
||||
proc parse_list(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
if (text[*index_in_text] != '(') {
|
||||
create_parsing_error("a list cannot be parsed here");
|
||||
return nullptr;
|
||||
}
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
|
||||
if (text[*index_in_text] == ')') {
|
||||
step_char(text, index_in_text);
|
||||
return Memory::nil;
|
||||
}
|
||||
|
||||
Lisp_Object* first_elem;
|
||||
Lisp_Object* ret;
|
||||
Lisp_Object* head;
|
||||
|
||||
|
||||
try first_elem = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil);
|
||||
head = ret;
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
while (text[*index_in_text] != ')') {
|
||||
Lisp_Object* element;
|
||||
|
||||
if (text[*index_in_text+0] == '.' &&
|
||||
text[*index_in_text+1] == ' ')
|
||||
{
|
||||
step_char(text, index_in_text, 2);
|
||||
try element = parse_expression(text, index_in_text);
|
||||
head->value.pair.rest = element;
|
||||
|
||||
eat_until_code(text, index_in_text);
|
||||
if (text[*index_in_text] != ')') {
|
||||
create_parsing_error("expected the list to end after the dotted end.");
|
||||
return nullptr;
|
||||
}
|
||||
step_char(text, index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
try element = parse_expression(text, index_in_text);
|
||||
try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil);
|
||||
head = head->value.pair.rest;
|
||||
eat_until_code(text, index_in_text);
|
||||
}
|
||||
step_char(text, index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* vector_sym = Memory::get_symbol("vector");
|
||||
Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map");
|
||||
|
||||
Lisp_Object* quote_sym = Memory::get_symbol("quote");
|
||||
Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote");
|
||||
Lisp_Object* unquote_sym = Memory::get_symbol("unquote");
|
||||
Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
|
||||
|
||||
Lisp_Object* ret = nullptr;
|
||||
Lisp_Object* expr;
|
||||
|
||||
switch (text[*index_in_text]) {
|
||||
case '\'': {
|
||||
// quote
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(quote_sym, ret);
|
||||
} break;
|
||||
case '`': {
|
||||
// quasiquote
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(quasiquote_sym, ret);
|
||||
} break;
|
||||
case ',': {
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
if (text[*index_in_text] == '@') {
|
||||
// unquote-splicing
|
||||
step_char_and_eat_until_code(text, index_in_text);
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, ret);
|
||||
} else {
|
||||
// unquote
|
||||
try expr = parse_expression(text, index_in_text);
|
||||
try ret = Memory::create_lisp_object_pair(expr, Memory::nil);
|
||||
try ret = Memory::create_lisp_object_pair(unquote_sym, ret);
|
||||
}
|
||||
} break;
|
||||
case '[': {
|
||||
// vector
|
||||
try ret = parse_fancy_delimiter(text, index_in_text, '[', ']', vector_sym);
|
||||
} break;
|
||||
case '{': {
|
||||
// hashmap
|
||||
try ret = parse_fancy_delimiter(text, index_in_text, '{', '}', hash_map_sym);
|
||||
} break;
|
||||
default: break;
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* {
|
||||
profile_this();
|
||||
Lisp_Object* ret;
|
||||
eat_until_code(text, index_in_text);
|
||||
try ret = maybe_expand_short_form(text, index_in_text);
|
||||
if (ret)
|
||||
return ret;
|
||||
|
||||
if (text[*index_in_text] == '(') {
|
||||
try ret = parse_list(text, index_in_text);
|
||||
} else {
|
||||
try ret = parse_atom(text, index_in_text);
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
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;
|
||||
parser_col = 1;
|
||||
|
||||
int index_in_text = 0;
|
||||
Lisp_Object* ret;
|
||||
try ret = parse_expression(text, &index_in_text);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
proc parse_program(String* file_name, char* text) -> Array_List<Lisp_Object*>* {
|
||||
profile_this();
|
||||
parser_file = file_name;
|
||||
parser_line = 1;
|
||||
parser_col = 0;
|
||||
|
||||
Array_List<Lisp_Object*>* program = new Array_List<Lisp_Object*>;
|
||||
|
||||
int index_in_text = 0;
|
||||
Lisp_Object* parsed;
|
||||
|
||||
eat_until_code(text, &index_in_text);
|
||||
while (text[index_in_text] != '\0') {
|
||||
try parsed = parse_expression(text, &index_in_text);
|
||||
program->append(parsed);
|
||||
eat_until_code(text, &index_in_text);
|
||||
}
|
||||
return program;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user