From ee1a5de91c875fb66724dc21c02333bfebe2a812 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Tue, 1 Feb 2022 18:36:52 +0100
Subject: Add new syntax to lexer and prepare refactor

---
 src/treewalk/primitives.c | 918 ----------------------------------------------
 1 file changed, 918 deletions(-)
 delete mode 100644 src/treewalk/primitives.c

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

diff --git a/src/treewalk/primitives.c b/src/treewalk/primitives.c
deleted file mode 100644
index 8b0d407..0000000
--- a/src/treewalk/primitives.c
+++ /dev/null
@@ -1,918 +0,0 @@
-#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