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 {
Provable, add, MASK_PRED_CHECK,
MASK_PRED_ARITHMETIC, Variable, MASK_PRED_SPECIAL,
is_variable, Compound, is_compound
} from "./store.mjs";
import {
bind, call, gc_flags, Choice, check_nonvar,
cont, snap_setup, solve, set_gc_flags, snap_cleanup,
cut, deref, is_atom, exec_build, exec_unify,
is_float, is_integer, is_number,
make_error, more, redo, trail, unify, check_callable,
solve_signal, GC_MASK_ASYNC_MODE, GC_MASK_ALLOW_YIELD,
copy_term, fs, VOID_ARGS, ctx, register_interrupt,
setDelay, url, VAR_MASK_STATE, mark2_term
} from "./machine.mjs";
import {
code_type, code_numeric
} from "./unicode.mjs";
export const MAX_ARITY = 2147483647;
/*********************************************************************/
/* Special Predicate */
/*********************************************************************/
/**
* Return a built-in for a special.
*
* @param func The special.
* @return Provable The built-in.
*/
export function make_special(func) {
let peek = new Provable(MASK_PRED_SPECIAL);
peek.func = func;
return peek;
}
/**
* Return a built-in for a check.
*
* @param func The check.
* @return Provable The built-in.
*/
export function make_check(func) {
let peek = new Provable(MASK_PRED_CHECK);
peek.func = func;
return peek;
}
/**
* Return a built-in for an arithmetic.
*
* @param func The arithmetic.
* @return Provable The built-in.
*/
export function make_arithmetic(func) {
let peek = new Provable(MASK_PRED_ARITHMETIC);
peek.func = func;
return peek;
}
/*********************************************************************/
/* fail/0, '$CUT'/1 and '$MARK'/1 */
/*********************************************************************/
/**
* fail: [ISO 7.8.2]
* The built-in fails.
*/
function test_fail(args) {
return false;
}
/**
* '$CUT'(R): internal only
* The built-in removes the choice points up to R and succeeds.
*/
function test_cut(args) {
let choice = deref(exec_build(args[0]));
cut(choice);
return true;
}
/**
* '$MARK'(R): Internal only
* The built-in binds R to the top choice point.
*/
function test_mark(args) {
let choice = redo;
return exec_unify(args[0], choice);
}
/*********************************************************************/
/* '$SEQ'/2 and '$ALT'/1 */
/*********************************************************************/
/**
* '$SEQ'(O, L): internal only
* If the Prolog term O has the form just(R) bind R the top choice point.
* Otherwise, do nothing. The built-in then sequentially adds the goals L
* to the continuation.
*/
function special_seq(args) {
let temp = deref(args[0]);
solve_mark(temp);
temp = deref(args[1]);
solve_seq(temp);
return true;
}
/**
* If the Prolog term has the form just(R) bind R the top choice point.
* Otherwise do nothing.
*
* @param temp The Prolog term.
*/
function solve_mark(temp) {
if (is_compound(temp) && temp.functor === "just" && temp.args.length === 1) {
temp = deref(temp.args[0]);
bind(redo, temp);
}
}
/**
* Sequentially adds the literals L to the continuation. The list
* is unchecked, no validation that it ends on [].
*
* @param goal The literals.
*/
function solve_seq(goal) {
let back = null;
let res = null;
while (is_compound(goal) && goal.functor === "." && goal.args.length === 2) {
let peek = goal.args[0];
let temp = new Compound(".", [peek, undefined]);
if (back === null) {
res = temp;
} else {
back.args[1] = temp;
}
back = temp;
goal = deref(goal.args[1]);
}
if (back === null) {
res = call.args[1];
} else {
back.args[1] = call.args[1];
}
cont(res);
}
/**
* '$ALT'(L): internal only
* The built-in alternatively adds the variants L to the
* continuation and succeeds.
*/
function special_alt(args) {
let goal = deref(args[0]);
return solve_alt(goal, -1, null);
}
/**
* Alternatively adds the variants to the continuation.
*
* @param goal The variants.
* @param at This argument is ignored.
* @param choice The choice point for reuse or null.
* @return boolean True if a variant could be added, otherwise false.
*/
function solve_alt(goal, at, choice) {
if (is_compound(goal) && goal.functor === "." && goal.args.length === 2) {
let mark = trail;
let peek = deref(goal.args[0]);
let temp = deref(peek.args[0]);
solve_mark(temp);
peek = deref(peek.args[1]);
goal = deref(goal.args[1]);
if (is_compound(goal) && goal.functor === "." && goal.args.length === 2) {
if (choice === null) {
choice = new Choice(solve_alt, goal, -1, mark);
} else {
choice.data = goal;
}
more(choice);
}
solve_seq(peek);
return true;
} else {
return false;
}
}
/*********************************************************************/
/* sys_raise/1 and sys_trap/3 */
/*********************************************************************/
/**
* sys_raise(E): internal only
* The predicate raises the exception E.
*/
function test_sys_raise(args) {
let problem = exec_build(args[0]);
throw copy_term(problem);
}
/**
* sys_trap(G, E, F): internal only
* The built-in succeeds whenever G succeeds. If
* there was an exception that unifies with E, the
* built-in further succeeds whenever F succeeds.
*/
function special_sys_trap(args) {
let goal = deref(args[0]);
let snap = snap_setup();
goal = new Compound(".", [goal, "[]"]);
cont(goal);
return solve_catch(snap, true, null);
}
/**
* Call, redo or resume a goal.
* If there is an exception put the handler on the continuation.
*
* @param snap The surrounding choice point.
* @param found The call or redo flag.
* @param choice The choice point for reuse or null.
* @return boolean True if goal succeeded, otherwise false.
*/
function solve_catch(snap, found, choice) {
if (choice !== null) {
choice.mark = null;
choice.cont = "[]";
choice.tail = null;
}
try {
found = solve(snap, found);
} catch (err) {
snap_cleanup(snap);
let goal = deref(call.args[0]);
err = map_throwable(err);
if (!unify(goal.args[1], err))
throw err;
goal = deref(goal.args[2]);
goal = new Compound(".", [goal, call.args[1]]);
cont(goal);
return true;
}
if (found === false)
return false;
if (redo !== snap) {
if (choice === null) {
choice = new Choice(solve_catch, snap, false, trail);
} else {
choice.mark = trail;
choice.cont = call;
choice.tail = redo;
}
more(choice);
} else {
cut(snap.tail);
}
if (found === true)
cont(snap.cont.args[1]);
return found;
}
function map_throwable(err) {
if (err instanceof RangeError)
err = make_error(new Compound("system_error", ["stack_overflow"]));
return err;
}
/*********************************************************************/
/* os_sleep_promise/2 and os_import_promise/3 */
/*********************************************************************/
/**
* os_sleep_promise(D, P):
* The predicate succeeds in P with a promise for a delay D.
*/
function test_os_sleep_promise(args) {
let delay = deref(exec_build(args[0]));
check_integer(delay);
if (delay < 0)
throw make_error(new Compound("domain_error",
["not_less_than_zero", delay]));
let buf = ctx;
return exec_unify(args[1], sleep_promise(buf, delay));
}
function sleep_promise(buf, delay) {
return new Promise(resolve => {
let timer = setDelay(resolve, delay);
register_interrupt(buf, () => {
clearTimeout(timer);
timer = setDelay(resolve, 0)})
}).then(() => register_interrupt(buf, () => {}));
}
/**
* os_import_promise(F, M, Q):
* The predicate succeeds in Q with with a promise for the
* import M of the file F.
*/
function test_os_import_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;
return exec_unify(args[2], import_promise(buf, url, res));
}
function import_promise(buf, path, res) {
if (fs !== undefined) {
path = url.pathToFileURL(path);
return import(path).then(module => res["module"]=module);
} else {
return import(path).then(module => res["module"]=module);
}
}
/**
* os_invoke_main(M):
* Invoke the main method of the module M.
*/
function test_os_invoke_main(args) {
let module = deref(exec_build(args[0]));
module.main();
return true;
}
/*********************************************************************/
/* '$YIELD'/1, shield/1 and unshield/1 */
/*********************************************************************/
/**
* '$YIELD'(R): Internal only
* The built-in stops the interpreter loop with return value R.
*/
function special_yield(args) {
if ((gc_flags & GC_MASK_ALLOW_YIELD) === 0)
throw make_error(new Compound("system_error", ["illegal_yield"]));
cont(call.args[1]);
more(new Choice(solve_signal, null, null, trail));
return deref(args[0]);
}
/**
* shield(G):
* The predicate succeeds whenever the goal G succeeds.
* The goal is executed without auto-yield.
*/
function special_shield(args) {
let goal = deref(args[0]);
let snap = snap_setup();
goal = new Compound(".", [goal, "[]"]);
cont(goal);
return solve_shield(snap, true, null);
}
/**
* Call, redo or resume a goal.
* The goal is executed without auto-yield.
*
* @param snap The surrounding choice point.
* @param found The call or redo flag.
* @param choice The choice point for reuse or null.
* @return boolean True if goal succeeded, otherwise false.
*/
function solve_shield(snap, found, choice) {
if (choice !== null) {
choice.mark = null;
choice.cont = "[]";
choice.tail = null;
}
let back = gc_flags & GC_MASK_ASYNC_MODE;
set_gc_flags(gc_flags & ~GC_MASK_ASYNC_MODE);
try {
found = solve(snap, found);
} catch (x) {
set_gc_flags((gc_flags & ~GC_MASK_ASYNC_MODE) | back);
snap_cleanup(snap);
throw x;
}
set_gc_flags((gc_flags & ~GC_MASK_ASYNC_MODE) | back);
if (found === false)
return false;
if (redo !== snap) {
if (choice === null) {
choice = new Choice(solve_shield, snap, false, trail);
} else {
choice.mark = trail;
choice.cont = call;
choice.tail = redo;
}
more(choice);
} else {
cut(snap.tail);
}
if (found === true)
cont(snap.cont.args[1]);
return found;
}
/**
* unshield(G):
* The predicate succeeds whenever the goal G succeeds.
* The goal is executed with auto-yield.
*/
function special_unshield(args) {
let goal = deref(args[0]);
let snap = snap_setup();
goal = new Compound(".", [goal, "[]"]);
cont(goal);
return solve_unshield(snap, true, null);
}
/**
* Call, redo or resume a goal.
* The goal is executed without auto-yield.
*
* @param snap The surrounding choice point.
* @param found The call or redo flag.
* @param choice The choice point for reuse or null.
* @return boolean True if goal succeeded, otherwise false.
*/
function solve_unshield(snap, found, choice) {
if (choice !== null) {
choice.mark = null;
choice.cont = "[]";
choice.tail = null;
}
let back = gc_flags & GC_MASK_ASYNC_MODE;
set_gc_flags(gc_flags | GC_MASK_ASYNC_MODE);
try {
found = solve(snap, found);
} catch (x) {
set_gc_flags((gc_flags & ~GC_MASK_ASYNC_MODE) | back);
snap_cleanup(snap);
throw x;
}
set_gc_flags((gc_flags & ~GC_MASK_ASYNC_MODE) | back);
if (found === false)
return false;
if (redo !== snap) {
if (choice === null) {
choice = new Choice(solve_unshield, snap, false, trail);
} else {
choice.mark = trail;
choice.cont = call;
choice.tail = redo;
}
more(choice);
} else {
cut(snap.tail);
}
if (found === true)
cont(snap.cont.args[1]);
return found;
}
/*********************************************************************/
/* Type Assertions */
/*********************************************************************/
/**
* Assure that the object is an atom.
*
* @param beta The object.
*/
export function check_atom(beta) {
if (!is_atom(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["atom", beta]));
}
}
/**
* Assure that the object is a number.
*
* @param beta The object.
*/
export function check_number(beta) {
if (!is_number(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["number", beta]));
}
}
/**
* Assure that the object is an integer.
*
* @param beta The object.
*/
export function check_integer(beta) {
if (!is_integer(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["integer", beta]));
}
}
/**
* Assure that the object is atomic.
*
* @param beta The object.
*/
export function check_atomic(beta) {
if (is_variable(beta) || is_compound(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["atomic", beta]));
}
}
/**
* Assure that the Prolog term is nil.
*
* @param beta The Prolog term.
*/
export function check_nil(beta) {
if (beta !== "[]") {
if (is_compound(beta) && beta.functor === "."
&& beta.args.length === 2) {
throw make_error(new Compound("representation_error", ["int"]));
} else {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["list", beta]));
}
}
}
/**
* Assure that the object is a symbol.
*
* @param beta The object.
*/
export function check_symbol(beta) {
if (is_variable(beta) || is_compound(beta) || is_number(beta)) {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["symbol", beta]));
}
}
/*********************************************************************/
/* =/2 and copy_term/2 */
/*********************************************************************/
/**
* S = T: [ISO 8.2.1]
* The built-in succeeds when the Prolog terms S and T unify,
* otherwise the built-in fails.
*/
function test_unify(args) {
let alpha = exec_build(args[0]);
return exec_unify(args[1], alpha);
}
/**
* copy_term(S, T): [ISO 8.5.4]
* The built-in succeeds in T with a copy of S.
*/
function test_copy_term(args) {
let alpha = exec_build(args[0]);
alpha = copy_term(alpha)
return exec_unify(args[1], alpha);
}
/*********************************************************************/
/* =../2 and functor/3 */
/*********************************************************************/
/**
* T =.. [F|L]: [ISO 8.5.3]
* If T is a variable, the built-in succeeds in T with the Prolog term
* from the functor F and arguments L. Otherwise the built-in succeeds in
* F and L with the functor and arguments of the Prolog term T.
*/
function test_univ(args) {
let alpha = deref(exec_build(args[0]));
if (is_variable(alpha)) {
let beta = deref(exec_build(args[1]));
beta = special_univ_pack(beta);
return unify(alpha, beta);
} else {
alpha = special_univ_unpack(alpha);
return exec_unify(args[1], alpha);
}
}
function special_univ_pack(beta) {
if (is_compound(beta) &&
"." === beta.functor &&
beta.args.length === 2) {
let peek = deref(beta.args[1]);
let args = list_objects(peek);
peek = deref(beta.args[0]);
if (args.length === 0) {
check_atomic(peek);
} else {
check_symbol(peek);
peek = new Compound(peek, args);
}
return peek;
} else {
check_nonvar(beta);
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["list", beta]));
}
}
export function list_objects(obj) {
let peek = obj;
let arity = 0;
while (is_compound(peek) &&
"." === peek.functor &&
peek.args.length === 2 &&
arity < MAX_ARITY) {
arity++;
peek = deref(peek.args[1]);
}
check_nil(peek);
if (arity === 0) {
return VOID_ARGS;
} else {
let args = new Array(arity);
peek = obj;
arity = 0;
while (is_compound(peek) &&
"." === peek.functor &&
peek.args.length === 2) {
args[arity++] = deref(peek.args[0]);
peek = deref(peek.args[1]);
}
return args;
}
}
function special_univ_unpack(alpha) {
let res;
if (is_compound(alpha)) {
res = new Compound(".", [alpha.functor, undefined]);
let back = res;
alpha = alpha.args;
for (let i = 0; i < alpha.length; i++) {
let peek = new Compound(".", [alpha[i], undefined]);
back.args[1] = peek;
back = peek;
}
back.args[1] = "[]";
} else {
res = new Compound(".", [alpha, "[]"]);
}
return res;
}
/**
* functor(T, F, A): [ISO 8.5.1]
* If T is a variable, the built-in succeeds in T with a new Prolog term
* from the functor F and the arity A. Otherwise the built-in succeeds in
* F and L with the functor and arguments of the Prolog term T.
*/
function test_functor(args) {
let alpha = deref(exec_build(args[0]));
if (is_variable(alpha)) {
let functor = deref(exec_build(args[1]));
let arity = deref(exec_build(args[2]));
check_integer(arity);
if (arity < 0)
throw make_error(new Compound("domain_error",
["not_less_than_zero", arity]));
if (arity > MAX_ARITY)
throw make_error(new Compound("representation_error",
["max_arity"]));
let res;
if (arity === 0) {
check_atomic(functor);
res = functor;
} else {
check_symbol(functor);
let temp = new Array(arity);
for (let i = 0; i < arity; i++)
temp[i] = new Variable();
res = new Compound(functor, temp);
}
return unify(alpha, res);
} else {
let functor;
let arity;
if (is_compound(alpha)) {
functor = alpha.functor;
arity = alpha.args.length;
} else {
functor = alpha;
arity = 0;
}
if (!exec_unify(args[1], functor))
return false;
return exec_unify(args[2], arity);
}
}
/*********************************************************************/
/* arg/3 and change_arg/3 */
/*********************************************************************/
/**
* arg(K, X, Y): [ISO 8.5.2]
* The predicate succeeds in Y with the K-th argument of X.
*/
function test_arg(args) {
let alpha = deref(exec_build(args[0]));
check_integer(alpha);
let beta = deref(exec_build(args[1]));
check_callable(beta);
let arity;
if (is_compound(beta)) {
arity = beta.args.length;
} else {
arity = 0;
}
if (alpha < 1 || arity < alpha)
return false;
beta = beta.args[alpha - 1];
return exec_unify(args[2], beta);
}
/**
* change_arg(K, X, Y):
* The predicate succeeds. As a side-effect the K-th argument of X is set to Y.
*/
function test_change_arg(args) {
let alpha = deref(exec_build(args[0]));
check_integer(alpha);
let beta = deref(exec_build(args[1]));
check_callable(beta);
let gamma = deref(exec_build(args[2]));
let arity;
if (is_compound(beta)) {
arity = beta.args.length;
} else {
arity = 0;
}
if (alpha < 1 || arity < alpha)
return false;
beta = beta.args[alpha - 1];
check_var(beta);
link(gamma, beta);
return true;
}
export function check_var(beta) {
if (!is_variable(beta)) {
beta = copy_term(beta);
throw make_error(new Compound("type_error", ["var", beta]));
}
}
function link(source, term) {
if (term.tail === null) {
term.instantiated = source;
if ((term.flags & VAR_MASK_STATE) ===
(gc_flags & VAR_MASK_STATE))
mark2_term(source);
} else {
let beta = copy_term(term);
throw make_error(new Compound("type_error", ["conductor", beta]));
}
}
/*****************************************************************/
/* ir_object_new/1, ir_object_current/3 and ir_object_set/3 */
/*****************************************************************/
/**
* ir_object_new(O):
* The predicate succeeds in O with a new JavaScript object.
*/
function test_ir_object_new(args) {
let res = {};
return exec_unify(args[0], res);
}
/**
* ir_object_current(O, K, V):
* The predicate succeeds in V with the value of the key K
* in the JavaScript object O.
*/
function test_ir_object_current(args) {
let obj = deref(exec_build(args[0]));
let key = deref(exec_build(args[1]));
check_atom(key);
let res = obj[key];
if (res === undefined)
return false;
return exec_unify(args[2], res);
}
/**
* ir_object_set(O, K, V):
* The predicate sets the value of the key K in the
* JavaScript object O to V.
*/
function test_ir_object_set(args) {
let obj = deref(exec_build(args[0]));
let key = deref(exec_build(args[1]));
check_atom(key);
let value = deref(exec_build(args[2]));
obj[key] = value;
return true;
}
/**
* ir_object_keys(O, L):
* The predicate succeeds in L with the keys of
* the JavaScript object O
*/
function test_ir_object_keys(args) {
let obj = deref(exec_build(args[0]));
let res = Object.keys(obj);
res = set_to_list(res, "[]");
return exec_unify(args[1], res);
}
/*********************************************************************/
/* ground/1 and nonground/2 */
/*********************************************************************/
/**
* ground(T): [TC2 8.3.10]
* The built-in succceeds if T is ground.
*/
function test_ground(args) {
let alpha = exec_build(args[0]);
alpha = first_variable(alpha);
return (alpha === undefined);
}
/**
* nonground(T, V):
* The built-in succeeds if T is non-ground and V is the first variable.
*/
function test_nonground(args) {
let alpha = exec_build(args[0]);
alpha = first_variable(alpha);
if (alpha === undefined)
return false;
return exec_unify(args[1], alpha);
}
/**
* Find the first variable of a Prolog term.
*
* @param alpha The Prolog term.
* @return The first variable or undefined.
*/
function first_variable(alpha) {
for (; ;) {
alpha = deref(alpha);
if (is_variable(alpha)) {
return alpha;
} else if (is_compound(alpha)) {
alpha = alpha.args;
let i = 0;
for (; i < alpha.length - 1; i++) {
let res = first_variable(alpha[i]);
if (res !== undefined)
return res;
}
alpha = alpha[i];
} else {
return undefined;
}
}
}
/*********************************************************************/
/* term_variables/3 and term_singletons/2 */
/*********************************************************************/
/**
* term_variables(T, L, E): [TC2 8.5.5]
* The built-in succeeds in L with a list with end E and
* with the variables of T as its list elements.
*/
function test_term_variables(args) {
let alpha = exec_build(args[0]);
let beta = exec_build(args[1]);
let gamma = deref(exec_build(args[2]));
alpha = term_variables(alpha);
alpha = set_to_list(alpha, gamma);
return unify(beta, alpha);
}
/**
* Collect the variables of a Prolog term.
*
* @param alpha The Prolog term.
* @return The set with the variables.
*/
function term_variables(alpha) {
let res = null;
function term_variables2(alpha2) {
for (; ;) {
alpha2 = deref(alpha2);
if (is_variable(alpha2)) {
if (res === null)
res = new Set();
res.add(alpha2);
break;
} else if (is_compound(alpha2)) {
alpha2 = alpha2.args;
let i = 0;
for (; i < alpha2.length - 1; i++)
term_variables2(alpha2[i]);
alpha2 = alpha2[i];
} else {
break;
}
}
}
term_variables2(alpha);
return res;
}
/**
* term_singletons(T, L):
* The built-in succeeds in L with the singleton variables of T.
*/
function test_term_singletons(args) {
let alpha = exec_build(args[0]);
alpha = term_singletons(alpha);
alpha = set_to_list(alpha, "[]");
return exec_unify(args[1], alpha);
}
/**
* Collect the singleton variables of a Prolog term.
*
* @param alpha The Prolog term.
* @return The set with the singleton variables.
*/
function term_singletons(alpha) {
let res = null;
let anon = null;
function term_singletons2(alpha2) {
for (; ;) {
alpha2 = deref(alpha2);
if (is_variable(alpha2)) {
if (res === null) {
res = new Set();
anon = new Set();
}
if (res.has(alpha2)) {
anon.delete(alpha2);
} else {
res.add(alpha2);
anon.add(alpha2);
}
break;
} else if (is_compound(alpha2)) {
alpha2 = alpha2.args;
let i = 0;
for (; i < alpha2.length - 1; i++)
term_singletons2(alpha2[i]);
alpha2 = alpha2[i];
} else {
break;
}
}
}
term_singletons2(alpha);
return anon;
}
/**
* Convert a native set into a Prolog list.
*
* @param temp The native set or null.
* @param end The list end.
*/
function set_to_list(temp, end) {
let back = null;
let res = null;
if (temp !== null) {
for (let peek of temp) {
peek = new Compound(".", [peek, undefined]);
if (back === null) {
res = peek;
} else {
back.args[1] = peek;
}
back = peek;
}
}
if (back === null) {
res = end;
} else {
back.args[1] = end;
}
return res;
}
/*********************************************************************/
/* reference/1, \=/2 and acyclic_term/1 */
/*********************************************************************/
/**
* reference(A):
* The built-in succeeds if A is a Prolog reference. Otherwise, it fails.
*/
function test_reference(args) {
let alpha = deref(exec_build(args[0]));
if (is_variable(alpha) || is_compound(alpha))
return false;
if (is_atom(alpha) || is_number(alpha))
return false;
return true;
}
/**
* acyclic_term(T): [TC2 8.3.11]
* The predicate succeeds when the Prolog term T is an acyclic term,
* i.e. contains no cycles.
*/
function test_acyclic(args) {
let alpha = exec_build(args[0]);
return is_acyclic(alpha);
}
/**
* Check whether the given term is acyclic.
* Tail recursive solution.
*
* @param alpha The term.
* @return boolean True if the term is acyclic, otherwise false.
*/
function is_acyclic(alpha) {
let visited = null;
function is_acyclic2(alpha2) {
let undo = null;
for (; ;) {
if (is_variable(alpha2)) {
if (alpha2.instantiated !== undefined) {
if (visited === null) {
visited = new Set();
} else if (visited.has(alpha2)) {
return false;
}
visited.add(alpha2);
if (undo === null)
undo = new Array(0);
undo.push(alpha2);
alpha2 = alpha2.instantiated;
} else {
break;
}
} else if (is_compound(alpha2)) {
alpha2 = alpha2.args;
let i = 0;
for (; i < alpha2.length - 1; i++)
if (!is_acyclic2(alpha2[i]))
return false;
alpha2 = alpha2[i];
} else {
break;
}
}
if (undo !== null)
for (let i = undo.length - 1; i >= 0; i--)
visited.delete(undo[i]);
return true;
}
return is_acyclic2(alpha);
}
/*********************************************************************/
/* callable/1, var/1, nonvar/1, compound/1, atomic/1 and atom/1 */
/*********************************************************************/
/**
* callable(C): [TC2 8.3.9]
* The built-in succeeds if C is a Prolog compound or symbol. Otherwise, it fails.
*/
function test_callable(args) {
let alpha = deref(exec_build(args[0]));
if (is_variable(alpha) || is_number(alpha))
return false;
return true;
}
/**
* var(V): [ISO 8.3.1]
* The built-in succeeds if V is a Prolog variable. Otherwise, it fails.
*/
function test_var(args) {
let alpha = deref(exec_build(args[0]));
return is_variable(alpha);
}
/**
* nonvar(V): [ISO 8.3.7]
* The built-in succeeds if V is not a Prolog variable. Otherwise, it fails.
*/
function test_nonvar(args) {
let alpha = deref(exec_build(args[0]));
return !is_variable(alpha);
}
/**
* compound(C): [ISO 8.3.6]
* The built-in succeeds if V is a Prolog compound. Otherwise, it fails.
*/
function test_compound(args) {
let alpha = deref(exec_build(args[0]));
return is_compound(alpha);
}
/**
* atomic(A): [ISO 8.3.5]
* The built-in succeeds if A is a Prolog symbol or number. Otherwise, it fails.
*/
function test_atomic(args) {
let alpha = deref(exec_build(args[0]));
if (is_compound(alpha) || is_variable(alpha))
return false;
return true;
}
/**
* atom(A): [ISO 8.3.2]
* The built-in succeeds if A is a Prolog atom. Otherwise, it fails.
*/
function test_atom(args) {
let alpha = deref(exec_build(args[0]));
return is_atom(alpha);
}
/*********************************************************************/
/* number/1, integer/1 and float/1 */
/*********************************************************************/
/**
* number(A): [ISO 8.3.8]
* The built-in succeeds if A is a Prolog number. Otherwise, it fails.
*/
function test_number(args) {
let alpha = deref(exec_build(args[0]));
return is_number(alpha);
}
/**
* integer(A): [ISO 8.3.3]
* The built-in succeeds if A is a Prolog integer. Otherwise, it fails.
*/
function test_integer(args) {
let alpha = deref(exec_build(args[0]));
return is_integer(alpha);
}
/**
* float(A): [ISO 8.3.4]
* The built-in succeeds if A is a Prolog float. Otherwise, it fails.
*/
function test_float(args) {
let alpha = deref(exec_build(args[0]));
return is_float(alpha);
}
/*********************************************************************/
/* Number Utilities */
/*********************************************************************/
/**
* Check whether an object is a bigint.
*
* @param alpha The object.
* @return boolean True if the object is a bignum, otherwise false.
*/
export function is_bigint(alpha) {
return typeof alpha === 'bigint';
}
/**
* Normalize a JavaScript smallint. We do not check type obj == "number"
* and Number.isInteger(obj), but this is assumed. The later assumption
* is deliberately violated in truncate/1, etc.. implementation.
*
* @param alpha The smallint.
* @return {number | bigint} The Prolog integer.
*/
export function norm_smallint(alpha) {
if ((-94906266 <= alpha) && (alpha <= 94906266)) {
return alpha;
} else {
return BigInt(alpha);
}
}
/**
* Normalize a JavaScript bigint. We do not check type obj == "biginteger",
* but this is assumed.
*
* @param alpha The bigint.
* @return number The Prolog integer.
*/
export function norm_bigint(alpha) {
if ((-94906266 <= alpha) && (alpha <= 94906266)) {
return Number(alpha);
} else {
return alpha;
}
}
/**
* Widen a Prolog integer.
*
* @param alpha The Prolog integer.
* @return bigint The JavaScript bigint.
*/
export function widen_bigint(alpha) {
if (!is_bigint(alpha)) {
return BigInt(alpha);
} else {
return alpha;
}
}
/**
* Narrow a Prolog number to a float.
*
* @param alpha The Prolog number.
* @return number The JavaScript float.
*/
export function narrow_float(alpha) {
if (is_bigint(alpha)) {
alpha = Number(alpha);
if (Number.isFinite(alpha)) {
return alpha;
} else {
throw make_error(new Compound("evaluation_error", ["float_overflow"]));
}
} else {
return alpha;
}
}
/**
* Normalize a JavaScript float. We do not check type obj == "number"
* but this is assumed.
*
* @param alpha The JavaScript float.
* @return number The Prolog float.
*/
export function norm_float(alpha) {
if ((-94906266 <= alpha) && (alpha <= 94906266)
&& Number.isInteger(alpha)) {
return BigInt(alpha);
} else if (Number.isFinite(alpha)) {
return alpha;
} else if (Number.isNaN(alpha)) {
throw make_error(new Compound("evaluation_error", ["undefined"]));
} else {
throw make_error(new Compound("evaluation_error", ["float_overflow"]));
}
}
/*********************************************************************/
/* code_type/2 and code_numeric/2 */
/*********************************************************************/
/**
* code_type(C, T):
* The predicate succeeds in T with the Unicode general category of C.
* Otherwise, the predicate succeeds in T with 0.
*/
function test_code_type(args) {
let alpha = deref(exec_build(args[0]));
check_integer(alpha);
if (alpha < 0 || alpha > 0x10FFFF) {
alpha = 0; // UNASSIGNED
} else {
alpha = code_type(alpha);
}
return exec_unify(args[1], alpha);
}
/**
* code_numeric(C, V):
* The predicate succeeds in V with the Unicode numeric value of C,
* in case it is integer and between 0 and 35. Otherwise, the predicate
* succeeds in V with -1.
*/
function test_code_numeric(args) {
let alpha = deref(exec_build(args[0]));
check_integer(alpha);
if (alpha < 0 || alpha > 0x10FFFF) {
alpha = -1; // UNASSIGNED
} else {
alpha = code_numeric(alpha);
}
return exec_unify(args[1], alpha);
}
/*********************************************************************/
/* atom_integer/3 */
/*********************************************************************/
/**
* atom_integer(A, R, N):
* If A is a variable, then the built-in succeeds in A with the
* atom for the Prolog integer N in radix R. Otherwise the
* built-in succeeds in N with the Prolog number from the
* atom A in radix R.
*/
function test_atom_integer(args) {
let text = deref(exec_build(args[0]));
let radix = deref(exec_build(args[1]));
check_integer(radix);
if (radix < 2 || radix > 36)
throw make_error(new Compound("domain_error", ["radix", radix]));
if (is_variable(text)) {
let beta = deref(exec_build(args[2]));
check_integer(beta);
beta = atom_integer_encode(beta, radix);
return unify(text, beta);
} else {
check_atom(text);
text = atom_integer_decode(text, radix);
return exec_unify(args[2], text);
}
}
/**
* Encode a Prolog integer to a string.
*
* @param num The Prolog integer.
* @param radix The radix.
* @return string The string.
*/
function atom_integer_encode(num, radix) {
let res;
if (is_bigint(num)) {
res = BigInt(num).toString(radix);
} else {
res = Number(num).toString(radix);
}
return res;
}
/**
* Decode a Prolog integer from a string.
*
* @param text The string
* @param radix The radix.
* @return {number | bigint}The Prolog integer.
*/
function atom_integer_decode(text, radix) {
text = ascii_replace(text, radix, false);
let res;
let step = Math.trunc(52 / (32 - Math.clz32(radix - 1)));
if (text.length <= step) {
res = Number.parseInt(text, radix);
if (isNaN(res))
throw make_error(new Compound("syntax_error", ["illegal_number"]));
res = norm_smallint(res);
} else {
if (0 < text.length && text.charCodeAt(0) === 45) {
res = -bigint_parse(text, 1, step, radix);
} else {
res = bigint_parse(text, 0, step, radix);
}
res = norm_bigint(res);
}
return res;
}
/**
* Parse a bigint in some radix.
*
* @param str The string.
* @param help The start position.
* @param step The chunk size.
* @param radix The radix.
* @return The bigint.
*/
function bigint_parse(str, help, step, radix) {
if (help === str.length)
throw make_error(new Compound("syntax_error", ["illegal_number"]));
let res = BigInt(0);
while (help + step < str.length) {
let temp = Number.parseInt(str.slice(help, help + step), radix);
if (isNaN(temp) || temp < 0)
throw make_error(new Compound("syntax_error", ["illegal_number"]));
res = res * BigInt(radix ** step) + BigInt(temp);
help += step;
}
let temp = Number.parseInt(str.slice(help), radix);
if (isNaN(temp) || temp < 0)
throw make_error(new Compound("syntax_error", ["illegal_number"]));
return res * BigInt(radix ** (str.length - help)) + BigInt(temp);
}
/*********************************************************************/
/* atom_number/2 */
/*********************************************************************/
/**
* atom_number(A, N):
* If A is a variable, then the built-in succeeds in A with the
* atom for the Prolog number N. Otherwise the built-in succeeds in N
* with the Prolog number from the atom A.
*/
function test_atom_number(args) {
let text = deref(exec_build(args[0]));
if (is_variable(text)) {
let beta = deref(exec_build(args[1]));
check_number(beta);
beta = atom_number_encode(beta);
return unify(text, beta);
} else {
check_atom(text);
text = atom_number_decode(text);
return exec_unify(args[1], text);
}
}
/**
* Encode a Prolog number to a string.
*
* @param num The Prolog number.
* @return The string.
*/
function atom_number_encode(num) {
if (is_integer(num)) {
return num.toString();
} else {
num = narrow_float(num);
return shape_number(num.toPrecision(17));
}
}
/**
* Shape the number string so that it has always a period,
* no exponent positive sign and upper case exponent.
*
* @param res The ascii number string
* @return The shaped number string.
*/
function shape_number(res) {
let peek = res.indexOf("e");
if (peek !== -1) {
res = shape_number_mantissa(res.slice(0, peek)) +
"E" + shape_number_exponent(res.slice(peek + 1));
} else {
res = shape_number_mantissa(res);
}
return res;
}
function shape_number_mantissa(res) {
if (res.indexOf(".") !== -1) {
let pos = res.length;
while (res.charCodeAt(pos - 1) === 48) // '0'
pos--;
if (res.charCodeAt(pos - 1) === 46) // '.'
pos++;
if (pos !== res.length)
res = res.slice(0, pos);
}
return res;
}
function shape_number_exponent(res) {
if (0 < res.length && res.charCodeAt(0) === 43) // '+'
res = res.slice(1);
return res;
}
/**
* Decode a Prolog number from a string. Unlike the ISO
* core standard and numbers without a period but with
* an exponent are accepted as float.
*
* @param text The string
* @return The Prolog number.
*/
function atom_number_decode(text) {
text = ascii_replace(text, 10, true);
let res;
if ((text.indexOf(".") !== -1) ||
(text.indexOf("e") !== -1) ||
(text.indexOf("E") !== -1)) {
res = Number(text);
if (isNaN(res))
throw make_error(new Compound("syntax_error", ["illegal_number"]));
res = norm_float(res);
} else {
if (text.length <= 8) {
res = Number(text);
if (isNaN(res))
throw make_error(new Compound("syntax_error", ["illegal_number"]));
res = norm_smallint(res);
} else {
try {
res = BigInt(text);
} catch (e) {
throw make_error(new Compound("syntax_error", ["illegal_number"]));
}
res = norm_bigint(res);
}
}
return res;
}
/*********************************************************************/
/* atom_reference/2 */
/*********************************************************************/
/**
* atom_reference(A, R):
* The built-in succeeds in A with the atom for the Prolog reference R.
*/
function test_atom_reference(args) {
let text = deref(exec_build(args[0]));
if (is_variable(text)) {
let obj = deref(exec_build(args[1]));
if (obj === true) {
obj = "True";
} else if (obj === false) {
obj = "False";
} else if (obj === null) {
obj = "None";
} else {
obj = "Reference";
}
return unify(text, obj);
} else {
check_atom(text);
let obj;
if (text === "True") {
obj = true;
} else if (text === "False") {
obj = false;
} else if (text === "None") {
obj = null;
} else {
obj = undefined;
}
if (obj === undefined)
throw make_error(new Compound("syntax_error", ["illegal_reference"]));
return exec_unify(args[1], obj);
}
}
/*********************************************************************/
/* Number Checkers */
/*********************************************************************/
/**
* Convert and validate Unicode number values
* into capital ASCII number value.
*
* @param text The string.
* @param radix The radix.
* @param expo The float flag.
* @return The The new string.
*/
function ascii_replace(text, radix, expo) {
let buf = "";
let last = 0;
let pos = 0;
while (pos < text.length) {
let ch = text.codePointAt(pos);
let val = code_numeric(ch);
if (val >= 0 && val < radix) {
if (ch <= 127) { // ASCII
/* */
} else {
if (val < 10) {
val += 48; // '0'
} else {
val += 55; // 'A'-10
}
buf += text.slice(last, pos) + String.fromCodePoint(val);
last = pos + char_count(ch);
}
} else if ((ch===43 || ch===45) && (pos===0 ||
(expo && (text.charCodeAt(pos-1)===101 || text.charCodeAt(pos-1)===69)))) {
/* */
} else if (expo && (ch===46 || ch===101 || ch===69)) {
/* */
} else {
throw make_error(new Compound("syntax_error", ["illegal_number"]));
}
pos += char_count(ch);
}
if (last !== 0) {
buf += text.slice(last);
return buf;
} else {
return text;
}
}
/**
* Return the 16-bit char count of a Unicode code point.
*
* @param ch The code point.
* @return number The char count.
*/
export function char_count(ch) {
if (ch <= 0xFFFF) {
return 1;
} else {
return 2;
}
}
/*********************************************************************/
/* Time Formatting */
/*********************************************************************/
/**
* sys_get_locale(L):
* The built-in succeeds in L with the current locale
* of the JavaScript environment.
*/
function test_sys_get_locale(args) {
let loc = Intl.DateTimeFormat().resolvedOptions().locale;
return exec_unify(args[0], loc.replace("-", "_"));
}
/**
* sys_time_atom(F, T, S):
* If A is a variable, the built-in succeeds in A with the millisecond
* time T formatted by the pattern F. Otherwise the built-in succeeds
* in T with the millisecond time parsed from A by the pattern F.
*/
function test_sys_time_atom(args) {
let text = deref(exec_build(args[0]));
check_atom(text);
let tms = deref(exec_build(args[1]));
if (is_variable(tms)) {
let res = deref(exec_build(args[2]));
check_atom(res);
let date = sys_time_parse(res, text);
return unify(tms, norm_smallint(date.getTime()));
} else {
check_integer(tms);
let date = new Date(narrow_float(tms));
return exec_unify(args[2], sys_time_format(text, date));
}
}
/**
* <p>Parse a date time string.</p>
*
* @param res The date time as a string.
* @param pat The pattern.
* @return The date time.
*/
function sys_time_parse(res, pat) {
let year = 1970; let month = 1; let day = 1;
let hour = 0; let minute = 0; let second = 0;
let j = 0;
for (let i = 0; i < pat.length; i++) {
let ch = pat.charCodeAt(i);
if (ch === 37) { // %
i++;
let k;
switch (pat.charCodeAt(i)) {
case 100: // d
k = scan_integer(res, j);
day = Number.parseInt(res.substring(j, k));
j = k;
break;
case 109: // m
k = scan_integer(res, j);
month = Number.parseInt(res.substring(j, k));
j = k;
break;
case 89: // Y
k = scan_integer(res, j);
year = Number.parseInt(res.substring(j, k));
j = k;
break;
case 72: // H
k = scan_integer(res, j);
hour = Number.parseInt(res.substring(j, k));
j = k;
break;
case 77: // M
k = scan_integer(res, j);
minute = Number.parseInt(res.substring(j, k));
j = k;
break;
case 83: // S
k = scan_integer(res, j);
second = Number.parseInt(res.substring(j, k));
j = k;
break;
}
} else {
if (j < res.length && res.charCodeAt(j) === ch)
j++;
}
}
return new Date(year, month - 1, day, hour, minute, second);
}
/**
* <p>Scan integer.</p>
*
* @param res The text.
* @param j The old position.
* @return The new position.
*/
function scan_integer(res, j) {
let ch;
while (j < res.length && 48 <= (ch = res.charCodeAt(j)) && ch <= 57)
j++;
return j;
}
/**
* <p>Format a date time string.</p>
*
* @param pat The format pattern.
* @param date The date time.
* @return The date time as a string.
*/
function sys_time_format(pat, date) {
let buf = "";
let k = 0;
for (let i = 0; i < pat.length; i++) {
let ch = pat.charCodeAt(i);
if (ch === 37) { // %
buf += pat.substring(k, i);
i++;
if (i < pat.length) {
switch (pat.charCodeAt(i)) {
case 100: // d
buf = append_padded(buf, date.getDate());
break;
case 109: // m
buf = append_padded(buf, date.getMonth()+1);
break;
case 89: // Y
buf += date.getFullYear();
break;
case 72: // H
buf = append_padded(buf, date.getHours());
break;
case 77: // M
buf = append_padded(buf, date.getMinutes());
break;
case 83: // S
buf = append_padded(buf, date.getSeconds());
break;
}
k = i + 1;
} else {
k = i;
}
}
}
buf += pat.substring(k, pat.length);
return buf;
}
/**
* Append an integer value zero padded.
*
* @param buf The string builder.
* @param value The integer value.
* @return The string builder.
*/
function append_padded(buf, value) {
if (value < 10)
buf += '0';
buf += value.toString();
return buf;
}
/**
* sys_get_args(L):
* The built-in succeeds in L with the current command
* line arguments of the JavaScript environment.
*/
function test_sys_get_args(args) {
let res = "[]";
if (fs !== undefined) {
for (let i = process.argv.length - 1; i >= 2; i--)
res = new Compound(".", [process.argv[i], res]);
}
return exec_unify(args[0], res);
}
/*********************************************************************/
/* Special Init */
/*********************************************************************/
// Albufeira compiler, control flow
add("fail", 0, make_check(test_fail));
add("$CUT", 1, make_check(test_cut));
add("$MARK", 1, make_check(test_mark));
add("$SEQ", 2, make_special(special_seq));
add("$ALT", 1, make_special(special_alt));
add("sys_raise", 1, make_check(test_sys_raise));
add("sys_trap", 3, make_special(special_sys_trap));
// Albufeira compiler, async flow
add("os_sleep_promise", 2, make_check(test_os_sleep_promise));
add("os_import_promise", 3, make_check(test_os_import_promise));
add("os_invoke_main", 1, make_check(test_os_invoke_main));
add("$YIELD", 1, make_special(special_yield));
add("shield", 1, make_special(special_shield));
add("unshield", 1, make_special(special_unshield));
// term specials
add("=", 2, make_check(test_unify));
add("copy_term", 2, make_check(test_copy_term));
add("=..", 2, make_check(test_univ));
add("functor", 3, make_check(test_functor));
add("arg", 3, make_check(test_arg));
add("change_arg", 3, make_check(test_change_arg));
// object specials
add("ir_object_new", 1, make_check(test_ir_object_new));
add("ir_object_current", 3, make_check(test_ir_object_current));
add("ir_object_set", 3, make_check(test_ir_object_set));
add("ir_object_keys", 2, make_check(test_ir_object_keys));
// variable specials
add("ground", 1, make_check(test_ground));
add("nonground", 2, make_check(test_nonground));
add("term_variables", 3, make_check(test_term_variables));
add("term_singletons", 2, make_check(test_term_singletons));
add("reference", 1, make_check(test_reference));
add("acyclic_term", 1, make_check(test_acyclic));
// type specials
add("callable", 1, make_check(test_callable));
add("var", 1, make_check(test_var));
add("nonvar", 1, make_check(test_nonvar));
add("compound", 1, make_check(test_compound));
add("atomic", 1, make_check(test_atomic));
add("atom", 1, make_check(test_atom));
add("number", 1, make_check(test_number));
add("integer", 1, make_check(test_integer));
add("float", 1, make_check(test_float));
// atom specials
add("code_type", 2, make_check(test_code_type));
add("code_numeric", 2, make_check(test_code_numeric));
add("atom_integer", 3, make_check(test_atom_integer));
add("atom_number", 2, make_check(test_atom_number));
add("atom_reference", 2, make_check(test_atom_reference));
// locale specials
add("sys_get_locale", 1, make_check(test_sys_get_locale));
add("sys_time_atom", 3, make_check(test_sys_time_atom));
add("sys_get_args", 1, make_check(test_sys_get_args));