Просмотр исходного кода

step 1 in transitioning to c++

master
FelixBrendel 7 лет назад
Родитель
Сommit
9bc30d1569
21 измененных файлов: 1560 добавлений и 1444 удалений
  1. +1
    -1
      .dir-locals.el
  2. +22
    -0
      CMakeLists.txt
  3. +12
    -4
      bin/test.slime
  4. +1
    -1
      build.bat
  5. Двоичные данные
     
  6. +0
    -0
      src/assert.cpp
  7. +10
    -137
      src/ast.cpp
  8. +0
    -218
      src/built_ins.c
  9. +968
    -0
      src/built_ins.cpp
  10. +7
    -4
      src/env.cpp
  11. +2
    -2
      src/error.cpp
  12. +0
    -1015
      src/eval.c
  13. +444
    -0
      src/eval.cpp
  14. +52
    -6
      src/helpers.cpp
  15. +0
    -18
      src/init.c
  16. +3
    -3
      src/io.cpp
  17. +22
    -19
      src/main.cpp
  18. +0
    -0
      src/parse.cpp
  19. +13
    -13
      src/testing.cpp
  20. +1
    -1
      test.bat
  21. +2
    -2
      vs/slime.vcxproj

+ 1
- 1
.dir-locals.el Просмотреть файл

