#include <rlang.h>
#include "internal.h"
#include "env.h"
#include "quo.h"

#include "decl/env-binding-decl.h"

r_obj* ffi_env_get(
    r_obj* env,
    r_obj* nm,
    r_obj* inherit,
    r_obj* last,
    r_obj* closure_env
) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }
    if (!r_is_string(nm)) {
        r_abort("`nm` must be a string.");
    }
    if (!r_is_bool(inherit)) {
        r_abort("`inherit` must be a logical value.");
    }

    bool c_inherit = r_lgl_get(inherit, 0);

    r_obj* sym = r_str_as_symbol(r_chr_get(nm, 0));
    return env_get_sym(env, sym, c_inherit, last, closure_env);
}

// This util is a little more complex than it would be by calling `getVar()`
// directly because it evaluates `default` lazily
static r_obj* env_get_sym(
    r_obj* env,
    r_obj* sym,
    bool inherit,
    r_obj* last,
    r_obj* closure_env
) {
    if (r_typeof(last) != R_TYPE_environment) {
        r_abort("`last` must be an environment.");
    }

    bool unbound;
    if (inherit) {
        if (last == r_null) {
            unbound = !r_env_has_anywhere(env, sym);
        } else {
            unbound = !r_env_has_until(env, sym, last);
        }
    } else {
        unbound = !r_env_has(env, sym);
    }

    if (unbound) {
        if (r_env_has_missing(closure_env, r_sym("default"))) {
            struct r_pair args[] = {
                {r_sym("nm"), KEEP(r_str_as_character(r_sym_string(sym)))}
            };
            r_exec_n(
                r_null,
                r_sym("stop_env_get_missing"),
                args,
                R_ARR_SIZEOF(args),
                closure_env
            );
            r_stop_unreachable();
        }

        return r_eval(r_sym("default"), closure_env);
    }

    if (inherit) {
        if (last == r_null) {
            return r_env_get_anywhere(env, sym);
        } else {
            return r_env_get_until(env, sym, last);
        }
    } else {
        return r_env_get(env, sym);
    }
}

r_obj* ffi_env_get_list(
    r_obj* env,
    r_obj* nms,
    r_obj* inherit,
    r_obj* last,
    r_obj* closure_env
) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }
    if (r_typeof(nms) != R_TYPE_character) {
        r_abort("`nm` must be a string.");
    }
    if (!r_is_bool(inherit)) {
        r_abort("`inherit` must be a logical value.");
    }

    bool c_inherit = r_lgl_get(inherit, 0);
    r_ssize n = r_length(nms);

    r_obj* out = KEEP(r_alloc_list(n));
    r_attrib_poke_names(out, nms);

    r_obj* const* p_nms = r_chr_cbegin(nms);

    for (r_ssize i = 0; i < n; ++i) {
        r_obj* sym = r_str_as_symbol(p_nms[i]);
        r_obj* elt = env_get_sym(env, sym, c_inherit, last, closure_env);
        r_list_poke(out, i, elt);
    }

    FREE(1);
    return out;
}

r_obj* ffi_env_has(r_obj* env, r_obj* nms, r_obj* inherit) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }
    if (r_typeof(nms) != R_TYPE_character) {
        r_abort("`nms` must be a character vector.");
    }
    if (r_typeof(inherit) != R_TYPE_logical) {
        r_abort("`inherit` must be a logical value.");
    }

    r_ssize n = r_length(nms);
    r_obj* out = KEEP(r_alloc_logical(n));

    int* p_out = r_lgl_begin(out);
    r_obj* const* p_nms = r_chr_cbegin(nms);

    if (r_lgl_get(inherit, 0)) {
        for (r_ssize i = 0; i < n; ++i) {
            r_obj* sym = r_str_as_symbol(p_nms[i]);
            p_out[i] = r_env_has_anywhere(env, sym);
        }
    } else {
        for (r_ssize i = 0; i < n; ++i) {
            r_obj* sym = r_str_as_symbol(p_nms[i]);
            p_out[i] = r_env_has(env, sym);
        }
    }

    r_attrib_poke_names(out, nms);
    FREE(1);
    return out;
}

static void env_poke_or_zap(r_obj* env, r_obj* sym, r_obj* value);
static void env_poke_delayed(
    r_obj* env,
    r_obj* sym,
    r_obj* value,
    r_obj* eval_env
);
static void env_poke_active(r_obj* env, r_obj* sym, r_obj* fn, r_obj* eval_env);
static r_obj* env_get(r_obj* env, r_obj* sym);

