Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 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, is_cache, Cache,
engine, Variable, Compound, is_compound,
Place, Quote, Skeleton, unquote_objects
} from "./store.mjs";
import {
fs, call, Choice, snap_cleanup, cont, cut,
defined_clauses, launch_async, ctx, real_time,
deref, exec_head, exec_body, gc_enter, gc_time, Goal, setDelay,
copy_term, exec_unify, exec_build, VOID_ARGS,
lookup_pred, launch, make_error, Context,
make_indicator, make_indicator_term, VAR_MASK_STATE,
more, redo, snap_setup, solve, trail, register_interrupt,
unbind, unify, gc_flags, register_signal, invoke_interrupt,
melt_directive, path, check_nonvar
} from "./machine.mjs";
import {
check_atom, norm_smallint, narrow_float, make_check, check_var,
check_integer, char_count, make_special, list_objects
} from "./special.mjs";
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;
}
/**
* Set the output and error cursor to a DOM element.
*
* @param elem The DOM element.
*/
export function set_cursor(elem) {
engine.text_output.data = elem;
engine.text_error.data = elem;
}
/*********************************************************************/
/* current_output/1, current_error/1, set_output/1 and set_error/1 */
/*********************************************************************/
/**
* Create a text output.
*/
export function Sink() {
this.buf = "";
this.send = (fd, buf) => {};
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(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_code/2, current_lastcode/2 and set_lastcode/2 */
/*********************************************************************/
/**
* put_code(S, C): [ISO 8.12.3]
* The built-in succeeds. As a side effect, it adds
* the code point C to the stream S.
*/
function test_put_code(args) {
let stream = deref(exec_build(args[0]));
check_sink(stream);
let ch = deref(exec_build(args[1]));
check_integer(ch);
if (ch < 0 || ch > 0x10FFFF)
throw make_error(new Compound("domain_error", ["code_point", ch]));
put_code(stream, ch);
return true;
}
function put_code(stream, ch) {
stream.buf += String.fromCodePoint(ch);
stream.last = ch;
if (stream.buf.length >= MAX_BUF)
flush_buffer(stream);
}
export function flush_buffer(stream) {
if (stream.buf.length > 0) {
stream.send(stream.data, stream.buf);
stream.buf = "";
}
}
/**
* current_lastcode(S, C):
* The built-in succeeds in C with the
* last code point of the output stream S.
*/
function test_current_lastcode(args) {
let stream = deref(exec_build(args[0]));
check_sink(stream);
return exec_unify(args[1], norm_smallint(stream.last));
}
/**
* set_lastcode(S, C):
* The built-in succeeds. As a side effect, the last
* code point of the stream S is set to C.
*/
function test_set_lastcode(args) {
let stream = deref(exec_build(args[0]));
check_sink(stream);
let ch = deref(exec_build(args[1]));
check_integer(ch);
stream.last = narrow_float(ch);
return true;
}
/*********************************************************************/
/* 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 = 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.buf += text;
stream.last = last_code(text, text.length);
if (stream.buf.length >= MAX_BUF)
flush_buffer(stream);
}
}
export function last_code(text, pos) {
let ch = text.charCodeAt(pos - 1);
if (ch >= 0xDC00 && ch <= 0xDFFF && pos > 1) {
let res2 = text.charCodeAt(pos - 2);
if (res2 >= 0xD800 && res2 <= 0xDBFF)
ch = ((res2 - 0xD7C0) << 10) + ch - 0xDC00;
}
return ch;
}
/*********************************************************************/
/* current_input/1 and set_input/1 */
/*********************************************************************/
const MASK_SRC_SKIP = 0x00000001;
export const MASK_SRC_AREAD = 0x00000002;
/**
* Create a text input.
*/
export function Source() {
this.buf = "";
this.pos = 0;
this.receive = (fd) => "";
this.flags = 0;
this.lineno = 0;
this.release = (fd) => {};
this.data = undefined;
}
/**
* 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/2 */
/*******************************************************************/
/**
* os_open_promise(P, S, Q):
* The predicate succeeds in Q with a promise for open input S
* on path P.
*/
function test_os_open_promise(args) {
let url = deref(exec_build(args[0]));
check_atom(url);
let stream = new Source();
if (!exec_unify(args[1], stream))
return false;
let buf = ctx;
let prom;
if (fs !== undefined) {
if (url.startsWith("http:") || url.startsWith("https:")) {
prom = open_http_promise(buf, stream, url);
} else {
prom = open_file_promise(buf, stream, url);
}
} else {
try {
url = new URL(url, codebase).href;
} catch (err) {
throw make_error(
new Compound("resource_error", ["base_url"]));
}
prom = open_http_promise(buf, stream, url);
}
return exec_unify(args[2], prom);
}
export function open_http_promise(buf, stream, url) {
let paras = {};
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 {
stream.data = response.body.getReader();
stream.receive = http_read_promise;
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 open_file_promise(buf, stream, url) {
return new Promise(resolve => {
fs.open(url, (err, fd) => {
if (err === null) {
stream.data = fd;
stream.receive = file_read_promise;
stream.release = file_close_promise;
stream.flags |= MASK_SRC_AREAD;
} else {
register_signal(buf, map_file_error(err, url));
}
resolve();
});
});
}
export function map_file_error(err, url) {
let code = err.code;
if (code === "ENOENT" || code === "ERR_CONNECTION_REFUSED") {
return new Compound("existence_error",
["source_sink", url]);
} else if (code === "EPERM" || code === "ERR_FAILED") {
return new Compound("permission_error",
["open", "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));
}
function file_read_promise(buf, stream) {
return new Promise(resolve => {
fs.readFile(stream.data, "utf8", (err, res) => {
if (err === null) {
stream.buf = res;
stream.pos = 0;
} else {
register_signal(buf, map_stream_error(err));
}
resolve();
});
});
}
export function http_read_promise(buf, stream) {
return stream.data.read().then(response => {
let { done, value } = response;
let res;
if (done) {
res = "";
} else {
let decoder = new TextDecoder("utf8");
res = decoder.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 === "ECONNRESET") {
return new Compound("resource_error",
["remote_error"]);
} else {
return new Compound("resource_error",
["io_error"]);
}
}
/**
* 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 === null) {
/* */
} else {
register_signal(buf, map_stream_error(err));
}
resolve();
});
});
}
export function http_close_promise(buf, stream) {
return stream.data.cancel();
}
/******************************************************************/
/* os_open_sync/3 */
/******************************************************************/
/**
* os_open_sync(P, M, S):
* The predicate succeeds. As a side effect the stream S is
* opened on the path P with the mode M.
*/
function test_os_open_sync(args) {
let url = deref(exec_build(args[0]));
check_atom(url);
let mode = deref(exec_build(args[1]));
check_atom(mode);
let stream;
if ("read" === mode) {
throw make_error(new Compound("resource_error",
["not_implemented"]));
} else if ("write" === mode) {
stream = open_write(url, "w");
} else if ("append" === mode) {
stream = open_write(url, "a");
} else {
throw make_error(new Compound("domain_error",
["io_mode", mode]));
}
return exec_unify(args[2], stream);
}
export function open_write(url, mode) {
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();
dst.data = file;
dst.send = file_write;
dst.release = file_close;
return dst;
} else {
throw make_error(new Compound("resource_error", ["io_exception"]));
}
}
export function file_write(data, buf) {
try {
fs.writeSync(data, buf);
} catch (err) {
throw make_error(map_stream_error(err));
}
}
export 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 mtime = response.headers.get("Last-Modified");
res.last_modified = norm_smallint(mtime !== null ? new Date(mtime).getTime() : -1);
res.real_path = response.url;
res.type = "regular";
}
}, err => {
register_interrupt(buf, () => {});
if ("ABORT" !== err)
register_signal(buf, map_file_error(err, url));
});
}
export 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"]);
default:
return new Compound("resource_error",
["io_exception"]);
}
}
function prop_file_promise(buf, url, res) {
return new Promise(resolve => {
fs.realpath(url, (err, rpath) => {
if (err === null) {
fs.lstat(rpath, (err, stats) => {
if (err === null) {
let mtime = Math.round(stats.mtimeMs);
let ftype = (stats.isFile() ? "regular" : (stats.isDirectory() ? "directory" : "other"));
res.last_modified = norm_smallint(mtime);
res.real_path = rpath;
res.type = ftype;
} else {
register_signal(buf, map_file_error(err, url));
}
resolve();
});
} 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]));
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 = narrow_float(val2);
try {
let val = Math.round(fs.lstatSync(url).atimeMs);
fs.lutimesSync(url, new Date(val), new Date(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 and ir_skeleton_new/3 */
/******************************************************************/
/**
* 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_is_site/1, ir_pred_site/2 and ir_site_name/2 */
/*********************************************************************/
/**
* ir_is_site(Q): internal only
* The built-in succeeds if Q is a cache.
*/
function test_ir_is_site(args) {
let cache = deref(exec_build(args[0]));
return is_cache(cache);
}
/**
* 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_site_name(Q, F): internal only
* The built-in succeeds in F with the functor of the cache Q.
*/
function test_ir_site_name(args) {
let cache = deref(exec_build(args[0]));
check_cache(cache);
return exec_unify(args[1], cache.name);
}
/**
* Assure that the object is a cache.
*
* @param beta The object.
*/
function check_cache(beta) {
if (!is_cache(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error",
["cache", beta]));
}
}
/*********************************************************************/
/* 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, G):
* The built-in succeeds in G with a JavaScript object representing
* a goal with variable count S, body instructions B.
*/
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);
unquote_objects(beta);
return exec_unify(args[2], new Goal(alpha, beta));
}
/**
* 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);
}
/**
* 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 {
cut(snap.tail);
}
return found;
}
snap_cleanup(snap);
cont(call.args[1]);
return true;
}
/*********************************************************************/
/* Dynamic Database */
/*********************************************************************/
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(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;
}
/******************************************************************/
/* Linked Provables */
/******************************************************************/
/**
* 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_is_link(Q): internal only
* The built-in succeeds if Q is a provable.
*/
function test_kb_is_link(args) {
let peek = deref(exec_build(args[0]));
return is_provable(peek);
}
/**
* 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]));
}
}
/*********************************************************************/
/* Meta Data */
/*********************************************************************/
/**
* 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(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;
}
/*********************************************************************/
/* dg_date_now/1 and dg_real_time/1 */
/*********************************************************************/
/**
* dg_date_now(W): internal only
* The built-in succeeds in W with the wall clock time.
*/
function test_dg_date_now(args) {
return exec_unify(args[0], norm_smallint(Date.now()));
}
/**
* dg_real_time(W): internal only
* The built-in succeeds in W with the real time.
*/
function test_dg_real_time(args) {
return exec_unify(args[0], norm_smallint(real_time()));
}
/*********************************************************************/
/* dg_gc_time/1, dg_call_count/1 and dg_gc_flags/1 */
/*********************************************************************/
/**
* dg_gc_time(W): internal only
* The built-in succeeds in W with the garbage collection time.
*/
function test_dg_gc_time(args) {
return exec_unify(args[0], norm_smallint(gc_time));
}
/**
* dg_call_count(W): internal only
* The built-in succeeds in W with the call count.
*/
function test_dg_call_count(args) {
return exec_unify(args[0], norm_smallint(gc_enter));
}
/**
* 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));
}
/*********************************************************************/
/* dg_var_serno/2 */
/*********************************************************************/
/**
* 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));
}
/**************************************************************/
/* 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 = 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_stream_list/2, os_get_workdir/1 and os_set_workdir/1 */
/**************************************************************/
/**
* os_stream_list(S, L): internal only
* The built-in succeeds in L with the properties of the stream S.
*/
function test_os_stream_list(args) {
let stream = deref(exec_build(args[0]));
stream = os_stream_list(stream);
return exec_unify(args[1], stream);
}
function os_stream_list(stream) {
let res
if (stream instanceof Sink) {
res = "[]";
} else {
check_source(stream);
res = "[]";
let value = new Compound("line_no", [norm_smallint(stream.lineno)]);
res = new Compound(".", [value, res]);
}
return res;
}
/**
* os_get_workdir(D): internal only
* The built-in succeeds in D with the working directory.
*/
function test_os_get_workdir(args) {
let url;
if (fs !== undefined) {
url = process.cwd()+path.sep;
} else {
url = codebase;
}
return exec_unify(args[0], url);
}
/**
* os_set_workdir(D): internal only
* The built-in succeeds. As a side effect it changes the working directory to D.
*/
function test_os_set_workdir(args) {
let url = 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");
}
/*********************************************************************/
/* os_call_later/3 and os_call_cancel/1 */
/*********************************************************************/
/**
* 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 = deref(exec_build(args[0]));
check_goal(goal);
let delay = deref(exec_build(args[1]));
check_integer(delay);
delay = narrow_float(delay);
let buf = ctx;
let tid = setDelay(() => {launch(goal, buf, VOID_ARGS)}, delay);
return exec_unify(args[2], tid);
}
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]));
}
}
/**
* os_call_cancel(T): internal only
* The predicate succeeds. As a side effect it cancels the timer T.
*/
function test_os_call_cancel(args) {
let tid = deref(exec_build(args[0]));
clearTimeout(tid);
return true;
}
/*********************************************************************/
/* os_task_current/1, os_task_abort/2 and os_task_create/2 */
/*********************************************************************/
/**
* os_task_current(E): internal only
* The predicate succeeds in E with the current task.
*/
function test_os_task_current(args) {
return exec_unify(args[0], ctx);
}
/**
* os_task_abort(E, M): internal only
* The predicate succeeds. As a side effect the task E gets
* the message M signalled.
*/
function test_os_task_abort(args) {
let buf = deref(exec_build(args[0]));
let msg = exec_build(args[1]);
msg = copy_term(msg);
register_signal(buf, msg);
invoke_interrupt(buf);
return true;
}
/**
* 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 = deref(exec_build(args[0]));
check_goal(goal);
let buf = new Context();
buf.engine.text_output = engine.text_output;
buf.engine.text_error = engine.text_error;
buf.engine.text_input = engine.text_input;
setDelay(async () => { await launch_async(goal, buf, VOID_ARGS) }, 0);
return exec_unify(args[1], buf);
}
/******************************************************************/
/* os_host_info/1 */
/******************************************************************/
/**
* os_host_info(I): internal only
* The predicate succeeds in I with the host programming language info.
*/
function test_os_host_info(args) {
let version;
if (fs !== undefined) {
version = process.versions.node;
} else {
version = "0.0.0";
}
let st = version.split('.');
let res = new Array(3);
for (let i = 0; i < res.length; i++)
res[i] = Number.parseInt(st[i]);
let value = new Compound("javascript", res);
return exec_unify(args[0], value);
}
/*********************************************************************/
/* Fiddle Console */
/*********************************************************************/
export function fiddle_out(data, buf) {
data.insertAdjacentText("beforeend", buf);
}
export function fiddle_err(data, buf) {
data.insertAdjacentHTML("beforeend", "<span style='color: #A52A2A'></span>");
data.lastElementChild.insertAdjacentText("beforeend", buf);
}
/*********************************************************************/
/* 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_code", 2, make_check(test_put_code));
add("current_lastcode", 2, make_check(test_current_lastcode));
add("set_lastcode", 2, make_check(test_set_lastcode));
add("put_atom", 2, make_check(test_put_atom));
// stream specials, input
add("current_input", 1, make_check(test_current_input));
add("set_input", 1, make_check(test_set_input));
add("os_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", 3, make_check(test_os_open_promise));
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", 3, make_check(test_os_open_sync));
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_is_site", 1, make_check(test_ir_is_site));
add("ir_pred_site", 2, make_check(test_ir_pred_site));
add("ir_site_name", 2, make_check(test_ir_site_name));
// intermediate representation specials, consult text, internal only
add("ir_clause_new", 6, make_check(test_ir_clause_new));
add("ir_clause_add", 4, make_check(test_ir_clause_add));
add("ir_goal_new", 3, 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_is_link", 1, make_check(test_kb_is_link));
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("dg_date_now", 1, make_check(test_dg_date_now));
add("dg_real_time", 1, make_check(test_dg_real_time));
add("dg_gc_time", 1, make_check(test_dg_gc_time));
add("dg_call_count", 1, make_check(test_dg_call_count));
add("dg_gc_flags", 1, make_check(test_dg_gc_flags));
add("dg_var_serno", 2, make_check(test_dg_var_serno));
// 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_stream_list", 2, make_check(test_os_stream_list));
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));
// system specials, coroutines, internal only
add("os_call_later", 3, make_check(test_os_call_later));
add("os_call_cancel", 1, make_check(test_os_call_cancel));
add("os_task_current", 1, make_check(test_os_task_current));
add("os_task_abort", 2, make_check(test_os_task_abort));
add("os_task_create", 2, make_check(test_os_task_create));
// system specials, natlib, internal only
add("os_host_info", 1, make_check(test_os_host_info));