/**
 * 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 {
    is_provable, MASK_PRED_DYNAMIC, kb, stage, pred_link,
    set_stage, Clause, is_logical, clear, pred_destroy,
    set_partition, add_clause, add, is_goal,
    pred_touch, remove_clause, snapshot_data, Cache, Frozen,
    engine, Variable, Compound, is_structure, Goal, is_cache,
    Place, Quote, Skeleton, unquote_objects, is_clause,
    deref, copy_term, MASK_PRED_BITS, make_defined
} from "./store.mjs";
import {
    fs, call, Choice, cont, os, gc_major,
    defined_clauses, ctx, real_time, lookup_pred, make_error,
    exec_head, exec_body, gc_enter, gc_time,
    exec_unify, exec_build, VOID_ARGS, unbind,
    make_indicator, make_indicator_term, is_atom,
    more, trail, unify, register_signal, melt_directive,
    path, check_nonvar, gc_maxinfs, check_callable
} from "./machine.mjs";
import {
    check_atom, norm_smallint, narrow_float, make_check,
    check_integer, char_count, make_special,
    list_objects, solve_seq, norm_float
} from "./special.mjs";

export const MAX_BUF = 4096;

export let codebase = "";
export let bootbase = "";

/**
 * Set the code base.
 *
 * @param url The code base.
 */
export function set_codebase(url) {
    codebase = url;
}

/**
 * Set the boot base.
 *
 * @param url The boot base.
 */
export function set_bootbase(url) {
    bootbase = url;
}

/*********************************************************************/
/* current_output/1 and current_error/1                              */
/*********************************************************************/

export const MASK_DST_COLR = 0x00000004;
export const MASK_DST_CYCL = 0x00000008;
export const MASK_DST_FEAT = MASK_DST_COLR | MASK_DST_CYCL;

/**
 * Create a text output.
 */
export function Sink() {
    this.buf = "";
    this.send = (fd, buf) => fd;
    this.last = -1;
    this.flags = 0;
    this.notify = fd => {};
    this.release = fd => {};
    this.data = undefined;
    this.indent = 0;
}

/**
 * current_output(S): [ISO 8.11.2]
 * The built-in succeeds in S with the current output.
 */
function test_current_output(args) {
    let alpha = engine.text_output;
    return exec_unify(args[0], alpha);
}

/**
 * current_error(S):
 * The built-in succeeds in S with the current error.
 */
function test_current_error(args) {
    let alpha = engine.text_error;
    return exec_unify(args[0], alpha);
}

/*********************************************************************/
/* set_output/1 and set_error/1                                      */
/*********************************************************************/

/**
 * set_output(S): [ISO 8.11.4]
 * The built-in succeeds. As a side effect the current output is set to S.
 */
function test_set_output(args) {
    let obj = exec_build(args[0]);
    check_sink(obj);
    engine.text_output = obj;
    return true;
}

/**
 * set_error(S):
 * The built-in succeeds. As a side effect the current error is set to S.
 */
function test_set_error(args) {
    let obj = exec_build(args[0]);
    check_sink(obj);
    engine.text_error = obj;
    return true;
}

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

/*********************************************************************/
/* put_atom/2                                                        */
/*********************************************************************/

/**
 * put_atom(S, A):
 * The built-in succeeds. As a side effect, it adds
 * the atom to the stream S.
 */
function test_put_atom(args) {
    let stream = exec_build(args[0]);
    check_sink(stream);
    let text = exec_build(args[1]);
    check_atom(text);
    put_atom(stream, text);
    return true;
}

export function put_atom(stream, text) {
    if (text.length > 0) {
        stream.last = last_code(text, text.length);
        if (stream.buf !== null) {
            stream.buf += text;
            if (stream.buf.length >= MAX_BUF)
                flush_buffer(stream);
        } else {
            stream.data = stream.send(stream.data, text);
        }
    }
}

function flush_buffer(stream) {
    if (stream.buf !== null && stream.buf.length > 0) {
        let text = stream.buf;
        stream.buf = "";
        stream.data = stream.send(stream.data, text);
    }
}

export function last_code(text, pos) {
    let ch = text.charCodeAt(pos - 1);
    if (ch >= 0xDC00 && ch <= 0xDFFF && pos > 1) {
        let res2 = text.charCodeAt(pos - 2);
        if (res2 >= 0xD800 && res2 <= 0xDBFF)
            ch = ((res2 - 0xD7C0) << 10) + ch - 0xDC00;
    }
    return ch;
}

/*********************************************************************/
/* current_input/1 and set_input/1                                   */
/*********************************************************************/

const MASK_SRC_SKIP = 0x00000001;
export const MASK_SRC_AREAD = 0x00000002;

/**
 * Create a text input.
 */
export function Source() {
    this.buf = "";
    this.pos = 0;
    this.receive = fd => "";
    this.flags = 0;
    this.lineno = 0;
    this.release = fd => {};
    this.data = undefined;
    this.partial = undefined;
}

