Add initial lambda implementation

4 files changed, 96 insertions, 0 deletions

diff --git a/src/bootstrap/errors.c b/src/bootstrap/errors.c
index 61ea902..c1d2879 100644
--- a/src/bootstrap/errors.c
+++ b/src/bootstrap/errors.c
@@ -16,6 +16,7 @@ typedef enum ErrorValue {
     ERR_SYMBOL_NOT_FOUND,
     ERR_OBJ_NOT_CALLABLE,
     ERR_NOT_ENOUGH_ARGS,
+    ERR_TOO_MANY_ARGS,
     ERR_WRONG_ARG_TYPE,
     ERR_DIVISION_BY_ZERO,
 } ErrorValue;
@@ -39,6 +40,7 @@ static const char* error_msgs[] = {
     [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found",
     [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable",
     [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments",
+    [ERR_TOO_MANY_ARGS] = "error: too many arguments",
     [ERR_WRONG_ARG_TYPE] = "error: wrong argument type",
     [ERR_DIVISION_BY_ZERO] = "error: division by zero",
 };
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c
index c589b2d..7591834 100755
--- a/src/bootstrap/main.c
+++ b/src/bootstrap/main.c
@@ -75,6 +75,7 @@ init(void) {
     MAKE_ENV_PROC(global_env, "eq?", proc_equal);
     MAKE_ENV_PROC(global_env, "def", proc_define);
     MAKE_ENV_PROC(global_env, "set!", proc_set);
+    MAKE_ENV_PROC(global_env, "lambda", proc_lambda);
 
     // Runtime procedures.
     MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors);
diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c
index fd76166..b3aa3de 100644
--- a/src/bootstrap/objects.c
+++ b/src/bootstrap/objects.c
@@ -6,6 +6,7 @@ typedef enum ObjectType {
     OBJ_TYPE_STRING,
     OBJ_TYPE_PAIR,
     OBJ_TYPE_PROCEDURE,
+    OBJ_TYPE_LAMBDA,
     OBJ_TYPE_ERR,
 } ObjectType;
 
@@ -37,6 +38,13 @@ typedef struct Object {
 
         // OBJ_TYPE_PROCEDURE
         struct Object *(*proc)(struct Environment *env, struct Object *args);
+
+        // OBJ_TYPE_LAMBDA
+        struct {
+            struct Object *args;
+            struct Object *body;
+            struct Environment *env;
+        };
     };
 } Object;
 
@@ -118,6 +126,7 @@ obj_duplicate(Object *obj) {
         case OBJ_TYPE_BOOL:
         case OBJ_TYPE_NIL:
         case OBJ_TYPE_PROCEDURE:
+        case OBJ_TYPE_LAMBDA: // TODO: should we duplicate everything inside?
         case OBJ_TYPE_ERR: {
             copy = obj;
         } break;
@@ -176,6 +185,12 @@ free_objects(Object *root) {
             }
             free(root);
         } break;
+        case OBJ_TYPE_LAMBDA: {
+            free_objects(root->args);
+            free_objects(root->body);
+            // TODO: free_env(root->env);
+            free(root);
+        } break;
     }
 }
 
@@ -222,6 +237,7 @@ display(Object *root) {
             display_pair(root);
             printf(")");
         } break;
+        case OBJ_TYPE_LAMBDA:
         case OBJ_TYPE_PROCEDURE: {
             printf("#{procedure}");
         } break;
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 3afeef6..461799e 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -1,8 +1,10 @@
 Object *
 eval(Environment* env, Object *root) {
+tailcall:
     switch (root->type) {
         case OBJ_TYPE_ERR:
         case OBJ_TYPE_PROCEDURE:
+        case OBJ_TYPE_LAMBDA:
         case OBJ_TYPE_FIXNUM:
         case OBJ_TYPE_BOOL:
         case OBJ_TYPE_NIL:
@@ -39,6 +41,52 @@ eval(Environment* env, Object *root) {
                 });
                 return obj_err;
             }
+            Object* lambda = eval(env, root->car);
+            if (lambda->type == OBJ_TYPE_LAMBDA) {
+                Object *fun = lambda;
+                Object *args = root->cdr;
+                Object *params = fun->args;
+                while (params != obj_nil) {
+                    if (args == obj_nil) {
+                        error_push((Error){
+                            .type = ERR_TYPE_RUNTIME,
+                            .value = ERR_NOT_ENOUGH_ARGS,
+                        });
+                        return obj_err;
+                    }
+                    Object *symbol = params->car;
+                    Object *value = eval(env, args->car);
+                    if (value == obj_err) {
+                        return obj_err;
+                    }
+                    if (value == obj_nil) {
+                        error_push((Error){
+                            .type = ERR_TYPE_RUNTIME,
+                            .value = ERR_NOT_ENOUGH_ARGS,
+                        });
+                        return obj_err;
+                    }
+                    ssize_t index = env_symbol_index_in_current_env(fun->env, symbol);
+                    if (index == -1) {
+                        env_add_symbol(fun->env, obj_duplicate(symbol), obj_duplicate(value));
+                    } else {
+                        fun->env->buf[index].value = obj_duplicate(value);
+                    }
+                    args = args->cdr;
+                    params = params->cdr;
+                }
+                if (args != obj_nil) {
+                    error_push((Error){
+                        .type = ERR_TYPE_RUNTIME,
+                        .value = ERR_TOO_MANY_ARGS,
+                    });
+                    return obj_err;
+                }
+
+                env = fun->env;
+                root = fun->body;
+                goto tailcall;
+            }
         } break;
     }
 
@@ -692,6 +740,31 @@ proc_set(Environment *env, Object *obj) {
     return obj_nil;
 }
 
+Object *
+proc_lambda(Environment *env, Object *obj) {
+    if (obj == obj_nil || obj->cdr == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    Object *args = obj->car;
+    if (args != obj_nil && args->type != OBJ_TYPE_PAIR) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    Object *body = obj->cdr->car;
+    Object *fun = alloc_object(OBJ_TYPE_LAMBDA);
+    fun->args = obj_duplicate(args);
+    fun->body = obj_duplicate(body);
+    fun->env = env_create(env);
+    return fun;
+}
+
 
 //
 // Evaluation.
@@ -709,6 +782,10 @@ proc_eval(Environment *env, Object *obj) {
     return eval(env, eval(env, obj->car));
 }
 
+//
+// Runtime configuration options.
+//
+
 Object *
 proc_supress_errors(Environment *env, Object *obj) {
     Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL);