/**
 * 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 {
    set, clear, Compound, engine, is_variable,
    set_stage, stage, copy_term, set_partition,
    check_nonvar
} from "./store.mjs";
import {
    callback, Context, ctx, exec_build, os,
    exec_deref, is_pending, exec_unify, fs, invoke_interrupt,
    launch, launch_async, make_error, register_interrupt,
    register_signal, setDelay, CTX_MAIN, task_async, is_special,
    group_teardown, group_gather_async, VOID_ARGS
} from "./machine.mjs";
import {
    atom_count, atom_offset
} from"./eval.mjs";
import {
    check_atom, check_integer, check_number, make_check,
    check_goal, MAX_ARITY,
    narrow_float, norm_smallint, norm_float, objects_list
} from "./special.mjs";
import {
    Source, codebase, get_encoding, map_stream_error,
    map_file_error, set_codebase, bootbase,
    put_atom, MASK_SRC_AREAD, MASK_DST_FEAT
} from "./runtime.mjs";

let xml_serializer;
if (fs === undefined) {
    xml_serializer = new XMLSerializer();
} else {
    xml_serializer = undefined;
}

/**************************************************************/
/* Main API                                                   */
/**************************************************************/

/**
 * Post a message to the Prolog interpreter.
 *
 * @param msg The message.
 */
export function post(msg) {
    register_signal(CTX_MAIN, msg);
    invoke_interrupt(CTX_MAIN);
}

/**
 * Run a Prolog term once. The goal is run with auto-yield
 * disabled and promises are not accepted.
 *
 * @param goal The Prolog term.
 * @return boolean True or false.
 */
export function perform(goal) {
    goal = new Compound(".", [goal, "[]"]);
    return launch(goal, CTX_MAIN, VOID_ARGS);
}

/**
 * Run a Prolog term once. The goal is run with auto-yield
 * enabled and promises are accepted.
 *
 * @param goal The Prolog term.
 * @return boolean True or false.
 */
export async function perform_async(goal) {
    goal = new Compound(".", [goal, "[]"]);
    return await launch_async(goal, CTX_MAIN, VOID_ARGS);
}

/**************************************************************/
/* Register API                                               */
/**************************************************************/

/**
 * The flag indicates a non-void dispatch foreign function.
 */
export const FFI_FUNC = 0x00000100;

/**
 * Add a JavaScript function to the knowledge base. The given
 * function is invoked with rather slow argument copying and
 * spreading. Also the function is wrapped and registered as a
 * special, therefore not eligible to neck optimization.
 *
 * @param functor The functor.
 * @param arity The arity.
 * @param func The JavaScript function.
 * @param flags The flags.
 */
export function register(functor, arity, func, flags) {
    let res;
    if ((flags & FFI_FUNC) !== 0) {
        res = make_check(args => invoke_func(func, args));
    } else {
        res = make_check(args => invoke(func, args));
    }
    set(functor, arity, res);
}

function invoke(func, args) {
    let temp = new Array(args.length);
    for (let i = 0; i < temp.length; i++)
        temp[i] = exec_build(args[i]);
    func(...temp);
    return true;
}

function invoke_func(func, args) {
    let temp = new Array(args.length - 1);
    for (let i = 0; i < temp.length; i++)
        temp[i] = exec_build(args[i]);
    let res = func(...temp);
    return exec_unify(args[args.length-1], res);
}

/****************************************************************/
/* Element Output                                               */
/****************************************************************/

export function set_cursor(elem) {
    let dom = engine.text_output.data;
    dom.data = elem;

    dom = engine.text_error.data;
    dom.data = elem;
}

export function html_encode(buf) {
    return xml_serializer.serializeToString(new Text(buf));
}

export function html_send(data, buf) {
    buf = html_encode(buf);
    put_atom(data, buf);
    return data;
}

export function fiddle_flush(data) {
    if (data.hasAttribute("cell-clear")) {
        data.innerHTML = "";
        data.removeAttribute("cell-clear");
    }
}

export function fiddle_out(data, buf) {
    if (data.hasAttribute("cell-clear")) {
        data.innerHTML = "";
        data.removeAttribute("cell-clear");
    }
    let depth = 0;
    let k = buf.indexOf("<");
    let i = 0;
    while (k !== -1) {
        let k2 = buf.indexOf(">", k+1);
        if (k2 === -1)
            throw make_error(new Compound("syntax_error",
                ["missing_angle"]));
        if (buf.charCodeAt(k+1) === 47) { // '/'
            if (depth > 0) {
                depth--;
            } else {
                data.insertAdjacentHTML("beforeend", buf.substring(i, k));
                data = data.parentElement;
                i = k2 + 1;
            }
        } else if (buf.charCodeAt(k2-1) !== 47) { // '/'
            depth++;
        }
        k = buf.indexOf("<", k2+1);
    }
    data.insertAdjacentHTML("beforeend", buf.substring(i));
    while (depth > 0) {
        data = data.lastElementChild;
        depth--;
    }
    return data;
}

/****************************************************************/
/* Text Input                                                   */
/****************************************************************/

export function set_input(text) {
    let src = engine.text_input;
    src.data = undefined;
    src.receive = fd => "";
    src.flags &= ~MASK_SRC_AREAD;
    src.buf = text;
    src.pos = 0;
    src.lineno = 0;
}

/****************************************************************/
/* Element Input Wait                                           */
/****************************************************************/

/**
 * Create a blocking input stream for an element.
 *
 * @param elem The element.
 */
export function set_caret_wait(elem) {
    let src = engine.text_input;
    src.data = elem;
    src.receive = fiddle_in_promise;
    src.flags |= MASK_SRC_AREAD;
    src.buf = "";
    src.pos = 0;
    src.lineno = 0;
}

/**
 * Wait for enter key and them obtain the input.
 *
 * @param buf The context.
 * @param stream The stream.
 * @returns The wait for promise.
 */
export function fiddle_in_promise(buf, stream) {
    return new Promise(resolve => {
        function keydown_handler(event) {
            if (event.key === "Enter") {
                event.preventDefault();

                let elem = stream.data;
                elem.insertAdjacentText("beforeend", "\n");
                elem.setAttribute("contenteditable", "false");
                elem.insertAdjacentHTML("afterend", "<span></span>");

                set_cursor(elem);
                stream.data = elem.nextElementSibling;
                stream.buf = elem.innerText;
                stream.pos = 0;

                elem = stream.data.parentElement;
                elem.removeEventListener("keydown", keydown_handler);
                register_interrupt(buf, () => {});
                resolve();
            }
        }

        let elem = stream.data;
        window.getSelection().collapse(elem, 0);
        elem.scrollIntoView();

        elem = stream.data.parentElement;
        elem.addEventListener("keydown", keydown_handler);
        register_interrupt(buf, () => {
            elem.removeEventListener("keydown", keydown_handler);
            register_interrupt(buf, () => {});
            resolve();
        });
    });
}

/****************************************************************/
/* Notebook Execution                                           */
/****************************************************************/

/**
 * Disable/enable all the buttons.
 *
 * @param flag Enable if true, other disable.
 */
function shield_buttons(flag) {
    let pres = document.getElementsByClassName("nb_box");
    for (let num = 0; num < pres.length; num++) {
        let btn = pres[num].nextElementSibling;
        btn.disabled = flag;
    }
}

/**
 * Rollback the Prolog interpreter to a stage.
 *
 * @param num The desired stage.
 */
function rollback_stage(num) {
    let pres = document.getElementsByClassName("nb_box");
    while (num < stage) {
        set_stage(stage-1);
        let out = pres[stage].getElementsByClassName("nb_out")[0];
        if (num === stage) {
            out.setAttribute("cell-clear", "true");
        } else {
            out.innerHTML = "";
        }
        clear();
    }
}

/**
 * Advance the Prolog interpreter to a stage.
 *
 * @param num The desired stage.
 */
async function advance_async(num) {
    let pres = document.getElementsByClassName("nb_box");
    while (num >= stage) {
        let btn = pres[stage].nextElementSibling;
        btn.disabled = false;
        btn.firstChild.className = "hack_box";
        let out = pres[stage].getElementsByClassName("nb_out")[0];
        set_cursor(out);
        let txt = pres[stage].getElementsByClassName("nb_txt")[0];
        set_input(txt.innerText);
        try {
            await perform_async(new Compound("ensure_loaded", ["user"]));
            await group_gather_async();
            perform("flush_output");
        } catch (err) {
            group_teardown();
            perform(new Compound("sys_print_error", [err]));
        }
        set_stage(stage+1);
        btn.disabled = true;
        btn.firstChild.className = "hack_arrow";
    }
}

/**
 * Asynchronously run or abort the Prolog interpreter.
 *
 * @param form The form.
 */