r_obj* ffi_env_poke(
    r_obj* env,
    r_obj* nm,
    r_obj* value,
    r_obj* ffi_inherit,
    r_obj* ffi_create
) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }
    if (!r_is_string(nm)) {
        r_abort("`nm` must be a string.");
    }
    if (!r_is_bool(ffi_inherit)) {
        r_abort("`inherit` must be a logical value.");
    }
    if (!r_is_bool(ffi_create)) {
        r_abort("`create` must be a logical value.");
    }

    bool inherit = r_lgl_get(ffi_inherit, 0);
    bool create = r_lgl_get(ffi_create, 0);
    r_obj* sym = r_str_as_symbol(r_chr_get(nm, 0));

    bool unbound;
    if (inherit) {
        unbound = !r_env_has_anywhere(env, sym);
    } else {
        unbound = !r_env_has(env, sym);
    }

    r_obj* old;
    if (unbound) {
        if (!create) {
            r_abort(
                "Can't find existing binding in `env` for \"%s\".",
                r_sym_c_string(sym)
            );
        }
        old = rlang_zap;
    } else if (inherit) {
        old = r_env_get_anywhere(env, sym);
    } else {
        old = r_env_get(env, sym);
    }
    KEEP(old);

    if (inherit && !unbound) {
        while (env != r_envs.empty) {
            if (r_env_has(env, sym)) {
                break;
            }
            env = r_env_parent(env);
        }
    }
    env_poke_or_zap(env, sym, value);

    FREE(1);
    return old;
}

enum bind_type {
    BIND_TYPE_value,
    BIND_TYPE_active,
    BIND_TYPE_lazy
};

enum bind_type parse_bind_type(r_obj* bind_type) {
    switch (*r_chr_get_c_string(bind_type, 0)) {
    case 'v':
        return BIND_TYPE_value;
    case 'a':
        return BIND_TYPE_active;
    case 'l':
        return BIND_TYPE_lazy;
    default:
        r_stop_unreachable();
    }
}

r_obj* ffi_env_bind(
    r_obj* env,
    r_obj* values,
    r_obj* needs_old,
    r_obj* bind_type,
    r_obj* eval_env
) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }

    bool c_needs_old = r_lgl_get(needs_old, 0);
    enum bind_type c_bind_type = parse_bind_type(bind_type);

    if (r_typeof(values) != R_TYPE_list) {
        r_stop_internal("`values` must be a list.");
    }

    r_ssize n = r_length(values);
    if (!n) {
        return r_globals.empty_list;
    }

    r_obj* names = KEEP(r_names(values));
    if (n && names == r_null) {
        r_abort("Can't bind data because some elements are not named.");
    }
    r_obj* const* p_names = r_chr_cbegin(names);

    r_obj* old = r_null;
    if (c_needs_old) {
        old = KEEP(r_alloc_list(n));
        r_attrib_poke_names(old, names);
    } else {
        KEEP(old);
    }

    for (r_ssize i = 0; i < n; ++i) {
        r_obj* sym = r_str_as_symbol(p_names[i]);
        r_obj* value = r_list_get(values, i);

        if (c_needs_old) {
            r_list_poke(old, i, env_get(env, sym));
        }

        if (value == rlang_zap) {
            r_env_unbind(env, sym);
        } else {
            switch (c_bind_type) {
            case BIND_TYPE_value:
                r_env_bind(env, sym, value);
                break;
            case BIND_TYPE_lazy:
                env_poke_delayed(env, sym, value, eval_env);
                break;
            case BIND_TYPE_active:
                env_poke_active(env, sym, value, eval_env);
                break;
            }
        }
    }

    FREE(2);
    return old;
}

r_obj* ffi_env_unbind(r_obj* env, r_obj* names, r_obj* inherits) {
    if (r_typeof(env) != R_TYPE_environment) {
        r_abort("`env` must be an environment.");
    }
    if (r_typeof(names) != R_TYPE_character) {
        r_abort("`names` must be a character vector.");
    }
    if (!r_is_bool(inherits)) {
        r_abort("`inherits` must be a logical value.");
    }

    if (*r_lgl_begin(inherits)) {
        r_env_unbind_anywhere_names(env, names);
    } else {
        r_env_unbind_names(env, names);
    }

    return r_null;
}

static void env_poke_or_zap(r_obj* env, r_obj* sym, r_obj* value) {
    if (value == rlang_zap) {
        r_env_unbind(env, sym);
    } else {
        r_env_bind(env, sym, value);
    }
}
static void env_poke_delayed(
    r_obj* env,
    r_obj* sym,
    r_obj* expr,
    r_obj* eval_env
) {
    if (is_quosure(expr)) {
        expr = KEEP(rlang_as_function(expr, eval_env));
        expr = r_new_call(expr, r_null);
        FREE(1);
    }
    KEEP(expr);

    r_env_bind_delayed(env, sym, expr, eval_env);
    FREE(1);
}
static void env_poke_active(
    r_obj* env,
    r_obj* sym,
    r_obj* fn,
    r_obj* eval_env
) {
    if (!r_is_function(fn)) {
        fn = rlang_as_function(fn, eval_env);
    }
    KEEP(fn);

    r_env_bind_active(env, sym, fn);
    FREE(1);
}

static r_obj* env_get(r_obj* env, r_obj* sym) {
    if (!r_env_has(env, sym)) {
        return rlang_zap;
    }

    if (r_env_has_missing(env, sym)) {
        return r_missing_arg;
    }

    return r_env_get(env, sym);
}