@@ -1,4 +1,4 @@
((c-mode . ((eval . (company-clang-set-prefix "main.c"))
((c++-mode . ((eval . (company-clang-set-prefix "main.cpp"))
(eval . (flycheck-mode 0))
(eval . (rainbow-mode 0))))
(nil . ((eval . (progn


+ 22
- 0
CMakeLists.txt Просмотреть файл

@@ -0,0 +1,22 @@
ACME_MODULE(
#==========================================================================
# general module information
#==========================================================================
NAME TSE_LispIntegration
TYPE LIBRARY

#==========================================================================
# files of this module
#==========================================================================
INCLUDE_BASE src
bin
FILES_PRIVATE_HEADER src/*.h
FILES_SOURCE src/main.cpp
#DEPENDENCIES TSE_Engine
)

file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/bin/pre.slime
DESTINATION ${CMAKE_CURRENT_BINARY_DIR})

file(COPY ${CMAKE_CURRENT_SOURCE_DIR}/bin/test.slime
DESTINATION ${CMAKE_CURRENT_BINARY_DIR})

+ 12
- 4
bin/test.slime Просмотреть файл

@@ -1,4 +1,12 @@
(defun ! (n)
(ifs (< n 2)
1
(* n (! (- n 1)))))

(defun make-vector (x y z)
(let ((local-x x)
(local-y y)
(local-z z))
(lambda ()
local-x)))

(define v (make-vector 1 2 3))
(print (v))

(read " ")

+ 1
- 1
build.bat Просмотреть файл

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

echo ---------- Compiling ----------
call timecmd cl ../src/main.c /Fe%exeName% /D_DEBUG /W3 /TC /Zi /nologo /EHsc /link
call timecmd cl ../src/main.cpp /Fe%exeName% /D_DEBUG /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib

if %errorlevel% == 0 (
echo.


Двоичные данные
Просмотреть файл


src/assert.c → src/assert.cpp Просмотреть файл


src/ast.c → src/ast.cpp Просмотреть файл

@@ -12,7 +12,7 @@ typedef enum {

Ast_Node_Type_Pair,
Ast_Node_Type_Function,
Ast_Node_Type_Built_In_Function,
Ast_Node_Type_CFunction,
} Ast_Node_Type;

char* Ast_Node_Type_to_string(Ast_Node_Type type) {
@@ -24,7 +24,7 @@ char* Ast_Node_Type_to_string(Ast_Node_Type type) {
case(Ast_Node_Type_Symbol): return "symbol";
case(Ast_Node_Type_Keyword): return "keyword";
case(Ast_Node_Type_Function): return "function";
case(Ast_Node_Type_Built_In_Function): return "built-in function";
case(Ast_Node_Type_CFunction): return "C-function";
case(Ast_Node_Type_Pair): return "pair";
}
return "unknown";
@@ -122,96 +122,10 @@ typedef struct {
struct Ast_Node* body; // implicit prog
} Function;

typedef enum {
Built_In_Addition,
Built_In_And,
Built_In_Breakpoint,
Built_In_Copy,
Built_In_Define,
Built_In_Division,
Built_In_Equal,
Built_In_Eval,
Built_In_Error,
Built_In_Exit,
Built_In_First,
Built_In_Greater,
Built_In_Greater_Equal,
Built_In_If,
Built_In_Info,
Built_In_Lambda,
Built_In_Less,
Built_In_Less_Equal,
Built_In_Let,
Built_In_List,
Built_In_Load,
Built_In_Macro,
Built_In_Macro_Define,
Built_In_Multiplication,
Built_In_Mutate,
Built_In_Not,
Built_In_Or,
Built_In_Pair,
Built_In_Print,
Built_In_Prog,
Built_In_Quote,
Built_In_Read,
Built_In_Rest,
Built_In_Subtraction,
Built_In_Try,
Built_In_Type,
Built_In_While,
} Built_In_Name;

/**
This is used only for printing.
**/
char* Built_In_Name_to_string(Built_In_Name name) {
switch (name) {
case Built_In_Addition: return "+";
case Built_In_And: return "and";
case Built_In_Breakpoint: return "breakpoint";
case Built_In_Copy: return "copy";
case Built_In_Define: return "define";
case Built_In_Division: return "/";
case Built_In_Equal: return "=";
case Built_In_Error: return "error";
case Built_In_Eval: return "eval";
case Built_In_Exit: return "exit";
case Built_In_First: return "first";
case Built_In_Greater: return ">";
case Built_In_Greater_Equal: return ">=";
case Built_In_If: return "if";
case Built_In_Info: return "info";
case Built_In_Lambda: return "lambda";
case Built_In_Less: return "<";
case Built_In_Less_Equal: return "<=";
case Built_In_Let: return "let";
case Built_In_List: return "list";
case Built_In_Load: return "load";
case Built_In_Macro: return "macro";
case Built_In_Macro_Define: return "macro-define";
case Built_In_Multiplication: return "*";
case Built_In_Mutate: return "mutate";
case Built_In_Not: return "not";
case Built_In_Or: return "or";
case Built_In_Pair: return "pair";
case Built_In_Print: return "print";
case Built_In_Prog: return "prog";
case Built_In_Quote: return "quote";
case Built_In_Read: return "read";
case Built_In_Rest: return "rest";
case Built_In_Subtraction: return "-";
case Built_In_Try: return "try";
case Built_In_Type: return "type";
case Built_In_While: return "while";
}

return "Built in string missing in Built_In_Name_to_string";
}

struct Environment;
typedef struct {
Built_In_Name type;
} Built_In_Function;
std::function<Ast_Node*(Ast_Node*, Environment*)> function;
} CFunction;

struct Ast_Node {
Source_Code_Location* sourceCodeLocation;
@@ -223,7 +137,7 @@ struct Ast_Node {
String* string;
Pair* pair;
Function* function;
Built_In_Function* built_in_function;
CFunction* cfunction;
} value;
};
// was forward declarated
@@ -290,52 +204,11 @@ Ast_Node* create_ast_node_keyword(char* keyword) {
return node;
}

Ast_Node* create_ast_node_built_in_function(char* name) {
Built_In_Name type;
if (string_equal(name, "+")) type = Built_In_Addition;
else if (string_equal(name, "*")) type = Built_In_Multiplication;
else if (string_equal(name, "-")) type = Built_In_Subtraction;
else if (string_equal(name, "/")) type = Built_In_Division;
else if (string_equal(name, "<")) type = Built_In_Less;
else if (string_equal(name, "<=")) type = Built_In_Less_Equal;
else if (string_equal(name, "=")) type = Built_In_Equal;
else if (string_equal(name, ">")) type = Built_In_Greater;
else if (string_equal(name, ">=")) type = Built_In_Greater_Equal;
else if (string_equal(name, "and")) type = Built_In_And;
else if (string_equal(name, "breakpoint")) type = Built_In_Breakpoint;
else if (string_equal(name, "copy")) type = Built_In_Copy;
else if (string_equal(name, "define")) type = Built_In_Define;
else if (string_equal(name, "error")) type = Built_In_Error;
else if (string_equal(name, "eval")) type = Built_In_Eval;
else if (string_equal(name, "exit")) type = Built_In_Exit;
else if (string_equal(name, "first")) type = Built_In_First;
else if (string_equal(name, "if")) type = Built_In_If;
else if (string_equal(name, "info")) type = Built_In_Info;
else if (string_equal(name, "info")) type = Built_In_Info;
else if (string_equal(name, "lambda")) type = Built_In_Lambda;
else if (string_equal(name, "let")) type = Built_In_Let;
else if (string_equal(name, "list")) type = Built_In_List;
else if (string_equal(name, "load")) type = Built_In_Load;
else if (string_equal(name, "macro")) type = Built_In_Macro;
else if (string_equal(name, "macro-define")) type = Built_In_Macro_Define;
else if (string_equal(name, "mutate")) type = Built_In_Mutate;
else if (string_equal(name, "not")) type = Built_In_Not;
else if (string_equal(name, "or")) type = Built_In_Or;
else if (string_equal(name, "pair")) type = Built_In_Pair;
else if (string_equal(name, "print")) type = Built_In_Print;
else if (string_equal(name, "prog")) type = Built_In_Prog;
else if (string_equal(name, "quote")) type = Built_In_Quote;
else if (string_equal(name, "read")) type = Built_In_Read;
else if (string_equal(name, "rest")) type = Built_In_Rest;
else if (string_equal(name, "try")) type = Built_In_Try;
else if (string_equal(name, "type")) type = Built_In_Type;
else if (string_equal(name, "while")) type = Built_In_While;
else return nullptr;

Ast_Node* create_ast_node_cfunction(std::function<Ast_Node*(Ast_Node*, Environment*)> function) {
Ast_Node* node = create_ast_node();
node->type = Ast_Node_Type_Built_In_Function;
node->value.built_in_function = new(Built_In_Function);
node->value.built_in_function->type = type;
node->type = Ast_Node_Type_CFunction;
node->value.cfunction = new(CFunction);
node->value.cfunction->function = function;
return node;
}


+ 0
- 218
src/built_ins.c Просмотреть файл

@@ -1,218 +0,0 @@
Ast_Node* eval_expr(Ast_Node* node, Environment* env);

bool ast_node_equal(Ast_Node* n1, Ast_Node* n2) {
if (n1 == n2)
return true;
if (n1->type != n2->type)
return false;

switch (n1->type) {
case Ast_Node_Type_Built_In_Function:
return n1->value.built_in_function->type
== n2->value.built_in_function->type;
case Ast_Node_Type_Function:
// if they have the same pointer, true is
// returned a few lines above
return false;
case Ast_Node_Type_Keyword:
return string_equal(
n1->value.keyword->identifier,
n2->value.keyword->identifier);
case Ast_Node_Type_T:
case Ast_Node_Type_Nil:
return true;
case Ast_Node_Type_Number:
return
n1->value.number->value ==
n2->value.number->value;
case Ast_Node_Type_Pair:
create_error(Error_Type_Not_Yet_Implemented, n1->sourceCodeLocation);
return false;
case Ast_Node_Type_String:
return string_equal(
n1->value.string->value,
n2->value.string->value);
case Ast_Node_Type_Symbol:
return string_equal(
n1->value.symbol->identifier,
n2->value.symbol->identifier);
}

// we should never reach here
return false;
}

Ast_Node* built_in_equals(Ast_Node* operands) {
if (operands->type == Ast_Node_Type_Nil)
return create_ast_node_t();

Ast_Node* first = operands->value.pair->first;

while (operands->type == Ast_Node_Type_Pair) {
if (!ast_node_equal(operands->value.pair->first, first))
return create_ast_node_nil();
operands = operands->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_greater(Ast_Node* operands) {
double last_number = strtod("Inf", NULL);

while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

if (operands->value.pair->first->value.number->value >= last_number)
return create_ast_node_nil();

last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_greater_equal(Ast_Node* operands) {
double last_number = strtod("Inf", NULL);

while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

if (operands->value.pair->first->value.number->value > last_number)
return create_ast_node_nil();

last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_less(Ast_Node* operands) {
double last_number = strtod("-Inf", NULL);

while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

if (operands->value.pair->first->value.number->value <= last_number)
return create_ast_node_nil();

last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_less_equal(Ast_Node* operands) {
double last_number = strtod("-Inf", NULL);

while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

if (operands->value.pair->first->value.number->value < last_number)
return create_ast_node_nil();

last_number = operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_add(Ast_Node* operands) {
double sum = 0;
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
sum += operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}

return create_ast_node_number(sum);
}

Ast_Node* built_in_substract(Ast_Node* operands) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
double difference = operands->value.pair->first->value.number->value;

operands = operands->value.pair->rest;
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

difference -= operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(difference);
}

Ast_Node* built_in_multiply(Ast_Node* operands) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
double product = operands->value.pair->first->value.number->value;

operands = operands->value.pair->rest;
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

product *= operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(product);
}

Ast_Node* built_in_divide(Ast_Node* operands) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}
double quotient = operands->value.pair->first->value.number->value;

operands = operands->value.pair->rest;
while (operands->type == Ast_Node_Type_Pair) {
try {
assert_type(operands->value.pair->first, Ast_Node_Type_Number);
}

quotient /= operands->value.pair->first->value.number->value;
operands = operands->value.pair->rest;
}
return create_ast_node_number(quotient);
}


Ast_Node* built_in_load(char* file_name, Environment* env) {
char* file_content = read_entire_file(file_name);
if (file_content) {
Ast_Node* result = create_ast_node_nil();
Ast_Node_Array_List* program;
try {
program = parse_program(file_name, file_content);
}
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;
}
}

+ 968
- 0
src/built_ins.cpp Просмотреть файл

@@ -0,0 +1,968 @@
Ast_Node* eval_arguments(Ast_Node* arguments, Environment* env, int *out_arguments_length);
int list_length(Ast_Node* node);
Ast_Node* eval_expr(Ast_Node* node, Environment* env);
bool is_truthy (Ast_Node* expression, Environment* env);
void parse_argument_list(Ast_Node* arguments, Function* function);

bool ast_node_equal(Ast_Node* n1, Ast_Node* n2) {
if (n1 == n2)
return true;
if (n1->type != n2->type)
return false;

switch (n1->type) {
case Ast_Node_Type_CFunction:
// TODO(Felix): make comparing work again.
return false;
/* return n1->value.built_in_function->type */
/* == n2->value.built_in_function->type; */
case Ast_Node_Type_Function:
// if they have the same pointer, true is
// returned a few lines above
return false;
case Ast_Node_Type_Keyword:
return string_equal(
n1->value.keyword->identifier,
n2->value.keyword->identifier);
case Ast_Node_Type_T:
case Ast_Node_Type_Nil:
return true;
case Ast_Node_Type_Number:
return
n1->value.number->value ==
n2->value.number->value;
case Ast_Node_Type_Pair:
create_error(Error_Type_Not_Yet_Implemented, n1->sourceCodeLocation);
return false;
case Ast_Node_Type_String:
return string_equal(
n1->value.string->value,
n2->value.string->value);
case Ast_Node_Type_Symbol:
return string_equal(
n1->value.symbol->identifier,
n2->value.symbol->identifier);
}

// we should never reach here
return false;
}

Ast_Node* built_in_equals(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments->type == Ast_Node_Type_Nil)
return create_ast_node_t();

Ast_Node* first = arguments->value.pair->first;

while (arguments->type == Ast_Node_Type_Pair) {
if (!ast_node_equal(arguments->value.pair->first, first))
return create_ast_node_nil();
arguments = arguments->value.pair->rest;
}

return create_ast_node_t();
}

Ast_Node* built_in_greater(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

double last_number = strtod("Inf", NULL);

while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

if (arguments->value.pair->first->value.number->value >= last_number)
return create_ast_node_nil();

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

return create_ast_node_t();
}

Ast_Node* built_in_greater_equal(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

double last_number = strtod("Inf", NULL);

while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

if (arguments->value.pair->first->value.number->value > last_number)
return create_ast_node_nil();

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

return create_ast_node_t();
}

Ast_Node* built_in_less(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

double last_number = strtod("-Inf", NULL);

while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

if (arguments->value.pair->first->value.number->value <= last_number)
return create_ast_node_nil();

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

return create_ast_node_t();
}

Ast_Node* built_in_less_equal(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

double last_number = strtod("-Inf", NULL);

while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

if (arguments->value.pair->first->value.number->value < last_number)
return create_ast_node_nil();

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

return create_ast_node_t();
}

Ast_Node* built_in_add(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

double sum = 0;
while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}
sum += arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}

return create_ast_node_number(sum);
}

Ast_Node* built_in_substract(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}
double difference = arguments->value.pair->first->value.number->value;

arguments = arguments->value.pair->rest;
while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

difference -= arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
return create_ast_node_number(difference);
}

Ast_Node* built_in_multiply(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}
double product = arguments->value.pair->first->value.number->value;

arguments = arguments->value.pair->rest;
while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

product *= arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
return create_ast_node_number(product);
}

Ast_Node* built_in_divide(Ast_Node* arguments, Environment* env) {
int arguments_length;
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}

try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}
double quotient = arguments->value.pair->first->value.number->value;

arguments = arguments->value.pair->rest;
while (arguments->type == Ast_Node_Type_Pair) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Number);
}

quotient /= arguments->value.pair->first->value.number->value;
arguments = arguments->value.pair->rest;
}
return create_ast_node_number(quotient);
}


