From eeff5e273f22aa28e81ab080e9ffdce85ac394b8 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Fri, 22 Oct 2021 09:59:31 +0200
Subject: Prepare skeleton for bytecode interpreter

---
 src/treewalk/primitives.c | 918 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 918 insertions(+)
 create mode 100644 src/treewalk/primitives.c

(limited to 'src/treewalk/primitives.c')

diff --git a/src/treewalk/primitives.c b/src/treewalk/primitives.c
new file mode 100644
index 0000000..8b0d407
--- /dev/null
+++ b/src/treewalk/primitives.c
@@ -0,0 +1,918 @@
+#include "primitives.h"
+
+Object *
+eval(Environment *env, Object *root) {
+    Object* lambda = NULL;
+    Object* args = NULL;
+    Object* ret = NULL;
+    bool recursion_active = false;
+eval_start:
+    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:
+        case OBJ_TYPE_STRING: {
+            ret = root;
+            goto eval_success;
+        } break;
+        case OBJ_TYPE_SYMBOL: {
+            Object *val = env_lookup(env, root);
+            if (val == obj_err) {
+                error_push((Error){
+                    .type = ERR_TYPE_RUNTIME,
+                    .value = ERR_SYMBOL_NOT_FOUND,
+                });
+                return obj_err;
+            }
+            ret = val;
+            goto eval_success;
+        } break;
+        case OBJ_TYPE_PAIR: {
+            if (root->car->type == OBJ_TYPE_SYMBOL) {
+                Object *val = env_lookup(env, root->car);
+                if (val == obj_err) {
+                    error_push((Error){
+                        .type = ERR_TYPE_RUNTIME,
+                        .value = ERR_SYMBOL_NOT_FOUND,
+                    });
+                    return obj_err;
+                }
+
+                // Primitive `if` procedure with TCO.
+                if (val == proc_if) {
+                    Object *obj = root->cdr;
+                    if (obj == obj_nil || obj->cdr == obj_nil) {
+                        error_push((Error){
+                            .type = ERR_TYPE_RUNTIME,
+                            .value = ERR_NOT_ENOUGH_ARGS,
+                        });
+                        return obj_err;
+                    }
+                    Object *car = obj->car;
+                    Object *cdr = obj->cdr;
+                    Object *condition = eval(env, car);
+                    if (condition == obj_err) {
+                        return obj_err;
+                    }
+                    if (condition == obj_true) {
+                        root = cdr->car;
+                    } else if (cdr->cdr != obj_nil) {
+                        root = cdr->cdr->car;
+                    } else {
+                        return obj_nil;
+                    }
+                    goto eval_start;
+                }
+
+                if (val->type == OBJ_TYPE_PROCEDURE) {
+                    ret = val->proc(env, root->cdr);
+                    goto eval_success;
+                }
+                if (val->type == OBJ_TYPE_LAMBDA) {
+                    lambda = val;
+                    goto eval_lambda;
+                }
+                error_push((Error){
+                    .type = ERR_TYPE_RUNTIME,
+                    .value = ERR_OBJ_NOT_CALLABLE,
+                });
+                return obj_err;
+            }
+            lambda = eval(env, root->car);
+            if (lambda == obj_err) {
+                return obj_err;
+            }
+            if (lambda->type != OBJ_TYPE_LAMBDA) {
+                error_push((Error){
+                    .type = ERR_TYPE_RUNTIME,
+                    .value = ERR_OBJ_NOT_CALLABLE,
+                });
+                return obj_err;
+            }
+
+eval_lambda:
+            args = root->cdr;
+            Object *params = lambda->params;
+            if (!recursion_active) {
+                recursion_active = true;
+                // Protect current stack.
+                Environment *tmp = env_create(lambda->env);
+                push_active_env(tmp);
+                // Extend environment.
+                env = env_extend(tmp, env);
+            }
+
+            // Create temporary environment to store bindings.
+            Environment *tmp = env_create(env);
+            push_active_env(tmp);
+
+            // Evaluate arguments in temporary environment.
+            while (params != obj_nil) {
+                if (args == obj_nil) {
+                    error_push((Error){
+                        .type = ERR_TYPE_RUNTIME,
+                        .value = ERR_NOT_ENOUGH_ARGS,
+                    });
+                    return obj_err;
+                }
+                if (args->car == 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;
+                }
+                env_add_or_update_current(tmp, symbol, 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;
+            }
+
+            // Copy temporary environment values to closure environment.
+            args = root->cdr;
+            params = lambda->params;
+            while (params != obj_nil) {
+                Object *symbol = params->car;
+                Object *value = env_lookup(tmp, symbol);
+                env_add_or_update_current(env, symbol, value);
+                args = args->cdr;
+                params = params->cdr;
+            }
+
+            // Release the temporary environment protection.
+            pop_active_env();
+
+            // Run the body of the function.
+            root = lambda->body;
+            while (root->cdr != obj_nil) {
+                if (eval(env, root->car) == obj_err) {
+                    return obj_err;
+                };
+                root = root->cdr;
+            }
+            root = root->car;
+            goto eval_start;
+        } break;
+    }
+
+    error_push((Error){
+        .type = ERR_TYPE_RUNTIME,
+        .value = ERR_UNKNOWN_OBJ_TYPE,
+    });
+    return obj_err;
+
+eval_success:
+    if (recursion_active) {
+        // Remove stack protector.
+        pop_active_env();
+    }
+    return ret;
+}
+
+Object *
+proc_quote(Environment *env, Object *obj) {
+    (void)env;
+    return obj->car;
+}
+
+static inline Object *
+extract_car_with_type(Environment *env, Object *obj, ObjectType expected_type) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    Object *car = eval(env, obj->car);
+    if (car == obj_err) {
+        return obj_err;
+    }
+    if (car->type != expected_type) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    return car;
+}
+
+//
+// Arithmetic procedures.
+//
+
+Object *
+proc_sum(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t tot = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        tot += car->fixnum;
+        obj = obj->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+Object *
+proc_sub(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t tot = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        tot -= car->fixnum;
+        obj = obj->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+Object *
+proc_mul(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t tot = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        tot *= car->fixnum;
+        obj = obj->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+Object *
+proc_div(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t tot = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (car->fixnum == 0) {
+            error_push((Error){
+                .type = ERR_TYPE_RUNTIME,
+                .value = ERR_DIVISION_BY_ZERO,
+            });
+            return obj_err;
+        }
+        tot /= car->fixnum;
+        obj = obj->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+Object *
+proc_mod(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t tot = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (car->fixnum == 0) {
+            error_push((Error){
+                .type = ERR_TYPE_RUNTIME,
+                .value = ERR_DIVISION_BY_ZERO,
+            });
+            return obj_err;
+        }
+        tot %= car->fixnum;
+        obj = obj->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+//
+// Display/Evaluation procedues.
+//
+
+Object *
+proc_display(Environment *env, Object *obj) {
+    display(eval(env, obj->car));
+    return obj_nil;
+}
+
+Object *
+proc_print(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_STRING);
+    StringView scanner = (StringView) {
+        .start = car->string,
+        .n = array_size(car->string),
+    };
+    while (scanner.n != 0) {
+        char c = sv_next(&scanner);
+        if (c == '\\' && sv_peek(&scanner) == 'n') {
+            putchar('\n');
+            sv_next(&scanner);
+            continue;
+        }
+        if (c == '\\' && sv_peek(&scanner) == '"') {
+            putchar('"');
+            sv_next(&scanner);
+            continue;
+        }
+        putchar(c);
+    }
+    return obj_nil;
+}
+
+Object *
+proc_newline(Environment *env, Object *obj) {
+    printf("\n");
+    (void)env;
+    (void)obj;
+    return obj_nil;
+}
+
+//
+// Type info procedures.
+//
+
+Object *
+proc_is_boolean(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
+}
+
+Object *
+proc_is_nil(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj == obj_nil ? obj_true : obj_false;
+}
+
+Object *
+proc_is_symbol(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false;
+}
+
+Object *
+proc_is_string(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false;
+}
+
+Object *
+proc_is_fixnum(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false;
+}
+
+Object *
+proc_is_pair(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false;
+}
+
+Object *
+proc_is_procedure(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
+}
+
+Object *
+proc_is_error(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_true;
+    }
+    return obj_false;
+}
+
+//
+// Boolean/conditional procedures.
+//
+
+Object *
+proc_not(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    return obj == obj_false ? obj_true : obj_false;
+}
+
+Object *
+proc_and(Environment *env, Object *obj) {
+    while (obj != obj_nil) {
+        if (proc_not(env, obj) == obj_true) {
+            return obj_false;
+        }
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_or(Environment *env, Object *obj) {
+    while (obj != obj_nil) {
+        if (proc_not(env, obj) == obj_false) {
+            return obj_true;
+        }
+        obj = obj->cdr;
+    }
+    return obj_false;
+}
+
+Object *
+proc_cond(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    while (obj != obj_nil) {
+        Object *clause = obj->car;
+        if (clause->type != OBJ_TYPE_PAIR || clause->cdr == obj_nil) {
+            error_push((Error){
+                .type = ERR_TYPE_RUNTIME,
+                .value = ERR_WRONG_ARG_TYPE,
+            });
+            return obj_err;
+        }
+        Object *test = clause->car;
+        Object *value = clause->cdr->car;
+        Object *result = eval(env, test);
+        if (result == obj_err) {
+            return obj_err;
+        }
+        if (result == obj_true) {
+            return eval(env, value);
+        }
+        obj = obj->cdr;
+    }
+    return obj_nil;
+}
+
+Object *
+proc_num_less_than(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t prev = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (prev >= car->fixnum) {
+            return obj_false;
+        }
+        prev = car->fixnum;
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_greater_than(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t prev = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (prev <= car->fixnum) {
+            return obj_false;
+        }
+        prev = car->fixnum;
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_lesseq_than(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t prev = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (prev > car->fixnum) {
+            return obj_false;
+        }
+        prev = car->fixnum;
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_greatereq_than(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t prev = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (prev < car->fixnum) {
+            return obj_false;
+        }
+        prev = car->fixnum;
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_equal(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+    obj = obj->cdr;
+    ssize_t prev = car->fixnum;
+    while (obj != obj_nil) {
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
+        if (prev != car->fixnum) {
+            return obj_false;
+        }
+        prev = car->fixnum;
+        obj = obj->cdr;
+    }
+    return obj_true;
+}
+
+//
+// List operation procedures.
+//
+
+Object *
+proc_car(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    if (obj->type != OBJ_TYPE_PAIR) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    return obj->car;
+}
+
+Object *
+proc_cdr(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    obj = eval(env, obj->car);
+    if (obj == obj_err) {
+        return obj_err;
+    }
+    if (obj->type != OBJ_TYPE_PAIR) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    return obj->cdr;
+}
+
+Object *
+proc_cons(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    Object *head = make_pair(obj_nil, obj_nil);
+    push_root(head);
+    head->car = eval(env, obj->car);
+    if (head->car == obj_err) {
+        pop_root();
+        return obj_err;
+    }
+    head->cdr = eval(env, obj->cdr->car);
+    if (head->cdr == obj_err) {
+        pop_root();
+        return obj_err;
+    }
+    pop_root();
+    return head;
+}
+
+Object *
+proc_list(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        return obj_nil;
+    }
+
+    Object *head = make_pair(obj_nil, obj_nil);
+    push_root(head);
+    Object *tmp = eval(env, obj->car);
+    if (tmp == obj_err) {
+        pop_root();
+        return obj_err;
+    }
+    head->car = tmp;
+    Object *curr = head;
+    obj = obj->cdr;
+    while (obj != obj_nil) {
+        tmp = eval(env, obj->car);
+        if (tmp == obj_err) {
+            pop_root();
+            return obj_err;
+        }
+        curr->cdr = make_pair(tmp, obj_nil);
+        curr = curr->cdr;
+        obj = obj->cdr;
+    }
+    pop_root();
+    return head;
+}
+
+//
+// Polymorphic procedures.
+//
+
+Object *
+proc_equal(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 *a = eval(env, obj->car);
+    if (a == obj_err) {
+        return obj_err;
+    }
+    Object *b = eval(env, obj->cdr->car);
+    if (b == obj_err) {
+        return obj_err;
+    }
+    return obj_eq(a, b) ? obj_true : obj_false;
+}
+
+//
+// Variables and declarations.
+//
+
+Object *
+proc_define(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 *symbol = obj->car;
+    if (symbol->type != OBJ_TYPE_SYMBOL) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+
+    Object *value = eval(env, obj->cdr->car);
+    if (value == obj_err) {
+        return obj_err;
+    }
+
+    env_add_or_update_current(env, symbol, value);
+    return obj_nil;
+}
+
+Object *
+proc_set(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 *symbol = obj->car;
+    if (symbol->type != OBJ_TYPE_SYMBOL) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+
+    Object *value = eval(env, obj->cdr->car);
+    if (value == obj_err) {
+        return obj_err;
+    }
+
+    return env_update(env, symbol, value);
+}
+
+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 *params = obj->car;
+    if (params != obj_nil && params->type != OBJ_TYPE_PAIR) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    Object *body = obj->cdr;
+    Object *fun = alloc_object(OBJ_TYPE_LAMBDA);
+    fun->params = params;
+    fun->body = body;
+    fun->env = env;
+    return fun;
+}
+
+Object *
+proc_fun(Environment *env, Object *obj) {
+    if (obj == obj_nil || obj->cdr == obj_nil || obj->cdr->cdr == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+
+    Object *name = obj->car;
+    if (name->type != OBJ_TYPE_SYMBOL) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+
+    Object *params = obj->cdr->car;
+    if (params != obj_nil && params->type != OBJ_TYPE_PAIR) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_WRONG_ARG_TYPE,
+        });
+        return obj_err;
+    }
+    Object *body = obj->cdr->cdr;
+    Object *fun = alloc_object(OBJ_TYPE_LAMBDA);
+    fun->params = params;
+    fun->body = body;
+    fun->env = env;
+    env_add_or_update_current(env, name, fun);
+    return obj_nil;
+}
+
+//
+// Evaluation.
+//
+
+Object *
+proc_eval(Environment *env, Object *obj) {
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
+    }
+    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);
+    if (car == obj_err) {
+        return obj_err;
+    }
+
+    if (car == obj_true) {
+        supress_errors = true;
+    } else if (car == obj_false) {
+        supress_errors = false;
+    }
+    return obj_nil;
+}
+
+// TODO: map
+// TODO: apply
+// TODO: filter
+
+// TODO: fixnum left/right shift, mask, invert
+// TODO: add primitives for type transforms: string->symbol, symbol->string, etc
+// TODO: implement support for semi-quotes
+// TODO: LAMBDA
+// TODO: let
-- 
cgit v1.2.1