/**
 * current_input(S): [ISO 8.11.1]
 * The built-in succeeds in S with the current input.
 */
function test_current_input(args) {
    let alpha = engine.text_input;
    return exec_unify(args[0], alpha);
}

/**
 * set_input(S): [ISO 8.11.3]
 * The built-in succeeds. As a side effect it sets the current input to S.
 */
function test_set_input(args) {
    let obj = exec_build(args[0]);
    check_source(obj);
    engine.text_input = obj;
    return true;
}

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

/*********************************************************************/
/* os_get_code/2 and os_peek_code/2                                  */
/*********************************************************************/

/**
 * os_get_code(S, C):
 * The predicate succeeds in C with the Unicode point from the stream buffer S.
 * As a side effect the stream position is advanced.
 */
function test_os_get_code(args) {
    let stream = exec_build(args[0]);
    let pos = stream.pos;
    let buf = stream.buf;
    if (pos < buf.length) {
        let ch = buf.codePointAt(pos);
        pos += char_count(ch);
        if (ch === 13 || (ch === 10 && (stream.flags & MASK_SRC_SKIP) === 0))
            stream.lineno++;
        if (ch === 13) {
            stream.flags |= MASK_SRC_SKIP;
        } else {
            stream.flags &= ~MASK_SRC_SKIP;
        }
        stream.pos = pos;
        return exec_unify(args[1], ch);
    } else {
        return false;
    }
}

/**
 * os_peek_code(S, C):
 * The built-in succeeds in C with the Unicode point from the stream buffer S.
 */
function test_os_peek_code(args) {
    let stream = exec_build(args[0]);
    let pos = stream.pos;
    let buf = stream.buf;
    if (pos < buf.length) {
        let ch = buf.codePointAt(pos);
        return exec_unify(args[1], ch);
    } else {
        return false;
    }
}

/*******************************************************************/
/* os_open_promise_opts/4                                          */
/*******************************************************************/

/**
 * os_open_promise_opts(P, L, S, Q):
 * The predicate succeeds in Q with a promise for open input S
 * on path P and option list L.
 */
function test_os_open_promise_opts(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    let opts = exec_build(args[1]);
    let stream = new Source();
    if (!exec_unify(args[2], stream))
        return false;
    let buf = ctx;
    let prom;
    if (fs !== undefined) {
        prom = open_file_promise_opts(buf, stream, url, opts);
    } else {
        throw make_error(new Compound("permission_error",
            ["access", "source_sink", url]));
    }
    return exec_unify(args[3], prom);
}

export function get_encoding(opts) {
    if (opts !== null && opts.get("encoding") !== undefined) {
        return opts.get("encoding");
    } else {
        return "utf8";
    }
}

function open_file_promise_opts(buf, stream, url, opts) {
    return new Promise(resolve => {
        fs.open(url, (err, fd) => {
            if (!err) {
                let enc = get_encoding(opts);
                stream.data = fd;
                stream.receive = (buf, stream) => file_read_promise(enc, buf, stream);
                stream.release = file_close_promise;
                stream.partial = Buffer.alloc(0);
                stream.flags |= MASK_SRC_AREAD;
            } else {
                register_signal(buf, map_file_error(err, url));
            }
            resolve();
        });
    });
}

export function map_file_error(err, url) {
    if (err.cause !== undefined) {
        let code = err.cause.code;
        if (code === "ENOTFOUND") {
            return new Compound("resource_error", ["unknown_host"]);
        } else {
            return new Compound("resource_error", ["connect_failed"]);
        }
    } else {
        let code = err.code;
        if (code === "ENOENT" || code === "EISDIR" || code === "EPERM") {
            return new Compound("existence_error",
                ["source_sink", url]);
        } else {
            return new Compound("resource_error", ["remote_error"]);
        }
    }
}

/*******************************************************************/
/* os_read_promise/2 and os_close_promise/2                        */
/*******************************************************************/

/**
 * os_read_promise(S, P):
 * The predicate suceeds in P with a read promise for a input S.
 */
function test_os_read_promise(args) {
    let stream = exec_build(args[0]);
    let buf = ctx;
    return exec_unify(args[1], stream.receive(buf, stream));
}

export function file_read_promise(enc, buf, stream) {
    return new Promise(resolve => {
        let res = Buffer.alloc(8192);
        stream.partial.copy(res, 0);
        let pos = stream.partial.length;
        fs.read(stream.data, res, pos, 8192-pos, null, (err, len, _) => {
            if (!err) {
                let last = last_valid(res, pos+len, enc);
                stream.buf = res.toString(enc, 0, last);
                stream.pos = 0;
                stream.partial = res.slice(last, pos+len);
            } else {
                register_signal(buf, map_stream_error(err));
            }
            resolve();
        });
    });
}

