/*
* Copyright (c) 2022 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/

#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif

#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>

/* Conditional compilation */
#ifdef JANET_INT_TYPES

#define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */

static int it_s64_get(void *p, Janet key, Janet *out);
static int it_u64_get(void *p, Janet key, Janet *out);
static Janet janet_int64_next(void *p, Janet key);
static Janet janet_uint64_next(void *p, Janet key);

static int32_t janet_int64_hash(void *p1, size_t size) {
    (void) size;
    int32_t *words = p1;
    return words[0] ^ words[1];
}

static int janet_int64_compare(void *p1, void *p2) {
    int64_t x = *((int64_t *)p1);
    int64_t y = *((int64_t *)p2);
    return x == y ? 0 : x < y ? -1 : 1;
}

static int janet_uint64_compare(void *p1, void *p2) {
    uint64_t x = *((uint64_t *)p1);
    uint64_t y = *((uint64_t *)p2);
    return x == y ? 0 : x < y ? -1 : 1;
}

static void int64_marshal(void *p, JanetMarshalContext *ctx) {
    janet_marshal_abstract(ctx, p);
    janet_marshal_int64(ctx, *((int64_t *)p));
}

static void *int64_unmarshal(JanetMarshalContext *ctx) {
    int64_t *p = janet_unmarshal_abstract(ctx, sizeof(int64_t));
    p[0] = janet_unmarshal_int64(ctx);
    return p;
}

static void it_s64_tostring(void *p, JanetBuffer *buffer) {
    char str[32];
    sprintf(str, "%" PRId64, *((int64_t *)p));
    janet_buffer_push_cstring(buffer, str);
}

static void it_u64_tostring(void *p, JanetBuffer *buffer) {
    char str[32];
    sprintf(str, "%" PRIu64, *((uint64_t *)p));
    janet_buffer_push_cstring(buffer, str);
}

const JanetAbstractType janet_s64_type = {
    "core/s64",
    NULL,
    NULL,
    it_s64_get,
    NULL,
    int64_marshal,
    int64_unmarshal,
    it_s64_tostring,
    janet_int64_compare,
    janet_int64_hash,
    janet_int64_next,
    JANET_ATEND_NEXT
};

const JanetAbstractType janet_u64_type = {
    "core/u64",
    NULL,
    NULL,
    it_u64_get,
    NULL,
    int64_marshal,
    int64_unmarshal,
    it_u64_tostring,
    janet_uint64_compare,
    janet_int64_hash,
    janet_uint64_next,
    JANET_ATEND_NEXT
};

int64_t janet_unwrap_s64(Janet x) {
    switch (janet_type(x)) {
        default:
            break;
        case JANET_NUMBER : {
            double dbl = janet_unwrap_number(x);
            if (fabs(dbl) <=  MAX_INT_IN_DBL)
                return (int64_t)dbl;
            break;
        }
        case JANET_STRING: {
            int64_t value;
            const uint8_t *str = janet_unwrap_string(x);
            if (janet_scan_int64(str, janet_string_length(str), &value))
                return value;
            break;
        }
        case JANET_ABSTRACT: {
            void *abst = janet_unwrap_abstract(x);
            if (janet_abstract_type(abst) == &janet_s64_type ||
                    (janet_abstract_type(abst) == &janet_u64_type))
                return *(int64_t *)abst;
            break;
        }
    }
    janet_panicf("bad s64 initializer: %t", x);
    return 0;
}

uint64_t janet_unwrap_u64(Janet x) {
    switch (janet_type(x)) {
        default:
            break;
        case JANET_NUMBER : {
            double dbl = janet_unwrap_number(x);
            /* Allow negative values to be cast to "wrap around".
             * This let's addition and subtraction work as expected. */
            if (fabs(dbl) <=  MAX_INT_IN_DBL)
                return (uint64_t)dbl;
            break;
        }
        case JANET_STRING: {
            uint64_t value;
            const uint8_t *str = janet_unwrap_string(x);
            if (janet_scan_uint64(str, janet_string_length(str), &value))
                return value;
            break;
        }
        case JANET_ABSTRACT: {
            void *abst = janet_unwrap_abstract(x);
            if (janet_abstract_type(abst) == &janet_s64_type ||
                    (janet_abstract_type(abst) == &janet_u64_type))
                return *(uint64_t *)abst;
            break;
        }
    }
    janet_panicf("bad u64 initializer: %t", x);
    return 0;
}

