/**
 * 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 {
    Provable, set, MASK_PRED_TEST, engine, VAR_MASK_SERNO,
    MASK_PRED_ARITH, Variable, MASK_PRED_SPECIAL, Goal,
    is_skeleton, Clause, check_nonvar, add_clause,
    VAR_MASK_SEEN, VAR_MASK_STATE, Place, Skeleton, is_goal,
    is_variable, Compound, is_structure, deref, copy_term,
    stack_push, stack_pop, stack_peek, is_compound, is_clause
} from "./store.mjs";
import {
    bind, call, gc_mask, Choice,
    cont, snap_setup, solve, snap_cleanup, is_bigint,
    is_atom, exec_build, exec_unify, is_frozen,
    is_float, is_integer, is_number, exec_deref, is_pending,
    make_error, more, redo, trail, unify, melt_directive,
    solve_signal, SYS_MASK_ASYNC_MODE, SYS_MASK_ALLOW_YIELD,
    fs, VOID_ARGS, ctx, register_interrupt, Frozen,
    setDelay, url, mark2_term, register_signal, is_special
} from "./machine.mjs";
import {
    code_category, code_numeric
} from "./unicode.mjs";

export const MAX_ARITY = 2147483647;

/*********************************************************************/
/* Special Predicate                                                 */
/*********************************************************************/

/**
 * Return a built-in for a special.
 *
 * @param func The special.
 * @return Provable The built-in.
 */
export function make_special(func) {
    let peek = new Provable();
    peek.flags |= MASK_PRED_SPECIAL;
    peek.func = func;
    return peek;
}

/**
 * Return a built-in for a check.
 *
 * @param func The check.
 * @return Provable The built-in.
 */
export function make_check(func) {
    let peek = new Provable();
    peek.flags |= MASK_PRED_TEST;
    peek.func = func;
    return peek;
}

/**
 * Return a built-in for an arithmetic.
 *
 * @param func The arithmetic.
 * @return Provable The built-in.
 */
export function make_arithmetic(func) {
    let peek = new Provable();
    peek.flags |= MASK_PRED_ARITH;
    peek.func = func;
    return peek;
}

/*********************************************************************/
/* fail/0, '$CUT'/1 and '$MARK'/1                                    */
/*********************************************************************/

/**
 * fail: [ISO 7.8.2]
 * The built-in fails.
 */
function test_fail(args) {
    return false;
}

/**
 * '$CUT'(R): internal only
 * The built-in removes the choice points up to R and succeeds.
 */
function test_cut(args) {
    let choice = exec_build(args[0]);
    more(choice);
    return true;
}

/**
 * '$MARK'(R): Internal only
 * The built-in binds R to the top choice point.
 */
function test_mark(args) {
    let choice = redo;
    return exec_unify(args[0], choice);
}

/*********************************************************************/
/* '$SEQ'/2 and '$ALT'/1                                             */
/*********************************************************************/

/**
 * '$SEQ'(O, L): internal only
 * The built-in first matches the option O with the top choice point.
 * The built-in then sequentially adds the goals L to the continuation.
 */
function special_seq(args) {
    let temp = deref(args[0]);
    solve_mark(temp);
    temp = deref(args[1]);
    solve_seq(temp);
    return true;
}

/**
 * If temp is just(R) bind R the top choice point. If temp is
 * nothing do nothing. Otherwise throw an exception.
 *
 * @param temp The Prolog term.
 */
function solve_mark(temp) {
    if (temp === "nothing") {
        /* */
    } else if (is_structure(temp) &&
            temp.functor === "just" &&
            temp.args.length === 1) {
        temp = deref(temp.args[0]);
        bind(redo, temp);
    } else {
        check_nonvar(temp);
        temp = copy_term(temp);
        throw make_error(new Compound("type_error", ["maybe", temp]));
    }
}

/**
 * Sequentially adds the literals L to the continuation.
 *
 * @param peek The literals.
 */
export function solve_seq(peek) {
    let back = null;
    let res = null;
    while (is_structure(peek) &&
                peek.functor === "." &&
                peek.args.length === 2) {
        let goal = deref(peek.args[0]);
        goal = new Compound(".", [goal, undefined]);
        if (back === null) {
            res = goal;
        } else {
            back.args[1] = goal;
        }
        back = goal;
        peek = deref(peek.args[1]);
    }
    check_nil(peek);
    if (back === null) {
        res = call.args[1];
    } else {
        back.args[1] = call.args[1];
    }
    cont(res);
}

/**
 * '$ALT'(L): internal only
 * The built-in alternatively adds the variants L to the
 * continuation and succeeds.
 */
function special_alt(args) {
    let goal = deref(args[0]);
    return solve_alt(goal, -1, null);
}

/**
 * Alternatively adds the variants to the continuation.
 *
 * @param peek The variants.
 * @param at This argument is ignored.
 * @param choice The choice point for reuse or null.
 * @return boolean True if a variant could be added, otherwise false.
 */
function solve_alt(peek, at, choice) {
    if (is_structure(peek) &&
            peek.functor === "." &&
            peek.args.length === 2) {
        let mark = trail;
        let goal = deref(peek.args[0]);
        solve_mark(deref(goal.args[0]));
        peek = deref(peek.args[1]);
        if (is_structure(peek) &&
                peek.functor === "." &&
                peek.args.length === 2) {
            if (choice === null) {
                choice = new Choice(solve_alt, peek, -1, mark);
            } else {
                choice.data = peek;
            }
            more(choice);
        }
        solve_seq(deref(goal.args[1]));
        return true;
    } else {
        return false;
    }
}