function last_valid(res, len, enc) {
    if (enc === "utf8") {
        let pos = len;
        while (pos > 0 && (res[pos-1] & 0xC0) === 0x80)
            pos--;
        if (pos > 0) {
            if ((res[pos - 1] & 0x80) === 0x00 && pos === len) {
                return len;
            } else if ((res[pos - 1] & 0xE0) === 0xC0 && pos === len - 1) {
                return len;
            } else if ((res[pos - 1] & 0xF0) === 0xE0 && pos === len - 2) {
                return len;
            } else if ((res[pos - 1] & 0xF8) === 0xF0 && pos === len - 3) {
                return len;
            } else {
                pos--;
            }
        }
        return pos;
    } else {
        return len;
    }
}

/**
 * Map a stream error when in transit.
 *
 * @param err The offending error.
 * @return {Compound} The Prolog error term.
 */
export function map_stream_error(err) {
    let code = err.code;
    if (code === "ETIMEDOUT") {
        return new Compound("resource_error",
            ["socket_timeout"]);
    } else if (code === "EADDRINUSE") {
        return new Compound("resource_error",
            ["port_error"]);
    } else if (code === "ECONNRESET") {
        return new Compound("resource_error",
            ["remote_error"]);
    } else {
        return new Compound("resource_error",
            ["io_exception"]);
    }
}

/**
 * os_close_promise(S, P):
 * The predicate suceeds in P with a close promise for a input S.
 */
function test_os_close_promise(args) {
    let stream = exec_build(args[0]);
    let buf = ctx;
    return exec_unify(args[1], stream.release(buf, stream));
}

function file_close_promise(buf, stream) {
    return new Promise(resolve => {
        fs.close(stream.data, err => {
            if (!err) {
                /* */
            } else {
                register_signal(buf, map_stream_error(err));
            }
            resolve();
        });
    });
}

/*********************************************************************/
/* os_prop_promise/3                                                 */
/*********************************************************************/

/**
 * os_prop_promise(F, M, Q):
 * The predicate succeeds in Q with with a promise for the
 * properties M of the file F. Barks if path F doesn't exist
 * or io exception while resolving.
 */
function test_os_prop_promise(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    let res = {};
    if (!exec_unify(args[1], res))
        return false;
    let buf = ctx;
    let prom;
    if (fs !== undefined) {
        prom = prop_file_promise(buf, url, res);
    } else {
        throw make_error(new Compound("permission_error",
            ["access", "source_sink", url]));
    }
    return exec_unify(args[2], prom);
}

function prop_file_promise(buf, url, res) {
    return new Promise(resolve => {
        fs.stat(url, (err, stats) => {
            if (!err) {
                let ftype = (stats.isFile() ? "regular" : (stats.isDirectory() ? "directory" : "other"));
                let mtime = Math.floor(stats.mtimeMs);

                res.last_modified = norm_smallint(mtime);
                res.absolute_path = path.resolve(url);
                res.type = ftype;
                res.can_write =((stats.mode & 0x80) !== 0 ? "true" : "false");
            } else {
                register_signal(buf, map_file_error(err, url));
            }
            resolve();
        });
    });
}

/******************************************************************/
/* os_stream_flags/2 and os_open_sync_opts/3                      */
/******************************************************************/

/**
 * (S, F):
 * The predicate succeeds in F with the flags of the stream S.
 */
function test_os_stream_flags(args) {
    let obj = exec_build(args[0]);
    let flags;
    if (obj instanceof Source) {
        flags = obj.flags;
    } else {
        check_sink(obj);
        flags = obj.flags;
    }
    return exec_unify(args[1], flags);
}

/**
 * os_open_sync_opts(P, M, L, S):
 * The predicate succeeds. As a side effect the stream S is
 * opened on the path P with the mode M and the option list L.
 */
function test_os_open_sync_opts(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    let mode = exec_build(args[1]);
    check_atom(mode);
    let opts = exec_build(args[2]);
    let stream;
    if ("read" === mode) {
        throw make_error(new Compound("resource_error",
            ["not_implemented"]));
    } else if ("write" === mode) {
        stream = open_write(url, "w", opts);
    } else if ("append" === mode) {
        stream = open_write(url, "a", opts);
    } else {
        throw make_error(new Compound("domain_error",
            ["io_mode", mode]));
    }
    return exec_unify(args[3], stream);
}

function open_write(url, mode, opts) {
    if (fs !== undefined) {
        let file;
        try {
            file = fs.openSync(url, mode);
        } catch (err) {
            throw make_error(map_file_error(err, url));
        }
        let dst = new Sink();
        let enc = get_encoding(opts);
        dst.data = file;
        dst.send = (data, buf) => file_write(data, buf, enc);
        dst.release = file_close;
        return dst;
    } else {
        throw make_error(new Compound("resource_error", ["io_exception"]));
    }
}

function file_write(data, buf, enc) {
    try {
        fs.writeSync(data, buf, null, enc);
        return data;
    } catch (err) {
        throw make_error(map_stream_error(err));
    }
}

function file_close(data) {
    try {
        fs.closeSync(data);
    } catch (err) {
        throw make_error(map_stream_error(err));
    }
}