JanetIntType janet_is_int(Janet x) {
    if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
    const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
    return (at == &janet_s64_type) ? JANET_INT_S64 :
           ((at == &janet_u64_type) ? JANET_INT_U64 :
            JANET_INT_NONE);
}

Janet janet_wrap_s64(int64_t x) {
    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
    *box = (int64_t)x;
    return janet_wrap_abstract(box);
}

Janet janet_wrap_u64(uint64_t x) {
    uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
    *box = (uint64_t)x;
    return janet_wrap_abstract(box);
}

JANET_CORE_FN(cfun_it_s64_new,
              "(int/s64 value)",
              "Create a boxed signed 64 bit integer from a string value.") {
    janet_fixarity(argc, 1);
    return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}

JANET_CORE_FN(cfun_it_u64_new,
              "(int/u64 value)",
              "Create a boxed unsigned 64 bit integer from a string value.") {
    janet_fixarity(argc, 1);
    return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}

JANET_CORE_FN(cfun_to_number,
              "(int/to-number value)",
              "Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
    janet_fixarity(argc, 1);
    if (janet_type(argv[0]) == JANET_ABSTRACT) {
        void *abst = janet_unwrap_abstract(argv[0]);

        if (janet_abstract_type(abst) == &janet_s64_type) {
            int64_t value = *((int64_t *)abst);
            if (value > JANET_INTMAX_INT64) {
                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
            }
            if (value < -JANET_INTMAX_INT64) {
                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
            }
            return janet_wrap_number((double)value);
        }

        if (janet_abstract_type(abst) == &janet_u64_type) {
            uint64_t value = *((uint64_t *)abst);
            if (value > JANET_INTMAX_INT64) {
                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
            }

            return janet_wrap_number((double)value);
        }
    }

    janet_panicf("expected int/u64 or int/s64, got %q", argv[0]);
}

JANET_CORE_FN(cfun_to_bytes,
              "(int/to-bytes value &opt endianness buffer)",
              "Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
              "The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
              "Returns the modified buffer.\n"
              "The `endianness` paramater indicates the byte order:\n"
              "- `nil` (unset): system byte order\n"
              "- `:le`: little-endian, least significant byte first\n"
              "- `:be`: big-endian, most significant byte first\n") {
    janet_arity(argc, 1, 3);
    if (janet_is_int(argv[0]) == JANET_INT_NONE) {
        janet_panicf("int/to-bytes: expected an int/s64 or int/u64, got %q", argv[0]);
    }

    int reverse = 0;
    if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
        JanetKeyword endianness_kw = janet_getkeyword(argv, 1);
        if (!janet_cstrcmp(endianness_kw, "le")) {
#if JANET_BIG_ENDIAN
            reverse = 1;
#endif
        } else if (!janet_cstrcmp(endianness_kw, "be")) {
#if JANET_LITTLE_ENDIAN
            reverse = 1;
#endif
        } else {
            janet_panicf("int/to-bytes: expected endianness :le, :be or nil, got %v", argv[1]);
        }
    }

    JanetBuffer *buffer = NULL;
    if (argc > 2 && !janet_checktype(argv[2], JANET_NIL)) {
        if (!janet_checktype(argv[2], JANET_BUFFER)) {
            janet_panicf("int/to-bytes: expected buffer or nil, got %q", argv[2]);
        }

        buffer = janet_unwrap_buffer(argv[2]);
        janet_buffer_extra(buffer, 8);
    } else {
        buffer = janet_buffer(8);
    }

    uint8_t *bytes = janet_unwrap_abstract(argv[0]);
    if (reverse) {
        for (int i = 0; i < 8; ++i) {
            buffer->data[buffer->count + 7 - i] = bytes[i];
        }
    } else {
        memcpy(buffer->data + buffer->count, bytes, 8);
    }
    buffer->count += 8;

    return janet_wrap_buffer(buffer);
}

/*
 * Code to support polymorphic comparison.
 * int/u64 and int/s64 support a "compare" method that allows
 * comparison to each other, and to Janet numbers, using the
 * "compare" "compare<" ... functions.
 * In the following code explicit casts are sometimes used to help
 * make it clear when int/float conversions are happening.
 */
static int compare_double_double(double x, double y) {
    return (x < y) ? -1 : ((x > y) ? 1 : 0);
}

static int compare_int64_double(int64_t x, double y) {
    if (isnan(y)) {
        return 0; // clojure and python do this
    } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
        double dx = (double) x;
        return compare_double_double(dx, y);
    } else if (y > ((double) INT64_MAX)) {
        return -1;
    } else if (y < ((double) INT64_MIN)) {
        return 1;
    } else {
        int64_t yi = (int64_t) y;
        return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
    }
}