/*********************************************************************/
/* sys_raise/1 and sys_trap/3                                        */
/*********************************************************************/

/**
 * sys_raise(E): internal only
 * The predicate raises the exception E.
 */
function test_sys_raise(args) {
    let problem = exec_build(args[0]);
    throw copy_term(problem);
}

/**
 * sys_trap(G, E, F): internal only
 * The built-in succeeds whenever G succeeds. If
 * there was an exception that unifies with E, the
 * built-in further succeeds whenever F succeeds.
 */
function special_sys_trap(args) {
    let goal = deref(args[0]);
    let snap = snap_setup();
    goal = new Compound(".", [goal, "[]"]);
    cont(goal);
    return solve_catch(snap, true, null);
}

/**
 * Call, redo or resume a goal.
 * If there is an exception put the handler on the continuation.
 *
 * @param snap The surrounding choice point.
 * @param found The call or redo flag.
 * @param choice The choice point for reuse or null.
 * @return boolean True if goal succeeded, otherwise false.
 */
function solve_catch(snap, found, choice) {
    if (choice !== null) {
        choice.mark = null;
        choice.cont = "[]";
        choice.tail = null;
    }
    try {
        found = solve(snap, found);
    } catch (err) {
        snap_cleanup(snap);
        let goal = deref(call.args[0]);
        err = map_throwable(err);
        if (!unify(goal.args[1], err))
            throw err;
        goal = deref(goal.args[2]);
        goal = new Compound(".", [goal, call.args[1]]);
        cont(goal);
        return true;
    }
    if (found === false)
        return false;
    if (redo !== snap) {
        if (choice === null) {
            choice = new Choice(solve_catch, snap, false, trail);
        } else {
            choice.mark = trail;
            choice.cont = call;
            choice.tail = redo;
        }
        more(choice);
    } else {
        more(snap.tail);
    }
    if (found === true)
        cont(snap.cont.args[1]);
    return found;
}

function map_throwable(err) {
    if (err instanceof RangeError && err.message.includes("stack"))
        err = make_error(new Compound("system_error", ["stack_overflow"]));
    return err;
}

/*********************************************************************/
/* os_sleep_promise/2 and os_import_promise/3                        */
/*********************************************************************/

/**
 * os_sleep_promise(D, P):
 * The predicate succeeds in P with a promise for a delay D.
 */
function test_os_sleep_promise(args) {
    let delay = exec_build(args[0]);
    check_integer(delay);
    if (delay < 0)
        throw make_error(new Compound("domain_error",
            ["not_less_than_zero", delay]));
    let buf = ctx;
    return exec_unify(args[1], sleep_promise(buf, delay));
}

function sleep_promise(buf, delay) {
    return new Promise(resolve => {
        function handler() {
            register_interrupt(buf, () => {});
            resolve();
        }
        let timer = setDelay(handler, delay);
        register_interrupt(buf, () => {
            clearTimeout(timer);
            register_interrupt(buf, () => {});
            resolve()
        });
    });
}

/**
 * os_import_promise(F, M, Q): internal only
 * The predicate succeeds in Q with with a promise for the
 * import M of the file F.
 */
function test_os_import_promise(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    let res = {};
    if (!exec_unify(args[1], res))
        return false;
    let buf = ctx;
    return exec_unify(args[2], import_promise(buf, url, res));
}

async function import_promise(buf, path, res) {
    try {
        let path2;
        if (fs !== undefined) {
            path2 = url.pathToFileURL(path);
        } else {
            path2 = path;
        }
        res.module = await import(path2);
    } catch (err) {
        if (err instanceof SyntaxError) {
            register_signal(buf,
                new Compound("syntax_error", ["bad_module"]));
        } else {
            register_signal(buf,
                new Compound("existence_error", ["module", path]));
        }
    }
}

/**
 * os_invoke_main(M): internal only
 * Invoke the main method of the module M.
 */
function test_os_invoke_main(args) {
    let module = exec_build(args[0]);
    let val = module.main;
    if (val === undefined) {
        throw make_error(new Compound("existence_error",
            ["method", "main"]));
    } else if (typeof val !== "function") {
        throw make_error(new Compound("permission_error",
            ["invoke", "method", "main"]));
    } else {
        val();
    }
    return true;
}

/*********************************************************************/
/* '$YIELD'/1, shield/1 and unshield/1                               */
/*********************************************************************/

/**
 * '$YIELD'(R): Internal only
 * The built-in stops the interpreter loop with return value R.
 */
function special_yield(args) {
    if ((engine.flags & SYS_MASK_ALLOW_YIELD) === 0)
        throw make_error(new Compound("system_error", ["illegal_yield"]));
    cont(call.args[1]);
    more(new Choice(solve_signal, null, 0, trail));
    return deref(args[0]);
}

/**
 * shield(G):
 * The predicate succeeds whenever the goal G succeeds.
 * The goal is executed without auto-yield.
 */
function special_shield(args) {
    let goal = deref(args[0]);
    let snap = snap_setup();
    goal = new Compound(".", [goal, "[]"]);
    cont(goal);
    return solve_shield(snap, true, null);
}

/**
 * Call, redo or resume a goal.
 * The goal is executed without auto-yield.
 *
 * @param snap The surrounding choice point.
 * @param found The call or redo flag.
 * @param choice The choice point for reuse or null.
 * @return boolean True if goal succeeded, otherwise false.
 */
