/**
 * 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, pred_link,
    is_logical, pred_destroy, set, is_stick, check_nonvar,
    pred_touch, remove_clause, snapshot_rope, Cache,
    engine, Variable, Compound, is_structure, is_cache,
    deref, copy_term, make_defined, defined_pred,
    is_variable
} from "./store.mjs";
import {
    fs, call, Choice, cont, exec_head,
    ctx, lookup_pred, make_error, bind,
    exec_unify, exec_build, VOID_ARGS, unbind,
    make_indicator, make_indicator_term, is_atom,
    more, trail, unify, register_signal,
    path, exec_body, exec_frame
} from "./machine.mjs";
import {
    check_atom, norm_smallint, narrow_float, make_check,
    check_integer, char_count, make_special,
    list_objects, check_callable, check_clause
} from "./special.mjs";
import {atom_count
} from "./eval.mjs";

export const MAX_BUF = 4096;

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

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

/**
 * Set the code base.
 *
 * @param url The code base.
 */
export function set_codebase(url) {
    codebase = 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;

export const MASK_DST_LINE = 0x00000010;

/**
 * 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;
    this.offset = 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) {
        let pos = text.lastIndexOf("\n");
        if (pos !== -1) {
            stream.offset = atom_count(text, pos+1, text.length);
        } else {
            stream.offset += atom_count(text, 0, text.length);
        }
        stream.last = code_point_before(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 code_point_before(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(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 = (ftype === "directory" ?
                    path.resolve(url) + path.sep : 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_open_sync_opts/3                                            */
/******************************************************************/

/**
 * 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(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_supported"]));
    } 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",
            ["file_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_site_new/2, ir_is_site/1 and ir_site_name/2                   */
/*********************************************************************/

/**
 * ir_site_new(X, Y): internal only
 * The built-in succeeds in Y with a cacheable X.
 */
function test_ir_site_new(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_link_new/2 and ir_is_link/1                             */
/**************************************************************/

/**
 * ir_link_new(L, P): internal only
 * The built-in succeeds in P with an anonymous predicate
 * for the clauses L.
 */
function test_ir_link_new(args) {
    let alpha = exec_build(args[0]);
    alpha = list_objects(alpha);
    return exec_unify(args[1], make_defined(alpha));
}

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

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

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

/**
 * 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) {
        if ((flags & MASK_FIND_SIGNAL) !== 0) {
            throw make_error(new Compound("existence_error",
                ["procedure", make_indicator_term(head)]));
        } else {
            return false;
        }
    }
    if ((flags & MASK_FIND_DYNAMIC) !== 0) {
        if ((peek.flags & MASK_PRED_DYNAMIC) === 0) {
            make_error_find(head, flags);
        }
    }
    if (!is_logical(peek.func) && !is_stick(peek.func)) {
        if ((flags & MASK_FIND_SIGNAL) !== 0) {
            make_error_find(head, flags);
        } else {
            return false;
        }
    }
    if (is_structure(head)) {
        head = head.args;
    } else {
        head = VOID_ARGS;
    }
    peek = defined_pred(peek, head);
    peek = snapshot_rope(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/2 and kb_pred_destroy/2                   */
/**************************************************************/

/**
 * kb_clause_remove(C, O): internal only
 * The built-in succeeds if the clause C could
 * be removed according to the options O.
 */
function test_kb_clause_remove(args) {
    let alpha = exec_build(args[0]);
    check_clause(alpha);
    let beta = exec_build(args[1]);
    check_integer(beta);
    return remove_clause(alpha, 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_pred_link/3, kb_link_flags/2 and kb_pred_list/1         */
/**************************************************************/

/**
 * 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_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;
    return exec_unify(args[1], res);
}

/**
 * Assure that the object is a provable.
 *
 * @param beta The object.
 */
export 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, kb_clause_head/2 and kb_clause_data/4   */
/**************************************************************/

/**
 * 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_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 display;
    if (clause.size !== 0) {
        display = new Array(clause.size);
    } else {
        display = null;
    }
    if (!is_variable(head)) {
        let paras;
        if (is_structure(head)) {
            paras = head.args;
        } else {
            paras = VOID_ARGS;
        }
        if (!exec_head(clause.head, display, paras))
            return false;
    } else {
        let alpha = exec_frame(clause.functor, clause.head, display);
        bind(alpha, head);
    }
    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 display;
    if (clause.size !== 0) {
        display = new Array(clause.size);
    } else {
        display = null;
    }
    if (!is_variable(head)) {
        let paras;
        if (is_structure(head)) {
            paras = head.args;
        } else {
            paras = VOID_ARGS;
        }
        if (!exec_head(clause.head, display, paras))
            return false;
    } else {
        let alpha = exec_frame(clause.functor, clause.head, display);
        bind(alpha, head);
    }
    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;
}

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

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

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

// stream specials, async
set("os_open_promise", 4, make_check(test_os_open_promise));
set("os_read_promise", 2, make_check(test_os_read_promise));
set("os_close_promise", 2, make_check(test_os_close_promise));
set("os_prop_promise", 3, make_check(test_os_prop_promise));

// stream specials, sync
set("os_open_sync", 4, make_check(test_os_open_sync));
set("flush_output", 1, make_check(test_flush_output));
set("os_close_sync", 1, make_check(test_os_close_sync));
set("os_cntrl_sync", 2, make_check(test_os_cntrl_sync));
set("os_read_sync", 1, make_check(test_os_read_sync));

// intermediate representation, Albufeira code
set("ir_site_new", 2, make_check(test_ir_site_new));
set("ir_is_site", 1, make_check(test_ir_is_site));
set("ir_site_name", 2, make_check(test_ir_site_name));
set("ir_link_new", 2, make_check(test_ir_link_new));
set("ir_is_link", 1, make_check(test_ir_is_link));

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

// knowledge base specials, linked provables, internal only
set("kb_pred_link", 3, make_check(test_kb_pred_link));
set("kb_link_flags", 2, make_check(test_kb_link_flags));
set("kb_pred_list", 1, make_check(test_kb_pred_list));

// knowledge base specials, meta data, internal only
set("kb_clause_shard", 2, make_check(test_kb_clause_shard));
set("kb_clause_head", 2, make_special(special_kb_clause_head));
set("kb_clause_data", 4, make_special(special_kb_clause_data));


