felix
/
slime
1
0
Forkuj 0
Kod Zgłoszenia 0 Oczekujące zmiany 0 Wydania 0 Wiki Aktywność
Przeglądaj źródła

fixed import bug

master
fumfar hiwi 6 lat temu
rodzic
667989e373
commit
efbdfeed2e
19 zmienionych plików z 3602 dodań i 3584 usunięć
Zunifikowany widok
Opcje porównania
Pokaż statystyki Ściągnij plik aktualizacji Ściągnij plik porównania
  1. +1
    -1
      bin/tests/import1.slime
  2. +8
    -15
      bin/tests/singular_imports.slime
  3. +1113
    -1113
      src/built_ins.cpp
  4. +125
    -123
      src/docgeneration.cpp
  5. +112
    -112
      src/env.cpp
  6. +49
    -46
      src/error.cpp
  7. +427
    -425
      src/eval.cpp
  8. +73
    -71
      src/forward_decls.cpp
  9. +1
    -1
      src/gc.cpp
  10. +1
    -1
      src/globals.cpp
  11. +380
    -378
      src/io.cpp
  12. +3
    -4
      src/libslime.cpp
  13. +48
    -46
      src/lisp_object.cpp
  14. +1
    -1
      src/memory.cpp
  15. +1
    -1
      src/parse.cpp
  16. +129
    -126
      src/platform.cpp
  17. +144
    -142
      src/structs.cpp
  18. +475
    -469
      src/testing.cpp
  19. +511
    -509
      src/visualization.cpp

+ 1
- 1
bin/tests/import1.slime Wyświetl plik

@@ -1,3 +1,3 @@
(define a 10)
(define a 1111)


(define (get-a-1) a) (define (get-a-1) a)

+ 8
- 15
bin/tests/singular_imports.slime Wyświetl plik

@@ -1,27 +1,20 @@
(import "tests/import1.slime") (import "tests/import1.slime")


(print)
(print ">" a)
(assert (= a 10))
(print ">" (get-a-1))
(assert (= (get-a-1) 10))
(assert (= a 1111))
(assert (= (get-a-1) 1111))




(import "tests/import2.slime") (import "tests/import2.slime")


(print ">" a)
(assert (= a 10))
(print ">" (get-a-1))
(assert (= (get-a-1) 10))
(print ">" (get-a-2))
(assert (= (get-a-2) 10))

(assert (= a 1111))
(assert (= (get-a-1) 1111))
(assert (= (get-a-2) 1111))


(set-a-2 11) (set-a-2 11)
(print "> should be 11 from now on")


(print ">" a)
(assert (= a 11)) (assert (= a 11))
(print ">" (get-a-1))
(assert (= (get-a-1) 11)) (assert (= (get-a-1) 11))
(print ">" (get-a-2))
(assert (= (get-a-2) 11)) (assert (= (get-a-2) 11))

+ 1113
- 1113
src/built_ins.cpp
Plik diff jest za duży
Wyświetl plik


+ 125
- 123
src/docgeneration.cpp Wyświetl plik

@@ -1,144 +1,146 @@
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;
}
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;
} }
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);
defer {
fclose(f);
};


push_environment(env);
defer {
pop_environment();
};
Array_List<Environment*> visited;


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);
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;
} }
/*
* 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);
}
if (!we_already_printed) {
// printf("Working on env::::");
// print_environment(env);
// printf("\n--------------------------------\n");
visited.append(env);


fprintf(f, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "=");
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);


/*
* 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, "\n - type :: =");
print(LOtype, true, f);
fprintf(f, "="); fprintf(f, "=");
} break;
default: break;
}
/*
* if function then print arguments
*/
if (type == Lisp_Object_Type::Function ||
type == Lisp_Object_Type::CFunction)
{
Arguments* args =
(type == Lisp_Object_Type::Function)
? &value->value.function->args
: &value->value.cFunction->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)


