Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
package foreign;
import nova.Machine;
import nova.Store;
import nova.envir.ComputeCompare;
import nova.envir.ComputeElem;
import nova.special;
import java.math.BigInteger;
import java.util.*;
/**
* Foreign functions for library(compat)
* <p/>
* 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.
* <p/>
* 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.
* <p/>
* 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.
* <p/>
* 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.
* <p/>
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
public final class fastlib {
/******************************************************************/
/* numbervars/3 */
/******************************************************************/
/**
* numbervars(X, N, M):
* The predicate instantiates the un-instantiated variables of
* the term X with compounds of the form ‘$VAR’(<index>). The
* <index> starts with N. The predicate succeeds when M unifies
* with the next available <index>.
*/
private static boolean test_numbervars(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
Object beta = Machine.deref(Machine.exec_build(args[1]));
special.check_integer(beta);
if (ComputeCompare.integer_signum((Number) beta) < 0)
throw Machine.make_error(new Store.Compound("domain_error",
new Object[]{"not_less_than_zero", beta}));
beta = new numbervars().call(alpha, (Number) beta);
return Machine.exec_unify(args[2], beta);
}
private static class numbervars {
private Number beta;
private void numbervars2(Object alpha2) {
for (; ; ) {
alpha2 = Machine.deref(alpha2);
if (Store.is_variable(alpha2)) {
Machine.bind(new Store.Compound("$VAR", new Object[]{beta}), (Store.Variable)alpha2);
beta = succ(beta);
break;
} else if (Store.is_compound(alpha2)) {
Object[] temp = ((Store.Compound) alpha2).args;
int i = 0;
for (; i < temp.length - 1; i++)
numbervars2(temp[i]);
alpha2 = temp[i];
} else {
break;
}
}
}
private Number call(Object alpha, Number v) {
beta = v;
numbervars2(alpha);
return beta;
}
}
private static Number succ(Number beta) {
if (beta instanceof Integer) {
return ComputeElem.norm_smallint((long) beta.intValue() + 1);
} else {
return ComputeElem.norm_bigint(((BigInteger)beta).add(BigInteger.ONE));
}
}
/******************************************************************/
/* unify_with_occurs_check/2 */
/******************************************************************/
/**
* unify_with_occurs_check(S, T): [ISO 8.2.2]
* The built-in succeeds when the Prolog terms S and T unify
* with occurs check, otherwise the built-in fails.
*/
private static boolean test_unify_checked(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
Object beta = Machine.exec_build(args[1]);
return unify_checked(alpha, beta);
}
/**
* Determine whether two terms unify with occurs check.
* As a side effect the trail is extended, even if unification fails.
* Tail recursive solution.
*
* @param first The first term.
* @param second The second term.
* @return boolean True if the two terms unify, otherwise false.
*/
private static boolean unify_checked(Object first, Object second) {
for (; ; ) {
first = Machine.deref(first);
second = Machine.deref(second);
if (Store.is_variable(first)) {
if (Store.is_variable(second) && first == second)
return true;
if (has_var(first, second))
return false;
Machine.bind(second, (Store.Variable) first);
return true;
}
if (Store.is_variable(second)) {
if (has_var(second, first))
return false;
Machine.bind(first, (Store.Variable) second);
return true;
}
if (!Store.is_compound(first))
return Objects.equals(first, second);
if (!Store.is_compound(second))
return false;
Object[] t1 = ((Store.Compound) first).args;
Object[] t2 = ((Store.Compound) second).args;
if (t1.length != t2.length)
return false;
if (!((Store.Compound) first).functor.equals(((Store.Compound) second).functor))
return false;
int i = 0;
for (; i < t1.length - 1; i++) {
if (!unify_checked(t1[i], t2[i]))
return false;
}
first = t1[i];
second = t2[i];
}
}
/**
* Check whether a variable occurs in a term.
* Tail recursive solution.
*
* @param term The variable.
* @param source The Prolog term.
* @return boolean True if term occurs in source, otherwise false.
*/
private static boolean has_var(Object term, Object source) {
for (; ; ) {
source = Machine.deref(source);
if (Store.is_variable(source)) {
return (term == source);
} else if (Store.is_compound(source)) {
Object[] temp = ((Store.Compound) source).args;
int i = 0;
for (; i < temp.length - 1; i++)
if (has_var(term, temp[i]))
return true;
source = temp[i];
} else {
return false;
}
}
}
/******************************************************************/
/* subsumes/2 */
/******************************************************************/
/**
* subsumes(X, Y): [N208 8.2.4]
* The built-in succeeds if X subsumes Y.
*/
private static boolean test_subsumes(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
Object beta = Machine.exec_build(args[1]);
return subsumes(beta, alpha, beta);
}
/**
* Determine whether two terms single side unify.
* As a side effect the trail is extended, even if unification fails.
* Tail recursive solution.
*
* @param root The root of the second term.
* @param first The first term.
* @param second The second term.
* @return boolean True if the two terms single side unify, otherwise false.
*/
private static boolean subsumes(Object root, Object first, Object second) {
for (; ; ) {
first = Machine.deref(first);
second = Machine.deref(second);
if (Store.is_variable(first)) {
if (Store.is_variable(second) && first == second)
return true;
if (has_var(first, root))
return false;
Machine.bind(second, (Store.Variable) first);
return true;
}
if (Store.is_variable(second))
return false;
if (!Store.is_compound(first))
return Objects.equals(first, second);
if (!Store.is_compound(second))
return false;
Object[] t1 = ((Store.Compound) first).args;
Object[] t2 = ((Store.Compound) second).args;
if (t1.length != t2.length)
return false;
if (!((Store.Compound) first).functor.equals(((Store.Compound) second).functor))
return false;
int i = 0;
for (; i < t1.length - 1; i++) {
if (!subsumes(root, t1[i], t2[i]))
return false;
}
first = t1[i];
second = t2[i];
}
}
/******************************************************************/
/* term_hash/2 */
/******************************************************************/
/**
* term_hash(X, H):
* The predicate succeeds in H with the hash of the term X.
*/
private static boolean test_term_hash(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
int res = new term_hash().call(alpha);
return Machine.exec_unify(args[1], Integer.valueOf(res));
}
private static class term_hash {
private int res;
private void term_hash2(Object alpha) {
for (; ; ) {
alpha = Machine.deref(alpha);
if (Store.is_variable(alpha)) {
res = res * 31 + (((Store.Variable)alpha).flags & ~Machine.VAR_MASK_STATE);
return;
}
if (!Store.is_compound(alpha)) {
res = res * 31 + hash_code(alpha);
return;
}
Object[] args = ((Store.Compound) alpha).args;
res = res * 31 + hash_code(((Store.Compound) alpha).functor);
int i = 0;
for (; i < args.length - 1; i++)
term_hash2(args[i]);
alpha = args[i];
}
}
private int call(Object alpha) {
term_hash2(alpha);
return res;
}
}
/**
* Compute the hash code of an atomic
*
* @param alpha The term.
* @return The hash code, a signed 32-bit integer
*/
private static int hash_code(Object alpha) {
if (Machine.is_atom(alpha) || Machine.is_number(alpha)) {
return alpha.hashCode();
} else {
if (alpha == Boolean.TRUE) {
return 1;
} else if (alpha == Boolean.FALSE) {
return 0;
} else if (alpha == null) {
return -1;
} else {
return -2;
}
}
}
/******************************************************************/
/* term_singletons/2 and nonground/2 */
/******************************************************************/
/**
* term_singletons(T, L):
* The built-in succeeds in L with the singleton variables of T.
*/
private static boolean test_term_singletons(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
Set<Store.Variable> temp = new term_singletons().call(alpha);
alpha = special.set_to_list(temp);
return Machine.exec_unify(args[1], alpha);
}
private static class term_singletons {
private Set<Store.Variable> res = null;
private Set<Store.Variable> anon = null;
private void term_singletons2(Object alpha2) {
for (; ; ) {
alpha2 = Machine.deref(alpha2);
if (Store.is_variable(alpha2)) {
Store.Variable peek = (Store.Variable) alpha2;
if (res == null) {
res = new HashSet<>();
anon = new LinkedHashSet<>();
}
if (res.contains(peek)) {
anon.remove(peek);
} else {
res.add(peek);
anon.add(peek);
}
break;
} else if (Store.is_compound(alpha2)) {
Object[] peek = ((Store.Compound) alpha2).args;
int i = 0;
for (; i < peek.length - 1; i++)
term_singletons2(peek[i]);
alpha2 = peek[i];
} else {
break;
}
}
}
private Set<Store.Variable> call(Object alpha) {
term_singletons2(alpha);
return anon;
}
}
/**
* nonground(T, V):
* The built-in succeeds if T is non-ground and V is the first variable.
*/
private static boolean test_nonground(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
alpha = first_variable(alpha);
if (alpha == null)
return false;
return Machine.exec_unify(args[1], alpha);
}
private static Store.Variable first_variable(Object alpha) {
for (; ; ) {
alpha = Machine.deref(alpha);
if (Store.is_variable(alpha)) {
return (Store.Variable) alpha;
} else if (Store.is_compound(alpha)) {
Object[] peek = ((Store.Compound) alpha).args;
int i = 0;
for (; i < peek.length - 1; i++) {
Store.Variable res = first_variable(peek[i]);
if (res != null)
return res;
}
alpha = peek[i];
} else {
return null;
}
}
}
/******************************************************************/
/* unnumbervars/4 */
/******************************************************************/
/**
* unnumbervars(S, N, T):
* The predicate succeeds in T with a copy of S with compounds of
* the form ‘$VAR’(<index>) and <index> greater or equal N are
* replaced by fresh variables.
*/
private static boolean test_unnumbervars(Object[] args) {
Object alpha = Machine.exec_build(args[0]);
Object beta = Machine.deref(Machine.exec_build(args[1]));
special.check_integer(beta);
if (ComputeCompare.integer_signum((Number) beta) < 0)
throw Machine.make_error(new Store.Compound("domain_error",
new Object[]{"not_less_than_zero", beta}));
alpha = new unnumbervars().call(alpha, (Number) beta);
return Machine.exec_unify(args[2], alpha);
}
private static class unnumbervars {
private Number beta;
private ArrayList<Store.Variable> assoc;
private Object unnumbervars2(Object alpha) {
Store.Compound back = null;
for (; ; ) {
alpha = Machine.deref(alpha);
if (Store.is_variable(alpha)) {
break;
} else if (Store.is_compound(alpha)) {
if ("$VAR".equals(((Store.Compound) alpha).functor) &&
((Store.Compound) alpha).args.length == 1) {
Object beta2 = Machine.deref(((Store.Compound) alpha).args[0]);
if (Machine.is_integer(beta2) &&
ComputeCompare.integer_compare(beta, (Number)beta2) <= 0) {
beta2 = ComputeElem.subtract((Number)beta2, beta);
int pos = (!special.is_bigint(beta2) ? ((Integer) beta2).intValue() : -1);
if (assoc == null)
assoc = new ArrayList<>();
while (assoc.size() <= pos)
assoc.add(new Store.Variable());
alpha = assoc.get(pos);
break;
}
}
Object[] t1 = ((Store.Compound) alpha).args;
Object[] args = new Object[t1.length];
alpha = new Store.Compound(((Store.Compound) alpha).functor, args);
int i = 0;
for (; i < args.length - 1; i++)
args[i] = unnumbervars2(t1[i]);
args[i] = back;
back = (Store.Compound) alpha;
alpha = t1[i];
} else {
break;
}
}
while (back != null) {
Object peek = back.args[back.args.length - 1];
back.args[back.args.length - 1] = alpha;
alpha = back;
back = (Store.Compound) peek;
}
return alpha;
}
private Object call(Object alpha, Number v) {
beta = v;
return unnumbervars2(alpha);
}
}
/******************************************************************/
/* call/2-4 */
/******************************************************************/
/**
* call(F, A1, .., An): [Corr.2 8.15.4.4]
* The predicate succeeds in calling the goal which results from
* appending the arguments A1, .., An to the callable F.
*/
private static Object special_call(Object[] args) {
Object alpha = Machine.deref(args[0]);
Machine.check_callable(alpha);
Object functor;
Object[] oldargs;
if (Store.is_compound(alpha)) {
functor = ((Store.Compound) alpha).functor;
oldargs = ((Store.Compound) alpha).args;
} else {
functor = alpha;
oldargs = Machine.VOID_ARGS;
}
int arity = oldargs.length + args.length - 1;
Object goal;
if (arity == 0) {
goal = functor;
} else {
Object[] newargs = new Object[arity];
for (int i = 0; i < oldargs.length; i++)
newargs[i] = Machine.deref(oldargs[i]);
for (int i = 0; i < args.length - 1; i++)
newargs[i + oldargs.length] = Machine.deref(args[i + 1]);
goal = new Store.Compound(functor, newargs);
}
Object res = ((Store.Compound) Machine.call).args[1];
res = new Store.Compound(".", new Object[]{goal, res});
Machine.cont(res);
return Boolean.TRUE;
}
/******************************************************************/
/* Fast Lib Init */
/******************************************************************/
public static void main() {
Store.add("numbervars", 3, special.make_check(fastlib::test_numbervars));
Store.add("unify_with_occurs_check", 2, special.make_check(fastlib::test_unify_checked));
Store.add("subsumes", 2, special.make_check(fastlib::test_subsumes));
Store.add("term_hash", 2, special.make_check(fastlib::test_term_hash));
Store.add("term_singletons", 2, special.make_check(fastlib::test_term_singletons));
Store.add("nonground", 2, special.make_check(fastlib::test_nonground));
Store.add("unnumbervars", 3, special.make_check(fastlib::test_unnumbervars));
Store.add("call", 2, special.make_special(fastlib::special_call));
Store.add("call", 3, special.make_special(fastlib::special_call));
Store.add("call", 4, special.make_special(fastlib::special_call));
Store.add("call", 5, special.make_special(fastlib::special_call));
Store.add("call", 6, special.make_special(fastlib::special_call));
Store.add("call", 7, special.make_special(fastlib::special_call));
Store.add("call", 8, special.make_special(fastlib::special_call));
}
}