function solve_shield(snap, found, choice) {
    if (choice !== null) {
        choice.mark = null;
        choice.cont = "[]";
        choice.tail = null;
    }
    let back = engine.flags & SYS_MASK_ASYNC_MODE;
    engine.flags &= ~SYS_MASK_ASYNC_MODE;
    try {
        found = solve(snap, found);
    } catch (x) {
        engine.flags &= ~SYS_MASK_ASYNC_MODE;
        engine.flags |= back;
        snap_cleanup(snap);
        throw x;
    }
    engine.flags &= ~SYS_MASK_ASYNC_MODE;
    engine.flags |= back;
    if (found === false)
        return false;
    if (redo !== snap) {
        if (choice === null) {
            choice = new Choice(solve_shield, snap, false, trail);
        } else {
            choice.mark = trail;
            choice.cont = call;
            choice.tail = redo;
        }
        more(choice);
    } else {
        more(snap.tail);
    }
    if (found === true)
        cont(snap.cont.args[1]);
    return found;
}

/**
 * unshield(G):
 * The predicate succeeds whenever the goal G succeeds.
 * The goal is executed with auto-yield.
 */
function special_unshield(args) {
    let goal = deref(args[0]);
    let snap = snap_setup();
    goal = new Compound(".", [goal, "[]"]);
    cont(goal);
    return solve_unshield(snap, true, null);
}

/**
 * Call, redo or resume a goal.
 * The goal is executed without auto-yield.
 *
 * @param snap The surrounding choice point.
 * @param found The call or redo flag.
 * @param choice The choice point for reuse or null.
 * @return boolean True if goal succeeded, otherwise false.
 */
function solve_unshield(snap, found, choice) {
    if (choice !== null) {
        choice.mark = null;
        choice.cont = "[]";
        choice.tail = null;
    }
    let back = engine.flags & SYS_MASK_ASYNC_MODE;
    engine.flags |= SYS_MASK_ASYNC_MODE;
    try {
        found = solve(snap, found);
    } catch (x) {
        engine.flags &= ~SYS_MASK_ASYNC_MODE;
        engine.flags |= back;
        snap_cleanup(snap);
        throw x;
    }
    engine.flags &= ~SYS_MASK_ASYNC_MODE;
    engine.flags |= back;
    if (found === false)
        return false;
    if (redo !== snap) {
        if (choice === null) {
            choice = new Choice(solve_unshield, snap, false, trail);
        } else {
            choice.mark = trail;
            choice.cont = call;
            choice.tail = redo;
        }
        more(choice);
    } else {
        more(snap.tail);
    }
    if (found === true)
        cont(snap.cont.args[1]);
    return found;
}

/**
 * call(A): [ISO 7.8.3]
 * The predicate succeeds whenever the goal A succeeds.
 */
function special_call(args) {
    let goal = deref(args[0]);
    goal = new Compound(".", [goal, call.args[1]]);
    cont(goal);
    return true;
}

/*********************************************************************/
/* Type Assertions                                                   */
/*********************************************************************/

/**
 * Assure that the object is an atom.
 *
 * @param beta The object.
 */
export function check_atom(beta) {
    if (!is_atom(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["atom", beta]));
    }
}

/**
 * Assure that the object is a number.
 *
 * @param beta The object.
 */
export function check_number(beta) {
    if (!is_number(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["number", beta]));
    }
}

/**
 * Assure that the object is an integer.
 *
 * @param beta The object.
 */
export function check_integer(beta) {
    if (!is_integer(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["integer", beta]));
    }
}

/**
 * Assure that the object is atomic.
 *
 * @param beta The object.
 */
export function check_atomic(beta) {
    if (is_variable(beta) || is_structure(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["atomic", beta]));
    }
}

/**
 * Assure that the Prolog term is nil.
 *
 * @param beta The Prolog term.
 */
export function check_nil(beta) {
    if (beta === "[]")
        return;
    if (is_structure(beta) && beta.functor === "."
        && beta.args.length === 2) {
        throw make_error(new Compound("representation_error",
            ["max_arity"]));
    } else {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error",
            ["list", beta]));
    }
}

/*********************************************************************/
/* =/2 and copy_term/2                                               */
/*********************************************************************/

/**
 * S = T: [ISO 8.2.1]
 * The built-in succeeds when the Prolog terms S and T unify,
 * otherwise the built-in fails.
 */
function test_unify(args) {
    let alpha = exec_build(args[0]);
    return exec_unify(args[1], alpha);
}

/**
 * copy_term(S, T): [ISO 8.5.4]
 * The built-in succeeds in T with a copy of S.
 */
function test_copy_term(args) {
    let alpha = exec_build(args[0]);
    alpha = copy_term(alpha);
    return exec_unify(args[1], alpha);
}

/*********************************************************************/
/* =../2, functor/3 and arg/3                                        */
/*********************************************************************/

/**
 * T =.. [F|L]: [ISO 8.5.3]
 * If T is a variable, the built-in succeeds in T with the Prolog term
 * from the functor F and arguments L. Otherwise the built-in succeeds in
 * F and L with the functor and arguments of the Prolog term T.
 */
function test_univ(args) {
    let alpha = exec_deref(args[0]);
    if (is_variable(alpha) || is_pending(alpha)) {
        let beta = exec_build(args[1]);
        beta = special_univ_pack(beta);
        return exec_unify(alpha, beta);
    } else {
        alpha = exec_build(alpha);
        alpha = special_univ_unpack(alpha);
        return exec_unify(args[1], alpha);
    }
}

