/**
 * 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 {
    set, is_variable, Compound, is_structure, Item,
    stack_push, stack_peek, stack_pop, deref,
    is_compound, VAR_MASK_SERNO, variable_serno
} from "./store.mjs";
import {
    is_frozen, object_hash_code,
    call, cont, union_undo, exec_unify, is_special,
    union_find, union_add, exec_deref, is_pending,
    is_integer, make_error, unify, exec_build,
    trail, unbind, Choice, more, exec_eval, is_bigint
} from "./machine.mjs";
import {
    check_integer, 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 {
    code_point_before
} from "./runtime.mjs";

/*********************************************************************/
/* is/2, (-)/2, abs/2 and sign/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);
}

/**
 * -(A, B): [ISO 9.1.7]
 * The predicate succeeds in B with the negation of A.
 * This implements NaN propagation IEEE 754-2019 §6.2.3.
 */
function arit_neg(args) {
    let alpha = exec_eval(args[0]);
    if (is_bigint(alpha)) {
        return -alpha;
    } else {
        return 0 - alpha;
    }
}

/**
 * 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;
        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;
        if (alpha > 0)
            return 1;
        return 0;
    } else {
        return norm_float(Math.sign(narrow_float(alpha)));
    }
}

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

/**
 * +(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 (alpha / beta) | 0;
    } 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]);
    return norm_float(narrow_float(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;
}

/*********************************************************************/
/* min/3, max/3, inf/1 and nan/1                                     */
/*********************************************************************/

/**
 * min(A, B, C): [TC2 9.3.9]
 * The predicate succeeds in C with the minimum of A and B.
 * This implements minimumNumber IEEE 754-2019 §9.6.
 */
