/**
 * 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 {
    exec_build, is_variable, exec_unify, make_check,
    set, set_to_list, widen_bigint, exec_eval,
    norm_bigint, VAR_MASK_SEEN, make_arithmetic,
    check_integer, walk_compute, walk_uncompute,
    walk_vars, Compound, is_bigint, make_error
} from "../nova/core.mjs";

/*********************************************************************/
/* term_singletons2/2                                                */
/*********************************************************************/

/**
 * term_singletons(T, L):
 * The built-in succeeds in L with the singleton variables of T.
 */
function test_term_singletons(args) {
    let alpha = exec_build(args[0]);
    let res;
    try {
        res = walk_compute(alpha, init_map, union_map);
    } finally {
        walk_uncompute(alpha);
    }
    for (let [key, val] of res) {
        if (val)
            res.delete(key);
    }
    res = set_to_list(res.keys());
    return exec_unify(args[1], res);
}

let EMPTY_MAP = new Map();

function init_map(first) {
    if (is_variable(first)) {
        return new Map([[first, false]]);
    } else {
        return EMPTY_MAP;
    }
}

function union_map(first, second) {
    if (first.size === 0)
        return second;
    if (second.size === 0)
        return first;
    first = new Map(first);
    for (let [key, val] of second) {
        let value = first.get(key);
        if (value !== undefined) {
            value = true;
        } else {
            value = val;
        }
        first.set(key, value);
    }
    return first;
}

/******************************************************************/
/* ground/1 and nonground/2                                       */
/******************************************************************/

/**
 * ground(T): [TC2 8.3.10]
 * The built-in succceeds if T is ground.
 */
function test_ground(args) {
    let alpha = exec_build(args[0]);
    let res = walk_vars(alpha, node => true, VAR_MASK_SEEN);
    walk_vars(alpha, node => true, 0);
    return !res;
}

/**
 * nonground(T, V):
 * The built-in succeeds if T is non-ground and V is the first variable.
 */
function test_nonground(args) {
    let alpha = exec_build(args[0]);
    let hit = undefined;

    function nonground2(node) {
        hit = node;
        return true;
    }

    let res = walk_vars(alpha, nonground2, VAR_MASK_SEEN);
    walk_vars(alpha, node => true, 0);
    return res && exec_unify(args[1], hit);
}

/*********************************************************************/
/* divmod/4 and gcd/3                                                */
/*********************************************************************/

/**
 * divmod(X, Y, Z, T):
 * If X and Y are both integers then the predicate succeeds in
 * Z with the division of X by Y, and in T with the modulo of X by Y.
 */
function test_divmod(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    let beta = exec_build(args[1]);
    check_integer(beta);
    let resdiv;
    let resmod;
    if (!is_bigint(alpha) && !is_bigint(beta)) {
        if (beta === 0)
            throw make_error(new Compound("evaluation_error",["zero_divisor"]));
        resdiv = Math.floor(alpha / beta);
        resmod = alpha - resdiv*beta;
    } else {
        alpha = widen_bigint(alpha);
        beta = widen_bigint(beta);
        if (beta === 0n)
            throw make_error(new Compound("evaluation_error",["zero_divisor"]));
        resdiv = bigint_div(alpha, beta);
        resmod = alpha - resdiv*beta;
        resdiv = norm_bigint(resdiv);
        resmod = norm_bigint(resmod);
    }
    if (!exec_unify(args[2], resdiv))
        return false;
    return exec_unify(args[3], resmod);
}

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

/**
 * gcd(X, Y, Z):
 * If X and Y are integers then the predicate succeeds in Z
 * with the greatest common divisor of X and Y.
 */
function arit_gcd(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 intGcd(alpha, beta);
   } else {
       return norm_bigint(
                bigIntGcd(widen_bigint(alpha),
                            widen_bigint(beta)));
   }
}

function intGcd(a, b) {
    a = Math.abs(a);
    b = Math.abs(b);
    while (b !== 0) {
        let h = a % b;
        a = b;
        b = h;
    }
    return a;
}

function bigIntGcd(a, b) {
    a = (a < 0n ? -a : a);
    b = (b < 0n ? -b : b);
    while (b !== 0n) {
        let h = a % b;
        a = b;
        b = h;
    }
    return a;
}

/*********************************************************************/
/* Fast Lib Init                                                     */
/*********************************************************************/

export function main() {
    set("term_singletons", 2, make_check(test_term_singletons));
    set("ground", 1, make_check(test_ground));
    set("nonground", 2, make_check(test_nonground));
    set("divmod", 4, make_check(test_divmod));
    set("gcd", 3, make_arithmetic(arit_gcd));
}