/*
* 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 ||
type == Lisp_Object_Type::CFunction)
{ {
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, ")=");
Arguments* args =
(type == Lisp_Object_Type::Function)
? &value->value.function->args
: &value->value.cFunction->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));
}
} }
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]) {
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, " =("); fprintf(f, " =(");
print(args->keyword.values.data[i], true, f);
print(args->keyword.values.data[0], true, f);
fprintf(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));
} }
}
if (args->rest) {
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
} }
} }
fprintf(f, "\n - docu :: ");
if (value->docstring)
fprintf(f, "\n #+BEGIN:\n%s\n #+END:\n",
Memory::get_c_str(value->docstring));
else
fprintf(f, "none\n");
} }
fprintf(f, "\n - docu :: ");
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);
}
};
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*)"");
}
} }

+ 112
- 112
src/env.cpp Wyświetl plik

@@ -1,126 +1,126 @@
namespace Slime { namespace Slime {


proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment();
env->hm.set_object((void*)symbol, value);
}

inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
return (Lisp_Object*)env->hm.get_object((void*)sym);
}

proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
return lookup_symbol_in_this_envt(sym, env) != nullptr;
}

proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
if (environment_binds_symbol(sym, env))
return env;
for (auto it : env->parents) {
if (Environment* ret = find_binding_environment(sym, it))
return ret;
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
profile_with_comment(&symbol->value.symbol->data);
Environment* env = get_current_environment();
env->hm.set_object((void*)symbol, value);
} }
return nullptr;
}

proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment
Lisp_Object* result;
result = lookup_symbol_in_this_envt(node, env);
if (result)
return result;

for (int i = 0; i < env->parents.next_index; ++i) {
result = try_lookup_symbol(node, env->parents.data[i]);

if (result)
return result;

inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
return (Lisp_Object*)env->hm.get_object((void*)sym);
}

proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
return lookup_symbol_in_this_envt(sym, env) != nullptr;
} }


auto nil_sym = Memory::get_symbol("nil");
auto t_sym = Memory::get_symbol("t");
proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
if (environment_binds_symbol(sym, env))
return env;
for (auto it : env->parents) {
if (Environment* ret = find_binding_environment(sym, it))
return ret;
}
return nullptr;
}

proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
// first check current environment

Lisp_Object* result;
result = lookup_symbol_in_this_envt(node, env);
if (result)
return result;


if (node == nil_sym) {
return Memory::nil;
for (int i = 0; i < env->parents.next_index; ++i) {
result = try_lookup_symbol(node, env->parents.data[i]);

if (result)
return result;
}

auto nil_sym = Memory::get_symbol("nil");
auto t_sym = Memory::get_symbol("t");

if (node == nil_sym) {
return Memory::nil;
}
if (node == t_sym) {
return Memory::t;
}

return nullptr;
} }
if (node == t_sym) {
return Memory::t;

inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution;
envi_stack.append(env);
} }


return nullptr;
}

inline proc push_environment(Environment* env) -> void {
using namespace Globals::Current_Execution;
envi_stack.append(env);
}

inline proc pop_environment() -> void {
using namespace Globals::Current_Execution;
--envi_stack.next_index;
}

inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[0];
}

inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[envi_stack.next_index-1];
}

proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
profile_with_comment(&node->value.symbol->data);
// print(node);
assert_type(node, Lisp_Object_Type::Symbol);

Lisp_Object* result = try_lookup_symbol(node, env);

if (result)
return result;

String* identifier = node->value.symbol;
print_environment(env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
return nullptr;
}


proc print_environment_indent(Environment* env, int indent) -> void {
proc print_indent = [](int indent) {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
};

// if(env == get_root_environment()) {
// print_indent(indent);
// printf("[built-ins]-Environment (%lld)\n", (long long)env);
// return;
// }

for_hash_map (env->hm) {
print_indent(indent);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
inline proc pop_environment() -> void {
using namespace Globals::Current_Execution;
--envi_stack.next_index;
} }
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (0x%016llx)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);

inline proc get_root_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[0];
} }
}


proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
print_environment_indent(env, 0);
}
inline proc get_current_environment() -> Environment* {
using namespace Globals::Current_Execution;
return envi_stack.data[envi_stack.next_index-1];
}

proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* {
profile_with_comment(&node->value.symbol->data);
// print(node);
assert_type(node, Lisp_Object_Type::Symbol);

Lisp_Object* result = try_lookup_symbol(node, env);

if (result)
return result;

String* identifier = node->value.symbol;
print_environment(env);
printf("\n");
create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data);
return nullptr;
}


proc print_environment_indent(Environment* env, int indent) -> void {
proc print_indent = [](int indent) {
for (int i = 0; i < indent; ++i) {
printf(" ");
}
};

if(env == get_root_environment()) {
print_indent(indent);
printf("[built-ins]-Environment (%lld)\n", (long long)env);
return;
}

for_hash_map (env->hm) {
print_indent(indent);
printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data));
print((Lisp_Object*)value);
printf(" (0x%016llx)", (unsigned long long)value);
puts("");
}
for (int i = 0; i < env->parents.next_index; ++i) {
print_indent(indent);
printf("parent (0x%016llx)", (long long)env->parents.data[i]);
puts(":");
print_environment_indent(env->parents.data[i], indent+4);
}
}

proc print_environment(Environment* env) -> void {
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
print_environment_indent(env, 0);
}


} }

+ 49
- 46
src/error.cpp Wyświetl plik

@@ -1,54 +1,57 @@
proc delete_error() -> void {
using Globals::error;
namespace Slime {


free(error);
error = nullptr;
}

proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
}
proc delete_error() -> void {
using Globals::error;


using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type;
error->message = message;

log_error();
if (Globals::log_level > Log_Level::None) {
// c error location
printf("in");
int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line));
if (spacing < 1) spacing = 1;
for (int i = 0; i < spacing; ++i)
printf(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
free(error);
error = nullptr;
} }


// visualize_lisp_machine();
}
proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
delete_error();
if (Globals::breaking_on_errors) {
debug_break();
}


proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
using Globals::error;

int length = 200;
String* formatted_string = Memory::create_string("", length);
if (error) {
error = new(Error);
using Globals::error;
error = (Error*)malloc(sizeof(Error)) ;
error->type = type; error->type = type;
error->message = message;

log_error();
if (Globals::log_level > Log_Level::None) {
// c error location
printf("in");
int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line));
if (spacing < 1) spacing = 1;
for (int i = 0; i < spacing; ++i)
printf(" ");
printf("%s (%d) ", c_file_name, c_file_line);
printf("-> %s\n", c_func_name);
}

// visualize_lisp_machine();
}

proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void {
using Globals::error;

int length = 200;
String* formatted_string = Memory::create_string("", length);
if (error) {
error = new(Error);
error->type = type;
}
int written_length;
va_list args;
char* out_msg;
va_start(args, format);
written_length = vasprintf(&out_msg, format, args);
va_end(args);

formatted_string->length = written_length;
strcpy(&formatted_string->data, out_msg);
free(out_msg);
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string);
} }
int written_length;
va_list args;
char* out_msg;
va_start(args, format);
written_length = vasprintf(&out_msg, format, args);
va_end(args);

formatted_string->length = written_length;
strcpy(&formatted_string->data, out_msg);
free(out_msg);
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string);
} }

+ 427
- 425
src/eval.cpp Wyświetl plik

@@ -1,116 +1,99 @@
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function,
bool should_evaluate) -> Environment*
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
Lisp_Object* arguments = unevaluated_arguments;
Arguments* arg_spec;

// NOTE(Felix): Step 1.
// - setting the parent environment
// - setting the arg_spec
// - potentially evaluating the arguments
if (is_c_function) {
new_env = Memory::create_child_environment(get_root_environment());
arg_spec = &function->value.cFunction->args;
} else {
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (should_evaluate) {
try arguments = eval_arguments(arguments);
}

// NOTE(Felix): Even though we will return the environment at the
// end, for defining symbols here for the parameters, it has to be
// on the envi stack.
push_environment(new_env);
defer {
pop_environment();
};

namespace Slime {
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function,
bool should_evaluate) -> Environment*
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
Lisp_Object* arguments = unevaluated_arguments;
Arguments* arg_spec;

// NOTE(Felix): Step 1.
// - setting the parent environment
// - setting the arg_spec
// - potentially evaluating the arguments
if (is_c_function) {
new_env = Memory::create_child_environment(get_root_environment());
arg_spec = &function->value.cFunction->args;
} else {
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (should_evaluate) {
try arguments = eval_arguments(arguments);
}


// NOTE(Felix): Step 2.
// Reading the argument spec and fill in the environment
// for the function call
// NOTE(Felix): Even though we will return the environment at the
// end, for defining symbols here for the parameters, it has to be
// on the envi stack.
push_environment(new_env);
defer {
pop_environment();
};


Lisp_Object* sym, *val; // used as temp storage to use `try`
Array_List<Lisp_Object*> read_in_keywords;
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;


proc read_positional_args = [&]() -> void {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_parsing_error("Wrong number of arguments.");
return;
}
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. XXX(Felix): T C
// functions we pass by reference...
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) {
define_symbol(sym, arguments->value.pair.first);
} else {
define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first));
}
// NOTE(Felix): Step 2.
// Reading the argument spec and fill in the environment
// for the function call


arguments = arguments->value.pair.rest;
}
};
Lisp_Object* sym, *val; // used as temp storage to use `try`
Array_List<Lisp_Object*> read_in_keywords;
int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0;


proc read_keyword_args = [&]() -> void {
// keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or
// something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop.
proc read_positional_args = [&]() -> void {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_parsing_error("Wrong number of arguments.");
return;
}
// NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. XXX(Felix): T C
// functions we pass by reference...
sym = arg_spec->positional.symbols.data[i];
if (is_c_function) {
define_symbol(sym, arguments->value.pair.first);
} else {
define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first));
}


if (arguments == Memory::nil)
return;
arguments = arguments->value.pair.rest;
}
};


// find out how many keyword args we /have/ to read
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arg_spec->keyword.values.data[i] == nullptr)
++obligatory_keywords_count;
else
break;
}
proc read_keyword_args = [&]() -> void {
// keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or
// something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop.


if (arguments == Memory::nil)
return;


while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
// find out how many keyword args we /have/ to read
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i])
{
accepted = true;
if (arg_spec->keyword.values.data[i] == nullptr)
++obligatory_keywords_count;
else
break; break;
}
}
if (!accepted) {
// NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count)
return;
create_generic_error(
"The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.",
&(arguments->value.pair.first->value.symbol->data));
return;
} }


// check if it was already read in
for (int i = 0; i < read_in_keywords.next_index; ++i) {
if (arguments->value.pair.first == read_in_keywords.data[i])
{

while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i])
{
accepted = true;
break;
}
}
if (!accepted) {
// NOTE(Felix): if we are actually done with all the // NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest // necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error // as :rest here, instead od always creating an error
@@ -118,132 +101,150 @@ proc create_extended_environment_for_function_application(
if (read_obligatory_keywords_count == obligatory_keywords_count) if (read_obligatory_keywords_count == obligatory_keywords_count)
return; return;
create_generic_error( create_generic_error(
"The function already read the keyword argument ':%s'",
"The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.",
&(arguments->value.pair.first->value.symbol->data)); &(arguments->value.pair.first->value.symbol->data));
return; return;
} }
}


// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->value.symbol->data));
return;
}
// check if it was already read in
for (int i = 0; i < read_in_keywords.next_index; ++i) {
if (arguments->value.pair.first == read_in_keywords.data[i])
{
// NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count)
return;
create_generic_error(
"The function already read the keyword argument ':%s'",
&(arguments->value.pair.first->value.symbol->data));
return;
}
}


// if not set it and then add it to the array list
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) {
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first);
} else {
try_void define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
}
// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->value.symbol->data));
return;
}


read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count;
// if not set it and then add it to the array list
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
// NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) {
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first);
} else {
try_void define_symbol(
sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
}


// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;
read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count;


if (arguments == Memory::nil) {
break;
}
}
};

proc check_keyword_args = [&]() -> void {
// check if all necessary keywords have been read in
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
auto defined_keyword = arg_spec->keyword.keywords.data[i];
bool was_set = false;
for (int j = 0; j < read_in_keywords.next_index; ++j) {
if (read_in_keywords.data[j] == defined_keyword) {
was_set = true;
// overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest;

if (arguments == Memory::nil) {
break; break;
} }
} }
if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value
if (!was_set) {
create_generic_error(
"There was no value supplied for the required "
"keyword argument ':%s'.",
&defined_keyword->value.symbol->data);
return;
};

proc check_keyword_args = [&]() -> void {
// check if all necessary keywords have been read in
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
auto defined_keyword = arg_spec->keyword.keywords.data[i];
bool was_set = false;
for (int j = 0; j < read_in_keywords.next_index; ++j) {
if (read_in_keywords.data[j] == defined_keyword) {
was_set = true;
break;
}
} }
} else {
// this one does have a default value, lets see if we have
// to use it or if the user supplied his own
if (!was_set) {
try_void sym = Memory::get_symbol(defined_keyword->value.symbol);
if (is_c_function) {
try_void val = arg_spec->keyword.values.data[i];
} else {
try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value
if (!was_set) {
create_generic_error(
"There was no value supplied for the required "
"keyword argument ':%s'.",
&defined_keyword->value.symbol->data);
return;
}
} else {
// this one does have a default value, lets see if we have
// to use it or if the user supplied his own
if (!was_set) {
try_void sym = Memory::get_symbol(defined_keyword->value.symbol);
if (is_c_function) {
try_void val = arg_spec->keyword.values.data[i];
} else {
try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
}
define_symbol(sym, val);
} }
define_symbol(sym, val);
} }
} }
}
};
};


proc read_rest_arg = [&]() -> void {
if (arguments == Memory::nil) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
} else {
if (arg_spec->rest) {
define_symbol(
arg_spec->rest,
// NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it...
arguments);
proc read_rest_arg = [&]() -> void {
if (arguments == Memory::nil) {
if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil);
}
} else { } else {
// rest was not declared but additional arguments were found
create_generic_error(
"A rest argument was not declared "
"but the function was called with additional arguments.");
return;
if (arg_spec->rest) {
define_symbol(
arg_spec->rest,
// NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it...
arguments);
} else {
// rest was not declared but additional arguments were found
create_generic_error(
"A rest argument was not declared "
"but the function was called with additional arguments.");
return;
}
} }
}
};
};


try read_positional_args();
try read_keyword_args();
try check_keyword_args();
try read_rest_arg();
try read_positional_args();
try read_keyword_args();
try check_keyword_args();
try read_rest_arg();


return new_env;
}
return new_env;
}


proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this();
Environment* new_env;
Lisp_Object* result;
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this();
Environment* new_env;
Lisp_Object* result;


try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env);
defer {
pop_environment();
};
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env);
defer {
pop_environment();
};




if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else
// if lisp function
try result = eval_expr(function->value.function->body);
if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function:
try result = function->value.cFunction->body();
else
// if lisp function
try result = eval_expr(function->value.function->body);


return result;
}
return result;
}


/** /**
This parses the argument specification of funcitons into their This parses the argument specification of funcitons into their
@@ -251,272 +252,273 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function,
positional_arguments, keyword_arguments and rest_argument and positional_arguments, keyword_arguments and rest_argument and
filling it in filling it in
*/ */
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
result = &function->value.function->args;
}
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
Arguments* result;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
result = &function->value.function->args;
}


