Prolog "compat"
Admin User, erstellt 06. Apr. 2025
/**
* 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.
*/
/**
* Source of test cases are the following standards and proposals:
* - New built-in flags, predicates, and functions proposal
* <a href="https://www.complang.tuwien.ac.at/ulrich/iso-prolog/N208">www.complang.tuwien.ac.at/ulrich/iso-prolog/N208</a>
*/
runner_file(common, compat, 'XLOG 2.2 compat').
/*******************************************************************/
/* compat.p */
/*******************************************************************/
/* forall(G, T) */
alpha(1). alpha(2). alpha(3).
beta(1, a). beta(2, b). beta(3, c).
runner_pred(forall, 2, common, compat, 'N208 8.10.4').
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 1') :-
forall(fail, true).
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 2') :-
forall(alpha(X), beta(X, _)).
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 3') :-
\+ forall(alpha(X), beta(_, X)).
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 4') :-
Y = foo(A,B,C), forall(between(1, 3, X), arg(X, Y ,X)),
Y == foo(A,B,C).
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 5') :-
catch(forall(_, beta(_, _)), error(E,_), true),
E == instantiation_error.
runner_case(forall, 2, common, compat, 'N208 8.10.4, XLOG 6') :-
catch(forall(alpha(_), 1), error(E,_), true),
E == type_error(callable,1).
/* numbervars(T, N, M) */
runner_pred(numbervars, 3, common, compat, 'XLOG 2.2.1').
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.1, XLOG 1') :-
numbervars(f(X,X,Y), 0, N),
X == '$VAR'(0), Y == '$VAR'(1), N == 2.
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.1, XLOG 2') :-
numbervars(f(Y,X,X), 10, N),
Y == '$VAR'(10), X == '$VAR'(11), N == 12.
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.1, XLOG 3') :-
numbervars(f(X,g(Y,X),Y), 0, _),
X == '$VAR'(0), Y == '$VAR'(1).
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.1, XLOG 4') :-
catch(numbervars(_, a, _), error(E, _), true),
nonvar(E), E = type_error(integer,_).
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.1, XLOG 5') :-
catch(numbervars(_, -2, _), error(E, _), true),
E == domain_error(not_less_than_zero, -2).
/****************************************************************/
/* term.p extras */
/****************************************************************/
/* subsumes(X, Y) */
runner_pred(subsumes,2, common, compat, 'XLOG 2.2.2').
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 1') :-
subsumes(a, a).
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 2') :-
subsumes(f(A,Z), f(B,Z)), A == B.
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 3') :-
subsumes(f(A,B), f(Z,Z)), A == Z, B == Z.
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 4') :-
\+ subsumes(f(_,A), f(A,_)).
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 5') :-
\+ subsumes(g(X), g(f(X))).
runner_case(subsumes,2, common, compat, 'XLOG 2.2.2, ISO 6') :-
subsumes(X, Y), \+ subsumes(Y, f(X)).
/* subsumes_term(X, Y) */
runner_pred(subsumes_term, 2, common, compat, 'ISO 8.2.4.4').
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 1') :-
subsumes_term(a, a).
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 2') :-
subsumes_term(f(A,Z), f(B,Z)), A \== B.
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 3') :-
subsumes_term(f(A,B), f(Z,Z)), A \== Z, B \== Z.
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 4') :-
\+ subsumes_term(f(_,A), f(A,_)).
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 5') :-
\+ subsumes_term(g(X), g(f(X))).
runner_case(subsumes_term, 2, common, compat, 'ISO 8.2.4.4, ISO 6') :-
subsumes_term(X, Y), subsumes_term(Y, f(X)).
/* term_hash(X, Y) */
runner_pred(term_hash, 2, common, compat, 'XLOG 2.2.3').
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 1') :-
X is pi, term_hash(X, H),
H == 340593891.
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 2') :-
X is 2^40-1, term_hash(X, H),
H == 7904.
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 3') :-
X = 'abc', term_hash(X, H),
H == 96354.
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 4') :-
X = "abc", term_hash(X, H),
H == 697975686.
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 5') :-
current_input(C), term_hash(C, X),
integer(X).
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 6') :-
term_hash(f, J), term_hash(X, H), term_hash(f(X), K),
K =:= J*31+H.
runner_case(term_hash, 2, common, compat, 'XLOG 2.2.3, XLOG 7') :-
X is -(2^41*3), term_hash(X, H),
H = -47616.
/* term_singletons(S, T) */
runner_pred(term_singletons,2, common, compat, 'XLOG 2.2.4').
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.4, XLOG 1') :-
term_singletons(t, L), L == [].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.4, XLOG 2') :-
term_singletons(a([],X), L), L == [X].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.4, XLOG 3') :-
C=3.3*A, term_singletons(A+B/C, L), L == [B].
/* nonground(X, Y) */
runner_pred(nonground,2, common, compat, 'XLOG 2.2.5').
runner_case(nonground,2, common, compat, 'XLOG 2.2.5, XLOG 1') :-
\+ nonground(foo, _).
runner_case(nonground,2, common, compat, 'XLOG 2.2.5, XLOG 2') :-
nonground(bar(X,_,X),Z), Z == X.
/* unnumbervars(S, T) */
runner_pred(unnumbervars, 2, common, compat, 'XLOG 2.2.6').
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.6, XLOG 1') :-
unnumbervars(f(abc, X), 0, T),
T == f(abc, X).
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.6, XLOG 2') :-
unnumbervars(f([123, '$VAR'(0)], ['$VAR'(0), 3.1415]), 0, T),
T = f([123, B], [B, 3.1415]), var(B).
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.6, XLOG 3') :-
unnumbervars(f('$VAR'(0), g('$VAR'(1), '$VAR'(0)), '$VAR'(1)), 0, T),
T = f(A, g(B, A), B), var(A), var(B), A \== B.
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.6, XLOG 4') :-
unnumbervars(f(X, g(Y, X), Y), 0, T),
T == f(X, g(Y, X), Y).
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.6, XLOG 5') :-
unnumbervars(f(X, g('$VAR'(0), X), '$VAR'(1)), 0, T),
T = f(C, g(A, D), B),
var(A), var(B), A \== B,
C == X, D == X, X \== A, X \== B.
/* unify_with_occurs_check(X, Y) */
runner_pred(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4').
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 1') :-
unify_with_occurs_check(1, 1).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 2') :-
unify_with_occurs_check(X, 1), X==1.
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 3') :-
unify_with_occurs_check(X, Y), X==Y.
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 4') :-
unify_with_occurs_check(_, _).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 5') :-
unify_with_occurs_check(X, Y), unify_with_occurs_check(X, abc), X==abc, Y==abc.
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 6') :-
unify_with_occurs_check(f(X,def), f(def,Y)), X==def, Y==def.
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 7') :-
\+ unify_with_occurs_check(1, 2).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 8') :-
\+ unify_with_occurs_check(1, 1.0).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 9') :-
\+ unify_with_occurs_check(g(X), f(f(X))).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 10') :-
\+ unify_with_occurs_check(f(X, 1), f(a(X))).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 11') :-
\+ unify_with_occurs_check(f(X, Y, X), f(a(X), a(Y), Y, 2)).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 12') :-
\+ unify_with_occurs_check(X, a(X)).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 13') :-
\+ unify_with_occurs_check(f(X, 1), f(a(X), 2)).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 14') :-
\+ unify_with_occurs_check(f(1, X, 1), f(2, a(X), 2)).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 15') :-
\+ unify_with_occurs_check(f(1, X), f(2, a(X))).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, ISO 16') :-
\+ unify_with_occurs_check(f(X, Y, X, 1), f(a(X), a(Y), Y, 2)).
/* call(C, X, Y) */
makepair(X, Y, X-Y).
runner_pred(call, 3, common, compat, 'Corr.2 8.15.4.4').
runner_case(call, 3, common, compat, 'Corr.2 8.15.4.4, ISO 1') :-
call(integer, 3).
runner_case(call, 3, common, compat, 'Corr.2 8.15.4.4, ISO 2') :-
call(functor(F, c), 0),
F == c.
runner_case(call, 3, common, compat, 'Corr.2 8.15.4.4, ISO 4') :-
findall(X, call(;, X=1, X=2), L),
L == [1,2].
runner_case(call, 3, common, compat, 'Corr.2 8.15.4.4, XLOG 1') :-
call(call(call(makepair,1),2),X),
X == 1-2.
runner_case(call, 3, common, compat, 'Corr.2 8.15.4.4, XLOG 2') :-
catch(call(',', integer(1), 3), error(E,_), true),
E == type_error(callable, 3).