/**
 * Modern Albufeira Prolog Interpreter
 *
 * Warranty & Liability
 * To the extent permitted by applicable law and unless explicitly
 * otherwise agreed upon, XLOG Technologies AG makes no warranties
 * regarding the provided information. XLOG Technologies AG assumes
 * no liability that any problems might be solved with the information
 * provided by XLOG Technologies AG.
 *
 * Rights & License
 * All industrial property rights regarding the information - copyright
 * and patent rights in particular - are the sole property of XLOG
 * Technologies AG. If the company was not the originator of some
 * excerpts, XLOG Technologies AG has at least obtained the right to
 * reproduce, change and translate the information.
 *
 * Reproduction is restricted to the whole unaltered document. Reproduction
 * of the information is only allowed for non-commercial uses. Selling,
 * giving away or letting of the execution of the library is prohibited.
 * The library can be distributed as part of your applications and libraries
 * for execution provided this comment remains unchanged.
 *
 * Restrictions
 * Only to be distributed with programs that add significant and primary
 * functionality to the library. Not to be distributed with additional
 * software intended to replace any components of the library.
 *
 * Trademarks
 * Jekejeke is a registered trademark of XLOG Technologies AG.
 */

import {
    add, is_variable, Compound, is_structure, engine,
    Item, stack_push, stack_peek, stack_pop,
    VAR_MASK_SERNO
} from "./store.mjs";
import {
    call, cont, deref, is_atom, is_number, union_undo,
    union_find, union_add, exec_deref, is_pending,
    is_integer, make_error, unify, exec_build, exec_unify,
    trail, unbind, Choice, more, exec_eval
} from "./machine.mjs";
import {
    check_integer, is_bigint, norm_bigint, widen_bigint,
    norm_smallint, norm_float, narrow_float, make_special,
    check_atom, make_arithmetic, make_check,
    char_count, check_nil, MAX_ARITY,
} from "./special.mjs";
import {
    last_code
} from "./runtime.mjs";

/*********************************************************************/
/* is/2                                                              */
/*********************************************************************/

/**
 * X is Y: [ISO 8.6.1]
 * The predicate succeeds in X with the evaluation of Y.
 */
function test_eval(args) {
    let res = exec_eval(args[1]);
    return exec_unify(args[0], res);
}

/*********************************************************************/
/* (-)/2, (+)/3, (-)/3, (*)/3, (/)/3, (//)/3 and (rem)/3.            */
/*********************************************************************/

/**
 * -(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the negation of A.
 */
function arit_neg(args) {
    let alpha = exec_eval(args[0]);
    return -alpha;
}

/**
 * +(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with the sum of A and B.
 */
function arit_add(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (!is_bigint(alpha) && !is_bigint(beta)) {
            return norm_smallint(alpha + beta);
        } else {
            return norm_bigint(widen_bigint(alpha) + widen_bigint(beta));
        }
    } else {
        return norm_float(narrow_float(alpha) + narrow_float(beta));
    }
}

/**
 * -(A, B, C):
 * The predicate succeeds in C with A subtracted by B.
 */
function arit_sub(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (!is_bigint(alpha) && !is_bigint(beta)) {
            return norm_smallint(alpha - beta);
        } else {
            return norm_bigint(widen_bigint(alpha) - widen_bigint(beta));
        }
    } else {
        return norm_float(narrow_float(alpha) - narrow_float(beta));
    }
}

/**
 * *(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with the product of A and B.
 */
function arit_mul(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (!is_bigint(alpha) && !is_bigint(beta)) {
            return norm_smallint(alpha * beta);
        } else {
            return norm_bigint(widen_bigint(alpha) * widen_bigint(beta));
        }
    } else {
        return norm_float(narrow_float(alpha) * narrow_float(beta));
    }
}

/**
 * /(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with A float divided by B.
 */
function arit_quot(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    beta = narrow_float(beta);
    if (beta === 0)
        throw make_error(new Compound("evaluation_error",["zero_divisor"]));
    return norm_float(narrow_float(alpha) / beta);
}

/**
 * //(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with A truncate divided by B.
 */
function arit_intquot(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (beta === 0)
            throw make_error(new Compound("evaluation_error",["zero_divisor"]));
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return Math.trunc(alpha / beta);
    } else {
        return norm_bigint(widen_bigint(alpha) / widen_bigint(beta));
    }
}

/**
 * rem(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with A remainder B.
 */
function arit_rem(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (beta === 0)
        throw make_error(new Compound("evaluation_error",["zero_divisor"]));
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return alpha % beta;
    } else {
        return norm_bigint(widen_bigint(alpha) % widen_bigint(beta));
    }
}

/*********************************************************************/
/* float/1, (^)/3, div/3 and mod/3.                                  */
/*********************************************************************/

/**
 * float(A, B): [ISO 9.17]
 * The predicate succeeds in B with the approximated A.
 */
function arit_float(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        return norm_float(narrow_float(alpha));
    } else {
        return alpha;
    }
}

