felix
/
slime
1
0
Rozštěpit 0
Zdrojový kód Úkoly 0 Požadavky na natažení 0 Vydání 0 Wiki Aktivita
Procházet zdrojové kódy

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

master
Felix Brendel před 6 roky
rodič
9295d57a8e
revize
4f0fef064e
16 změnil soubory, kde provedl 4336 přidání a 4388 odebrání
Rozdělené zobrazení
Diff Options
Zobrazit statistiky Stáhněte soubor opravy Stáhněte rozdílový soubor
  1. +1
    -1
      build.sh
  2. +63
    -63
      src/assert.hpp
  3. +1271
    -1267
      src/built_ins.cpp
  4. +159
    -159
      src/define_macros.hpp
  5. +145
    -143
      src/docgeneration.cpp
  6. +533
    -557
      src/eval.cpp
  7. +88
    -89
      src/forward_decls.cpp
  8. +96
    -96
      src/gc.cpp
  9. +43
    -38
      src/globals.cpp
  10. +580
    -576
      src/io.cpp
  11. +121
    -121
      src/libslime.cpp
  12. +33
    -31
      src/lisp_object.cpp
  13. +30
    -31
      src/main.cpp
  14. +502
    -539
      src/memory.cpp
  15. +11
    -17
      src/structs.cpp
  16. +660
    -660
      src/testing.cpp

+ 1
- 1
build.sh Zobrazit soubor

@@ -52,7 +52,7 @@ echo ""
echo "----------------------"
echo " running profile "
echo "----------------------"
time ./slime_p --run-tests || exit 1
time ./slime_p --run-tests > /dev/null || exit 1

echo ""
echo "------------------------"


+ 63
- 63
src/assert.hpp Zobrazit soubor

