Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* 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, make_defined,
pred_touch, remove_clause, snapshot_data, Cache,
engine, Variable, Compound, is_compound,
Place, Quote, Skeleton, unquote_objects
} from "./store.mjs";
import {
fs, call, Choice, snap_cleanup, cont, os, gc_major,
defined_clauses, ctx, real_time, lookup_pred, make_error,
deref, exec_head, exec_body, gc_enter, gc_time, Goal,
copy_term, exec_unify, exec_build, VOID_ARGS, unbind,
make_indicator, make_indicator_term, VAR_MASK_STATE,
more, redo, snap_setup, solve, trail, register_interrupt,
unify, gc_flags, register_signal, melt_directive,
path, check_nonvar, teardown
} from "./machine.mjs";
import {
check_atom, norm_smallint, narrow_float, make_check,
check_var, check_integer, char_count, make_special,
list_objects, sys_time_parse
} from "./special.mjs";
const HTTP_TIME = "%a, %d %b %Y %H:%M:%S GMT";
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 */
/*********************************************************************/
/**
* Create a text output.
*/
export function Sink() {
this.buf = "";
this.send = (fd, buf) => fd;
this.last = -1;
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 = deref(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 = deref(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 and dg_var_serno/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 = deref(exec_build(args[0]));
check_sink(stream);
let text = deref(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;
}
/**
* dg_var_serno(V, S): internal only
* The built-in succeeds in S with the serno of the variable V.
*/
function test_dg_var_serno(args) {
let obj = deref(exec_build(args[0]));
check_var(obj);
return exec_unify(args[1], norm_smallint(obj.flags & ~VAR_MASK_STATE));
}
/*********************************************************************/
/* 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 = deref(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_read_sync/1, os_get_code/2 and os_peek_code/2 */
/*********************************************************************/
/**
* os_read_sync(S):
* The predicate succeeds. As a side effect the stream buffer is read.
*/
function test_os_read_sync(args) {
let stream = deref(exec_build(args[0]));
stream.buf = stream.receive(stream.data);
stream.pos = 0;
return true;
}
/**
* 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 = deref(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 = deref(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 = deref(exec_build(args[0]));
check_atom(url);
let opts = deref(exec_build(args[1]));
let stream = new Source();
if (!exec_unify(args[2], stream))
return false;
let buf = ctx;
let prom;
if (fs !== undefined) {
if (url.startsWith("http:") || url.startsWith("https:")) {
prom = open_http_promise_opts(buf, stream, url, opts);
} else {
prom = open_file_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);
}
function open_http_promise_opts(buf, stream, url, opts) {
let paras = {};
if (opts !== null && opts.method !== undefined) {
paras.method = opts.method;
} else if (opts !== null && opts.body !== undefined) {
paras.method = "POST";
} else {
paras.method = "GET";
}
if (opts !== null && opts.body !== undefined) {
let opts2 = opts.body;
if (fs !== undefined) {
let enc = get_encoding(opts2);
paras.body = Buffer.from(opts2.text, enc);
} else {
paras.body = opts2.text;
}
}
if (opts !== null && opts.headers !== undefined)
paras.headers = opts.headers;
let contr = new AbortController();
paras.signal = contr.signal;
register_interrupt(buf, () => contr.abort("ABORT"));
return fetch(url, paras).then(response => {
register_interrupt(buf, () => {});
if (response.status < 200 || 399 < response.status) {
register_signal(buf, map_http_result(response.status, url));
} else {
if (opts !== null) {
opts.uri = response.url;
opts.status = response.status;
let res = {};
let map = response.headers;
for (let key of map.keys())
res[key] = map.get(key);
opts.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;
}
}
}, err => {
register_interrupt(buf, () => {});
if ("ABORT" !== err)
register_signal(buf, map_file_error(err, url));
});
}
export function get_encoding(opts) {
if (opts !== null && opts.encoding !== undefined) {
return opts.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();
});
});
}
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_stream_flags/2, os_read_promise/2 and os_close_promise/2 */
/*******************************************************************/
/**
* (S, F):
* The predicate succeeds in F with the flags of the stream S.
*/
function test_os_stream_flags(args) {
let obj = deref(exec_build(args[0]));
let flags;
if (obj instanceof Source) {
flags = obj.flags;
} else {
check_sink(obj);
flags = 0;
}
return exec_unify(args[1], flags);
}
/**
* 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 = deref(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;
}
}
function http_read_promise(enc, buf, stream) {
return stream.data.read().then(response => {
let { done, value } = response;
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;
}, err => {
register_signal(buf, map_stream_error(err));
});
}
/**
* 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 = deref(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();
});
});
}
export function http_close_promise(buf, stream) {
return stream.data.cancel();
}
/******************************************************************/
/* 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_opts(args) {
let url = deref(exec_build(args[0]));
check_atom(url);
let mode = deref(exec_build(args[1]));
check_atom(mode);
let opts = deref(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 = deref(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 = deref(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_prop_promise/3 and set_file_property/2 */
/*********************************************************************/
/**
* 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 = deref(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) {
if (url.startsWith("http:") || url.startsWith("https:")) {
prom = prop_http_promise(buf, url, res);
} else {
prom = prop_file_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);
}
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"));
return fetch(url, paras).then(response => {
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";
}
}, err => {
register_interrupt(buf, () => {});
if ("ABORT" !== err)
register_signal(buf, map_file_error(err, url));
});
}
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"]);
}
}
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.normalize(path.resolve(url));
res.type = ftype;
} else {
register_signal(buf, map_file_error(err, url));
}
resolve();
});
});
}
/**
* set_file_property(F, P):
* The predicate assigns the property P to the file F.
*/
function test_set_file_property(args) {
let url = deref(exec_build(args[0]));
check_atom(url);
if (fs === undefined)
throw make_error(new Compound("permission_error", ["access", "source_sink", url]));
if (url.startsWith("http:") || url.startsWith("https:"))
throw make_error(new Compound("permission_error", ["access", "source_sink", url]));
let prop = deref(exec_build(args[1]));
if (is_compound(prop) &&
prop.functor === "last_modified" &&
prop.args.length === 1) {
let val2 = deref(prop.args[0]);
check_integer(val2);
if (val2 < 0)
throw make_error(new Compound("domain_error",
["not_less_than_zero", val2]));
val2 = new Date(narrow_float(val2));
try {
fs.utimesSync(url, val2, val2);
} 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;
}
/******************************************************************/
/* ir_place_new/2, ir_skeleton_new/3 and ir_pred_site/2 */
/******************************************************************/
/**
* 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 = deref(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 = deref(exec_build(args[0]));
let beta = deref(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_pred_site(F, Q): internal only
* The built-in succeeds in Q with the cache for the functor F.
*/
function test_ir_pred_site(args) {
let name = deref(exec_build(args[0]));
check_atom(name);
return exec_unify(args[1], new Cache(name));
}
/*********************************************************************/
/* 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 = deref(exec_build(args[0]));
check_integer(alpha);
let beta = deref(exec_build(args[1]));
beta = list_objects(beta);
let gamma = deref(exec_build(args[2]));
gamma = list_objects(gamma);
let delta = deref(exec_build(args[3]));
check_integer(delta);
let mue = deref(exec_build(args[4]));
if (is_compound(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):
* 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 = deref(exec_build(args[0]));
check_atom(functor);
let arity = deref(exec_build(args[1]));
check_integer(arity);
let gamma = deref(exec_build(args[2]));
let flags = deref(exec_build(args[3]));
check_integer(flags);
add_clause(functor, arity, gamma, flags);
return true;
}
/*********************************************************************/
/* ir_goal_new/4 and ir_goal_run/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 = deref(exec_build(args[0]));
check_integer(alpha);
let beta = deref(exec_build(args[1]));
beta = list_objects(beta);
let gamma = deref(exec_build(args[2]));
check_integer(gamma);
unquote_objects(beta);
return exec_unify(args[3], new Goal(alpha, beta, gamma));
}
/**
* ir_goal_run(G):
* As a side effect, the built-in executes the JavaScript object goal G,
* cuts away its choice points and undoes its bindings. If the goal fails,
* it throws a new error. If the goal throws an error, it re-throws this error.
* If the goal succeeds, the built-in succeeds.
*/
function special_ir_goal_run(args) {
let goal = deref(args[0]);
check_goal(goal);
let snap = snap_setup();
cont(melt_directive(goal));
return solve_run(snap, true, null);
}
export function check_goal(beta) {
if (!(beta instanceof Goal)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["goal", beta]));
}
}
/**
* Call or resume a goal.
* Failure results in error, success results in cut.
*
* @param snap The surrounding choice point.
* @param found The call or redo flag.
* @param choice The choice point for reuse or null.
* @return any True if goal succeeded, otherwise false.
*/
function solve_run(snap,found,choice) {
try {
found = solve(snap, found);
} catch (x) {
snap_cleanup(snap);
throw x;
}
if (found === false)
throw make_error(new Compound("syntax_error", ["directive_failed"]));
if (found !== true) {
if (redo !== snap) {
if (choice === null) {
choice = new Choice(solve_run, snap, false, trail);
} else {
choice.mark = trail;
choice.cont = call;
choice.tail = redo;
}
more(choice);
} else {
more(snap.tail);
}
return found;
}
snap_cleanup(snap);
cont(call.args[1]);
return true;
}
/*********************************************************************/
/* 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]);
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_compound(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 = deref(exec_build(args[0]));
check_atom(functor);
let arity = deref(exec_build(args[1]));
check_integer(arity);
let flags = deref(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 = deref(exec_build(args[0]));
check_atom(functor);
let arity = deref(exec_build(args[1]));
check_integer(arity);
let flags = deref(exec_build(args[2]));
check_integer(flags);
let clause = deref(exec_build(args[3]));
check_clause(clause);
return remove_clause(functor, arity, clause, flags);
}
export function check_clause(beta) {
if (!(beta instanceof Clause)) {
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 = deref(exec_build(args[0]));
check_atom(functor);
let arity = deref(exec_build(args[1]));
check_integer(arity);
pred_destroy(functor, arity);
return true;
}
/**************************************************************/
/* kb_make_defined/2, kb_pred_link/3 and kb_link_flags/2 */
/**************************************************************/
/**
* kb_make_defined(L, P): internal only
* The built-in succeeds in P with an anonymous predicate for the clauses L.
*/
function test_kb_make_defined(args) {
let alpha = deref(exec_build(args[0]));
alpha = list_objects(alpha);
return exec_unify(args[1], make_defined(alpha));
}
/**
* 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 = deref(exec_build(args[0]));
check_atom(functor);
let arity = deref(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 = deref(exec_build(args[0]));
check_provable(peek);
return exec_unify(args[1], peek.flags);
}
/**
* 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/1, kb_clause_creator/2 and kb_clause_shard/2 */
/*********************************************************************/
/**
* 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_creator(C, S):
* The built-in succeeds in S with the creator of the clause C.
*/
function test_kb_clause_creator(args) {
let clause = deref(exec_build(args[0]));
check_clause(clause);
return exec_unify(args[1], norm_smallint(clause.creator));
}
/**
* kb_clause_shard(C, S):
* The built-in succeeds in S with the shard of the clause C.
*/
function test_kb_clause_shard(args) {
let clause = deref(exec_build(args[0]));
check_clause(clause);
return exec_unify(args[1], clause.shard);
}
/**************************************************************/
/* 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 display;
if (clause.size !== 0) {
display = new Array(clause.size);
} else {
display = null;
}
if (is_compound(head) &&
!exec_head(clause.head, display, head.args))
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,
* cut var and the 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_compound(head) &&
!exec_head(clause.head, display, head.args))
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;
}
/*********************************************************************/
/* sys_stat_map/1, dg_gc_flags/1 and garbage_collect/0 */
/*********************************************************************/
/**
* sys_stat_map(M): internal only
* The built-in succeeds in W with the statistics map.
*/
function test_sys_stat_map(args) {
let res = {};
res["wall"] = norm_smallint(Date.now());
res["time"] = norm_smallint(real_time());
res["calls"] = norm_smallint(gc_enter);
res["gctime"] = norm_smallint(gc_time);
if (fs !== undefined) {
res["used"] = norm_smallint(process.memoryUsage().heapUsed);
} else {
res["used"] = norm_smallint(performance.memory.usedJSHeapSize);
}
return exec_unify(args[0], res);
}
/**
* dg_gc_flags(W): internal only
* The built-in succeeds in W with the garbage collector flags.
*/
function test_dg_gc_flags(args) {
return exec_unify(args[0], norm_smallint(gc_flags));
}
/**
* garbage_collect: internal only
* The built-in succeeds in attempting a garbage colection.
*/
function test_garbage_collect(args) {
gc_major();
if (fs !== 0) {
// --expose-gc
global.gc();
} else {
// --js-flags="--expose-gc"
window.gc();
}
return true
}
/**************************************************************/
/* sys_flag_map/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 = {};
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"] = "";
res["mach_info"] = "";
}
return exec_unify(args[0], res);
}
/**************************************************************/
/* 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) {
teardown();
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 = deref(exec_build(args[0]));
check_integer(value);
set_stage(narrow_float(value));
return true;
}
/**************************************************************/
/* dg_get_partition/1 and dg_set_partition/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 = deref(exec_build(args[0]));
check_atom(value);
set_partition(value);
return true;
}
/**************************************************************/
/* 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 = deref(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;
}
/*********************************************************************/
/* os_get_libpath/1 and os_get_natext/1 */
/*********************************************************************/
/**
* os_get_libpath(D): internal only
* The built-in succeeds in D with the library path.
*/
function test_os_get_libpath(args) {
return exec_unify(args[0], bootbase);
}
/**
* os_get_natext(D): internal only
* The built-in succeeds in D with the native extension.
*/
function test_os_get_natext(args) {
return exec_unify(args[0], ".mjs");
}
/*********************************************************************/
/* 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));
add("dg_var_serno", 2, make_check(test_dg_var_serno));
// stream specials, input
add("current_input", 1, make_check(test_current_input));
add("set_input", 1, make_check(test_set_input));
add("os_read_sync", 1, make_check(test_os_read_sync));
add("os_get_code", 2, make_check(test_os_get_code));
add("os_peek_code", 2, make_check(test_os_peek_code));
add("os_open_promise_opts", 4, make_check(test_os_open_promise_opts));
add("os_stream_flags", 2, make_check(test_os_stream_flags));
add("os_read_promise", 2, make_check(test_os_read_promise));
add("os_close_promise", 2, make_check(test_os_close_promise));
// stream specials, files
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_prop_promise", 3, make_check(test_os_prop_promise));
add("set_file_property", 2, make_check(test_set_file_property));
// intermediate representation, Albufeira code
add("ir_place_new", 2, make_check(test_ir_place_new));
add("ir_skeleton_new", 3, make_check(test_ir_skeleton_new));
add("ir_pred_site", 2, make_check(test_ir_pred_site));
// 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_run", 1, make_special(special_ir_goal_run));
// 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_pred_link", 3, make_check(test_kb_pred_link));
add("kb_link_flags", 2, make_check(test_kb_link_flags));
// knowledge base specials, meta data, internal only
add("kb_pred_list", 1, make_check(test_kb_pred_list));
add("kb_clause_creator", 2, make_check(test_kb_clause_creator));
add("kb_clause_shard", 2, make_check(test_kb_clause_shard));
add("kb_clause_head", 2, make_special(special_kb_clause_head));
add("kb_clause_data", 4, make_special(special_kb_clause_data));
// system specials, statistics, internal only
add("sys_stat_map", 1, make_check(test_sys_stat_map));
add("dg_gc_flags", 1, make_check(test_dg_gc_flags));
add("garbage_collect", 0, make_check(test_garbage_collect));
add("sys_flag_map", 1, make_check(test_sys_flag_map));
// 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));
add("dg_get_partition", 1, make_check(test_dg_get_partition));
add("dg_set_partition", 1, make_check(test_dg_set_partition));
// system specials, operating, internal only
add("os_get_workdir", 1, make_check(test_os_get_workdir));
add("os_set_workdir", 1, make_check(test_os_set_workdir));
add("os_get_libpath", 1, make_check(test_os_get_libpath));
add("os_get_natext", 1, make_check(test_os_get_natext));