felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Docs is stored external to the lisp objects in a hashmap now

Browse Source
This commit is contained in:
Felix Brendel
2020-03-19 01:02:06 +01:00
parent 9295d57a8e
commit 4f0fef064e
16 changed files with 4336 additions and 4388 deletions
Download Patch File Download Diff File Expand all files Collapse all files
build.sh
+1 -1
View File
@@ -52,7 +52,7 @@ echo ""
echo "----------------------" echo "----------------------"
echo " running profile " echo " running profile "
echo "----------------------" echo "----------------------"
time ./slime_p --run-tests || exit 1 time ./slime_p --run-tests > /dev/null || exit 1
echo "" echo ""
echo "------------------------" echo "------------------------"
src/assert.hpp
+63 -63
View File
@@ -1,63 +1,63 @@
/** /**
Usage of the create_error_macros: Usage of the create_error_macros:
*/ */
#define __create_error(keyword, ...) \ #define __create_error(keyword, ...) \
create_error( \ create_error( \
__FUNCTION__, __FILE__, __LINE__, \ __FUNCTION__, __FILE__, __LINE__, \
Memory::get_keyword(keyword), \ Memory::get_keyword(keyword), \
__VA_ARGS__) __VA_ARGS__)
#define create_out_of_memory_error(...) \ #define create_out_of_memory_error(...) \
__create_error("out-of-memory", __VA_ARGS__) __create_error("out-of-memory", __VA_ARGS__)
#define create_generic_error(...) \ #define create_generic_error(...) \
__create_error("generic", __VA_ARGS__) __create_error("generic", __VA_ARGS__)
#define create_not_yet_implemented_error() \ #define create_not_yet_implemented_error() \
__create_error("not-yet-implemented", "This feature has not yet been implemented.") __create_error("not-yet-implemented", "This feature has not yet been implemented.")
#define create_parsing_error(...) \ #define create_parsing_error(...) \
__create_error("parsing-error", __VA_ARGS__) __create_error("parsing-error", __VA_ARGS__)
#define create_symbol_undefined_error(...) \ #define create_symbol_undefined_error(...) \
__create_error("symbol-undefined", __VA_ARGS__) __create_error("symbol-undefined", __VA_ARGS__)
#define create_type_missmatch_error(expected, actual, exp) \ #define create_type_missmatch_error(expected, actual, exp) \
__create_error("type-missmatch", \ __create_error("type-missmatch", \
"Type missmatch: expected %s, got %s in %s", \ "Type missmatch: expected %s, got %s in %s", \
expected, actual, exp) expected, actual, exp)
#ifdef _DEBUG #ifdef _DEBUG
#define assert_type(_node, _type) \ #define assert_type(_node, _type) \
do { \ do { \
if (Memory::get_type(_node) != _type) { \ if (_node->type != _type) { \
char* t = lisp_object_to_string(_node); \ char* t = lisp_object_to_string(_node); \
defer { free(t); }; \ defer { free(t); }; \
create_type_missmatch_error( \ create_type_missmatch_error( \
lisp_object_type_to_string(_type), \ lisp_object_type_to_string(_type), \
lisp_object_type_to_string(Memory::get_type(_node)), \ lisp_object_type_to_string(_node->type), \
t); \ t); \
} \ } \
} while(0) } while(0)
#define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len) #define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)
#define assert(message, condition) \ #define assert(message, condition) \
do { \ do { \
if (!(condition)) { \ if (!(condition)) { \
create_generic_error("Assertion-error: %s\n" \ create_generic_error("Assertion-error: %s\n" \
" for: %s\n" \ " for: %s\n" \
" in: %s:%d", \ " in: %s:%d", \
message, #condition, __FILE__, __LINE__); \ message, #condition, __FILE__, __LINE__); \
} \ } \
} while(0) } while(0)
#else #else
# define assert_arguments_length(expected, actual) do {} while (0) # define assert_arguments_length(expected, actual) do {} while (0)
# define assert_arguments_length_less_equal(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_arguments_length_greater_equal(expected, actual) do {} while (0)
# define assert_type(_node, _type) do {} while (0) # define assert_type(_node, _type) do {} while (0)
# define assert_list_length(_node, _len) do {} while (0) # define assert_list_length(_node, _len) do {} while (0)
# define assert(message, condition) do {} while (0) # define assert(message, condition) do {} while (0)
#endif #endif
src/built_ins.cpp
+1271 -1267
View File
File diff suppressed because it is too large Load Diff
src/define_macros.hpp
+159 -159
View File
@@ -1,159 +1,159 @@
#define concat_( a, b) a##b #define concat_( a, b) a##b
#define label(prefix, lnum) concat_(prefix,lnum) #define label(prefix, lnum) concat_(prefix,lnum)
#define log_location() \ #define log_location() \
do { \ do { \
if (Globals::log_level == Log_Level::Debug) { \ if (Globals::log_level == Log_Level::Debug) { \
printf("in"); \ printf("in"); \
int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\ int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\
if (spacing < 1) spacing = 1; \ if (spacing < 1) spacing = 1; \
for (int i = 0; i < spacing;++i) \ for (int i = 0; i < spacing;++i) \
printf(" "); \ printf(" "); \
printf("%s (%d) ", __FILE__, __LINE__); \ printf("%s (%d) ", __FILE__, __LINE__); \
printf("-> %s\n",__FUNCTION__); \ printf("-> %s\n",__FUNCTION__); \
} \ } \
} while(0) } while(0)
#define if_error_log_location_and_return(val) \ #define if_error_log_location_and_return(val) \
do { \ do { \
if (Globals::error) { \ if (Globals::error) { \
log_location(); \ log_location(); \
return val; \ return val; \
} \ } \
} while(0) } while(0)
#ifdef _DEBUG #ifdef _DEBUG
#define try_or_else_return(val) \ #define try_or_else_return(val) \
if (1) \ if (1) \
goto label(body,__LINE__); \ goto label(body,__LINE__); \
else \ else \
while (1) \ while (1) \
if (1) { \ if (1) { \
if (Globals::error) { \ if (Globals::error) { \
log_location(); \ log_location(); \
return val; \ return val; \
} \ } \
break; \ break; \
} \ } \
else label(body,__LINE__): else label(body,__LINE__):
; ;
#else #else
#define try_or_else_return(val) #define try_or_else_return(val)
#endif #endif
#define try_struct try_or_else_return({}) #define try_struct try_or_else_return({})
#define try_void try_or_else_return(;) #define try_void try_or_else_return(;)
#define try try_or_else_return(0) #define try try_or_else_return(0)
#define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false) #define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false)
#define ignore_logging fluid_let(Globals::log_level, Log_Level::None) #define ignore_logging fluid_let(Globals::log_level, Log_Level::None)
#define fetch1(var) \ #define fetch1(var) \
Lisp_Object* var##_symbol = Memory::get_symbol(#var); \ Lisp_Object* var##_symbol = Memory::get_symbol(#var); \
Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \
if_error_log_location_and_return(nullptr) if_error_log_location_and_return(nullptr)
#define fetch2(var1, var2) fetch1(var1); fetch1(var2) #define fetch2(var1, var2) fetch1(var1); fetch1(var2)
#define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) #define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3)
#define fetch4(var1, var2, var3, var4) fetch3(var1, var2, var3); fetch1(var4) #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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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( \ #define GET_MACRO( \
_1, _2, _3, _4, _5, _6, \ _1, _2, _3, _4, _5, _6, \
_7, _8, _9, _10, _11, _12, \ _7, _8, _9, _10, _11, _12, \
_13, _14, _15, _16, _17, _18, \ _13, _14, _15, _16, _17, _18, \
_19, _20, _21, _22, _23, _24, \ _19, _20, _21, _22, _23, _24, \
NAME, ...) NAME NAME, ...) NAME
#ifdef _MSC_VER #ifdef _MSC_VER
#define EXPAND( x ) x #define EXPAND( x ) x
#define fetch(...) EXPAND( \ #define fetch(...) EXPAND( \
GET_MACRO( \ GET_MACRO( \
__VA_ARGS__, \ __VA_ARGS__, \
fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \
fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \
fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \
fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \
)(__VA_ARGS__)) )(__VA_ARGS__))
#else #else
#define fetch(...) \ #define fetch(...) \
GET_MACRO( \ GET_MACRO( \
__VA_ARGS__, \ __VA_ARGS__, \
fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \
fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \
fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \
fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \
)(__VA_ARGS__) )(__VA_ARGS__)
#endif #endif
// NOTE(Felix): we have to copy the string because we need it to be // NOTE(Felix): we have to copy the string because we need it to be
// mutable for the parser to work, (#def gives us a const char) // mutable for the parser to work, (#def gives us a const char)
// because the parser relys on being able to temporaily put in markers // 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 // in the code and also it will fill out the source code location
#define _define_helper(def, docs, type, ending) \ #define _define_helper(def, docstring, type, ending) \
Parser::parser_file = file_name_built_ins; \ Parser::parser_file = file_name_built_ins; \
Parser::parser_line = __LINE__; \ Parser::parser_line = __LINE__; \
Parser::parser_col = 0; \ Parser::parser_col = 0; \
auto label(params,__LINE__) = Parser::parse_single_expression(#def); \ auto label(params,__LINE__) = Parser::parse_single_expression(#def); \
if_error_log_location_and_return(nullptr); \ if_error_log_location_and_return(nullptr); \
assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \
assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \
auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \ auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(type); \ auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(type); \
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ Globals::docs.set_object(label(sfun,__LINE__), Memory::create_string(docstring).data); \
if_error_log_location_and_return(nullptr); \ create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
/* TODO(Felix): label(sfun,__LINE__)->docstring = Memory::create_string(docs); */ \ if_error_log_location_and_return(nullptr); \
label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \ label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
label(sfun,__LINE__)->value.function->body. ending label(sfun,__LINE__)->value.function->body. ending
#define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction, c_body = []() -> Lisp_Object*) #define define(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cFunction, c_body = []() -> Lisp_Object*)
#define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial, c_body = []() -> Lisp_Object*) #define define_special(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cSpecial, c_body = []() -> Lisp_Object*)
#define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro, c_macro_body = []() -> void) #define define_macro(def, docs) _define_helper(def, docs, Slime::C_Function_Type::cMacro, c_macro_body = []() -> void)
#define in_caller_env fluid_let( \ #define in_caller_env fluid_let( \
Globals::Current_Execution::envi_stack.next_index, \ Globals::Current_Execution::envi_stack.next_index, \
Globals::Current_Execution::envi_stack.next_index-1) Globals::Current_Execution::envi_stack.next_index-1)
/* /*
* iterate over lisp vectors * iterate over lisp vectors
*/ */
#define for_lisp_vector(v) \ #define for_lisp_vector(v) \
if (!v); else \ if (!v); else \
if (int it_index = 0); else \ if (int it_index = 0); else \
for (auto it = v->value.vector.data; \ for (auto it = v->value.vector.data; \
it_index < v->value.vector.length; \ it_index < v->value.vector.length; \
it=v->value.vector.data+(++it_index)) it=v->value.vector.data+(++it_index))
/* /*
* iterate over lisp lists * iterate over lisp lists
*/ */
#define for_lisp_list(l) \ #define for_lisp_list(l) \
if (!l); else \ if (!l); else \
if (int it_index = 0); else \ if (int it_index = 0); else \
for (Lisp_Object* head = l, *it; \ for (Lisp_Object* head = l, *it; \
Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ head->type == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
head = head->value.pair.rest, ++it_index) head = head->value.pair.rest, ++it_index)
#define dbg(thing, format) \ #define dbg(thing, format) \
printf("%s = " format "\n", #thing, thing) printf("%s = " format "\n", #thing, thing)
src/docgeneration.cpp
+145 -143
View File
@@ -1,143 +1,145 @@
namespace Slime { namespace Slime {
proc generate_docs(String path) -> void { proc generate_docs(String path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w"); FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) { if (!f) {
create_generic_error("The file for writing the documentation (%s) " create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path)); "could not be opened for writing.", Memory::get_c_str(path));
return; return;
} }
defer { defer {
fclose(f); fclose(f);
}; };
Array_List<Environment*> visited; Array_List<Environment*> visited;
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void { const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
bool we_already_printed = false; bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function // TODO(Felix): Make a generic array_list_contains function
for(auto it : visited) { for(auto it : visited) {
if (it == env) { if (it == env) {
we_already_printed = true; we_already_printed = true;
break; break;
} }
} }
if (!we_already_printed) { if (!we_already_printed) {
// printf("Working on env::::"); // printf("Working on env::::");
// print_environment(env); // print_environment(env);
// printf("\n--------------------------------\n"); // printf("\n--------------------------------\n");
visited.append(env); visited.append(env);
push_environment(env); push_environment(env);
defer { defer {
pop_environment(); pop_environment();
}; };
for_hash_map(env->hm) { for_hash_map(env->hm) {
try_void fprintf(f, try_void fprintf(f,
"#+latex: \\hrule\n" "#+latex: \\hrule\n"
"#+html: <hr/>\n" "#+html: <hr/>\n"
"* =%s%s= \n" "* =%s%s= \n"
" :PROPERTIES:\n" " :PROPERTIES:\n"
" :UNNUMBERED: t\n" " :UNNUMBERED: t\n"
" :END:" " :END:"
,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol)); ,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
/* /*
* sourcecodeLocation * sourcecodeLocation
*/ */
if (value->sourceCodeLocation) { // TODO(Felix): Enable again when we have SCL again:
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
Memory::get_c_str(value->sourceCodeLocation->file), // if (value->sourceCodeLocation) {
value->sourceCodeLocation->line, // try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
value->sourceCodeLocation->column); // Memory::get_c_str(value->sourceCodeLocation->file),
} // value->sourceCodeLocation->line,
/* // value->sourceCodeLocation->column);
* type // }
*/ /*
Lisp_Object_Type type = Memory::get_type(value); * type
Lisp_Object* LOtype; */
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value); Lisp_Object_Type type = value->type;
try_void LOtype = eval_expr(type_expr); Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
fprintf(f, "\n - type :: ="); try_void LOtype = eval_expr(type_expr);
print(LOtype, true, f);
fprintf(f, "="); fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
/*
* if printable value -> print it
*/ /*
switch (type) { * if printable value -> print it
case(Lisp_Object_Type::Nil): */
case(Lisp_Object_Type::T): switch (type) {
case(Lisp_Object_Type::Number): case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::String): case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Pair): case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::Symbol): case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Keyword): { case(Lisp_Object_Type::Pair):
fprintf(f, "\n - value :: ="); case(Lisp_Object_Type::Symbol):
print(value, true, f); case(Lisp_Object_Type::Keyword): {
fprintf(f, "="); fprintf(f, "\n - value :: =");
} break; print(value, true, f);
default: break; fprintf(f, "=");
} } break;
/* default: break;
* if function then print arguments }
*/ /*
if (type == Lisp_Object_Type::Function) * if function then print arguments
{ */
Arguments* args = &value->value.function->args; if (type == Lisp_Object_Type::Function)
fprintf(f, "\n - arguments :: "); {
// if no args at all Arguments* args = &value->value.function->args;
if (args->positional.symbols.next_index == 0 && fprintf(f, "\n - arguments :: ");
args->keyword.values.next_index == 0 && // if no args at all
!args->rest) if (args->positional.symbols.next_index == 0 &&
{ args->keyword.values.next_index == 0 &&
fprintf(f, "none."); !args->rest)
} else { {
if (args->positional.symbols.next_index != 0) { fprintf(f, "none.");
fprintf(f, "\n - postitional :: "); } else {
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); if (args->positional.symbols.next_index != 0) {
for (int i = 1; i < args->positional.symbols.next_index; ++i) { fprintf(f, "\n - postitional :: ");
fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
} for (int i = 1; i < args->positional.symbols.next_index; ++i) {
} fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
if (args->keyword.values.next_index != 0) { }
fprintf(f, "\n - keyword :: "); }
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol)); if (args->keyword.values.next_index != 0) {
if (args->keyword.values.data[0]) { fprintf(f, "\n - keyword :: ");
fprintf(f, " =("); fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
print(args->keyword.values.data[0], true, f); if (args->keyword.values.data[0]) {
fprintf(f, ")="); fprintf(f, " =(");
} print(args->keyword.values.data[0], true, f);
for (int i = 1; i < args->keyword.values.next_index; ++i) { fprintf(f, ")=");
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); }
if (args->keyword.values.data[i]) { for (int i = 1; i < args->keyword.values.next_index; ++i) {
fprintf(f, " =("); fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
print(args->keyword.values.data[i], true, f); if (args->keyword.values.data[i]) {
fprintf(f, ")="); fprintf(f, " =(");
} print(args->keyword.values.data[i], true, f);
} fprintf(f, ")=");
} }
if (args->rest) { }
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol)); }
} if (args->rest) {
} fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
} }
fprintf(f, "\n - docu :: "); }
// TODO(Felix): make docsting a hashmap lookup }
// if (value->docstring) fprintf(f, "\n - docu :: ");
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n", // TODO(Felix): make docsting a hashmap lookup
// Memory::get_c_str(value->docstring)); // if (value->docstring)
// else // fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
fprintf(f, "none\n"); // Memory::get_c_str(value->docstring));
} // else
} fprintf(f, "none\n");
}
for (int i = 0; i < env->parents.next_index; ++i) { }
try_void rec(rec, env->parents.data[i], prefix);
} for (int i = 0; i < env->parents.next_index; ++i) {
}; try_void rec(rec, env->parents.data[i], prefix);
}
print_this_env(print_this_env, get_current_environment(), (char*)""); };
}
} print_this_env(print_this_env, get_current_environment(), (char*)"");
}
}
src/eval.cpp
+533 -557
View File
File diff suppressed because it is too large Load Diff
src/forward_decls.cpp
+88 -89
View File
@@ -1,89 +1,88 @@
namespace Slime { namespace Slime {
void add_to_load_path(const char*); void add_to_load_path(const char*);
bool lisp_object_equal(Lisp_Object*,Lisp_Object*); bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
Lisp_Object* built_in_load(String); Lisp_Object* built_in_load(String);
Lisp_Object* built_in_import(String); Lisp_Object* built_in_import(String);
void delete_error(); 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, 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(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); 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_arguments(Lisp_Object*);
Lisp_Object* eval_expr(Lisp_Object*); Lisp_Object* eval_expr(Lisp_Object*);
bool is_truthy (Lisp_Object*); bool is_truthy (Lisp_Object*);
int list_length(Lisp_Object*); int list_length(Lisp_Object*);
void* load_built_ins_into_environment(); void* load_built_ins_into_environment();
void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function);
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value); void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env); void define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true); char* lisp_object_to_string(Lisp_Object* node, bool print_repr = true);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*); void print_environment(Environment*);
bool run_all_tests(); bool run_all_tests();
inline Environment* get_root_environment(); inline Environment* get_root_environment();
inline Environment* get_current_environment(); inline Environment* get_current_environment();
inline void push_environment(Environment*); inline void push_environment(Environment*);
inline void pop_environment(); inline void pop_environment();
const char* lisp_object_type_to_string(Lisp_Object_Type type); const char* lisp_object_type_to_string(Lisp_Object_Type type);
void visualize_lisp_machine(); void visualize_lisp_machine();
void generate_docs(String path); void generate_docs(String path);
void log_error(); void log_error();
namespace Memory { namespace Memory {
Environment* create_built_ins_environment(); Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special); Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node); void init();
void init(); char* get_c_str(String);
char* get_c_str(String); void free_everything();
void free_everything(); String create_string(const char*);
String create_string(const char*); Lisp_Object* get_symbol(String identifier);
Lisp_Object* get_symbol(String identifier); Lisp_Object* get_symbol(const char*);
Lisp_Object* get_symbol(const char*); Lisp_Object* get_keyword(String identifier);
Lisp_Object* get_keyword(String identifier); Lisp_Object* get_keyword(const char*);
Lisp_Object* get_keyword(const char*); Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(double); Lisp_Object* create_lisp_object(const char*);
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* create_lisp_object_vector(Lisp_Object*, 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(Lisp_Object*, Lisp_Object*, Lisp_Object*); Lisp_Object* create_lisp_object_vector(int, 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*); inline Lisp_Object* create_list(Lisp_Object*,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*); 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*); 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*); inline Lisp_Object* create_list(Lisp_Object*,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 {
namespace Parser { // extern Environment* environment_for_macros;
// extern Environment* environment_for_macros;
extern String standard_in;
extern String standard_in; extern String parser_file;
extern String parser_file; extern int parser_line;
extern int parser_line; extern int parser_col;
extern int parser_col;
Lisp_Object* parse_expression(char* text, int* index_in_text);
Lisp_Object* parse_expression(char* text, int* index_in_text); Lisp_Object* parse_single_expression(const char* text);
Lisp_Object* parse_single_expression(const char* text); Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(char* text); Lisp_Object* parse_single_expression(wchar_t* text);
Lisp_Object* parse_single_expression(wchar_t* text); }
}
namespace Globals {
namespace Globals { extern bool debug_log;
extern bool debug_log; extern char* bin_path;
extern char* bin_path; extern Log_Level log_level;
extern Log_Level log_level; extern Array_List<void*> load_path;
extern Array_List<void*> load_path; namespace Current_Execution {
namespace Current_Execution { extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Lisp_Object*> call_stack; extern Array_List<Environment*> envi_stack;
extern Array_List<Environment*> envi_stack; }
} extern Error* error;
extern Error* error; extern bool breaking_on_errors;
extern bool breaking_on_errors; }
} }
}
src/gc.cpp
+96 -96
View File
@@ -1,96 +1,96 @@
namespace Slime::GC { namespace Slime::GC {
proc maybe_mark(Environment* env) -> void; proc maybe_mark(Environment* env) -> void;
int current_mark; int current_mark;
Array_List<Lisp_Object*> marked_objects; Array_List<Lisp_Object*> marked_objects;
Array_List<String> marked_strings; Array_List<String> marked_strings;
Array_List<Environment*> marked_environments; Array_List<Environment*> marked_environments;
Array_List<Environment*> protected_environments; Array_List<Environment*> protected_environments;
proc marked(Lisp_Object* node) -> bool { proc marked(Lisp_Object* node) -> bool {
return false; return false;
} }
proc marked(Environment* env) -> bool { proc marked(Environment* env) -> bool {
return false; return false;
} }
proc maybe_mark(Lisp_Object* node) -> void { proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node)) if (marked(node))
return; return;
// mark object itself // mark object itself
marked_objects.append(node); marked_objects.append(node);
// mark docstring // mark docstring
// TODO(Felix): // TODO(Felix):
// if (node->docstring) // if (node->docstring)
// marked_strings.append(node->docstring); // marked_strings.append(node->docstring);
// mark type specific data // mark type specific data
switch (Memory::get_type(node)) { switch (node->type) {
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
for_lisp_list (node) { for_lisp_list (node) {
maybe_mark(it); maybe_mark(it);
} }
} break; } break;
case Lisp_Object_Type::Vector: { case Lisp_Object_Type::Vector: {
for_lisp_vector (node) { for_lisp_vector (node) {
maybe_mark(it); maybe_mark(it);
} }
} break; } break;
case Lisp_Object_Type::String: { case Lisp_Object_Type::String: {
marked_strings.append(node->value.string); marked_strings.append(node->value.string);
} break; } break;
case Lisp_Object_Type::Function: { case Lisp_Object_Type::Function: {
// NOTE(Felix): We dont have to mark the symbols, keywords // NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never // for parameter names, as symbols and keywords are never
// garbage collected // garbage collected
maybe_mark(node->value.function->parent_environment); maybe_mark(node->value.function->parent_environment);
if (!node->value.function->is_c) { if (!node->value.function->is_c) {
maybe_mark(node->value.function->body.lisp_body); maybe_mark(node->value.function->body.lisp_body);
} }
// mark the default arguemnt values: // mark the default arguemnt values:
for (auto it : node->value.function->args.keyword.values) { for (auto it : node->value.function->args.keyword.values) {
if (it) if (it)
maybe_mark(it); maybe_mark(it);
} }
} break; } break;
default: break; default: break;
} }
} }
proc maybe_mark(Environment* env) -> void { proc maybe_mark(Environment* env) -> void {
if (marked(env)) if (marked(env))
return; return;
marked_environments.append(env); marked_environments.append(env);
for (auto p : env->parents) { for (auto p : env->parents) {
maybe_mark(p); maybe_mark(p);
} }
// Lisp_Object* it = env->values[0]; // Lisp_Object* it = env->values[0];
// for (int i = 0; i < env->next_index; it = env->values[++i]) { // for (int i = 0; i < env->next_index; it = env->values[++i]) {
// maybe_mark(it); // maybe_mark(it);
// } // }
} }
proc garbage_collect() -> void { proc garbage_collect() -> void {
profile_this(); profile_this();
++current_mark; ++current_mark;
for (auto it : protected_environments) maybe_mark(it); for (auto it : protected_environments) maybe_mark(it);
for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it); for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it);
} }
proc gc_init_and_go() -> void { proc gc_init_and_go() -> void {
current_mark = 0; current_mark = 0;
while (1) { while (1) {
garbage_collect(); garbage_collect();
} }
} }
} }
src/globals.cpp
+43 -38
View File
@@ -1,38 +1,43 @@
namespace Slime { namespace Slime {
#define v_major 0 #define v_major 0
#define v_minor 1 #define v_minor 1
#define STRINGIZE2(s) #s #define STRINGIZE2(s) #s
#define STRINGIZE(s) STRINGIZE2(s) #define STRINGIZE(s) STRINGIZE2(s)
#define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__ #define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__
const char* version_string = VERSION_STRING; const char* version_string = VERSION_STRING;
const int major_version = v_major; const int major_version = v_major;
const int minor_version = v_minor; const int minor_version = v_minor;
#undef v_major #undef v_major
#undef v_minor #undef v_minor
#undef STRINGIZE2 #undef STRINGIZE2
#undef STRINGIZE #undef STRINGIZE
#undef VERSION_STRING #undef VERSION_STRING
} }
namespace Slime::Globals { namespace Slime::Globals {
char* bin_path = nullptr; char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug; Log_Level log_level = Log_Level::Debug;
bool debug_log = false; bool debug_log = false;
Array_List<void*> load_path; Array_List<void*> load_path;
namespace Current_Execution {
Array_List<Lisp_Object*> cs; // call stack Hash_Map<void*, char*> docs;
Array_List<Lisp_Object*> pcs; // program counter stack Hash_Map<void*, Source_Code_Location> source_code_locations;
Array_List<int> ams; // apply marker stack Hash_Map<void*, Lisp_Object*> user_types;
Array_List<Array_List<NasAction>> nass; // next action stack stack
Array_List<Lambda<void()>> ats; // and then stack namespace Current_Execution {
Array_List<Lisp_Object*> mes; // macro expansion stack Array_List<Lisp_Object*> cs; // call stack
Array_List<Environment*> envi_stack; Array_List<Lisp_Object*> pcs; // program counter stack
} Array_List<int> ams; // apply marker stack
Array_List<Array_List<NasAction>> nass; // next action stack stack
Error* error = nullptr; Array_List<Lambda<void()>> ats; // and then stack
#ifdef _DONT_BREAK_ON_ERRORS Array_List<Lisp_Object*> mes; // macro expansion stack
bool breaking_on_errors = false; Array_List<Environment*> envi_stack;
#else }
bool breaking_on_errors = true;
#endif Error* error = nullptr;
} #ifdef _DONT_BREAK_ON_ERRORS
bool breaking_on_errors = false;
#else
bool breaking_on_errors = true;
#endif
}
src/io.cpp
+580 -576
View File
File diff suppressed because it is too large Load Diff
src/libslime.cpp
+121 -121
View File
@@ -1,121 +1,121 @@
#define _CRT_SECURE_NO_WARNINGS #define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE #define _CRT_SECURE_NO_DEPRECATE
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#include <time.h> #include <time.h>
#include <string.h> #include <string.h>
#include <cmath> #include <cmath>
#include <ctype.h> #include <ctype.h>
#include <stdarg.h> #include <stdarg.h>
#include <errno.h> #include <errno.h>
#include <new> #include <new>
#ifdef _MSC_VER #ifdef _MSC_VER
# include <direct.h> # include <direct.h>
# include <windows.h> # include <windows.h>
#else #else
# include <unistd.h> # include <unistd.h>
# include <signal.h> # include <signal.h>
#endif #endif
/* /*
Forward declare the hash functions for the hashmap (needed at least Forward declare the hash functions for the hashmap (needed at least
for clang++) for clang++)
*/ */
namespace Slime {struct Lisp_Object;} namespace Slime {struct Lisp_Object;}
bool hm_objects_match(char* a, char* b); bool hm_objects_match(char* a, char* b);
bool hm_objects_match(void* a, void* b); bool hm_objects_match(void* a, void* b);
bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b); bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b);
unsigned int hm_hash(char* str); unsigned int hm_hash(char* str);
unsigned int hm_hash(void* ptr); unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj); unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp" #include "ftb/hashmap.hpp"
#include "ftb/types.hpp" #include "ftb/types.hpp"
#include "ftb/arraylist.hpp" #include "ftb/arraylist.hpp"
#include "ftb/bucket_allocator.hpp" #include "ftb/bucket_allocator.hpp"
#include "ftb/macros.hpp" #include "ftb/macros.hpp"
#include "ftb/profiler.hpp" #include "ftb/profiler.hpp"
#include "ftb/hooks.hpp" #include "ftb/hooks.hpp"
# include "defines.cpp" # include "defines.cpp"
# include "assert.hpp" # include "assert.hpp"
# include "define_macros.hpp" # include "define_macros.hpp"
# include "platform.cpp" # include "platform.cpp"
# include "structs.cpp" # include "structs.cpp"
# include "forward_decls.cpp" # include "forward_decls.cpp"
inline bool hm_objects_match(char* a, char* b) { inline bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0; return strcmp(a, b) == 0;
} }
inline bool hm_objects_match(void* a, void* b) { inline bool hm_objects_match(void* a, void* b) {
return a == b; return a == b;
} }
inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) { inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) {
return Slime::lisp_object_equal(a, b); return Slime::lisp_object_equal(a, b);
} }
unsigned int hm_hash(char* str) { unsigned int hm_hash(char* str) {
unsigned int value = str[0] << 7; unsigned int value = str[0] << 7;
int i = 0; int i = 0;
while (str[i]) { while (str[i]) {
value = (10000003 * value) ^ str[i++]; value = (10000003 * value) ^ str[i++];
} }
return value ^ i; return value ^ i;
} }
unsigned int hm_hash(void* ptr) { unsigned int hm_hash(void* ptr) {
return ((unsigned long long)ptr * 2654435761) % 4294967296; return ((unsigned long long)ptr * 2654435761) % 4294967296;
} }
unsigned int hm_hash(Slime::Lisp_Object* obj) { unsigned int hm_hash(Slime::Lisp_Object* obj) {
using namespace Slime; using namespace Slime;
switch (Memory::get_type(obj)) { switch (obj->type) {
// hash from adress: if two objects of these types have // hash from adress: if two objects of these types have
// different addresses, they are different // different addresses, they are different
case Lisp_Object_Type::Function: case Lisp_Object_Type::Function:
case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::Continuation: case Lisp_Object_Type::Continuation:
case Lisp_Object_Type::Nil: case Lisp_Object_Type::Nil:
case Lisp_Object_Type::T: case Lisp_Object_Type::T:
return hm_hash((void*) obj); return hm_hash((void*) obj);
// hash from contents: even if objects are themselved // hash from contents: even if objects are themselved
// different, they cauld be equivalent: // different, they cauld be equivalent:
case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer); 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::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::String: return hm_hash((char*) obj->value.string.data);
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
u32 hash = 1; u32 hash = 1;
for_lisp_list (obj) { for_lisp_list (obj) {
hash <<= 1; hash <<= 1;
hash += hm_hash(it); hash += hm_hash(it);
} }
return hash; return hash;
} break; } break;
case Lisp_Object_Type::Vector: case Lisp_Object_Type::Vector:
case Lisp_Object_Type::HashMap: case Lisp_Object_Type::HashMap:
default: default:
create_not_yet_implemented_error(); create_not_yet_implemented_error();
return 0; return 0;
} }
} }
# include "globals.cpp" # include "globals.cpp"
# include "memory.cpp" # include "memory.cpp"
# include "gc.cpp" # include "gc.cpp"
# include "lisp_object.cpp" # include "lisp_object.cpp"
# include "error.cpp" # include "error.cpp"
# include "io.cpp" # include "io.cpp"
# include "env.cpp" # include "env.cpp"
# include "parse.cpp" # include "parse.cpp"
# include "eval.cpp" # include "eval.cpp"
# include "visualization.cpp" # include "visualization.cpp"
# include "docgeneration.cpp" # include "docgeneration.cpp"
# include "built_ins.cpp" # include "built_ins.cpp"
# include "testing.cpp" # include "testing.cpp"
// # include "undefines.cpp" // # include "undefines.cpp"
src/lisp_object.cpp
+33 -31
View File
@@ -1,31 +1,33 @@
namespace Slime { namespace Slime {
proc create_source_code_location(String file, int line, int col) -> Source_Code_Location* { proc create_source_code_location(String file, int line, int col) -> Source_Code_Location* {
if (!file.data) if (!file.data)
return nullptr; return nullptr;
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location)); Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file; ret->file = file;
ret->line = line; ret->line = line;
ret->column = col; ret->column = col;
return ret; return ret;
} }
proc lisp_object_type_to_string(Lisp_Object_Type type) -> const char* { proc lisp_object_type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) { switch (type) {
case(Lisp_Object_Type::Nil): return "nil"; case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t"; case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number"; case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string"; case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol"; case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword"; case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function"; case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::Continuation): return "continuation"; case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair"; case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector"; case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer"; case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap"; case(Lisp_Object_Type::HashMap): return "hashmap";
} case(Lisp_Object_Type::Invalid_Garbage_Collected): return "Invalid: Garbage Collected";
return "unknown"; case(Lisp_Object_Type::Invalid_Under_Construction): return "Invalid: Under Construction";
} }
return "unknown";
} }
}
src/main.cpp
+30 -31
View File
@@ -1,31 +1,30 @@
#include "libslime.cpp" #include "libslime.cpp"
int main(int argc, char* argv[]) { int main(int argc, char* argv[]) {
#ifdef _MSC_VER
#ifdef _MSC_VER // enable colored terminal output for windows
// enable colored terminal output for windows HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); DWORD dwMode = 0;
DWORD dwMode = 0; GetConsoleMode(hOut, &dwMode);
GetConsoleMode(hOut, &dwMode); dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING; SetConsoleMode(hOut, dwMode);
SetConsoleMode(hOut, dwMode); #endif
#endif
if (argc > 1) {
if (argc > 1) { if (Slime::string_equal(argv[1], "--run-tests")) {
if (Slime::string_equal(argv[1], "--run-tests")) { int res = Slime::run_all_tests();
int res = Slime::run_all_tests(); return res ? 0 : 1;
return res ? 0 : 1; } else if (Slime::string_equal(argv[1], "--generate-docs")) {
} else if (Slime::string_equal(argv[1], "--generate-docs")) { Slime::Memory::init();
Slime::Memory::init(); if (Slime::Globals::error) return 1;
if (Slime::Globals::error) return 1; Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime")); } else {
} else { Slime::interprete_file(argv[1]);
Slime::interprete_file(argv[1]); }
} } else {
} else { Slime::interprete_stdin();
Slime::interprete_stdin(); return 0;
return 0; }
}
if (Slime::Globals::error) return 1;
if (Slime::Globals::error) return 1; }
}
src/memory.cpp
+502 -539
View File
File diff suppressed because it is too large Load Diff
src/structs.cpp
+11 -17
View File
@@ -3,12 +3,12 @@ namespace Slime {
struct String; struct String;
struct Environment; struct Environment;
enum struct Thread_Type { enum struct Thread_Type : u8 {
Main, Main,
GarbageCollection GarbageCollection
}; };
enum struct Lisp_Object_Type { enum struct Lisp_Object_Type : u8 {
Nil, Nil,
T, T,
Symbol, Symbol,
@@ -22,16 +22,11 @@ namespace Slime {
HashMap, HashMap,
// OwningPointer, // OwningPointer,
Function, Function,
Invalid_Garbage_Collected,
Invalid_Under_Construction
}; };
enum class Lisp_Object_Flags enum struct NasAction : u8 {
{
// bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};
enum struct NasAction {
And_Then_Action, And_Then_Action,
Macro_Write_Back, Macro_Write_Back,
Eval, Eval,
@@ -43,13 +38,13 @@ namespace Slime {
Pop_Environment Pop_Environment
}; };
enum struct Lisp_Function_Type { enum struct Lisp_Function_Type : u8 {
Lambda, // normal evaluation order Lambda, // normal evaluation order
Macro // args are not evaluated, a new programm is returned Macro // args are not evaluated, a new programm is returned
// that will be executed again // that will be executed again
}; };
enum struct C_Function_Type { enum struct C_Function_Type : u8 {
cFunction, // normal evaluation order cFunction, // normal evaluation order
cSpecial, // args are not evaluated, but result is returned cSpecial, // args are not evaluated, but result is returned
// as you would expect // as you would expect
@@ -57,7 +52,7 @@ namespace Slime {
// modified // modified
}; };
enum struct Log_Level { enum struct Log_Level : u8 {
None, None,
Critical, Critical,
Warning, Warning,
@@ -131,10 +126,9 @@ namespace Slime {
} body; } body;
}; };
#pragma pack(1)
struct Lisp_Object { struct Lisp_Object {
Source_Code_Location* sourceCodeLocation; Lisp_Object_Type type;
u64 flags;
Lisp_Object* userType; // keyword
union value { union value {
String symbol; // used for symbols and keywords String symbol; // used for symbols and keywords
double number; double number;
@@ -145,9 +139,9 @@ namespace Slime {
void* pointer; void* pointer;
Continuation* continuation; Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value; } value;
}; };
#pragma options align=reset
struct Error { struct Error {
Lisp_Object* position; Lisp_Object* position;
src/testing.cpp
+660 -660
View File
File diff suppressed because it is too large Load Diff