export async function goto_async(form) {
    let pres = document.getElementsByClassName("nb_box");
    let num = [].indexOf.call(pres,form);
    let btn = form.nextElementSibling;
    if (btn.firstChild.className === "hack_arrow") {
        shield_buttons(true);
        rollback_stage(num);
        await advance_async(num);
        shield_buttons(false);
    } else {
        post(new Compound("system_error", ["user_abort"]));
    }
}

/****************************************************************/
/* Document Instrumentation                                     */
/****************************************************************/

/**
 * Do the document instrumentation.
 */
export async function instrument_document_async() {
    engine.text_output.flags |= MASK_DST_FEAT;
    engine.text_error.flags |= MASK_DST_FEAT;
    let pres = Array.from(document.querySelectorAll(".code, .raw"));
    for (let num = 0; num < pres.length; num++) {
        let pre = pres[num];

        if (pre.className === "code") {
            pre.insertAdjacentHTML("beforebegin", '<div class="nb_flex"></div>');
            pre.previousElementSibling.appendChild(pre);

            /* modify text */
            let text = pre.innerHTML;
            text = '<div class="nb_txt" contenteditable="plaintext-only">' + text
                + '</div><div class="nb_out"></div>'
            pre.innerHTML = text;
            pre.className = "nb_box";

            /* create button */
            pre.insertAdjacentHTML("afterend", '&nbsp;<button class="nb_btn" disabled>' +
                '<div class="hack_arrow"></div>' +
                '</button>');
            let btn = pre.nextElementSibling;
            btn.addEventListener("click", async function () {
                await goto_async(pre);
            });
            btn.disabled = false;

            /* instrument text */
            let txt = pre.getElementsByClassName("nb_txt")[0];
            perform(new Compound("instrument_elem", [txt]));

        } else {
            /* colorize text */
            perform(new Compound("colorize_elem", [pre]));
        }

    }
}

/*****************************************************************/
/* ir_object_new/1 and ir_object_current/3                       */
/*****************************************************************/

/**
 * ir_object_new(O):
 * The predicate succeeds in O with a new JavaScript object.
 */
function test_ir_object_new(args) {
    let res = new Map();
    return exec_unify(args[0], res);
}

/**
 * ir_object_current(O, K, V):
 * The predicate succeeds in V with the value of the key K
 * in the JavaScript object O.
 */
function test_ir_object_current(args) {
    let obj = exec_build(args[0]);
    let key = exec_build(args[1]);
    check_atom(key);
    let res;
    if (obj instanceof Map) {
        res = obj.get(key);
    } else {
        try {
            res = obj[key];
        } catch (err) {
            res = undefined;
        }
    }
    if (res === undefined)
        return false;
    return exec_unify(args[2], res);
}

/*****************************************************************/
/* ir_object_set/3, ir_object_reset/2 and ir_object_keys/2       */
/*****************************************************************/

/**
 * ir_object_set(O, K, V):
 * The predicate sets the value of the key K in the
 * JavaScript object O to V.
 */
function test_ir_object_set(args) {
    let obj = exec_build(args[0]);
    let key = exec_build(args[1]);
    check_atom(key);
    let value = exec_build(args[2]);
    if (obj instanceof Map) {
        obj.set(key, value);
    } else {
        try {
            obj[key] = value;
        } catch (err) {
            throw make_error(new Compound("permission_error",
                ["modify", "field", key]));
        }
    }
    return true;
}

/**
 * ir_object_reset(O, K):
 * The predicate removes the key K from the JavaScript object O.
 */
function test_ir_object_reset(args) {
    let obj = exec_build(args[0]);
    let key = exec_build(args[1]);
    check_atom(key);
    if (obj instanceof Map) {
        obj.delete(key);
    } else {
        try {
            delete obj[key];
        } catch (err) {
            throw make_error(new Compound("permission_error",
                ["modify", "field", key]));
        }
    }
    return true;
}

/**
 * ir_object_keys(O, L):
 * The predicate succeeds in L with the keys of
 * the JavaScript object O
 */
function test_ir_object_keys(args) {
    let obj = exec_build(args[0]);
    if (obj instanceof Map) {
        obj = obj.keys();
    } else {
        obj = Object.keys(obj);
    }
    obj = set_to_list(obj);
    return exec_unify(args[1], obj);
}

/**
 * Convert a native set into a Prolog list.
 *
 * @param temp The native set or null.
 */