/*********************************************************************/
/* flush_output/1 and os_close_sync/1                                */
/*********************************************************************/

/**
 * flush_output(S): [ISO 8.11.7]
 * The built-in succeeds. As a side effect, it flushes the stream S buffer.
 */
function test_flush_output(args) {
    let stream = exec_build(args[0]);
    check_sink(stream);
    stream_flush(stream);
    return true;
}

export function stream_flush(stream) {
    flush_buffer(stream);
    stream.notify(stream.data);
}

/**
 * close(S): [ISO 8.11.6]
 * The built-in succeeds. As a side effect, the stream S is closed.
 */
function test_os_close_sync(args) {
    let stream = exec_build(args[0]);
    if (stream instanceof Sink) {
        /* */
    } else {
        check_source(stream);
    }
    stream_close(stream);
    return true;
}

export function stream_close(stream) {
    if (stream instanceof Sink) {
        flush_buffer(stream);
        stream.release(stream.data);
    } else {
        stream.release(stream.data);
    }
}

/*********************************************************************/
/* os_cntrl_sync/2 and os_read_sync/1                                */
/*********************************************************************/

/**
 * os_cntrl_sync(F, P):
 * The predicate assigns the property P to the file F.
 */
function test_os_cntrl_sync(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    if (fs === undefined)
        throw make_error(new Compound("permission_error", ["access", "source_sink", url]));
    let prop = exec_build(args[1]);
    if (is_structure(prop) &&
        prop.functor === "last_modified" &&
        prop.args.length === 1) {
        let val = deref(prop.args[0]);
        check_integer(val);
        if (val < 0)
            throw make_error(new Compound("domain_error",
                ["not_less_than_zero", val]));
        val = new Date(narrow_float(val));
        try {
            fs.utimesSync(url, val, val);
        } catch (err) {
            throw make_error(map_file_error(err, url));
        }
    } else if (is_structure(prop) &&
            prop.functor === "can_write" &&
            prop.args.length === 1) {
        let val = deref(prop.args[0]);
        check_atom(val);
        if ("true" !== val && "false" !== val)
            throw make_error(new Compound("domain_error",
                ["boolean", val]));
        try {
            let stats = fs.statSync(url);
            if ("true" === val)
                fs.chmodSync(url, (stats.mode | 0x80));
            else
                fs.chmodSync(url, (stats.mode & ~0x80));
        } catch (err) {
            throw make_error(map_file_error(err, url));
        }
    } else {
        check_nonvar(prop);
        prop = copy_term(prop);
        throw make_error(new Compound("domain_error", ["prolog_property", prop]));
    }
    return true;
}

/**
 * os_read_sync(S):
 * The predicate succeeds. As a side effect the stream buffer is read.
 */
function test_os_read_sync(args) {
    let stream = exec_build(args[0]);
    stream.buf = stream.receive(stream.data);
    stream.pos = 0;
    return true;
}

/******************************************************************/
/* ir_anon_new/1, ir_place_new/2 and ir_skeleton_new/3            */
/******************************************************************/

/**
 * ir_anon_new(I, S):
 * The predicate succeeds in S with a new annonymous variable.
 */
function test_ir_anon_new(args) {
    let alpha = undefined;
    return exec_unify(args[0], new Quote(alpha));
}

/**
 * ir_place_new(I, S):
 * The predicate succeeds in S with a new place for index I.
 */
function test_ir_place_new(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    alpha = new Place(alpha);
    return exec_unify(args[1], new Quote(alpha));
}

/**
 * ir_skeleton_new(F, L, S):
 * The predicate succeeds in S with a new
 * skeleton for functor F and list L.
 */
function test_ir_skeleton_new(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    beta = list_objects(beta);
    unquote_objects(beta);
    alpha = new Skeleton(alpha, beta);
    return exec_unify(args[2], new Quote(alpha));
}

/*********************************************************************/
/* ir_make_frozen/3                                                  */
/*********************************************************************/

/**
 * ir_make_frozen(F, L, S):
 * The predicate succeeds in S with a new frozen
 * compound for functor F and list L.
 */
function test_ir_make_frozen(args) {
    let alpha = exec_build(args[0]);
    let beta = exec_build(args[1]);
    beta = list_objects(beta);
    alpha = new Frozen(alpha, beta);
    return exec_unify(args[2], alpha);
}

/*********************************************************************/
/* ir_pred_site/2, ir_is_site/1 and ir_site_name/2                   */
/*********************************************************************/

/**
 * ir_pred_site(X, Y): internal only
 * The built-in succeeds in Y with a cacheable X.
 */
function test_ir_pred_site(args) {
    let alpha = exec_build(args[0]);
    if (is_structure(alpha)) {
        if (is_atom(alpha.functor))
            alpha = new Compound(new Cache(alpha.functor), alpha.args);
    } else if (is_atom(alpha)) {
        alpha = new Cache(alpha);
    }
    return exec_unify(args[1], alpha);
}

