latest
This commit is contained in:
+1
-1
@@ -11,7 +11,7 @@ pushd build
|
|||||||
taskkill /F /IM %exeName% > NUL 2> NUL
|
taskkill /F /IM %exeName% > NUL 2> NUL
|
||||||
|
|
||||||
echo ---------- Compiling ----------
|
echo ---------- Compiling ----------
|
||||||
call timecmd clang++ -std=c++17 ../src/main.cpp -o %exeName% -D_DEBUG libucrtd.lib
|
call timecmd clang++ -std=c++1z ../src/main.cpp -o %exeName% -D_DEBUG libucrtd.lib
|
||||||
|
|
||||||
if %errorlevel% == 0 (
|
if %errorlevel% == 0 (
|
||||||
echo.
|
echo.
|
||||||
|
|||||||
+249
-267
@@ -40,234 +40,6 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
proc built_in_equals(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments->type == Lisp_Object_Type::Nil)
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
|
|
||||||
Lisp_Object* first = arguments->value.pair->first;
|
|
||||||
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
if (!lisp_object_equal(arguments->value.pair->first, first))
|
|
||||||
return Memory::create_lisp_object_nil();
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_greater(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
double last_number = strtod("Inf", NULL);
|
|
||||||
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments->value.pair->first->value.number->value >= last_number)
|
|
||||||
return Memory::create_lisp_object_nil();
|
|
||||||
|
|
||||||
last_number = arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_greater_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
double last_number = strtod("Inf", NULL);
|
|
||||||
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments->value.pair->first->value.number->value > last_number)
|
|
||||||
return Memory::create_lisp_object_nil();
|
|
||||||
|
|
||||||
last_number = arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_less(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
double last_number = strtod("-Inf", NULL);
|
|
||||||
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments->value.pair->first->value.number->value <= last_number)
|
|
||||||
return Memory::create_lisp_object_nil();
|
|
||||||
|
|
||||||
last_number = arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_less_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
double last_number = strtod("-Inf", NULL);
|
|
||||||
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments->value.pair->first->value.number->value < last_number)
|
|
||||||
return Memory::create_lisp_object_nil();
|
|
||||||
|
|
||||||
last_number = arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_t();
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_add(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
double sum = 0;
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
sum += arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_number(sum);
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_substract(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
double difference = arguments->value.pair->first->value.number->value;
|
|
||||||
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
difference -= arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
return Memory::create_lisp_object_number(difference);
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_multiply(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
double product = arguments->value.pair->first->value.number->value;
|
|
||||||
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
product *= arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
return Memory::create_lisp_object_number(product);
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_divide(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
double quotient = arguments->value.pair->first->value.number->value;
|
|
||||||
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
while (arguments->type == Lisp_Object_Type::Pair) {
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
quotient /= arguments->value.pair->first->value.number->value;
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
}
|
|
||||||
return Memory::create_lisp_object_number(quotient);
|
|
||||||
}
|
|
||||||
|
|
||||||
proc built_in_exponentiate(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
|
||||||
int arguments_length;
|
|
||||||
try {
|
|
||||||
arguments = eval_arguments(arguments, env, &arguments_length);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (arguments_length != 2) {
|
|
||||||
create_error(Error_Type::Wrong_Number_Of_Arguments, arguments->sourceCodeLocation);
|
|
||||||
return nullptr;
|
|
||||||
}
|
|
||||||
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
double base = arguments->value.pair->first->value.number->value;
|
|
||||||
|
|
||||||
arguments = arguments->value.pair->rest;
|
|
||||||
|
|
||||||
try {
|
|
||||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
|
||||||
}
|
|
||||||
|
|
||||||
double exponent = arguments->value.pair->first->value.number->value;
|
|
||||||
|
|
||||||
return Memory::create_lisp_object_number(pow(base, exponent));
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
|
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
|
||||||
char* file_content = read_entire_file(Memory::get_c_str(file_name));
|
char* file_content = read_entire_file(Memory::get_c_str(file_name));
|
||||||
if (file_content) {
|
if (file_content) {
|
||||||
@@ -298,23 +70,230 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
return nullptr; \
|
return nullptr; \
|
||||||
}
|
}
|
||||||
|
|
||||||
proc defun = [&](const char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) {
|
proc defun = [&](const char* name, auto fun) {
|
||||||
define_symbol(
|
define_symbol(
|
||||||
Memory::create_lisp_object_symbol(name),
|
Memory::create_lisp_object_symbol(name),
|
||||||
Memory::create_lisp_object_cfunction(fun),
|
Memory::create_lisp_object_cfunction(fun),
|
||||||
env);
|
env);
|
||||||
};
|
};
|
||||||
|
|
||||||
defun("=", built_in_equals);
|
defun("=", cLambda {
|
||||||
defun(">", built_in_greater);
|
int arguments_length;
|
||||||
defun(">=", built_in_greater_equal);
|
try {
|
||||||
defun("<", built_in_less);
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
defun("<=", built_in_less_equal);
|
}
|
||||||
defun("+", built_in_add);
|
|
||||||
defun("-", built_in_substract);
|
if (arguments->type == Lisp_Object_Type::Nil)
|
||||||
defun("*", built_in_multiply);
|
return Memory::create_lisp_object_t();
|
||||||
defun("/", built_in_divide);
|
|
||||||
defun("**", built_in_exponentiate);
|
Lisp_Object* first = arguments->value.pair->first;
|
||||||
|
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
if (!lisp_object_equal(arguments->value.pair->first, first))
|
||||||
|
return Memory::create_lisp_object_nil();
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_t();
|
||||||
|
});
|
||||||
|
defun(">", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
double last_number = strtod("Inf", NULL);
|
||||||
|
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (arguments->value.pair->first->value.number->value >= last_number)
|
||||||
|
return Memory::create_lisp_object_nil();
|
||||||
|
|
||||||
|
last_number = arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_t();
|
||||||
|
});
|
||||||
|
defun(">=", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
double last_number = strtod("Inf", NULL);
|
||||||
|
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (arguments->value.pair->first->value.number->value > last_number)
|
||||||
|
return Memory::create_lisp_object_nil();
|
||||||
|
|
||||||
|
last_number = arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_t();
|
||||||
|
});
|
||||||
|
defun("<", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
double last_number = strtod("-Inf", NULL);
|
||||||
|
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (arguments->value.pair->first->value.number->value <= last_number)
|
||||||
|
return Memory::create_lisp_object_nil();
|
||||||
|
|
||||||
|
last_number = arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_t();
|
||||||
|
});
|
||||||
|
defun("<=", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
double last_number = strtod("-Inf", NULL);
|
||||||
|
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (arguments->value.pair->first->value.number->value < last_number)
|
||||||
|
return Memory::create_lisp_object_nil();
|
||||||
|
|
||||||
|
last_number = arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_t();
|
||||||
|
});
|
||||||
|
defun("+", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
double sum = 0;
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
sum += arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_number(sum);
|
||||||
|
});
|
||||||
|
defun("-", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
double difference = arguments->value.pair->first->value.number->value;
|
||||||
|
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
difference -= arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
return Memory::create_lisp_object_number(difference);
|
||||||
|
});
|
||||||
|
defun("*", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
double product = arguments->value.pair->first->value.number->value;
|
||||||
|
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
product *= arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
return Memory::create_lisp_object_number(product);
|
||||||
|
});
|
||||||
|
defun("/", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
double quotient = arguments->value.pair->first->value.number->value;
|
||||||
|
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
while (arguments->type == Lisp_Object_Type::Pair) {
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
quotient /= arguments->value.pair->first->value.number->value;
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
}
|
||||||
|
return Memory::create_lisp_object_number(quotient);
|
||||||
|
});
|
||||||
|
defun("**", cLambda {
|
||||||
|
int arguments_length;
|
||||||
|
try {
|
||||||
|
arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (arguments_length != 2) {
|
||||||
|
create_error(Error_Type::Wrong_Number_Of_Arguments, arguments->sourceCodeLocation);
|
||||||
|
return nullptr;
|
||||||
|
}
|
||||||
|
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
double base = arguments->value.pair->first->value.number->value;
|
||||||
|
|
||||||
|
arguments = arguments->value.pair->rest;
|
||||||
|
|
||||||
|
try {
|
||||||
|
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
|
||||||
|
}
|
||||||
|
|
||||||
|
double exponent = arguments->value.pair->first->value.number->value;
|
||||||
|
|
||||||
|
return Memory::create_lisp_object_number(pow(base, exponent));
|
||||||
|
});
|
||||||
defun("define", cLambda {
|
defun("define", cLambda {
|
||||||
try {
|
try {
|
||||||
arguments_length = list_length(arguments);
|
arguments_length = list_length(arguments);
|
||||||
@@ -345,41 +324,41 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
|
|
||||||
return value;
|
return value;
|
||||||
});
|
});
|
||||||
defun("define-upwards", cLambda {
|
// defun("define-upwards", cLambda {
|
||||||
try {
|
// try {
|
||||||
arguments_length = list_length(arguments);
|
// arguments_length = list_length(arguments);
|
||||||
}
|
// }
|
||||||
|
|
||||||
if (arguments_length != 2) {
|
// if (arguments_length != 2) {
|
||||||
report_error(Error_Type::Wrong_Number_Of_Arguments);
|
// report_error(Error_Type::Wrong_Number_Of_Arguments);
|
||||||
}
|
// }
|
||||||
|
|
||||||
Lisp_Object* symbol = arguments->value.pair->first;
|
// Lisp_Object* symbol = arguments->value.pair->first;
|
||||||
|
|
||||||
if (symbol->type == Lisp_Object_Type::Pair) {
|
// if (symbol->type == Lisp_Object_Type::Pair) {
|
||||||
try {
|
// try {
|
||||||
symbol = eval_expr(symbol, env);
|
// symbol = eval_expr(symbol, env);
|
||||||
}
|
// }
|
||||||
}
|
// }
|
||||||
|
|
||||||
if (symbol->type != Lisp_Object_Type::Symbol) {
|
// if (symbol->type != Lisp_Object_Type::Symbol) {
|
||||||
report_error(Error_Type::Type_Missmatch);
|
// report_error(Error_Type::Type_Missmatch);
|
||||||
}
|
// }
|
||||||
|
|
||||||
if (!env->parent) {
|
// if (!env->parent) {
|
||||||
report_error(Error_Type::Unknown_Error);
|
// report_error(Error_Type::Unknown_Error);
|
||||||
}
|
// }
|
||||||
|
|
||||||
|
|
||||||
Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
|
// Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
|
||||||
try {
|
// try {
|
||||||
value = eval_expr(value, env);
|
// value = eval_expr(value, env);
|
||||||
}
|
// }
|
||||||
|
|
||||||
define_symbol(symbol, value, env->parent);
|
// define_symbol(symbol, value, env->parent);
|
||||||
|
|
||||||
return value;
|
// return value;
|
||||||
});
|
// });
|
||||||
defun("mutate", cLambda {
|
defun("mutate", cLambda {
|
||||||
try {
|
try {
|
||||||
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
@@ -453,8 +432,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
// print(arguments);
|
// print(arguments);
|
||||||
// printf("\n");
|
// printf("\n");
|
||||||
|
|
||||||
// recursive lambdas in lambdas yay!!
|
/* recursive lambdas in lambdas yay!! */
|
||||||
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions;
|
// NOTE(Felix): first we have to initialize the variable
|
||||||
|
// with a garbage lambda, so that we can then overwrite it
|
||||||
|
// a recursive lambda
|
||||||
|
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
|
||||||
unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* {
|
unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Lisp_Object* expr) -> Lisp_Object* {
|
||||||
// if it is an atom, return it
|
// if it is an atom, return it
|
||||||
if (expr->type != Lisp_Object_Type::Pair)
|
if (expr->type != Lisp_Object_Type::Pair)
|
||||||
|
|||||||
+2
-1
@@ -388,7 +388,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
|||||||
|
|
||||||
// check for c function
|
// check for c function
|
||||||
if (lispOperator->type == Lisp_Object_Type::CFunction) {
|
if (lispOperator->type == Lisp_Object_Type::CFunction) {
|
||||||
Lisp_Object* result = lispOperator->value.cfunction->function(arguments, env);
|
Lisp_Object* result = lispOperator->value.lambdaWrapper->function(arguments, env);
|
||||||
|
// Lisp_Object* result = (*lispOperator->value.lambdaWrapper)(arguments, env);
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
+5
-5
@@ -2,13 +2,13 @@
|
|||||||
|
|
||||||
int main(int argc, char* argv[]) {
|
int main(int argc, char* argv[]) {
|
||||||
if (argc > 1) {
|
if (argc > 1) {
|
||||||
interprete_file(argv[1]);
|
Slime::interprete_file(argv[1]);
|
||||||
if (error) {
|
if (Slime::error) {
|
||||||
log_error();
|
Slime::log_error();
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
run_all_tests();
|
Slime::run_all_tests();
|
||||||
interprete_stdin();
|
Slime::interprete_stdin();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+2
-3
@@ -154,11 +154,10 @@ namespace Memory {
|
|||||||
Memory::create_string(keyword));
|
Memory::create_string(keyword));
|
||||||
}
|
}
|
||||||
|
|
||||||
proc create_lisp_object_cfunction(std::function<Lisp_Object*(Lisp_Object*, Environment*)> function) -> Lisp_Object* {
|
proc create_lisp_object_cfunction(TransientFunction<Lisp_Object* (Lisp_Object*, Environment*)> function) -> Lisp_Object* {
|
||||||
Lisp_Object* node = create_lisp_object();
|
Lisp_Object* node = create_lisp_object();
|
||||||
node->type = Lisp_Object_Type::CFunction;
|
node->type = Lisp_Object_Type::CFunction;
|
||||||
node->value.cfunction = new(CFunction);
|
node->value.lambdaWrapper = new Lambda_Wrapper(function);
|
||||||
node->value.cfunction->function = function;
|
|
||||||
return node;
|
return node;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
+14
-14
@@ -9,7 +9,7 @@ namespace Parser {
|
|||||||
// read-time. This should always be the global environment.
|
// read-time. This should always be the global environment.
|
||||||
Environment* environment_for_macros;
|
Environment* environment_for_macros;
|
||||||
|
|
||||||
void init(Environment* env) {
|
proc init(Environment* env) -> void {
|
||||||
// NOTE(Felix): it is important to keep the parser environment
|
// NOTE(Felix): it is important to keep the parser environment
|
||||||
// up to date with the global environment. When donig tests,
|
// up to date with the global environment. When donig tests,
|
||||||
// or running a programm we have to reaload it.
|
// or running a programm we have to reaload it.
|
||||||
@@ -28,7 +28,7 @@ namespace Parser {
|
|||||||
lo->sourceCodeLocation->column = parser_col;
|
lo->sourceCodeLocation->column = parser_col;
|
||||||
}
|
}
|
||||||
|
|
||||||
void eat_comment_line(char* text, int* index_in_text) {
|
proc eat_comment_line(char* text, int* index_in_text) -> void {
|
||||||
// safety check if we are actually starting a comment here
|
// safety check if we are actually starting a comment here
|
||||||
if (text[*index_in_text] != ';')
|
if (text[*index_in_text] != ';')
|
||||||
return;
|
return;
|
||||||
@@ -42,7 +42,7 @@ namespace Parser {
|
|||||||
text[(*index_in_text)] != '\0');
|
text[(*index_in_text)] != '\0');
|
||||||
}
|
}
|
||||||
|
|
||||||
void eat_whitespace(char* text, int* index_in_text) {
|
proc eat_whitespace(char* text, int* index_in_text) -> void {
|
||||||
// skip whitespaces
|
// skip whitespaces
|
||||||
while (text[(*index_in_text)] == ' ' ||
|
while (text[(*index_in_text)] == ' ' ||
|
||||||
text[(*index_in_text)] == '\t' ||
|
text[(*index_in_text)] == '\t' ||
|
||||||
@@ -59,7 +59,7 @@ namespace Parser {
|
|||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void eat_until_code(char* text, int* index_in_text) {
|
proc eat_until_code(char* text, int* index_in_text) -> void {
|
||||||
int position_before;
|
int position_before;
|
||||||
do {
|
do {
|
||||||
position_before = *index_in_text;
|
position_before = *index_in_text;
|
||||||
@@ -68,7 +68,7 @@ namespace Parser {
|
|||||||
} while (position_before != *index_in_text);
|
} while (position_before != *index_in_text);
|
||||||
}
|
}
|
||||||
|
|
||||||
String* read_atom(char* text, int* index_in_text) {
|
proc read_atom(char* text, int* index_in_text) -> String* {
|
||||||
int atom_length = 0;
|
int atom_length = 0;
|
||||||
while (text[*index_in_text+atom_length] != ' ' &&
|
while (text[*index_in_text+atom_length] != ' ' &&
|
||||||
text[*index_in_text+atom_length] != ')' &&
|
text[*index_in_text+atom_length] != ')' &&
|
||||||
@@ -102,7 +102,7 @@ namespace Parser {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_number(char* text, int* index_in_text) {
|
proc parse_number(char* text, int* index_in_text) -> Lisp_Object* {
|
||||||
double number;
|
double number;
|
||||||
// TODO(Felix): parse the number direcrly from the string and
|
// TODO(Felix): parse the number direcrly from the string and
|
||||||
// dont create a String first
|
// dont create a String first
|
||||||
@@ -114,7 +114,7 @@ namespace Parser {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_keyword(char* text, int* index_in_text) {
|
proc parse_keyword(char* text, int* index_in_text) -> Lisp_Object* {
|
||||||
// we are now on the colon
|
// we are now on the colon
|
||||||
++(*index_in_text);
|
++(*index_in_text);
|
||||||
++parser_col;
|
++parser_col;
|
||||||
@@ -125,7 +125,7 @@ namespace Parser {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_symbol(char* text, int* index_in_text) {
|
proc parse_symbol(char* text, int* index_in_text) -> Lisp_Object* {
|
||||||
// we are now at the first char of the symbol
|
// we are now at the first char of the symbol
|
||||||
String* str_symbol = read_atom(text, index_in_text);
|
String* str_symbol = read_atom(text, index_in_text);
|
||||||
Lisp_Object* ret = Memory::create_lisp_object_symbol(str_symbol);
|
Lisp_Object* ret = Memory::create_lisp_object_symbol(str_symbol);
|
||||||
@@ -133,7 +133,7 @@ namespace Parser {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_string(char* text, int* index_in_text) {
|
proc parse_string(char* text, int* index_in_text) -> Lisp_Object*{
|
||||||
// the first character is the '"'
|
// the first character is the '"'
|
||||||
++(*index_in_text);
|
++(*index_in_text);
|
||||||
++parser_col;
|
++parser_col;
|
||||||
@@ -188,7 +188,7 @@ namespace Parser {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_atom(char* text, int* index_in_text) {
|
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
|
||||||
// numbers
|
// numbers
|
||||||
if ((text[*index_in_text] <= 57 && // if number
|
if ((text[*index_in_text] <= 57 && // if number
|
||||||
text[*index_in_text] >= 48)
|
text[*index_in_text] >= 48)
|
||||||
@@ -216,7 +216,7 @@ namespace Parser {
|
|||||||
return parse_symbol(text, index_in_text);
|
return parse_symbol(text, index_in_text);
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_expression(char* text, int* index_in_text) {
|
proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* {
|
||||||
|
|
||||||
// if it is quoted
|
// if it is quoted
|
||||||
if (text[*index_in_text] == '\'' ||
|
if (text[*index_in_text] == '\'' ||
|
||||||
@@ -440,7 +440,7 @@ namespace Parser {
|
|||||||
return expression;
|
return expression;
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object* parse_single_expression(char* text) {
|
proc parse_single_expression(char* text) -> Lisp_Object* {
|
||||||
parser_file = Memory::create_string("stdin");
|
parser_file = Memory::create_string("stdin");
|
||||||
parser_line = 1;
|
parser_line = 1;
|
||||||
parser_col = 1;
|
parser_col = 1;
|
||||||
@@ -470,7 +470,7 @@ namespace Parser {
|
|||||||
return nullptr;
|
return nullptr;
|
||||||
}
|
}
|
||||||
|
|
||||||
void write_expanded_file(String* file_name, Lisp_Object_Array_List* program) {
|
proc write_expanded_file(String* file_name, Lisp_Object_Array_List* program) -> void {
|
||||||
const char* ext = ".expanded";
|
const char* ext = ".expanded";
|
||||||
char* newName = (char*)calloc(10 + file_name->length, sizeof(char));
|
char* newName = (char*)calloc(10 + file_name->length, sizeof(char));
|
||||||
strcpy(newName, Memory::get_c_str(file_name));
|
strcpy(newName, Memory::get_c_str(file_name));
|
||||||
@@ -494,7 +494,7 @@ namespace Parser {
|
|||||||
free(newName);
|
free(newName);
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object_Array_List* parse_program(String* file_name, char* text) {
|
proc parse_program(String* file_name, char* text) -> Lisp_Object_Array_List* {
|
||||||
parser_file = file_name;
|
parser_file = file_name;
|
||||||
parser_line = 1;
|
parser_line = 1;
|
||||||
parser_col = 0;
|
parser_col = 0;
|
||||||
|
|||||||
@@ -1,8 +1,13 @@
|
|||||||
#pragma once
|
#pragma once
|
||||||
|
|
||||||
#define _CRT_SECURE_NO_DEPRECATE
|
#define _CRT_SECURE_NO_DEPRECATE
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
// #include <type_traits>
|
||||||
#include <functional>
|
#include <functional>
|
||||||
|
|
||||||
|
|
||||||
|
namespace Slime {
|
||||||
#include "./defines.cpp"
|
#include "./defines.cpp"
|
||||||
#include "./structs.cpp"
|
#include "./structs.cpp"
|
||||||
#include "./forward_decls.cpp"
|
#include "./forward_decls.cpp"
|
||||||
@@ -16,5 +21,6 @@
|
|||||||
#include "./eval.cpp"
|
#include "./eval.cpp"
|
||||||
#include "./testing.cpp"
|
#include "./testing.cpp"
|
||||||
#include "./undefines.cpp"
|
#include "./undefines.cpp"
|
||||||
|
}
|
||||||
|
|
||||||
#undef _CRT_SECURE_NO_DEPRECATE
|
#undef _CRT_SECURE_NO_DEPRECATE
|
||||||
|
|||||||
+54
-3
@@ -7,6 +7,56 @@ define_array_list(String*, String);
|
|||||||
define_array_list(int, Int);
|
define_array_list(int, Int);
|
||||||
define_array_list(void*, Void_Ptr);
|
define_array_list(void*, Void_Ptr);
|
||||||
|
|
||||||
|
// -----------------------------
|
||||||
|
// <crazy lambda wrapper>
|
||||||
|
// -----------------------------
|
||||||
|
// SOURCE: http://brnz.org/hbr/?p=1767
|
||||||
|
template<typename>
|
||||||
|
struct TransientFunction; // intentionally not defined
|
||||||
|
|
||||||
|
template<typename R, typename ...Args>
|
||||||
|
struct TransientFunction<R(Args...)>
|
||||||
|
{
|
||||||
|
using Dispatcher = R(*)(void*, Args...);
|
||||||
|
|
||||||
|
Dispatcher m_Dispatcher; // A pointer to the static function that will call the
|
||||||
|
// wrapped invokable object
|
||||||
|
void* m_Target; // A pointer to the invokable object
|
||||||
|
|
||||||
|
// Dispatch() is instantiated by the TransientFunction constructor,
|
||||||
|
// which will store a pointer to the function in m_Dispatcher.
|
||||||
|
template<typename S>
|
||||||
|
static R Dispatch(void* target, Args... args) {
|
||||||
|
return (*(S*)target)(args...);
|
||||||
|
}
|
||||||
|
|
||||||
|
template<typename T>
|
||||||
|
TransientFunction(T&& target)
|
||||||
|
: m_Dispatcher(&Dispatch<typename std::decay<T>::type>)
|
||||||
|
, m_Target(&target)
|
||||||
|
{}
|
||||||
|
|
||||||
|
// Specialize for reference-to-function, to ensure that a valid pointer is
|
||||||
|
// stored.
|
||||||
|
using TargetFunctionRef = R(Args...);
|
||||||
|
TransientFunction(TargetFunctionRef target)
|
||||||
|
: m_Dispatcher(Dispatch<TargetFunctionRef>)
|
||||||
|
{
|
||||||
|
static_assert(sizeof(void*) == sizeof target,
|
||||||
|
"It will not be possible to pass functions by reference on this platform. "
|
||||||
|
"Please use explicit function pointers i.e. foo(target) -> foo(&target)");
|
||||||
|
m_Target = (void*)target;
|
||||||
|
}
|
||||||
|
|
||||||
|
R operator()(Args... args) const {
|
||||||
|
return m_Dispatcher(m_Target, args...);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
// -----------------------------
|
||||||
|
// </crazy lambda wrapper>
|
||||||
|
// -----------------------------
|
||||||
|
|
||||||
|
|
||||||
enum struct Lisp_Object_Type {
|
enum struct Lisp_Object_Type {
|
||||||
Nil,
|
Nil,
|
||||||
T,
|
T,
|
||||||
@@ -108,8 +158,9 @@ struct Function {
|
|||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
struct CFunction {
|
struct Lambda_Wrapper {
|
||||||
std::function<Lisp_Object* (Lisp_Object*, Environment*)> function;
|
Lambda_Wrapper(TransientFunction<Lisp_Object* (Lisp_Object*, Environment*)> f) : function(f) {}
|
||||||
|
TransientFunction<Lisp_Object* (Lisp_Object*, Environment*)> function;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct Lisp_Object {
|
struct Lisp_Object {
|
||||||
@@ -122,7 +173,7 @@ struct Lisp_Object {
|
|||||||
String* string;
|
String* string;
|
||||||
Pair* pair;
|
Pair* pair;
|
||||||
Function* function;
|
Function* function;
|
||||||
CFunction* cfunction;
|
Lambda_Wrapper* lambdaWrapper;
|
||||||
} value;
|
} value;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user