/**
 * ^(A, B, C): [TC2 9.3.10]
 * The predicate succeeds in C with A int power by B.
 */
function arit_intpow(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (beta < 0)
            throw make_error(new Compound("domain_error",
                ["not_less_than_zero", beta]));
        if (!is_bigint(alpha) && !is_bigint(beta)) {
            if ((32 - Math.clz32(Math.abs(alpha))) * beta < 53) {
                return norm_smallint(Math.pow(alpha, beta));
            } else {
                return norm_bigint(widen_bigint(alpha) ** widen_bigint(beta));
            }
        } else {
            return norm_bigint(widen_bigint(alpha) ** widen_bigint(beta));
        }
    } else {
        return norm_float(Math.pow(narrow_float(alpha), narrow_float(beta)));
    }
}

/**
 * div(A, B, C): [TC2 9.1.3]
 * The predicate succeeds in C with A floor divided by B.
 */
function arit_div(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (beta === 0)
        throw make_error(new Compound("evaluation_error", ["zero_divisor"]));
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return Math.floor(alpha / beta);
    } else {
        return norm_bigint(bigint_div(
            widen_bigint(alpha), widen_bigint(beta)));
    }
}

function bigint_div(alpha, beta) {
    let temp = alpha / beta;
    if ((alpha < 0n) !== (beta < 0n)) {
        let res = alpha % beta;
        if (res !== 0n)
            temp--;
    }
    return temp;
}

/**
 * mod(A, B, C): [ISO 9.1.7]
 * The predicate succeeds in C with A modulus B.
 */
function arit_mod(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (beta === 0)
        throw make_error(new Compound("evaluation_error",["zero_divisor"]));
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return smallint_mod(alpha, beta);
    } else {
        return norm_bigint(bigint_mod(
            widen_bigint(alpha), widen_bigint(beta)));
    }
}


function smallint_mod(alpha, beta) {
    let res = alpha % beta;
    if ((alpha < 0) !== (beta < 0)) {
        if (res !== 0)
            res += beta;
    }
    return res;
}

function bigint_mod(alpha, beta) {
    let res = alpha % beta;
    if ((alpha < 0n) !== (beta < 0n)) {
        if (res !== 0n)
            res += beta;
    }
    return res;
}

/*********************************************************************/
/* abs/2, sign/2, min/3 and max/3                                    */
/*********************************************************************/

/**
 * abs(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the absolute value of A.
 */
function arit_abs(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        if (alpha < 0) {
            return -alpha;
        } else {
            return alpha;
        }
    } else {
        return norm_float(Math.abs(narrow_float(alpha)));
    }
}

/**
 * sign(A, B): [ISO 9.1.4]
 * The predicate succeeds in B with the sign of A.
 */
function arit_sign(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        if (alpha < 0) {
            return -1;
        } else if (alpha > 0) {
            return 1;
        } else {
            return 0;
        }
    } else {
        return norm_float(Math.sign(narrow_float(alpha)));
    }
}

/**
 * min(A, B, C): [TC2 9.3.9]
 * The predicate succeeds in C with the minimum of A and B.
 */
function arit_min(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (alpha < beta) {
            return alpha;
        } else {
            return beta;
        }
    } else {
        return norm_float(Math.min(
            narrow_float(alpha), narrow_float(beta)));
    }
}

/**
 * max(A, B, C): [TC2 9.3.8]
 * The predicate succeeds in C with the maximum of A and B.
 */
function arit_max(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_integer(alpha) && is_integer(beta)) {
        if (alpha > beta) {
            return alpha;
        } else {
            return beta;
        }
    } else {
        return norm_float(Math.max(
            narrow_float(alpha), narrow_float(beta)));
    }
}

/*********************************************************************/
/* truncate/2, floor/2, ceiling/2 and round/2                        */
/*********************************************************************/

/**
 * truncate(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the truncate of A.
 */
function arit_truncate(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        return alpha;
    } else {
        return norm_smallint(Math.trunc(narrow_float(alpha)));
    }
}

/**
 * floor(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the floor of A.
 */
function arit_floor(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        return alpha;
    } else {
        return norm_smallint(Math.floor(narrow_float(alpha)));
    }
}

/**
 * ceiling(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the ceiling of A.
 */
function arit_ceiling(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        return alpha;
    } else {
        return norm_smallint(Math.ceil(narrow_float(alpha)));
    }
}

/**
 * round(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the rounding of A.
 */
function arit_round(args) {
    let alpha = exec_eval(args[0]);
    if (is_integer(alpha)) {
        return alpha;
    } else {
        return norm_smallint(Math.round(narrow_float(alpha)));
    }
}

/*********************************************************************/
/* =:=/2, =\=/2, </2, >=/2, >/2 and =</2                             */
/*********************************************************************/

/**
 * X =:= Y: [ISO 8.7.1]
 * The predicate succeeds when X number equals Y, otherwise fails.
 */
function test_numberequal(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return number_equal(alpha, beta);
}

