/**
* 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, equal_term, list_objects, objects_list,
compare_term, Compound, exec_unify, is_compound,
make_error, add, make_check, deref, check_nonvar,
copy_term, check_callable, Cache, check_atom
} from "../nova/core.mjs";
/******************************************************************/
/* sort/2 and keysort/2 */
/******************************************************************/
/**
* sort(L, R): [TC2 8.4.3]
* The predicate succeeds in R with the sorted list L.
*/
function test_sort(args) {
let alpha = deref(exec_build(args[0]));
let res = list_objects(alpha);
res.sort(compare_term);
let count = objects_dedup(res);
return exec_unify(args[1], objects_list(res, 0, count));
}
function objects_dedup(res) {
let j = 0;
let i = 0;
while (i < res.length) {
let alpha = res[i++];
while (i < res.length && equal_term(alpha, res[i]))
i++;
res[j++] = alpha;
}
return j;
}
/**
* keysort(L, R): [TC2 8.4.4]
* The predicate succeeds in R with the key sorted list L.
*/
function test_keysort(args) {
let alpha = deref(exec_build(args[0]));
let res = list_objects(alpha);
objects_pairs(res);
res.sort((first, second) => compare_term(get_key(first), get_key(second)));
return exec_unify(args[1], objects_list(res, 0, res.length));
}
function objects_pairs(res) {
for (let i = 0; i < res.length; i++) {
let alpha = res[i];
if (is_compound(alpha) &&
"-" === alpha.functor &&
alpha.args.length === 2) {
/* */
} else {
check_nonvar(alpha);
alpha = copy_term(alpha);
throw make_error(new Compound("type_error",
["pair", alpha]));
}
}
}
function get_key(peek) {
return peek.args[0];
}
/******************************************************************/
/* ir_call_site/2 */
/******************************************************************/
/**
* ir_call_site(F, T):
* The predicate succeeds in T with a
* cachable version of the callable F.
*/
function test_ir_call_site(args) {
let alpha = deref(exec_build(args[0]));
check_callable(alpha);
let res;
if (is_compound(alpha)) {
let functor = alpha.functor;
check_atom(functor);
let oldargs = alpha.args;
res = new Compound(new Cache(functor), oldargs);
} else {
check_atom(alpha);
res = new Cache(alpha);
}
return exec_unify(args[1], res);
}
/*********************************************************************/
/* Iso Lib Init */
/*********************************************************************/
export function main() {
add("sort", 2, make_check(test_sort));
add("keysort", 2, make_check(test_keysort));
add("ir_call_site", 2, make_check(test_ir_call_site));
}
