fixed import bug
This commit is contained in:
@@ -1,3 +1,3 @@
|
|||||||
(define a 10)
|
(define a 1111)
|
||||||
|
|
||||||
(define (get-a-1) a)
|
(define (get-a-1) a)
|
||||||
|
|||||||
@@ -1,27 +1,20 @@
|
|||||||
(import "tests/import1.slime")
|
(import "tests/import1.slime")
|
||||||
|
|
||||||
(print)
|
(assert (= a 1111))
|
||||||
(print ">" a)
|
(assert (= (get-a-1) 1111))
|
||||||
(assert (= a 10))
|
|
||||||
(print ">" (get-a-1))
|
|
||||||
(assert (= (get-a-1) 10))
|
|
||||||
|
|
||||||
|
|
||||||
(import "tests/import2.slime")
|
(import "tests/import2.slime")
|
||||||
|
|
||||||
(print ">" a)
|
|
||||||
(assert (= a 10))
|
(assert (= a 1111))
|
||||||
(print ">" (get-a-1))
|
(assert (= (get-a-1) 1111))
|
||||||
(assert (= (get-a-1) 10))
|
(assert (= (get-a-2) 1111))
|
||||||
(print ">" (get-a-2))
|
|
||||||
(assert (= (get-a-2) 10))
|
|
||||||
|
|
||||||
(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))
|
||||||
|
|||||||
+1092
-1092
File diff suppressed because it is too large
Load Diff
+128
-126
@@ -1,144 +1,146 @@
|
|||||||
proc generate_docs(String* path) -> void {
|
namespace Slime {
|
||||||
FILE *f = fopen(Memory::get_c_str(path), "w");
|
proc generate_docs(String* path) -> void {
|
||||||
if (!f) {
|
FILE *f = fopen(Memory::get_c_str(path), "w");
|
||||||
create_generic_error("The file for writing the documentation (%s) "
|
if (!f) {
|
||||||
"could not be opened for writing.", Memory::get_c_str(path));
|
create_generic_error("The file for writing the documentation (%s) "
|
||||||
return;
|
"could not be opened for writing.", Memory::get_c_str(path));
|
||||||
}
|
return;
|
||||||
defer {
|
|
||||||
fclose(f);
|
|
||||||
};
|
|
||||||
|
|
||||||
Array_List<Environment*> visited;
|
|
||||||
|
|
||||||
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
|
|
||||||
bool we_already_printed = false;
|
|
||||||
// TODO(Felix): Make a generic array_list_contains function
|
|
||||||
for(auto it : visited) {
|
|
||||||
if (it == env) {
|
|
||||||
we_already_printed = true;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
if (!we_already_printed) {
|
defer {
|
||||||
// printf("Working on env::::");
|
fclose(f);
|
||||||
// print_environment(env);
|
};
|
||||||
// printf("\n--------------------------------\n");
|
|
||||||
visited.append(env);
|
|
||||||
|
|
||||||
push_environment(env);
|
Array_List<Environment*> visited;
|
||||||
defer {
|
|
||||||
pop_environment();
|
|
||||||
};
|
|
||||||
|
|
||||||
for_hash_map(env->hm) {
|
const auto print_this_env = [&](const auto& rec, Environment* env, char* prefix) -> void {
|
||||||
try_void fprintf(f,
|
bool we_already_printed = false;
|
||||||
"#+latex: \\hrule\n"
|
// TODO(Felix): Make a generic array_list_contains function
|
||||||
"#+html: <hr/>\n"
|
for(auto it : visited) {
|
||||||
"* =%s%s= \n"
|
if (it == env) {
|
||||||
" :PROPERTIES:\n"
|
we_already_printed = true;
|
||||||
" :UNNUMBERED: t\n"
|
break;
|
||||||
" :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
|
if (!we_already_printed) {
|
||||||
*/
|
// printf("Working on env::::");
|
||||||
Lisp_Object_Type type = Memory::get_type(value);
|
// print_environment(env);
|
||||||
Lisp_Object* LOtype;
|
// printf("\n--------------------------------\n");
|
||||||
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
|
visited.append(env);
|
||||||
try_void LOtype = eval_expr(type_expr);
|
|
||||||
|
|
||||||
fprintf(f, "\n - type :: =");
|
push_environment(env);
|
||||||
print(LOtype, true, f);
|
defer {
|
||||||
fprintf(f, "=");
|
pop_environment();
|
||||||
|
};
|
||||||
|
|
||||||
|
for_hash_map(env->hm) {
|
||||||
|
try_void fprintf(f,
|
||||||
|
"#+latex: \\hrule\n"
|
||||||
|
"#+html: <hr/>\n"
|
||||||
|
"* =%s%s= \n"
|
||||||
|
" :PROPERTIES:\n"
|
||||||
|
" :UNNUMBERED: t\n"
|
||||||
|
" :END:"
|
||||||
|
,prefix, Memory::get_c_str(((Lisp_Object*)key)->value.symbol));
|
||||||
|
/*
|
||||||
|
* sourcecodeLocation
|
||||||
|
*/
|
||||||
|
if (value->sourceCodeLocation) {
|
||||||
|
try_void fprintf(f, "\n - defined in :: =%s:%d:%d=",
|
||||||
|
Memory::get_c_str(value->sourceCodeLocation->file),
|
||||||
|
value->sourceCodeLocation->line,
|
||||||
|
value->sourceCodeLocation->column);
|
||||||
|
}
|
||||||
|
/*
|
||||||
|
* type
|
||||||
|
*/
|
||||||
|
Lisp_Object_Type type = Memory::get_type(value);
|
||||||
|
Lisp_Object* LOtype;
|
||||||
|
Lisp_Object* type_expr = Memory::create_list(Memory::get_symbol("type"), value);
|
||||||
|
try_void LOtype = eval_expr(type_expr);
|
||||||
|
|
||||||
/*
|
fprintf(f, "\n - type :: =");
|
||||||
* if printable value -> print it
|
print(LOtype, true, f);
|
||||||
*/
|
|
||||||
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, "=");
|
fprintf(f, "=");
|
||||||
} break;
|
|
||||||
default: break;
|
|
||||||
}
|
/*
|
||||||
/*
|
* if printable value -> print it
|
||||||
* if function then print arguments
|
*/
|
||||||
*/
|
switch (type) {
|
||||||
if (type == Lisp_Object_Type::Function ||
|
case(Lisp_Object_Type::Nil):
|
||||||
type == Lisp_Object_Type::CFunction)
|
case(Lisp_Object_Type::T):
|
||||||
{
|
case(Lisp_Object_Type::Number):
|
||||||
Arguments* args =
|
case(Lisp_Object_Type::String):
|
||||||
(type == Lisp_Object_Type::Function)
|
case(Lisp_Object_Type::Pair):
|
||||||
? &value->value.function->args
|
case(Lisp_Object_Type::Symbol):
|
||||||
: &value->value.cFunction->args;
|
case(Lisp_Object_Type::Keyword): {
|
||||||
fprintf(f, "\n - arguments :: ");
|
fprintf(f, "\n - value :: =");
|
||||||
// if no args at all
|
print(value, true, f);
|
||||||
if (args->positional.symbols.next_index == 0 &&
|
fprintf(f, "=");
|
||||||
args->keyword.values.next_index == 0 &&
|
} break;
|
||||||
!args->rest)
|
default: break;
|
||||||
|
}
|
||||||
|
/*
|
||||||
|
* if function then print arguments
|
||||||
|
*/
|
||||||
|
if (type == Lisp_Object_Type::Function ||
|
||||||
|
type == Lisp_Object_Type::CFunction)
|
||||||
{
|
{
|
||||||
fprintf(f, "none.");
|
Arguments* args =
|
||||||
} else {
|
(type == Lisp_Object_Type::Function)
|
||||||
if (args->positional.symbols.next_index != 0) {
|
? &value->value.function->args
|
||||||
fprintf(f, "\n - postitional :: ");
|
: &value->value.cFunction->args;
|
||||||
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
|
fprintf(f, "\n - arguments :: ");
|
||||||
for (int i = 1; i < args->positional.symbols.next_index; ++i) {
|
// if no args at all
|
||||||
fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
|
if (args->positional.symbols.next_index == 0 &&
|
||||||
}
|
args->keyword.values.next_index == 0 &&
|
||||||
}
|
!args->rest)
|
||||||
if (args->keyword.values.next_index != 0) {
|
{
|
||||||
fprintf(f, "\n - keyword :: ");
|
fprintf(f, "none.");
|
||||||
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
|
} else {
|
||||||
if (args->keyword.values.data[0]) {
|
if (args->positional.symbols.next_index != 0) {
|
||||||
fprintf(f, " =(");
|
fprintf(f, "\n - postitional :: ");
|
||||||
print(args->keyword.values.data[0], true, f);
|
fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
|
||||||
fprintf(f, ")=");
|
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]) {
|
|
||||||
fprintf(f, " =(");
|
|
||||||
print(args->keyword.values.data[i], true, f);
|
|
||||||
fprintf(f, ")=");
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
if (args->keyword.values.next_index != 0) {
|
||||||
if (args->rest) {
|
fprintf(f, "\n - keyword :: ");
|
||||||
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
|
fprintf(f, "=%s=", Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
|
||||||
|
if (args->keyword.values.data[0]) {
|
||||||
|
fprintf(f, " =(");
|
||||||
|
print(args->keyword.values.data[0], true, f);
|
||||||
|
fprintf(f, ")=");
|
||||||
|
}
|
||||||
|
for (int i = 1; i < args->keyword.values.next_index; ++i) {
|
||||||
|
fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
|
||||||
|
if (args->keyword.values.data[i]) {
|
||||||
|
fprintf(f, " =(");
|
||||||
|
print(args->keyword.values.data[i], true, f);
|
||||||
|
fprintf(f, ")=");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (args->rest) {
|
||||||
|
fprintf(f, "\n - rest :: =%s=", Memory::get_c_str(args->rest->value.symbol));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
fprintf(f, "\n - docu :: ");
|
||||||
|
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) {
|
for (int i = 0; i < env->parents.next_index; ++i) {
|
||||||
try_void rec(rec, env->parents.data[i], prefix);
|
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*)"");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+116
-116
@@ -1,126 +1,126 @@
|
|||||||
namespace Slime {
|
namespace Slime {
|
||||||
|
|
||||||
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
|
proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void {
|
||||||
profile_with_comment(&symbol->value.symbol->data);
|
profile_with_comment(&symbol->value.symbol->data);
|
||||||
Environment* env = get_current_environment();
|
Environment* env = get_current_environment();
|
||||||
env->hm.set_object((void*)symbol, value);
|
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;
|
|
||||||
}
|
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
auto nil_sym = Memory::get_symbol("nil");
|
inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* {
|
||||||
auto t_sym = Memory::get_symbol("t");
|
return (Lisp_Object*)env->hm.get_object((void*)sym);
|
||||||
|
|
||||||
if (node == nil_sym) {
|
|
||||||
return Memory::nil;
|
|
||||||
}
|
|
||||||
if (node == t_sym) {
|
|
||||||
return Memory::t;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return nullptr;
|
proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool {
|
||||||
}
|
return lookup_symbol_in_this_envt(sym, env) != 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("");
|
|
||||||
}
|
}
|
||||||
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 {
|
proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* {
|
||||||
printf("\n=== Environment === (0x%016llx)\n", (long long)env);
|
if (environment_binds_symbol(sym, env))
|
||||||
print_environment_indent(env, 0);
|
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;
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
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("");
|
||||||
|
}
|
||||||
|
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
@@ -1,54 +1,57 @@
|
|||||||
proc delete_error() -> void {
|
namespace Slime {
|
||||||
using Globals::error;
|
|
||||||
|
|
||||||
free(error);
|
proc delete_error() -> void {
|
||||||
error = nullptr;
|
using Globals::error;
|
||||||
}
|
|
||||||
|
|
||||||
proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
|
free(error);
|
||||||
delete_error();
|
error = nullptr;
|
||||||
if (Globals::breaking_on_errors) {
|
|
||||||
debug_break();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
using Globals::error;
|
proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void {
|
||||||
error = (Error*)malloc(sizeof(Error)) ;
|
delete_error();
|
||||||
error->type = type;
|
if (Globals::breaking_on_errors) {
|
||||||
error->message = message;
|
debug_break();
|
||||||
|
}
|
||||||
|
|
||||||
log_error();
|
using Globals::error;
|
||||||
if (Globals::log_level > Log_Level::None) {
|
error = (Error*)malloc(sizeof(Error)) ;
|
||||||
// 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;
|
error->type = type;
|
||||||
}
|
error->message = message;
|
||||||
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;
|
log_error();
|
||||||
strcpy(&formatted_string->data, out_msg);
|
if (Globals::log_level > Log_Level::None) {
|
||||||
free(out_msg);
|
// c error location
|
||||||
create_error(c_func_name, c_file_name, c_file_line, type, formatted_string);
|
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);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+465
-463
@@ -1,116 +1,99 @@
|
|||||||
proc create_extended_environment_for_function_application(
|
namespace Slime {
|
||||||
Lisp_Object* unevaluated_arguments,
|
proc create_extended_environment_for_function_application(
|
||||||
Lisp_Object* function,
|
Lisp_Object* unevaluated_arguments,
|
||||||
bool should_evaluate) -> Environment*
|
Lisp_Object* function,
|
||||||
{
|
bool should_evaluate) -> Environment*
|
||||||
profile_this();
|
{
|
||||||
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
|
profile_this();
|
||||||
Environment* new_env;
|
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
|
||||||
Lisp_Object* arguments = unevaluated_arguments;
|
Environment* new_env;
|
||||||
Arguments* arg_spec;
|
Lisp_Object* arguments = unevaluated_arguments;
|
||||||
|
Arguments* arg_spec;
|
||||||
|
|
||||||
// NOTE(Felix): Step 1.
|
// NOTE(Felix): Step 1.
|
||||||
// - setting the parent environment
|
// - setting the parent environment
|
||||||
// - setting the arg_spec
|
// - setting the arg_spec
|
||||||
// - potentially evaluating the arguments
|
// - potentially evaluating the arguments
|
||||||
if (is_c_function) {
|
if (is_c_function) {
|
||||||
new_env = Memory::create_child_environment(get_root_environment());
|
new_env = Memory::create_child_environment(get_root_environment());
|
||||||
arg_spec = &function->value.cFunction->args;
|
arg_spec = &function->value.cFunction->args;
|
||||||
} else {
|
} else {
|
||||||
new_env = Memory::create_child_environment(function->value.function->parent_environment);
|
new_env = Memory::create_child_environment(function->value.function->parent_environment);
|
||||||
arg_spec = &function->value.function->args;
|
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();
|
|
||||||
};
|
|
||||||
|
|
||||||
|
|
||||||
// NOTE(Felix): Step 2.
|
|
||||||
// Reading the argument spec and fill in the environment
|
|
||||||
// for the function call
|
|
||||||
|
|
||||||
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));
|
|
||||||
}
|
|
||||||
|
|
||||||
arguments = arguments->value.pair.rest;
|
|
||||||
}
|
}
|
||||||
};
|
if (should_evaluate) {
|
||||||
|
try arguments = eval_arguments(arguments);
|
||||||
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;
|
|
||||||
|
|
||||||
// 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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// 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();
|
||||||
|
};
|
||||||
|
|
||||||
while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
|
|
||||||
// check if this one is even an accepted keyword
|
// NOTE(Felix): Step 2.
|
||||||
bool accepted = false;
|
// Reading the argument spec and fill in the environment
|
||||||
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
|
// for the function call
|
||||||
if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i])
|
|
||||||
{
|
Lisp_Object* sym, *val; // used as temp storage to use `try`
|
||||||
accepted = true;
|
Array_List<Lisp_Object*> read_in_keywords;
|
||||||
break;
|
int obligatory_keywords_count = 0;
|
||||||
}
|
int read_obligatory_keywords_count = 0;
|
||||||
}
|
|
||||||
if (!accepted) {
|
proc read_positional_args = [&]() -> void {
|
||||||
// NOTE(Felix): if we are actually done with all the
|
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
|
||||||
// necessary keywords then we have to count the rest
|
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
|
||||||
// as :rest here, instead od always creating an error
|
create_parsing_error("Wrong number of arguments.");
|
||||||
// (special case with default variables)
|
|
||||||
if (read_obligatory_keywords_count == obligatory_keywords_count)
|
|
||||||
return;
|
return;
|
||||||
create_generic_error(
|
}
|
||||||
"The function does not take the keyword argument ':%s'\n"
|
// NOTE(Felix): We have to copy all the arguments,
|
||||||
"and not all required keyword arguments have been read\n"
|
// otherwise we change the program code. XXX(Felix): T C
|
||||||
"in to potentially count it as the rest argument.",
|
// functions we pass by reference...
|
||||||
&(arguments->value.pair.first->value.symbol->data));
|
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));
|
||||||
|
}
|
||||||
|
|
||||||
|
arguments = arguments->value.pair.rest;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
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;
|
return;
|
||||||
|
|
||||||
|
// 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;
|
||||||
}
|
}
|
||||||
|
|
||||||
// check if it was already read in
|
|
||||||
for (int i = 0; i < read_in_keywords.next_index; ++i) {
|
while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
|
||||||
if (arguments->value.pair.first == read_in_keywords.data[i])
|
// 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
|
// check if it was already read in
|
||||||
// not already read in, is there a next element to actually
|
for (int i = 0; i < read_in_keywords.next_index; ++i) {
|
||||||
// set it to?
|
if (arguments->value.pair.first == read_in_keywords.data[i])
|
||||||
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
|
{
|
||||||
create_generic_error(
|
// NOTE(Felix): if we are actually done with all the
|
||||||
"Attempting to set the keyword argument ':%s', but no value was supplied.",
|
// necessary keywords then we have to count the rest
|
||||||
&(arguments->value.pair.first->value.symbol->data));
|
// as :rest here, instead od always creating an error
|
||||||
return;
|
// (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
|
// okay so we found a keyword that has to be read in and was
|
||||||
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
|
// not already read in, is there a next element to actually
|
||||||
// NOTE(Felix): It seems we do not need to evaluate the argument here...
|
// set it to?
|
||||||
if (is_c_function) {
|
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
|
||||||
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first);
|
create_generic_error(
|
||||||
} else {
|
"Attempting to set the keyword argument ':%s', but no value was supplied.",
|
||||||
try_void define_symbol(
|
&(arguments->value.pair.first->value.symbol->data));
|
||||||
sym,
|
return;
|
||||||
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
|
}
|
||||||
}
|
|
||||||
|
|
||||||
read_in_keywords.append(arguments->value.pair.first);
|
// if not set it and then add it to the array list
|
||||||
++read_obligatory_keywords_count;
|
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
|
read_in_keywords.append(arguments->value.pair.first);
|
||||||
arguments = arguments->value.pair.rest->value.pair.rest;
|
++read_obligatory_keywords_count;
|
||||||
|
|
||||||
if (arguments == Memory::nil) {
|
// overstep both for next one
|
||||||
break;
|
arguments = arguments->value.pair.rest->value.pair.rest;
|
||||||
}
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
proc check_keyword_args = [&]() -> void {
|
if (arguments == Memory::nil) {
|
||||||
// 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;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (arg_spec->keyword.values.data[i] == nullptr) {
|
};
|
||||||
// if this one does not have a default value
|
|
||||||
if (!was_set) {
|
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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
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);
|
||||||
|
} else {
|
||||||
|
// rest was not declared but additional arguments were found
|
||||||
create_generic_error(
|
create_generic_error(
|
||||||
"There was no value supplied for the required "
|
"A rest argument was not declared "
|
||||||
"keyword argument ':%s'.",
|
"but the function was called with additional arguments.");
|
||||||
&defined_keyword->value.symbol->data);
|
|
||||||
return;
|
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);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
};
|
||||||
};
|
|
||||||
|
|
||||||
proc read_rest_arg = [&]() -> void {
|
try read_positional_args();
|
||||||
if (arguments == Memory::nil) {
|
try read_keyword_args();
|
||||||
if (arg_spec->rest) {
|
try check_keyword_args();
|
||||||
define_symbol(arg_spec->rest, Memory::nil);
|
try read_rest_arg();
|
||||||
}
|
|
||||||
} 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);
|
|
||||||
} 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();
|
return new_env;
|
||||||
try read_keyword_args();
|
}
|
||||||
try check_keyword_args();
|
|
||||||
try read_rest_arg();
|
|
||||||
|
|
||||||
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* {
|
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
|
||||||
profile_this();
|
push_environment(new_env);
|
||||||
Environment* new_env;
|
defer {
|
||||||
Lisp_Object* result;
|
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 (Memory::get_type(function) == Lisp_Object_Type::CFunction)
|
||||||
// if c function:
|
// if c function:
|
||||||
try result = function->value.cFunction->body();
|
try result = function->value.cFunction->body();
|
||||||
else
|
else
|
||||||
// if lisp function
|
// if lisp function
|
||||||
try result = eval_expr(function->value.function->body);
|
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 {
|
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
|
||||||
Arguments* result;
|
Arguments* result;
|
||||||
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
|
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
|
||||||
result = &function->value.cFunction->args;
|
result = &function->value.cFunction->args;
|
||||||
} else {
|
|
||||||
result = &function->value.function->args;
|
|
||||||
}
|
|
||||||
|
|
||||||
// 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) {
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
// okay we found an actual symbol
|
|
||||||
result->positional.symbols.append(arguments->value.pair.first);
|
|
||||||
|
|
||||||
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.");
|
|
||||||
}
|
|
||||||
|
|
||||||
result->keyword.keywords.append(keyword);
|
|
||||||
result->keyword.values.append(value);
|
|
||||||
}
|
|
||||||
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;
|
|
||||||
|
|
||||||
assert_type(node, Lisp_Object_Type::Pair);
|
|
||||||
|
|
||||||
int len = 0;
|
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
Lisp_Object* evaluated_arguments;
|
|
||||||
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
|
|
||||||
|
|
||||||
Lisp_Object* evaluated_arguments_head = evaluated_arguments;
|
|
||||||
Lisp_Object* current_head = arguments;
|
|
||||||
|
|
||||||
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
|
|
||||||
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
|
|
||||||
|
|
||||||
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 {
|
} else {
|
||||||
create_parsing_error("Attempting to evaluate ill formed argument list.");
|
result = &function->value.function->args;
|
||||||
|
}
|
||||||
|
|
||||||
|
// 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) {
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
// okay we found an actual symbol
|
||||||
|
result->positional.symbols.append(arguments->value.pair.first);
|
||||||
|
|
||||||
|
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.");
|
||||||
|
}
|
||||||
|
|
||||||
|
result->keyword.keywords.append(keyword);
|
||||||
|
result->keyword.values.append(value);
|
||||||
|
}
|
||||||
|
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;
|
||||||
|
|
||||||
|
assert_type(node, Lisp_Object_Type::Pair);
|
||||||
|
|
||||||
|
int len = 0;
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
Lisp_Object* evaluated_arguments;
|
||||||
|
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
|
||||||
|
|
||||||
|
Lisp_Object* evaluated_arguments_head = evaluated_arguments;
|
||||||
|
Lisp_Object* current_head = arguments;
|
||||||
|
|
||||||
|
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
|
||||||
|
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
// *(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;
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
return nullptr;
|
||||||
}
|
}
|
||||||
// ++my_out_arguments_length;
|
default: {
|
||||||
}
|
create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
|
||||||
// *(out_arguments_length) = my_out_arguments_length;
|
return nullptr;
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
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
|
proc is_truthy(Lisp_Object* expression) -> bool {
|
||||||
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
|
Lisp_Object* result;
|
||||||
// only for lambdas we evaluate the arguments before
|
try result = eval_expr(expression);
|
||||||
// apllying, for the other types, special-lambda and macro
|
|
||||||
// we do not need.
|
|
||||||
|
|
||||||
Lisp_Object* result;
|
return result != Memory::nil;
|
||||||
try result = apply_arguments_to_function(
|
}
|
||||||
arguments,
|
|
||||||
lispOperator,
|
|
||||||
lispOperator->value.function->type == Function_Type::Lambda);
|
|
||||||
|
|
||||||
// NOTE(Felix): The parser does not understnad (import ..)
|
proc interprete_file (char* file_name) -> Lisp_Object* {
|
||||||
// so it cannot expand imported macros at read time
|
try Memory::init(4096 * 256);
|
||||||
// (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;
|
Lisp_Object* result;
|
||||||
|
|
||||||
|
try result = built_in_load(Memory::create_string(file_name));
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
}();
|
||||||
}
|
}
|
||||||
|
|
||||||
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);
|
|
||||||
|
|
||||||
return result != Memory::nil;
|
|
||||||
}
|
|
||||||
|
|
||||||
proc interprete_file (char* file_name) -> Lisp_Object* {
|
|
||||||
try Memory::init(4096 * 256);
|
|
||||||
|
|
||||||
Lisp_Object* result;
|
|
||||||
|
|
||||||
try result = built_in_load(Memory::create_string(file_name));
|
|
||||||
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
}();
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+77
-75
@@ -1,83 +1,85 @@
|
|||||||
void add_to_load_path(const char*);
|
namespace Slime {
|
||||||
bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
|
void add_to_load_path(const char*);
|
||||||
Lisp_Object* built_in_load(String*);
|
bool lisp_object_equal(Lisp_Object*,Lisp_Object*);
|
||||||
Lisp_Object* built_in_import(String*);
|
Lisp_Object* built_in_load(String*);
|
||||||
void delete_error();
|
Lisp_Object* built_in_import(String*);
|
||||||
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
|
void delete_error();
|
||||||
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
|
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...);
|
||||||
void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line);
|
void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message);
|
||||||
Lisp_Object* eval_arguments(Lisp_Object*);
|
void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line);
|
||||||
Lisp_Object* eval_expr(Lisp_Object*);
|
Lisp_Object* eval_arguments(Lisp_Object*);
|
||||||
bool is_truthy (Lisp_Object*);
|
Lisp_Object* eval_expr(Lisp_Object*);
|
||||||
int list_length(Lisp_Object*);
|
bool is_truthy (Lisp_Object*);
|
||||||
void* load_built_ins_into_environment();
|
int list_length(Lisp_Object*);
|
||||||
void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function);
|
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*);
|
Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*);
|
||||||
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
|
void define_symbol(Lisp_Object* symbol, Lisp_Object* value);
|
||||||
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
|
void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout);
|
||||||
void print_environment(Environment*);
|
void print_environment(Environment*);
|
||||||
|
|
||||||
bool run_all_tests();
|
bool run_all_tests();
|
||||||
|
|
||||||
inline Environment* get_root_environment();
|
inline Environment* get_root_environment();
|
||||||
inline Environment* get_current_environment();
|
inline Environment* get_current_environment();
|
||||||
inline void push_environment(Environment*);
|
inline void push_environment(Environment*);
|
||||||
inline void pop_environment();
|
inline void pop_environment();
|
||||||
|
|
||||||
const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
|
const char* Lisp_Object_Type_to_string(Lisp_Object_Type type);
|
||||||
|
|
||||||
void visualize_lisp_machine();
|
void visualize_lisp_machine();
|
||||||
void generate_docs(String* path);
|
void generate_docs(String* path);
|
||||||
void log_error();
|
void log_error();
|
||||||
|
|
||||||
namespace Memory {
|
namespace Memory {
|
||||||
Environment* create_built_ins_environment();
|
Environment* create_built_ins_environment();
|
||||||
Lisp_Object* create_lisp_object_cfunction(bool is_special);
|
Lisp_Object* create_lisp_object_cfunction(bool is_special);
|
||||||
inline Lisp_Object_Type get_type(Lisp_Object* node);
|
inline Lisp_Object_Type get_type(Lisp_Object* node);
|
||||||
void init(int);
|
void init(int);
|
||||||
char* get_c_str(String*);
|
char* get_c_str(String*);
|
||||||
void free_everything();
|
void free_everything();
|
||||||
String* create_string(const char*);
|
String* create_string(const char*);
|
||||||
Lisp_Object* get_symbol(String* identifier);
|
Lisp_Object* get_symbol(String* identifier);
|
||||||
Lisp_Object* get_symbol(const char*);
|
Lisp_Object* get_symbol(const char*);
|
||||||
Lisp_Object* get_keyword(String* identifier);
|
Lisp_Object* get_keyword(String* identifier);
|
||||||
Lisp_Object* get_keyword(const char*);
|
Lisp_Object* get_keyword(const char*);
|
||||||
Lisp_Object* create_lisp_object(double);
|
Lisp_Object* create_lisp_object(double);
|
||||||
Lisp_Object* create_lisp_object(const char*);
|
Lisp_Object* create_lisp_object(const char*);
|
||||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
|
Lisp_Object* create_lisp_object_vector(Lisp_Object*);
|
||||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
|
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*);
|
||||||
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
|
Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*);
|
||||||
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
|
Lisp_Object* create_lisp_object_vector(int, Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||||
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*);
|
||||||
}
|
}
|
||||||
|
|
||||||
namespace Parser {
|
namespace Parser {
|
||||||
// extern Environment* environment_for_macros;
|
// extern Environment* environment_for_macros;
|
||||||
|
|
||||||
extern String* standard_in;
|
extern String* standard_in;
|
||||||
extern String* parser_file;
|
extern String* parser_file;
|
||||||
extern int parser_line;
|
extern int parser_line;
|
||||||
extern int parser_col;
|
extern int parser_col;
|
||||||
|
|
||||||
Lisp_Object* parse_expression(char* text, int* index_in_text);
|
Lisp_Object* parse_expression(char* text, int* index_in_text);
|
||||||
Lisp_Object* parse_single_expression(char* text);
|
Lisp_Object* parse_single_expression(char* text);
|
||||||
Lisp_Object* parse_single_expression(wchar_t* text);
|
Lisp_Object* parse_single_expression(wchar_t* text);
|
||||||
}
|
}
|
||||||
|
|
||||||
namespace Globals {
|
namespace Globals {
|
||||||
extern char* bin_path;
|
extern char* bin_path;
|
||||||
extern Log_Level log_level;
|
extern Log_Level log_level;
|
||||||
extern Array_List<void*> load_path;
|
extern Array_List<void*> load_path;
|
||||||
namespace Current_Execution {
|
namespace Current_Execution {
|
||||||
extern Array_List<Lisp_Object*> call_stack;
|
extern Array_List<Lisp_Object*> call_stack;
|
||||||
extern Array_List<Environment*> envi_stack;
|
extern Array_List<Environment*> envi_stack;
|
||||||
|
}
|
||||||
|
extern Error* error;
|
||||||
|
extern bool breaking_on_errors;
|
||||||
}
|
}
|
||||||
extern Error* error;
|
|
||||||
extern bool breaking_on_errors;
|
|
||||||
}
|
}
|
||||||
|
|||||||
+1
-1
@@ -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
@@ -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;
|
||||||
|
|
||||||
|
|||||||
+418
-416
@@ -1,460 +1,462 @@
|
|||||||
proc string_equal(const char input[], const char check[]) -> bool {
|
namespace Slime {
|
||||||
if (input == check) return true;
|
proc string_equal(const char input[], const char check[]) -> bool {
|
||||||
|
if (input == check) return true;
|
||||||
|
|
||||||
for(int i = 0; input[i] == check[i]; i++) {
|
for(int i = 0; input[i] == check[i]; i++) {
|
||||||
if (input[i] == '\0')
|
if (input[i] == '\0')
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
|
||||||
|
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(String* str1, String* str2) -> bool {
|
||||||
|
if (str1 == str2)
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
|
return string_equal(Memory::get_c_str(str1), Memory::get_c_str(str2));
|
||||||
}
|
}
|
||||||
|
|
||||||
return false;
|
proc get_nibble(char c) -> char {
|
||||||
}
|
if (c >= 'A' && c <= 'F')
|
||||||
|
return (c - 'A') + 10;
|
||||||
proc string_equal(String* str, const char check[]) -> bool {
|
else if (c >= 'a' && c <= 'f')
|
||||||
return string_equal(Memory::get_c_str(str), check);
|
return (c - 'a') + 10;
|
||||||
}
|
return (c - '0');
|
||||||
|
|
||||||
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;
|
|
||||||
|
|
||||||
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 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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
char* ret = (char*)malloc((i+count+1)*sizeof(char));
|
proc escape_string(char* in) -> char* {
|
||||||
|
// TODO(Felix): add more escape sequences
|
||||||
// copy in
|
int i = 0, count = 0;
|
||||||
i = 0;
|
while (in[i] != '\0') {
|
||||||
int j = 0;
|
switch (in[i]) {
|
||||||
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;
|
|
||||||
}
|
|
||||||
ret[j++] = '\0';
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
proc unescape_string(char* in) -> int {
|
|
||||||
if (!in) return 0;
|
|
||||||
|
|
||||||
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 '\\':
|
case '\\':
|
||||||
|
case '\n':
|
||||||
|
case '\t':
|
||||||
|
++count;
|
||||||
|
default: break;
|
||||||
|
}
|
||||||
|
++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;
|
||||||
|
}
|
||||||
|
ret[j++] = '\0';
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
proc unescape_string(char* in) -> int {
|
||||||
|
if (!in) return 0;
|
||||||
|
|
||||||
|
char *out = in, *p = in;
|
||||||
|
const char *int_err = nullptr;
|
||||||
|
|
||||||
|
while (*p && !int_err) {
|
||||||
|
if (*p != '\\') {
|
||||||
|
/* normal case */
|
||||||
*out++ = *p++;
|
*out++ = *p++;
|
||||||
case '?':
|
} else {
|
||||||
break;
|
/* escape sequence */
|
||||||
case 'x':
|
switch (*++p) {
|
||||||
case 'X':
|
case '0': *out++ = '\a'; ++p; break;
|
||||||
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
|
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;
|
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* 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));
|
||||||
|
|
||||||
|
/* 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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
closeFile:
|
||||||
|
fclose(fp);
|
||||||
|
}
|
||||||
|
|
||||||
|
return fileContent;
|
||||||
|
/* Don't forget to call free() later! */
|
||||||
|
}
|
||||||
|
|
||||||
|
proc read_expression() -> char* {
|
||||||
|
char* line = (char*)malloc(100);
|
||||||
|
|
||||||
|
if(line == nullptr)
|
||||||
|
return nullptr;
|
||||||
|
|
||||||
|
char* linep = line;
|
||||||
|
size_t lenmax = 100, len = lenmax;
|
||||||
|
int c;
|
||||||
|
|
||||||
|
int nesting = 0;
|
||||||
|
|
||||||
|
while (true) {
|
||||||
|
c = fgetc(stdin);
|
||||||
|
if(c == EOF)
|
||||||
break;
|
break;
|
||||||
default:
|
|
||||||
create_parsing_error(
|
if(--len == 0) {
|
||||||
"The string '%s' at %s:%d:%d could not be unescaped. "
|
len = lenmax;
|
||||||
"(Unexpected '\\' with no escape sequence at char %d)",
|
char * linen = (char*)realloc(linep, lenmax *= 2);
|
||||||
in, Parser::parser_file, Parser::parser_line, Parser::parser_col,
|
|
||||||
(p+1)-in);
|
if(linen == nullptr) {
|
||||||
|
free(linep);
|
||||||
|
return nullptr;
|
||||||
|
}
|
||||||
|
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';
|
||||||
|
|
||||||
|
return linep;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Set the end of string. */
|
proc read_line() -> char* {
|
||||||
*out = '\0';
|
char* line = (char*)malloc(100), * linep = line;
|
||||||
return (int)(out - in);
|
size_t lenmax = 100, len = lenmax;
|
||||||
}
|
int c;
|
||||||
|
|
||||||
proc read_entire_file(char* filename) -> char* {
|
int nesting = 0;
|
||||||
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(line == nullptr)
|
||||||
if (fseek(fp, 0L, SEEK_SET) != 0) {
|
return nullptr;
|
||||||
fputs("Error reading file", stderr);
|
|
||||||
goto closeFile;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Allocate our buffer to that size. */
|
for(;;) {
|
||||||
fileContent = (char*)calloc(bufsize, sizeof(char));
|
c = fgetc(stdin);
|
||||||
|
if(c == EOF)
|
||||||
/* 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);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
closeFile:
|
|
||||||
fclose(fp);
|
|
||||||
}
|
|
||||||
|
|
||||||
return fileContent;
|
|
||||||
/* Don't forget to call free() later! */
|
|
||||||
}
|
|
||||||
|
|
||||||
proc read_expression() -> char* {
|
|
||||||
char* line = (char*)malloc(100);
|
|
||||||
|
|
||||||
if(line == nullptr)
|
|
||||||
return nullptr;
|
|
||||||
|
|
||||||
char* linep = line;
|
|
||||||
size_t lenmax = 100, len = lenmax;
|
|
||||||
int c;
|
|
||||||
|
|
||||||
int nesting = 0;
|
|
||||||
|
|
||||||
while (true) {
|
|
||||||
c = fgetc(stdin);
|
|
||||||
if(c == EOF)
|
|
||||||
break;
|
|
||||||
|
|
||||||
if(--len == 0) {
|
|
||||||
len = lenmax;
|
|
||||||
char * linen = (char*)realloc(linep, lenmax *= 2);
|
|
||||||
|
|
||||||
if(linen == nullptr) {
|
|
||||||
free(linep);
|
|
||||||
return nullptr;
|
|
||||||
}
|
|
||||||
line = linen + (line - linep);
|
|
||||||
linep = linen;
|
|
||||||
}
|
|
||||||
|
|
||||||
*line = (char)c;
|
|
||||||
if(*line == '(')
|
|
||||||
++nesting;
|
|
||||||
else if(*line == ')')
|
|
||||||
--nesting;
|
|
||||||
else if(*line == '\n')
|
|
||||||
if (nesting == 0)
|
|
||||||
break;
|
break;
|
||||||
line++;
|
|
||||||
}
|
|
||||||
(*line)--; // we dont want the \n actually
|
|
||||||
*line = '\0';
|
|
||||||
|
|
||||||
return linep;
|
if(--len == 0) {
|
||||||
}
|
len = lenmax;
|
||||||
|
char* linen = (char*)realloc(linep, lenmax *= 2);
|
||||||
|
|
||||||
proc read_line() -> char* {
|
if(linen == nullptr) {
|
||||||
char* line = (char*)malloc(100), * linep = line;
|
free(linep);
|
||||||
size_t lenmax = 100, len = lenmax;
|
return nullptr;
|
||||||
int c;
|
}
|
||||||
|
line = linen + (line - linep);
|
||||||
int nesting = 0;
|
linep = linen;
|
||||||
|
|
||||||
if(line == nullptr)
|
|
||||||
return nullptr;
|
|
||||||
|
|
||||||
for(;;) {
|
|
||||||
c = fgetc(stdin);
|
|
||||||
if(c == EOF)
|
|
||||||
break;
|
|
||||||
|
|
||||||
if(--len == 0) {
|
|
||||||
len = lenmax;
|
|
||||||
char* linen = (char*)realloc(linep, lenmax *= 2);
|
|
||||||
|
|
||||||
if(linen == nullptr) {
|
|
||||||
free(linep);
|
|
||||||
return nullptr;
|
|
||||||
}
|
}
|
||||||
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';
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
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];
|
||||||
|
|
||||||
|
while (currentChar != '\0')
|
||||||
|
{
|
||||||
|
currentCharIndex++;
|
||||||
|
currentChar = (char)pwchar[currentCharIndex];
|
||||||
}
|
}
|
||||||
|
|
||||||
*line = (char)c;
|
const int charCount = currentCharIndex + 1;
|
||||||
if(*line == '(')
|
|
||||||
++nesting;
|
// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
|
||||||
else if(*line == ')')
|
char* filePathC = (char*)malloc(sizeof(char) * charCount);
|
||||||
--nesting;
|
|
||||||
else if(*line == '\n')
|
for (int i = 0; i < charCount; i++)
|
||||||
if (nesting == 0)
|
{
|
||||||
|
// convert to char (1 byte)
|
||||||
|
char character = (char)pwchar[i];
|
||||||
|
|
||||||
|
*filePathC = character;
|
||||||
|
|
||||||
|
filePathC += sizeof(char);
|
||||||
|
|
||||||
|
}
|
||||||
|
filePathC += '\0';
|
||||||
|
|
||||||
|
filePathC -= (sizeof(char) * charCount);
|
||||||
|
|
||||||
|
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);
|
||||||
|
|
||||||
|
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;
|
break;
|
||||||
line++;
|
}
|
||||||
}
|
if (node->value.function->type == Function_Type::Lambda)
|
||||||
(*line)--; // we dont want the \n actually
|
fputs("[lambda]", file);
|
||||||
*line = '\0';
|
// else if (node->value.function->type == Function_Type::Special_Lambda)
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
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];
|
|
||||||
|
|
||||||
while (currentChar != '\0')
|
|
||||||
{
|
|
||||||
currentCharIndex++;
|
|
||||||
currentChar = (char)pwchar[currentCharIndex];
|
|
||||||
}
|
|
||||||
|
|
||||||
const int charCount = currentCharIndex + 1;
|
|
||||||
|
|
||||||
// allocate a new block of memory size char (1 byte) instead of wide char (2 bytes)
|
|
||||||
char* filePathC = (char*)malloc(sizeof(char) * charCount);
|
|
||||||
|
|
||||||
for (int i = 0; i < charCount; i++)
|
|
||||||
{
|
|
||||||
// convert to char (1 byte)
|
|
||||||
char character = (char)pwchar[i];
|
|
||||||
|
|
||||||
*filePathC = character;
|
|
||||||
|
|
||||||
filePathC += sizeof(char);
|
|
||||||
|
|
||||||
}
|
|
||||||
filePathC += '\0';
|
|
||||||
|
|
||||||
filePathC -= (sizeof(char) * charCount);
|
|
||||||
|
|
||||||
return filePathC;
|
|
||||||
}
|
|
||||||
|
|
||||||
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);
|
// fputs("[special-lambda]", file);
|
||||||
else if (node->value.function->type == Function_Type::Macro)
|
else if (node->value.function->type == Function_Type::Macro)
|
||||||
fputs("[macro]", file);
|
fputs("[macro]", file);
|
||||||
else
|
else
|
||||||
assert(false);
|
assert(false);
|
||||||
} break;
|
} break;
|
||||||
case (Lisp_Object_Type::Pair): {
|
case (Lisp_Object_Type::Pair): {
|
||||||
Lisp_Object* head = node;
|
Lisp_Object* head = node;
|
||||||
|
|
||||||
// first check if it is a quotation form, in that case we want
|
// first check if it is a quotation form, in that case we want
|
||||||
// to print it prettier
|
// to print it prettier
|
||||||
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
|
if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Symbol) {
|
||||||
String* identifier = head->value.pair.first->value.symbol;
|
String* identifier = head->value.pair.first->value.symbol;
|
||||||
|
|
||||||
|
|
||||||
auto symbol = head->value.pair.first;
|
auto symbol = head->value.pair.first;
|
||||||
auto quote_sym = Memory::get_symbol("quote");
|
auto quote_sym = Memory::get_symbol("quote");
|
||||||
auto unquote_sym = Memory::get_symbol("unquote");
|
auto unquote_sym = Memory::get_symbol("unquote");
|
||||||
auto quasiquote_sym = Memory::get_symbol("quasiquote");
|
auto quasiquote_sym = Memory::get_symbol("quasiquote");
|
||||||
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
|
auto unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
|
||||||
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
|
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
|
||||||
{
|
{
|
||||||
if (symbol == quote_sym)
|
if (symbol == quote_sym)
|
||||||
putc('\'', file);
|
putc('\'', file);
|
||||||
else if (symbol == unquote_sym)
|
else if (symbol == unquote_sym)
|
||||||
putc(',', file);
|
putc(',', file);
|
||||||
else if (symbol == unquote_splicing_sym)
|
else if (symbol == unquote_splicing_sym)
|
||||||
fputs(",@", file);
|
fputs(",@", file);
|
||||||
|
|
||||||
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
|
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
|
||||||
assert(head->value.pair.rest->value.pair.rest == Memory::nil);
|
assert(head->value.pair.rest->value.pair.rest == Memory::nil);
|
||||||
|
|
||||||
print(head->value.pair.rest->value.pair.first, print_repr, file);
|
print(head->value.pair.rest->value.pair.first, print_repr, file);
|
||||||
break;
|
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;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
else if (symbol == quasiquote_sym) {
|
|
||||||
putc('`', file);
|
putc('(', file);
|
||||||
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
|
|
||||||
print(head->value.pair.rest->value.pair.first, print_repr, file);
|
// NOTE(Felix): We could do a while true here, however in case
|
||||||
break;
|
// 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);
|
||||||
|
}
|
||||||
|
|
||||||
|
putc(')', file);
|
||||||
|
} break;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
putc('(', file);
|
proc print_single_call(Lisp_Object* obj) -> void {
|
||||||
|
printf(console_cyan);
|
||||||
// NOTE(Felix): We could do a while true here, however in case
|
print(obj, true);
|
||||||
// we want to print a broken list (for logging the error) we
|
printf(console_normal);
|
||||||
// should do more checks.
|
printf("\n at ");
|
||||||
while (head) {
|
if (obj->sourceCodeLocation) {
|
||||||
print(head->value.pair.first, print_repr, file);
|
printf("%s (line %d, position %d)",
|
||||||
head = head->value.pair.rest;
|
Memory::get_c_str(
|
||||||
if (!head)
|
obj->sourceCodeLocation->file),
|
||||||
return;
|
obj->sourceCodeLocation->line,
|
||||||
if (Memory::get_type(head) != Lisp_Object_Type::Pair)
|
obj->sourceCodeLocation->column);
|
||||||
break;
|
} else {
|
||||||
putc(' ', file);
|
fputs("no source code location avaliable", stdout);
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
if (Memory::get_type(head) != Lisp_Object_Type::Nil) {
|
proc print_call_stack() -> void {
|
||||||
fputs(" . ", file);
|
using Globals::Current_Execution::call_stack;
|
||||||
print(head, print_repr, file);
|
|
||||||
|
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");
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
putc(')', file);
|
proc log_error() -> void {
|
||||||
} break;
|
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);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
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;
|
|
||||||
|
|
||||||
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);
|
|
||||||
|
|
||||||
fputs(" in: ", stdout);
|
|
||||||
print_call_stack();
|
|
||||||
puts(console_normal);
|
|
||||||
}
|
|
||||||
|
|||||||
+3
-4
@@ -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"
|
||||||
}
|
|
||||||
|
|||||||
+49
-47
@@ -1,53 +1,55 @@
|
|||||||
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
|
namespace Slime {
|
||||||
if (!file)
|
proc create_source_code_location(String* file, int line, int col) -> Source_Code_Location* {
|
||||||
return nullptr;
|
if (!file)
|
||||||
|
return nullptr;
|
||||||
|
|
||||||
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
|
Source_Code_Location* ret = (Source_Code_Location*)malloc(sizeof(Source_Code_Location));
|
||||||
ret->file = file;
|
ret->file = file;
|
||||||
ret->line = line;
|
ret->line = line;
|
||||||
ret->column = col;
|
ret->column = col;
|
||||||
return ret;
|
return ret;
|
||||||
}
|
|
||||||
|
|
||||||
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
|
|
||||||
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";
|
|
||||||
}
|
|
||||||
|
|
||||||
Lisp_Object::~Lisp_Object() {
|
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
|
||||||
free(sourceCodeLocation);
|
switch (type) {
|
||||||
sourceCodeLocation = 0;
|
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";
|
||||||
|
}
|
||||||
|
|
||||||
switch (Memory::get_type(this)) {
|
Lisp_Object::~Lisp_Object() {
|
||||||
case Lisp_Object_Type::HashMap: {
|
free(sourceCodeLocation);
|
||||||
delete this->value.hashMap;
|
sourceCodeLocation = 0;
|
||||||
} break;
|
|
||||||
case Lisp_Object_Type::CFunction: {
|
switch (Memory::get_type(this)) {
|
||||||
this->value.cFunction->args.positional.symbols.~Array_List();
|
case Lisp_Object_Type::HashMap: {
|
||||||
this->value.cFunction->args.keyword.keywords.~Array_List();
|
delete this->value.hashMap;
|
||||||
this->value.cFunction->args.keyword.values.~Array_List();
|
} break;
|
||||||
delete this->value.cFunction;
|
case Lisp_Object_Type::CFunction: {
|
||||||
} break;
|
this->value.cFunction->args.positional.symbols.~Array_List();
|
||||||
case Lisp_Object_Type::Function:{
|
this->value.cFunction->args.keyword.keywords.~Array_List();
|
||||||
this->value.function->args.positional.symbols.~Array_List();
|
this->value.cFunction->args.keyword.values.~Array_List();
|
||||||
this->value.function->args.keyword.keywords.~Array_List();
|
delete this->value.cFunction;
|
||||||
this->value.function->args.keyword.values.~Array_List();
|
} break;
|
||||||
delete this->value.function;
|
case Lisp_Object_Type::Function:{
|
||||||
} break;
|
this->value.function->args.positional.symbols.~Array_List();
|
||||||
default: break;
|
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
@@ -1,4 +1,4 @@
|
|||||||
namespace Memory {
|
namespace Slime::Memory {
|
||||||
|
|
||||||
// ------------------
|
// ------------------
|
||||||
// global symbol / keyword table
|
// global symbol / keyword table
|
||||||
|
|||||||
+1
-1
@@ -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;
|
||||||
|
|||||||
+144
-141
@@ -1,167 +1,170 @@
|
|||||||
inline proc get_cwd() -> char* {
|
namespace Slime {
|
||||||
const int buf_size = 2048;
|
|
||||||
char* res = (char*)malloc(buf_size * sizeof(char));
|
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) {
|
int vasprintf(char **strp, const char *fmt, va_list ap) {
|
||||||
// _vscprintf tells you how big the buffer needs to be
|
// _vscprintf tells you how big the buffer needs to be
|
||||||
int len = _vscprintf(fmt, ap);
|
int len = _vscprintf(fmt, ap);
|
||||||
if (len == -1) {
|
if (len == -1) {
|
||||||
return -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;
|
|
||||||
}
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
proc get_exe_dir() -> char* {
|
|
||||||
#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) {
|
size_t size = (size_t)len + 1;
|
||||||
free(path);
|
char *str = (char*)malloc(size);
|
||||||
/* May need to also check for ERROR_SUCCESS here if XP/2K */
|
if (!str) {
|
||||||
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
proc get_exe_dir() -> char* {
|
||||||
|
#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;
|
path = 0;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
path_size = path_size * 2;
|
else if (result == path_size - 1) {
|
||||||
path = (char*)malloc(path_size);
|
free(path);
|
||||||
}
|
/* May need to also check for ERROR_SUCCESS here if XP/2K */
|
||||||
else
|
if (ERROR_INSUFFICIENT_BUFFER != last_error) {
|
||||||
break;
|
path = 0;
|
||||||
}
|
break;
|
||||||
|
}
|
||||||
if (!path) {
|
path_size = path_size * 2;
|
||||||
fprintf(stderr, "Failure: %ld\n", last_error);
|
path = (char*)malloc(path_size);
|
||||||
return nullptr;
|
}
|
||||||
}
|
else
|
||||||
else {
|
break;
|
||||||
// remove the exe name, so we are only left with the path
|
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// we are assuming there are some backslashes
|
|
||||||
path[last_backslash+1] = '\0';
|
|
||||||
|
|
||||||
return path;
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
ssize_t size = 512, i, n;
|
|
||||||
char *path, *temp;
|
|
||||||
|
|
||||||
while (1) {
|
|
||||||
size_t used;
|
|
||||||
|
|
||||||
path = (char*)malloc(size);
|
|
||||||
if (!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;
|
||||||
|
|
||||||
|
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';
|
||||||
|
|
||||||
|
return path;
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
ssize_t size = 512, i, n;
|
||||||
|
char *path, *temp;
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
size_t used;
|
||||||
|
|
||||||
|
path = (char*)malloc(size);
|
||||||
|
if (!path) {
|
||||||
|
errno = ENOMEM;
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
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) {
|
||||||
|
free(path);
|
||||||
|
errno = EIO;
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ((size_t)used >= size) {
|
||||||
|
free(path);
|
||||||
|
size = (size | 2047) + 2049;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
errno = ENOMEM;
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
used = readlink("/proc/self/exe", path, size);
|
/* and properly trim and terminate the path string. */
|
||||||
|
path[n+0] = '/';
|
||||||
|
path[n+1] = '\0';
|
||||||
|
|
||||||
if (used == -1) {
|
return path;
|
||||||
const int saved_errno = errno;
|
|
||||||
free(path);
|
|
||||||
errno = saved_errno;
|
|
||||||
return NULL;
|
|
||||||
} else
|
|
||||||
if (used < 1) {
|
|
||||||
free(path);
|
|
||||||
errno = EIO;
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ((size_t)used >= size) {
|
|
||||||
free(path);
|
|
||||||
size = (size | 2047) + 2049;
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* and properly trim and terminate the path string. */
|
|
||||||
path[n+0] = '/';
|
|
||||||
path[n+1] = '\0';
|
|
||||||
|
|
||||||
return path;
|
|
||||||
#endif
|
#endif
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+125
-123
@@ -1,142 +1,144 @@
|
|||||||
struct Lisp_Object;
|
namespace Slime {
|
||||||
struct String;
|
struct Lisp_Object;
|
||||||
struct Environment;
|
struct String;
|
||||||
|
struct Environment;
|
||||||
|
|
||||||
enum struct Thread_Type {
|
enum struct Thread_Type {
|
||||||
Main,
|
Main,
|
||||||
GarbageCollection
|
GarbageCollection
|
||||||
};
|
};
|
||||||
|
|
||||||
enum struct Lisp_Object_Type {
|
enum struct Lisp_Object_Type {
|
||||||
Nil,
|
Nil,
|
||||||
T,
|
T,
|
||||||
Symbol,
|
Symbol,
|
||||||
Keyword,
|
Keyword,
|
||||||
Number,
|
Number,
|
||||||
String,
|
String,
|
||||||
Pair,
|
Pair,
|
||||||
Vector,
|
Vector,
|
||||||
Continuation,
|
Continuation,
|
||||||
Pointer,
|
Pointer,
|
||||||
HashMap,
|
HashMap,
|
||||||
// OwningPointer,
|
// OwningPointer,
|
||||||
Function,
|
Function,
|
||||||
CFunction,
|
CFunction,
|
||||||
};
|
};
|
||||||
|
|
||||||
enum class Lisp_Object_Flags
|
enum class Lisp_Object_Flags
|
||||||
{
|
{
|
||||||
// bits 1 to 5 (including) will be reserved for the type
|
// bits 1 to 5 (including) will be reserved for the type
|
||||||
Already_Garbage_Collected = 1 << 5,
|
Already_Garbage_Collected = 1 << 5,
|
||||||
Under_Construction = 1 << 6,
|
Under_Construction = 1 << 6,
|
||||||
};
|
};
|
||||||
|
|
||||||
enum struct Function_Type {
|
enum struct Function_Type {
|
||||||
Lambda,
|
Lambda,
|
||||||
Macro
|
Macro
|
||||||
};
|
};
|
||||||
|
|
||||||
enum struct Log_Level {
|
enum struct Log_Level {
|
||||||
None,
|
None,
|
||||||
Critical,
|
Critical,
|
||||||
Warning,
|
Warning,
|
||||||
Info,
|
Info,
|
||||||
Debug,
|
Debug,
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Continuation {
|
struct Continuation {
|
||||||
Array_List<Lisp_Object*> call_stack;
|
Array_List<Lisp_Object*> call_stack;
|
||||||
Array_List<Environment*> envi_stack;
|
Array_List<Environment*> envi_stack;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct String {
|
struct String {
|
||||||
int length;
|
int length;
|
||||||
char data;
|
char data;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Source_Code_Location {
|
struct Source_Code_Location {
|
||||||
String* file;
|
String* file;
|
||||||
int line;
|
int line;
|
||||||
int column;
|
int column;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Pair {
|
struct Pair {
|
||||||
Lisp_Object* first;
|
Lisp_Object* first;
|
||||||
Lisp_Object* rest;
|
Lisp_Object* rest;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Vector {
|
struct Vector {
|
||||||
int length;
|
int length;
|
||||||
Lisp_Object* data;
|
Lisp_Object* data;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Positional_Arguments {
|
struct Positional_Arguments {
|
||||||
Array_List<Lisp_Object*> symbols;
|
Array_List<Lisp_Object*> symbols;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Keyword_Arguments {
|
struct Keyword_Arguments {
|
||||||
// Array of Pointers to Lisp_Object<Keyword>
|
// Array of Pointers to Lisp_Object<Keyword>
|
||||||
Array_List<Lisp_Object*> keywords;
|
Array_List<Lisp_Object*> keywords;
|
||||||
// NOTE(Felix): values[i] will be nullptr if no defalut value was
|
// NOTE(Felix): values[i] will be nullptr if no defalut value was
|
||||||
// declared for key identifiers[i]
|
// declared for key identifiers[i]
|
||||||
Array_List<Lisp_Object*> values;
|
Array_List<Lisp_Object*> values;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Arguments {
|
struct Arguments {
|
||||||
Positional_Arguments positional;
|
Positional_Arguments positional;
|
||||||
Keyword_Arguments keyword;
|
Keyword_Arguments keyword;
|
||||||
// NOTE(Felix): rest_argument will be nullptr if no rest argument
|
// NOTE(Felix): rest_argument will be nullptr if no rest argument
|
||||||
// is declared otherwise its a symbol
|
// is declared otherwise its a symbol
|
||||||
Lisp_Object* rest;
|
Lisp_Object* rest;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Environment {
|
struct Environment {
|
||||||
Array_List<Environment*> parents;
|
Array_List<Environment*> parents;
|
||||||
Hash_Map<void*, Lisp_Object*> hm;
|
Hash_Map<void*, Lisp_Object*> hm;
|
||||||
|
|
||||||
~Environment() {
|
~Environment() {
|
||||||
parents.~Array_List();
|
parents.~Array_List();
|
||||||
hm.~Hash_Map();
|
hm.~Hash_Map();
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Function {
|
struct Function {
|
||||||
Function_Type type;
|
Function_Type type;
|
||||||
Arguments args;
|
Arguments args;
|
||||||
Lisp_Object* body; // maybe implicit begin
|
Lisp_Object* body; // maybe implicit begin
|
||||||
Environment* parent_environment; // we are doing closures now!!
|
Environment* parent_environment; // we are doing closures now!!
|
||||||
};
|
};
|
||||||
|
|
||||||
struct cFunction {
|
struct cFunction {
|
||||||
Lisp_Object* (*body)();
|
Lisp_Object* (*body)();
|
||||||
Arguments args;
|
Arguments args;
|
||||||
bool is_special_form;
|
bool is_special_form;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Lisp_Object {
|
struct Lisp_Object {
|
||||||
Source_Code_Location* sourceCodeLocation;
|
Source_Code_Location* sourceCodeLocation;
|
||||||
u64 flags;
|
u64 flags;
|
||||||
Lisp_Object* userType; // keyword
|
Lisp_Object* userType; // keyword
|
||||||
String* docstring;
|
String* docstring;
|
||||||
union value {
|
union value {
|
||||||
String* symbol; // used for symbols and keywords
|
String* symbol; // used for symbols and keywords
|
||||||
double number;
|
double number;
|
||||||
String* string;
|
String* string;
|
||||||
Pair pair;
|
Pair pair;
|
||||||
Vector vector;
|
Vector vector;
|
||||||
Function* function;
|
Function* function;
|
||||||
cFunction* cFunction;
|
cFunction* cFunction;
|
||||||
void* pointer;
|
void* pointer;
|
||||||
Continuation* continuation;
|
Continuation* continuation;
|
||||||
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
|
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
|
||||||
~value() {}
|
~value() {}
|
||||||
} value;
|
} value;
|
||||||
~Lisp_Object();
|
~Lisp_Object();
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Error {
|
struct Error {
|
||||||
Lisp_Object* position;
|
Lisp_Object* position;
|
||||||
// type has to be a keyword
|
// type has to be a keyword
|
||||||
Lisp_Object* type;
|
Lisp_Object* type;
|
||||||
String* message;
|
String* message;
|
||||||
};
|
};
|
||||||
|
}
|
||||||
|
|||||||
+505
-499
File diff suppressed because it is too large
Load Diff
+514
-512
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user