/**
 * X =\= Y: [ISO 8.7.1]
 * The predicate succeeds when X does not number equal Y, otherwise fails.
 */
function test_numbernotequal(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return !number_equal(alpha, beta);
}

/**
 * Determine whether two Prolog numbers are equal.
 *
 * @param alpha The first Prolog number.
 * @param beta The second Prolog number.
 * @return boolean True if the two Prolog numbers are equal.
 */
function number_equal(alpha, beta) {
    if (is_integer(alpha) && is_integer(beta)) {
        return alpha === beta;
    } else {
        return narrow_float(alpha) === narrow_float(beta);
    }
}

/**
 * X < Y: [ISO 8.7.1]
 * The predicate succeeds when X is number less than Y, otherwise fails.
 */
function test_numberless(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return number_less(alpha, beta);
}

/**
 * X >= Y: [ISO 8.7.1]
 * The predicate succeeds when X is number greater or equal to Y, otherwise fails.
 */
function test_numbergreaterequal(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return !number_less(alpha, beta);
}

/**
 * X > Y: [ISO 8.7.1]
 * The predicate succeeds when X is number greater than Y, otherwise fails.
 */
function test_numbergreater(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return number_less(beta, alpha);
}

/**
 * X =< Y: [ISO 8.7.1]
 * The predicate succeeds when X is number less or equal to Y, otherwise fails.
 */
function test_numberlessequal(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return !number_less(beta, alpha);
}

/**
 * Determine whether a Prolog numbers is less than a Prolog number.
 *
 * @param alpha The first Prolog number.
 * @param beta The second Prolog number.
 * @return boolean True if the two Prolog numbers are equal.
 */
function number_less(alpha, beta) {
    if (is_integer(alpha) && is_integer(beta)) {
        return alpha < beta;
    } else {
        return narrow_float(alpha) < narrow_float(beta);
    }
}

/*********************************************************************/
/* sin/3, cos/2, tan/2, asin/2, acos/2, atan/2 and pi/1.             */
/*********************************************************************/

/**
 * sin(A, B): [ISO 9.3.2]
 * The predicate succeeds in B with the sine of A.
 */
function arit_sin(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.sin(narrow_float(alpha)));
}

/**
 * cos(A, B): [ISO 9.3.3]
 * The predicate succeeds in B with the cosine of A.
 */
function arit_cos(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.cos(narrow_float(alpha)));
}

/**
 * tan(A, B): [TC2 9.3.14]
 * The predicate succeeds in B with the tangent of A.
 */
function arit_tan(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.tan(narrow_float(alpha)));
}

/**
 * asin(A, B): [TC2 9.3.11]
 * The predicate succeeds in B with the arcus sine of A.
 */
function arit_asin(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.asin(narrow_float(alpha)));
}

/**
 * acos(A, B): [TC2 9.3.12]
 * The predicate succeeds in B with the arcus cosine of A.
 */
function arit_acos(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.acos(narrow_float(alpha)));
}

/**
 * atan(A, B): [ISO 9.3.4]
 * The predicate succeeds in B with the arcus tangent of A.
 */
function arit_atan(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.atan(narrow_float(alpha)));
}

/**
 * pi(A): [TC2 9.3.15]
 * The predicate succeeds in A with π.
 */
function arit_pi(args) {
    return Math.PI;
}

/*********************************************************************/
/* (**)/3, exp/2, log/2, sqrt/2, e/1, epsilon/1 and atan2/3          */
/*********************************************************************/

/**
 * **(A, B, C): [ISO 9.3.1]
 * The predicate succeeds in C with A float power by B.
 */
function arit_pow(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    return norm_float(Math.pow(narrow_float(alpha), narrow_float(beta)));
}

/**
 * exp(A, B): [ISO 9.3.5]
 * The predicate succeeds in B with e power by A.
 */
function arit_exp(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.exp(narrow_float(alpha)));
}

/**
 * log(A, B): [ISO 9.3.6]
 * The predicate succeeds in B with the natural logarithm of A.
 */
function arit_log(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.log(narrow_float(alpha)));
}

/**
 * sqrt(A, B): [ISO 9.3.7]
 * The predicate succeeds in B with the square root of A.
 */
function arit_sqrt(args) {
    let alpha = exec_eval(args[0]);
    return norm_float(Math.sqrt(narrow_float(alpha)));
}

/**
 * e(A): [N208 9.7.2]
 * The predicate succeeds in A with the Euler number.
 */
function arit_e(args) {
    return Math.E;
}

/**
 * epsilon(A): [N208 9.7.3]
 * The predicate succeeds in A with the machine epsilon.
 */
function arit_epsilon(args) {
    return Number.EPSILON;
}

/**
 * atan2(A, B, C): [TC2 9.3.13]
 * The predicate succeeds in C with the arc tangent of A and B.
 */
