/**
* 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 {
exec_build, is_variable, exec_unify, make_check,
set, set_to_list, widen_bigint, exec_eval,
norm_bigint, VAR_MASK_SEEN, make_arithmetic,
check_integer, walk_compute, walk_uncompute,
walk_vars, Compound, is_bigint, make_error
} from "../nova/core.mjs";
/*********************************************************************/
/* term_singletons2/2 */
/*********************************************************************/
/**
* 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]);
let res;
try {
res = walk_compute(alpha, init_map, union_map);
} finally {
walk_uncompute(alpha);
}
for (let [key, val] of res) {
if (val)
res.delete(key);
}
res = set_to_list(res.keys());
return exec_unify(args[1], res);
}
let EMPTY_MAP = new Map();
function init_map(first) {
if (is_variable(first)) {
return new Map([[first, false]]);
} else {
return EMPTY_MAP;
}
}
function union_map(first, second) {
if (first.size === 0)
return second;
if (second.size === 0)
return first;
first = new Map(first);
for (let [key, val] of second) {
let value = first.get(key);
if (value !== undefined) {
value = true;
} else {
value = val;
}
first.set(key, value);
}
return first;
}
/******************************************************************/
/* 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]);
let res = walk_vars(alpha, node => true, VAR_MASK_SEEN);
walk_vars(alpha, node => true, 0);
return !res;
}
/**
* 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]);
let hit = undefined;
function nonground2(node) {
hit = node;
return true;
}
let res = walk_vars(alpha, nonground2, VAR_MASK_SEEN);
walk_vars(alpha, node => true, 0);
return res && exec_unify(args[1], hit);
}
/*********************************************************************/
/* divmod/4 and gcd/3 */
/*********************************************************************/
/**
* divmod(X, Y, Z, T):
* If X and Y are both integers then the predicate succeeds in
* Z with the division of X by Y, and in T with the modulo of X by Y.
*/
function test_divmod(args) {
let alpha = exec_build(args[0]);
check_integer(alpha);
let beta = exec_build(args[1]);
check_integer(beta);
let resdiv;
let resmod;
if (!is_bigint(alpha) && !is_bigint(beta)) {
if (beta === 0)
throw make_error(new Compound("evaluation_error",["zero_divisor"]));
resdiv = Math.floor(alpha / beta);
resmod = alpha - resdiv*beta;
} else {
alpha = widen_bigint(alpha);
beta = widen_bigint(beta);
if (beta === 0n)
throw make_error(new Compound("evaluation_error",["zero_divisor"]));
resdiv = bigint_div(alpha, beta);
resmod = alpha - resdiv*beta;
resdiv = norm_bigint(resdiv);
resmod = norm_bigint(resmod);
}
if (!exec_unify(args[2], resdiv))
return false;
return exec_unify(args[3], resmod);
}
function bigint_div(alpha, beta) {
let temp = alpha / beta;
if ((alpha < 0n) !== (beta < 0n)) {
let res = alpha % beta;
if (res !== 0n)
temp--;
}
return temp;
}
/**
* gcd(X, Y, Z):
* If X and Y are integers then the predicate succeeds in Z
* with the greatest common divisor of X and Y.
*/
function arit_gcd(args) {
let alpha = exec_eval(args[0]);
check_integer(alpha);
let beta = exec_eval(args[1]);
check_integer(beta);
if (!is_bigint(alpha) && !is_bigint(beta)) {
return intGcd(alpha, beta);
} else {
return norm_bigint(
bigIntGcd(widen_bigint(alpha),
widen_bigint(beta)));
}
}
function intGcd(a, b) {
a = Math.abs(a);
b = Math.abs(b);
while (b !== 0) {
let h = a % b;
a = b;
b = h;
}
return a;
}
function bigIntGcd(a, b) {
a = (a < 0n ? -a : a);
b = (b < 0n ? -b : b);
while (b !== 0n) {
let h = a % b;
a = b;
b = h;
}
return a;
}
/*********************************************************************/
/* Fast Lib Init */
/*********************************************************************/
export function main() {
set("term_singletons", 2, make_check(test_term_singletons));
set("ground", 1, make_check(test_ground));
set("nonground", 2, make_check(test_nonground));
set("divmod", 4, make_check(test_divmod));
set("gcd", 3, make_arithmetic(arit_gcd));
}