/**
 * ir_is_site(X): internal only
 * The built-in succeeds if X is cacheable.
 */
function test_ir_is_site(args) {
    let alpha = exec_build(args[0]);
    if (is_structure(alpha))
        return is_cache(alpha.functor);
    return is_cache(alpha);
}

/**
 * ir_site_name(X, Y): internal only
 * The built-in succeeds in Y with a cachefree X.
 */
function test_ir_site_name(args) {
    let alpha = exec_build(args[0]);
    if (is_structure(alpha)) {
        if (is_cache(alpha.functor))
            alpha = new Compound(alpha.functor.name, alpha.args);
    } else if (is_cache(alpha)) {
        alpha = alpha.name;
    }
    return exec_unify(args[1], alpha);
}

/*********************************************************************/
/* ir_clause_new/5 and ir_clause_add/4                               */
/*********************************************************************/

/**
 * ir_clause_new(S, H, B, R, D, C):
 * The built-in succeeds in C with a Java object representing
 * a clause with variable count S, head instructions H, body instructions B,
 * cut variable index R and head index option D.
 */
function test_ir_clause_new(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    let beta = exec_build(args[1]);
    beta = list_objects(beta);
    let gamma = exec_build(args[2]);
    gamma = list_objects(gamma);
    let delta = exec_build(args[3]);
    check_integer(delta);
    let mue = exec_build(args[4]);
    if (is_structure(mue) && mue.functor === "just" && mue.args.length === 1) {
        mue = deref(mue.args[0]);
    } else {
        mue = undefined;
    }
    unquote_objects(beta);
    unquote_objects(gamma);
    return exec_unify(args[5], new Clause(alpha, beta, gamma, delta, mue));
}

/**
 * ir_clause_add(F, A, 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 for the predicate
 * indicator F/A. If C is not a clause, but directly a JavaScript object
 * provable, the built-in definition of the indicator F/A is updated.
 */
function test_ir_clause_add(args) {
    let functor = exec_build(args[0]);
    check_atom(functor);
    let arity = exec_build(args[1]);
    check_integer(arity);
    let gamma = exec_build(args[2]);
    let flags = exec_build(args[3]);
    check_integer(flags);
    add_clause(functor, arity, gamma, flags);
    return true;
}

/*********************************************************************/
/* ir_goal_new/4 and ir_goal_call/1                                  */
/*********************************************************************/

/**
 * ir_goal_new(S, B, R, G):
 * The built-in succeeds in G with a JavaScript object representing
 * a goal with variable count S, body instructions B and the
 * cut variable index R.
 */
function test_ir_goal_new(args) {
    let alpha = exec_build(args[0]);
    check_integer(alpha);
    let beta = exec_build(args[1]);
    beta = list_objects(beta);
    let gamma = exec_build(args[2]);
    check_integer(gamma);
    unquote_objects(beta);
    return exec_unify(args[3], new Goal(alpha, beta, gamma));
}

/**
 * ir_goal_call(A):
 * The predicate succeeds whenever the compiled goal A succeeds.
 */
function special_ir_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]));
    }
}

/*********************************************************************/
/* kb_clause_ref/3 and kb_pred_touch/3                               */
/*********************************************************************/

const MASK_FIND_MODIFY = 0x00000001;
const MASK_FIND_DYNAMIC = 0x00000002;
const MASK_FIND_REVERSE = 0x00000004;

/**
 * kb_clause_ref(H, F, C): internal only
 * The built-in succeeds in C with the clause references
 * for the head H and the flags F.
 */
function special_kb_clause_ref(args) {
    let head = deref(args[0]);
    check_callable(head);
    let flags = deref(args[1]);
    check_integer(flags);
    let peek = lookup_pred(head);
    if (peek === undefined)
        return false;
    if ((flags & MASK_FIND_DYNAMIC) !== 0)
        if ((peek.flags & MASK_PRED_DYNAMIC) === 0)
            make_error_find(head, flags);
    if (!is_logical(peek.rope))
        return false;
    if (is_structure(head)) {
        head = head.args;
    } else {
        head = VOID_ARGS;
    }
    peek = defined_clauses(peek, head);
    peek = snapshot_data(peek);
    if ((flags & MASK_FIND_REVERSE) === 0) {
        return solve2_ref(args, peek, 0, null);
    } else {
        return solve2_ref_reverse(args, peek, peek.length, null);
    }
}

function make_error_find(head, flags) {
    if ((flags & MASK_FIND_MODIFY) !== 0) {
        throw make_error(new Compound("permission_error",
            ["modify", "static_procedure", make_indicator_term(head)]));
    } else {
        throw make_error(new Compound("permission_error",
            ["access", "private_procedure", make_indicator_term(head)]));
    }
}

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

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

/**
 * Search a Prolog clause and return it.
 *
 * @param args The current arguments.
 * @param rope The clause list.
 * @param at The clause index.
 * @param choice The choice point for reuse or null.
 * @return boolean True if search succeeds, otherwise false.
 */
