#define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n");

Object *
eval(Environment* env, Object *root) {
    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: {
            return root;
        } 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;
            }
            return val;
        } 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;
                }
                if (val->type == OBJ_TYPE_PROCEDURE) {
                    return val->proc(env, root->cdr);
                }
                if (val->type == OBJ_TYPE_LAMBDA) {
                    goto eval_lambda;
                }
                error_push((Error){
                    .type = ERR_TYPE_RUNTIME,
                    .value = ERR_OBJ_NOT_CALLABLE,
                });
                return obj_err;
            }
            Object* lambda;
eval_lambda:
            lambda = eval(env, root->car);
            if (lambda == obj_err) {
                return obj_err;
            }
            if (lambda->type == OBJ_TYPE_LAMBDA) {
                Object *fun = lambda;
                Object *args = root->cdr;
                Object *params = fun->params;
                env = env_extend(fun->env, env);
                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;
                    }
                    env_add_or_update_current(env, 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;
                }
                root = fun->body;
                while (root->cdr != obj_nil) {
                    if (eval(env, root->car) == obj_err) {
                        return obj_err;
                    };
                    root = root->cdr;
                }
                return eval(env, root->car);
            }
        } break;
    }

    error_push((Error){
        .type = ERR_TYPE_RUNTIME,
        .value = ERR_UNKNOWN_OBJ_TYPE,
    });
    return obj_err;
}

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 = car->string_n,
    };
    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_if(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 *car = obj->car;
    Object *cdr = obj->cdr;
    Object *condition = eval(env, car);
    if (condition == obj_err) {
        return obj_err;
    }
    if (condition == obj_true) {
        return eval(env, cdr->car);
    }
    if (cdr->cdr != obj_nil) {
        return eval(env, cdr->cdr->car);
    }
    return obj_nil;
}

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 *a = eval(env, obj->car);
    Object *b = eval(env, obj->cdr->car);
    return make_pair(a, b);
}

Object *
proc_list(Environment *env, Object *obj) {
    if (obj == obj_nil) {
        return obj_nil;
    }
    Object *head = make_pair(eval(env, obj->car), obj_nil);
    Object *curr = head;
    obj = obj->cdr;
    while (obj != obj_nil) {
        curr->cdr = make_pair(eval(env, obj->car), obj_nil);
        curr = curr->cdr;
        obj = obj->cdr;
    }
    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 = obj_duplicate(params);
    fun->body = obj_duplicate(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 = obj_duplicate(params);
    fun->body = obj_duplicate(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