diff --git a/bin/pre.slime b/bin/pre.slime index c815b44..e04e0f2 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -127,11 +127,13 @@ by the key 'from' and ends with the number defined in 'to'." (defun range-while (:keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined by the key 'from' and ends with the number defined in 'to'." - (define result (list from)) + (define result (list (copy from))) + (define head result) (mutate from (incr from)) (while (< from to) (prog - (append result (copy from)) + (mutate head (pair (first head) (pair (copy from) nil))) + (define head (rest head)) (mutate from (incr from)))) result) diff --git a/bin/test.slime b/bin/test.slime index 053a891..c8c55d5 100644 --- a/bin/test.slime +++ b/bin/test.slime @@ -1,4 +1,4 @@ -(when 1 (breakpoint)) +;; (when 1 (breakpoint)) ;; (if (eval 1) ;; (apply prog ((breakpoint))) @@ -7,3 +7,9 @@ ;; (if (eval 1) ;; (eval (pair prog ((breakpoint))))) ;; nil)) + + +(defun ! (n) + (if (< n 2) + 1 + (* n (! (- 1 n))))) diff --git a/build/slime.exe.dbg b/build/slime.exe.dbg index d5b5597..ace130a 100644 Binary files a/build/slime.exe.dbg and b/build/slime.exe.dbg differ diff --git a/src/ast.c b/src/ast.c index 90085c1..389c3ee 100644 --- a/src/ast.c +++ b/src/ast.c @@ -126,6 +126,7 @@ typedef enum { Built_In_Addition, Built_In_And, Built_In_Breakpoint, + Built_In_Copy, Built_In_Define, Built_In_Division, Built_In_Equal, @@ -169,6 +170,7 @@ char* Built_In_Name_to_string(Built_In_Name 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 "="; @@ -294,6 +296,7 @@ Ast_Node* create_ast_node_built_in_function(char* name) { 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; @@ -337,3 +340,9 @@ Ast_Node* create_ast_node_pair(Ast_Node* first, Ast_Node* rest) { node->value.pair->rest = rest; return node; } + +Ast_Node* copy_ast_node(Ast_Node* n) { + Ast_Node* target = new(Ast_Node); + *target = *n; + return target; +} diff --git a/src/env.c b/src/env.c index 791228b..b1f7c59 100644 --- a/src/env.c +++ b/src/env.c @@ -6,10 +6,10 @@ typedef enum { struct Environment { struct Environment* parent; - Environment_Type type; + Environment_Type type; - int capacity; - int next_index; + int capacity; + int next_index; // TODO(Felix): Use a hashmap here. char** keys; Ast_Node** values; @@ -22,12 +22,12 @@ Environment* create_child_environment(Environment* parent, Environment_Type type int start_capacity = 16; - env->type = type; - env->parent = parent; + env->type = type; + env->parent = parent; env->capacity = start_capacity; env->next_index = 0; - env->keys = (char**)malloc(start_capacity * sizeof(char*)); - env->values = (Ast_Node**)malloc(start_capacity * sizeof(Ast_Node*)); + env->keys = (char**)malloc(start_capacity * sizeof(char*)); + env->values = (Ast_Node**)malloc(start_capacity * sizeof(Ast_Node*)); return env; } @@ -38,12 +38,12 @@ Environment* create_empty_environment(Environment_Type type) { void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) { if (env->type == Environment_Type_Macro) { - // NOTE(Felix): we know we have a parent because every - // environment has a parent except the top level environment. - // However the top level environment is not a let-environment, - // so we would not land here - define_symbol(symbol, value, env->parent); - return; + // NOTE(Felix): we know we have a parent because every + // environment has a parent except the top level environment. + // However the top level environment is not a let-environment, + // so we would not land here + define_symbol(symbol, value, env->parent); + return; } // NOTE(Felix): right now we are simply adding the symol at the @@ -52,9 +52,9 @@ void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) { // latest defined one first, but a bit messy. Later we should use // a hashmap here. @refactor if (env->next_index == env->capacity) { - env->capacity *= 2; - env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*)); - env->values = (Ast_Node**)realloc(env->values, env->capacity * sizeof(Ast_Node*)); + env->capacity *= 2; + env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*)); + env->values = (Ast_Node**)realloc(env->values, env->capacity * sizeof(Ast_Node*)); } env->keys [env->next_index] = symbol->value.symbol->identifier; @@ -64,8 +64,8 @@ void define_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) { void define_macro_symbol(Ast_Node* symbol, Ast_Node* value, Environment* env) { if (env->type != Environment_Type_Macro) { - create_error(Error_Type_Unknown_Error, symbol); - return; + create_error(Error_Type_Unknown_Error, symbol); + return; } env->type = Environment_Type_Lambda; @@ -77,19 +77,19 @@ void print_environment(Environment* env); Ast_Node* lookup_symbol_in_this_envt(Symbol* sym, Environment* env) { for (int i = env->next_index - 1; i >= 0; --i) - if (string_equal(env->keys[i], sym->identifier)) - return env->values[i]; + if (string_equal(env->keys[i], sym->identifier)) + return env->values[i]; return nullptr; } Ast_Node* lookup_symbol_from_lambda_env(Symbol* sym, Environment* env) { Ast_Node* result; do { - if (env->type != Environment_Type_Lambda) { - result = lookup_symbol_in_this_envt(sym, env); - if (result) return result; - } - env = env->parent; + if (env->type != Environment_Type_Lambda) { + result = lookup_symbol_in_this_envt(sym, env); + if (result) return result; + } + env = env->parent; } while (env); return nullptr; } @@ -97,22 +97,22 @@ Ast_Node* lookup_symbol_from_lambda_env(Symbol* sym, Environment* env) { Ast_Node* lookup_symbol_from_let_or_macro_env(Symbol* sym, Environment* env) { Ast_Node* result; do { - result = lookup_symbol_in_this_envt(sym, env); - if (result) return result; - if (env->type == Environment_Type_Lambda) - break; + result = lookup_symbol_in_this_envt(sym, env); + if (result) return result; + if (env->type == Environment_Type_Lambda) + break; - env = env->parent; + env = env->parent; } while (env); if (env) { - do { - if (env->type != Environment_Type_Lambda) { - result = lookup_symbol_in_this_envt(sym, env); - if (result) return result; - } - env = env->parent; - } while (env); + do { + if (env->type != Environment_Type_Lambda) { + result = lookup_symbol_in_this_envt(sym, env); + if (result) return result; + } + env = env->parent; + } while (env); } return nullptr; @@ -123,29 +123,29 @@ Ast_Node* lookup_symbol(Symbol* sym, Environment* env) { Ast_Node* result; result = lookup_symbol_in_this_envt(sym, env); if (result) - return result; + return result; if (env->parent) { - if (env->type == Environment_Type_Lambda) { - result = lookup_symbol_from_lambda_env(sym, env->parent); - } else { - result = lookup_symbol_from_let_or_macro_env(sym, env->parent); - } - - if (result) - return result; + if (env->type == Environment_Type_Lambda) { + result = lookup_symbol_from_lambda_env(sym, env->parent); + } else { + result = lookup_symbol_from_let_or_macro_env(sym, env->parent); + } + + if (result) + return result; } if (string_equal(sym->identifier, "nil")) { - return create_ast_node_nil(); + return create_ast_node_nil(); } if (string_equal(sym->identifier, "t")) { - return create_ast_node_t(); + return create_ast_node_t(); } result = create_ast_node_built_in_function(sym->identifier); if (result) - return result; + return result; create_error(Error_Type_Symbol_Not_Defined, create_ast_node_nil()); /* printf("%s\n", sym->identifier); */ @@ -153,28 +153,28 @@ Ast_Node* lookup_symbol(Symbol* sym, Environment* env) { } void print_indent(int indent) { for (int i = 0; i < indent; ++i) { - printf(" "); + printf(" "); } } void print_environment_indent(Environment* env, int indent) { for (int i = 0; i < env->next_index; ++i) { - print_indent(indent); - printf("%s -> ", env->keys[i]); - print(env->values[i]); - printf("\n"); + print_indent(indent); + printf("%s -> ", env->keys[i]); + print(env->values[i]); + printf("\n"); } if (env->parent) { - print_indent(indent); - printf("parent"); - if (env->parent->type == Environment_Type_Lambda) - printf(" (lambda)"); - else if (env->parent->type == Environment_Type_Macro) - printf(" (macro)"); - else if (env->parent->type == Environment_Type_Let) - printf(" (let)"); - printf(":\n"); - print_environment_indent(env->parent, indent+4); + print_indent(indent); + printf("parent"); + if (env->parent->type == Environment_Type_Lambda) + printf(" (lambda)"); + else if (env->parent->type == Environment_Type_Macro) + printf(" (macro)"); + else if (env->parent->type == Environment_Type_Let) + printf(" (let)"); + printf(":\n"); + print_environment_indent(env->parent, indent+4); } } diff --git a/src/eval.c b/src/eval.c index bb3d80a..97b0089 100644 --- a/src/eval.c +++ b/src/eval.c @@ -77,7 +77,8 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, E // 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); + arguments->value.pair->rest->value.pair->first, + new_env); append_to_String_array_list(read_in_keywords, arguments->value.pair->first->value.keyword->identifier); @@ -115,7 +116,7 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, E if (!was_set) { define_symbol( create_ast_node_symbol(defined_keyword), - function->keyword_arguments->values->data[i], new_env); + copy_ast_node(function->keyword_arguments->values->data[i]), new_env); } } } @@ -151,7 +152,6 @@ Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, E result = eval_expr(function->body, new_env); } - free(new_env); return result; } } @@ -456,8 +456,18 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) { 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"); @@ -808,6 +818,22 @@ Ast_Node* eval_expr(Ast_Node* node, Environment* env) { *target = *source; return target; } + case Built_In_Copy: { + 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; + } case Built_In_Load: { if (arguments_length != 1) report_error(Error_Type_Wrong_Number_Of_Arguments);