From e225caea002b83e8dd147e41eab913b82a5f0c60 Mon Sep 17 00:00:00 2001 From: Alex Kotov Date: Sun, 7 May 2023 17:28:45 +0400 Subject: [PATCH] syntax "define" --- src/eval.c | 57 +++++++++++++++++++++++++++++++++--------------- src/eval.h | 4 ++-- src/main.c | 20 +++++++++++------ src/syntax.c | 48 ++++++++++++++++++++++++++++++++-------- src/syntax.h | 7 +++--- tests/syntax.scm | 15 +++++++++++++ 6 files changed, 112 insertions(+), 39 deletions(-) diff --git a/src/eval.c b/src/eval.c index 3adc3f2..4fe2241 100644 --- a/src/eval.c +++ b/src/eval.c @@ -11,10 +11,15 @@ static struct Object *lookup(struct Object *namespace, struct Object *name); -static struct Object *eval_list(struct Object *object); +static struct Object *eval_list( + struct Object *object, + struct Object *environment +); -struct Object *eval_str(const char *const str) -{ +struct Object *eval_str( + const char *const str, + struct Object *const environment +) { assert(str); Tokens tokens = Tokens_new(); @@ -34,16 +39,21 @@ struct Object *eval_str(const char *const str) struct Object *const program = parse(tokens); TOKENS_DELETE(tokens); - return eval(program); + return eval(program, environment); } -struct Object *eval(struct Object *const object) -{ +struct Object *eval( + struct Object *const object, + struct Object *const environment +) { + assert(Object_is_pair(environment)); + assert(OBJECT_IS_NULL(environment->pair.cdr)); + // NULL is an empty list, can't eval - assert(object); + assert(!OBJECT_IS_NULL(object)); // SYMBOL performs lookup - if (Object_is_symbol(object)) return lookup(NULL, object); + if (Object_is_symbol(object)) return lookup(environment->pair.car, object); // Almost everything evaluates to itself if (!Object_is_pair(object)) return object; @@ -52,19 +62,30 @@ struct Object *eval(struct Object *const object) struct Object *const args = object->pair.cdr; if (Object_is_symbol(func_expr)) { - if (strcmp(func_expr->s, "begin") == 0) return syntax_begin(args); - if (strcmp(func_expr->s, "quote") == 0) return syntax_quote(args); - if (strcmp(func_expr->s, "if") == 0) return syntax_if(args); + if (strcmp(func_expr->s, "begin") == 0) { + return syntax_begin(args, environment); + } + if (strcmp(func_expr->s, "define") == 0) { + return syntax_define(args, environment); + } + if (strcmp(func_expr->s, "quote") == 0) { + return syntax_quote(args, environment); + } + if (strcmp(func_expr->s, "if") == 0) { + return syntax_if(args, environment); + } } - struct Object *const func = eval(func_expr); + struct Object *const func = eval(func_expr, environment); assert(Object_is_procedure(func)); - struct Object *const evaluated_args = eval_list(args); + struct Object *const evaluated_args = eval_list(args, environment); return Object_procedure_call(func, evaluated_args); } -struct Object *eval_list(struct Object *const object) -{ +struct Object *eval_list( + struct Object *const object, + struct Object *const environment +) { assert(OBJECT_IS_LIST_HEAD(object)); if (OBJECT_IS_NULL(object)) return NULL; @@ -72,12 +93,12 @@ struct Object *eval_list(struct Object *const object) if (OBJECT_IS_NULL(object->pair.car)) { return Object_new_pair( NULL, - eval_list(object->pair.cdr) + eval_list(object->pair.cdr, environment) ); } else { return Object_new_pair( - eval(object->pair.car), - eval_list(object->pair.cdr) + eval(object->pair.car, environment), + eval_list(object->pair.cdr, environment) ); } } diff --git a/src/eval.h b/src/eval.h index 3e924d6..7cb524a 100644 --- a/src/eval.h +++ b/src/eval.h @@ -3,7 +3,7 @@ #include "object.h" -struct Object *eval_str(const char * str); -struct Object *eval(struct Object *object); +struct Object *eval_str(const char * str, struct Object *environment); +struct Object *eval(struct Object *object, struct Object *environment); #endif diff --git a/src/main.c b/src/main.c index 0c28d9f..082f5a8 100644 --- a/src/main.c +++ b/src/main.c @@ -32,6 +32,8 @@ void repl() { printf("Lisp by Causa Arcana\n\n"); + struct Object *const environment = Object_new_pair(NULL, NULL); + while (true) { Tokens tokens = Tokens_new(); assert(tokens); @@ -60,14 +62,17 @@ void repl() struct Object *const program = parse(tokens); TOKENS_DELETE(tokens); - struct Object *const result = eval(program); + struct Object *const result = eval(program, environment); printf("=> "); - eval(Object_build_list( - 2, - Object_new_symbol("displayln"), - Object_build_list(2, Object_new_symbol("quote"), result) - )); + eval( + Object_build_list( + 2, + Object_new_symbol("displayln"), + Object_build_list(2, Object_new_symbol("quote"), result) + ), + environment + ); } } @@ -92,5 +97,6 @@ void script() struct Object *const program = parse(tokens); TOKENS_DELETE(tokens); - eval(program); + struct Object *const environment = Object_new_pair(NULL, NULL); + eval(program, environment); } diff --git a/src/syntax.c b/src/syntax.c index 58bb845..f3de3e1 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -5,20 +5,46 @@ #include -struct Object *syntax_begin(struct Object *args) -{ +struct Object *syntax_begin( + struct Object *args, + struct Object *const environment +) { assert(OBJECT_IS_LIST_HEAD(args)); struct Object *result = NULL; while (!OBJECT_IS_NULL(args)) { assert(Object_is_pair(args)); - result = eval(args->pair.car); + result = eval(args->pair.car, environment); args = args->pair.cdr; } return result; } -struct Object *syntax_if(struct Object *const args) -{ +struct Object *syntax_define( + struct Object *const args, + struct Object *const environment +) { + assert(Object_is_pair(args)); + struct Object *const name = args->pair.car; + assert(Object_is_symbol(name)); + assert(Object_is_pair(args->pair.cdr)); + struct Object *const value_expr = args->pair.cdr->pair.car; + assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr)); + + assert(Object_is_pair(environment)); + assert(OBJECT_IS_NULL(environment->pair.cdr)); + assert(OBJECT_IS_LIST_HEAD(environment->pair.car)); + environment->pair.car = Object_new_pair( + Object_new_pair(name, eval(value_expr, environment)), + environment->pair.car + ); + + return NULL; +} + +struct Object *syntax_if( + struct Object *const args, + struct Object *const environment +) { assert(Object_is_pair(args)); struct Object *const cond = args->pair.car; struct Object *const then_else_list = args->pair.cdr; @@ -32,14 +58,18 @@ struct Object *syntax_if(struct Object *const args) assert(OBJECT_IS_NULL(else_list->pair.cdr)); if (Object_is_false(cond)) { - return eval(else_branch); + return eval(else_branch, environment); } else { - return eval(then_branch); + return eval(then_branch, environment); } } -struct Object *syntax_quote(struct Object *const args) -{ +struct Object *syntax_quote( + struct Object *const args, + struct Object *const environment +) { + (void)environment; // unused + assert(Object_is_pair(args)); assert(OBJECT_IS_NULL(args->pair.cdr)); return args->pair.car; diff --git a/src/syntax.h b/src/syntax.h index 1bfe67a..fadd85e 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -3,8 +3,9 @@ #include "object.h" -struct Object *syntax_begin(struct Object *args); -struct Object *syntax_if(struct Object *args); -struct Object *syntax_quote(struct Object *args); +struct Object *syntax_begin(struct Object *args, struct Object *environment); +struct Object *syntax_define(struct Object *args, struct Object *environment); +struct Object *syntax_if(struct Object *args, struct Object *environment); +struct Object *syntax_quote(struct Object *args, struct Object *environment); #endif diff --git a/tests/syntax.scm b/tests/syntax.scm index 223dc5e..b0e65eb 100644 --- a/tests/syntax.scm +++ b/tests/syntax.scm @@ -5,6 +5,21 @@ (assert-equal 456 (begin 123 456)) (assert-equal 789 (begin 123 456 789)) + ;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (assert-equal + '(123 579) + (begin + (define x 123) + (define y (+ x 456)) + (list x y))) + (assert-equal + '(123 456) + (begin + (define x 123) + (define old x) + (define x 456) + (list old x))) + ;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-equal 123 (if #true 123 456)) (assert-equal 123 (if "foo" 123 456))