Prolog "compat"
/**
* 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).
/* call_nth(G, N) */
runner_pred(call_nth,2, calculate, sequence, 'XLOG 2.2.1').
runner_case(call_nth,2, calculate, sequence, 'XLOG 2.2.1, XLOG 1') :-
findall(N, call_nth(between(5, 10, _), N), L),
L == [1,2,3,4,5,6].
runner_case(call_nth,2, calculate, sequence, 'XLOG 2.2.1, XLOG 2') :-
call_nth(between(5, 10, X), 3),
X == 7.
runner_case(call_nth,2, calculate, sequence, 'XLOG 2.2.1, XLOG 3') :-
\+ call_nth(repeat, 0).
runner_case(call_nth,2, calculate, sequence, 'XLOG 2.2.1, XLOG 4') :-
catch(call_nth(_,_), error(E,_), true),
E == instantiation_error.
/****************************************************************/
/* 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_singletons(S, T) */
runner_pred(term_singletons,2, common, compat, 'XLOG 2.2.3').
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.3, XLOG 1') :-
term_singletons(t, L),
L == [].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.3, XLOG 2') :-
term_singletons(a([],X), L),
L == [X].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.3, XLOG 3') :-
C = 3.3*A, term_singletons(A+B/C, L),
L == [B].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.3, XLOG 4') :-
Y = g(_,_), X = f(Y,C,D,Y), term_singletons(X, L),
L == [C,D].
runner_case(term_singletons,2, common, compat, 'XLOG 2.2.3, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
Y = g(A,X,B), X = f(Y,C,D), term_singletons(X, L),
L == [A,B,C,D].
/* 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 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 8') :-
\+ unify_with_occurs_check(1, 1.0).
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 13') :-
\+ unify_with_occurs_check(f(X, 1), f(a(X), 1)).
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)).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, XLOG 1') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X,_), unify_with_occurs_check(X, _).
runner_case(unify_with_occurs_check, 2, common, compat, 'ISO 8.2.2.4, XLOG 2') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X,A), \+ unify_with_occurs_check(X, A).
/****************************************************************/
/* Cyclic Terms */
/****************************************************************/
/* ground(X) */
runner_pred(ground, 1, common, compat, 'Corr.2 8.3.10.4').
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, ISO 1') :-
ground(1.0).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 1') :-
X = a(b), Y = c(X,X,X), ground(Y).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 2') :-
X = a(b), Y = c(X,_,X), \+ ground(Y).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 3') :-
\+ ground(_).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 4') :-
ground([]).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
Y = f(a, Y), ground(Y).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 6') :-
\+ current_prolog_flag(dialect, gprolog),
Y = f(a, Y), X = g(Y, b, _), \+ ground(X).
/* nonground(X, Y) */
runner_pred(nonground,2, common, compat, 'XLOG 2.2.4').
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 1') :-
\+ nonground(foo, _).
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 2') :-
nonground(a(1,X), Z), Z == X.
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 3') :-
nonground(bar(X,_,X),Z), Z == X.
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 4') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(g(X,A),_), nonground(X, Y), Y == A.
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
Y = g(f(Y,B),_), X = f(Y,B), nonground(X, Z), Z == B.
/* number_codes(X, Y) */
runner_pred(number_codes, 2, common, compat, 'ISO 8.16.8.4').
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 1') :-
number_codes(33, L), L == "33".
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 2') :-
number_codes(33, "33").
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 3') :-
number_codes(33.0, L), L == "33.0".
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 5') :-
number_codes(A, "-25"), A == -25.
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, XLOG 2') :-
catch(number_codes(_, " 3"), error(E,_), true),
E == syntax_error(illegal_number).
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 7') :-
catch(number_codes(_, "0xf"), error(E,_), true),
E == syntax_error(illegal_number).
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 8') :-
catch(number_codes(_, "0'a"), error(E,_), true),
E == syntax_error(illegal_number).
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 9') :-
number_codes(A, "4.2"), A == 4.2.
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, ISO 10') :-
number_codes(A, "42.0e-1"), A == 4.2.
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, XLOG 3') :-
catch(number_codes(_, "0X1"), error(E,_), true),
E == syntax_error(illegal_number).
runner_case(number_codes, 2, common, compat, 'ISO 8.16.8.4, XLOG 4') :-
catch(number_codes(_,_), error(E,_), true),
E == instantiation_error.
/* term_hash(X, Y) */
runner_pred(term_hash,2, common, compat, 'XLOG 2.2.5').
runner_case(term_hash,2, common, compat, 'XLOG 2.2.5, XLOG 1') :-
X = "abc", term_hash(X, H),
H == 144646.
runner_case(term_hash,2, common, compat, 'XLOG 2.2.5, XLOG 2') :-
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.5, XLOG 3') :-
X is -(2^41*3), term_hash(X, H),
H = -47616.
runner_case(term_hash,2, common, compat, 'XLOG 2.2.5, XLOG 4') :-
\+ current_prolog_flag(dialect, gprolog),
X = [97, 98, 99|X], term_hash(X, H),
H == 141732.
runner_case(term_hash,2, common, compat, 'XLOG 2.2.5, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X,a), Y = g(b,X,Y), term_hash(Y, H),
H == 6204340.
/* numbervars(T, N, M) */
runner_pred(numbervars, 3, common, compat, 'XLOG 2.2.6').
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.6, 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.6, 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.6, 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.6, XLOG 4') :-
catch(numbervars(_, a, _), error(E, _), true),
nonvar(E), E = type_error(integer,_).
runner_case(numbervars, 3, common, compat, 'XLOG 2.2.6, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X,Z,Y), numbervars(X, 0, T),
Z == '$VAR'(0), Y == '$VAR'(1), T == 2.
/* unnumbervars(S, T) */
runner_pred(unnumbervars, 2, common, compat, 'XLOG 2.2.7').
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.7, XLOG 1') :-
unnumbervars(f(abc, X), 0, T),
T == f(abc, X).
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.7, 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.7, 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.7, 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.7, 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.
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.7, XLOG 6') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X, g('$VAR'(0), X), '$VAR'(1)), unnumbervars(X, 0, T),
T = f(T, g(A, T), B),
var(A), var(B), A \== B.