// first init the fields
result->rest = nullptr;
// first init the fields
result->rest = nullptr;


// okay let's try to read some positional arguments
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
// if we encounter a keyword or a list (for keywords with
// defualt args), the positionals are done
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword ||
Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
// okay let's try to read some positional arguments
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
// if we encounter a keyword or a list (for keywords with
// defualt args), the positionals are done
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword ||
Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
break; break;
}
}


// if we encounter something that is neither a symbol nor a
// keyword arg, it's an error
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords "
"(with or without default args) "
"can be parsed here, but found '%s'",
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}
// if we encounter something that is neither a symbol nor a
// keyword arg, it's an error
if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
create_parsing_error("Only symbols and keywords "
"(with or without default args) "
"can be parsed here, but found '%s'",
Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
return;
}


// okay we found an actual symbol
result->positional.symbols.append(arguments->value.pair.first);
// okay we found an actual symbol
result->positional.symbols.append(arguments->value.pair.first);


arguments = arguments->value.pair.rest;
}
arguments = arguments->value.pair.rest;
}


// if we reach here, we are on a keyword or a pair wher a keyword
// should be in first
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// if we are on a actual keyword (with no default arg)
auto keyword = arguments->value.pair.first;
result->keyword.keywords.append(keyword);
result->keyword.values.append(nullptr);
} else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
// if we are on a keyword with a default value

auto keyword = arguments->value.pair.first->value.pair.first;
if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) {
create_parsing_error("Default args must be keywords");
}
if (Memory::get_type(arguments->value.pair.first->value.pair.rest)
!= Lisp_Object_Type::Pair)
{
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
try_void value = eval_expr(value);
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
// if we reach here, we are on a keyword or a pair wher a keyword
// should be in first
while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// if we are on a actual keyword (with no default arg)
auto keyword = arguments->value.pair.first;
result->keyword.keywords.append(keyword);
result->keyword.values.append(nullptr);
} else if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Pair) {
// if we are on a keyword with a default value

auto keyword = arguments->value.pair.first->value.pair.first;
if (Memory::get_type(keyword) != Lisp_Object_Type::Keyword) {
create_parsing_error("Default args must be keywords");
}
if (Memory::get_type(arguments->value.pair.first->value.pair.rest)
!= Lisp_Object_Type::Pair)
{
create_parsing_error("Default args must be a list of 2.");
}
auto value = arguments->value.pair.first->value.pair.rest->value.pair.first;
try_void value = eval_expr(value);
if (arguments->value.pair.first->value.pair.rest->value.pair.rest != Memory::nil) {
create_parsing_error("Default args must be a list of 2.");
}

result->keyword.keywords.append(keyword);
result->keyword.values.append(value);
} }
arguments = arguments->value.pair.rest;
}


result->keyword.keywords.append(keyword);
result->keyword.values.append(value);
// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments == Memory::nil)
return;
if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol)
result->rest = arguments;
else
create_parsing_error("The rest argument must be a symbol.");
} }
arguments = arguments->value.pair.rest;
} }


// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
if (arguments == Memory::nil)
return;
if (Memory::get_type(arguments) == Lisp_Object_Type::Symbol)
result->rest = arguments;
else
create_parsing_error("The rest argument must be a symbol.");
}
}


proc list_length(Lisp_Object* node) -> int {
if (node == Memory::nil)
return 0;


proc list_length(Lisp_Object* node) -> int {
if (node == Memory::nil)
return 0;
assert_type(node, Lisp_Object_Type::Pair);


assert_type(node, Lisp_Object_Type::Pair);
int len = 0;


int len = 0;
while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
if (node == Memory::nil)
return len;
}


while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
++len;
node = node->value.pair.rest;
if (node == Memory::nil)
return len;
create_parsing_error("Can't calculate length of ill formed list.");
return 0;
} }


create_parsing_error("Can't calculate length of ill formed list.");
return 0;
}

proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
// TODO(Felix):
return nullptr;
}

proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this();
// int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
// *(out_arguments_length) = 0;
return arguments;
proc copy_scl(Source_Code_Location*) -> Source_Code_Location* {
// TODO(Felix):
return nullptr;
} }


Lisp_Object* evaluated_arguments;
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this();
// int my_out_arguments_length = 0;
if (arguments == Memory::nil) {
// *(out_arguments_length) = 0;
return arguments;
}


Lisp_Object* evaluated_arguments_head = evaluated_arguments;
Lisp_Object* current_head = arguments;
Lisp_Object* evaluated_arguments;
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);


while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
Lisp_Object* evaluated_arguments_head = evaluated_arguments;
Lisp_Object* current_head = arguments;


evaluated_arguments_head->value.pair.first->sourceCodeLocation =
copy_scl(current_head->value.pair.first->sourceCodeLocation);
current_head = current_head->value.pair.rest;
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);


if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head == Memory::nil) {
evaluated_arguments_head->value.pair.rest = current_head;
} else {
create_parsing_error("Attempting to evaluate ill formed argument list.");
return nullptr;
evaluated_arguments_head->value.pair.first->sourceCodeLocation =
copy_scl(current_head->value.pair.first->sourceCodeLocation);
current_head = current_head->value.pair.rest;

if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head == Memory::nil) {
evaluated_arguments_head->value.pair.rest = current_head;
} else {
create_parsing_error("Attempting to evaluate ill formed argument list.");
return nullptr;
}
// ++my_out_arguments_length;
} }
// ++my_out_arguments_length;
// *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
} }
// *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments;
}


proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
profile_this();

using namespace Globals::Current_Execution;
call_stack.append(node);
defer {
--call_stack.next_index;
};

switch (Memory::get_type(node)) {
case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Number:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return node;
case Lisp_Object_Type::Symbol: {
Lisp_Object* value;
try value = lookup_symbol(node, get_current_environment());
return value;
}
case Lisp_Object_Type::Pair: {
Lisp_Object* lispOperator;
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{
try lispOperator = eval_expr(node->value.pair.first);
} else {
lispOperator = node->value.pair.first;
proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
profile_this();

using namespace Globals::Current_Execution;
call_stack.append(node);
defer {
--call_stack.next_index;
};

switch (Memory::get_type(node)) {
case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil:
case Lisp_Object_Type::Number:
case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return node;
case Lisp_Object_Type::Symbol: {
Lisp_Object* value;
try value = lookup_symbol(node, get_current_environment());
return value;
} }
case Lisp_Object_Type::Pair: {
Lisp_Object* lispOperator;
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{
try lispOperator = eval_expr(node->value.pair.first);
} else {
lispOperator = node->value.pair.first;
}


Lisp_Object* arguments = node->value.pair.rest;
// check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
!lispOperator->value.cFunction->is_special_form);
return result;
}
Lisp_Object* arguments = node->value.pair.rest;
// check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
!lispOperator->value.cFunction->is_special_form);
return result;
}

// check for lisp function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before
// apllying, for the other types, special-lambda and macro
// we do not need.

Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
lispOperator->value.function->type == Function_Type::Lambda);

// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
// (because at read time, they are not imported yet, this
// is done at runtime...). That is why we sometimes have
// stray macros fying around, in that case, we expand them
// and bake them in, so they do not have to be expanded
// later again. We will call this "lazy macro expansion"
if (lispOperator->value.function->type == Function_Type::Macro) {
// bake in the macro expansion:
*node = *Memory::copy_lisp_object(result);
result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// eval again because macro
try result = eval_expr(result);
}


// check for lisp function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before
// apllying, for the other types, special-lambda and macro
// we do not need.

Lisp_Object* result;
try result = apply_arguments_to_function(
arguments,
lispOperator,
lispOperator->value.function->type == Function_Type::Lambda);

// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
// (because at read time, they are not imported yet, this
// is done at runtime...). That is why we sometimes have
// stray macros fying around, in that case, we expand them
// and bake them in, so they do not have to be expanded
// later again. We will call this "lazy macro expansion"
if (lispOperator->value.function->type == Function_Type::Macro) {
// bake in the macro expansion:
*node = *Memory::copy_lisp_object(result);
result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// eval again because macro
try result = eval_expr(result);
return result;
} }


return result;
create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
return nullptr;
}
default: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
return nullptr;
} }


create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
return nullptr;
}
default: {
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
return nullptr;
}
} }


}
}
proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);


proc is_truthy(Lisp_Object* expression) -> bool {
Lisp_Object* result;
try result = eval_expr(expression);

return result != Memory::nil;
}
return result != Memory::nil;
}


proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256);
proc interprete_file (char* file_name) -> Lisp_Object* {
try Memory::init(4096 * 256);


Lisp_Object* result;
Lisp_Object* result;


try result = built_in_load(Memory::create_string(file_name));
try result = built_in_load(Memory::create_string(file_name));


return result;
}
return result;
}


proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100);

printf("Welcome to the lispy interpreter.\n");

char* line;

Lisp_Object* parsed, * evaluated;
while (true) {
[&] {
delete_error();
fputs("> ", stdout);
line = read_expression();
defer {
free(line);
};
try_void parsed = Parser::parse_single_expression(line);
try_void evaluated = eval_expr(parsed);
if (evaluated != Memory::nil) {
print(evaluated);
fputs("\n", stdout);
}
}();
proc interprete_stdin() -> void {
try_void Memory::init(4096 * 256* 100);

printf("Welcome to the lispy interpreter.\n");

char* line;

Lisp_Object* parsed, * evaluated;
while (true) {
[&] {
delete_error();
fputs("> ", stdout);
line = read_expression();
defer {
free(line);
};
try_void parsed = Parser::parse_single_expression(line);
try_void evaluated = eval_expr(parsed);
if (evaluated != Memory::nil) {
print(evaluated);
fputs("\n", stdout);
}
}();
}
} }
} }

+ 73
- 71
src/forward_decls.cpp Wyświetl plik

@@ -1,83 +1,85 @@
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);
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 print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
void print_environment(Environment*);


bool run_all_tests();
bool run_all_tests();


inline Environment* get_root_environment();
inline Environment* get_current_environment();
inline void push_environment(Environment*);
inline void pop_environment();
inline Environment* get_root_environment();
inline Environment* get_current_environment();
inline void push_environment(Environment*);
inline void pop_environment();


const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);


void visualize_lisp_machine();
void generate_docs(String* path);
void log_error();
void visualize_lisp_machine();
void generate_docs(String* path);
void log_error();


namespace Memory {
Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node);
void init(int);
char* get_c_str(String*);
void free_everything();
String* create_string(const char*);
Lisp_Object* get_symbol(String* identifier);
Lisp_Object* get_symbol(const char*);
Lisp_Object* get_keyword(String* identifier);
Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(const char*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
}
namespace Memory {
Environment* create_built_ins_environment();
Lisp_Object* create_lisp_object_cfunction(bool is_special);
inline Lisp_Object_Type get_type(Lisp_Object* node);
void init(int);
char* get_c_str(String*);
void free_everything();
String* create_string(const char*);
Lisp_Object* get_symbol(String* identifier);
Lisp_Object* get_symbol(const char*);
Lisp_Object* get_keyword(String* identifier);
Lisp_Object* get_keyword(const char*);
Lisp_Object* create_lisp_object(double);
Lisp_Object* create_lisp_object(const char*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
}


namespace Parser {
// extern Environment* environment_for_macros;
namespace Parser {
// extern Environment* environment_for_macros;


extern String* standard_in;
extern String* parser_file;
extern int parser_line;
extern int parser_col;
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(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}
Lisp_Object* parse_expression(char* text, int* index_in_text);
Lisp_Object* parse_single_expression(char* text);
Lisp_Object* parse_single_expression(wchar_t* text);
}


namespace Globals {
extern char* bin_path;
extern Log_Level log_level;
extern Array_List<void*> load_path;
namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack;
namespace Globals {
extern char* bin_path;
extern Log_Level log_level;
extern Array_List<void*> load_path;
namespace Current_Execution {
extern Array_List<Lisp_Object*> call_stack;
extern Array_List<Environment*> envi_stack;
}
extern Error* error;
extern bool breaking_on_errors;
} }
extern Error* error;
extern bool breaking_on_errors;
} }