function arit_atan2(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    alpha = narrow_float(alpha);
    beta = narrow_float(beta);
    if (alpha === 0 && beta === 0) {
        throw make_error(new Compound("evaluation_error", ["undefined"]));
    } else {
        return norm_float(Math.atan2(alpha, beta));
    }
}

/*********************************************************************/
/* (\)/2, (/\)/3, (\/)/3, (xor)/3, (>>)/3 and (<</3)                 */
/*********************************************************************/

/**
 * \(A, B): [ISO 9.4.5]
 * The predicate succeeds in B with the bitwise not of A.
 */
function arit_not(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    return ~alpha;
}

/**
 * /\(A, B, C): [ISO 9.4.3]
 * The predicate succeeds in C with the bitwise and of A and B.
 */
function arit_and(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return alpha & beta;
    } else {
        return norm_bigint(widen_bigint(alpha) & widen_bigint(beta));
    }
}

/**
 * \/(A, B, C): [ISO 9.4.4]
 * The predicate succeeds in C with the bitwise or of A and B.
 */
function arit_or(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return norm_smallint(alpha | beta);
    } else {
        return norm_bigint(widen_bigint(alpha) | widen_bigint(beta));
    }
}

/**
 * xor(A, B, C): [TC2 9.4.6]
 * The predicate succeeds in C with the bitwise xor of A and B.
 */
function arit_xor(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        return norm_smallint(alpha ^ beta);
    } else {
        return norm_bigint(widen_bigint(alpha) ^ widen_bigint(beta));
    }
}

/**
 * >>(A, B, C): [ISO 9.4.1]
 * The predicate succeeds in C with A shift right by B.
 */
function arit_shiftright(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        if (0 <= beta && beta < 32) {
            return alpha >> beta;
        } else if (0 > beta && beta < Math.clz32(Math.abs(alpha)) - 1) {
            return norm_smallint(alpha << -beta);
        } else {
            return norm_bigint(widen_bigint(alpha) >> widen_bigint(beta));
        }
    } else {
        return norm_bigint(widen_bigint(alpha) >> widen_bigint(beta));
    }
}

/**
 * <<(A, B, C): [ISO 9.4.2]
 * The predicate succeeds in C with A shift left by B.
 */
function arit_shiftleft(args) {
    let alpha = exec_eval(args[0]);
    check_integer(alpha);
    let beta = exec_eval(args[1]);
    check_integer(beta);
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        if (0 < beta && beta < Math.clz32(Math.abs(alpha)) - 1) {
            return norm_smallint(alpha << beta);
        } else if (0 >= beta && -beta < 32) {
            return alpha >> -beta;
        } else {
            return norm_bigint(widen_bigint(alpha) << widen_bigint(beta));
        }
    } else {
        return norm_bigint(widen_bigint(alpha) << widen_bigint(beta));
    }
}

/*********************************************************************/
/* ==/2, \==/2, @<, @=<, @>, @>= and compare/3                       */
/*********************************************************************/

/**
 * S == T: [ISO 8.4.1]
 * The built-in succeeds when S and T are syntactically equivalent
 * Prolog terms, otherwise the built-in fails.
 */
function test_equal(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return equal_term(alpha, beta);
}

/**
 * S \== T: [ISO 8.4.1]
 * The built-in succeeds when S and T are not syntactically equivalent
 * Prolog terms, otherwise the built-in fails.
 */
function test_notequal(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return !equal_term(alpha, beta);
}

/**
 * Determine whether two Prolog terms are syntactically equivalent.
 * Can handle cyclic terms and deep recursion.
 *
 * @param first The first Prolog term.
 * @param second The second Prolog term.
 * @return boolean True if they are syntactically equivalent, otherwise false.
 */
export function equal_term(first, second) {
    let stack = null;
    let log = null;
    try {
        for (; ;) {
            first = deref(first);
            second = deref(second);
            if (!is_structure(first)) {
                if (first !== second)
                    break;
            } else if (!is_structure(second)) {
                break;
            } else if (first.args.length !== second.args.length) {
                break;
            } else {
                first = union_find(first);
                second = union_find(second);
                if (first.functor !== second.functor) {
                    break;
                } else if (first !== second) {
                    log = union_add(log, first, second);
                    if (0 !== first.args.length - 1) {
                        let item = new Item(first, second, 0);
                        stack = stack_push(stack, item);
                    }
                    first = first.args[0];
                    second = second.args[0];
                    continue;
                }
            }
            let item = stack_peek(stack);
            if (item === null) {
                return true;
            } else {
                item.idx++;
                first = item.first.args[item.idx];
                second = item.second.args[item.idx];
                if (item.idx === item.first.args.length - 1)
                    stack_pop(stack);
            }
        }
        return false;
    } finally {
        union_undo(log);
    }
}

/*********************************************************************/
/* same_term/2 and hash_code/2                                       */
/*********************************************************************/

/**
 * same_term(A, B):
 * The built-in succeeds when A and B are equal objects,
 * otherwise the built-in fails.
 */
function test_same_term(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return (alpha === beta);
}