export function set_to_list(temp) {
    let back = null;
    let res = null;
    if (temp !== null) {
        for (let peek of temp) {
            peek = new Compound(".", [peek, undefined]);
            if (back === null) {
                res = peek;
            } else {
                back.args[1] = peek;
            }
            back = peek;
        }
    }
    if (back === null) {
        res = "[]";
    } else {
        back.args[1] = "[]";
    }
    return res;
}

/*********************************************************************/
/* ir_float_value/2 and ir_atom_offset/3                             */
/*********************************************************************/

/**
 * ir_float_value(P, H):
 * If P is instantiated, then the predicate succeeds in H with the
 * JavaScript float of P, otherwise in P with the Prolog float of H.
 */
function test_ir_float_value(args) {
    let alpha = exec_deref(args[0]);
    if (is_variable(alpha) || is_pending(alpha)) {
        let beta = exec_build(args[1]);
        check_number(beta);
        let res = (is_special(beta) ? beta :
            norm_float(narrow_float(beta)));
        return exec_unify(alpha, res);
    } else {
        alpha = exec_build(alpha);
        check_number(alpha);
        let res = (is_special(alpha) ? alpha :
            narrow_float(alpha));
        return exec_unify(args[1], res);
    }
}

/**
 * ir_atom_offset(A, P, H):
 * If P is instantiated, then the predicate succeeds in H with
 * the JavaScript offset of P into atom A, otherwise in P with the
 * Prolog offset of H into the atom A. If the corresponding
 * offset exceeds the given atom A the predicate fails.
 */
function test_ir_atom_offset(args) {
    let alpha = exec_build(args[0]);
    check_atom(alpha);
    let beta = exec_deref(args[1]);
    if (is_variable(beta) || is_pending(beta)) {
        let gamma = exec_build(args[2]);
        check_integer(gamma);
        let at = (0 <= gamma && gamma <= MAX_ARITY ?
                        narrow_float(gamma) : -1);
        if (at < 0 || at > alpha.length)
            return false;
        let res = atom_count(alpha, 0, at);
        return exec_unify(beta, norm_smallint(res));
    } else {
        beta = exec_build(beta);
        check_integer(beta);
        let at = (0 <= beta && beta <= MAX_ARITY ?
                        narrow_float(beta) : -1);
        let res = atom_offset(alpha, 0, at);
        if (res < 0)
            return false;
        return exec_unify(args[2], norm_smallint(res));
    }
}

/*********************************************************************/
/* os_call_later/3 and timer_cancel/1                              */
/*********************************************************************/

/**
 * Create a text output.
 */
export function Timer(id) {
    this.id = id;
}

/**
 * os_call_later(N, D, T): internal only
 * The predicate succeeds in T with a new timer. As a side
 * effect it schedules the compiled goal N to be executed
 * after D milliseconds.
 */
function test_os_call_later(args) {
    let goal = exec_build(args[0]);
    check_goal(goal);
    let delay = exec_build(args[1]);
    check_integer(delay);
    if (delay < 0)
        throw make_error(new Compound("domain_error",
            ["not_less_than_zero", delay]));
    delay = narrow_float(delay);
    let buf = ctx;
    let id = setDelay(() => callback(goal, buf, VOID_ARGS), delay);
    return exec_unify(args[2], new Timer(id));
}

/**
 * timer_cancel(T):
 * The predicate succeeds. As a side effect it cancels the timer T.
 */
function test_timer_cancel(args) {
    let tid = exec_build(args[0]);
    check_timer(tid);
    clearTimeout(tid.id);
    return true;
}

export function check_timer(beta) {
    if (!(beta instanceof Timer)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["timer", beta]));
    }
}

/*********************************************************************/
/* current_task/1, task_abort/2 and os_task_create/2           */
/*********************************************************************/

/**
 * current_task(E):
 * The predicate succeeds in E with the current task.
 */
function test_current_task(args) {
    return exec_unify(args[0], ctx);
}

/**
 * task_abort(E, M):
 * The predicate succeeds. As a side effect the task E gets
 * the message M signalled.
 */
function test_task_abort(args) {
    let buf = exec_build(args[0]);
    check_task(buf);
    let msg = exec_build(args[1]);
    msg = copy_term(msg);
    register_signal(buf, msg);
    invoke_interrupt(buf);
    return true;
}

export function check_task(beta) {
    if ((beta !== CTX_MAIN) &&
        !(beta instanceof Context)) {
        check_nonvar(beta);
        beta = copy_term(beta);
        throw make_error(new Compound("type_error", ["task", beta]));
    }
}