+ 1
- 1
src/gc.cpp Wyświetl plik

@@ -1,4 +1,4 @@
namespace GC {
namespace Slime::GC {
proc maybe_mark(Environment* env) -> void; proc maybe_mark(Environment* env) -> void;
int current_mark; int current_mark;


+ 1
- 1
src/globals.cpp Wyświetl plik

@@ -1,4 +1,4 @@
namespace 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;




+ 380
- 378
src/io.cpp Wyświetl plik

@@ -1,460 +1,462 @@
proc string_equal(const char input[], const char check[]) -> bool {
if (input == check) return true;
namespace Slime {
proc string_equal(const char input[], const char check[]) -> bool {
if (input == check) return true;


for(int i = 0; input[i] == check[i]; i++) {
if (input[i] == '\0')
return true;
}
for(int i = 0; input[i] == check[i]; i++) {
if (input[i] == '\0')
return true;
}


return false;
}
return false;
}


proc string_equal(String* str, const char check[]) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(String* str, const char check[]) -> bool {
return string_equal(Memory::get_c_str(str), check);
}


proc string_equal(const char check[], String* str) -> bool {
return string_equal(Memory::get_c_str(str), check);
}
proc string_equal(const char check[], String* str) -> bool {
return string_equal(Memory::get_c_str(str), check);
}


proc string_equal(String* str1, String* str2) -> bool {
if (str1 == str2)
return true;
proc string_equal(String* str1, String* str2) -> bool {
if (str1 == str2)
return true;


return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
}
return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
}


proc get_nibble(char c) -> char {
if (c >= 'A' && c <= 'F')
return (c - 'A') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0');
}
proc get_nibble(char c) -> char {
if (c >= 'A' && c <= 'F')
return (c - 'A') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0');
}


proc escape_string(char* in) -> char* {
// TODO(Felix): add more escape sequences
int i = 0, count = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\':
case '\n':
case '\t':
++count;
default: break;
proc escape_string(char* in) -> char* {
// TODO(Felix): add more escape sequences
int i = 0, count = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\':
case '\n':
case '\t':
++count;
default: break;
}
++i;
} }
++i;
}


char* ret = (char*)malloc((i+count+1)*sizeof(char));

// copy in
i = 0;
int j = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break;
case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break;
case '\t': ret[j++] = '\\'; ret[j++] = 't'; break;
default: ret[j++] = in[i];
char* ret = (char*)malloc((i+count+1)*sizeof(char));

// copy in
i = 0;
int j = 0;
while (in[i] != '\0') {
switch (in[i]) {
case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break;
case '\n': ret[j++] = '\\'; ret[j++] = 'n'; break;
case '\t': ret[j++] = '\\'; ret[j++] = 't'; break;
default: ret[j++] = in[i];
}
++i;
} }
++i;
ret[j++] = '\0';
return ret;
} }
ret[j++] = '\0';
return ret;
}


proc unescape_string(char* in) -> int {
if (!in) return 0;
proc unescape_string(char* in) -> int {
if (!in) return 0;


char *out = in, *p = in;
const char *int_err = nullptr;
char *out = in, *p = in;
const char *int_err = nullptr;


while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++;
} else {
/* escape sequence */
switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
case 'r': *out++ = '\r'; ++p; break;
case 't': *out++ = '\t'; ++p; break;
case 'v': *out++ = '\v'; ++p; break;
case '"':
case '\'':
case '\\':
while (*p && !int_err) {
if (*p != '\\') {
/* normal case */
*out++ = *p++; *out++ = *p++;
case '?':
break;
case 'x':
case 'X':
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
} else {
/* escape sequence */
switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++p; break;
case 'n': *out++ = '\n'; ++p; break;
case 'r': *out++ = '\r'; ++p; break;
case 't': *out++ = '\t'; ++p; break;
case 'v': *out++ = '\v'; ++p; break;
case '"':
case '\'':
case '\\':
*out++ = *p++;
case '?':
break;
case 'x':
case 'X':
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Invalid character on hexadecimal escape at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} else {
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
p += 3;
}
break;
default:
create_parsing_error( create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. " "The string '%s' at %s:%d:%d could not be unescaped. "
"(Invalid character on hexadecimal escape at char %d)",
"(Unexpected '\\' with no escape sequence at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col, in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in); (p+1)-in);
} else {
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
p += 3;
} }
break;
default:
create_parsing_error(
"The string '%s' at %s:%d:%d could not be unescaped. "
"(Unexpected '\\' with no escape sequence at char %d)",
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
(p+1)-in);
} }
} }
}


/* Set the end of string. */
*out = '\0';
return (int)(out - in);
}
/* Set the end of string. */
*out = '\0';
return (int)(out - in);
}


proc read_entire_file(char* filename) -> char* {
profile_with_comment(filename);
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp) + 1;
if (bufsize == 0) {
fputs("Empty file", stderr);
goto closeFile;
}
proc read_entire_file(char* filename) -> char* {
profile_with_comment(filename);
char *fileContent = nullptr;
FILE *fp = fopen(filename, "r");
if (fp) {
/* Go to the end of the file. */
if (fseek(fp, 0L, SEEK_END) == 0) {
/* Get the size of the file. */
long bufsize = ftell(fp) + 1;
if (bufsize == 0) {
fputs("Empty file", stderr);
goto closeFile;
}


/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}
/* Go back to the start of the file. */
if (fseek(fp, 0L, SEEK_SET) != 0) {
fputs("Error reading file", stderr);
goto closeFile;
}


/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));
/* Allocate our buffer to that size. */
fileContent = (char*)calloc(bufsize, sizeof(char));


/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);
/* Read the entire file into memory. */
size_t newLen = fread(fileContent, sizeof(char), bufsize, fp);


fileContent[newLen] = '\0';
if (ferror(fp) != 0) {
fputs("Error reading file", stderr);
fileContent[newLen] = '\0';
if (ferror(fp) != 0) {
fputs("Error reading file", stderr);
}
} }
closeFile:
fclose(fp);
} }
closeFile:
fclose(fp);
}


return fileContent;
/* Don't forget to call free() later! */
}
return fileContent;
/* Don't forget to call free() later! */
}


proc read_expression() -> char* {
char* line = (char*)malloc(100);
proc read_expression() -> char* {
char* line = (char*)malloc(100);


if(line == nullptr)
return nullptr;
if(line == nullptr)
return nullptr;


char* linep = line;
size_t lenmax = 100, len = lenmax;
int c;
char* linep = line;
size_t lenmax = 100, len = lenmax;
int c;


int nesting = 0;
int nesting = 0;


while (true) {
c = fgetc(stdin);
if(c == EOF)
break;
while (true) {
c = fgetc(stdin);
if(c == EOF)
break;


if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);
if(--len == 0) {
len = lenmax;
char * linen = (char*)realloc(linep, lenmax *= 2);


if(linen == nullptr) {
free(linep);
return nullptr;
if(linen == nullptr) {
free(linep);
return nullptr;
}
line = linen + (line - linep);
linep = linen;
} }
line = linen + (line - linep);
linep = linen;

*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
} }
(*line)--; // we dont want the \n actually
*line = '\0';


*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
return linep;
} }
(*line)--; // we dont want the \n actually
*line = '\0';


return linep;
}
proc read_line() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;