/**
 * hash_code(X, H):
 * The predicate succeeds in H with the hash code of the term X.
 */
function test_hash_code(args) {
    let alpha = exec_build(args[0]);
    alpha = norm_smallint(object_hash_code(alpha));
    return exec_unify(args[1], alpha);
}

/**
 * Compute the hash code of an object
 *
 * @param alpha The object.
 * @return The hash code, a signed 32-bit integer
 */
export function object_hash_code(alpha) {
    if (is_variable(alpha)) {
        return variable_serno(alpha);
    } else if (is_atom(alpha)) {
        let res = 0;
        for (let i = 0; i < alpha.length; i++)
            res = (res * 31 + alpha.charCodeAt(i)) | 0;
        return res;
    } else if (is_number(alpha)) {
        if (is_integer(alpha)) {
            if (!is_bigint(alpha)) {
                return alpha;
            } else {
                let sign;
                if (alpha < 0) {
                    sign = -1;
                    alpha = -alpha;
                } else {
                    sign = 1;
                }
                alpha = alpha.toString(16);
                let res = 0;
                let i = alpha.length % 8;
                if (i > 0)
                    res = parseInt(alpha.substring(0, i), 16) | 0;
                for (; i < alpha.length; i += 8)
                    res = (res * 31 + parseInt(alpha.substring(i, i + 8), 16)) | 0;
                return res * sign;
            }
        } else {
            let beta = new Float64Array(1);
            beta[0] = narrow_float(alpha);
            let gamma = new Int32Array(beta.buffer);
            return gamma[0] ^ gamma[1];
        }
    } else if (alpha === null) {
        return 0;
    } else if (alpha === true) {
        return 1231;
    } else if (alpha === false) {
        return 1237;
    } else {
        return 2467;
    }
}

export function variable_serno(alpha) {
    let val = alpha.flags & VAR_MASK_SERNO;
    if (val === VAR_MASK_SERNO) {
        if (engine.low < engine.high) {
            val = engine.low;
            engine.low = val + 1;
        } else {
            val = engine.serno;
            engine.serno = val + 1;
        }
        alpha.flags &= ~VAR_MASK_SERNO;
        alpha.flags |= val;
    }
    return val;
}

/*********************************************************************/
/* atom_codes/2 and char_code/2                                      */
/*********************************************************************/

/**
 * atom_codes(A, L): [ISO 8.16.5]
 * If A is a variable, the built-in succeeds in A with the atom
 * for the Prolog list L. Otherwise the built-in succeeds in L
 * with the Prolog list from the atom A.
 */
function test_atom_codes(args) {
    let text = exec_deref(args[0]);
    if (is_variable(text) || is_pending(text)) {
        let res = exec_build(args[1]);
        res = atom_codes_pack(res);
        return exec_unify(text, res);
    } else {
        text = exec_build(text);
        check_atom(text);
        text = atom_codes_unpack(text);
        return exec_unify(args[1], text);
    }
}

function atom_codes_pack(peek) {
    let temp = peek;
    let i = 0;
    while (is_structure(temp) && temp.functor === "."
    && temp.args.length === 2 && i < MAX_ARITY) {
        let ch = deref(temp.args[0]);
        check_integer(ch);
        if (ch < 0 || ch > 0x10FFFF)
            throw make_error(new Compound("type_error", ["character_code", ch]));
        i++;
        temp = deref(temp.args[1]);
    }
    check_nil(temp);
    let res = new Array(i);
    temp = peek;
    i = 0;
    while (is_structure(temp) && temp.functor === "." && temp.args.length === 2) {
        let ch = deref(temp.args[0]);
        res[i++] = ch;
        temp = deref(temp.args[1]);
    }
    return String.fromCodePoint(...res);
}

function atom_codes_unpack(text) {
    let back = null;
    let res;
    let i = 0;
    while (i < text.length) {
        let ch = text.codePointAt(i);
        let peek = new Compound(".", [ch, undefined]);
        if (back !== null) {
            back.args[1] = peek;
        } else {
            res = peek;
        }
        back = peek;
        i += char_count(ch);
    }
    if (back !== null) {
        back.args[1] = "[]";
    } else {
        res = "[]";
    }
    return res;
}

/**
 * char_code(C, N): [ISO 8.16.6]
 * If C is a variable, the built-in succeeds in C with the
 * character for the code N. Otherwise the built-in succeeds
 * in N with the code from character C.
 */
function test_char_code(args) {
    let text = exec_deref(args[0]);
    if (is_variable(text) || is_pending(text)) {
        let ch = exec_build(args[1]);
        check_integer(ch);
        if (ch < 0 || ch > 0x10FFFF)
            throw make_error(new Compound("type_error",
                ["character_code", ch]));
        ch = String.fromCodePoint(ch);
        return exec_unify(text, ch);
    } else {
        text = exec_build(text);
        check_atom(text);
        let ch;
        if (text.length === 0 ||
            text.length !== char_count(ch = text.codePointAt(0)))
            throw make_error(new Compound("type_error",
                ["character", text]));
        return exec_unify(args[1], ch);
    }
}