/**
 * os_task_create(N, E): internal only
 * The predicate succeeds in E with a new task for the compiled
 * goal N. The task is scheduled to execute immediately.
 */
function test_os_task_create(args) {
    let goal = exec_build(args[0]);
    check_goal(goal);
    let buf = new Context();
    setDelay(async () => await task_async(goal, buf, VOID_ARGS), 0);
    return exec_unify(args[1], buf);
}

/******************************************************************/
/* net_open_promise/4                                        */
/******************************************************************/

/**
 * net_open_promise(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_net_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_http_promise_opts(buf, stream, url, opts);
    } else {
        try {
            url = new URL(url, codebase).href;
        } catch (err) {
            throw make_error(
                new Compound("resource_error", ["base_url"]));
        }
        prom = open_http_promise_opts(buf, stream, url, opts);
    }
    return exec_unify(args[3], prom);
}

async function open_http_promise_opts(buf, stream, url, opts) {
    let paras = {};
    if (opts !== null && opts.get("method") !== undefined) {
        paras.method = opts.get("method");
    } else if (opts !== null && opts.get("body") !== undefined) {
        paras.method = "POST";
    } else {
        paras.method = "GET";
    }
    if (opts !== null && opts.get("body") !== undefined) {
        let opts2 = opts.get("body");
        if (fs !== undefined) {
            let enc = get_encoding(opts2);
            paras.body = Buffer.from(opts2.get("text"), enc);
        } else {
            paras.body = opts2.get("text");
        }
    }
    if (opts !== null && opts.get("headers") !== undefined)
        paras.headers = opts.get("headers");
    let contr = new AbortController();
    paras.signal = contr.signal;
    register_interrupt(buf, () => contr.abort("ABORT"));
    try {
        let response = await fetch(url, paras);
        register_interrupt(buf, () => {});
        if (response.status < 200 || 399 < response.status) {
            register_signal(buf, map_http_result(response.status, url));
        } else {
            if (opts !== null) {
                opts.set("uri", response.url);
                opts.set("status", response.status);
                let res = new Map();
                let map = response.headers;
                for (let key of map.keys())
                    res.set(key, map.get(key));
                opts.set("fields", res);
            }
            if (!response.body) {
                /* */
            } else {
                let enc = get_encoding(opts);
                stream.data = response.body.getReader();
                stream.receive = (buf, stream) => http_read_promise(enc, buf, stream);
                stream.release = http_close_promise;
                stream.flags |= MASK_SRC_AREAD;
            }
        }
    } catch (err) {
        register_interrupt(buf, () => {});
        if ("ABORT" !== err)
            register_signal(buf, map_file_error(err, url));
    }
}

async function http_read_promise(enc, buf, stream) {
    try {
        let {done, value} = await stream.data.read();
        let res;
        if (done) {
            res = "";
        } else {
            if (fs !== undefined) {
                res = Buffer.from(value.buffer).toString(enc);
            } else {
                let txt = new TextDecoder("utf8");
                res = txt.decode(value);
            }
        }
        stream.buf = res;
        stream.pos = 0;
    } catch (err) {
        register_signal(buf, map_stream_error(err));
    }
}

function http_close_promise(buf, stream) {
    return stream.data.cancel();
}

function map_http_result(res, url) {
    switch (res) {
        case 403: // Forbidden
            return new Compound("permission_error",
                ["open", "source_sink", url]);
        case 404: // Not Found
            return new Compound("existence_error",
                ["source_sink", url]);
        case 405: // Method Not Allowed
            return new Compound("resource_error",
                ["illegal_method"]);
        case 500: // Internal Server Error
            return new Compound("resource_error",
                ["internal_error"]);
        case 503: // Service Unavailable
            return new Compound("resource_error",
                ["service_unavailable"]);
        default:
            return new Compound("resource_error",
                ["io_exception"]);
    }
}

/*******************************************************************/
/* net_prop_promise/3                                              */
/*******************************************************************/

const HTTP_TIME = "%a, %d %b %Y %H:%M:%S GMT";