function special_univ_pack(beta) {
    if (is_structure(beta) &&
        "." === beta.functor &&
        beta.args.length === 2) {
        /* */
    } else {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["list", beta]));
    }
    let functor = deref(beta.args[0]);
    check_atomic(functor);
    beta = deref(beta.args[1]);
    let args = list_objects(beta);
    if (args.length === 0) {
        /* */
    } else {
        if (is_number(functor))
            throw make_error(new Compound("type_error", ["atom", functor]));
        functor = new Compound(functor, args);
    }
    return functor;
}

export function list_objects(obj) {
    let peek = obj;
    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);
    if (i === 0) {
        return VOID_ARGS;
    } else {
        let args = new Array(i);
        peek = obj;
        i = 0;
        while (is_structure(peek) &&
                "." === peek.functor &&
                peek.args.length === 2) {
            args[i++] = deref(peek.args[0]);
            peek = deref(peek.args[1]);
        }
        return args;
    }
}

function special_univ_unpack(alpha) {
    if (is_structure(alpha)) {
        let temp = alpha.args;
        alpha = alpha.functor;
        return new Compound(".", [alpha,
            objects_list(temp, 0, temp.length)]);
    } else {
        return new Compound(".", [alpha, "[]"]);
    }
}

export function objects_list(args, off, count) {
    let res = "[]";
    for (let i = off + count - 1; i >= off; i--)
        res = new Compound(".", [args[i], res]);
    return res;
}

/**
 * functor(T, F, A): [ISO 8.5.1]
 * If T is a variable, the built-in succeeds in T with a new Prolog term
 * from the functor F and the arity A. Otherwise the built-in succeeds in
 * F and L with the functor and arguments of the Prolog term T.
 */
function test_functor(args) {
    let alpha = exec_deref(args[0]);
    if (is_variable(alpha) || is_pending(alpha)) {
        let functor = exec_build(args[1]);
        check_atomic(functor);
        let arity = exec_build(args[2]);
        check_integer(arity);
        if (arity < 0)
            throw make_error(new Compound("domain_error",
                ["not_less_than_zero", arity]));
        if (arity > MAX_ARITY)
            throw make_error(new Compound("representation_error",
                ["max_arity"]));
        arity = narrow_float(arity);
        if (arity === 0) {
            /* */
        } else {
            if (is_number(functor))
                throw make_error(new Compound("type_error", ["atom", functor]));
            let temp = new Array(arity);
            for (let i = 0; i < arity; i++)
                temp[i] = new Variable();
            functor = new Compound(functor, temp);
        }
        return exec_unify(alpha, functor);
    } else {
        alpha = exec_build(alpha);
        let functor;
        let arity;
        if (is_structure(alpha)) {
            functor = alpha.functor;
            arity = alpha.args.length;
        } else {
            functor = alpha;
            arity = 0;
        }
        if (!exec_unify(args[1], functor))
            return false;
        return exec_unify(args[2], norm_smallint(arity));
    }
}

/**
 * arg(K, X, Y): [ISO 8.5.2]
 * The predicate succeeds in Y with the K-th argument of X.
 */
function test_arg(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    let beta = exec_build(args[1]);
    check_callable(beta);
    let arity;
    if (is_structure(beta)) {
        arity = beta.args.length;
    } else {
        arity = 0;
    }
    if (alpha < 1 || arity < alpha)
        return false;
    beta = beta.args[alpha - 1];
    return exec_unify(args[2], beta);
}

/**
 * Assure that the object is a callable.
 *
 * @param beta The object.
 */
export function check_callable(beta) {
    if (is_variable(beta) || is_number(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["callable", beta]));
    }
}

/*********************************************************************/
/* change_arg/3                                                      */
/*********************************************************************/

/**
 * change_arg(K, X, Y):
 * The predicate succeeds. As a side-effect the K-th argument of X is set to Y.
 */
function test_change_arg(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    let beta = exec_build(args[1]);
    check_callable(beta);
    let gamma = exec_build(args[2]);
    let arity;
    if (is_structure(beta)) {
        arity = beta.args.length;
    } else {
        arity = 0;
    }
    if (alpha < 1 || arity < alpha)
        return false;
    linkarg(gamma, beta, alpha);
    return true;
}

function linkarg(source, term, pos) {
    if (is_frozen(term))
        throw make_error(new Compound("permission_error",
            ["modify", "compound", term]));
    if ((term.walk & VAR_MASK_STATE) === gc_mask)
        mark2_term(source);
    term.args[pos-1] = source;
}

/*********************************************************************/
/* term_variables/2                                                  */
/*********************************************************************/

/**
 * term_variables(T, L): [TC2 8.5.5]
 * The built-in succeeds in L with a list of the variables of T.
 */
function test_term_variables(args) {
    let alpha = exec_build(args[0]);
    let res = null;
    let back = null;

    function term_variables2(node) {
        let peek = new Compound(".", [node, undefined]);
        if (back === null) {
            res = peek;
        } else {
            back.args[1] = peek;
        }
        back = peek;
        return false;
    }

    walk_vars(alpha, term_variables2, VAR_MASK_SEEN);
    if (back === null) {
        res = "[]";
    } else {
        back.args[1] = "[]";
    }
    walk_vars(alpha, node => false, 0);
    return exec_unify(args[1], res);
}