@@ -1,63 +1,63 @@
/**
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, exp) \
__create_error("type-missmatch", \
"Type missmatch: expected %s, got %s in %s", \
expected, actual, exp)
#ifdef _DEBUG
#define assert_type(_node, _type) \
do { \
if (Memory::get_type(_node) != _type) { \
char* t = lisp_object_to_string(_node); \
defer { free(t); }; \
create_type_missmatch_error( \
lisp_object_type_to_string(_type), \
lisp_object_type_to_string(Memory::get_type(_node)), \
t); \
} \
} while(0)
#define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)
#define assert(message, condition) \
do { \
if (!(condition)) { \
create_generic_error("Assertion-error: %s\n" \
" for: %s\n" \
" in: %s:%d", \
message, #condition, __FILE__, __LINE__); \
} \
} 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_list_length(_node, _len) do {} while (0)
# define assert(message, 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, exp) \
__create_error("type-missmatch", \
"Type missmatch: expected %s, got %s in %s", \
expected, actual, exp)
#ifdef _DEBUG
#define assert_type(_node, _type) \
do { \
if (_node->type != _type) { \
char* t = lisp_object_to_string(_node); \
defer { free(t); }; \
create_type_missmatch_error( \
lisp_object_type_to_string(_type), \
lisp_object_type_to_string(_node->type), \
t); \
} \
} while(0)
#define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)
#define assert(message, condition) \
do { \
if (!(condition)) { \
create_generic_error("Assertion-error: %s\n" \
" for: %s\n" \
" in: %s:%d", \
message, #condition, __FILE__, __LINE__); \
} \
} 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_list_length(_node, _len) do {} while (0)
# define assert(message, condition) do {} while (0)
#endif

+ 1271
- 1267
src/built_ins.cpp
Diff nebyl zobrazen, protože je příliš veliký
Zobrazit soubor


+ 159
- 159
src/define_macros.hpp Zobrazit soubor

@@ -1,159 +1,159 @@
#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__) + (int)log10(__LINE__));\
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_error_log_location_and_return(nullptr)
#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, (#def gives us a const char)
// 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, type, ending) \
Parser::parser_file = file_name_built_ins; \
Parser::parser_line = __LINE__; \
Parser::parser_col = 0; \
auto label(params,__LINE__) = Parser::parse_single_expression(#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(type); \
create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
if_error_log_location_and_return(nullptr); \
/* TODO(Felix): label(sfun,__LINE__)->docstring = Memory::create_string(docs); */ \
label(sfun,__LINE__)->value.function->parent_environment = get_current_environment(); \
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
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_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 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 dbg(thing, format) \
printf("%s = " format "\n", #thing, thing)
#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__) + (int)log10(__LINE__));\
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_error_log_location_and_return(nullptr)
#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, (#def gives us a const char)
// 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, docstring, type, ending) \
Parser::parser_file = file_name_built_ins; \
Parser::parser_line = __LINE__; \
Parser::parser_col = 0; \
auto label(params,__LINE__) = Parser::parse_single_expression(#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(type); \
Globals::docs.set_object(label(sfun,__LINE__), Memory::create_string(docstring).data); \
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__)->value.function->parent_environment = get_current_environment(); \
define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \
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_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 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; \
head->type == Lisp_Object_Type::Pair && (it = head->value.pair.first); \
head = head->value.pair.rest, ++it_index)
#define dbg(thing, format) \
printf("%s = " format "\n", #thing, thing)

+ 145
- 143
src/docgeneration.cpp Zobrazit soubor

@@ -1,143 +1,145 @@
namespace Slime {
proc generate_docs(String path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) {
create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path));
return;
}
defer {
fclose(f);
};
Array_List<Environment*> visited;
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function
for(auto it : visited) {
if (it == env) {
we_already_printed = true;
break;
}
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);
push_environment(env);
defer {
pop_environment();
};
for_hash_map(env->hm) {
try_void fprintf(f,
"#+latex: \\hrule\n"
"#+html: <hr/>\n"
"* =%s%s= \n"
" :PROPERTIES:\n"
" :UNNUMBERED: t\n"
" :END:"
,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
/*
* sourcecodeLocation
*/
if (value->sourceCodeLocation) {
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
Memory::get_c_str(value->sourceCodeLocation->file),
value->sourceCodeLocation->line,
value->sourceCodeLocation->column);
}
/*
* type
*/
Lisp_Object_Type type = Memory::get_type(value);
Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
try_void LOtype = eval_expr(type_expr);
fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
/*
* if printable value -> print it
*/
switch (type) {
case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Pair):
case(Lisp_Object_Type::Symbol):
case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - value :: =");
print(value, true, f);
fprintf(f, "=");
} break;
default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function)
{
Arguments* args = &value->value.function->args;
fprintf(f, "\n - arguments :: ");
// if no args at all
if (args->positional.symbols.next_index == 0 &&
args->keyword.values.next_index == 0 &&
!args->rest)
{
fprintf(f, "none.");
} else {
if (args->positional.symbols.next_index != 0) {
fprintf(f, "\n - postitional :: ");
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.data[0]) {
fprintf(f, " =(");
print(args->keyword.values.data[0], true, f);
fprintf(f, ")=");
}
for (int i = 1; i < args->keyword.values.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) {
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));
}
}
}
fprintf(f, "\n - docu :: ");
// TODO(Felix): make docsting a hashmap lookup
// if (value->docstring)
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\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);
}
};
print_this_env(print_this_env, get_current_environment(), (char*)"");
}
}
namespace Slime {
proc generate_docs(String path) -> void {
FILE *f = fopen(Memory::get_c_str(path), "w");
if (!f) {
create_generic_error("The file for writing the documentation (%s) "
"could not be opened for writing.", Memory::get_c_str(path));
return;
}
defer {
fclose(f);
};

Array_List<Environment*> visited;

const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
bool we_already_printed = false;
// TODO(Felix): Make a generic array_list_contains function
for(auto it : visited) {
if (it == env) {
we_already_printed = true;
break;
}
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);

push_environment(env);
defer {
pop_environment();
};

for_hash_map(env->hm) {
try_void fprintf(f,
"#+latex: \\hrule\n"
"#+html: <hr/>\n"
"* =%s%s= \n"
" :PROPERTIES:\n"
" :UNNUMBERED: t\n"
" :END:"
,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
/*
* sourcecodeLocation
*/
// TODO(Felix): Enable again when we have SCL again:

// if (value->sourceCodeLocation) {
// try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
// Memory::get_c_str(value->sourceCodeLocation->file),
// value->sourceCodeLocation->line,
// value->sourceCodeLocation->column);
// }
/*
* type
*/
Lisp_Object_Type type = value->type;
Lisp_Object* LOtype;
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
try_void LOtype = eval_expr(type_expr);

fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");


/*
* if printable value -> print it
*/
switch (type) {
case(Lisp_Object_Type::Nil):
case(Lisp_Object_Type::T):
case(Lisp_Object_Type::Number):
case(Lisp_Object_Type::String):
case(Lisp_Object_Type::Pair):
case(Lisp_Object_Type::Symbol):
case(Lisp_Object_Type::Keyword): {
fprintf(f, "\n - value :: =");
print(value, true, f);
fprintf(f, "=");
} break;
default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function)
{
Arguments* args = &value->value.function->args;
fprintf(f, "\n - arguments :: ");
// if no args at all
if (args->positional.symbols.next_index == 0 &&
args->keyword.values.next_index == 0 &&
!args->rest)
{
fprintf(f, "none.");
} else {
if (args->positional.symbols.next_index != 0) {
fprintf(f, "\n - postitional :: ");
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.data[0]) {
fprintf(f, " =(");
print(args->keyword.values.data[0], true, f);
fprintf(f, ")=");
}
for (int i = 1; i < args->keyword.values.next_index; ++i) {
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
if (args->keyword.values.data[i]) {
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));
}
}
}
fprintf(f, "\n - docu :: ");
// TODO(Felix): make docsting a hashmap lookup
// if (value->docstring)
// fprintf(f, "\n #+BEGIN:\n%s\n #+END:\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);
}
};

print_this_env(print_this_env, get_current_environment(), (char*)"");
}
}