/**
 * net_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_net_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_http_promise(buf, url, res);
    } else {
        try {
            url = new URL(url, codebase).href;
        } catch (err) {
            throw make_error(
                new Compound("resource_error", ["base_url"]));
        }
        prom = prop_http_promise(buf, url, res);
    }
    return exec_unify(args[2], prom);
}

async function prop_http_promise(buf, url, res) {
    let paras = {};
    paras.method = "HEAD";
    let contr = new AbortController();
    paras.signal = contr.signal;
    register_interrupt(buf, () => contr.abort("ABORT"));
    try {
        let response = await fetch(url, paras);
        register_interrupt(buf, () => { });
        if (response.status !== 200) {
            register_signal(buf, map_http_result(response.status, url));
        } else {
            let val = response.headers.get("Last-Modified");
            let mtime = (val !== null ? sys_time_parse(
                val, HTTP_TIME, 1) : -1);

            res.last_modified = norm_smallint(mtime);
            res.absolute_path = response.url;
            res.type = "regular";
            res.can_write = "false";
        }
    } catch(err) {
        register_interrupt(buf, () => {});
        if ("ABORT" !== err)
            register_signal(buf, map_file_error(err, url));
    }
}

/*******************************************************************/
/* net_open_sync/3                                            */
/*******************************************************************/

/**
 * net_open_sync(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_net_open_sync(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    throw make_error(new Compound("permission_error",
        ["access", "source_sink", url]));
}

/**
 * net_cntrl_sync(F, P):
 * The predicate assigns the property P to the file F.
 */
function test_net_cntrl_sync(args) {
    let url = exec_build(args[0]);
    check_atom(url);
    throw make_error(new Compound("permission_error",
        ["access", "source_sink", url]));
}

/*********************************************************************/
/* sys_atom_time/4                                                   */
/*********************************************************************/

/**
 * sys_atom_time(A, F, O, T): internal only
 * If A is a variable, the built-in succeeds in A with the millisecond
 * time T formatted by the pattern F and the flag O. Otherwise the
 * built-in succeeds in T with the millisecond time parsed from A
 * by the pattern F and the flag O.
 */
function test_sys_atom_time(args) {
    let fmt = exec_build(args[1]);
    check_atom(fmt);
    let flag = exec_build(args[2]);
    check_integer(flag);
    let text = exec_deref(args[0]);
    if (is_variable(text) || is_pending(text)) {
        let tms = exec_build(args[3]);
        check_integer(tms);
        let res = sys_time_format(fmt, narrow_float(tms), flag);
        if (res === null)
            throw make_error(new Compound("domain_error",
                ["time_format", fmt]));
        return exec_unify(text, res);
    } else {
        text = exec_build(text);
        check_atom(text);
        let tms = sys_time_parse(text, fmt, flag);
        if (isNaN(tms))
            throw make_error(new Compound("syntax_error", ["illegal_date"]));
        if (tms === null)
            throw make_error(new Compound("domain_error",
                ["time_format", fmt]));
        return exec_unify(args[3], norm_smallint(tms));
    }
}

/**
 * <p>Parse a date time string.</p>
 *
 * @param res The date time as a string.
 * @param pat The pattern.
 * @param utc The UTC calendar flag.
 * @return The date time in UTC milliseconds.
 */
export function sys_time_parse(res, pat, utc) {
    let year = 1900; let month = 1; let day = 1;
    let hour = 0; let  minute = 0; let second = 0;
    let j = 0;
    for (let i = 0; i < pat.length; i++) {
        let ch = pat.charCodeAt(i);
        if (ch === 37) { // %
            i++;
            let k;
            switch (pat.charCodeAt(i)) {
                case 37: // %
                    if (j < res.length && res.charCodeAt(j) === 37) {
                        j++;
                    } else {
                        return NaN;
                    }
                    break;
                case 97: // a
                    k = scan_alphanum(res, j);
                    let f = new Intl.DateTimeFormat((utc !== 0 ? "en-US":undefined), {weekday: "short"});
                    let weekday = parse_weekday(res.substring(j, k), f);
                    if (isNaN(weekday))
                        return NaN;
                    j = k;
                    break;
                case 98: // b
                    k = scan_alphanum(res, j);
                    let g = new Intl.DateTimeFormat((utc !== 0 ? "en-US":undefined), {month: "short"});
                    month = parse_month(res.substring(j, k), g);
                    if (isNaN(month))
                        return NaN;
                    j = k;
                    break;
                case 100: // d
                    k = scan_integer(res, j);
                    day = Number.parseInt(res.substring(j, k));
                    if (isNaN(day))
                        return NaN;
                    j = k;
                    break;
                case 109: // m
                    k = scan_integer(res, j);
                    month = Number.parseInt(res.substring(j, k));
                    if (isNaN(month))
                        return NaN;
                    j = k;
                    break;
                case 89: // Y
                    k = scan_integer(res, j);
                    year = Number.parseInt(res.substring(j, k));
                    if (isNaN(year))
                        return NaN;
                    j = k;
                    break;
                case 72: // H
                    k = scan_integer(res, j);
                    hour = Number.parseInt(res.substring(j, k));
                    if (isNaN(hour))
                        return NaN;
                    j = k;
                    break;
                case 77: // M
                    k = scan_integer(res, j);
                    minute = Number.parseInt(res.substring(j, k));
                    if (isNaN(minute))
                        return NaN;
                    j = k;
                    break;
                case 83: // S
                    k = scan_integer(res, j);
                    second = Number.parseInt(res.substring(j, k));
                    if (isNaN(second))
                        return NaN;
                    j = k;
                    break;
                default:
                    return null;
            }
        } else {
            if (j < res.length && res.charCodeAt(j) === ch) {
                j++;
            } else {
                return NaN;
            }
        }
    }
    if (utc !== 0) {
        return Date.UTC(year, month - 1, day, hour, minute, second);
    } else {
        return new Date(year, month - 1, day, hour, minute, second).getTime();
    }
}

