/**
 * 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, equal_term, list_objects, objects_list,
    Compound, exec_unify, is_structure, variable_serno,
    is_integer, is_float, union_undo, is_special, is_number,
    make_error, set, make_check, check_nonvar, copy_term,
    is_variable, is_atom, deref, union_find, union_add,
    Item, stack_peek, stack_pop, stack_push
} from "../nova/core.mjs";

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

/**
 * X @< Y: [ISO 8.4.1]
 * The predicate succeeds when X is syntactically less than Y, otherwise fails.
 */
function test_less(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return compare_term(alpha, beta) < 0;
}

/**
 * X @>= Y: [ISO 8.4.1]
 * The predicate succeeds when X is syntactically greater or equal to Y, otherwise fails.
 */
function test_greaterequal(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return compare_term(alpha, beta) >= 0;
}

/**
 * X @> Y: [ISO 8.4.1]
 * The predicate succeeds when X is syntactically greater than Y, otherwise fails.
 */
function test_greater(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return compare_term(alpha, beta) > 0;
}

/**
 * X @=< Y: [ISO 8.4.1]
 * The predicate succeeds when X is syntactically less or equal to Y, otherwise fails.
 */
function test_lessequal(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    return compare_term(alpha, beta) <= 0;
}

/**
 * compare(C, X, Y): [TC2 8.4.2]
 * The predicate succeeds when C unifies with the result of comparing
 * X to Y. The result is one of the following atoms <, = or >.
 */
function test_compare(args) {
    let beta = exec_build(args[1]);
    let gamma = exec_build(args[2]);
    beta = compare_term(beta, gamma);
    if (beta < 0) {
        beta = "<";
    } else if (beta === 0) {
        beta = "=";
    } else {
        beta = ">";
    }
    return exec_unify(args[0], beta);
}

/**
 * Determine the syntactic relationship between two Prolog terms.
 * Can handle cyclic terms and deep recursion.
 * Has left to right anomaly.
 *
 * @param first The first Prolog term.
 * @param second The second Prolog term.
 * @return number <0 for less, =0 for equal and >0 for greater
 */
function compare_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 (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 0;
            } 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 compare_truncated(first, second);
    } finally {
        union_undo(log);
    }
}

/**
 * Determine the syntactic relationship between truncated Prolog terms.
 * Prolog compounds are truncated to their arity and functor.
 *
 * @param first  The first Prolog term.
 * @param second The second Prolog term.
 * @return <0 for less, =0 for equal and >0 for greater
 */
function compare_truncated(first, second) {
    let i = compare_type(first);
    let k = i - compare_type(second);
    if (k !== 0)
        return k;
    switch (i) {
        case 0:
            return variable_serno(first) -
                variable_serno(second);
        case 2:
            return compare_atomic(first, second);
        case 3:
            return compare_atomic(first, second);
        case 9:
            return compare_atomic(first, second);
        case 10:
            k = first.args.length - second.args.length;
            if (k !== 0)
                return k;
            return compare_atomic(first.functor, second.functor);
        default:
            return 0;
    }
}

/**
 * Determine the compare type of a Prolog term.
 *
 * @param first The Prolog term.
 * @return number The compare type.
 */
function compare_type(first) {
    if (is_variable(first)) {
        return 0;
    } else if (is_structure(first)) {
        return 10;
    } else if (is_atom(first)) {
        return 9;
    } else if (is_number(first)) {
        if (is_integer(first)) {
            return 3;
        } else if (is_special(first)) {
            if (first === -Infinity) {
                return 1;
            } else if (first === Infinity) {
                return 4;
            } else if (Number.isNaN(first)) {
                return 5;
            }
        } else if (is_float(first)) {
            return 2;
        }
    } else if (first === false) {
        return 7;
    } else if (first === true) {
        return 8;
    } else if (first === null) {
        return 6;
    }
    throw make_error(new Compound("resource_error",
                ["not_supported"]));
}

/**
 * Determine the syntactic relationship between two Prolog atomics.
 *
 * @param first The first Prolog atomic.
 * @param second The second Prolog atomic.
 * @return number -1 for less, 0 for equal and 1 for greater
 */
function compare_atomic(first, second) {
    if (first < second)
        return -1;
    if (first === second)
        return 0;
    return 1;
}

/******************************************************************/
/* sort/2 and keysort/2                                           */
/******************************************************************/

/**
 * sort(L, R): [TC2 8.4.3]
 * The predicate succeeds in R with the sorted list L.
 */
function test_sort(args) {
    let alpha = exec_build(args[0]);
    let res = list_objects(alpha);
    res.sort(compare_term);
    let count = objects_dedup(res);
    return exec_unify(args[1], objects_list(res, 0, count));
}

function objects_dedup(res) {
    let j = 0;
    let i = 0;
    while (i < res.length) {
        let alpha = res[i++];
        while (i < res.length && equal_term(alpha, res[i]))
            i++;
        res[j++] = alpha;
    }
    return j;
}

/**
 * keysort(L, R): [TC2 8.4.4]
 * The predicate succeeds in R with the key sorted list L.
 */
function test_keysort(args) {
    let alpha = exec_build(args[0]);
    let res = list_objects(alpha);
    objects_pairs(res);
    res.sort((first, second) => compare_term(get_key(first), get_key(second)));
    return exec_unify(args[1], objects_list(res, 0, res.length));
}

function objects_pairs(res) {
    for (let i = 0; i < res.length; i++) {
        let alpha = res[i];
        if (is_structure(alpha) &&
            "-" === alpha.functor &&
            alpha.args.length === 2) {
            /* */
        } else {
            check_nonvar(alpha);
            alpha = copy_term(alpha);
            throw make_error(new Compound("type_error",
                ["pair", alpha]));
        }
    }
}

function get_key(peek) {
    return peek.args[0];
}

/*********************************************************************/
/* Iso Lib Init                                                      */
/*********************************************************************/

export function main() {
    // term specials, syntactic comparison
    set("@<", 2, make_check(test_less));
    set("@>=", 2, make_check(test_greaterequal));
    set("@>", 2, make_check(test_greater));
    set("@=<", 2, make_check(test_lessequal));
    set("compare", 3, make_check(test_compare));

    // list specials, miscellaneous sorting
    set("sort", 2, make_check(test_sort));
    set("keysort", 2, make_check(test_keysort));
}