export function walk_vars(first, acceptor, state) {
    let stack = null;
    for (; ; ) {
        first = deref(first);
        if (is_variable(first)) {
            if ((first.flags & VAR_MASK_SEEN) !== state) {
                if (acceptor(first))
                    return true;
                first.flags = (first.flags & ~VAR_MASK_SEEN) | state;
            }
        } else if (is_compound(first)) {
            if ((first.walk & VAR_MASK_SEEN) !== state) {
                first.walk = (first.walk & ~VAR_MASK_SEEN) | state;
                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 false;
        } else {
            item.walk++;
            first = item.args[item.walk & VAR_MASK_SERNO];
            if ((item.walk & VAR_MASK_SERNO) === item.args.length - 1)
                stack_pop(stack);
        }
    }
}

/*********************************************************************/
/* var/1, compound/1 and nonvar/1                                    */
/*********************************************************************/

/**
 * var(V): [ISO 8.3.1]
 * The built-in succeeds if V is a Prolog variable. Otherwise, it fails.
 */
function test_var(args) {
    let alpha = exec_build(args[0]);
    return is_variable(alpha);
}

/**
 * compound(C): [ISO 8.3.6]
 * The built-in succeeds if C is a Prolog compound. Otherwise, it fails.
 */
function test_compound(args) {
    let alpha = exec_build(args[0]);
    return is_structure(alpha);
}

/**
 * nonvar(V): [ISO 8.3.7]
 * The built-in succeeds if V is not a Prolog variable. Otherwise, it fails.
 */
function test_nonvar(args) {
    let alpha = exec_build(args[0]);
    return !is_variable(alpha);
}

/*********************************************************************/
/* atomic/1, number/1 and float/1                                    */
/*********************************************************************/

/**
 * atomic(A): [ISO 8.3.5]
 * The built-in succeeds if A is a Prolog symbol or number. Otherwise, it fails.
 */
function test_atomic(args) {
    let alpha = exec_build(args[0]);
    if (is_structure(alpha) || is_variable(alpha))
        return false;
    return true;
}

/**
 * number(A): [ISO 8.3.8]
 * The built-in succeeds if A is a Prolog number. Otherwise, it fails.
 */
function test_number(args) {
    let alpha = exec_build(args[0]);
    return is_number(alpha);
}

/**
 * float(A): [ISO 8.3.4]
 * The built-in succeeds if A is a Prolog float. Otherwise, it fails.
 */
function test_float(args) {
    let alpha = exec_build(args[0]);
    return is_float(alpha) && !is_special(alpha);
}

/*********************************************************************/
/* integer/1, atom/1, callable/1 and must_be/2                       */
/*********************************************************************/

/**
 * integer(A): [ISO 8.3.3]
 * The built-in succeeds if A is a Prolog integer. Otherwise, it fails.
 */
function test_integer(args) {
    let alpha = exec_build(args[0]);
    return is_integer(alpha);
}

/**
 * atom(A): [ISO 8.3.2]
 * The built-in succeeds if A is a Prolog atom. Otherwise, it fails.
 */
function test_atom(args) {
    let alpha = exec_build(args[0]);
    return is_atom(alpha);
}

/**
 * callable(C): [TC2 8.3.9]
 * The built-in succeeds if C is a Prolog compound or symbol. Otherwise, it fails.
 */
function test_callable(args) {
    let alpha = exec_build(args[0]);
    if (is_variable(alpha) || is_number(alpha))
        return false;
    return true;
}

/**
 * must_be(T, A):
 * The built-in succeeds if A is of type T. Otherwise, an exception is thrown.
 */
function test_must_be(args) {
    let alpha = exec_build(args[0]);
    check_atom(alpha);
    let beta = exec_build(args[1]);
    if ("integer" === alpha) {
        check_integer(beta);
    } else if ("atom" === alpha) {
        check_atom(beta);
    } else if ("callable" === alpha) {
        check_callable(beta);
    } else {
        throw make_error(new Compound("type_error",
                ["type", alpha]));
    }
    return true;
}

/*********************************************************************/
/* Number Utilities                                                  */
/*********************************************************************/

/**
 * Normalize a JavaScript smallint. We do not check type obj === "number"
 * and Number.isInteger(obj), but this is assumed. The later assumption
 * is deliberately violated in truncate/1, etc.. implementation.
 *
 * @param alpha The smallint.
 * @return The Prolog integer.
 */
export function norm_smallint(alpha) {
    if ((-94906266 <= alpha) && (alpha <= 94906266)) {
        return alpha;
    } else {
        return BigInt(alpha);
    }
}

/**
 * Normalize a JavaScript bigint. We do not check type obj === "biginteger",
 * but this is assumed.
 *
 * @param alpha The bigint.
 * @return The Prolog integer.
 */
export function norm_bigint(alpha) {
    if ((-94906266 <= alpha) && (alpha <= 94906266)) {
        return Number(alpha);
    } else {
        return alpha;
    }
}

/**
 * Widen a Prolog integer.
 *
 * @param alpha The Prolog integer.
 * @return The JavaScript bigint.
 */
export function widen_bigint(alpha) {
    if (!is_bigint(alpha)) {
        return BigInt(alpha);
    } else {
        return alpha;
    }
}

/**
 * Narrow a Prolog number to a JavaScript float.
 *
 * @param alpha The Prolog number.
 * @return The JavaScript float.
 */
export function narrow_float(alpha) {
    if (!is_bigint(alpha)) {
        if (!Number.isFinite(alpha))
            throw make_error(new Compound("evaluation_error", ["undefined"]));
    } else {
        alpha = Number(alpha);
        if (!Number.isFinite(alpha))
            throw make_error(new Compound("evaluation_error", ["float_overflow"]));
    }
    return alpha;
}

/**
 * Norm a JavaScript float to a Prolog float.
 *
 * @param alpha The JavaScript float.
 * @return The Prolog float.
 */
export function norm_float(alpha) {
    if (Number.isNaN(alpha))
        throw make_error(new Compound("evaluation_error", ["undefined"]));
    if (!Number.isFinite(alpha))
        throw make_error(new Compound("evaluation_error", ["float_overflow"]));
    if ((-94906266 <= alpha) && (alpha <= 94906266)
        && Number.isInteger(alpha))
        return BigInt(alpha);
    return alpha;
}

/*********************************************************************/
/* code_category/2 and code_numeric/2                                */
/*********************************************************************/

/**
 * code_category(C, T):
 * The predicate succeeds in T with the Unicode general category of C.
 * Otherwise, the predicate succeeds in T with 0.
 */
function test_code_category(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    if (alpha < 0 || alpha > 0x10FFFF) {
        alpha = 0; // UNASSIGNED
    } else {
        alpha = code_category(alpha);
    }
    return exec_unify(args[1], alpha);
}

/**
 * code_numeric(C, V):
 * The predicate succeeds in V with the Unicode numeric value of C,
 * in case it is integer and between 0 and 35. Otherwise, the predicate
 * succeeds in V with -1.
 */
function test_code_numeric(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    if (alpha < 0 || alpha > 0x10FFFF) {
        alpha = -1; // UNASSIGNED
    } else {
        alpha = code_numeric(alpha);
    }
    return exec_unify(args[1], alpha);
}

/*********************************************************************/
/* atom_integer/3                                                    */
/*********************************************************************/

/**
 * atom_integer(A, R, N):
 * If A is a variable, then the built-in succeeds in A with the
 * atom for the Prolog integer N in radix R. Otherwise the
 * built-in succeeds in N with the Prolog number from the
 * atom A in radix R.
 */
function test_atom_integer(args) {
    let radix = exec_build(args[1]);
    check_integer(radix);
    if (radix < 2 || radix > 36)
        throw make_error(new Compound("domain_error", ["radix", radix]));
    let text = exec_deref(args[0]);
    if (is_variable(text) || is_pending(text)) {
        let beta = exec_build(args[2]);
        check_integer(beta);
        beta = beta.toString(radix);
        return exec_unify(text, beta);
    } else {
        text = exec_build(text);
        check_atom(text);
        text = atom_integer_decode(text, radix);
        return exec_unify(args[2], text);
    }
}

/**
 * Decode a Prolog integer from a string.
 *
 * @param text The string
 * @param radix The radix.
 * @return The Prolog integer.
 */
function atom_integer_decode(text, radix) {
    text = ascii_replace(text, radix, false);
    let res;
    let step = (52 / (32 - Math.clz32(radix - 1))) | 0;
    if (text.length <= step) {
        res = Number.parseInt(text, radix);
        if (isNaN(res))
            throw make_error(new Compound("syntax_error", ["illegal_number"]));
        res = norm_smallint(res);
    } else {
        if (0 < text.length && text.charCodeAt(0) === 45) {
            res = -bigint_parse(text, 1, step, radix);
        } else {
            res = bigint_parse(text, 0, step, radix);
        }
        res = norm_bigint(res);
    }
    return res;
}

/**
 * Parse a bigint in some radix.
 *
 * @param str The string.
 * @param help The start position.
 * @param step The chunk size.
 * @param radix The radix.
 * @return The bigint.
 */
function bigint_parse(str, help, step, radix) {
    if (help === str.length)
        throw make_error(new Compound("syntax_error", ["illegal_number"]));
    let res = BigInt(0);
    while (help + step < str.length) {
        let temp = Number.parseInt(str.slice(help, help + step), radix);
        if (isNaN(temp) || temp < 0)
            throw make_error(new Compound("syntax_error", ["illegal_number"]));
        res = res * BigInt(radix ** step) + BigInt(temp);
        help += step;
    }
    let temp = Number.parseInt(str.slice(help), radix);
    if (isNaN(temp) || temp < 0)
        throw make_error(new Compound("syntax_error", ["illegal_number"]));
    return res * BigInt(radix ** (str.length - help)) + BigInt(temp);
}

/**
 * Convert and validate Unicode number values
 * into capital ASCII number value.
 *
 * @param text The string.
 * @param radix The radix.
 * @param expo The float flag.
 * @return The The new string.
 */
function ascii_replace(text, radix, expo) {
    let buf = "";
    let last = 0;
    let pos = 0;
    while (pos < text.length) {
        let ch = text.codePointAt(pos);
        let val = code_numeric(ch);
        if (val >= 0 && val < radix) {
            if (ch <= 127) { // ASCII
                /* */
            } else {
                if (val < 10) {
                    val += 48; // '0'
                } else {
                    val += 55; // 'A'-10
                }
                buf += text.slice(last, pos) + String.fromCodePoint(val);
                last = pos + char_count(ch);
            }
        } else if ((ch===43 || ch===45) && (pos===0 ||
            (expo && (text.charCodeAt(pos-1)===101 || text.charCodeAt(pos-1)===69)))) {
            /*  */
        } else if (expo && (ch===46 || ch===101 || ch===69)) {
            /*  */
        } else {
            throw make_error(new Compound("syntax_error", ["illegal_number"]));
        }
        pos += char_count(ch);
    }
    if (last !== 0) {
        buf += text.slice(last);
        return buf;
    } else {
        return text;
    }
}

/**
 * Return the 16-bit char count of a Unicode code point.
 *
 * @param ch The code point.
 * @return The char count.
 */
export function char_count(ch) {
    if (ch <= 0xFFFF) {
        return 1;
    } else {
        return 2;
    }
}

/*********************************************************************/
/* atom_number/2                                                     */
/*********************************************************************/

/**
 * atom_number(A, N):
 * If A is a variable, then the built-in succeeds in A with the
 * atom for the Prolog number N. Otherwise the built-in succeeds in N
 * with the Prolog number from the atom A.
 */
function test_atom_number(args) {
    let text = exec_deref(args[0]);
    if (is_variable(text) || is_pending(text)) {
        let beta = exec_build(args[1]);
        check_number(beta);
        beta = atom_number_encode(beta);
        return exec_unify(text, beta);
    } else {
        text = exec_build(text);
        check_atom(text);
        text = atom_number_decode(text);
        return exec_unify(args[1], text);
    }
}

/**
 * Encode a Prolog number to a string.
 *
 * @param num The Prolog number.
 * @return The string.
 */
function atom_number_encode(num) {
    if (is_integer(num)) {
        return num.toString();
    } else {
        num = narrow_float(num);
        let res = num.toPrecision(16);
        if (Number(res) !== num)
            res = num.toPrecision(17);
        return shape_number(res);
    }
}

/**
 * Shape the number string so that it has no trailing
 * zeros after the period, always a period, no exponent
 * positive sign and lower case exponent.
 *
 * @param res The ascii number string
 * @return The shaped number string.
 */
function shape_number(res) {
    let peek = res.indexOf("e");
    if (peek !== -1) {
        res = shape_number_mantissa(res.slice(0, peek)) +
            "e" + shape_number_exponent(res.slice(peek + 1));
    } else {
        res = shape_number_mantissa(res);
    }
    return res;
}

function shape_number_mantissa(res) {
    if (res.indexOf(".") !== -1) {
        let pos = res.length;
        while (res.charCodeAt(pos - 1) === 48)  // '0'
            pos--;
        if (res.charCodeAt(pos - 1) === 46)  // '.'
            pos++;
        if (pos !== res.length)
            res = res.slice(0, pos);
    } else {
        res += ".0";
    }
    return res;
}

function shape_number_exponent(res) {
    if (res.startsWith("+"))
        res = res.slice(1);
    return res;
}

/**
 * Decode a Prolog number from a string. Unlike the ISO
 * core standard and numbers without a period but with
 * an exponent are accepted as float.
 *
 * @param text The string
 * @return The Prolog number.
 */
function atom_number_decode(text) {
    text = ascii_replace(text, 10, true);
    let res;
    if ((text.indexOf(".") !== -1) ||
        (text.indexOf("e") !== -1) ||
        (text.indexOf("E") !== -1)) {
        res = Number(text);
        if (isNaN(res))
            throw make_error(new Compound("syntax_error", ["illegal_number"]));
        res = norm_float(res);
    } else {
        if (text.length <= 8) {
            res = Number(text);
            if (isNaN(res))
                throw make_error(new Compound("syntax_error", ["illegal_number"]));
            res = norm_smallint(res);
        } else {
            try {
                res = BigInt(text);
            } catch (e) {
                throw make_error(new Compound("syntax_error", ["illegal_number"]));
            }
            res = norm_bigint(res);
        }
    }
    return res;
}

/******************************************************************/
/* sys_goal_ossify/3 and sys_clause_ossify/6                        */
/******************************************************************/

/**
 * sys_goal_ossify(B, R, G): internal only
 * The built-in succeeds in G with a JavaScript object representing
 * a goal with body instructions B and the cut option R.
 */
function test_sys_goal_ossify(args) {
    let alpha = exec_build(args[0]);
    let body = list_objects(alpha);
    let beta = exec_build(args[1]);
    let cutvar;
    let size = 0;
    try {
        size = number_term(beta, size);
        size = number_objects(body, size);
        cutvar = ossify_cutvar(beta);
        ossify_objects(body);
    } finally {
        unossify_term(beta);
        unossify_objects(alpha);
    }
    return exec_unify(args[2],
        new Goal(size, body, cutvar));
}

/**
 * sys_clause_ossify(H, B, R, W, C): internal only
 * The built-in succeeds in C with a JavaScript object representing
 * a clause with head instructions H, body instructions B,
 * cut option R and head functor W.
 */
function test_sys_clause_ossify(args) {
    let alpha = exec_build(args[0]);
    let head = list_objects(alpha);
    let beta = exec_build(args[1]);
    let body = list_objects(beta);
    let gamma = exec_build(args[2]);
    let mue = exec_build(args[3]);
    let cutvar;
    let size = 0;
    try {
        size = number_term(gamma, size);
        size = number_objects(head, size);
        size = number_objects(body, size);
        cutvar = ossify_cutvar(gamma);
        ossify_objects(head);
        ossify_objects(body);
    } finally {
        unossify_term(gamma);
        unossify_objects(alpha);
        unossify_objects(beta);
    }
    return exec_unify(args[4],
        new Clause(size, mue, head, body, cutvar));
}

/******************************************************************/
/* Object Lists                                                   */
/******************************************************************/

function number_objects(peek, size) {
    for (let i = 0; i < peek.length; i++)
       size = number_term(peek[i], size);
    return size;
}

function ossify_objects(peek) {
    for (let i = 0; i < peek.length; i++)
        peek[i] = ossify_term(peek[i]);
}

function unossify_objects(peek) {
    while (is_structure(peek) &&
            "." === peek.functor &&
            peek.args.length === 2) {
        unossify_term(peek.args[0]);
        peek = deref(peek.args[1]);
    }
}

/******************************************************************/
/* Cut Variable                                                   */
/******************************************************************/

function ossify_cutvar(peek) {
    if (is_structure(peek) &&
        "just" === peek.functor &&
        peek.args.length === 1) {
        let res = ossify_term(peek.args[0]);
        return res.index;
    } else {
        return -1;
    }
}

/******************************************************************/
/* Term Ossify                                                    */
/******************************************************************/

function number_term(alpha, size) {

    function number_term2(first) {
        for (; ;) {
            first = deref(first);
            if (is_variable(first)) {
                if (first.tail === null) {
                    first.tail = undefined;
                } else if (first.tail === undefined) {
                    first.tail = new Place(size);
                    size++;
                }
            } else if (is_compound(first)) {
                let i = 0;
                for (; i < first.args.length - 1; i++)
                    number_term2(first.args[i]);
                first = first.args[i];
                continue;
            }
            break;
        }
    }

    number_term2(alpha);
    return size;
}

function ossify_term(first) {
    let back = null;
    for (;;) {
        first = deref(first);
        if (is_variable(first)) {
            first = first.tail;
        } else if (is_compound(first)) {
            let args = new Array(first.args.length);
            let i = 0;
            for (; i < first.args.length-1; i++)
                args[i] = ossify_term(first.args[i]);
            args[i] = back;
            back = new Skeleton(first.functor, args);
            first = first.args[i];
            continue;
        }
        while (back !== null) {
            let peek = back.args[back.args.length-1];
            back.args[back.args.length-1] = first;
            first = try_freeze(back);
            back = peek;
        }
        return first;
    }
}

function try_freeze(alpha) {
    for (let i = 0; i < alpha.args.length; i++) {
        let temp = alpha.args[i];
        if (is_pending(temp))
            return alpha;
        if (is_skeleton(temp))
            return alpha;
    }
    return new Frozen(alpha.functor, alpha.args);
}

function unossify_term(first) {
    for (;;) {
        first = deref(first);
        if (is_variable(first)) {
            if (first.tail != null)
                first.tail = null;
        } else if (is_compound(first)) {
            let i = 0;
            for (; i < first.args.length-1; i++)
                unossify_term(first.args[i]);
            first = first.args[i];
            continue;
        }
        break;
    }
}

/*********************************************************************/
/* sys_clause_add/2 and sys_goal_call/1                                */
/*********************************************************************/

/**
 * sys_clause_add(C, O): internal only
 * The built-in succeeds. As a side effect the JavaScript object clause C
 * is added according to options O to the knowledge base.
 */
function test_sys_clause_add(args) {
    let gamma = exec_build(args[0]);
    check_clause(gamma);
    let flags = exec_build(args[1]);
    check_integer(flags);
    add_clause(gamma, flags);
    return true;
}

export function check_clause(beta) {
    if (!is_clause(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["clause", beta]));
    }
}