/**
 * <p>Scan alphanum.</p>
 *
 * @param res The text.
 * @param j   The old position.
 * @return The new position.
 */
function scan_alphanum(res, j) {
    let ch;
    while (j < res.length && ((48 <= (ch = res.charCodeAt(j)) && ch <= 57) ||
        (65 <= ch && ch <= 90) ||
        (97 <= ch && ch <= 122)))
        j++;
    return j;
}

/**
 * <p>Parse a week day.</p>
 *
 * @param str The text.
 * @param fmt  The formatter.
 * @return The index.
 */
function parse_weekday(str, fmt) {
    str = str.toLowerCase();
    for (let i=1; i < 8; i++) {
        let wday = new Date(Date.UTC(2001,0,i,0,0,0));
        let val = fmt.format(wday);
        val = val.toLowerCase();
        if (str === val)
            return i;
    }
    return NaN;
}

/**
 * <p>Parse a month.</p>
 *
 * @param str The text.
 * @param fmt  The formatter.
 * @return The index.
 */
function parse_month(str, fmt) {
    str = str.toLowerCase();
    for (let i=1; i < 13; i++) {
        let mon = new Date(Date.UTC(2001,i-1,1,0,0,0));
        let val = fmt.format(mon);
        val = val.toLowerCase();
        if (str === val)
            return i;
    }
    return NaN;
}

/**
 * <p>Scan integer.</p>
 *
 * @param res The text.
 * @param j   The old position.
 * @return The new position.
 */
function scan_integer(res, j) {
    let ch;
    while (j < res.length && 48 <= (ch = res.charCodeAt(j)) && ch <= 57)
        j++;
    return j;
}

/**
 * <p>Format a date time string.</p>
 *
 * @param pat  The format pattern.
 * @param tms The date time in UTC milliseconds.
 * @param utc The UTC calendar flag.
 * @return The date time as a string.
 */
export function sys_time_format(pat, tms, utc) {
    let date = new Date(tms);
    let buf = "";
    let k = 0;
    for (let i = 0; i < pat.length; i++) {
        let ch = pat.charCodeAt(i);
        if (ch === 37) { // %
            buf += pat.substring(k, i);
            i++;
            if (i < pat.length) {
                switch (pat.charCodeAt(i)) {
                    case 37: // %
                        buf += "%";
                        break;
                    case 97: // a
                        let f;
                        if (utc !== 0) {
                            f = new Intl.DateTimeFormat("en-US", {timeZone: "UTC", weekday: "short"});
                        } else {
                            f = new Intl.DateTimeFormat(undefined, {weekday: "short"});
                        }
                        buf += f.format(date);
                        break;
                    case 98: // b
                        let g;
                        if (utc !== 0) {
                            g = new Intl.DateTimeFormat("en-US", {timeZone: "UTC", month: "short"});
                        } else {
                            g = new Intl.DateTimeFormat(undefined, {month: "short"});
                        }
                        buf += g.format(date);
                        break;
                    case 100: // d
                        buf = append_padded(buf, (utc !== 0 ? date.getUTCDate():date.getDate()));
                        break;
                    case 109: // m
                        buf = append_padded(buf, (utc !== 0 ? date.getUTCMonth():date.getMonth())+1);
                        break;
                    case 89: // Y
                        buf += (utc !== 0 ? date.getUTCFullYear():date.getFullYear());
                        break;
                    case 72: // H
                        buf = append_padded(buf, (utc !== 0 ? date.getUTCHours():date.getHours()));
                        break;
                    case 77: // M
                        buf = append_padded(buf, (utc !== 0 ? date.getUTCMinutes():date.getMinutes()));
                        break;
                    case 83: // S
                        buf = append_padded(buf, (utc !== 0 ? date.getUTCSeconds():date.getSeconds()));
                        break;
                    default:
                        return null;
                }
                k = i + 1;
            } else {
                k = i;
            }
        }
    }
    buf += pat.substring(k, pat.length);
    return buf;
}