function arit_min(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_special(alpha) || is_special(beta)) {
        if (Number.isNaN(alpha))
            return beta;
        if (Number.isNaN(beta))
            return alpha;
        if (alpha === Infinity)
            return beta;
        if (beta === Infinity)
            return alpha;
        if (alpha === -Infinity)
            return alpha;
        return beta;
    } else if (is_integer(alpha) && is_integer(beta)) {
        if (alpha < beta)
            return alpha;
        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.
 * This implements maximumNumber IEEE 754-2019 §9.6.
 */
function arit_max(args) {
    let alpha = exec_eval(args[0]);
    let beta = exec_eval(args[1]);
    if (is_special(alpha) || is_special(beta)) {
        if (Number.isNaN(alpha))
            return beta;
        if (Number.isNaN(beta))
            return alpha;
        if (alpha === -Infinity)
            return beta;
        if (beta === -Infinity)
            return alpha;
        if (alpha === Infinity)
            return alpha;
        return beta;
    } else if (is_integer(alpha) && is_integer(beta)) {
        if (alpha > beta)
            return alpha;
        return beta;
    } else {
        return norm_float(Math.max(
            narrow_float(alpha), narrow_float(beta)));
    }
}

/**
 * inf(A):
 * The predicate succeeds in A with positive infinity.
 */
function arit_inf(args) {
    return Infinity;
}

/**
 * nan(A):
 * The predicate succeeds in A with not a number.
 */
function arit_nan(args) {
    return NaN;
}

/*********************************************************************/
/* 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(0 + 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(0 + 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(0 + 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.
 * This implement compareQuietEqual IEEE 754-2019 §5.6.1.
 *
 * @param alpha The first Prolog number.
 * @param beta The second Prolog number.
 * @return True if the two Prolog numbers are equal.
 */
function number_equal(alpha, beta) {
    if (is_special(alpha) || is_special(beta)) {
        if (Number.isNaN(alpha))
            return false;
        if (Number.isNaN(beta))
            return false;
        return (alpha === beta);
    } else 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_lessequal(beta, alpha);
}

/**
 * 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_lessequal(alpha, beta);
}

/**
 * Determine whether a Prolog numbers is less than a Prolog number.
 * This implement compareQuietLess IEEE 754-2019 §5.6.1.
 *
 * @param alpha The first Prolog number.
 * @param beta The second Prolog number.
 * @return True if the first is less than the second, otherwise false.
 */
function number_less(alpha, beta) {
    if (is_special(alpha) || is_special(beta)) {
        if (Number.isNaN(alpha))
            return false;
        if (Number.isNaN(beta))
            return false;
        if (alpha === beta)
            return false;
        if (beta === Infinity)
            return true;
        return (alpha === -Infinity);
    } else if (is_integer(alpha) && is_integer(beta)) {
        return alpha < beta;
    } else {
        return narrow_float(alpha) < narrow_float(beta);
    }
}

/**
 * Determine whether a Prolog numbers is less or equal than a Prolog number.
 * This implement compareQuietLessEqual IEEE 754-2019 §5.6.1.
 *
 * @param alpha The first Prolog number.
 * @param beta The second Prolog number.
 * @return True if the first is less or equal than the second, otherwise false.
 */
function number_lessequal(alpha, beta) {
    if (is_special(alpha) || is_special(beta)) {
        if (Number.isNaN(alpha))
            return false;
        if (Number.isNaN(beta))
            return false;
        if (alpha === beta)
            return true;
        if (beta === Infinity)
            return true;
        return (alpha === -Infinity);
    } else 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.0 && beta === 0.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 and \==/2                                                    */
/*********************************************************************/

/**
 * 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 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 (!Object.is(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 !== second) {
                    if (is_frozen(first) && is_frozen(second) &&
                        first.hash !== second.hash)
                        break;
                    if (first.functor !== second.functor)
                        break;
                    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);
    }
}

/******************************************************************/
/* Visitor Triple                                                 */
/******************************************************************/

/**
 * Create a visitor triple.
 *
 * @param backup The backup functor.
 * @param accum The accumlated value.
 * @param children The argument children.
 */
export function Triple(backup, accum, children) {
    this.backup = backup;
    this.accum = accum;
    this.children = children;
}

/**
 * Check whether an object is a visitor triple.
 *
 * @param obj The object.
 * @return boolean True if the object is a triple, otherwise false.
 */
export function is_triple(obj) {
    return obj instanceof Triple;
}

/*********************************************************************/
/* term_hash2/2                                                      */
/*********************************************************************/

/**
 * term_hash(X, H):
 * The predicate succeeds in H with the term hash of the term X.
 */
function test_term_hash(args) {
    let alpha = exec_build(args[0]);
    let res;
    try {
        res = walk_compute(alpha, init_hash, union_hash);
    } finally {
        walk_uncompute(alpha);
    }
    return exec_unify(args[1], norm_smallint(res));
}

function init_hash(first) {
    if (is_compound(first)) {
        return object_hash_code(first.functor);
    } else if (is_variable(first)) {
        return variable_serno(first);
    } else if (is_frozen(first)) {
        return first.hash;
    } else {
        return object_hash_code(first);
    }
}

function union_hash(first, second) {
    return (first * 31 + second) | 0;
}

export function walk_compute(first, init, reduce) {
    let stack = null;
    for (; ; ) {
        first = deref(first);
        if (is_compound(first)) {
            if (!is_triple(first.functor)) {
                first.functor = new Triple(
                            first.functor,
                            init(first), null);
                first.walk &= ~VAR_MASK_SERNO;
                stack = stack_push(stack, first);
                first = first.args[0];
                continue;
            } else {
                first = first.functor.accum;
            }
        } else {
            first = init(first);
        }
        let item = stack_peek(stack);
        while (item !== null &&
        (item.walk & VAR_MASK_SERNO) === item.args.length - 1) {
            first = reduce(item.functor.accum, first);
            item.functor.accum = first;
            stack_pop(stack);
            item = stack_peek(stack);
        }
        if (item === null) {
            return first;
        } else {
            first = reduce(item.functor.accum, first);
            item.functor.accum = first;
            item.walk++;
            first = item.args[item.walk & VAR_MASK_SERNO];
        }
    }
}

export function walk_uncompute(first) {
    let stack = null;
    for (; ; ) {
        first = deref(first);
        if (is_compound(first)) {
            if (is_triple(first.functor)) {
                first.functor = first.functor.backup;
                if (0 !== first.args.length - 1) {
                    first.walk &= ~VAR_MASK_SERNO;
                    stack = stack_push(stack, first);
                }
                first = first.args[0];
                continue;
            }
        }
        let item = stack_peek(stack);
        if (item === null) {
            return;
        } else {
            item.walk++;
            first = item.args[item.walk & VAR_MASK_SERNO];
            if ((item.walk & VAR_MASK_SERNO) === item.args.length - 1)
                stack_pop(stack);
        }
    }
}

/*********************************************************************/
/* 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("domain_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("domain_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_join/2                                     */
/*********************************************************************/

/**
 * 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));
}

export 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_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("");
}

/*********************************************************************/
/* atom_concat/3                                                     */
/*********************************************************************/

/**
 * 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_succ(text, at) {
    if (at < text.length) {
        let ch = text.codePointAt(at);
        return at + char_count(ch);
    } else {
        return at + 1;
    }
}

/*********************************************************************/
/* 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;
}

export 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 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);
        let at = (0 <= beta && beta <= MAX_ARITY ?
                        narrow_float(beta) : -1);
        let res = atom_offset(text, 0, at);
        if (res < 0)
            return false;
        return solve2_part(args, [0,0], res, null);
    } else {
        check_integer(alpha);
        let beta = deref(args[2]);
        check_integer(beta);
        let at = (0 <= alpha && alpha <= MAX_ARITY ?
                        narrow_float(alpha) : -1);
        let from = atom_offset(text, 0, at);
        if (from < 0)
            return false;
        at = (0 <= beta && beta <= MAX_ARITY ?
                    narrow_float(beta) : -1);
        let to = atom_offset(text, from, at);
        if (to < 0)
            return false;
        if (!unify(args[3], text.substring(from, to)))
            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 = code_point_before(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 = code_point_before(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
set("is", 2, make_check(test_eval));
set("-", 2, make_arithmetic(arit_neg));
set("abs", 2, make_arithmetic(arit_abs));
set("sign", 2, make_arithmetic(arit_sign));

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

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

// number specials, magnitude operations
set("min", 3, make_arithmetic(arit_min));
set("max", 3, make_arithmetic(arit_max));
set("inf", 1, make_arithmetic(arit_inf));
set("nan", 1, make_arithmetic(arit_nan));

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

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

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

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

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

// term specials, miscellaneous equality
set("==", 2, make_check(test_equal));
set("\\==", 2, make_check(test_notequal));
set("term_hash", 2, make_check(test_term_hash));

// atom specials, standard
set("atom_codes", 2, make_check(test_atom_codes));
set("char_code", 2, make_check(test_char_code));
set("atom_length", 2, make_check(test_atom_length));
set("atom_join", 2, make_check(test_atom_join));

// atom specials, non-standard
set("atom_concat", 3, make_special(special_atom_concat));
set("sys_atom_part", 4, make_special(special_sys_atom_part));
set("sys_atom_match", 3, make_special(special_sys_atom_match));
set("sys_last_atom_part", 4, make_special(special_sys_last_atom_part));
set("sys_last_atom_match", 3, make_special(special_sys_last_atom_match));