add builtin_lambda() that returns a closure and support closures in eval (also much tests)

1 files changed, 379 insertions, 6 deletions

diff --git a/eval.c b/eval.c
index 98c3132..8325c1f 100644
--- a/eval.c
+++ b/eval.c
@@ -251,6 +251,29 @@ struct atom *builtin_define(struct atom *expr, struct env *env)
     return expr_value;
 }
 
+struct atom *builtin_lambda(struct atom *expr, struct env *env)
+{
+    struct list *list = expr->list;
+    struct atom *op = LIST_FIRST(list);
+
+    struct atom *params = CDR(op);
+    struct atom *body = CDR(params);
+
+    if (!params || !body || CDR(body))
+    {
+        printf("error: lambda takes exactly 2 arguments\n");
+        return &nil_atom;
+    }
+
+    if (!IS_LIST(params) && !IS_NIL(params))
+    {
+        printf("error: first arg to lambda must be a list\n");
+        return &nil_atom;
+    }
+
+    return atom_new_closure(params, body, env);
+}
+
 typedef struct atom *(*builtin_function_t)(struct atom *, struct env *);
 
 static struct builtin_function_def
@@ -269,12 +292,49 @@ static struct builtin_function_def
     { "if", &builtin_if },
     { "mod", &builtin_mod },
     { "define", &builtin_define },
+    { "lambda", &builtin_lambda },
 
     { NULL, NULL }
 };
 
+struct atom *eval_closure(struct atom *closure, struct atom *args,
+    struct env *env)
+{
+    struct env *closure_env = closure->closure.env;
+
+    struct atom *param_value = args;
+    struct atom *param_name = CAR(closure->closure.params->list);
+
+    while (param_value && param_name)
+    {
+        struct atom *evaluated_param = eval(param_value, env);
+
+        closure_env = env_extend(closure_env, 1,
+            param_name->str.str, evaluated_param);
+
+        param_value = CDR(param_value);
+        param_name = CDR(param_name);
+    }
+
+    if (param_value && !param_name)
+    {
+        printf("error: incorrect number of arguments\n");
+        return &nil_atom;
+    }
+
+    if (!param_value && param_name)
+    {
+        printf("error: incorrect number of arguments\n");
+        return &nil_atom;
+    }
+
+    return eval(closure->closure.body, closure_env);
+}
+
 struct atom *eval(struct atom *expr, struct env *env)
 {
+    // symbols and not-a-lists are evaluated or returned directly
+
     if (IS_SYM(expr))
     {
         struct atom *atom = env_lookup(env, expr->str.str);
@@ -297,18 +357,50 @@ struct atom *eval(struct atom *expr, struct env *env)
     struct list *list = expr->list;
     struct atom *op = LIST_FIRST(list);
 
-    struct builtin_function_def *def = builtin_function_defs;
-    while (def->name && def->fn)
+    // Check if the first elem is not a symbol or a closure. If it's
+    // not, then we'll evaluate it (it could be a lambda form).
+
+    if (!IS_SYM(op) && !IS_CLOSURE(op))
+    {
+        struct atom *evaluated_op = eval(op, env);
+        // Replace the evaluated one to the list!
+        LIST_REMOVE(op, entries);
+        LIST_INSERT_HEAD(list, evaluated_op, entries);
+        op = evaluated_op;
+    }
+
+    // If the first elem is a symbol, it should be a name for a builtin
+    // function or a closure bound to that name by the user. If the
+    // first argument is directly a closure, eval that with the args.
+
+    if (IS_SYM(op))
     {
-        if (strcmp(op->str.str, def->name) == 0)
+        struct builtin_function_def *def = builtin_function_defs;
+        while (def->name && def->fn)
+        {
+            if (strcmp(op->str.str, def->name) == 0)
+            {
+                return def->fn(expr, env);
+            }
+
+            ++def;
+        }
+
+        struct atom *closure = env_lookup(env, op->str.str);
+
+        if (closure)
         {
-            return def->fn(expr, env);
+            return eval_closure(closure, CDR(op), env);
         }
 
-        ++def;
+        printf("error: unknown function %s\n", op->str.str);
+    }
+    else if (IS_CLOSURE(op))
+    {
+        return eval_closure(op, CDR(op), env);
     }
 
-    printf("error: unknown function %s\n", op->str.str);
+    printf("error: cannot evaluate\n");
 
     return &nil_atom;
 }
@@ -427,4 +519,285 @@ TEST(define_with_val_as_expr)
     ASSERT_EQ(9, atom->l);
 }
 