/**
 * sys_goal_call(A):
 * The predicate succeeds whenever the compiled goal A succeeds.
 */
function special_sys_goal_call(args) {
    let goal = deref(args[0]);
    check_goal(goal);
    goal = melt_directive(goal);
    solve_seq(goal);
    return true;
}

export function check_goal(beta) {
    if (!is_goal(beta)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["goal", beta]));
    }
}

/*********************************************************************/
/* Special Init                                                      */
/*********************************************************************/

// Albufeira compiler, control flow
set("fail", 0, make_check(test_fail));
set("$CUT", 1, make_check(test_cut));
set("$MARK", 1, make_check(test_mark));
set("$SEQ", 2, make_special(special_seq));
set("$ALT", 1, make_special(special_alt));
set("sys_raise", 1, make_check(test_sys_raise));
set("sys_trap", 3, make_special(special_sys_trap));

// Albufeira compiler, async flow
set("os_sleep_promise", 2, make_check(test_os_sleep_promise));
set("os_import_promise", 3, make_check(test_os_import_promise));
set("os_invoke_main", 1, make_check(test_os_invoke_main));
set("$YIELD", 1, make_special(special_yield));
set("shield", 1, make_special(special_shield));
set("unshield", 1, make_special(special_unshield));
set("call", 1, make_special(special_call));