/*********************************************************************/
/* atom_length/2 and atom_concat/3                                   */
/*********************************************************************/

/**
 * atom_length(X, Y): [ISO 8.16.1]
 * The predicate succeeds in Y with the length of the atom X.
 */
function test_atom_length(args) {
    let text = exec_build(args[0]);
    check_atom(text);
    let res = atom_count(text, 0, text.length);
    return exec_unify(args[1], norm_smallint(res));
}

function atom_count(text, from, to) {
    let res = 0;
    while (from < to) {
        let ch = text.codePointAt(from);
        from += char_count(ch);
        res ++;
    }
    return res;
}

/**
 * atom_concat(X, Y, Z): [ISO 8.16.2]
 * The built-in succeeds when Z is the concatenation of X and Y.
 */
function special_atom_concat(args) {
    let first = deref(args[0]);
    let second = deref(args[1]);
    let third = deref(args[2]);
    if (is_variable(second)) {
        if (is_variable(first)) {
            check_atom(third);
            return solve2_concat(args, null, 0, null);
        } else {
            check_atom(first);
            check_atom(third);
            if (!third.startsWith(first))
                return false;
            if (!unify(second, third.substring(first.length)))
                return false;
        }
    } else if (is_variable(first)) {
        check_atom(second);
        check_atom(third);
        if (!third.endsWith(second))
            return false;
        if (!unify(first, third.substring(0,third.length-second.length)))
            return false;
    } else {
        check_atom(first);
        check_atom(second);
        if (!unify(third, first + second))
            return false;
    }
    cont(call.args[1]);
    return true;
}

function solve_concat(rope, at, choice) {
    let goal = deref(call.args[0]);
    return solve2_concat(goal.args, rope, at, choice);
}