Ast_Node* built_in_load(char* file_name, Environment* env) {
char* file_content = read_entire_file(file_name);
if (file_content) {
Ast_Node* result = create_ast_node_nil();
Ast_Node_Array_List* program;
try {
program = parse_program(file_name, file_content);
}
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;
}
}

void load_built_ins_into_environment(Environment* env) {
int arguments_length;
Ast_Node* evaluated_arguments;

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

auto defun = [&](char* name, std::function<Ast_Node*(Ast_Node*, Environment*)> fun) {
define_symbol(
create_ast_node_symbol(name),
create_ast_node_cfunction(fun),
env);
};

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("define", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 2) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

Ast_Node* symbol = arguments->value.pair->first;

if (symbol->type == Ast_Node_Type_Pair) {
try {
symbol = eval_expr(symbol, env);
}
}

if (symbol->type != Ast_Node_Type_Symbol) {
report_error(Error_Type_Type_Missmatch);
}

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

define_symbol(symbol, value, env);

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

if (arguments_length != 2) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

Ast_Node* symbol = arguments->value.pair->first;

if (symbol->type == Ast_Node_Type_Pair) {
try {
symbol = eval_expr(symbol, env);
}
}

if (symbol->type != Ast_Node_Type_Symbol) {
report_error(Error_Type_Type_Missmatch);
}

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

define_macro_symbol(symbol, value, env);

return value;
});
defun("mutate", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 2)
report_error(Error_Type_Wrong_Number_Of_Arguments);

if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil ||
evaluated_arguments->value.pair->first->type == Ast_Node_Type_Keyword)
{
report_error(Error_Type_Type_Missmatch);
}

Ast_Node* target = evaluated_arguments->value.pair->first;
Ast_Node* source = evaluated_arguments->value.pair->rest->value.pair->first;

*target = *source;
return target;
});
defun("if", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 2 && arguments_length != 3) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

Ast_Node* condition = arguments->value.pair->first;
Ast_Node* then_part = arguments->value.pair->rest;
Ast_Node* else_part = then_part->value.pair->rest;

bool truthy;
try {
truthy = is_truthy(condition, env);
}

Ast_Node* result;

