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

latest

master
FelixBrendel 7 years ago
parent
0a37967fa6
commit
9a0e32635b
8 changed files with 316 additions and 277 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +1
    -1
      build_clang.bat
  2. +232
    -250
      src/built_ins.cpp
  3. +2
    -1
      src/eval.cpp
  4. +5
    -5
      src/main.cpp
  5. +2
    -3
      src/memory.cpp
  6. +14
    -14
      src/parse.cpp
  7. +6
    -0
      src/slime.h
  8. +54
    -3
      src/structs.cpp

+ 1
- 1
build_clang.bat View File

@@ -11,7 +11,7 @@ pushd build
taskkill /F /IM %exeName% > NUL 2> NUL

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 (
echo.


+ 232
- 250
src/built_ins.cpp View File

@@ -40,281 +40,260 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
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) {
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
char* file_content = read_entire_file(Memory::get_c_str(file_name));
if (file_content) {
Lisp_Object* result = Memory::create_lisp_object_nil();
Lisp_Object_Array_List* program;
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
program = Parser::parse_program(file_name, file_content);
}

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;
for (int i = 0; i < program->next_index; ++i) {
try {
result = eval_expr(program->data[i], env);
}
}
return result;
} else {
create_error(Error_Type::Unknown_Error, nullptr);
return nullptr;
}

return Memory::create_lisp_object_t();
}

proc built_in_greater_equal(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
proc load_built_ins_into_environment(Environment* env) -> void {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
Lisp_Object* evaluated_arguments;

#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
#define report_error(_type) { \
create_error(_type, arguments->sourceCodeLocation); \
return nullptr; \
}

double last_number = strtod("Inf", NULL);
proc defun = [&](const char* name, auto fun) {
define_symbol(
Memory::create_lisp_object_symbol(name),
Memory::create_lisp_object_cfunction(fun),
env);
};

while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
defun("=", cLambda {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments->value.pair->first->value.number->value > last_number)
return Memory::create_lisp_object_nil();
if (arguments->type == Lisp_Object_Type::Nil)
return Memory::create_lisp_object_t();

last_number = arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
Lisp_Object* first = arguments->value.pair->first;

return Memory::create_lisp_object_t();
}
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;
}

proc built_in_less(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
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);
double last_number = strtod("Inf", NULL);

while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
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();
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;
}
last_number = arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}

return Memory::create_lisp_object_t();
}
return Memory::create_lisp_object_t();
});
defun(">=", cLambda {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

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);

double last_number = strtod("-Inf", NULL);
while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}

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();

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;
}

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);
}

return Memory::create_lisp_object_t();
}
double last_number = strtod("-Inf", NULL);

proc built_in_add(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}

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;
}
if (arguments->value.pair->first->value.number->value <= last_number)
return Memory::create_lisp_object_nil();

return Memory::create_lisp_object_number(sum);
}
last_number = arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}

proc built_in_substract(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
return Memory::create_lisp_object_t();
});
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;
double last_number = strtod("-Inf", NULL);

arguments = arguments->value.pair->rest;
while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
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);
}
if (arguments->value.pair->first->value.number->value < last_number)
return Memory::create_lisp_object_nil();

proc built_in_multiply(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
last_number = arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}

try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
double product = arguments->value.pair->first->value.number->value;
return Memory::create_lisp_object_t();
});
defun("+", cLambda {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

arguments = arguments->value.pair->rest;
while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
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;
}

product *= arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
return Memory::create_lisp_object_number(product);
}
return Memory::create_lisp_object_number(sum);
});
defun("-", cLambda {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

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 difference = arguments->value.pair->first->value.number->value;

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);
}

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);
}

quotient /= arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
return Memory::create_lisp_object_number(quotient);
}
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
double product = arguments->value.pair->first->value.number->value;

proc built_in_exponentiate(Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
arguments = arguments->value.pair->rest;
while (arguments->type == Lisp_Object_Type::Pair) {
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}

if (arguments_length != 2) {
create_error(Error_Type::Wrong_Number_Of_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
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);
}
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
double quotient = arguments->value.pair->first->value.number->value;

double base = 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);
}