static int compare_uint64_double(uint64_t x, double y) {
    if (isnan(y)) {
        return 0; // clojure and python do this
    } else if (y < 0) {
        return 1;
    } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
        double dx = (double) x;
        return compare_double_double(dx, y);
    } else if (y > ((double) UINT64_MAX)) {
        return -1;
    } else {
        uint64_t yi = (uint64_t) y;
        return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
    }
}

static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
    janet_fixarity(argc, 2);
    if (janet_is_int(argv[0]) != JANET_INT_S64)
        janet_panic("compare method requires int/s64 as first argument");
    int64_t x = janet_unwrap_s64(argv[0]);
    switch (janet_type(argv[1])) {
        default:
            break;
        case JANET_NUMBER : {
            double y = janet_unwrap_number(argv[1]);
            return janet_wrap_number(compare_int64_double(x, y));
        }
        case JANET_ABSTRACT: {
            void *abst = janet_unwrap_abstract(argv[1]);
            if (janet_abstract_type(abst) == &janet_s64_type) {
                int64_t y = *(int64_t *)abst;
                return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
            } else if (janet_abstract_type(abst) == &janet_u64_type) {
                // comparing signed to unsigned -- be careful!
                uint64_t y = *(uint64_t *)abst;
                if (x < 0) {
                    return janet_wrap_number(-1);
                } else if (y > INT64_MAX) {
                    return janet_wrap_number(-1);
                } else {
                    int64_t y2 = (int64_t) y;
                    return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
                }
            }
            break;
        }
    }
    return janet_wrap_nil();
}

static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
    janet_fixarity(argc, 2);
    if (janet_is_int(argv[0]) != JANET_INT_U64)  // is this needed?
        janet_panic("compare method requires int/u64 as first argument");
    uint64_t x = janet_unwrap_u64(argv[0]);
    switch (janet_type(argv[1])) {
        default:
            break;
        case JANET_NUMBER : {
            double y = janet_unwrap_number(argv[1]);
            return janet_wrap_number(compare_uint64_double(x, y));
        }
        case JANET_ABSTRACT: {
            void *abst = janet_unwrap_abstract(argv[1]);
            if (janet_abstract_type(abst) == &janet_u64_type) {
                uint64_t y = *(uint64_t *)abst;
                return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
            } else if (janet_abstract_type(abst) == &janet_s64_type) {
                // comparing unsigned to signed -- be careful!
                int64_t y = *(int64_t *)abst;
                if (y < 0) {
                    return janet_wrap_number(1);
                } else if (x > INT64_MAX) {
                    return janet_wrap_number(1);
                } else {
                    int64_t x2 = (int64_t) x;
                    return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
                }
            }
            break;
        }
    }
    return janet_wrap_nil();
}

/*
 * In C, signed arithmetic overflow is undefined behvior
 * but unsigned arithmetic overflow is twos complement
 *
 * Reference:
 * https://en.cppreference.com/w/cpp/language/ub
 * http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
 *
 * This means OPMETHOD & OPMETHODINVERT must always use
 * unsigned arithmetic internally, regardless of the true type.
 * This will not affect the end result (property of twos complement).
 */
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_arity(argc, 2, -1); \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[0]); \
    for (int32_t i = 1; i < argc; i++) \
        /* This avoids undefined behavior. See above for why. */ \
        *box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
    return janet_wrap_abstract(box); \
} \

#define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_fixarity(argc, 2); \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[1]); \
    /* This avoids undefined behavior. See above for why. */ \
    *box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
    return janet_wrap_abstract(box); \
} \

#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_arity(argc, 2, -1);                       \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[0]); \
    for (int32_t i = 1; i < argc; i++) { \
      T value = janet_unwrap_##type(argv[i]); \
      if (value == 0) janet_panic("division by zero"); \
      *box oper##= value; \
    } \
    return janet_wrap_abstract(box); \
} \

#define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_fixarity(argc, 2);                       \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[1]); \
    T value = janet_unwrap_##type(argv[0]); \
    if (value == 0) janet_panic("division by zero"); \
    *box oper##= value; \
    return janet_wrap_abstract(box); \
} \

#define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_arity(argc, 2, -1);                       \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[0]); \
    for (int32_t i = 1; i < argc; i++) { \
      T value = janet_unwrap_##type(argv[i]); \
      if (value == 0) janet_panic("division by zero"); \
      if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
      *box oper##= value; \
    } \
    return janet_wrap_abstract(box); \
} \

