/**
* Modern Albufeira Prolog Interpreter
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
import {
is_provable, MASK_PRED_DYNAMIC, kb, pred_link,
is_logical, pred_destroy, set, is_stick, check_nonvar,
pred_touch, remove_clause, snapshot_rope, Cache,
engine, Variable, Compound, is_structure, is_cache,
deref, copy_term, make_defined, defined_pred,
is_variable
} from "./store.mjs";
import {
fs, call, Choice, cont, exec_head,
ctx, lookup_pred, make_error, bind,
exec_unify, exec_build, VOID_ARGS, unbind,
make_indicator, make_indicator_term, is_atom,
more, trail, unify, register_signal,
path, exec_body, exec_frame
} from "./machine.mjs";
import {
check_atom, norm_smallint, narrow_float, make_check,
check_integer, char_count, make_special,
list_objects, check_callable, check_clause
} from "./special.mjs";
import {atom_count
} from "./eval.mjs";
export const MAX_BUF = 4096;
export let bootbase = "";
export let codebase = "";
/**
* Set the boot base.
*
* @param url The boot base.
*/
export function set_bootbase(url) {
bootbase = url;
}
/**
* Set the code base.
*
* @param url The code base.
*/
export function set_codebase(url) {
codebase = url;
}
/*********************************************************************/
/* current_output/1 and current_error/1 */
/*********************************************************************/
export const MASK_DST_COLR = 0x00000004;
export const MASK_DST_CYCL = 0x00000008;
export const MASK_DST_FEAT = MASK_DST_COLR | MASK_DST_CYCL;
export const MASK_DST_LINE = 0x00000010;
/**
* Create a text output.
*/
export function Sink() {
this.buf = "";
this.send = (fd, buf) => fd;
this.last = -1;
this.flags = 0;
this.notify = fd => {};
this.release = fd => {};
this.data = undefined;
this.indent = 0;
this.offset = 0;
}
/**
* current_output(S): [ISO 8.11.2]
* The built-in succeeds in S with the current output.
*/
function test_current_output(args) {
let alpha = engine.text_output;
return exec_unify(args[0], alpha);
}
/**
* current_error(S):
* The built-in succeeds in S with the current error.
*/
function test_current_error(args) {
let alpha = engine.text_error;
return exec_unify(args[0], alpha);
}
/*********************************************************************/
/* set_output/1 and set_error/1 */
/*********************************************************************/
/**
* set_output(S): [ISO 8.11.4]
* The built-in succeeds. As a side effect the current output is set to S.
*/
function test_set_output(args) {
let obj = exec_build(args[0]);
check_sink(obj);
engine.text_output = obj;
return true;
}
/**
* set_error(S):
* The built-in succeeds. As a side effect the current error is set to S.
*/
function test_set_error(args) {
let obj = exec_build(args[0]);
check_sink(obj);
engine.text_error = obj;
return true;
}
/**
* Assure that the object is a sink.
*
* @param beta The object.
*/
export function check_sink(beta) {
if (!(beta instanceof Sink)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["writer", beta]));
}
}
/*********************************************************************/
/* put_atom/2 */
/*********************************************************************/
/**
* put_atom(S, A):
* The built-in succeeds. As a side effect, it adds
* the atom to the stream S.
*/
function test_put_atom(args) {
let stream = exec_build(args[0]);
check_sink(stream);
let text = exec_build(args[1]);
check_atom(text);
put_atom(stream, text);
return true;
}
export function put_atom(stream, text) {
if (text.length > 0) {
let pos = text.lastIndexOf("\n");
if (pos !== -1) {
stream.offset = atom_count(text, pos+1, text.length);
} else {
stream.offset += atom_count(text, 0, text.length);
}
stream.last = code_point_before(text, text.length);
if (stream.buf !== null) {
stream.buf += text;
if (stream.buf.length >= MAX_BUF)
flush_buffer(stream);
} else {
stream.data = stream.send(stream.data, text);
}
}
}
function flush_buffer(stream) {
if (stream.buf !== null && stream.buf.length > 0) {
let text = stream.buf;
stream.buf = "";
stream.data = stream.send(stream.data, text);
}
}
export function code_point_before(text, pos) {
let ch = text.charCodeAt(pos - 1);
if (ch >= 0xDC00 && ch <= 0xDFFF && pos > 1) {
let res2 = text.charCodeAt(pos - 2);
if (res2 >= 0xD800 && res2 <= 0xDBFF)
ch = ((res2 - 0xD7C0) << 10) + ch - 0xDC00;
}
return ch;
}
/*********************************************************************/
/* current_input/1 and set_input/1 */
/*********************************************************************/
const MASK_SRC_SKIP = 0x00000001;
export const MASK_SRC_AREAD = 0x00000002;
/**
* Create a text input.
*/
export function Source() {
this.buf = "";
this.pos = 0;
this.receive = fd => "";
this.flags = 0;
this.lineno = 0;
this.release = fd => {};
this.data = undefined;
this.partial = undefined;
}
/**
* current_input(S): [ISO 8.11.1]
* The built-in succeeds in S with the current input.
*/
function test_current_input(args) {
let alpha = engine.text_input;
return exec_unify(args[0], alpha);
}
/**
* set_input(S): [ISO 8.11.3]
* The built-in succeeds. As a side effect it sets the current input to S.
*/
function test_set_input(args) {
let obj = exec_build(args[0]);
check_source(obj);
engine.text_input = obj;
return true;
}
/**
* Assure that the object is a source.
*
* @param beta The object.
*/
export function check_source(beta) {
if (!(beta instanceof Source)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["reader", beta]));
}
}
/*********************************************************************/
/* os_get_code/2 and os_peek_code/2 */
/*********************************************************************/
/**
* os_get_code(S, C):
* The predicate succeeds in C with the Unicode point from the stream buffer S.
* As a side effect the stream position is advanced.
*/
function test_os_get_code(args) {
let stream = exec_build(args[0]);
let pos = stream.pos;
let buf = stream.buf;
if (pos < buf.length) {
let ch = buf.codePointAt(pos);
pos += char_count(ch);
if (ch === 13 || (ch === 10 && (stream.flags & MASK_SRC_SKIP) === 0))
stream.lineno++;
if (ch === 13) {
stream.flags |= MASK_SRC_SKIP;
} else {
stream.flags &= ~MASK_SRC_SKIP;
}
stream.pos = pos;
return exec_unify(args[1], ch);
} else {
return false;
}
}
/**
* os_peek_code(S, C):
* The built-in succeeds in C with the Unicode point from the stream buffer S.
*/
function test_os_peek_code(args) {
let stream = exec_build(args[0]);
let pos = stream.pos;
let buf = stream.buf;
if (pos < buf.length) {
let ch = buf.codePointAt(pos);
return exec_unify(args[1], ch);
} else {
return false;
}
}
/*******************************************************************/
/* os_open_promise_opts/4 */
/*******************************************************************/
/**
* os_open_promise_opts(P, L, S, Q):
* The predicate succeeds in Q with a promise for open input S
* on path P and option list L.
*/
function test_os_open_promise(args) {
let url = exec_build(args[0]);
check_atom(url);
let opts = exec_build(args[1]);
let stream = new Source();
if (!exec_unify(args[2], stream))
return false;
let buf = ctx;
let prom;
if (fs !== undefined) {
prom = open_file_promise_opts(buf, stream, url, opts);
} else {
throw make_error(new Compound("permission_error",
["access", "source_sink", url]));
}
return exec_unify(args[3], prom);
}
export function get_encoding(opts) {
if (opts !== null && opts.get("encoding") !== undefined) {
return opts.get("encoding");
} else {
return "utf8";
}
}
function open_file_promise_opts(buf, stream, url, opts) {
return new Promise(resolve => {
fs.open(url, (err, fd) => {
if (!err) {
let enc = get_encoding(opts);
stream.data = fd;
stream.receive = (buf, stream) => file_read_promise(enc, buf, stream);
stream.release = file_close_promise;
stream.partial = Buffer.alloc(0);
stream.flags |= MASK_SRC_AREAD;
} else {
register_signal(buf, map_file_error(err, url));
}
resolve();
});
});
}
export function map_file_error(err, url) {
if (err.cause !== undefined) {
let code = err.cause.code;
if (code === "ENOTFOUND") {
return new Compound("resource_error", ["unknown_host"]);
} else {
return new Compound("resource_error", ["connect_failed"]);
}
} else {
let code = err.code;
if (code === "ENOENT" || code === "EISDIR" || code === "EPERM") {
return new Compound("existence_error",
["source_sink", url]);
} else {
return new Compound("resource_error", ["remote_error"]);
}
}
}
/*******************************************************************/
/* os_read_promise/2 and os_close_promise/2 */
/*******************************************************************/
/**
* os_read_promise(S, P):
* The predicate suceeds in P with a read promise for a input S.
*/
function test_os_read_promise(args) {
let stream = exec_build(args[0]);
let buf = ctx;
return exec_unify(args[1], stream.receive(buf, stream));
}
export function file_read_promise(enc, buf, stream) {
return new Promise(resolve => {
let res = Buffer.alloc(8192);
stream.partial.copy(res, 0);
let pos = stream.partial.length;
fs.read(stream.data, res, pos, 8192-pos, null, (err, len, _) => {
if (!err) {
let last = last_valid(res, pos+len, enc);
stream.buf = res.toString(enc, 0, last);
stream.pos = 0;
stream.partial = res.slice(last, pos+len);
} else {
register_signal(buf, map_stream_error(err));
}
resolve();
});
});
}
function last_valid(res, len, enc) {
if (enc === "utf8") {
let pos = len;
while (pos > 0 && (res[pos-1] & 0xC0) === 0x80)
pos--;
if (pos > 0) {
if ((res[pos - 1] & 0x80) === 0x00 && pos === len) {
return len;
} else if ((res[pos - 1] & 0xE0) === 0xC0 && pos === len - 1) {
return len;
} else if ((res[pos - 1] & 0xF0) === 0xE0 && pos === len - 2) {
return len;
} else if ((res[pos - 1] & 0xF8) === 0xF0 && pos === len - 3) {
return len;
} else {
pos--;
}
}
return pos;
} else {
return len;
}
}
/**
* Map a stream error when in transit.
*
* @param err The offending error.
* @return {Compound} The Prolog error term.
*/
export function map_stream_error(err) {
let code = err.code;
if (code === "ETIMEDOUT") {
return new Compound("resource_error",
["socket_timeout"]);
} else if (code === "EADDRINUSE") {
return new Compound("resource_error",
["port_error"]);
} else if (code === "ECONNRESET") {
return new Compound("resource_error",
["remote_error"]);
} else {
return new Compound("resource_error",
["io_exception"]);
}
}
/**
* os_close_promise(S, P):
* The predicate suceeds in P with a close promise for a input S.
*/
function test_os_close_promise(args) {
let stream = exec_build(args[0]);
let buf = ctx;
return exec_unify(args[1], stream.release(buf, stream));
}
function file_close_promise(buf, stream) {
return new Promise(resolve => {
fs.close(stream.data, err => {
if (!err) {
/* */
} else {
register_signal(buf, map_stream_error(err));
}
resolve();
});
});
}
/*********************************************************************/
/* os_prop_promise/3 */
/*********************************************************************/
/**
* os_prop_promise(F, M, Q):
* The predicate succeeds in Q with with a promise for the
* properties M of the file F. Barks if path F doesn't exist
* or io exception while resolving.
*/
function test_os_prop_promise(args) {
let url = exec_build(args[0]);
check_atom(url);
let res = {};
if (!exec_unify(args[1], res))
return false;
let buf = ctx;
let prom;
if (fs !== undefined) {
prom = prop_file_promise(buf, url, res);
} else {
throw make_error(new Compound("permission_error",
["access", "source_sink", url]));
}
return exec_unify(args[2], prom);
}
function prop_file_promise(buf, url, res) {
return new Promise(resolve => {
fs.stat(url, (err, stats) => {
if (!err) {
let ftype = (stats.isFile() ? "regular" :
(stats.isDirectory() ? "directory" : "other"));
let mtime = Math.floor(stats.mtimeMs);
res.last_modified = norm_smallint(mtime);
res.absolute_path = (ftype === "directory" ?
path.resolve(url) + path.sep : path.resolve(url));
res.type = ftype;
res.can_write =((stats.mode & 0x80) !== 0 ? "true" : "false");
} else {
register_signal(buf, map_file_error(err, url));
}
resolve();
});
});
}
/******************************************************************/
/* os_open_sync_opts/3 */
/******************************************************************/
/**
* os_open_sync_opts(P, M, L, S):
* The predicate succeeds. As a side effect the stream S is
* opened on the path P with the mode M and the option list L.
*/
function test_os_open_sync(args) {
let url = exec_build(args[0]);
check_atom(url);
let mode = exec_build(args[1]);
check_atom(mode);
let opts = exec_build(args[2]);
let stream;
if ("read" === mode) {
throw make_error(new Compound("resource_error",
["not_supported"]));
} else if ("write" === mode) {
stream = open_write(url, "w", opts);
} else if ("append" === mode) {
stream = open_write(url, "a", opts);
} else {
throw make_error(new Compound("domain_error",
["io_mode", mode]));
}
return exec_unify(args[3], stream);
}
function open_write(url, mode, opts) {
if (fs !== undefined) {
let file;
try {
file = fs.openSync(url, mode);
} catch (err) {
throw make_error(map_file_error(err, url));
}
let dst = new Sink();
let enc = get_encoding(opts);
dst.data = file;
dst.send = (data, buf) => file_write(data, buf, enc);
dst.release = file_close;
return dst;
} else {
throw make_error(new Compound("resource_error", ["io_exception"]));
}
}
function file_write(data, buf, enc) {
try {
fs.writeSync(data, buf, null, enc);
return data;
} catch (err) {
throw make_error(map_stream_error(err));
}
}
function file_close(data) {
try {
fs.closeSync(data);
} catch (err) {
throw make_error(map_stream_error(err));
}
}
/*********************************************************************/
/* flush_output/1 and os_close_sync/1 */
/*********************************************************************/
/**
* flush_output(S): [ISO 8.11.7]
* The built-in succeeds. As a side effect, it flushes the stream S buffer.
*/
function test_flush_output(args) {
let stream = exec_build(args[0]);
check_sink(stream);
stream_flush(stream);
return true;
}
export function stream_flush(stream) {
flush_buffer(stream);
stream.notify(stream.data);
}
/**
* close(S): [ISO 8.11.6]
* The built-in succeeds. As a side effect, the stream S is closed.
*/
function test_os_close_sync(args) {
let stream = exec_build(args[0]);
if (stream instanceof Sink) {
/* */
} else {
check_source(stream);
}
stream_close(stream);
return true;
}
export function stream_close(stream) {
if (stream instanceof Sink) {
flush_buffer(stream);
stream.release(stream.data);
} else {
stream.release(stream.data);
}
}
/*********************************************************************/
/* os_cntrl_sync/2 and os_read_sync/1 */
/*********************************************************************/
/**
* os_cntrl_sync(F, P):
* The predicate assigns the property P to the file F.
*/
function test_os_cntrl_sync(args) {
let url = exec_build(args[0]);
check_atom(url);
if (fs === undefined)
throw make_error(new Compound("permission_error", ["access", "source_sink", url]));
let prop = exec_build(args[1]);
if (is_structure(prop) &&
prop.functor === "last_modified" &&
prop.args.length === 1) {
let val = deref(prop.args[0]);
check_integer(val);
if (val < 0)
throw make_error(new Compound("domain_error",
["not_less_than_zero", val]));
val = new Date(narrow_float(val));
try {
fs.utimesSync(url, val, val);
} catch (err) {
throw make_error(map_file_error(err, url));
}
} else if (is_structure(prop) &&
prop.functor === "can_write" &&
prop.args.length === 1) {
let val = deref(prop.args[0]);
check_atom(val);
if ("true" !== val && "false" !== val)
throw make_error(new Compound("domain_error",
["boolean", val]));
try {
let stats = fs.statSync(url);
if ("true" === val)
fs.chmodSync(url, (stats.mode | 0x80));
else
fs.chmodSync(url, (stats.mode & ~0x80));
} catch (err) {
throw make_error(map_file_error(err, url));
}
} else {
check_nonvar(prop);
prop = copy_term(prop);
throw make_error(new Compound("domain_error",
["file_property", prop]));
}
return true;
}
/**
* os_read_sync(S):
* The predicate succeeds. As a side effect the stream buffer is read.
*/
function test_os_read_sync(args) {
let stream = exec_build(args[0]);
stream.buf = stream.receive(stream.data);
stream.pos = 0;
return true;
}
/*********************************************************************/
/* ir_site_new/2, ir_is_site/1 and ir_site_name/2 */
/*********************************************************************/
/**
* ir_site_new(X, Y): internal only
* The built-in succeeds in Y with a cacheable X.
*/
function test_ir_site_new(args) {
let alpha = exec_build(args[0]);
if (is_structure(alpha)) {
if (is_atom(alpha.functor))
alpha = new Compound(new Cache(alpha.functor), alpha.args);
} else if (is_atom(alpha)) {
alpha = new Cache(alpha);
}
return exec_unify(args[1], alpha);
}
/**
* ir_is_site(X): internal only
* The built-in succeeds if X is cacheable.
*/
function test_ir_is_site(args) {
let alpha = exec_build(args[0]);
if (is_structure(alpha))
return is_cache(alpha.functor);
return is_cache(alpha);
}
/**
* ir_site_name(X, Y): internal only
* The built-in succeeds in Y with a cachefree X.
*/
function test_ir_site_name(args) {
let alpha = exec_build(args[0]);
if (is_structure(alpha)) {
if (is_cache(alpha.functor))
alpha = new Compound(alpha.functor.name, alpha.args);
} else if (is_cache(alpha)) {
alpha = alpha.name;
}
return exec_unify(args[1], alpha);
}
/**************************************************************/
/* ir_link_new/2 and ir_is_link/1 */
/**************************************************************/
/**
* ir_link_new(L, P): internal only
* The built-in succeeds in P with an anonymous predicate
* for the clauses L.
*/
function test_ir_link_new(args) {
let alpha = exec_build(args[0]);
alpha = list_objects(alpha);
return exec_unify(args[1], make_defined(alpha));
}
/**
* ir_is_link(Q): internal only
* The built-in succeeds if Q is a provable.
*/
function test_ir_is_link(args) {
let alpha = exec_build(args[0]);
if (is_structure(alpha))
return is_provable(alpha.functor);
return is_provable(alpha);
}
/*********************************************************************/
/* kb_clause_ref/3 and kb_pred_touch/3 */
/*********************************************************************/
const MASK_FIND_MODIFY = 0x00000001;
const MASK_FIND_DYNAMIC = 0x00000002;
const MASK_FIND_REVERSE = 0x00000004;
const MASK_FIND_SIGNAL = 0x00000008;
/**
* kb_clause_ref(H, F, C): internal only
* The built-in succeeds in C with the clause references
* for the head H and the flags F.
*/
function special_kb_clause_ref(args) {
let head = deref(args[0]);
check_callable(head);
let flags = deref(args[1]);
check_integer(flags);
let peek = lookup_pred(head);
if (peek === undefined) {
if ((flags & MASK_FIND_SIGNAL) !== 0) {
throw make_error(new Compound("existence_error",
["procedure", make_indicator_term(head)]));
} else {
return false;
}
}
if ((flags & MASK_FIND_DYNAMIC) !== 0) {
if ((peek.flags & MASK_PRED_DYNAMIC) === 0) {
make_error_find(head, flags);
}
}
if (!is_logical(peek.func) && !is_stick(peek.func)) {
if ((flags & MASK_FIND_SIGNAL) !== 0) {
make_error_find(head, flags);
} else {
return false;
}
}
if (is_structure(head)) {
head = head.args;
} else {
head = VOID_ARGS;
}
peek = defined_pred(peek, head);
peek = snapshot_rope(peek);
if ((flags & MASK_FIND_REVERSE) === 0) {
return solve2_ref(args, peek, 0, null);
} else {
return solve2_ref_reverse(args, peek, peek.length, null);
}
}
function make_error_find(head, flags) {
if ((flags & MASK_FIND_MODIFY) !== 0) {
throw make_error(new Compound("permission_error",
["modify", "static_procedure", make_indicator_term(head)]));
} else {
throw make_error(new Compound("permission_error",
["access", "private_procedure", make_indicator_term(head)]));
}
}
function solve_ref(rope, at, choice) {
let goal = deref(call.args[0]);
return solve2_ref(goal.args, rope, at, choice);
}
function solve_ref_reverse(rope, at, choice) {
let goal = deref(call.args[0]);
return solve2_ref_reverse(goal.args, rope, at, choice);
}
/**
* Search a Prolog clause and return it.
*
* @param args The current arguments.
* @param rope The clause list.
* @param at The clause index.
* @param choice The choice point for reuse or null.
* @return boolean True if search succeeds, otherwise false.
*/
function solve2_ref(args, rope, at, choice) {
let mark = trail;
while (at < rope.length) {
let clause = rope[at++];
if (unify(args[2], clause)) {
if (at < rope.length) {
if (choice === null) {
choice = new Choice(solve_ref, rope, at, mark);
} else {
choice.at = at;
}
more(choice);
}
cont(call.args[1]);
return true;
}
unbind(mark);
}
return false;
}
/**
* Search a Prolog clause backwards and return it.
*
* @param args The current arguments.
* @param rope The clause list.
* @param at The clause index.
* @param choice The choice point for reuse or null.
* @return boolean True if search succeeds, otherwise false.
*/
function solve2_ref_reverse(args, rope, at, choice) {
let mark = trail;
while (at > 0) {
let clause = rope[--at];
if (unify(args[2], clause)) {
if (at > 0) {
if (choice === null) {
choice = new Choice(solve_ref_reverse, rope, at, mark);
} else {
choice.at = at;
}
more(choice);
}
cont(call.args[1]);
return true;
}
unbind(mark);
}
return false;
}
/**
* kb_pred_touch(F, N, O): internal only
* The built-in succeeds. As a side effect the predicate
* indicator F/N with options O is touched.
*/
function test_kb_pred_touch(args) {
let functor = exec_build(args[0]);
check_atom(functor);
let arity = exec_build(args[1]);
check_integer(arity);
let flags = exec_build(args[2]);
check_integer(flags);
pred_touch(functor, arity, flags);
return true;
}
/**************************************************************/
/* kb_clause_remove/2 and kb_pred_destroy/2 */
/**************************************************************/
/**
* kb_clause_remove(C, O): internal only
* The built-in succeeds if the clause C could
* be removed according to the options O.
*/
function test_kb_clause_remove(args) {
let alpha = exec_build(args[0]);
check_clause(alpha);
let beta = exec_build(args[1]);
check_integer(beta);
return remove_clause(alpha, beta);
}
/**
* kb_pred_destroy(F, N): internal only
* The built-in succeeds. As a side effect the
* predicate indicator F/N is destroyed.
*/
function test_kb_pred_destroy(args) {
let functor = exec_build(args[0]);
check_atom(functor);
let arity = exec_build(args[1]);
check_integer(arity);
pred_destroy(functor, arity);
return true;
}
/**************************************************************/
/* kb_pred_link/3, kb_link_flags/2 and kb_pred_list/1 */
/**************************************************************/
/**
* kb_pred_link(F, A, Q): internal only
* The built-in succeeds in Q with the provable of the
* predicate indicator F/A. Otherwise if no such provable
* exists the built-in fails.
*/
function test_kb_pred_link(args) {
let functor = exec_build(args[0]);
check_atom(functor);
let arity = exec_build(args[1]);
check_integer(arity);
let peek = pred_link(functor, arity);
if (peek === undefined)
return false;
return exec_unify(args[2], peek);
}
/**
* kb_link_flags(Q, F): internal only
* The built-in succeeds in F with the flags of the provable Q.
*/
function test_kb_link_flags(args) {
let peek = exec_build(args[0]);
check_provable(peek);
let res = peek.flags;
return exec_unify(args[1], res);
}
/**
* Assure that the object is a provable.
*
* @param beta The object.
*/
export function check_provable(beta) {
if (!is_provable(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error",
["provable", beta]));
}
}
/**
* kb_pred_list(L): internal only
* The built-in succeeds in L with the current predicate indicators.
*/
function test_kb_pred_list(args) {
let res = kb_pred_list();
return exec_unify(args[0], res);
}
function kb_pred_list() {
let back = null;
let res = null;
for (let functor in kb) {
let temp = kb[functor];
for (let i = 0; i < temp.length; i++) {
let peek = temp[i]
if (peek === undefined || peek.remover !== undefined)
continue;
peek = new Compound(".", [make_indicator(functor, i), undefined]);
if (back === null) {
res = peek;
} else {
back.args[1] = peek;
}
back = peek;
}
}
if (back === null) {
res = "[]";
} else {
back.args[1] = "[]";
}
return res;
}
/**************************************************************/
/* kb_clause_shard/2, kb_clause_head/2 and kb_clause_data/4 */
/**************************************************************/
/**
* kb_clause_shard(C, S): internal only
* The built-in succeeds in S with the shard of the clause C.
*/
function test_kb_clause_shard(args) {
let clause = exec_build(args[0]);
check_clause(clause);
return exec_unify(args[1], clause.shard);
}
/**
* kb_clause_head(C, H): internal only
* The built-in succeeds in H with the head of the clause C.
*/
function special_kb_clause_head(args) {
let clause = deref(args[0]);
check_clause(clause);
let head = deref(args[1]);
let display;
if (clause.size !== 0) {
display = new Array(clause.size);
} else {
display = null;
}
if (!is_variable(head)) {
let paras;
if (is_structure(head)) {
paras = head.args;
} else {
paras = VOID_ARGS;
}
if (!exec_head(clause.head, display, paras))
return false;
} else {
let alpha = exec_frame(clause.functor, clause.head, display);
bind(alpha, head);
}
cont(call.args[1]);
return true;
}
/**
* kb_clause_data(C, H, O, L): internal only
* The built-in succeeds in H, O and L with the head,
* the cut var and the translated body of the clause C.
*/
function special_kb_clause_data(args) {
let clause = deref(args[0]);
check_clause(clause);
let head = deref(args[1]);
let display;
if (clause.size !== 0) {
display = new Array(clause.size);
} else {
display = null;
}
if (!is_variable(head)) {
let paras;
if (is_structure(head)) {
paras = head.args;
} else {
paras = VOID_ARGS;
}
if (!exec_head(clause.head, display, paras))
return false;
} else {
let alpha = exec_frame(clause.functor, clause.head, display);
bind(alpha, head);
}
let temp;
let peek = clause.cutvar;
if (peek !== -1) {
temp = new Variable();
display[peek] = temp;
temp = new Compound("just", [temp]);
} else {
temp = "nothing";
}
if (!unify(args[2], temp))
return false;
temp = exec_body(clause.body, display);
if (!unify(args[3], temp))
return false;
cont(call.args[1]);
return true;
}
/*********************************************************************/
/* Runtime Init */
/*********************************************************************/
// stream specials, output
set("current_output", 1, make_check(test_current_output));
set("current_error", 1, make_check(test_current_error));
set("set_output", 1, make_check(test_set_output));
set("set_error", 1, make_check(test_set_error));
set("put_atom", 2, make_check(test_put_atom));
// stream specials, input
set("current_input", 1, make_check(test_current_input));
set("set_input", 1, make_check(test_set_input));
set("os_get_code", 2, make_check(test_os_get_code));
set("os_peek_code", 2, make_check(test_os_peek_code));
// stream specials, async
set("os_open_promise", 4, make_check(test_os_open_promise));
set("os_read_promise", 2, make_check(test_os_read_promise));
set("os_close_promise", 2, make_check(test_os_close_promise));
set("os_prop_promise", 3, make_check(test_os_prop_promise));
// stream specials, sync
set("os_open_sync", 4, make_check(test_os_open_sync));
set("flush_output", 1, make_check(test_flush_output));
set("os_close_sync", 1, make_check(test_os_close_sync));
set("os_cntrl_sync", 2, make_check(test_os_cntrl_sync));
set("os_read_sync", 1, make_check(test_os_read_sync));
// intermediate representation, Albufeira code
set("ir_site_new", 2, make_check(test_ir_site_new));
set("ir_is_site", 1, make_check(test_ir_is_site));
set("ir_site_name", 2, make_check(test_ir_site_name));
set("ir_link_new", 2, make_check(test_ir_link_new));
set("ir_is_link", 1, make_check(test_ir_is_link));
// knowledge base specials, dynamic database, internal only
set("kb_clause_ref", 3, make_special(special_kb_clause_ref));
set("kb_pred_touch", 3, make_check(test_kb_pred_touch));
set("kb_clause_remove", 2, make_check(test_kb_clause_remove));
set("kb_pred_destroy", 2, make_check(test_kb_pred_destroy));
// knowledge base specials, linked provables, internal only
set("kb_pred_link", 3, make_check(test_kb_pred_link));
set("kb_link_flags", 2, make_check(test_kb_link_flags));
set("kb_pred_list", 1, make_check(test_kb_pred_list));
// knowledge base specials, meta data, internal only
set("kb_clause_shard", 2, make_check(test_kb_clause_shard));
set("kb_clause_head", 2, make_special(special_kb_clause_head));
set("kb_clause_data", 4, make_special(special_kb_clause_data));