arguments = arguments->value.pair->rest;
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);
}

try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
if (arguments_length != 2) {
create_error(Error_Type::Wrong_Number_Of_Arguments, arguments->sourceCodeLocation);
return nullptr;
}

double exponent = arguments->value.pair->first->value.number->value;
try {
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}

return Memory::create_lisp_object_number(pow(base, exponent));
}
double base = arguments->value.pair->first->value.number->value;

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

proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
char* file_content = read_entire_file(Memory::get_c_str(file_name));
if (file_content) {
Lisp_Object* result = Memory::create_lisp_object_nil();
Lisp_Object_Array_List* program;
try {
program = Parser::parse_program(file_name, file_content);
}
for (int i = 0; i < program->next_index; ++i) {
try {
result = eval_expr(program->data[i], env);
assert_type(arguments->value.pair->first, Lisp_Object_Type::Number);
}
}
return result;
} else {
create_error(Error_Type::Unknown_Error, nullptr);
return nullptr;
}
}

proc load_built_ins_into_environment(Environment* env) -> void {
int arguments_length;
Lisp_Object* evaluated_arguments;

#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
#define report_error(_type) { \
create_error(_type, arguments->sourceCodeLocation); \
return nullptr; \
}

proc defun = [&](const char* name, std::function<Lisp_Object*(Lisp_Object*, Environment*)> fun) {
define_symbol(
Memory::create_lisp_object_symbol(name),
Memory::create_lisp_object_cfunction(fun),
env);
};
double exponent = arguments->value.pair->first->value.number->value;