proc read_line() -> char* {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;
int nesting = 0;


int nesting = 0;
if(line == nullptr)
return nullptr;


if(line == nullptr)
return nullptr;

for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;
for(;;) {
c = fgetc(stdin);
if(c == EOF)
break;


if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);
if(--len == 0) {
len = lenmax;
char* linen = (char*)realloc(linep, lenmax *= 2);


if(linen == nullptr) {
free(linep);
return nullptr;
if(linen == nullptr) {
free(linep);
return nullptr;
}
line = linen + (line - linep);
linep = linen;
} }
line = linen + (line - linep);
linep = linen;

*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
} }
(*line)--; // we dont want the \n actually
*line = '\0';


*line = (char)c;
if(*line == '(')
++nesting;
else if(*line == ')')
--nesting;
else if(*line == '\n')
if (nesting == 0)
break;
line++;
return linep;
} }
(*line)--; // we dont want the \n actually
*line = '\0';


return linep;
}

proc log_message(Log_Level type, const char* message) -> void {
if (type > Globals::log_level)
return;

const char* prefix;
switch (type) {
case Log_Level::Critical: prefix = "CRITICAL"; break;
case Log_Level::Warning: prefix = "WARNING"; break;
case Log_Level::Info: prefix = "INFO"; break;
case Log_Level::Debug: prefix = "DEBUG"; break;
default: return;
proc log_message(Log_Level type, const char* message) -> void {
if (type > Globals::log_level)
return;

const char* prefix;
switch (type) {
case Log_Level::Critical: prefix = "CRITICAL"; break;
case Log_Level::Warning: prefix = "WARNING"; break;
case Log_Level::Info: prefix = "INFO"; break;
case Log_Level::Debug: prefix = "DEBUG"; break;
default: return;
}
printf("%s: %s\n",prefix, message);
} }
printf("%s: %s\n",prefix, message);
}


char* wchar_to_char(const wchar_t* pwchar) {
// get the number of characters in the string.
int currentCharIndex = 0;
char currentChar = (char)pwchar[currentCharIndex];
char* wchar_to_char(const wchar_t* pwchar) {
// get the number of characters in the string.
int currentCharIndex = 0;
char currentChar = (char)pwchar[currentCharIndex];


while (currentChar != '\0')
{
currentCharIndex++;
currentChar = (char)pwchar[currentCharIndex];
}
while (currentChar != '\0')
{
currentCharIndex++;
currentChar = (char)pwchar[currentCharIndex];
}


const int charCount = currentCharIndex + 1;
const int charCount = currentCharIndex + 1;


// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
char* filePathC = (char*)malloc(sizeof(char) * charCount);
// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
char* filePathC = (char*)malloc(sizeof(char) * charCount);


for (int i = 0; i < charCount; i++)
{
// convert to char (1 byte)
char character = (char)pwchar[i];
for (int i = 0; i < charCount; i++)
{
// convert to char (1 byte)
char character = (char)pwchar[i];


*filePathC = character;
*filePathC = character;


filePathC += sizeof(char);
filePathC += sizeof(char);


}
filePathC += '\0';
}
filePathC += '\0';


filePathC -= (sizeof(char) * charCount);
filePathC -= (sizeof(char) * charCount);


return filePathC;
}
return filePathC;
}


const wchar_t* char_to_wchar(const char* c) {
const size_t cSize = strlen(c)+1;
wchar_t* wc = new wchar_t[cSize];
mbstowcs (wc, c, cSize);
const wchar_t* char_to_wchar(const char* c) {
const size_t cSize = strlen(c)+1;
wchar_t* wc = new wchar_t[cSize];
mbstowcs (wc, c, cSize);


return wc;
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
switch (Memory::get_type(node)) {
case (Lisp_Object_Type::Nil): fputs("()", file); break;
case (Lisp_Object_Type::T): fputs("t", file); break;
case (Lisp_Object_Type::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f)
fprintf(file, "%d", (int)node->value.number);
else
fprintf(file, "%f", node->value.number);
} break;
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) {
fputs(" ", file);
print(key, true, file);
fputs(" -> ", file);
print((Lisp_Object*)value, true, file);
fputs("\n", file);
}
} break;
case (Lisp_Object_Type::String): {
if (print_repr) {
putc('\"', file);
char* escaped = escape_string(Memory::get_c_str(node->value.string));
fputs(escaped, file);
putc('\"', file);
free(escaped);
}
else
fputs(Memory::get_c_str(node->value.string), file);
} break;
case (Lisp_Object_Type::Vector): {
fputs("[", file);
if (node->value.vector.length > 0)
print(node->value.vector.data, print_repr, file);
for (int i = 1; i < node->value.vector.length; ++i) {
fputs(" ", file);
print(node->value.vector.data+i, print_repr, file);
}
fputs("]", file);
} break;
case (Lisp_Object_Type::Function): {
if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break;
}
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function->type == Function_Type::Special_Lambda)
// fputs("[special-lambda]", file);
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;

// first check if it is a quotation form, in that case we want
// to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol;


auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_symbol("quote");
auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{
if (symbol == quote_sym)
putc('\'', file);
else if (symbol == unquote_sym)
putc(',', file);
else if (symbol == unquote_splicing_sym)
fputs(",@", file);

assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert(head->value.pair.rest->value.pair.rest == Memory::nil);

print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
return wc;
}
proc print(Lisp_Object* node, bool print_repr, FILE* file) -> void {
switch (Memory::get_type(node)) {
case (Lisp_Object_Type::Nil): fputs("()", file); break;
case (Lisp_Object_Type::T): fputs("t", file); break;
case (Lisp_Object_Type::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f)
fprintf(file, "%d", (int)node->value.number);
else
fprintf(file, "%f", node->value.number);
} break;
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) {
fputs(" ", file);
print(key, true, file);
fputs(" -> ", file);
print((Lisp_Object*)value, true, file);
fputs("\n", file);
} }
else if (symbol == quasiquote_sym) {
putc('`', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file);
} break;
case (Lisp_Object_Type::String): {
if (print_repr) {
putc('\"', file);
char* escaped = escape_string(Memory::get_c_str(node->value.string));
fputs(escaped, file);
putc('\"', file);
free(escaped);
}
else
fputs(Memory::get_c_str(node->value.string), file);
} break;
case (Lisp_Object_Type::Vector): {
fputs("[", file);
if (node->value.vector.length > 0)
print(node->value.vector.data, print_repr, file);
for (int i = 1; i < node->value.vector.length; ++i) {
fputs(" ", file);
print(node->value.vector.data+i, print_repr, file);
}
fputs("]", file);
} break;
case (Lisp_Object_Type::Function): {
if (node->userType) {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break; break;
} }
}
if (node->value.function->type == Function_Type::Lambda)
fputs("[lambda]", file);
// else if (node->value.function->type == Function_Type::Special_Lambda)
// fputs("[special-lambda]", file);
else if (node->value.function->type == Function_Type::Macro)
fputs("[macro]", file);
else
assert(false);
} break;
case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node;

// first check if it is a quotation form, in that case we want
// to print it prettier
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
String* identifier = head->value.pair.first->value.symbol;


auto symbol = head->value.pair.first;
auto quote_sym = Memory::get_symbol("quote");
auto unquote_sym = Memory::get_symbol("unquote");
auto quasiquote_sym = Memory::get_symbol("quasiquote");
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{
if (symbol == quote_sym)
putc('\'', file);
else if (symbol == unquote_sym)
putc(',', file);
else if (symbol == unquote_splicing_sym)
fputs(",@", file);

assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert(head->value.pair.rest->value.pair.rest == Memory::nil);

print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
else if (symbol == quasiquote_sym) {
putc('`', file);
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
print(head->value.pair.rest->value.pair.first, print_repr, file);
break;
}
}