if (truthy)
try{
result = eval_expr(then_part->value.pair->first, env);
}
else if (arguments_length == 3)
try {
result = eval_expr(else_part->value.pair->first, env);
}
else return create_ast_node_nil();
return result;
});
defun("quote", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

return arguments->value.pair->first;
});
defun("and", cLambda {
bool result = true;
while (arguments->type != Ast_Node_Type_Nil) {
if (arguments->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_List);
}
try {
result &= is_truthy(arguments->value.pair->first, env);
}
arguments = arguments->value.pair->rest;

if (!result) return create_ast_node_nil();
}

return create_ast_node_t();
});
defun("or", cLambda {
bool result = false;
while (arguments->type != Ast_Node_Type_Nil) {
if (arguments->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_List);
}
try {
result |= is_truthy(arguments->value.pair->first, env);
}
arguments = arguments->value.pair->rest;

if (result) return create_ast_node_t();
}

return create_ast_node_nil();
});
defun("not", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
bool truthy;
try {
truthy = is_truthy(arguments->value.pair->first, env);
}
if (truthy)
return create_ast_node_nil();
return create_ast_node_t();
});
defun("while", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length < 2) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
Ast_Node* condition_part = arguments->value.pair->first;
Ast_Node* condition;
Ast_Node* then_part = arguments->value.pair->rest;
Ast_Node* result = create_ast_node_nil();

while (true) {
try {
condition = eval_expr(condition_part, env);
}
if (condition->type == Ast_Node_Type_Nil) {
break;
}
try {
result = eval_expr(then_part->value.pair->first, env);
}
}
return result;

});
defun("let", cLambda {
// (let ((a 10)(b 20)) (body1) (body2))
try {
arguments_length = list_length(arguments);
}

if (arguments_length < 1)
report_error(Error_Type_Wrong_Number_Of_Arguments);

Environment* let_env = create_child_environment(env, Environment_Type_Let);
Ast_Node* bindings = arguments->value.pair->first;
while (true) {
if (bindings->type == Ast_Node_Type_Nil) {
break;
} else if (bindings->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_Arguments);
}

Ast_Node* sym = bindings->value.pair->first->value.pair->first;
if(sym->type != Ast_Node_Type_Symbol) {
report_error(Error_Type_Ill_Formed_Arguments);
}
Ast_Node* rest_sym = bindings->value.pair->first->value.pair->rest;
if (rest_sym->type != Ast_Node_Type_Pair) {
report_error(Error_Type_Ill_Formed_Arguments);
}
if (rest_sym->value.pair->rest->type != Ast_Node_Type_Nil) {
report_error(Error_Type_Ill_Formed_Arguments);
}

Ast_Node* value = eval_expr(rest_sym->value.pair->first, env);

define_symbol(sym, value, let_env);

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

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

Ast_Node* evaluated_arguments;
try {
evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length);
}

if (evaluated_arguments->type == Ast_Node_Type_Nil)
return evaluated_arguments;

// skip to the last evaluated operand and return it,
// we use eval_arguments here instead of doing it
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (evaluated_arguments->value.pair->rest->type == Ast_Node_Type_Pair) {
evaluated_arguments = evaluated_arguments->value.pair->rest;
}
return evaluated_arguments->value.pair->first;
});
defun("lambda", cLambda {
/*
* (lambda ())
* (lambda (x d) (+ 1 2) (- 1 2) (* 1 2))
*/
try {
arguments_length = list_length(arguments);
}

if (arguments_length == 0)
report_error(Error_Type_Wrong_Number_Of_Arguments);

Function* function = new(Function);
/* if (lispOperator->value.built_in_function->type == Built_In_Macro) { */
/* function->is_macro = true; */
/* } else { */
function->is_macro = false;
/* } */

// if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type_Nil) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Pair);
}
try {
parse_argument_list(arguments->value.pair->first, function);
}
} else {
function->positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr;
}

arguments = arguments->value.pair->rest;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Ast_Node_Type_String) {
function->docstring = arguments->value.pair->first->value.string->value;
arguments = arguments->value.pair->rest;
} else {
function->docstring = nullptr;
}

// we are now in the function body, just wrap it in an
// implicit prog
function->body = create_ast_node_pair(
create_ast_node_symbol("prog"),
arguments);

Ast_Node* ret = new(Ast_Node);
ret->type = Ast_Node_Type_Function;
ret->value.function = function;
return ret;
});
defun("macro", cLambda {
/*
* (macro ())
* (macro (x d) (+ 1 2) (- 1 2) (* 1 2))
*/
try {
arguments_length = list_length(arguments);
}

if (arguments_length == 0)
report_error(Error_Type_Wrong_Number_Of_Arguments);

Function* function = new(Function);
function->is_macro = true;

// if parameters were specified
if (arguments->value.pair->first->type != Ast_Node_Type_Nil) {
try {
assert_type(arguments->value.pair->first, Ast_Node_Type_Pair);
}
try {
parse_argument_list(arguments->value.pair->first, function);
}
} else {
function->positional_arguments = create_positional_argument_list(1);
function->keyword_arguments = create_keyword_argument_list(1);
function->rest_argument = nullptr;
}

arguments = arguments->value.pair->rest;
// if there is a docstring, use it
if (arguments->value.pair->first->type == Ast_Node_Type_String) {
function->docstring = arguments->value.pair->first->value.string->value;
arguments = arguments->value.pair->rest;
} else {
function->docstring = nullptr;
}

// we are now in the function body, just wrap it in an
// implicit prog
function->body = create_ast_node_pair(
create_ast_node_symbol("prog"),
arguments);

Ast_Node* ret = new(Ast_Node);
ret->type = Ast_Node_Type_Function;
ret->value.function = function;
return ret;
});
defun("eval", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
Ast_Node* result;
try {
result = eval_expr(evaluated_arguments->value.pair->first, env);
}
return result;
});


defun("prog", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (evaluated_arguments->type == Ast_Node_Type_Nil)
return evaluated_arguments;

// skip to the last evaluated operand and return it,
// we use eval_arguments here instead of doing it
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (evaluated_arguments->value.pair->rest->type == Ast_Node_Type_Pair) {
evaluated_arguments = evaluated_arguments->value.pair->rest;
}
return evaluated_arguments->value.pair->first;
});
defun("list", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
return evaluated_arguments;
});
defun("pair", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??
// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??
// BUG(Felix): Why is arguments_length for '(1 (2)) == 3 and not 2??
/* if (arguments_length != 2) { */
if (list_length(evaluated_arguments) != 2) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
return create_ast_node_pair(evaluated_arguments->value.pair->first, evaluated_arguments->value.pair->rest->value.pair->first);
});
defun("first", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil)
return create_ast_node_nil();
if (evaluated_arguments->value.pair->first->type != Ast_Node_Type_Pair)
report_error(Error_Type_Type_Missmatch);

return evaluated_arguments->value.pair->first->value.pair->first;
});
defun("rest", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil)
return create_ast_node_nil();
if (evaluated_arguments->value.pair->first->type != Ast_Node_Type_Pair)
report_error(Error_Type_Type_Missmatch);