#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
    janet_fixarity(argc, 2);                       \
    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
    *box = janet_unwrap_##type(argv[1]); \
    T value = janet_unwrap_##type(argv[0]); \
    if (value == 0) janet_panic("division by zero"); \
    if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
    *box oper##= value; \
    return janet_wrap_abstract(box); \
} \

static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
    janet_fixarity(argc, 2);
    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
    int64_t op1 = janet_unwrap_s64(argv[0]);
    int64_t op2 = janet_unwrap_s64(argv[1]);
    int64_t x = op1 % op2;
    *box = (op1 > 0)
           ? ((op2 > 0) ? x : (0 == x ? x : x + op2))
           : ((op2 > 0) ? (0 == x ? x : x + op2) : x);
    return janet_wrap_abstract(box);
}

OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -)
OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>)
OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, subi, -)
OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
OPMETHOD(uint64_t, u64, lshift, <<)
OPMETHOD(uint64_t, u64, rshift, >>)

#undef OPMETHOD
#undef DIVMETHOD
#undef DIVMETHOD_SIGNED
#undef COMPMETHOD

static JanetMethod it_s64_methods[] = {
    {"+", cfun_it_s64_add},
    {"r+", cfun_it_s64_add},
    {"-", cfun_it_s64_sub},
    {"r-", cfun_it_s64_subi},
    {"*", cfun_it_s64_mul},
    {"r*", cfun_it_s64_mul},
    {"/", cfun_it_s64_div},
    {"r/", cfun_it_s64_divi},
    {"mod", cfun_it_s64_mod},
    {"rmod", cfun_it_s64_mod},
    {"%", cfun_it_s64_rem},
    {"r%", cfun_it_s64_rem},
    {"&", cfun_it_s64_and},
    {"r&", cfun_it_s64_and},
    {"|", cfun_it_s64_or},
    {"r|", cfun_it_s64_or},
    {"^", cfun_it_s64_xor},
    {"r^", cfun_it_s64_xor},
    {"<<", cfun_it_s64_lshift},
    {">>", cfun_it_s64_rshift},
    {"compare", cfun_it_s64_compare},
    {NULL, NULL}
};

static JanetMethod it_u64_methods[] = {
    {"+", cfun_it_u64_add},
    {"r+", cfun_it_u64_add},
    {"-", cfun_it_u64_sub},
    {"r-", cfun_it_u64_subi},
    {"*", cfun_it_u64_mul},
    {"r*", cfun_it_u64_mul},
    {"/", cfun_it_u64_div},
    {"r/", cfun_it_u64_divi},
    {"mod", cfun_it_u64_mod},
    {"rmod", cfun_it_u64_mod},
    {"%", cfun_it_u64_mod},
    {"r%", cfun_it_u64_mod},
    {"&", cfun_it_u64_and},
    {"r&", cfun_it_u64_and},
    {"|", cfun_it_u64_or},
    {"r|", cfun_it_u64_or},
    {"^", cfun_it_u64_xor},
    {"r^", cfun_it_u64_xor},
    {"<<", cfun_it_u64_lshift},
    {">>", cfun_it_u64_rshift},
    {"compare", cfun_it_u64_compare},
    {NULL, NULL}
};

static Janet janet_int64_next(void *p, Janet key) {
    (void) p;
    return janet_nextmethod(it_s64_methods, key);
}

static Janet janet_uint64_next(void *p, Janet key) {
    (void) p;
    return janet_nextmethod(it_u64_methods, key);
}

static int it_s64_get(void *p, Janet key, Janet *out) {
    (void) p;
    if (!janet_checktype(key, JANET_KEYWORD))
        return 0;
    return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods, out);
}

static int it_u64_get(void *p, Janet key, Janet *out) {
    (void) p;
    if (!janet_checktype(key, JANET_KEYWORD))
        return 0;
    return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
}

/* Module entry point */
void janet_lib_inttypes(JanetTable *env) {
    JanetRegExt it_cfuns[] = {
        JANET_CORE_REG("int/s64", cfun_it_s64_new),
        JANET_CORE_REG("int/u64", cfun_it_u64_new),
        JANET_CORE_REG("int/to-number", cfun_to_number),
        JANET_CORE_REG("int/to-bytes", cfun_to_bytes),
        JANET_REG_END
    };
    janet_core_cfuns_ext(env, NULL, it_cfuns);
    janet_register_abstract_type(&janet_s64_type);
    janet_register_abstract_type(&janet_u64_type);
}

#endif