From fec24d11c7c36baeb8a5a6e3efad09da96741989 Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Fri, 18 Jan 2019 21:36:13 +0100 Subject: [PATCH] some things --- bin/pre.slime | 21 ++++-- bin/test.slime | 149 ++++++++++++++++++------------------ build.bat | 2 +- build/slime.exe.dbg | Bin 686 -> 614 bytes src/ast.cpp | 45 +++-------- src/built_ins.cpp | 180 +++++++++++++++++++++++++++++++++++++++----- src/env.cpp | 2 +- src/error.cpp | 2 +- src/eval.cpp | 31 ++++---- src/helpers.cpp | 19 +++-- src/io.cpp | 71 ++++++++++++++++- src/main.cpp | 5 +- src/parse.cpp | 100 +++++++++++++++++++----- vs/slime.vcxproj | 11 ++- 14 files changed, 452 insertions(+), 186 deletions(-) diff --git a/bin/pre.slime b/bin/pre.slime index ce08473..fc8a287 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -1,18 +1,24 @@ (define-syntax when (condition :rest body) - (list 'if condition (pair 'prog body) nil)) + ;; (break) + `(if ,condition ,(pair prog body) nil)) + ;; (list 'if condition (pair 'prog body) nil)) (define-syntax unless (condition :rest body) - (list 'if condition nil (pair 'prog body))) + `(if ,condition nil ,(pair prog body))) (define-syntax defun (name arguments :rest body) ;; (type-assert arguments :pair) ;; `(define ,name (lambda ,arguments ,body)) + ;; TODO(Felix: I think we do not need to wrap the body of the lamba + ;; in a prog + ;; see if we have a docstring (if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil))) (list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body)))) (list 'define name (list 'lambda arguments (pair 'prog body))))) + (define-syntax defspecial (name arguments :rest body) ;; (type-assert arguments :pair) ;; `(define ,name (lambda ,arguments ,body)) @@ -52,7 +58,7 @@ (defun pair? (x) "Checks if the argument is a pair." - (or (= (type x) :pair) (= (type x) :nil))) + (= (type x) :pair)) (defun string? (x) "Checks if the argument is a string." @@ -191,6 +197,11 @@ added to a list, which in the end is returned." (filter fun (rest seq))) (filter fun (rest seq))))) +(defun zip (l1 l2) + (if (and (nil? l1) (nil? l2)) + nil + (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2))))) + (defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args) "A wrapper for the built-in (print) that accepts a variable number of arguments and also provides keywords for specifying the printed @@ -208,5 +219,5 @@ las argument." (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args)))) -;; (defmacro pe (@expr) -;; (printf @expr "evaluates to" (eval @expr))) +(defspecial pe (@expr) + (printf @expr "evaluates to" (eval @expr))) diff --git a/bin/test.slime b/bin/test.slime index 274017c..59506ac 100644 --- a/bin/test.slime +++ b/bin/test.slime @@ -1,80 +1,77 @@ -;; (define-syntax defclass (name members :rest functions) -;; (list 'defun (string->symbol (concat-strings "make-" (symbol->string name))) - - -;; )) - -;; (defclass vector3 (x y z) -;; ;; getters and setters will be auto generated - -;; (defun ->length () -;; (** (+ (* x x) (* y y) (* z z)) 0.5)) - -;; (defun ->scale (fac) -;; (mutate x (* fac x)) -;; (mutate y (* fac y)) -;; (mutate z (* fac z))) - -;; ) - -(defun make-vector3 (x-coord y-coord z-coord) - (let ((x x-coord) - (y y-coord) - (z z-coord)) - - (defun ->get-x () x) - (defun ->get-y () y) - (defun ->get-z () z) - (defun ->set-x (new-x) (mutate x new-x)) - (defun ->set-y (new-y) (mutate y new-y)) - (defun ->set-z (new-z) (mutate z new-z)) - - (defun ->length () - (** (+ (* x x) (* y y) (* z z)) 0.5)) - - (defun ->scale (fac) - (mutate x (* fac x)) - (mutate y (* fac y)) - (mutate z (* fac z))) - - (defun ->print () - (print "[vector3] (") - (print x) - (print " ") - (print y) - (print " ") - (print z) - (print ")\n")) - - (defun ->+ (other) - (make-vector - (+ x ((other ->get-x))) - (+ y ((other ->get-y))) - (+ z ((other ->get-z))))) - - (defun ->- (other) - (make-vector - (- x ((other ->get-x))) - (- y ((other ->get-y))) - (- z ((other ->get-z))))) - - (defun ->scalar-product (other) - (+ (* x ((other ->get-x))) - (* y ((other ->get-y))) - (* z ((other ->get-z))))) - - (defun ->cross-product (other) - (make-vector - (- (* y ((other ->get-z))) (* z ((other ->get-y)))) - (- (* z ((other ->get-x))) (* x ((other ->get-z)))) - (- (* x ((other ->get-y))) (* y ((other ->get-x)))))) - - (special-lambda (message) (eval message)))) +(define-syntax defclass (name members :rest body) + "Macro for creatating classes." + (defun underscore (sym) + (string->symbol (concat-strings "_" (symbol->string sym)))) + + (define underscored-members (map underscore members)) + + ;; the wrapping let environment + (define let-body (list 'let (zip members underscored-members))) + + ;; the body + (map (lambda (fun) (append let-body fun)) body) + + ;; the dispatch function + (append let-body (list 'special-lambda '(message :rest args) + "This is the docs for the handle" + '(eval (extend (list message) args)))) + + + ;; stuff it all in the constructor function + (eval (list 'defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members + "This is the handle to an object of the class " + let-body))) + +;; (v1 print) +;; (v1 length) +;; (v1 get-x) +;; (v1 set-x 10) + +(defclass vector3 (x y z) + (defun get-x () x) + (defun get-y () y) + (defun get-z () z) + + (defun set-x (new-x) (mutate x new-x)) + (defun set-y (new-y) (mutate y new-y)) + (defun set-z (new-z) (mutate z new-z)) + + (defun length () + (** (+ (* x x) (* y y) (* z z)) 0.5)) + + (defun scale (fac) + (mutate x (* fac x)) + (mutate y (* fac y)) + (mutate z (* fac z)) + fac) + + (defun add (other) + (make-vector3 + (+ x (other get-x)) + (+ y (other get-y)) + (+ z (other get-z)))) + + (defun subtract (other) + (make-vector3 + (- x (other get-x)) + (- y (other get-y)) + (- z (other get-z)))) + + (defun scalar-product (other) + (+ (* x (other get-x)) + (* y (other get-y)) + (* z (other get-z)))) + + (defun cross-product (other) + (make-vector3 + (- (* y (other get-z)) (* z (other get-y))) + (- (* z (other get-x)) (* x (other get-z))) + (- (* x (other get-y)) (* y (other get-x))))) + + (defun printout () + (printf "[vector3] (" x y z ")")) + ) (define v1 (make-vector3 1 2 3)) (define v2 (make-vector3 3 2 1)) -(print ((v1 ->length))) -(print ((v2 ->length))) - -(read " ") diff --git a/build.bat b/build.bat index c9a9b48..3799856 100644 --- a/build.bat +++ b/build.bat @@ -11,7 +11,7 @@ pushd build taskkill /F /IM %exeName% > NUL 2> NUL echo ---------- Compiling ---------- -call timecmd cl ../src/main.cpp /Fe%exeName% /D_DEBUG /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib +call timecmd cl ../src/main.cpp /std:c++latest /Fe%exeName% /D_DEBUG /W3 /Zi /nologo /EHsc /link /NODEFAULTLIB:libucrt libucrtd.lib if %errorlevel% == 0 ( echo. diff --git a/build/slime.exe.dbg b/build/slime.exe.dbg index 37243e2cf2dc5a2dc2a5c86c341d4def7079b94a..e50c7946a5b9e92cc4e0004e2d01add43a7f561f 100644 GIT binary patch literal 614 zcmbtS!Ab)$5RJtOen7!vRq(jjDhfSx4=U}!yO)8I&Bi*CO_n6Ppr`(fAK>r!2|fA+ z&Zt2vY%dNxcuex%n+bV-xH;|#A@&IegzE`hxl+Rnqmcy!gO!E??GByI2;~H7@0MOx z)Ne5~(hNgvN_5aFh|ZY+RUkS#&qf#7`0{jo256OO$n?IkDx$N}kdt^Ftf##`Ga+^f z95E;SDTq*gGc(=BdCW+_$$K3xJd#kvTXp>loRetxG Y`<1*$oIeTs@g$a>E^V{bRDVzO0c41rj{pDw literal 686 zcmbu7&q@O^5XR$Q(36iKdX>f2TA_#bpk+PuAn0*G(rmgN$R;7lF6hap=)q_3<{NnS znZ!xAK|C%Ed@vb?-#7Wl>vDR&%NRQ%U6AfZaBB()IR?e&@WhpRT%w)o619XGdJA4* zC1H;GnC7E`^dVb!cj%UriV;|6O2;djY|z(So%&E0XrK`gj8PscPi1eA^@dsh=CXeU zsD-M@dQoc;&}goR#8wYKV|~Eb9@YD#XmL;4$|Ag2`5YX_;0g8bB#$9=$wS02$~KHZ zVR#BdwqdBhFuW5Woii>I)+XH9rl955TMs%Db(47c$zt-p;iV0)JM$W@5|FXC$w$nR jP6Bp*vgOXpMEv^v9next_index == arraylist->length) { \ -// arraylist->length *= 2; \ -// arraylist->data = \ -// (type*)realloc(arraylist->data, arraylist->length * sizeof(type)); \ -// } \ -// arraylist->data[arraylist->next_index++] = element; \ -// } \ -// \ -// \ -// name##_Array_List* create_##name##_array_list(int initial_capacity) { \ -// name##_Array_List* ret = new(name##_Array_List); \ -// ret->data = (type*)malloc(initial_capacity * sizeof(type)); \ -// ret->next_index = 0; \ -// ret->length = initial_capacity; \ -// return ret; \ -// } - define_array_list(Ast_Node*, Ast_Node); enum struct Ast_Node_Type { @@ -73,8 +47,8 @@ struct String { }; struct Pair { - struct Ast_Node* first; - struct Ast_Node* rest; + Ast_Node* first; + Ast_Node* rest; }; struct Positional_Arguments { @@ -87,17 +61,14 @@ struct Positional_Arguments { struct Keyword_Arguments { char** identifiers; - // values[i] will be nullptr if no defalut value was declared for - // key identifiers[i] + // NOTE(Felix): values[i] will be nullptr if no defalut value was + // declared for key identifiers[i] Ast_Node_Array_List* values; int next_index; int length; }; -/* Ast_Node_Array_List* create_Ast_Node_Array_List(int initial_length); */ -/* void append_to_Ast_Node_Array_List(Ast_Node_Array_List* list, struct Ast_Node* node); */ - Positional_Arguments* create_positional_argument_list(int initial_capacity) { Positional_Arguments* ret = new(Positional_Arguments); ret->identifiers = (char**)malloc(initial_capacity * sizeof(char*)); @@ -138,8 +109,14 @@ void append_to_keyword_argument_list(Keyword_Arguments* args, struct Environment; +enum struct Function_Type { + Lambda, + Special_Lambda, + Macro +}; + struct Function { - bool is_special_form; + Function_Type type; char* docstring; Positional_Arguments* positional_arguments; Keyword_Arguments* keyword_arguments; diff --git a/src/built_ins.cpp b/src/built_ins.cpp index c0fd3fe..018b417 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -450,6 +450,67 @@ void load_built_ins_into_environment(Environment* env) { return arguments->value.pair->first; }); + defun("quasiquote", cLambda { + try { + arguments_length = list_length(arguments); + } + + if (arguments_length != 1) { + report_error(Error_Type::Wrong_Number_Of_Arguments); + } + // print(arguments); + // printf("\n"); + + // recursive lambdas in lambdas yay!! + std::function unquoteSomeExpressions; + unquoteSomeExpressions = [&unquoteSomeExpressions, &env] (Ast_Node* expr) -> Ast_Node* { + // if it is an atom, return it + if (expr->type != Ast_Node_Type::Pair) + return copy_ast_node(expr); + + // it is a pair! + Ast_Node* originalPair = expr->value.pair->first; + if (originalPair->type == Ast_Node_Type::Symbol && + string_equal(originalPair->value.symbol->identifier, "unquote")) + { + // eval replace the stuff + return eval_expr(expr->value.pair->rest->value.pair->first, env); + } + + // it is a list but not starting with the symbol + // unquote, so search in there for stuff to unquote. + // While copying the list + + //NOTE(Felix): Of fucking course we have to copy the + // list. The quasiquote will be part of the body of a + // funciton, we can't jsut modify it because otherwise + // we modify the body of the function and would bake + // in the result... + Ast_Node* newPair = create_ast_node_pair(nullptr, nullptr); + Ast_Node* newPairHead = newPair; + Ast_Node* head = expr; + while (head->type == Ast_Node_Type::Pair) { + newPairHead->value.pair->first = unquoteSomeExpressions(head->value.pair->first); + + if (head->value.pair->rest->type != Ast_Node_Type::Pair) + break; + + newPairHead->value.pair->rest = create_ast_node_pair(nullptr, nullptr); + + newPairHead = newPairHead->value.pair->rest; + head = head->value.pair->rest; + } + newPairHead->value.pair->rest = create_ast_node_nil(); + + return newPair; + }; + + Ast_Node* ret = arguments->value.pair->first; + Ast_Node* head = ret; + + ret = unquoteSomeExpressions(ret); + return ret; + }); defun("and", cLambda { bool result = true; while (arguments->type != Ast_Node_Type::Nil) { @@ -596,7 +657,7 @@ void load_built_ins_into_environment(Environment* env) { Function* function = new(Function); function->parent_environment = env; - function->is_special_form = false; + function->type = Function_Type::Lambda; // if parameters were specified if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { @@ -646,7 +707,7 @@ void load_built_ins_into_environment(Environment* env) { Function* function = new(Function); function->parent_environment = env; - function->is_special_form = true; + function->type = Function_Type::Special_Lambda; // if parameters were specified if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { @@ -726,11 +787,6 @@ void load_built_ins_into_environment(Environment* env) { 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 (list_length(evaluated_arguments) != 2) { if (arguments_length != 2) { report_error(Error_Type::Wrong_Number_Of_Arguments); } @@ -776,9 +832,14 @@ void load_built_ins_into_environment(Environment* env) { 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_special_form) - return create_ast_node_keyword("dynamic-macro"); - return create_ast_node_keyword("dynamic-function"); + Function* fun = evaluated_arguments->value.pair->first->value.function; + if (fun->type == Function_Type::Lambda) + return create_ast_node_keyword("lambda"); + else if (fun->type == Function_Type::Special_Lambda) + return create_ast_node_keyword("special-lambda"); + else if (fun->type == Function_Type::Macro) + return create_ast_node_keyword("macro"); + else return create_ast_node_keyword("unknown"); } case Ast_Node_Type::Keyword: return create_ast_node_keyword("keyword"); case Ast_Node_Type::Nil: return create_ast_node_keyword("nil"); @@ -810,15 +871,16 @@ void load_built_ins_into_environment(Environment* 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 + printf("\n\n"); + + // TODO(Felix): Maybe don't compare strings here?? Wtf if (type->type == Ast_Node_Type::Keyword && - (string_equal(type->value.keyword->identifier, "dynamic-function") || - string_equal(type->value.keyword->identifier, "dynamic-macro"))) + (string_equal(type->value.keyword->identifier, "lambda") || + string_equal(type->value.keyword->identifier, "special-lambda") || + string_equal(type->value.keyword->identifier, "macro"))) { Ast_Node* fun = eval_expr(arguments->value.pair->first, env); - printf("\nspecial-lambda? %s\n", (fun->value.function->is_special_form) ? "yes" : "no"); + if (fun->value.function->docstring) printf("Docstring:\n==========\n%s\n\n", fun->value.function->docstring); else @@ -914,9 +976,9 @@ void load_built_ins_into_environment(Environment* env) { }); defun("break", cLambda { print_environment(env); -#ifdef _DEBUG - __debugbreak(); -#endif + if_debug { + __debugbreak(); + } return create_ast_node_nil(); }); defun("try", cLambda { @@ -961,6 +1023,9 @@ void load_built_ins_into_environment(Environment* env) { }); defun("copy", cLambda { + + // TODO(Felix): if we are copying string nodes, then + // shouldn't the string itself also get copied?? try { evaluated_arguments = eval_arguments(arguments, env, &arguments_length); } @@ -990,6 +1055,83 @@ void load_built_ins_into_environment(Environment* env) { report_error(Error_Type::Unknown_Error); }); + defun("string->symbol", cLambda { + + // TODO(Felix): do some sanity checks on the string. For + // example, numbers are not valid symbols. + + try { + evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + } + + if (arguments_length != 1) { + report_error(Error_Type::Wrong_Number_Of_Arguments); + } + + Ast_Node* source = evaluated_arguments->value.pair->first; + + if (source->type != Ast_Node_Type::String) { + report_error(Error_Type::Type_Missmatch); + } + + return create_ast_node_symbol(_strdup(source->value.string->value)); + }); + defun("symbol->string", cLambda { + try { + evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + } + + if (arguments_length != 1) { + report_error(Error_Type::Wrong_Number_Of_Arguments); + } + + Ast_Node* source = evaluated_arguments->value.pair->first; + + if (source->type != Ast_Node_Type::Symbol) { + report_error(Error_Type::Type_Missmatch); + } + + // TODO(Felix): this is not really fast what we are doing here: + return create_ast_node_string(_strdup(source->value.symbol->identifier), (int)strlen(source->value.symbol->identifier)); + }); + defun("concat-strings", cLambda { + try { + evaluated_arguments = eval_arguments(arguments, env, &arguments_length); + } + + if (arguments_length < 1) { + report_error(Error_Type::Wrong_Number_Of_Arguments); + } + + int resulting_string_len = 0; + + Ast_Node* head = evaluated_arguments; + + while (head->type == Ast_Node_Type::Pair) { + try { + assert_type(head->value.pair->first, Ast_Node_Type::String); + } + resulting_string_len += head->value.pair->first->value.string->length; + + head = head->value.pair->rest; + } + + head = evaluated_arguments; + + char* resulting_string = (char*)malloc(resulting_string_len * sizeof(char)) + 1; + int index_in_string = 0; + + while (head->type == Ast_Node_Type::Pair) { + strcpy(resulting_string+index_in_string, head->value.pair->first->value.string->value); + index_in_string += head->value.pair->first->value.string->length; + head = head->value.pair->rest; + } + + resulting_string[index_in_string] = '\0'; + + return create_ast_node_string(resulting_string, resulting_string_len); + }); + #undef report_error #undef cLambda } diff --git a/src/env.cpp b/src/env.cpp index 6219798..e3205a2 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -75,7 +75,7 @@ Ast_Node* lookup_symbol(Ast_Node* node, Environment* env) { } create_error(Error_Type::Symbol_Not_Defined, node->sourceCodeLocation); - /* printf("%s\n", sym->identifier); */ + printf("%s\n", sym->identifier); return nullptr; } void print_indent(int indent) { diff --git a/src/error.cpp b/src/error.cpp index e692587..4d9d051 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -52,6 +52,6 @@ char* Error_Type_to_string(Error_Type type) { case Error_Type::Unexpected_Eof: return "Parsing-error: Unexpected EOF"; case Error_Type::Unknown_Keyword_Argument: return "Evaluation-error: Unknown keyword argument"; case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments"; - default: return "Unknown Error"; + default: return "Unknown Error"; } } diff --git a/src/eval.cpp b/src/eval.cpp index c7b8417..c0228df 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -13,17 +13,17 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) { 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); + + if (arguments->type == Ast_Node_Type::Nil) + goto checks; // 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 @@ -85,7 +85,7 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) { } } - + checks: // 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]; @@ -135,14 +135,14 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function) { } } - eval_time: { - Ast_Node* result; - try { - result = eval_expr(function->body, new_env); - } - return result; + Ast_Node* result; + try { + result = eval_expr(function->body, new_env); } + + return result; + } /* @@ -397,9 +397,11 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) { return result; } - // check for list function + // check for lisp function if (lispOperator->type == Ast_Node_Type::Function) { - if (!lispOperator->value.function->is_special_form) { + // only for lambdas we evaluate the arguments before + // apllying + if (lispOperator->value.function->type == Function_Type::Lambda) { try { arguments = eval_arguments(arguments, env, &arguments_length); } @@ -413,9 +415,6 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) { } } default: { -#ifdef _DEBUG - __debugbreak(); -#endif report_error(Error_Type::Not_A_Function); } } diff --git a/src/helpers.cpp b/src/helpers.cpp index ad0a545..0559b9a 100644 --- a/src/helpers.cpp +++ b/src/helpers.cpp @@ -1,14 +1,22 @@ #define new(type) new type -#define nullptr NULL #ifdef _DEBUG -#define assert(cond) \ - if (!cond) \ - __debugbreak(); +constexpr bool is_debug_build = true; #else -#define assert(cond) +constexpr bool is_debug_build = false; #endif +#define if_debug if constexpr (is_debug_build) + +#define assert(cond) \ + if_debug { \ + if (!cond) { \ + printf("Assertion failed: %s %d", __FILE__, __LINE__); \ + __debugbreak(); \ + } \ + } else {} \ + + #define concat_( a, b) a##b #define label(prefix, lnum) concat_(prefix,lnum) #define try \ @@ -62,7 +70,6 @@ define_array_list(char*, String); - // int string_equal(char* a, char* b) { // return !strcmp(a, b); // } diff --git a/src/io.cpp b/src/io.cpp index 0a8c51a..dd8eb41 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -50,7 +50,7 @@ void print(Ast_Node* node) { printf("%f", node->value.number->value); } break; case (Ast_Node_Type::String): { - printf("%s", node->value.string->value); + printf("\"%s\"", node->value.string->value); } break; case (Ast_Node_Type::Symbol): { printf("%s", node->value.symbol->identifier); @@ -59,10 +59,14 @@ void print(Ast_Node* node) { printf(":%s", node->value.keyword->identifier); } break; case (Ast_Node_Type::Function): { - if (node->value.function->is_special_form) + if (node->value.function->type == Function_Type::Lambda) + printf("[lambda]"); + else if (node->value.function->type == Function_Type::Special_Lambda) printf("[special-lambda]"); + else if (node->value.function->type == Function_Type::Macro) + printf("[macro]"); else - printf("[lambda]"); + assert(false); } break; case (Ast_Node_Type::CFunction): { printf("[C-function]"); @@ -94,6 +98,67 @@ void print(Ast_Node* node) { } } +// XXX(Felix): obv code dublicate +void fprint(FILE* f, Ast_Node* node) { + switch (node->type) { + case (Ast_Node_Type::Nil): { + fprintf(f, "nil"); + } break; + case (Ast_Node_Type::T): { + fprintf(f, "t"); + } break; + case (Ast_Node_Type::Number): { + fprintf(f, "%f", node->value.number->value); + } break; + case (Ast_Node_Type::String): { + fprintf(f, "\"%s\"", node->value.string->value); + } break; + case (Ast_Node_Type::Symbol): { + fprintf(f, "%s", node->value.symbol->identifier); + } break; + case (Ast_Node_Type::Keyword): { + fprintf(f, ":%s", node->value.keyword->identifier); + } break; + case (Ast_Node_Type::Function): { + if (node->value.function->type == Function_Type::Lambda) + fprintf(f, "[lambda]"); + else if (node->value.function->type == Function_Type::Special_Lambda) + fprintf(f, "[special-lambda]"); + else if (node->value.function->type == Function_Type::Macro) + fprintf(f, "[macro]"); + else + assert(false); + } break; + case (Ast_Node_Type::CFunction): { + fprintf(f, "[C-function]"); + } break; + case (Ast_Node_Type::Pair): { + Ast_Node* head = node; + fprintf(f, "("); + + // NOTE(Felix): We cold do a while true here, however in case + // we want to print a broken list (for logging the error) we + // should do mo checks. + while (head) { + fprint(f, head->value.pair->first); + head = head->value.pair->rest; + if (!head) + return; + if (head->type != Ast_Node_Type::Pair) + break; + fprintf(f, " "); + } + + if (head->type != Ast_Node_Type::Nil) { + fprintf(f, " . "); + print(head); + } + + fprintf(f, ")"); + } break; + } +} + void print_error_location() { if (error->location) { printf("%s (line %d, position %d)", diff --git a/src/main.cpp b/src/main.cpp index 77b5b15..62a65b9 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -52,12 +52,13 @@ Ast_Node* interprete_file (char* file_name) { int interprete_stdin () { printf("Welcome to the lispy interpreter.\n"); char* line; - Environment* env = create_empty_environment(); - load_built_ins_into_environment(env); + Environment* env = create_built_ins_environment(); Parser::init(env); built_in_load("pre.slime", env); + built_in_load("test.slime", env); + if (error) { log_error(); delete_error(); diff --git a/src/parse.cpp b/src/parse.cpp index f74cdf7..814234b 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -1,8 +1,8 @@ // forward decls -- start void load_built_ins_into_environment(Environment*); -int list_length(Ast_Node*); -void parse_argument_list(Ast_Node*, Function*); Ast_Node* eval_expr(Ast_Node*, Environment*); +void parse_argument_list(Ast_Node*, Function*); +int list_length(Ast_Node*); // forward decls -- end @@ -18,16 +18,16 @@ namespace Parser { int parser_line; int parser_col; - // NOTE(Felix): In this environment, the build in vunctions will + // NOTE(Felix): In this environment, the build in functions will // be loaded, and the macros will be stroed in form of // special-lambdas, that get executed in this environment at - // read-time + // read-time. This should always be the global environment. Environment* environment_for_macros; void init(Environment* env) { - // if we already initialized it, then skip - if (environment_for_macros) - return; + // 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. // NOTE(Felix): For now we just allow executing built-ins at // read-time (while creating macros). If later we want to @@ -148,6 +148,10 @@ namespace Parser { *str = '\0'; Ast_Node* ret = create_ast_node_string(str, 0); inject_scl(ret); + + // plus one because we want to go after the quotes + *index_in_text += 1; + return ret; } @@ -219,11 +223,19 @@ namespace Parser { Ast_Node* parse_expression(char* text, int* index_in_text) { // if it is quoted - if (text[*index_in_text] == '\'') { + if (text[*index_in_text] == '\'' || + text[*index_in_text] == '`' || + text[*index_in_text] == ',') + { + char quoteType = text[*index_in_text]; ++(*index_in_text); ++parser_col; Ast_Node* result; - if (text[*index_in_text] == '(' || text[*index_in_text] == '\'' ) { + if (text[*index_in_text] == '(' || + text[*index_in_text] == '\'' || + text[*index_in_text] == '`' || + text[*index_in_text] == ',') + { try { result = parse_expression(text, index_in_text); } @@ -232,11 +244,22 @@ namespace Parser { result = parse_atom(text, index_in_text); } } + + if (quoteType == '\'') + return create_ast_node_pair( + create_ast_node_symbol("quote"), + create_ast_node_pair(result, create_ast_node_nil())); + else if (quoteType == '`') + return create_ast_node_pair( + create_ast_node_symbol("quasiquote"), + create_ast_node_pair(result, create_ast_node_nil())); + // it has to be an unquote return create_ast_node_pair( - create_ast_node_symbol("quote"), + create_ast_node_symbol("unquote"), create_ast_node_pair(result, create_ast_node_nil())); } + // if it is not quoted ++(*index_in_text); ++parser_col; @@ -258,7 +281,11 @@ namespace Parser { Ast_Node* expression = head; while (true) { - if (text[(*index_in_text)] == '(' || text[(*index_in_text)] == '\'' ) { + if (text[*index_in_text] == '(' || + text[*index_in_text] == '\''|| + text[*index_in_text] == '`' || + text[*index_in_text] == ',') + { try { head->value.pair->first = parse_expression(text, index_in_text); } @@ -333,7 +360,7 @@ namespace Parser { Function* function = new(Function); function->parent_environment = environment_for_macros; - function->is_special_form = true; + function->type = Function_Type::Macro; // if parameters were specified if (arguments->value.pair->first->type != Ast_Node_Type::Nil) { @@ -393,14 +420,20 @@ namespace Parser { for (int i = 0; i < environment_for_macros->next_index; ++i) { if (string_equal(expression->value.pair->first->value.symbol->identifier, environment_for_macros->keys[i]) && - environment_for_macros->values[i]->type == Ast_Node_Type::Function) + environment_for_macros->values[i]->type == Ast_Node_Type::Function && + environment_for_macros->values[i]->value.function->type == Function_Type::Macro) { - // every `Function` that is defined in this - // environment _has_ to be a macro because - // only built_ins are in there otherwise, - // which are `CFunction`s. try { + // if (string_equal(environment_for_macros->keys[i], "when")) { + // printf("invoking macro for %s in %s:%d to:\n\t", environment_for_macros->keys[i], parser_file, parser_line); + // print(environment_for_macros->values[i]->value.function->body); + // } expression = eval_expr(expression, environment_for_macros); + // if (string_equal(environment_for_macros->keys[i], "when")) { + // printf("\nresult: \n\t"); + // print(expression); + // printf("\n\n"); + // } } } } @@ -421,10 +454,15 @@ namespace Parser { eat_until_code(text, &index_in_text); if (text[(index_in_text)] == '\0') return create_ast_node_nil(); - if (text[(index_in_text)] == '(' || text[(index_in_text)] == '\'' ) + if (text[index_in_text] == '(' || + text[index_in_text] == '\'' || + text[index_in_text] == '`' || + text[index_in_text] == ',') + { try { result = parse_expression(text, &index_in_text); } + } else try { result = parse_atom(text, &index_in_text); @@ -436,6 +474,29 @@ namespace Parser { return nullptr; } + void write_expanded_file(char* file_name, Ast_Node_Array_List* program) { + char* ext = ".expanded"; + char* newName = (char*)calloc(4 + strlen(file_name), sizeof(char)); + strcpy(newName, file_name); + strcat(newName, ext); + + FILE *f = fopen(newName, "w"); + if (f == NULL) { + printf("Error opening file!\n"); + exit(1); + } + + for (int i = 0; i < program->next_index; ++i) { + // a macro will parse as nil for now, so we skip those + if (program->data[i]->type == Ast_Node_Type::Nil) + continue; + fprint(f, program->data[i]); + fprintf(f, "\n\n"); + } + + fclose(f); + } + Ast_Node_Array_List* parse_program(char* file_name, char* text) { parser_file = (char*)malloc(strlen(file_name) * sizeof(char) + 1); strcpy(parser_file, file_name); @@ -468,6 +529,9 @@ namespace Parser { return nullptr; } } + + write_expanded_file(file_name, program); + return program; } diff --git a/vs/slime.vcxproj b/vs/slime.vcxproj index cd4d45a..c0c20d0 100644 --- a/vs/slime.vcxproj +++ b/vs/slime.vcxproj @@ -122,7 +122,8 @@ Level3 Disabled true - CompileAsC + Default + stdcpplatest true @@ -134,6 +135,7 @@ Disabled true CompileAsC + stdcpplatest true @@ -159,12 +161,13 @@ true true true - CompileAsC + Default + stdcpplatest true true - Windows + NotSet @@ -173,4 +176,4 @@ - + \ No newline at end of file