function solve2_concat(args, rope, at, choice) {
    let text = deref(args[2]);
    let mark = trail;
    while (at <= text.length) {
        if (unify(args[0], text.substring(0, at)) &&
            unify(args[1], text.substring(at))) {
            at = atom_succ(text,at);
            if (at <= text.length) {
                if (choice === null) {
                    choice = new Choice(solve_concat, null, at, mark);
                } else {
                    choice.at = at;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
        at = atom_succ(text,at);
    }
    return false;
}

function atom_offset(text,pos,alpha) {
    if (alpha < 0)
        return -1;
    while (alpha > 0 && pos < text.length) {
        let ch = text.codePointAt(pos);
        pos += char_count(ch);
        alpha--;
    }
    if (alpha > 0)
        return -1;
    return pos;
}

function atom_succ(text, at) {
    if (at < text.length) {
        let ch = text.codePointAt(at);
        return at + char_count(ch);
    } else {
        return at + 1;
    }
}

/*********************************************************************/
/* atom_join/2                                                       */
/*********************************************************************/

/**
 * atom_join(L, A):
 * The built-in succeeds in A with the join of the atoms L.
 */
function test_atom_join(args) {
    let alpha = exec_build(args[0]);
    let res = atom_join(alpha);
    return exec_unify(args[1], res);
}

function atom_join(res) {
    let peek = res;
    let i = 0;
    while (is_structure(peek) &&
        peek.functor === "." &&
        peek.args.length === 2 &&
        i < MAX_ARITY) {
        i++;
        peek = deref(peek.args[1]);
    }
    check_nil(peek);
    let elems = new Array(i);
    peek = res;
    i = 0;
    while (is_structure(peek) &&
        peek.functor === "." &&
        peek.args.length === 2) {
        let val = deref(peek.args[0]);
        check_atom(val);
        elems[i++] = val;
        peek = deref(peek.args[1]);
    }
    return elems.join("");
}

/*********************************************************************/
/* sys_atom_match/3 and sys_atom_part/4                              */
/*********************************************************************/

/**
 * sys_atom_match(X, Y, Z):
 * The built-in succeeds if X has substring Y at Z.
 */
function special_sys_atom_match(args) {
    let text = deref(args[0]);
    check_atom(text);
    let part = deref(args[1]);
    check_atom(part);
    let alpha = deref(args[2]);
    if (is_variable(alpha)) {
        return solve2_match(args, 0, 0, null);
    } else {
        check_integer(alpha);
        alpha = atom_offset(text, 0, alpha);
        if (alpha < 0)
            return false;
        if (!text.startsWith(part, alpha))
            return false;
    }
    cont(call.args[1]);
    return true;
}

function solve_match(rope, at, choice) {
    let goal = deref(call.args[0]);
    return solve2_match(goal.args, rope, at, choice);
}

function solve2_match(args, res, at, choice) {
    let text = deref(args[0]);
    let part = deref(args[1]);
    let mark = trail;
    while (at + part.length <= text.length) {
        let pos = text.indexOf(part, at);
        if (pos < 0)
            return false;
        res += atom_count(text, at, pos);
        at = pos;
        if (unify(args[2], norm_smallint(res))) {
            at = atom_succ(text, at);
            res++;
            if (at + part.length <= text.length) {
                if (choice === null) {
                    choice = new Choice(solve_match, res, at, mark);
                } else {
                    choice.data = res;
                    choice.at = at;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
        at = atom_succ(text,at);
        res++;
    }
    return false;
}

/**
 * sys_atom_part(X, Y, Z, T):
 * The built-in succeeds in T with the substring at
 * offset Y and with length Z from X.
 */
function special_sys_atom_part(args) {
    let text = deref(args[0]);
    check_atom(text);
    let alpha = deref(args[1]);
    if (is_variable(alpha)) {
        let beta = deref(args[2]);
        check_integer(beta);
        beta = atom_offset(text, 0, beta);
        if (beta < 0)
            return false;
        return solve2_part(args, [0,0], beta, null);
    } else {
        check_integer(alpha);
        let beta = deref(args[2]);
        check_integer(beta);
        alpha = atom_offset(text, 0, alpha);
        if (alpha < 0)
            return false;
        beta = atom_offset(text, alpha, beta);
        if (beta < 0)
            return false;
        if (!unify(args[3], text.substring(alpha, beta)))
            return false;
    }
    cont(call.args[1]);
    return true;
}

function solve_part(rope, at, choice) {
    let goal = deref(call.args[0]);
    return solve2_part(goal.args, rope, at, choice);
}

function solve2_part(args, pair, to, choice) {
    let text = deref(args[0]);
    let mark = trail;
    while (to <= text.length) {
        if (unify(args[1], norm_smallint(pair[1])) &&
            unify(args[3], text.substring(pair[0], to))) {
            pair[0] = atom_succ(text, pair[0]);
            pair[1]++;
            to = atom_succ(text, to);
            if (to <= text.length) {
                if (choice === null) {
                    choice = new Choice(solve_part, pair, to, mark);
                } else {
                    choice.at = to;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
        pair[0] = atom_succ(text, pair[0]);
        pair[1]++;
        to = atom_succ(text, to);
    }
    return false;
}

/*********************************************************************/
/* sys_last_atom_match/3 and sys_last_atom_part/4                    */
/*********************************************************************/

/**
 * sys_last_atom_match(X, Y, Z):
 * The built-in succeeds if X has substring Y at Z.
 */
function special_sys_last_atom_match(args) {
    let text = deref(args[0]);
    check_atom(text);
    let part = deref(args[1]);
    check_atom(part);
    let alpha = deref(args[2]);
    if (is_variable(alpha)) {
        let at = text.length - part.length;
        let res = atom_count(text, 0, at);
        return solve2_last_match(args, res, at, null);
    } else {
        check_integer(alpha);
        alpha = atom_offset(text, 0, alpha);
        if (alpha < 0)
            return false;
        if (!text.startsWith(part, alpha))
            return false;
    }
    cont(call.args[1]);
    return true;
}

function solve_last_match(rope, at, choice) {
    let goal = deref(call.args[0]);
    return solve2_last_match(goal.args, rope, at, choice);
}

function solve2_last_match(args, res, at, choice) {
    let text = deref(args[0]);
    let part = deref(args[1]);
    let mark = trail;
    while (at >= 0) {
        let pos = text.lastIndexOf(part, at);
        if (pos < 0)
            return false;
        res -= atom_count(text, pos, at);
        at = pos;
        if (unify(args[2], norm_smallint(res))) {
            at = atom_pred(text, at);
            res--;
            if (at >= 0) {
                if (choice === null) {
                    choice = new Choice(solve_last_match, res, at, mark);
                } else {
                    choice.data = res;
                    choice.at = at;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
        at = atom_pred(text, at);
        res--;
    }
    return false;
}

function atom_pred(text, at) {
    if (0 < at) {
        let ch = last_code(text, at);
        return at - char_count(ch);
    } else {
        return at - 1;
    }
}

/**
 * sys_last_atom_part(X, Y, Z, T):
 * The built-in succeeds in T with the substring at
 * offset Y and with length Z from X.
 */
function special_sys_last_atom_part(args) {
    let text = deref(args[0]);
    check_atom(text);
    let alpha = deref(args[1]);
    if (is_variable(alpha)) {
        let beta = deref(args[2]);
        check_integer(beta);
        beta = last_atom_offset(text, text.length, beta);
        if (beta < 0)
            return false;
        let res = atom_count(text, 0, beta);
        return solve2_last_part(args, [beta,res], text.length, null);
    } else {
        check_integer(alpha);
        let beta = deref(args[2]);
        check_integer(beta);
        alpha = atom_offset(text, 0, alpha);
        if (alpha < 0)
            return false;
        beta = atom_offset(text, alpha, beta);
        if (beta < 0)
            return false;
        if (!unify(args[3], text.substring(alpha, beta)))
            return false;
    }
    cont(call.args[1]);
    return true;
}

function last_atom_offset(text,pos,alpha) {
    if (alpha < 0)
        return -1;
    while (alpha > 0 && 0 < pos) {
        let ch = last_code(text, pos);
        pos -= char_count(ch);
        alpha--;
    }
    if (alpha > 0)
        return -1;
    return pos;
}

function solve_last_part(rope, at, choice) {
    let goal = deref(call.args[0]);
    return solve2_last_part(goal.args, rope, at, choice);
}

function solve2_last_part(args, pair, to, choice) {
    let text = deref(args[0]);
    let mark = trail;
    while (pair[0] >= 0) {
        if (unify(args[1], norm_smallint(pair[1])) &&
            unify(args[3], text.substring(pair[0], to))) {
            pair[0] = atom_pred(text, pair[0]);
            pair[1]--;
            to = atom_pred(text, to);
            if (pair[0] >= 0) {
                if (choice === null) {
                    choice = new Choice(solve_last_part, pair, to, mark);
                } else {
                    choice.at = to;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
        pair[0] = atom_pred(text, pair[0]);
        pair[1]--;
        to = atom_pred(text, to);
    }
    return false;
}

/*********************************************************************/
/* Eval Init                                                         */
/*********************************************************************/

// number specials, basic predicates
add("is", 2, make_check(test_eval));

// number specials, basic operations
add("-", 2, make_arithmetic(arit_neg));
add("+", 3, make_arithmetic(arit_add));
add("-", 3, make_arithmetic(arit_sub));
add("*", 3, make_arithmetic(arit_mul));
add("/", 3, make_arithmetic(arit_quot));
add("//", 3, make_arithmetic(arit_intquot));
add("rem", 3, make_arithmetic(arit_rem));

// number specials, more operations
add("float", 2, make_arithmetic(arit_float));
add("^", 3, make_arithmetic(arit_intpow));
add("div", 3, make_arithmetic(arit_div));
add("mod", 3, make_arithmetic(arit_mod));

// number specials, magnitude operations
add("abs", 2, make_arithmetic(arit_abs));
add("sign", 2, make_arithmetic(arit_sign));
add("min", 3, make_arithmetic(arit_min));
add("max", 3, make_arithmetic(arit_max));

// number specials, rounding operations
add("truncate", 2, make_arithmetic(arit_truncate));
add("floor", 2, make_arithmetic(arit_floor));
add("ceiling", 2, make_arithmetic(arit_ceiling));
add("round", 2, make_arithmetic(arit_round));

// number specials, magnitude predicates
add("=:=", 2, make_check(test_numberequal));
add("=\\=", 2, make_check(test_numbernotequal));
add("<", 2, make_check(test_numberless));
add(">=", 2, make_check(test_numbergreaterequal));
add(">", 2, make_check(test_numbergreater));
add("=<", 2, make_check(test_numberlessequal));

// number specials, trigonometric operations
add("sin", 2, make_arithmetic(arit_sin));
add("cos", 2, make_arithmetic(arit_cos));
add("tan", 2, make_arithmetic(arit_tan));
add("asin", 2, make_arithmetic(arit_asin));
add("acos", 2, make_arithmetic(arit_acos));
add("atan", 2, make_arithmetic(arit_atan));
add("pi", 1, make_arithmetic(arit_pi));

// number specials, exponential operations
add("**", 3, make_arithmetic(arit_pow));
add("exp", 2, make_arithmetic(arit_exp));
add("log", 2, make_arithmetic(arit_log));
add("sqrt", 2, make_arithmetic(arit_sqrt));
add("e", 1, make_arithmetic(arit_e));
add("epsilon", 1, make_arithmetic(arit_epsilon));
add("atan2", 3, make_arithmetic(arit_atan2));

// number specials, bitwise operations
add("\\", 2, make_arithmetic(arit_not));
add("/\\", 3, make_arithmetic(arit_and));
add("\\/", 3, make_arithmetic(arit_or));
add("xor", 3, make_arithmetic(arit_xor));
add(">>", 3, make_arithmetic(arit_shiftright));
add("<<", 3, make_arithmetic(arit_shiftleft));

// term specials, miscellaneous equality
add("==", 2, make_check(test_equal));
add("\\==", 2, make_check(test_notequal));
add("same_term", 2, make_check(test_same_term));
add("hash_code", 2, make_check(test_hash_code));

// atom specials, standard
add("atom_codes", 2, make_check(test_atom_codes));
add("char_code", 2, make_check(test_char_code));
add("atom_length", 2, make_check(test_atom_length));
add("atom_concat", 3, make_special(special_atom_concat));

// atom specials, non-standard
add("atom_join", 2, make_check(test_atom_join));
add("sys_atom_part", 4, make_special(special_sys_atom_part));
add("sys_atom_match", 3, make_special(special_sys_atom_match));
add("sys_last_atom_part", 4, make_special(special_sys_last_atom_part));
add("sys_last_atom_match", 3, make_special(special_sys_last_atom_match));