defun("=", built_in_equals);
defun(">", built_in_greater);
defun(">=", built_in_greater_equal);
defun("<", built_in_less);
defun("<=", built_in_less_equal);
defun("+", built_in_add);
defun("-", built_in_substract);
defun("*", built_in_multiply);
defun("/", built_in_divide);
defun("**", built_in_exponentiate);
return Memory::create_lisp_object_number(pow(base, exponent));
});
defun("define", cLambda {
try {
arguments_length = list_length(arguments);
@@ -345,41 +324,41 @@ proc load_built_ins_into_environment(Environment* env) -> void {

return value;
});
defun("define-upwards", cLambda {
try {
arguments_length = list_length(arguments);
}
// defun("define-upwards", cLambda {
// try {
// arguments_length = list_length(arguments);
// }

if (arguments_length != 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments);
}
// if (arguments_length != 2) {
// 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) {
try {
symbol = eval_expr(symbol, env);
}
}
// if (symbol->type == Lisp_Object_Type::Pair) {
// try {
// symbol = eval_expr(symbol, env);
// }
// }

if (symbol->type != Lisp_Object_Type::Symbol) {
report_error(Error_Type::Type_Missmatch);
}
// if (symbol->type != Lisp_Object_Type::Symbol) {
// report_error(Error_Type::Type_Missmatch);
// }

if (!env->parent) {
report_error(Error_Type::Unknown_Error);
}
// if (!env->parent) {
// report_error(Error_Type::Unknown_Error);
// }


Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
try {
value = eval_expr(value, env);
}
// Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
// try {
// value = eval_expr(value, env);
// }

define_symbol(symbol, value, env->parent);
// define_symbol(symbol, value, env->parent);

return value;
});
// return value;
// });
defun("mutate", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
@@ -453,8 +432,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// print(arguments);
// printf("\n");

// recursive lambdas in lambdas yay!!
std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions;
/* recursive lambdas in lambdas yay!! */
// 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* {
// if it is an atom, return it
if (expr->type != Lisp_Object_Type::Pair)


+ 2
- 1
src/eval.cpp View File

@@ -388,7 +388,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {

// check for c function
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;
}



+ 5
- 5
src/main.cpp View File

@@ -2,13 +2,13 @@

int main(int argc, char* argv[]) {
if (argc > 1) {
interprete_file(argv[1]);
if (error) {
log_error();
Slime::interprete_file(argv[1]);
if (Slime::error) {
Slime::log_error();
return 1;
}
} else {
run_all_tests();
interprete_stdin();
Slime::run_all_tests();
Slime::interprete_stdin();
}
}

+ 2
- 3
src/memory.cpp View File

@@ -154,11 +154,10 @@ namespace Memory {
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();
node->type = Lisp_Object_Type::CFunction;
node->value.cfunction = new(CFunction);
node->value.cfunction->function = function;
node->value.lambdaWrapper = new Lambda_Wrapper(function);
return node;
}



+ 14
- 14
src/parse.cpp View File

@@ -9,7 +9,7 @@ namespace Parser {
// read-time. This should always be the global environment.
Environment* environment_for_macros;

void init(Environment* env) {
proc init(Environment* env) -> void {
// NOTE(Felix): it is important to keep the parser environment
// up to date with the global environment. When donig tests,
// or running a programm we have to reaload it.
@@ -28,7 +28,7 @@ namespace Parser {
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
if (text[*index_in_text] != ';')
return;
@@ -42,7 +42,7 @@ namespace Parser {
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
while (text[(*index_in_text)] == ' ' ||
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;
do {
position_before = *index_in_text;
@@ -68,7 +68,7 @@ namespace Parser {
} 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;
while (text[*index_in_text+atom_length] != ' ' &&
text[*index_in_text+atom_length] != ')' &&
@@ -102,7 +102,7 @@ namespace Parser {
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;
// TODO(Felix): parse the number direcrly from the string and
// dont create a String first
@@ -114,7 +114,7 @@ namespace Parser {
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
++(*index_in_text);
++parser_col;
@@ -125,7 +125,7 @@ namespace Parser {
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
String* str_symbol = read_atom(text, index_in_text);
Lisp_Object* ret = Memory::create_lisp_object_symbol(str_symbol);
@@ -133,7 +133,7 @@ namespace Parser {
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 '"'
++(*index_in_text);
++parser_col;
@@ -188,7 +188,7 @@ namespace Parser {
return ret;
}

Lisp_Object* parse_atom(char* text, int* index_in_text) {
proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* {
// numbers
if ((text[*index_in_text] <= 57 && // if number
text[*index_in_text] >= 48)
@@ -216,7 +216,7 @@ namespace Parser {
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 (text[*index_in_text] == '\'' ||
@@ -440,7 +440,7 @@ namespace Parser {
return expression;
}

Lisp_Object* parse_single_expression(char* text) {
proc parse_single_expression(char* text) -> Lisp_Object* {
parser_file = Memory::create_string("stdin");
parser_line = 1;
parser_col = 1;
@@ -470,7 +470,7 @@ namespace Parser {
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";
char* newName = (char*)calloc(10 + file_name->length, sizeof(char));
strcpy(newName, Memory::get_c_str(file_name));
@@ -494,7 +494,7 @@ namespace Parser {
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_line = 1;
parser_col = 0;


+ 6
- 0
src/slime.h View File

@@ -1,8 +1,13 @@
#pragma once

#define _CRT_SECURE_NO_DEPRECATE
#include <stdio.h>
#include <string.h>
// #include <type_traits>
#include <functional>


namespace Slime {
#include "./defines.cpp"
#include "./structs.cpp"
#include "./forward_decls.cpp"
@@ -16,5 +21,6 @@
#include "./eval.cpp"
#include "./testing.cpp"
#include "./undefines.cpp"
}

#undef _CRT_SECURE_NO_DEPRECATE

+ 54
- 3
src/structs.cpp View File

@@ -7,6 +7,56 @@ define_array_list(String*, String);
define_array_list(int, Int);
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 {
Nil,
T,
@@ -108,8 +158,9 @@ struct Function {
};


struct CFunction {
std::function<Lisp_Object* (Lisp_Object*, Environment*)> function;
struct Lambda_Wrapper {
Lambda_Wrapper(TransientFunction<Lisp_Object* (Lisp_Object*, Environment*)> f) : function(f) {}
TransientFunction<Lisp_Object* (Lisp_Object*, Environment*)> function;
};

struct Lisp_Object {
@@ -122,7 +173,7 @@ struct Lisp_Object {
String* string;
Pair* pair;
Function* function;
CFunction* cfunction;
Lambda_Wrapper* lambdaWrapper;
} value;
};



Write Preview
Loading…
Cancel
Save