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).
/* 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') :-
\+ current_prolog_flag(dialect, gprolog),
X = f(X,Z,Y), numbervars(X, 0, T),
Z == '$VAR'(0), Y == '$VAR'(1), T == 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_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].
/* unnumbervars(S, T) */
runner_pred(unnumbervars, 2, common, compat, 'XLOG 2.2.4').
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.4, XLOG 1') :-
unnumbervars(f(abc, X), 0, T),
T == f(abc, X).
runner_case(unnumbervars, 2, common, compat, 'XLOG 2.2.4, 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.4, 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.4, 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.4, 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.4, 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.
/* 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).
/* 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).
/****************************************************************/
/* 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.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(a(1,X), Z), Z == X.
runner_case(nonground,2, common, compat, 'XLOG 2.2.5, XLOG 3') :-
nonground(bar(X,_,X),Z), Z == X.
runner_case(nonground,2, common, compat, 'XLOG 2.2.5, 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.5, XLOG 5') :-
\+ current_prolog_flag(dialect, gprolog),
Y = g(f(Y,B),_), X = f(Y,B), nonground(X, Z), Z == B.
/* acyclic_term(X) */
runner_pred(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4').
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, ISO 1') :-
acyclic_term(a(_,1)).
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, ISO 2') :-
X = f(X), \+ acyclic_term(X).
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, XLOG 1') :-
X = f(X), Y = g(X), \+ acyclic_term(Y).
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, XLOG 2') :-
X = f(Y), Y = g(X), Z = h(X), \+ acyclic_term(Z).
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, XLOG 3') :-
X = [a,b,Y|c], Y = [d,e,Z|f], Z = [g,h,i], acyclic_term(X).
runner_case(acyclic_term, 1, common, compat, 'Corr.2 8.3.11.4, XLOG 4') :-
X = [a,b,Y|c], Y = [d,e,Z|f], Z = [g,h,X|i], \+ acyclic_term(X).