// term specials
set("=", 2, make_check(test_unify));
set("copy_term", 2, make_check(test_copy_term));
set("=..", 2, make_check(test_univ));
set("functor", 3, make_check(test_functor));
set("arg", 3, make_check(test_arg));
set("change_arg", 3, make_check(test_change_arg));
set("term_variables", 2, make_check(test_term_variables));

// type specials
set("var", 1, make_check(test_var));
set("compound", 1, make_check(test_compound));
set("nonvar", 1, make_check(test_nonvar));
set("atomic", 1, make_check(test_atomic));
set("number", 1, make_check(test_number));
set("float", 1, make_check(test_float));

// must specials
set("integer", 1, make_check(test_integer));
set("atom", 1, make_check(test_atom));
set("callable", 1, make_check(test_callable));
set("must_be", 2, make_check(test_must_be));

// atom specials
set("code_category", 2, make_check(test_code_category));
set("code_numeric", 2, make_check(test_code_numeric));
set("atom_integer", 3, make_check(test_atom_integer));
set("atom_number", 2, make_check(test_atom_number));

// clause specials
set("sys_goal_ossify", 3, make_check(test_sys_goal_ossify));
set("sys_clause_ossify", 5, make_check(test_sys_clause_ossify));
set("sys_clause_add", 2, make_check(test_sys_clause_add));
set("sys_goal_call", 1, make_special(special_sys_goal_call));