putc('(', file);

// NOTE(Felix): We could do a while true here, however in case
// we want to print a broken list (for logging the error) we
// should do more checks.
while (head) {
print(head->value.pair.first, print_repr, file);
head = head->value.pair.rest;
if (!head)
return;
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
break;
putc(' ', file);
}
putc('(', file);
// NOTE(Felix): We could do a while true here, however in case
// we want to print a broken list (for logging the error) we
// should do more checks.
while (head) {
print(head->value.pair.first, print_repr, file);
head = head->value.pair.rest;
if (!head)
return;
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
break;
putc(' ', file);
}


if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head, print_repr, file);
}
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
fputs(" . ", file);
print(head, print_repr, file);
}


putc(')', file);
} break;
putc(')', file);
} break;
}
} }
}


proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj, true);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
printf("%s (line %d, position %d)",
Memory::get_c_str(
obj->sourceCodeLocation->file),
obj->sourceCodeLocation->line,
obj->sourceCodeLocation->column);
} else {
fputs("no source code location avaliable", stdout);
proc print_single_call(Lisp_Object* obj) -> void {
printf(console_cyan);
print(obj, true);
printf(console_normal);
printf("\n at ");
if (obj->sourceCodeLocation) {
printf("%s (line %d, position %d)",
Memory::get_c_str(
obj->sourceCodeLocation->file),
obj->sourceCodeLocation->line,
obj->sourceCodeLocation->column);
} else {
fputs("no source code location avaliable", stdout);
}
} }
}


proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack;
proc print_call_stack() -> void {
using Globals::Current_Execution::call_stack;


printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
for (int i = 0; i < call_stack.next_index; ++i) {
printf("%2d -> ", i);
print_single_call(call_stack.data[i]);
printf("\n");
printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
for (int i = 0; i < call_stack.next_index; ++i) {
printf("%2d -> ", i);
print_single_call(call_stack.data[i]);
printf("\n");
}
} }
}


proc log_error() -> void {
fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal);
proc log_error() -> void {
fputs(console_red, stdout);
fputs(Memory::get_c_str(Globals::error->message), stdout);
puts(console_normal);


fputs(" in: ", stdout);
print_call_stack();
puts(console_normal);
fputs(" in: ", stdout);
print_call_stack();
puts(console_normal);
}
} }

+ 3
- 4
src/libslime.cpp Wyświetl plik

@@ -39,14 +39,14 @@ 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"


namespace Slime {
# 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"
}


bool hm_objects_match(char* a, char* b) { bool hm_objects_match(char* a, char* b) {
return strcmp(a, b) == 0; return strcmp(a, b) == 0;
@@ -107,7 +107,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) {
} }
} }


namespace Slime {
# include "globals.cpp" # include "globals.cpp"
# include "memory.cpp" # include "memory.cpp"
# include "gc.cpp" # include "gc.cpp"
@@ -122,4 +121,4 @@ namespace Slime {
# include "built_ins.cpp" # include "built_ins.cpp"
# include "testing.cpp" # include "testing.cpp"
// # include "undefines.cpp" // # include "undefines.cpp"
}

+ 48
- 46
src/lisp_object.cpp Wyświetl plik

@@ -1,53 +1,55 @@
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
if (!file)
return nullptr;
namespace Slime {
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
if (!file)
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;
}
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::CFunction): return "C-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";
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::CFunction): return "C-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";
} }
return "unknown";
}


Lisp_Object::~Lisp_Object() {
free(sourceCodeLocation);
sourceCodeLocation = 0;
Lisp_Object::~Lisp_Object() {
free(sourceCodeLocation);
sourceCodeLocation = 0;


switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.cFunction->args.keyword.values.~Array_List();
delete this->value.cFunction;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.~Array_List();
this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
switch (Memory::get_type(this)) {
case Lisp_Object_Type::HashMap: {
delete this->value.hashMap;
} break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.~Array_List();
this->value.cFunction->args.keyword.keywords.~Array_List();
this->value.cFunction->args.keyword.values.~Array_List();
delete this->value.cFunction;
} break;
case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.~Array_List();
this->value.function->args.keyword.keywords.~Array_List();
this->value.function->args.keyword.values.~Array_List();
delete this->value.function;
} break;
default: break;
}
} }
} }

+ 1
- 1
src/memory.cpp Wyświetl plik

@@ -1,4 +1,4 @@
namespace Memory {
namespace Slime::Memory {


// ------------------ // ------------------
// global symbol / keyword table // global symbol / keyword table


+ 1
- 1
src/parse.cpp Wyświetl plik

@@ -1,4 +1,4 @@
namespace Parser {
namespace Slime::Parser {
String* standard_in; String* standard_in;
String* parser_file; String* parser_file;
int parser_line; int parser_line;


+ 129
- 126
src/platform.cpp Wyświetl plik

@@ -1,167 +1,170 @@
inline proc get_cwd() -> char* {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char));
namespace Slime {

inline proc get_cwd() -> char* {
const int buf_size = 2048;
char* res = (char*)malloc(buf_size * sizeof(char));


#ifdef _MSC_VER #ifdef _MSC_VER
_getcwd(res, buf_size);
_getcwd(res, buf_size);
#else #else
getcwd(res, buf_size);
getcwd(res, buf_size);
#endif #endif


return res;
}
return res;
}


inline proc change_cwd(char* dir) -> void {
inline proc change_cwd(char* dir) -> void {
#ifdef _MSC_VER #ifdef _MSC_VER
_chdir(dir);
_chdir(dir);
#else #else
chdir(dir);
chdir(dir);
#endif #endif
}
}




#ifdef _MSC_VER #ifdef _MSC_VER
int vasprintf(char **strp, const char *fmt, va_list ap) {
// _vscprintf tells you how big the buffer needs to be
int len = _vscprintf(fmt, ap);
if (len == -1) {
return -1;
}
size_t size = (size_t)len + 1;
char *str = (char*)malloc(size);
if (!str) {
return -1;
}
// _vsprintf_s is the "secure" version of vsprintf
int r = vsprintf_s(str, len + 1, fmt, ap);
if (r == -1) {
free(str);
return -1;
int vasprintf(char **strp, const char *fmt, va_list ap) {
// _vscprintf tells you how big the buffer needs to be
int len = _vscprintf(fmt, ap);
if (len == -1) {
return -1;
}
size_t size = (size_t)len + 1;
char *str = (char*)malloc(size);
if (!str) {
return -1;
}
// _vsprintf_s is the "secure" version of vsprintf
int r = vsprintf_s(str, len + 1, fmt, ap);
if (r == -1) {
free(str);
return -1;
}
*strp = str;
return r;
} }
*strp = str;
return r;
}


int asprintf(char **strp, const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
int r = vasprintf(strp, fmt, ap);
va_end(ap);
return r;
}
int asprintf(char **strp, const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
int r = vasprintf(strp, fmt, ap);
va_end(ap);
return r;
}
#endif #endif


proc get_exe_dir() -> char* {
proc get_exe_dir() -> char* {
#ifdef _MSC_VER #ifdef _MSC_VER
DWORD last_error;
DWORD result;
DWORD path_size = 1024;
char* path = (char*)malloc(1024);

while (true) {
memset(path, 0, path_size);
result = GetModuleFileName(0, path, path_size - 1);
last_error = GetLastError();

if (0 == result) {
free(path);
path = 0;
break;
}
else if (result == path_size - 1) {
free(path);
/* May need to also check for ERROR_SUCCESS here if XP/2K */
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
DWORD last_error;
DWORD result;
DWORD path_size = 1024;
char* path = (char*)malloc(1024);

while (true) {
memset(path, 0, path_size);
result = GetModuleFileName(0, path, path_size - 1);
last_error = GetLastError();

if (0 == result) {
free(path);
path = 0; path = 0;
break; break;
} }
path_size = path_size * 2;
path = (char*)malloc(path_size);
else if (result == path_size - 1) {
free(path);
/* May need to also check for ERROR_SUCCESS here if XP/2K */
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
path = 0;
break;
}
path_size = path_size * 2;
path = (char*)malloc(path_size);
}
else
break;
} }
else
break;
}


if (!path) {
fprintf(stderr, "Failure: %ld\n", last_error);
return nullptr;
}
else {
// remove the exe name, so we are only left with the path
if (!path) {
fprintf(stderr, "Failure: %ld\n", last_error);
return nullptr;
}
else {
// remove the exe name, so we are only left with the path


int index_in_path = -1;
int last_backslash = -1;
int index_in_path = -1;
int last_backslash = -1;


char c;
while ((c = path[++index_in_path]) != '\0') {
if (c == '\\')
last_backslash = index_in_path;
}
char c;
while ((c = path[++index_in_path]) != '\0') {
if (c == '\\')
last_backslash = index_in_path;
}


// we are assuming there are some backslashes
path[last_backslash+1] = '\0';
// we are assuming there are some backslashes
path[last_backslash+1] = '\0';


return path;
}
return path;
}
#else #else
ssize_t size = 512, i, n;
char *path, *temp;
ssize_t size = 512, i, n;
char *path, *temp;


while (1) {
size_t used;
while (1) {
size_t used;


path = (char*)malloc(size);
if (!path) {
errno = ENOMEM;
return NULL;
}
path = (char*)malloc(size);
if (!path) {
errno = ENOMEM;
return NULL;
}


used = readlink("/proc/self/exe", path, size);
used = readlink("/proc/self/exe", path, size);


if (used == -1) {
const int saved_errno = errno;
free(path);
errno = saved_errno;
return NULL;
} else
if (used < 1) {
if (used == -1) {
const int saved_errno = errno;
free(path); free(path);
errno = EIO;
errno = saved_errno;
return NULL; return NULL;
} else
if (used < 1) {
free(path);
errno = EIO;
return NULL;
}

if ((size_t)used >= size) {
free(path);
size = (size | 2047) + 2049;
continue;
} }


if ((size_t)used >= size) {
free(path);
size = (size | 2047) + 2049;
continue;
size = (size_t)used;
break;
} }


size = (size_t)used;
break;
}

/* Find final slash. */
n = 0;
for (i = 0; i < size; i++)
if (path[i] == '/')
n = i;

/* Optimize allocated size,
ensuring there is room for
a final slash and a
string-terminating '\0', */
temp = path;
path = (char*)realloc(temp, n + 2);
if (!path) {
free(temp);
errno = ENOMEM;
return NULL;
}
/* Find final slash. */
n = 0;
for (i = 0; i < size; i++)
if (path[i] == '/')
n = i;

/* Optimize allocated size,
ensuring there is room for
a final slash and a
string-terminating '\0', */
temp = path;
path = (char*)realloc(temp, n + 2);
if (!path) {
free(temp);
errno = ENOMEM;
return NULL;
}


/* and properly trim and terminate the path string. */
path[n+0] = '/';
path[n+1] = '\0';
/* and properly trim and terminate the path string. */
path[n+0] = '/';
path[n+1] = '\0';


return path;
return path;
#endif #endif
}
} }