return evaluated_arguments->value.pair->first->value.pair->rest;
});
defun("type", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

Ast_Node_Type type = evaluated_arguments->value.pair->first->type;
switch (type) {
case Ast_Node_Type_CFunction: return create_ast_node_keyword("cfunction");
case Ast_Node_Type_Function: {
if (evaluated_arguments->value.pair->first->value.function->is_macro)
return create_ast_node_keyword("dynamic-macro");
return create_ast_node_keyword("dynamic-function");
}
case Ast_Node_Type_Keyword: return create_ast_node_keyword("keyword");
case Ast_Node_Type_Nil: return create_ast_node_keyword("nil");
case Ast_Node_Type_T: return create_ast_node_keyword("t");
case Ast_Node_Type_Number: return create_ast_node_keyword("number");
case Ast_Node_Type_Pair: return create_ast_node_keyword("pair");
case Ast_Node_Type_String: return create_ast_node_keyword("string");
case Ast_Node_Type_Symbol: return create_ast_node_keyword("symbol");
}
return create_ast_node_keyword("unknown");
});
defun("info", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

print(arguments->value.pair->first);

Ast_Node* type = eval_expr(
create_ast_node_pair(
create_ast_node_symbol("type"),
create_ast_node_pair(arguments->value.pair->first, create_ast_node_nil())),
env);

if (type) {
printf(" is of type ");
print(type);
printf("\n");
// just make sure type was not redefined and
// returns something that is not a keyword
if (type->type == Ast_Node_Type_Keyword &&
(string_equal(type->value.keyword->identifier, "dynamic-function") ||
string_equal(type->value.keyword->identifier, "dynamic-macro")))
{
Ast_Node* fun = eval_expr(arguments->value.pair->first, env);
printf("\nMacro? %s\n", (fun->value.function->is_macro) ? "yes" : "no");
if (fun->value.function->docstring)
printf("Docstring:\n==========\n%s\n\n", fun->value.function->docstring);
else
printf("No docstring avaliable\n");

printf("Arguments:\n==========\n");
printf("Postitional: {");
if (fun->value.function->positional_arguments->next_index != 0) {
printf("%s", fun->value.function->positional_arguments->identifiers[0]);
for (int i = 1; i < fun->value.function->positional_arguments->next_index; ++i) {
printf(", %s", fun->value.function->positional_arguments->identifiers[i]);
}
}
printf("}\n");
printf("Keyword: {");
if (fun->value.function->keyword_arguments->next_index != 0) {
printf("%s", fun->value.function->keyword_arguments->identifiers[0]);
if (fun->value.function->keyword_arguments->values->data[0]) {
printf(" (");
print(fun->value.function->keyword_arguments->values->data[0]);
printf(")");
}
for (int i = 1; i < fun->value.function->keyword_arguments->next_index; ++i) {
printf(", %s", fun->value.function->keyword_arguments->identifiers[i]);
if (fun->value.function->keyword_arguments->values->data[i]) {
printf(" (");
print(fun->value.function->keyword_arguments->values->data[i]);
printf(")");
}
}
}
printf("}\n");
printf("Rest: {");
if (fun->value.function->rest_argument)
printf("%s", fun->value.function->rest_argument);
printf("}\n");

}
} else {
printf(" is not defined\n");
delete_error();
}

return create_ast_node_nil();
});
defun("print", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
print(evaluated_arguments->value.pair->first);
printf("\n");
return create_ast_node_nil();
});
defun("read", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length > 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

if (arguments_length == 1) {
Ast_Node* prompt = evaluated_arguments->value.pair->first;
/* if (prompt->type == Ast_Node_Type_String) */
/* printf("%s", prompt->value.string->value); */
/* else */
print(evaluated_arguments->value.pair->first);
}
char* line = read_line();
return create_ast_node_string(line, (int)strlen(line));
});
defun("exit", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length > 1) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

if (arguments_length == 1) {
Ast_Node* error_code = evaluated_arguments->value.pair->first;
if (error_code->type != Ast_Node_Type_Number)
report_error(Error_Type_Type_Missmatch);

exit((int)error_code->value.number->value);
}
exit(0);
});
defun("break", cLambda {
print_environment(env);
#ifdef _DEBUG
__debugbreak();
#endif
return create_ast_node_nil();
});
defun("try", cLambda {
try {
arguments_length = list_length(arguments);
}

if (arguments_length != 2) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}

Ast_Node* try_part = arguments->value.pair->first;
Ast_Node* catch_part = arguments->value.pair->rest->value.pair->first;
Ast_Node* result;

result = eval_expr(try_part, env);
if (error) {
delete_error();
try {
result = eval_expr(catch_part, env);
}
}
return result;
});
defun("load", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 1)
report_error(Error_Type_Wrong_Number_Of_Arguments);

if (evaluated_arguments->value.pair->first->type != Ast_Node_Type_String)
report_error(Error_Type_Type_Missmatch);

Ast_Node* result;
try {
result = built_in_load(
evaluated_arguments->value.pair->first->value.string->value, env);
}
return result;

});
defun("copy", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}

if (arguments_length != 1)
report_error(Error_Type_Wrong_Number_Of_Arguments);

if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil ||
evaluated_arguments->value.pair->first->type == Ast_Node_Type_Keyword)
{
report_error(Error_Type_Type_Missmatch);
}

Ast_Node* target = new(Ast_Node);
Ast_Node* source = evaluated_arguments->value.pair->first;

*target = *source;
return target;
});
defun("error", cLambda {
try {
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
}
if (arguments_length != 0) {
report_error(Error_Type_Wrong_Number_Of_Arguments);
}
report_error(Error_Type_Unknown_Error);
});

#undef report_error
#undef cLambda
}

Environment* create_built_ins_environment() {
Environment* ret = create_child_environment(nullptr, Environment_Type_Let);
load_built_ins_into_environment(ret);
return ret;
}

src/env.c → src/env.cpp Просмотреть файл

@@ -144,10 +144,13 @@ Ast_Node* lookup_symbol(Ast_Node* node, Environment* env) {
return create_ast_node_t();
}

result = create_ast_node_built_in_function(sym->identifier);
result->sourceCodeLocation = node->sourceCodeLocation;
if (result)
return result;
// we should not need this anymore when we have c lambdas as built
// in functions

/* result = create_ast_node_built_in_function(sym->identifier); */
/* result->sourceCodeLocation = node->sourceCodeLocation; */
/* if (result) */
/* return result; */

create_error(Error_Type_Symbol_Not_Defined, node->sourceCodeLocation);
/* printf("%s\n", sym->identifier); */

src/error.c → src/error.cpp Просмотреть файл

@@ -15,7 +15,7 @@ typedef enum {
Error_Type_Wrong_Number_Of_Arguments,
} Error_Type;