/**
 * Append an integer value zero padded.
 *
 * @param buf The string builder.
 * @param value The integer value.
 * @return The string builder.
 */
function append_padded(buf, value) {
    if (value < 10)
        buf += '0';
    buf += value.toString();
    return buf;
}

/*********************************************************************/
/* os_get_gestalt/1 and os_get_host/1                                */
/*********************************************************************/

/**
 * os_get_gestalt(M): Internal only
 * The built-in succeeds in M with a host gestalt map.
 */
function test_os_get_gestalt(args) {
    let gestalt = new Map();
    let scm;
    if (fs !== undefined) {
        scm = process.env["TERM_SCHEME"];
    } else {
        scm  = "[]";
    }
    gestalt.set("sys_color", (scm !== undefined ? scm : "normal"));
    let loc = new Intl.DateTimeFormat().resolvedOptions().locale;
    gestalt.set("sys_locale", loc.replace("-", "_"));
    let res;
    if (fs !== undefined) {
        res = objects_list(process.argv, 2, process.argv.length - 2);
    } else {
        res  = "[]";
    }
    gestalt.set("argv", res);
    return exec_unify(args[0], gestalt);
}

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

/*********************************************************************/
/* os_get_workdir/1 and os_set_workdir/1                             */
/*********************************************************************/

/**
 * 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"]));
        }
        set_codebase(url);
    }
    return true;
}

/**************************************************************/
/* dg_get_flags/1, dg_get_partition/1 and dg_set_partition/1  */
/**************************************************************/

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

/**
 * 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;
}

/**************************************************************/
/* 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;
}

/*********************************************************************/
/* Theatre Init                                                      */
/*********************************************************************/

// object specials
set("ir_object_new", 1, make_check(test_ir_object_new));
set("ir_object_current", 3, make_check(test_ir_object_current));
set("ir_object_set", 3, make_check(test_ir_object_set));
set("ir_object_reset", 2, make_check(test_ir_object_reset));
set("ir_object_keys", 2, make_check(test_ir_object_keys));

// object specials II
set("ir_float_value", 2, make_check(test_ir_float_value));
set("ir_atom_offset", 3, make_check(test_ir_atom_offset));

// system specials, coroutines
set("os_call_later", 3, make_check(test_os_call_later));
set("timer_cancel", 1, make_check(test_timer_cancel));
set("current_task", 1, make_check(test_current_task));
set("task_abort", 2, make_check(test_task_abort));
set("os_task_create", 2, make_check(test_os_task_create));

// net specials, async
set("net_open_promise", 4, make_check(test_net_open_promise));
set("net_prop_promise", 3, make_check(test_net_prop_promise));

// net specials, sync
set("net_open_sync", 4, make_check(test_net_open_sync));
set("net_cntrl_sync", 2, make_check(test_net_cntrl_sync));

// atom specials, time
set("sys_atom_time", 4, make_check(test_sys_atom_time));

// object specials, gestalt
set("os_get_gestalt", 1, make_check(test_os_get_gestalt));
set("os_get_host", 1, make_check(test_os_get_host));
set("os_get_workdir", 1, make_check(test_os_get_workdir));
set("os_set_workdir", 1, make_check(test_os_set_workdir));

// system specials, staging, internal only
set("dg_get_flags", 1, make_check(test_dg_get_flags));
set("dg_get_partition", 1, make_check(test_dg_get_partition));
set("dg_set_partition", 1, make_check(test_dg_set_partition));
set("dg_clear_stage", 0, make_check(test_dg_clear_stage));
set("dg_get_stage", 1, make_check(test_dg_get_stage));
set("dg_set_stage", 1, make_check(test_dg_set_stage));