+ 533
- 557
src/eval.cpp
Diff nebyl zobrazen, protože je příliš veliký
Zobrazit soubor


+ 88
- 89
src/forward_decls.cpp Zobrazit soubor

@@ -1,89 +1,88 @@
namespace Slime {
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 define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
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_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();
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_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(const char* text);
Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}
namespace Globals {
extern bool debug_log;
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;
}
}
namespace Slime {
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 define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env);
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_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);
void init();
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_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(const char* text);
Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}

namespace Globals {
extern bool debug_log;
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;
}
}

+ 96
- 96
src/gc.cpp Zobrazit soubor

@@ -1,96 +1,96 @@
namespace Slime::GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
Array_List<Lisp_Object*> marked_objects;
Array_List<String> marked_strings;
Array_List<Environment*> marked_environments;
Array_List<Environment*> protected_environments;
proc marked(Lisp_Object* node) -> bool {
return false;
}
proc marked(Environment* env) -> bool {
return false;
}
proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node))
return;
// mark object itself
marked_objects.append(node);
// mark docstring
// TODO(Felix):
// if (node->docstring)
// marked_strings.append(node->docstring);
// mark type specific data
switch (Memory::get_type(node)) {
case Lisp_Object_Type::Pair: {
for_lisp_list (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::Vector: {
for_lisp_vector (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::String: {
marked_strings.append(node->value.string);
} break;
case Lisp_Object_Type::Function: {
// NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function->parent_environment);
if (!node->value.function->is_c) {
maybe_mark(node->value.function->body.lisp_body);
}
// mark the default arguemnt values:
for (auto it : node->value.function->args.keyword.values) {
if (it)
maybe_mark(it);
}
} break;
default: break;
}
}
proc maybe_mark(Environment* env) -> void {
if (marked(env))
return;
marked_environments.append(env);
for (auto p : env->parents) {
maybe_mark(p);
}
// Lisp_Object* it = env->values[0];
// for (int i = 0; i < env->next_index; it = env->values[++i]) {
// maybe_mark(it);
// }
}
proc garbage_collect() -> void {
profile_this();
++current_mark;
for (auto it : protected_environments) maybe_mark(it);
for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it);
}
proc gc_init_and_go() -> void {
current_mark = 0;
while (1) {
garbage_collect();
}
}
}
namespace Slime::GC {
proc maybe_mark(Environment* env) -> void;
int current_mark;
Array_List<Lisp_Object*> marked_objects;
Array_List<String> marked_strings;
Array_List<Environment*> marked_environments;
Array_List<Environment*> protected_environments;
proc marked(Lisp_Object* node) -> bool {
return false;
}
proc marked(Environment* env) -> bool {
return false;
}
proc maybe_mark(Lisp_Object* node) -> void {
if (marked(node))
return;
// mark object itself
marked_objects.append(node);
// mark docstring
// TODO(Felix):
// if (node->docstring)
// marked_strings.append(node->docstring);
// mark type specific data
switch (node->type) {
case Lisp_Object_Type::Pair: {
for_lisp_list (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::Vector: {
for_lisp_vector (node) {
maybe_mark(it);
}
} break;
case Lisp_Object_Type::String: {
marked_strings.append(node->value.string);
} break;
case Lisp_Object_Type::Function: {
// NOTE(Felix): We dont have to mark the symbols, keywords
// for parameter names, as symbols and keywords are never
// garbage collected
maybe_mark(node->value.function->parent_environment);
if (!node->value.function->is_c) {
maybe_mark(node->value.function->body.lisp_body);
}
// mark the default arguemnt values:
for (auto it : node->value.function->args.keyword.values) {
if (it)
maybe_mark(it);
}
} break;
default: break;
}
}
proc maybe_mark(Environment* env) -> void {
if (marked(env))
return;
marked_environments.append(env);
for (auto p : env->parents) {
maybe_mark(p);
}
// Lisp_Object* it = env->values[0];
// for (int i = 0; i < env->next_index; it = env->values[++i]) {
// maybe_mark(it);
// }
}
proc garbage_collect() -> void {
profile_this();
++current_mark;
for (auto it : protected_environments) maybe_mark(it);
for (auto it : Globals::Current_Execution::envi_stack) maybe_mark(it);
}
proc gc_init_and_go() -> void {
current_mark = 0;
while (1) {
garbage_collect();
}
}
}

+ 43
- 38
src/globals.cpp Zobrazit soubor

@@ -1,38 +1,43 @@
namespace Slime {
#define v_major 0
#define v_minor 1
#define STRINGIZE2(s) #s
#define STRINGIZE(s) STRINGIZE2(s)
#define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__
const char* version_string = VERSION_STRING;
const int major_version = v_major;
const int minor_version = v_minor;
#undef v_major
#undef v_minor
#undef STRINGIZE2
#undef STRINGIZE
#undef VERSION_STRING
}
namespace Slime::Globals {
char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug;
bool debug_log = false;
Array_List<void*> load_path;
namespace Current_Execution {
Array_List<Lisp_Object*> cs; // call 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
Array_List<Lambda<void()>> ats; // and then stack
Array_List<Lisp_Object*> mes; // macro expansion stack
Array_List<Environment*> envi_stack;
}
Error* error = nullptr;
#ifdef _DONT_BREAK_ON_ERRORS
bool breaking_on_errors = false;
#else
bool breaking_on_errors = true;
#endif
}
namespace Slime {
#define v_major 0
#define v_minor 1
#define STRINGIZE2(s) #s
#define STRINGIZE(s) STRINGIZE2(s)
#define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__
const char* version_string = VERSION_STRING;
const int major_version = v_major;
const int minor_version = v_minor;
#undef v_major
#undef v_minor
#undef STRINGIZE2
#undef STRINGIZE
#undef VERSION_STRING
}

namespace Slime::Globals {
char* bin_path = nullptr;
Log_Level log_level = Log_Level::Debug;
bool debug_log = false;
Array_List<void*> load_path;

Hash_Map<void*, char*> docs;
Hash_Map<void*, Source_Code_Location> source_code_locations;
Hash_Map<void*, Lisp_Object*> user_types;

namespace Current_Execution {
Array_List<Lisp_Object*> cs; // call 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
Array_List<Lambda<void()>> ats; // and then stack
Array_List<Lisp_Object*> mes; // macro expansion stack
Array_List<Environment*> envi_stack;
}

Error* error = nullptr;
#ifdef _DONT_BREAK_ON_ERRORS
bool breaking_on_errors = false;
#else
bool breaking_on_errors = true;
#endif
}

+ 580
- 576
src/io.cpp
Diff nebyl zobrazen, protože je příliš veliký
Zobrazit soubor


+ 121
- 121
src/libslime.cpp Zobrazit soubor

@@ -1,121 +1,121 @@
#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE
#include <stdlib.h>
#include <stdio.h>
#include <time.h>
#include <string.h>
#include <cmath>
#include <ctype.h>
#include <stdarg.h>
#include <errno.h>
#include <new>
#ifdef _MSC_VER
# include <direct.h>
# include <windows.h>
#else
# include <unistd.h>
# include <signal.h>
#endif
/*
Forward declare the hash functions for the hashmap (needed at least
for clang++)
*/
namespace Slime {struct Lisp_Object;}
bool hm_objects_match(char* a, char* b);
bool hm_objects_match(void* a, void* b);
bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b);
unsigned int hm_hash(char* str);
unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp"
#include "ftb/types.hpp"
#include "ftb/arraylist.hpp"
#include "ftb/bucket_allocator.hpp"
#include "ftb/macros.hpp"
#include "ftb/profiler.hpp"
#include "ftb/hooks.hpp"
# include "defines.cpp"
# include "assert.hpp"
# include "define_macros.hpp"
# include "platform.cpp"
# include "structs.cpp"
# include "forward_decls.cpp"
inline bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0;
}
inline bool hm_objects_match(void* a, void* b) {
return a == b;
}
inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) {
return Slime::lisp_object_equal(a, b);
}
unsigned int hm_hash(char* str) {
unsigned int value = str[0] << 7;
int i = 0;
while (str[i]) {
value = (10000003 * value) ^ str[i++];
}
return value ^ i;
}
unsigned int hm_hash(void* ptr) {
return ((unsigned long long)ptr * 2654435761) % 4294967296;
}
unsigned int hm_hash(Slime::Lisp_Object* obj) {
using namespace Slime;
switch (Memory::get_type(obj)) {
// hash from adress: if two objects of these types have
// different addresses, they are different
case Lisp_Object_Type::Function:
case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::Continuation:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::T:
return hm_hash((void*) obj);
// hash from contents: even if objects are themselved
// different, they cauld be equivalent:
case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer);
case Lisp_Object_Type::Number: return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes
case Lisp_Object_Type::String: return hm_hash((char*) obj->value.string.data);
case Lisp_Object_Type::Pair: {
u32 hash = 1;
for_lisp_list (obj) {
hash <<= 1;
hash += hm_hash(it);
}
return hash;
} break;
case Lisp_Object_Type::Vector:
case Lisp_Object_Type::HashMap:
default:
create_not_yet_implemented_error();
return 0;
}
}
# include "globals.cpp"
# include "memory.cpp"
# include "gc.cpp"
# include "lisp_object.cpp"
# include "error.cpp"
# include "io.cpp"
# include "env.cpp"
# include "parse.cpp"
# include "eval.cpp"
# include "visualization.cpp"
# include "docgeneration.cpp"
# include "built_ins.cpp"
# include "testing.cpp"
// # include "undefines.cpp"
#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE
#include <stdlib.h>
#include <stdio.h>
#include <time.h>
#include <string.h>
#include <cmath>
#include <ctype.h>
#include <stdarg.h>
#include <errno.h>
#include <new>
#ifdef _MSC_VER
# include <direct.h>
# include <windows.h>
#else
# include <unistd.h>
# include <signal.h>
#endif
/*
Forward declare the hash functions for the hashmap (needed at least
for clang++)
*/
namespace Slime {struct Lisp_Object;}
bool hm_objects_match(char* a, char* b);
bool hm_objects_match(void* a, void* b);
bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b);
unsigned int hm_hash(char* str);
unsigned int hm_hash(void* ptr);
unsigned int hm_hash(Slime::Lisp_Object* obj);
#include "ftb/hashmap.hpp"
#include "ftb/types.hpp"
#include "ftb/arraylist.hpp"
#include "ftb/bucket_allocator.hpp"
#include "ftb/macros.hpp"
#include "ftb/profiler.hpp"
#include "ftb/hooks.hpp"
# include "defines.cpp"
# include "assert.hpp"
# include "define_macros.hpp"
# include "platform.cpp"
# include "structs.cpp"
# include "forward_decls.cpp"
inline bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0;
}
inline bool hm_objects_match(void* a, void* b) {
return a == b;
}
inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) {
return Slime::lisp_object_equal(a, b);
}
unsigned int hm_hash(char* str) {
unsigned int value = str[0] << 7;
int i = 0;
while (str[i]) {
value = (10000003 * value) ^ str[i++];
}
return value ^ i;
}
unsigned int hm_hash(void* ptr) {
return ((unsigned long long)ptr * 2654435761) % 4294967296;
}
unsigned int hm_hash(Slime::Lisp_Object* obj) {
using namespace Slime;
switch (obj->type) {
// hash from adress: if two objects of these types have
// different addresses, they are different
case Lisp_Object_Type::Function:
case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::Continuation:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::T:
return hm_hash((void*) obj);
// hash from contents: even if objects are themselved
// different, they cauld be equivalent:
case Lisp_Object_Type::Pointer: return hm_hash((void*) obj->value.pointer);
case Lisp_Object_Type::Number: return hm_hash((void*) (unsigned long long)obj->value.number); // HACK(Felix): yes
case Lisp_Object_Type::String: return hm_hash((char*) obj->value.string.data);
case Lisp_Object_Type::Pair: {
u32 hash = 1;
for_lisp_list (obj) {
hash <<= 1;
hash += hm_hash(it);
}
return hash;
} break;
case Lisp_Object_Type::Vector:
case Lisp_Object_Type::HashMap:
default:
create_not_yet_implemented_error();
return 0;
}
}
# include "globals.cpp"
# include "memory.cpp"
# include "gc.cpp"
# include "lisp_object.cpp"
# include "error.cpp"
# include "io.cpp"
# include "env.cpp"
# include "parse.cpp"
# include "eval.cpp"
# include "visualization.cpp"
# include "docgeneration.cpp"
# include "built_ins.cpp"
# include "testing.cpp"
// # include "undefines.cpp"