+TEST(lambda_evaluates_to_closure)
+{
+    struct env *env = env_new();
+    struct atom *result = eval_str("(lambda () 1)", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_CLOSURE(result));
+}
+
+TEST(lambda_closure_keeps_defining_env)
+{
+    struct env *env = env_new();
+
+    env_set(env, "foo", atom_new_int(1));
+    env_set(env, "bar", atom_new_int(2));
+
+    struct atom *result = eval_str("(lambda () 42)", env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_EQ(env, result->closure.env);
+}
+
+TEST(lambda_closure_holds_function)
+{
+    struct env *env = env_new();
+
+    env_set(env, "foo", atom_new_int(1));
+    env_set(env, "bar", atom_new_int(2));
+
+    struct atom *result = eval_str("(lambda (x y) (+ x y))", env);
+
+    struct atom *params = result->closure.params;
+    struct atom *body = result->closure.body;
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(params != NULL);
+    ASSERT_TRUE(body != NULL);
+
+    ASSERT_TRUE(IS_LIST(params));
+
+    ASSERT_TRUE(IS_SYM(CAR(params->list)));
+    ASSERT_STREQ("x", CAR(params->list)->str.str);
+
+    ASSERT_TRUE(IS_SYM(CDR(CAR(params->list))));
+    ASSERT_STREQ("y", CDR(CAR(params->list))->str.str);
+
+    ASSERT_TRUE(IS_LIST(body));
+
+    ASSERT_TRUE(IS_SYM(CAR(body->list)));
+    ASSERT_STREQ("+", CAR(body->list)->str.str);
+}
+
+TEST(lambda_args_are_lists)
+{
+    struct env *env = env_new();
+    ASSERT_FALSE(IS_NIL(eval_str("(lambda () 1)", env)));
+    ASSERT_TRUE(IS_NIL(eval_str("(lambda 1 1)", env)));
+}
+
+TEST(lambda_number_of_arguments)
+{
+    struct env *env = env_new();
+    ASSERT_FALSE(IS_NIL(eval_str("(lambda () 1)", env)));
+    ASSERT_TRUE(IS_NIL(eval_str("(lambda () () ())", env)));
+}
+
+TEST(define_lambda_with_error_in_body)
+{
+    struct env *env = env_new();
+    struct atom *result = eval_str("(lambda (x y) (function body ((that) would never) work))", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_FALSE(IS_NIL(result));
+}
+
+TEST(evaluating_call_to_closure)
+{
+    struct env *env = env_new();
+
+    struct atom *closure = eval_str("(lambda () (+ 1 2))", env);
+
+    struct atom *list = atom_new_list_empty();
+    LIST_INSERT_HEAD(list->list, closure, entries);
+
+    struct env *env2 = env_new();
+    struct atom *result = eval(list, env2);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(3, result->l);
+}
+
+TEST(evaluating_call_to_closure_with_args)
+{
+    struct env *env = env_new();
+
+    struct atom *closure = eval_str("(lambda (a b) (+ a b))", env);
+
+    struct atom *list = atom_new_list_empty();
+    LIST_INSERT_HEAD(list->list, closure, entries);
+    struct atom *a = atom_new_int(4);
+    struct atom *b = atom_new_int(5);
+    LIST_INSERT_AFTER(closure, a, entries);
+    LIST_INSERT_AFTER(a, b, entries);
+
+    struct atom *result = eval(list, env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(9, result->l);
+}
+
+TEST(call_to_function_should_eval_args)
+{
+    struct env *env = env_new();
+
+    struct atom *closure = eval_str("(lambda (a) (+ a 5))", env);
+
+    int pos = 0;
+
+    struct atom *list = atom_list_append(atom_new_list_empty(), 2,
+        closure, parse("(if #f 0 (+ 10 10))", &pos));
+
+    struct atom *result = eval(list, env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_FALSE(IS_NIL(result));
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(25, result->l);
+}
+
+TEST(evaluating_call_to_closure_with_free_vars)
+{
+    struct env *env = env_new();
+    env_set(env, "y", atom_new_int(1));
+
+    struct atom *closure = eval_str("(lambda (x) (+ x y))", env);
+
+    struct atom *l = atom_list_append(atom_new_list_empty(), 2,
+        closure, atom_new_int(0));
+
+    struct env *env2 = env_new();
+    env_set(env2, "y", atom_new_int(2));
+
+    struct atom *result = eval(l, env2);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(1, result->l);
+}
+
+TEST(calling_very_simple_func_in_env)
+{
+    struct env *env = env_new();
+    eval_str("(define add (lambda (x y) (+ x y)))", env);
+    ASSERT_TRUE(IS_CLOSURE(env_lookup(env, "add")));
+
+    struct atom *result = eval_str("(add 1 2)", env);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(3, result->l);
+}
+
+TEST(calling_lambda_directly)
+{
+    int pos = 0;
+    struct atom *a = parse("((lambda (x) x) 42)", &pos);
+    struct atom *result = eval(a, env_new());
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(42, result->l);
+}
+
+TEST(calling_complex_expression_which_evaluates_to_function)
+{
+    struct env *env = env_new();
+    env_set(env, "y", atom_new_int(3));
+
+    struct atom *result = eval_str("((if #f wont-evaluate-me (lambda (x) (+ x y))) 2)", env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(5, result->l);
+}
+
+TEST(calling_atom_fails)
+{
+    struct env *env = env_new();
+    struct atom *result = eval_str("(#t 'foo 'bar)", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_NIL(result));
+
+    result = eval_str("(42)", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_NIL(result));
+}
+
+TEST(make_sure_args_to_func_are_evaluated)
+{
+    struct env *env = env_new();
+    struct atom *result = eval_str("((lambda (x) x) (+ 1 2))", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(3, result->l);
+}
+
+TEST(calling_with_wrong_number_of_args)
+{
+    struct env *env = env_new();
+
+    eval_str("(define fn (lambda (p1 p2) 'foobar))", env);
+
+    struct atom *result = eval_str("(fn 1 2 3)", env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_NIL(result));
+}
+
+TEST(calling_function_recursively)
+{
+    struct env *env = env_new();
+
+    eval_str("(define fn (lambda (x) (if (eq x 0) 42 (fn (- x 1)))))", env);
+
+    struct atom *result = eval_str("(fn 0)", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(42, result->l);
+
+    result = eval_str("(fn 10)", env);
+    ASSERT_TRUE(result != NULL);
+    ASSERT_TRUE(IS_INT(result));
+    ASSERT_EQ(42, result->l);
+}
+
+TEST(fibonacci)
+{
+    struct env *env = env_new();
+
+    const char *src =
+        "(define fibonacci "
+            "(lambda (x) "
+                "(if (eq x 0) "
+                    "0 "
+                    "(if (eq x 1) "
+                        "1 "
+                        "(+ (fibonacci (- x 2)) "
+                           "(fibonacci (- x 1)))))))";
+
+    struct atom *result = eval_str(src, env);
+
+    ASSERT_TRUE(result != NULL);
+    ASSERT_FALSE(IS_NIL(result));
+
+#define ASSERT_INT_VAL(ATOM, VALUE) \
+    ASSERT_TRUE((ATOM) != NULL); \
+    ASSERT_TRUE(IS_INT(ATOM)); \
+    ASSERT_EQ((VALUE), (ATOM)->l)
+
+    result = eval_str("(fibonacci 0)", env);
+    ASSERT_INT_VAL(result, 0);
+
+    result = eval_str("(fibonacci 1)", env);
+    ASSERT_INT_VAL(result, 1);
+
+    result = eval_str("(fibonacci 2)", env);
+    ASSERT_INT_VAL(result, 1);
+
+    result = eval_str("(fibonacci 3)", env);
+    ASSERT_INT_VAL(result, 2);
+
+    result = eval_str("(fibonacci 4)", env);
+    ASSERT_INT_VAL(result, 3);
+
+    result = eval_str("(fibonacci 5)", env);
+    ASSERT_INT_VAL(result, 5);
+
+    result = eval_str("(fibonacci 6)", env);
+    ASSERT_INT_VAL(result, 8);
+
+    result = eval_str("(fibonacci 7)", env);
+    ASSERT_INT_VAL(result, 13);
+}
+
 #endif /* BUILD_TEST */