typedef struct {
typedef struct Error_t {
Error_Type type;
Source_Code_Location* location;
} Error;
@@ -31,7 +31,7 @@ void delete_error() {

void create_error(Error_Type type, Source_Code_Location* location) {
delete_error();
__debugbreak();
error = new(Error);
error->type = type;
error->location = location;

+ 0
- 1015
src/eval.c
Разница между файлами не показана из-за своего большого размера
Просмотреть файл


+ 444
- 0
src/eval.cpp Просмотреть файл

@@ -0,0 +1,444 @@
Ast_Node* eval_expr(Ast_Node* node, Environment* env);

Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, Environment* parent) {
// NOTE(Felix): if it is a macro, we will set it later, so we can
// use the default "define_symbol" method here instead of
// switching between "define_symbol" and "define_macro_symbol" all
// the time

Environment* new_env = create_child_environment(parent, Environment_Type_Lambda);

// positional arguments
for (int i = 0; i < function->positional_arguments->next_index; ++i) {
if (arguments->type == Ast_Node_Type_Pair) {
// TODO(Felix): here we create new ast_node_symbols from
// their identifiers but before we converted them to
// strings from symbols... Wo maybe just use the symbols?
define_symbol(
create_ast_node_symbol(function->positional_arguments->identifiers[i]),
arguments->value.pair->first, new_env);
} else {
// not enough arguments given
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
arguments = arguments->value.pair->rest;
}

if (arguments->type == Ast_Node_Type_Nil)
goto eval_time;

String_Array_List* read_in_keywords = create_String_array_list(16);
// 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.

while (arguments->value.pair->first->type == Ast_Node_Type_Keyword) {
// check if this one is even an accepted keyword
bool accepted = false;
for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
if (string_equal(
arguments->value.pair->first->value.keyword->identifier,
function->keyword_arguments->identifiers[i]))
{
accepted = true;
break;
}
}
if (!accepted) {
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}

// check if it was already read in
for (int i = 0; i < read_in_keywords->next_index; ++i) {
if (string_equal(
arguments->value.pair->first->value.keyword->identifier,
read_in_keywords->data[i]))
{
// TODO(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error
// (special case with default variables)
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
}

// okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually
// set it to?
if (arguments->value.pair->rest->type != Ast_Node_Type_Pair) {
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}

// if not set it and then add it to the array list
define_symbol(
create_ast_node_symbol(arguments->value.pair->first->value.keyword->identifier),
arguments->value.pair->rest->value.pair->first,
new_env);

append_to_String_array_list(read_in_keywords, arguments->value.pair->first->value.keyword->identifier);

// overstep both for next one
arguments = arguments->value.pair->rest->value.pair->rest;

if (arguments->type == Ast_Node_Type_Nil) {
break;
}
}


// check if all necessary keywords have been read in
for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
char* defined_keyword = function->keyword_arguments->identifiers[i];
bool was_set = false;
for (int j = 0; j < read_in_keywords->next_index; ++j) {
if (string_equal(
read_in_keywords->data[j],
defined_keyword))
{
was_set = true;
break;
}
}
if (function->keyword_arguments->values->data[i] == nullptr) {
// if this one does not have a default value
if (!was_set) {
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
} 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) {
define_symbol(
create_ast_node_symbol(defined_keyword),
copy_ast_node(function->keyword_arguments->values->data[i]), new_env);
}
}
}


if (arguments->type == Ast_Node_Type_Nil) {
if (function->rest_argument) {
define_symbol(
create_ast_node_symbol(function->rest_argument),
create_ast_node_nil(), new_env);
}
} else {
if (function->rest_argument) {
define_symbol(
create_ast_node_symbol(function->rest_argument),
arguments, new_env);
} else {
// rest was not declared but additional arguments were found
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
}

eval_time: {
Ast_Node* result;

// don't have to check every time if it is macro environment or
// not
if (function->is_macro)
new_env->type = Environment_Type_Macro;

try {
result = eval_expr(function->body, new_env);
}

return result;
}
}

/*
(prog
(define type--before type)
(define type
(lambda (e)
(if (and (= (type--before e) :pair) (= (first e) :my-type))
:my-type
(type--before e))))
)
*/

/**
This parses the argument specification of funcitons into their
Function struct. It dois this by allocating new
positional_arguments, keyword_arguments and rest_argument and
filling it in
*/
void parse_argument_list(Ast_Node* arguments, Function* function) {
// first init the fields
function->positional_arguments = create_positional_argument_list(16);
function->keyword_arguments = create_keyword_argument_list(16);
function->rest_argument = nullptr;

// okay let's try to read some positional arguments
while (arguments->type == Ast_Node_Type_Pair) {
if (arguments->value.pair->first->type == Ast_Node_Type_Keyword) {
if (string_equal(arguments->value.pair->first->value.keyword->identifier, "keys") ||
string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
break;
else {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}
}

if (arguments->value.pair->first->type != Ast_Node_Type_Symbol) {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}

// okay wow we found an actual symbol
append_to_positional_argument_list(
function->positional_arguments,
arguments->value.pair->first->value.symbol->identifier);

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

// okay we are done with positional arguments, lets check for
// keywords,
if (arguments->type != Ast_Node_Type_Pair) {
if (arguments->type != Ast_Node_Type_Nil)
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}

if (arguments->value.pair->first->type == Ast_Node_Type_Keyword &&
string_equal(arguments->value.pair->first->value.keyword->identifier, "keys"))
{
arguments = arguments->value.pair->rest;
if (arguments->type != Ast_Node_Type_Pair ||
arguments->value.pair->first->type != Ast_Node_Type_Symbol)
{
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}

while (arguments->type == Ast_Node_Type_Pair) {
if (arguments->value.pair->first->type == Ast_Node_Type_Keyword) {
if (string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
break;
else {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}
}

if (arguments->value.pair->first->type != Ast_Node_Type_Symbol) {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}

// we found a symbol (arguments->value.pair->first) for
// the keyword args! Let's check if the next arguement is
// :defaults-to
Ast_Node* next = arguments->value.pair->rest;
if (next->type == Ast_Node_Type_Pair &&
next->value.pair->first->type == Ast_Node_Type_Keyword &&
string_equal(next->value.pair->first->value.keyword->identifier,
"defaults-to"))
{
// check if there is a next argument too, otherwise it
// would be an error
next = next->value.pair->rest;
if (next->type == Ast_Node_Type_Pair) {
append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair->first->value.symbol->identifier,
next->value.pair->first);
arguments = next->value.pair->rest;
} else {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}
} else {
// No :defaults-to, so just add it to the list
append_to_keyword_argument_list(function->keyword_arguments,
arguments->value.pair->first->value.symbol->identifier,
nullptr);
arguments = next;
}
}
}


// Now we are also done with keyword arguments, lets check for
// if there is a rest argument
if (arguments->type != Ast_Node_Type_Pair) {
if (arguments->type != Ast_Node_Type_Nil)
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}

if (arguments->value.pair->first->type == Ast_Node_Type_Keyword &&
string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
{
arguments = arguments->value.pair->rest;
if (arguments->type != Ast_Node_Type_Pair ||
arguments->value.pair->first->type != Ast_Node_Type_Symbol)
{
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
return;
}
function->rest_argument = arguments->value.pair->first->value.symbol->identifier;
if (arguments->value.pair->rest->type != Ast_Node_Type_Nil) {
create_error(Error_Type_Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
}
} else {
printf("this should not happen?");
create_error(Error_Type_Unknown_Error, arguments->sourceCodeLocation);
}
}


int list_length(Ast_Node* node) {
if (node->type == Ast_Node_Type_Nil)
return 0;

if (node->type != Ast_Node_Type_Pair) {
create_error(Error_Type_Type_Missmatch, node->sourceCodeLocation);
return 0;
}

int len = 0;
while (node->type == Ast_Node_Type_Pair) {
++len;
node = node->value.pair->rest;
if (node->type == Ast_Node_Type_Nil)
return len;
}

create_error(Error_Type_Ill_Formed_List, node->sourceCodeLocation);
return 0;
}

bool is_truthy (Ast_Node* expression, Environment* env);

Ast_Node* extract_keyword_value(char* keyword, Parsed_Arguments* args) {
// NOTE(Felix): This will be a hashmap lookup later
for (int i = 0; i < args->keyword_keys->next_index; ++i) {
if (string_equal(args->keyword_keys->data[i]->value.keyword->identifier, keyword))
return args->keyword_values->data[i];
}
return nullptr;
}

Ast_Node* eval_arguments(Ast_Node* arguments, Environment* env, int *out_arguments_length) {
*out_arguments_length = 0;
if (arguments->type == Ast_Node_Type_Nil) {
return arguments;
}

Ast_Node* evaluated_arguments = create_ast_node_pair(nullptr, nullptr);
Ast_Node* evaluated_arguments_head = evaluated_arguments;
Ast_Node* current_head = arguments;
while (current_head->type == Ast_Node_Type_Pair) {
try {
evaluated_arguments_head->value.pair->first =
eval_expr(current_head->value.pair->first, env);
}
current_head = current_head->value.pair->rest;

if (current_head->type == Ast_Node_Type_Pair) {
evaluated_arguments_head->value.pair->rest = create_ast_node_pair(nullptr, nullptr);
evaluated_arguments_head = evaluated_arguments_head->value.pair->rest;
} else if (current_head->type == Ast_Node_Type_Nil) {
evaluated_arguments_head->value.pair->rest = current_head;
} else {
create_error(Error_Type_Ill_Formed_Arguments, arguments->sourceCodeLocation);
return nullptr;
}
++(*out_arguments_length);
}
return evaluated_arguments;
}

Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
#define report_error(_type) { \
create_error(_type, node->sourceCodeLocation); \
return nullptr; \
}

if (error)
return nullptr;

Ast_Node* ret = new(Ast_Node);
switch (node->type) {
case Ast_Node_Type_T:
case Ast_Node_Type_Nil:
return node;
case Ast_Node_Type_Symbol: {
Ast_Node* symbol;
try {
symbol = lookup_symbol(node, env);
}
return symbol;
}
case Ast_Node_Type_Number:
case Ast_Node_Type_Keyword:
case Ast_Node_Type_String:
return node;
case Ast_Node_Type_Pair: {
Ast_Node* lispOperator;
if (node->value.pair->first->type != Ast_Node_Type_CFunction &&
node->value.pair->first->type != Ast_Node_Type_Function)
{
try {
lispOperator = eval_expr(node->value.pair->first, env);
}
} else {
lispOperator = node->value.pair->first;
}

Ast_Node* arguments = node->value.pair->rest;
int arguments_length;

// check for c function
if (lispOperator->type == Ast_Node_Type_CFunction) {
Ast_Node* result = lispOperator->value.cfunction->function(arguments, env);
return result;
}

// check for list function
if (lispOperator->type == Ast_Node_Type_Function) {
if (!lispOperator->value.function->is_macro) {
try {
arguments = eval_arguments(arguments, env, &arguments_length);
}
}

Ast_Node* result;
try {
result = apply_arguments_to_function(arguments, lispOperator->value.function, env);
}
return result;
}
}
default: {
#ifdef _DEBUG
__debugbreak();
#endif
report_error(Error_Type_Not_A_Function);
}
}
#undef report_error
}

bool is_truthy (Ast_Node* expression, Environment* env) {
Ast_Node* result;
try {
result = eval_expr(expression, env);
}
if (result->type == Ast_Node_Type_Nil)
return false;
return true;

}

src/helpers.c → src/helpers.cpp Просмотреть файл

@@ -1,4 +1,4 @@
#define new(type) (type*)malloc(sizeof(type))
#define new(type) new type
#define nullptr NULL

#define concat_( a, b) a##b
@@ -55,7 +55,7 @@
define_array_list(char*, String);


typedef enum { false, true } bool;
//typedef enum { false, true } bool;

int string_equal(char* a, char* b) {
return !strcmp(a, b);
@@ -74,7 +74,7 @@ int _vscprintf_so(const char * format, va_list pargs) {
int vasprintf(char **strp, const char *fmt, va_list ap) {
int len = _vscprintf_so(fmt, ap);
if (len == -1) return -1;
char *str = malloc((size_t) len + 1);
char *str = (char *)malloc((size_t) len + 1);
if (!str) return -1;
int r = vsnprintf(str, len + 1, fmt, ap); /* "secure" version of vsprintf */
if (r == -1) return free(str), -1;
@@ -99,6 +99,9 @@ static char get_nibble(char c) {
return (c - '0');
}

#define true 1
#define false 0
#define bool char
bool unescape_string(char* in) {
if (!in)
return true;
@@ -190,8 +193,50 @@ char* read_entire_file (char* filename) {
/* Don't forget to call free() later! */
}

char* read_expression() {
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;

int nesting = 0;

if(line == NULL)
return NULL;

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

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

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

*line++;
if((*line = (char)c) == '(')
++nesting;
else if((*line = (char)c) == ')')
--nesting;
else if((*line = (char)c) == '\n')
if (nesting == 0)
break;
}
(*line)--; // we dont want the \n actually
*line = '\0';
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}

char* read_line() {
char* line = malloc(100), * linep = line;
char* line = (char*)malloc(100), * linep = line;
size_t lenmax = 100, len = lenmax;
int c;

@@ -207,7 +252,7 @@ char* read_line() {

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

if(linen == NULL) {
free(linep);
@@ -228,7 +273,8 @@ char* read_line() {
}
(*line)--; // we dont want the \n actually
*line = '\0';
return linep;
// BUG(Felix): Why do we have to add 1 here?
return linep + 1;
}



+ 0
- 18
src/init.c Просмотреть файл

@@ -1,18 +0,0 @@
// for colored console output
#ifdef _WIN32
#include <windows.h>
#pragma comment(lib, "Kernel32.lib")
#endif

void init () {
// On Windows: manually enable colored console output
#ifdef _WIN32
SetConsoleMode(GetStdHandle(STD_OUTPUT_HANDLE),
ENABLE_PROCESSED_OUTPUT |
ENABLE_WRAP_AT_EOL_OUTPUT |
ENABLE_VIRTUAL_TERMINAL_PROCESSING);
#endif

// TODO(Felix): Init the constants here (Bulit-in function
// ast_nodes, nil, type_keywords ..more?)
}

src/io.c → src/io.cpp Просмотреть файл

@@ -66,8 +66,8 @@ void print(Ast_Node* node) {
else
printf("[lambda]");
} break;
case (Ast_Node_Type_Built_In_Function): {
printf("[built-in-function %s]", Built_In_Name_to_string(node->value.built_in_function->type));
case (Ast_Node_Type_CFunction): {
printf("[C-function]");
} break;
case (Ast_Node_Type_Pair): {
Ast_Node* head = node;
@@ -112,6 +112,6 @@ void log_error() {
Error_Type_to_string(error->type),
console_normal);
printf(" in: %s", console_cyan);
print_error_location(error->location);
print_error_location();
printf("%s\n", console_normal);
}

src/main.c → src/main.cpp Просмотреть файл

@@ -1,3 +1,4 @@
#pragma once
#define _CRT_SECURE_NO_DEPRECATE
#include <stdio.h>
#include <string.h>
@@ -5,48 +6,52 @@
#include <stdarg.h> /* needed for va_list */
#include <ctype.h>
#include <math.h>
#include <functional>

#include "./helpers.c"
#include "./ast.c"
#include "./error.c"
#include "./io.c"
#include "./assert.c"
#include "./parse.c"
#include "./env.c"
#include "./built_ins.c"
#include "./eval.c"
#include "./testing.c"
#include "./init.c"
#include "./helpers.cpp"
#include "./ast.cpp"
#include "./error.cpp"
#include "./io.cpp"
#include "./assert.cpp"
#include "./parse.cpp"
#include "./env.cpp"
#include "./built_ins.cpp"
#include "./eval.cpp"
#include "./testing.cpp"

void interprete_file (char* file_name) {
Ast_Node* interprete_file (char* file_name) {
char* file_content = read_entire_file(file_name);
if (!file_content) {
create_error(Error_Type_Unknown_Error, nullptr);
}

Ast_Node_Array_List* program;
try_void {
parse_program(file_name, file_content);
try {
program = parse_program(file_name, file_content);
}

Environment* env = create_empty_environment(Environment_Type_Let);
load_built_ins_into_environment(env);

try_void {
try {
built_in_load("pre.slime", env);
}

Ast_Node* result = create_ast_node_nil();
for (int i = 0; i < program->next_index; ++i) {
try_void {
try {
result = eval_expr(program->data[i], env);
}
}

return result;
}

int interprete_stdin () {
printf("Welcome to the lispy interpreter.\n");
char* line;
Environment* env = create_empty_environment(Environment_Type_Let);
load_built_ins_into_environment(env);

built_in_load("pre.slime", env);
if (error) {
@@ -57,7 +62,7 @@ int interprete_stdin () {
Ast_Node* parsed, * evaluated;
while (true) {
printf(">");
line = read_line();
line = read_expression();
parsed = parse_single_expression(line);
if (error) {
log_error();
@@ -77,8 +82,6 @@ int interprete_stdin () {
}

int main (int argc, char *argv[]) {
init();

if (argc > 1) {
interprete_file(argv[1]);
if (error) {

src/parse.c → src/parse.cpp Просмотреть файл


src/testing.c → src/testing.cpp Просмотреть файл

@@ -89,7 +89,7 @@ testresult test_eval_operands() {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Ast_Node* operands = parse_single_expression(operands_string);
int operands_length;
operands = eval_arguments(operands, create_empty_environment(Environment_Type_Let), &operands_length);
operands = eval_arguments(operands, create_built_ins_environment(), &operands_length);

assert_no_error(error);
assert_equal_int(list_length(operands), 4);
@@ -233,7 +233,7 @@ testresult test_parse_expression() {
testresult test_built_in_add() {
char exp_string[] = "(+ 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -246,7 +246,7 @@ testresult test_built_in_add() {
testresult test_built_in_substract() {
char exp_string[] = "(- 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -260,7 +260,7 @@ testresult test_built_in_substract() {
testresult test_built_in_multiply() {
char exp_string[] = "(* 10 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -274,7 +274,7 @@ testresult test_built_in_multiply() {
testresult test_built_in_divide() {
char exp_string[] = "(/ 20 4)";
Ast_Node* expression = parse_single_expression(exp_string);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_null(error);
assert_not_null(result);
@@ -288,7 +288,7 @@ testresult test_built_in_divide() {
testresult test_built_in_if() {
char exp_string1[] = "(if 1 4 5)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -297,7 +297,7 @@ testresult test_built_in_if() {

char exp_string2[] = "(if () 4 5)";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -310,7 +310,7 @@ testresult test_built_in_if() {
testresult test_built_in_and() {
char exp_string1[] = "(and 1 \"asd\" 4)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -319,7 +319,7 @@ testresult test_built_in_and() {
// a false case
char exp_string2[] = "(and () \"asd\" 4)";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -331,7 +331,7 @@ testresult test_built_in_and() {
testresult test_built_in_or() {
char exp_string1[] = "(or \"asd\" nil)";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -340,7 +340,7 @@ testresult test_built_in_or() {
// a false case
char exp_string2[] = "(or () ())";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);
@@ -353,7 +353,7 @@ testresult test_built_in_or() {
testresult test_built_in_not() {
char exp_string1[] = "(not ())";
Ast_Node* expression = parse_single_expression(exp_string1);
Ast_Node* result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
Ast_Node* result = eval_expr(expression, create_built_ins_environment());

// a true case
assert_no_error(error);
@@ -363,7 +363,7 @@ testresult test_built_in_not() {
// a false case
char exp_string2[] = "(not \"asd xD\")";
expression = parse_single_expression(exp_string2);
result = eval_expr(expression, create_empty_environment(Environment_Type_Let));
result = eval_expr(expression, create_built_ins_environment());

assert_no_error(error);
assert_not_null(result);

+ 1
- 1
test.bat Просмотреть файл

@@ -4,7 +4,7 @@ pushd %~dp0\bin
call ..\build.bat
if %errorlevel% == 0 (
echo ---------- Testing ----------
call timecmd slime.exe test.slime
call timecmd ..\build\slime.exe test.slime
)

popd

+ 2
- 2
vs/slime.vcxproj Просмотреть файл

@@ -168,9 +168,9 @@
</Link>
</ItemDefinitionGroup>
<ItemGroup>
<ClCompile Include="..\src\main.c" />
<ClCompile Include="..\src\main.cpp" />
</ItemGroup>
<Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
<ImportGroup Label="ExtensionTargets">
</ImportGroup>
</Project>
</Project>

Загрузка…
Отмена
Сохранить