+ 33
- 31
src/lisp_object.cpp Zobrazit soubor

@@ -1,31 +1,33 @@
namespace Slime {
proc create_source_code_location(String file, int line, int col) -> Source_Code_Location* {
if (!file.data)
return nullptr;
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}
proc lisp_object_type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap";
}
return "unknown";
}
}
namespace Slime {
proc create_source_code_location(String file, int line, int col) -> Source_Code_Location* {
if (!file.data)
return nullptr;

Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
ret->file = file;
ret->line = line;
ret->column = col;
return ret;
}

proc lisp_object_type_to_string(Lisp_Object_Type type) -> const char* {
switch (type) {
case(Lisp_Object_Type::Nil): return "nil";
case(Lisp_Object_Type::T): return "t";
case(Lisp_Object_Type::Number): return "number";
case(Lisp_Object_Type::String): return "string";
case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector";
case(Lisp_Object_Type::Pointer): return "pointer";
case(Lisp_Object_Type::HashMap): return "hashmap";
case(Lisp_Object_Type::Invalid_Garbage_Collected): return "Invalid: Garbage Collected";
case(Lisp_Object_Type::Invalid_Under_Construction): return "Invalid: Under Construction";
}
return "unknown";
}

}

+ 30
- 31
src/main.cpp Zobrazit soubor

