diff --git a/src/eval.c b/src/eval.c index 3f2602e..154062b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -38,6 +38,9 @@ struct Object *eval( if (strcmp(func_expr->s, "begin") == 0) { return syntax_begin(args, environment); } + if (strcmp(func_expr->s, "cond") == 0) { + return syntax_cond(args, environment); + } if (strcmp(func_expr->s, "define") == 0) { return syntax_define(args, environment); } diff --git a/src/syntax.c b/src/syntax.c index 9de72bf..34a2480 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -4,6 +4,7 @@ #include "object.h" #include +#include /******************************************* * Special syntax to use in the executable * @@ -41,6 +42,47 @@ struct Object *syntax_begin( return result; } +struct Object *syntax_cond( + struct Object *const args, + struct Object *const environment +) { + assert(Object_is_pair(environment)); + assert(OBJECT_IS_LIST_HEAD(environment->pair.cdr)); + assert(OBJECT_IS_LIST_HEAD(environment->pair.car)); + + assert(OBJECT_IS_LIST_HEAD(args)); + + for (struct Object *arg = args; !OBJECT_IS_NULL(arg); arg = arg->pair.cdr) + { + assert(Object_is_pair(arg)); + assert(Object_is_pair(arg->pair.car)); + assert(Object_is_pair(arg->pair.car->pair.cdr)); + assert(OBJECT_IS_NULL(arg->pair.car->pair.cdr->pair.cdr)); + + struct Object *const cond_prog = arg->pair.car->pair.car; + + if (Object_is_symbol(cond_prog) && strcmp(cond_prog->s, "else") == 0) { + assert(OBJECT_IS_NULL(arg->pair.cdr)); + } + } + + for (struct Object *arg = args; !OBJECT_IS_NULL(arg); arg = arg->pair.cdr) + { + struct Object *const cond_prog = arg->pair.car->pair.car; + struct Object *const val_prog = arg->pair.car->pair.cdr->pair.car; + + if (Object_is_symbol(cond_prog) && strcmp(cond_prog->s, "else") == 0) { + return eval(val_prog, environment); + } + + if (!Object_is_false(eval(cond_prog, environment))) { + return eval(val_prog, environment); + } + } + + return NULL; +} + struct Object *syntax_define( struct Object *const args, struct Object *const environment diff --git a/src/syntax.h b/src/syntax.h index df23294..8e59d7f 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -15,6 +15,7 @@ struct Object *syntax_script(struct Object *args, struct Object *environment); *******************/ struct Object *syntax_begin(struct Object *args, struct Object *environment); +struct Object *syntax_cond(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_lambda(struct Object *args, struct Object *environment); diff --git a/tests/syntax.scm b/tests/syntax.scm index 24b691e..0db030b 100644 --- a/tests/syntax.scm +++ b/tests/syntax.scm @@ -4,6 +4,17 @@ (assert-equal 456 (begin 123 456)) (assert-equal 789 (begin 123 456 789)) +;;; cond ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal '() (cond)) +(assert-equal '() (cond (#false 123))) +(assert-equal 123 (cond (#true 123))) +(assert-equal '() (cond (#false 123) (#false 456))) +(assert-equal 123 (cond (#true 123) (#true 456))) +(assert-equal 456 (cond (#false 123) (#true 456))) +(assert-equal 123 (cond (#true 123) (#true 456) (else 789))) +(assert-equal 456 (cond (#false 123) (#true 456) (else 789))) +(assert-equal 789 (cond (#false 123) (#false 456) (else 789))) + ;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (assert-equal '(123 579)