function solve2_ref(args, rope, at, choice) {
    let mark = trail;
    while (at < rope.length) {
        let clause = rope[at++];
        if (unify(args[2], clause)) {
            if (at < rope.length) {
                if (choice === null) {
                    choice = new Choice(solve_ref, rope, at, mark);
                } else {
                    choice.at = at;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
    }
    return false;
}

/**
 * Search a Prolog clause backwards and return it.
 *
 * @param args The current arguments.
 * @param rope The clause list.
 * @param at The clause index.
 * @param choice The choice point for reuse or null.
 * @return boolean True if search succeeds, otherwise false.
 */
function solve2_ref_reverse(args, rope, at, choice) {
    let mark = trail;
    while (at > 0) {
        let clause = rope[--at];
        if (unify(args[2], clause)) {
            if (at > 0) {
                if (choice === null) {
                    choice = new Choice(solve_ref_reverse, rope, at, mark);
                } else {
                    choice.at = at;
                }
                more(choice);
            }
            cont(call.args[1]);
            return true;
        }
        unbind(mark);
    }
    return false;
}

/**
 * kb_pred_touch(F, N, O): internal only
 * The built-in succeeds. As a side effect the predicate
 * indicator F/N with options O is touched.
 */
function test_kb_pred_touch(args) {
    let functor = exec_build(args[0]);
    check_atom(functor);
    let arity = exec_build(args[1]);
    check_integer(arity);
    let flags = exec_build(args[2]);
    check_integer(flags);
    pred_touch(functor, arity, flags);
    return true;
}

/**************************************************************/
/* kb_clause_remove/4 and kb_pred_destroy/2                   */
/**************************************************************/

/**
 * kb_clause_remove(F, N, G, R): internal only
 * The built-in succeeds if the clause or predicate R could
 * be removed from the predicate indicator F/N and the flags G.
 */
function test_kb_clause_remove(args) {
    let functor = exec_build(args[0]);
    check_atom(functor);
    let arity = exec_build(args[1]);
    check_integer(arity);
    let flags = exec_build(args[2]);
    check_integer(flags);
    let clause = exec_build(args[3]);
    check_clause(clause);
    return remove_clause(functor, arity, clause, flags);
}

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]));
    }
}

/**
 * kb_pred_destroy(F, N): internal only
 * The built-in succeeds. As a side effect the
 * predicate indicator F/N is destroyed.
 */
function test_kb_pred_destroy(args) {
    let functor = exec_build(args[0]);
    check_atom(functor);
    let arity = exec_build(args[1]);
    check_integer(arity);
    pred_destroy(functor, arity);
    return true;
}

/**************************************************************/
/* kb_make_defined/2 and kb_pred_link/3                       */
/**************************************************************/

/**
 * kb_make_defined(L, K, P): internal only
 * The built-in succeeds in P with an anonymous predicate
 * for the clauses L and the selected indexing argument K.
 */
function test_kb_make_defined(args) {
    let alpha = exec_build(args[0]);
    alpha = list_objects(alpha);
    let offset = exec_build(args[1]);
    check_integer(offset);
    return exec_unify(args[2], make_defined(alpha, offset));
}

/**
 * kb_pred_link(F, A, Q): internal only
 * The built-in succeeds in Q with the provable of the
 * predicate indicator F/A. Otherwise if no such provable
 * exists the built-in fails.
 */
function test_kb_pred_link(args) {
    let functor = exec_build(args[0]);
    check_atom(functor);
    let arity = exec_build(args[1]);
    check_integer(arity);
    let peek = pred_link(functor, arity);
    if (peek === undefined)
        return false;
    return exec_unify(args[2], peek);
}

/**************************************************************/
/* kb_is_link/1, kb_link_flags/2 and kb_pred_list/1           */
/**************************************************************/

/**
 * kb_is_link(Q): internal only
 * The built-in succeeds if Q is a provable.
 */
function test_kb_is_link(args) {
    let alpha = exec_build(args[0]);
    if (is_structure(alpha))
        return is_provable(alpha.functor);
    return is_provable(alpha);
}

/**
 * kb_link_flags(Q, F): internal only
 * The built-in succeeds in F with the flags of the provable Q.
 */
function test_kb_link_flags(args) {
    let peek = exec_build(args[0]);
    check_provable(peek);
    let res = peek.flags >> MASK_PRED_BITS;
    return exec_unify(args[1], res);
}

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

/**
 * kb_pred_list(L): internal only
 * The built-in succeeds in L with the current predicate indicators.
 */
function test_kb_pred_list(args) {
    let res = kb_pred_list();
    return exec_unify(args[0], res);
}

function kb_pred_list() {
    let back = null;
    let res = null;
    for (let functor in kb) {
        let temp = kb[functor];
        for (let i = 0; i < temp.length; i++) {
            let peek = temp[i]
            if (peek === undefined || peek.remover !== undefined)
                continue;
            peek = new Compound(".", [make_indicator(functor, i), undefined]);
            if (back === null) {
                res = peek;
            } else {
                back.args[1] = peek;
            }
            back = peek;
        }
    }
    if (back === null) {
        res = "[]";
    } else {
        back.args[1] = "[]";
    }
    return res;
}