@@ -1,31 +1,30 @@
#include "libslime.cpp"
int main(int argc, char* argv[]) {
#ifdef _MSC_VER
// enable colored terminal output for windows
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
#endif
if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
return res ? 0 : 1;
} else if (Slime::string_equal(argv[1], "--generate-docs")) {
Slime::Memory::init();
if (Slime::Globals::error) return 1;
Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
} else {
Slime::interprete_file(argv[1]);
}
} else {
Slime::interprete_stdin();
return 0;
}
if (Slime::Globals::error) return 1;
}
#include "libslime.cpp"

int main(int argc, char* argv[]) {
#ifdef _MSC_VER
// enable colored terminal output for windows
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
#endif

if (argc > 1) {
if (Slime::string_equal(argv[1], "--run-tests")) {
int res = Slime::run_all_tests();
return res ? 0 : 1;
} else if (Slime::string_equal(argv[1], "--generate-docs")) {
Slime::Memory::init();
if (Slime::Globals::error) return 1;
Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
} else {
Slime::interprete_file(argv[1]);
}
} else {
Slime::interprete_stdin();
return 0;
}

if (Slime::Globals::error) return 1;
}

+ 502
- 539
src/memory.cpp
Diff nebyl zobrazen, protože je příliš veliký
Zobrazit soubor


