#include "rlang.h"
#include <math.h>
#include <stdint.h>

r_obj* r_chr_n(const char* const* strings, r_ssize n) {
    r_obj* out = KEEP(r_alloc_character(n));

    for (r_ssize i = 0; i < n; ++i) {
        r_chr_poke(out, i, r_str(strings[i]));
    }

    FREE(1);
    return out;
}

#define RESIZE(R_TYPE, C_TYPE, CONST_DEREF, DEREF)                             \
    do {                                                                       \
        r_ssize old_size = r_length(x);                                        \
        if (old_size == new_size) {                                            \
            return x;                                                          \
        }                                                                      \
        if (!ALTREP(x) && new_size < old_size) {                               \
            return vec_shrink(x, new_size, old_size);                          \
        }                                                                      \
                                                                               \
        const C_TYPE* p_x = CONST_DEREF(x);                                    \
        r_obj* out = KEEP(r_alloc_vector(R_TYPE, new_size));                   \
        C_TYPE* p_out = DEREF(out);                                            \
                                                                               \
        r_ssize cpy_size = (new_size > old_size) ? old_size : new_size;        \
        r_memcpy(p_out, p_x, cpy_size * sizeof(C_TYPE));                       \
                                                                               \
        FREE(1);                                                               \
        return out;                                                            \
    } while (0)

#define RESIZE_BARRIER(R_TYPE, CONST_DEREF, SET)                               \
    do {                                                                       \
        r_ssize old_size = r_length(x);                                        \
        if (old_size == new_size) {                                            \
            return x;                                                          \
        }                                                                      \
        if (!ALTREP(x) && new_size < old_size) {                               \
            return vec_shrink(x, new_size, old_size);                          \
        }                                                                      \
                                                                               \
        r_obj* const* p_x = CONST_DEREF(x);                                    \
        r_obj* out = KEEP(r_alloc_vector(R_TYPE, new_size));                   \
                                                                               \
        r_ssize cpy_size = (new_size > old_size) ? old_size : new_size;        \
        for (r_ssize i = 0; i < cpy_size; ++i) {                               \
            SET(out, i, p_x[i]);                                               \
        }                                                                      \
                                                                               \
        FREE(1);                                                               \
        return out;                                                            \
    } while (0)

// Assumption on older R: `new_size` smaller than `old_size`
static inline r_obj* vec_shrink(r_obj* x, r_ssize new_size, r_ssize old_size) {
#if R_VERSION >= R_Version(4, 6, 0)
    if (R_isResizable(x)) {
        R_resizeVector(x, new_size);
        return x;
    } else {
        return Rf_xlengthgets(x, new_size);
    }
#else
    SETLENGTH(x, new_size);
    SET_TRUELENGTH(x, old_size);
    SET_GROWABLE_BIT(x);
    return x;
#endif
}

// Compared to `Rf_xlengthgets()` this does not initialise the new
// extended locations with `NA`
r_obj* r_lgl_resize(r_obj* x, r_ssize new_size) {
    RESIZE(R_TYPE_logical, int, r_lgl_cbegin, r_lgl_begin);
}
r_obj* r_int_resize(r_obj* x, r_ssize new_size) {
    RESIZE(R_TYPE_integer, int, r_int_cbegin, r_int_begin);
}
r_obj* r_dbl_resize(r_obj* x, r_ssize new_size) {
    RESIZE(R_TYPE_double, double, r_dbl_cbegin, r_dbl_begin);
}
r_obj* r_cpl_resize(r_obj* x, r_ssize new_size) {
    RESIZE(R_TYPE_complex, r_complex, r_cpl_cbegin, r_cpl_begin);
}
r_obj* r_raw_resize(r_obj* x, r_ssize new_size) {
    RESIZE(R_TYPE_raw, unsigned char, r_raw_cbegin, r_raw_begin);
}
r_obj* r_chr_resize(r_obj* x, r_ssize new_size) {
    RESIZE_BARRIER(R_TYPE_character, r_chr_cbegin, r_chr_poke);
}
r_obj* r_list_resize(r_obj* x, r_ssize new_size) {
    RESIZE_BARRIER(R_TYPE_list, r_list_cbegin, r_list_poke);
}

#undef RESIZE
#undef RESIZE_BARRIER

r_obj* r_list_compact(r_obj* x) {
    r_ssize n = r_length(x);
    r_obj* inc = KEEP(r_alloc_logical(n));

    int* v_inc = r_int_begin(inc);
    r_obj* const* v_x = r_list_cbegin(x);

    r_ssize new_n = 0;
    for (r_ssize i = 0; i < n; ++i) {
        v_inc[i] = v_x[i] != r_null;
        new_n += v_inc[i];
    }

    r_obj* out = KEEP(r_alloc_list(new_n));
    for (r_ssize i = 0, count = 0; i < n; ++i) {
        if (v_inc[i]) {
            r_list_poke(out, count, v_x[i]);
            ++count;
        }
    }

    FREE(2);
    return out;
}