+ 144
- 142
src/structs.cpp Wyświetl plik

@@ -1,142 +1,144 @@
struct Lisp_Object;
struct String;
struct Environment;

enum struct Thread_Type {
Main,
GarbageCollection
};

enum struct Lisp_Object_Type {
Nil,
T,
Symbol,
Keyword,
Number,
String,
Pair,
Vector,
Continuation,
Pointer,
HashMap,
// OwningPointer,
Function,
CFunction,
};

enum class Lisp_Object_Flags
{
// bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};

enum struct Function_Type {
Lambda,
Macro
};

enum struct Log_Level {
None,
Critical,
Warning,
Info,
Debug,
};

struct Continuation {
Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
};

struct String {
int length;
char data;
};

struct Source_Code_Location {
String* file;
int line;
int column;
};

struct Pair {
Lisp_Object* first;
Lisp_Object* rest;
};

struct Vector {
int length;
Lisp_Object* data;
};

struct Positional_Arguments {
Array_List<Lisp_Object*> symbols;
};

struct Keyword_Arguments {
// Array of Pointers to Lisp_Object<Keyword>
Array_List<Lisp_Object*> keywords;
// NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i]
Array_List<Lisp_Object*> values;
};

struct Arguments {
Positional_Arguments positional;
Keyword_Arguments keyword;
// NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol
Lisp_Object* rest;
};

struct Environment {
Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm;

~Environment() {
parents.~Array_List();
hm.~Hash_Map();
}
};

struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};

struct cFunction {
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
};

struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
u64 flags;
Lisp_Object* userType; // keyword
String* docstring;
union value {
String* symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
Vector vector;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
~Lisp_Object();
};

struct Error {
Lisp_Object* position;
// type has to be a keyword
Lisp_Object* type;
String* message;
};
namespace Slime {
struct Lisp_Object;
struct String;
struct Environment;

enum struct Thread_Type {
Main,
GarbageCollection
};

enum struct Lisp_Object_Type {
Nil,
T,
Symbol,
Keyword,
Number,
String,
Pair,
Vector,
Continuation,
Pointer,
HashMap,
// OwningPointer,
Function,
CFunction,
};

enum class Lisp_Object_Flags
{
// bits 1 to 5 (including) will be reserved for the type
Already_Garbage_Collected = 1 << 5,
Under_Construction = 1 << 6,
};

enum struct Function_Type {
Lambda,
Macro
};

enum struct Log_Level {
None,
Critical,
Warning,
Info,
Debug,
};

struct Continuation {
Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack;
};

struct String {
int length;
char data;
};

struct Source_Code_Location {
String* file;
int line;
int column;
};

struct Pair {
Lisp_Object* first;
Lisp_Object* rest;
};

struct Vector {
int length;
Lisp_Object* data;
};

struct Positional_Arguments {
Array_List<Lisp_Object*> symbols;
};

struct Keyword_Arguments {
// Array of Pointers to Lisp_Object<Keyword>
Array_List<Lisp_Object*> keywords;
// NOTE(Felix): values[i] will be nullptr if no defalut value was
// declared for key identifiers[i]
Array_List<Lisp_Object*> values;
};

struct Arguments {
Positional_Arguments positional;
Keyword_Arguments keyword;
// NOTE(Felix): rest_argument will be nullptr if no rest argument
// is declared otherwise its a symbol
Lisp_Object* rest;
};

struct Environment {
Array_List<Environment*> parents;
Hash_Map<void*, Lisp_Object*> hm;

~Environment() {
parents.~Array_List();
hm.~Hash_Map();
}
};

struct Function {
Function_Type type;
Arguments args;
Lisp_Object* body; // maybe implicit begin
Environment* parent_environment; // we are doing closures now!!
};

struct cFunction {
Lisp_Object* (*body)();
Arguments args;
bool is_special_form;
};

struct Lisp_Object {
Source_Code_Location* sourceCodeLocation;
u64 flags;
Lisp_Object* userType; // keyword
String* docstring;
union value {
String* symbol; // used for symbols and keywords
double number;
String* string;
Pair pair;
Vector vector;
Function* function;
cFunction* cFunction;
void* pointer;
Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
~value() {}
} value;
~Lisp_Object();
};

struct Error {
Lisp_Object* position;
// type has to be a keyword
Lisp_Object* type;
String* message;
};
}

+ 475
- 469
src/testing.cpp
Plik diff jest za duży
Wyświetl plik


+ 511
- 509
src/visualization.cpp
Plik diff jest za duży
Wyświetl plik


Napisz Podgląd
Ładowanie…
Anuluj
Zapisz