+ 11
- 17
src/structs.cpp Zobrazit soubor

@@ -3,12 +3,12 @@ namespace Slime {
struct String;
struct Environment;

enum struct Thread_Type {
enum struct Thread_Type : u8 {
Main,
GarbageCollection
};

enum struct Lisp_Object_Type {
enum struct Lisp_Object_Type : u8 {
Nil,
T,
Symbol,
@@ -22,16 +22,11 @@ namespace Slime {
HashMap,
// OwningPointer,
Function,
Invalid_Garbage_Collected,
Invalid_Under_Construction
};

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 NasAction {
enum struct NasAction : u8 {
And_Then_Action,
Macro_Write_Back,
Eval,
@@ -43,13 +38,13 @@ namespace Slime {
Pop_Environment
};

enum struct Lisp_Function_Type {
enum struct Lisp_Function_Type : u8 {
Lambda, // normal evaluation order
Macro // args are not evaluated, a new programm is returned
// that will be executed again
};

enum struct C_Function_Type {
enum struct C_Function_Type : u8 {
cFunction, // normal evaluation order
cSpecial, // args are not evaluated, but result is returned
// as you would expect
@@ -57,7 +52,7 @@ namespace Slime {
// modified
};

enum struct Log_Level {
enum struct Log_Level : u8 {
None,
Critical,
Warning,
@@ -131,10 +126,9 @@ namespace Slime {
} body;
};

#pragma pack(1)
struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
u64 flags;
Lisp_Object* userType; // keyword
Lisp_Object_Type type;
union value {
String symbol; // used for symbols and keywords
double number;
@@ -145,9 +139,9 @@ namespace Slime {
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
};
#pragma options align=reset

struct Error {
Lisp_Object* position;


+ 660
- 660
src/testing.cpp
Diff nebyl zobrazen, protože je příliš veliký
Zobrazit soubor


Zapsat Náhled
Načítá se…
Zrušit
Uložit