/**************************************************************/
/* kb_clause_shard/2 and kb_clause_arity/2                   */
/**************************************************************/

/**
 * kb_clause_shard(C, S): internal only
 * The built-in succeeds in S with the shard of the clause C.
 */
function test_kb_clause_shard(args) {
    let clause = exec_build(args[0]);
    check_clause(clause);
    return exec_unify(args[1], clause.shard);
}

/**
 * kb_clause_arity(C, A): internal only
 * The built-in succeeds in A with the arity of the clause C.
 */
function test_kb_clause_arity(args) {
    let clause = exec_build(args[0]);
    check_clause(clause);
    let res = clause.head.length;
    return exec_unify(args[1], norm_smallint(res));
}

/**************************************************************/
/* kb_clause_head/2 and kb_clause_data/4                      */
/**************************************************************/

/**
 * kb_clause_head(C, H): internal only
 * The built-in succeeds in H with the head of the clause C.
 */
function special_kb_clause_head(args) {
    let clause = deref(args[0]);
    check_clause(clause);
    let head = deref(args[1]);
    let paras;
    if (is_structure(head)) {
        paras = head.args;
    } else {
        paras = VOID_ARGS;
    }
    let display;
    if (clause.size !== 0) {
        display = new Array(clause.size);
    } else {
        display = null;
    }
    if (!exec_head(clause.head, display, paras))
        return false;
    cont(call.args[1]);
    return true;
}

/**
 * kb_clause_data(C, H, O, L): internal only
 * The built-in succeeds in H, O and L with the head,
 * the cut var and the translated body of the clause C.
 */
function special_kb_clause_data(args) {
    let clause = deref(args[0]);
    check_clause(clause);
    let head = deref(args[1]);
    let paras;
    if (is_structure(head)) {
        paras = head.args;
    } else {
        paras = VOID_ARGS;
    }
    let display;
    if (clause.size !== 0) {
        display = new Array(clause.size);
    } else {
        display = null;
    }
    if (!exec_head(clause.head, display, paras))
        return false;
    let temp;
    let peek = clause.cutvar;
    if (peek !== -1) {
        temp = new Variable();
        display[peek] = temp;
        temp = new Compound("just", [temp]);
    } else {
        temp = "nothing";
    }
    if (!unify(args[2], temp))
        return false;
    temp = exec_body(clause.body, display);
    if (!unify(args[3], temp))
        return false;
    cont(call.args[1]);
    return true;
}

/**************************************************************/
/* dg_get_partition/1, dg_set_partition/1 and sys_flags_get/1 */
/**************************************************************/

/**
 * dg_get_partition(D): internal only
 * The built-in succeeds in D with the current stage.
 */
function test_dg_get_partition(args) {
    return exec_unify(args[0], engine.partition);
}

/**
 * dg_set_partition(D): internal only
 * The built-in succeeds. As a side effect it changes the current partition.
 */
function test_dg_set_partition(args) {
    let value = exec_build(args[0]);
    check_atom(value);
    set_partition(value);
    return true;
}

/**
 * sys_flags_get(W): internal only
 * The built-in succeeds in W with the garbage collector flags.
 */
function test_sys_flags_get(args) {
    return exec_unify(args[0], norm_smallint(engine.flags));
}

/**************************************************************/
/* sys_flag_map/1, os_get_workdir/1 and os_set_workdir/1      */
/**************************************************************/

/**
 * sys_flag_map(M): internal only
 * The built-in succeeds in W with a Prolog flag map.
 */
function test_sys_flag_map(args) {
    let res = {};
    res.system_url = bootbase;
    res.foreign_ext = ".mjs";
    if (fs !== undefined) {
        res.host_info = (process.versions.bun !== undefined ? "bun" : "node")+", JavaScript "+process.versions.node;
        res.mach_info = os.cpus()[0].model.trim()+", "+os.version();
    } else {
        res.host_info = "N/A";
        res.mach_info = "N/A";
    }
    return exec_unify(args[0], res);
}

/**
 * os_get_workdir(D): internal only
 * The built-in succeeds in D with the working directory.
 */
function test_os_get_workdir(args) {
    let url;
    if (fs !== undefined) {
        url = process.cwd()+path.sep;
    } else {
        url = codebase;
    }
    return exec_unify(args[0], url);
}

/**
 * os_set_workdir(D): internal only
 * The built-in succeeds. As a side effect it changes the working directory to D.
 */
function test_os_set_workdir(args) {
    let url = exec_build(args[0]);
    check_atom(url);

    if (fs !== undefined) {
        try {
            process.chdir(url);
        } catch (err) {
            throw make_error(map_file_error(err, url));
        }
    } else {
        try {
            url = new URL(url, codebase).href;
        } catch (err) {
            throw make_error(new Compound("resource_error", ["base_url"]));
        }
        codebase = url;
    }
    return true;
}