r_obj* r_list_of_as_ptr_ssize(
    r_obj* xs,
    enum r_type type,
    struct r_pair_ptr_ssize** p_v_out
) {
    if (r_typeof(xs) != R_TYPE_list) {
        r_abort("`xs` must be a list.");
    }
    r_ssize n = r_length(xs);

    r_obj* shelter = KEEP(r_alloc_raw(sizeof(struct r_pair_ptr_ssize) * n));
    struct r_pair_ptr_ssize* v_out = r_raw_begin(shelter);

    r_obj* const* v_xs = r_list_cbegin(xs);

    for (r_ssize i = 0; i < n; ++i) {
        r_obj* x = v_xs[i];
        if (r_typeof(x) != type) {
            r_abort(
                "`xs` must be a list of vectors of type `%s`.",
                r_type_as_c_string(type)
            );
        }

        v_out[i] = (struct r_pair_ptr_ssize) {.ptr = r_int_begin(x),
                                              .size = r_length(x)};
    }

    FREE(1);
    *p_v_out = v_out;
    return shelter;
}

// FIXME: Does this have a place in the library?
void r_vec_poke_n(r_obj* x, r_ssize offset, r_obj* y, r_ssize from, r_ssize n) {

    if ((r_length(x) - offset) < n) {
        r_abort("Can't copy data to `x` because it is too small");
    }
    if ((r_length(y) - from) < n) {
        r_abort("Can't copy data from `y` because it is too small");
    }

    switch (r_typeof(x)) {
    case R_TYPE_logical: {
        int* src_data = r_lgl_begin(y);
        int* dest_data = r_lgl_begin(x);
        for (r_ssize i = 0; i != n; ++i) {
            dest_data[i + offset] = src_data[i + from];
        }
        break;
    }
    case R_TYPE_integer: {
        int* src_data = r_int_begin(y);
        int* dest_data = r_int_begin(x);
        for (r_ssize i = 0; i != n; ++i) {
            dest_data[i + offset] = src_data[i + from];
        }
        break;
    }
    case R_TYPE_double: {
        double* src_data = r_dbl_begin(y);
        double* dest_data = r_dbl_begin(x);
        for (r_ssize i = 0; i != n; ++i) {
            dest_data[i + offset] = src_data[i + from];
        }
        break;
    }
    case R_TYPE_complex: {
        r_complex* src_data = r_cpl_begin(y);
        r_complex* dest_data = r_cpl_begin(x);
        for (r_ssize i = 0; i != n; ++i) {
            dest_data[i + offset] = src_data[i + from];
        }
        break;
    }
    case R_TYPE_raw: {
        unsigned char* src_data = RAW(y);
        unsigned char* dest_data = RAW(x);
        for (r_ssize i = 0; i != n; ++i) {
            dest_data[i + offset] = src_data[i + from];
        }
        break;
    }
    case R_TYPE_character: {
        r_obj* elt;
        for (r_ssize i = 0; i != n; ++i) {
            elt = r_chr_get(y, i + from);
            r_chr_poke(x, i + offset, elt);
        }
        break;
    }
    case R_TYPE_list: {
        r_obj* elt;
        for (r_ssize i = 0; i != n; ++i) {
            elt = r_list_get(y, i + from);
            r_list_poke(x, i + offset, elt);
        }
        break;
    }
    default:
        r_abort("Copy requires vectors");
    }
}

void r_vec_poke_range(
    r_obj* x,
    r_ssize offset,
    r_obj* y,
    r_ssize from,
    r_ssize to
) {
    r_vec_poke_n(x, offset, y, from, to - from + 1);
}

bool _r_is_finite(r_obj* x) {
    r_ssize n = r_length(x);

    switch (r_typeof(x)) {
    case R_TYPE_integer: {
        const int* p_x = r_int_cbegin(x);
        for (r_ssize i = 0; i < n; ++i) {
            if (p_x[i] == r_globals.na_int) {
                return false;
            }
        }
        break;
    }
    case R_TYPE_double: {
        const double* p_x = r_dbl_cbegin(x);
        for (r_ssize i = 0; i < n; ++i) {
            if (!isfinite(p_x[i])) {
                return false;
            }
        }
        break;
    }
    case R_TYPE_complex: {
        const r_complex* p_x = r_cpl_cbegin(x);
        for (r_ssize i = 0; i < n; ++i) {
            if (!isfinite(p_x[i].r) || !isfinite(p_x[i].i)) {
                return false;
            }
        }
        break;
    }
    default:
        r_abort("Internal error: expected a numeric vector");
    }

    return true;
}
