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, common, compat, 'XLOG 2.2.1').
runner_case(call_nth,2, common, compat, '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, common, compat, 'XLOG 2.2.1, XLOG 2') :-
call_nth(between(5, 10, X), 3),
X == 7.
runner_case(call_nth,2, common, compat, 'XLOG 2.2.1, XLOG 3') :-
\+ call_nth(repeat, 0).
runner_case(call_nth,2, common, compat, 'XLOG 2.2.1, XLOG 4') :-
catch(call_nth(_,_), error(E,_), true),
E == instantiation_error.
/* 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') :-
Y = g(A,X,B), X = f(Y,C,D), term_singletons(X, L),
L == [A,B,C,D].
/* 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') :-
Y = f(a, Y), ground(Y).
runner_case(ground, 1, common, compat, 'Corr.2 8.3.10.4, XLOG 6') :-
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') :-
X = f(g(X,A),_), nonground(X, Y), Y == A.
runner_case(nonground,2, common, compat, 'XLOG 2.2.4, XLOG 5') :-
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') :-
X = [97, 98, 99|X], term_hash(X, H),
H == 141732.
runner_case(term_hash,2, common, compat, 'XLOG 2.2.5, XLOG 5') :-
X = f(X,a), Y = g(b,X,Y), term_hash(Y, H),
H == 6204340.
/* divmod(X, Y, D, M) */
runner_pred(divmod,4, common, compat, 'XLOG 2.2.6').
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 1') :-
divmod(7, 35, D, M), D == 0, M == 7.
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 2') :-
divmod(140, 14, D, M), D == 10, M == 0.
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 3') :-
divmod(7, -2, D, M), D == -4, M == -1.
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 4') :-
divmod(-5, 2, D, M), D == -3, M == 1.
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 5') :-
divmod(-15211807202738, -1394415660251, D, M),
D == 10, M == -1267650600228.
runner_case(divmod,4, common, compat, 'XLOG 2.2.6, XLOG 6') :-
catch(divmod(-33, 0, _, _), error(E,_), true),
E == evaluation_error(zero_divisor).
/* gcd(X, Y, Z) */
runner_pred(gcd,3, common, compat, 'XLOG 2.2.7').
runner_case(gcd,3, common, compat, 'XLOG 2.2.7, XLOG 1') :-
X is gcd(15211807202738, 1394415660251),
X == 1.
runner_case(gcd,3, common, compat, 'XLOG 2.2.7, XLOG 2') :-
X is gcd(-2147483648, 7110656),
X == 32768.
runner_case(gcd,3, common, compat, 'XLOG 2.2.7, XLOG 3') :-
X is gcd(7110656, -2147483648),
X == 32768.