/**************************************************************/
/* dg_clear_stage/0, dg_get_stage/1 and dg_set_stage/1        */
/**************************************************************/

/**
 * dg_clear_stage: internal only
 * The built-in succeeds. As a side effect it clears the current stage.
 */
function test_dg_clear_stage(args) {
    clear();
    return true;
}

/**
 * dg_get_stage(D): internal only
 * The built-in succeeds in D with the current stage.
 */
function test_dg_get_stage(args) {
    return exec_unify(args[0], norm_smallint(stage));
}

/**
 * dg_set_stage(D): internal only
 * The built-in succeeds. As a side effect it changes the current stage.
 */
function test_dg_set_stage(args) {
    let value = exec_build(args[0]);
    check_integer(value);
    set_stage(narrow_float(value));
    return true;
}

/*********************************************************************/
/* Runtime Init                                                      */
/*********************************************************************/

// stream specials, output
add("current_output", 1, make_check(test_current_output));
add("current_error", 1, make_check(test_current_error));
add("set_output", 1, make_check(test_set_output));
add("set_error", 1, make_check(test_set_error));
add("put_atom", 2, make_check(test_put_atom));

// stream specials, input
add("current_input", 1, make_check(test_current_input));
add("set_input", 1, make_check(test_set_input));
add("os_get_code", 2, make_check(test_os_get_code));
add("os_peek_code", 2, make_check(test_os_peek_code));

// stream specials, async
add("os_open_promise_opts", 4, make_check(test_os_open_promise_opts));
add("os_read_promise", 2, make_check(test_os_read_promise));
add("os_close_promise", 2, make_check(test_os_close_promise));
add("os_prop_promise", 3, make_check(test_os_prop_promise));

// stream specials, sync
add("os_stream_flags", 2, make_check(test_os_stream_flags));
add("os_open_sync_opts", 4, make_check(test_os_open_sync_opts));
add("flush_output", 1, make_check(test_flush_output));
add("os_close_sync", 1, make_check(test_os_close_sync));
add("os_cntrl_sync", 2, make_check(test_os_cntrl_sync));
add("os_read_sync", 1, make_check(test_os_read_sync));

// intermediate representation, Albufeira code
add("ir_anon_new", 1, make_check(test_ir_anon_new));
add("ir_place_new", 2, make_check(test_ir_place_new));
add("ir_skeleton_new", 3, make_check(test_ir_skeleton_new));
add("ir_make_frozen", 3, make_check(test_ir_make_frozen));
add("ir_pred_site", 2, make_check(test_ir_pred_site));
add("ir_is_site", 1, make_check(test_ir_is_site));
add("ir_site_name", 2, make_check(test_ir_site_name));

// intermediate representation specials, consult text, internal only
add("ir_clause_new", 6, make_check(test_ir_clause_new));
add("ir_clause_add", 4, make_check(test_ir_clause_add));
add("ir_goal_new", 4, make_check(test_ir_goal_new));
add("ir_goal_call", 1, make_special(special_ir_goal_call));

// knowledge base specials, dynamic database, internal only
add("kb_clause_ref", 3, make_special(special_kb_clause_ref));
add("kb_pred_touch", 3, make_check(test_kb_pred_touch));
add("kb_clause_remove", 4, make_check(test_kb_clause_remove));
add("kb_pred_destroy", 2, make_check(test_kb_pred_destroy));

// knowledge base specials, linked provables, internal only
add("kb_make_defined", 2, make_check(test_kb_make_defined));
add("kb_make_defined", 3, make_check(test_kb_make_defined));
add("kb_pred_link", 3, make_check(test_kb_pred_link));
add("kb_is_link", 1, make_check(test_kb_is_link));
add("kb_link_flags", 2, make_check(test_kb_link_flags));
add("kb_pred_list", 1, make_check(test_kb_pred_list));

// knowledge base specials, meta data, internal only
add("kb_clause_shard", 2, make_check(test_kb_clause_shard));
add("kb_clause_arity", 2, make_check(test_kb_clause_arity));
add("kb_clause_head", 2, make_special(special_kb_clause_head));
add("kb_clause_data", 4, make_special(special_kb_clause_data));
add("dg_get_partition", 1, make_check(test_dg_get_partition));
add("dg_set_partition", 1, make_check(test_dg_set_partition));

// system specials, flags, internal only
add("sys_flags_get", 1, make_check(test_sys_flags_get));
add("sys_flag_map", 1, make_check(test_sys_flag_map));
add("os_get_workdir", 1, make_check(test_os_get_workdir));
add("os_set_workdir", 1, make_check(test_os_set_workdir));

// system specials, staging, internal only
add("dg_clear_stage", 0, make_check(test_dg_clear_stage));
add("dg_get_stage", 1, make_check(test_dg_get_stage));
add("dg_set_stage", 1, make_check(test_dg_set_stage));
