mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity

Clean up the tests in half the test directories.

Browse Source 
tests/accumulator/*.m:
tests/analysis_*/*.m:
tests/benchmarks*/*.m:
tests/debugger*/*.{m,exp,inp}:
tests/declarative_debugger*/*.{m,exp,inp}:
tests/dppd*/*.m:
tests/exceptions*/*.m:
tests/general*/*.m:
tests/grade_subdirs*/*.m:
tests/hard_coded*/*.m:
    Make these tests use four-space indentation, and ensure that
    each module is imported on its own line. (I intend to use the latter
    to figure out which subdirectories' tests can be executed in parallel.)

    These changes usually move code to different lines. For the debugger tests,
    specify the new line numbers in .inp files and expect them in .exp files.
This commit is contained in:
Zoltan Somogyi
2015-02-14 20:14:03 +11:00
parent b2fa7623c8
commit 33eb3028f5
979 changed files with 27190 additions and 24047 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
tests/accumulator/base.m
View File

@@ -1,7 +1,11 @@
%
% Tests that we handle the case of a dynamic value for the base
% case coming from the previous call.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that we handle the case of a dynamic value for the base
% case coming from the previous call.
%
:- module base.
:- interface.
@@ -12,17 +16,18 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("l: "),
{ p([1,10,100], 5, Length) },
io__write(Length),
io__nl.
main(!IO) :-
io__write_string("l: ", !IO),
p([1, 10, 100], 5, Length),
io__write(Length, !IO),
io__nl(!IO).
:- pred p(list(int)::in, int::in, int::out) is det.
p([], L, L).
p([H|T], _, L) :-
p(T, H, L0),
L is L0 + 1.
p([H | T], _, L) :-
p(T, H, L0),
L is L0 + 1.

33
tests/accumulator/call_in_base.m
View File

@@ -1,7 +1,11 @@
%
% Tests that if there is a call in the base case that we still
% are able to introduce an accumulator.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that if there is a call in the base case that we still
% are able to introduce an accumulator.
%
:- module call_in_base.
:- interface.
@@ -12,21 +16,22 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("l: "),
{ l([1,10,100], Length) },
io__write(Length),
io__nl.
main(!IO) :-
io__write_string("l: ", !IO),
l([1, 10, 100], Length),
io__write(Length, !IO),
io__nl(!IO).
:- pred l(list(T)::in, int::out) is det.
l([], Init) :-
init(Init).
l([_|T], L) :-
l(T, L0),
L is L0 + 1.
init(Init).
l([_ | T], L) :-
l(T, L0),
L is L0 + 1.
:- pred init(int::out) is det.
:- pragma no_inline(init/1).

111
tests/accumulator/chain.m
View File

@@ -1,7 +1,11 @@
%
% Tests chained calls to a predicate that requires
% rearrangement.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests chained calls to a predicate that requires
% rearrangement.
%
:- module chain.
:- interface.
@@ -12,76 +16,73 @@
:- implementation.
:- import_module int, list.
:- import_module int.
:- import_module list.
main -->
io__write_string("pa: "),
{ pa([5,6,7], ListA) },
io__write(ListA),
io__nl,
io__write_string("pb: "),
{ pb([5,6,7], ListB) },
io__write(ListB),
io__nl,
io__write_string("pc: "),
{ pc([1,3,5], ValC) },
io__write(ValC),
io__nl,
io__write_string("pd: "),
{ pd([2,4,5], ValD) },
io__write(ValD),
io__nl.
io__write_string("pa: "),
{ pa([5, 6, 7], ListA) },
io__write(ListA),
io__nl,
io__write_string("pb: "),
{ pb([5, 6, 7], ListB) },
io__write(ListB),
io__nl,
io__write_string("pc: "),
{ pc([1, 3, 5], ValC) },
io__write(ValC),
io__nl,
io__write_string("pd: "),
{ pd([2, 4, 5], ValD) },
io__write(ValD),
io__nl.
%
% append([H], [1], NewH) is static so we can introduce
% accumulator recursion.
%
% append([H], [1], NewH) is static so we can introduce
% accumulator recursion.
%
:- pred pa(list(int)::in, list(int)::out) is det.
pa([], []).
pa(X, Y) :-
X = [H | T],
pa(T, T0),
append([H], [1], NewH),
append(T0, NewH, Y).
X = [H | T],
pa(T, T0),
append([H], [1], NewH),
append(T0, NewH, Y).
%
% We have two calls to append with dynamic variables in them
% that require rearrangement. Hence we can't introduce
% accumulator recursion.
%
% We have two calls to append with dynamic variables in them
% that require rearrangement. Hence we can't introduce
% accumulator recursion.
%
:- pred pb(list(int)::in, list(int)::out) is det.
pb([], []).
pb(X, Y) :-
X = [H | T],
pb(T, T0),
append([1], T0, NewT),
append([H], NewT, Y).
X = [H | T],
pb(T, T0),
append([1], T0, NewT),
append([H], NewT, Y).
%
% We have two calls to append with dynamic variables in them
% that don't require rearrangement. Hence we CAN introduce
% accumulator recursion.
%
% We have two calls to append with dynamic variables in them
% that don't require rearrangement. Hence we CAN introduce
% accumulator recursion.
%
:- pred pc(list(int)::in, int::out) is det.
pc([], 0).
pc(X, Y) :-
X = [H | T],
pc(T, Y0),
Tmp is Y0 + (2*H),
Y is Tmp + H.
X = [H | T],
pc(T, Y0),
Tmp is Y0 + (2*H),
Y is Tmp + H.
%
% We CANNOT introduce accumulators because the chain of calls
% are to different predicates.
%
% We CANNOT introduce accumulators because the chain of calls
% are to different predicates.
%
:- pred pd(list(int)::in, int::out) is det.
pd([], 0).
pd(X, Y) :-
X = [H | T],
pd(T, Y0),
Tmp is 2*Y0,
Y is Tmp + H.
X = [H | T],
pd(T, Y0),
Tmp is 2*Y0,
Y is Tmp + H.

24
tests/accumulator/commutative.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Implementation of a commutative predicate which is not associative,
% it should not have accumulators introduced.
@@ -16,23 +20,23 @@
:- type t ---> a ; b ; c.
main -->
io__write_string("p: "),
{ p([a,b,c], R) },
io__write(R),
io__nl.
io__write_string("p: "),
{ p([a, b, c], R) },
io__write(R),
io__nl.
:- pred p(list(t)::in, t::out) is det.
p([], a).
p([H|T], R) :-
p(T, R0),
c(H, R0, R).
p([H | T], R) :-
p(T, R0),
c(H, R0, R).
% We define the operator c which is commutative, but
% not associative.
% We define the operator c which is commutative, but
% not associative.
:- pred c(t::in, t::in, t::out) is det.
:- promise all [A,B,C] ( c(A, B, C) <=> c(B, A, C) ).
:- promise all [A, B, C] ( c(A, B, C) <=> c(B, A, C) ).
c(a, a, a).
c(a, b, a).

61
tests/accumulator/construct_test.m
View File

@@ -1,6 +1,10 @@
%
% Tests that any construction unifications get handled properly.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that any construction unifications get handled properly.
%
:- module construct_test.
:- interface.
@@ -14,40 +18,37 @@
:- import_module list.
main -->
io__write_string("p1: "),
{ p([1,10,100], ListA) },
io__write(ListA),
io__nl,
io__write_string("pb: "),
{ p2([5,6,7], ListB) },
io__write(ListB),
io__nl.
io__write_string("p1: "),
{ p([1, 10, 100], ListA) },
io__write(ListA),
io__nl,
io__write_string("pb: "),
{ p2([5, 6, 7], ListB) },
io__write(ListB),
io__nl.
:- pred p(list(T), list(T)).
:- mode p(in, out) is det.
%
% Direct construction unification.
%
% Direct construction unification.
%
p([], []).
p(X,Y) :-
X = [H|T],
p(T,T0),
Y = [H|T0].
p(X, Y) :-
X = [H | T],
p(T, T0),
Y = [H | T0].
%
% Hide the construction by introducing some intermediate
% variables.
%
% This will introduce accumulators provided
% --optimize-constructor-last-call is turned on.
%
% Hide the construction by introducing some intermediate variables.
%
% This will introduce accumulators provided
% --optimize-constructor-last-call is turned on.
%
:- pred p2(list(int), list(int)).
:- mode p2(in, out) is det.
p2([], []).
p2(X,Y) :-
X = [H|T],
p2(T, T0),
append(T0, [1], T1),
Y = [H|T1].
p2(X, Y) :-
X = [H | T],
p2(T, T0),
append(T0, [1], T1),
Y = [H | T1].

80
tests/accumulator/dcg.m
View File

@@ -1,7 +1,11 @@
%
% Tests the case where the base case contains some goals which
% must be left in the base case of the introduced predicate.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests the case where the base case contains some goals which
% must be left in the base case of the introduced predicate.
%
:- module dcg.
:- interface.
@@ -15,55 +19,51 @@
:- import_module list.
main -->
io__write_string("p A: "),
{ p([1,10,100,9,0], ListA, [], ListB) },
io__write(ListA),
io__nl,
io__write_string("p B: "),
io__write(ListB),
io__nl,
io__write_string("p2 A2: "),
{ p2([1,10,100,9,0], ListA2, [], ListB2) },
io__write(ListA2),
io__nl,
io__write_string("p2 B2: "),
io__write(ListB2),
io__nl.
io__write_string("p A: "),
{ p([1, 10, 100, 9, 0], ListA, [], ListB) },
io__write(ListA),
io__nl,
io__write_string("p B: "),
io__write(ListB),
io__nl,
io__write_string("p2 A2: "),
{ p2([1, 10, 100, 9, 0], ListA2, [], ListB2) },
io__write(ListA2),
io__nl,
io__write_string("p2 B2: "),
io__write(ListB2),
io__nl.
%
% We can introduce accumulators, but the DCG goals must be left
% in the base case of the accumulator version of the predicate.
%
% We can introduce accumulators, but the DCG goals must be left
% in the base case of the accumulator version of the predicate.
%
:- pred p(list(T), list(T), list(T), list(T)).
:- mode p(in, out, in, out) is det.
p([], []) --> [].
p(X,Y) -->
{ X = [H|T] },
q(H),
p(T,T0),
{ list__append(T0, [H], Y) }.
p(X, Y) -->
{ X = [H | T] },
q(H),
p(T, T0),
{ list__append(T0, [H], Y) }.
%
% We cannot introduce accumulators because the second call to q
% can't be moved before p2.
%
% We cannot introduce accumulators because the second call to q
% can't be moved before p2.
%
:- pred p2(list(T), list(T), list(T), list(T)).
:- mode p2(in, out, in, out) is det.
p2([], []) --> [].
p2(X,Y) -->
{ X = [H|T] },
q(H),
p2(T,T0),
q(H),
{ list__append(T0, [H], Y) }.
p2(X, Y) -->
{ X = [H | T] },
q(H),
p2(T, T0),
q(H),
{ list__append(T0, [H], Y) }.
:- pred q(T, list(T), list(T)).
:- mode q(in, in, out) is det.
:- pragma no_inline(q/3).
q(H, DCG0, DCG) :-
DCG = [H | DCG0].
DCG = [H | DCG0].

90
tests/accumulator/deconstruct_test.m
View File

@@ -1,6 +1,10 @@
%
% Tests that any deconstruction unifications get handled properly.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that any deconstruction unifications get handled properly.
%
:- module deconstruct_test.
:- interface.
@@ -11,56 +15,56 @@
:- implementation.
:- import_module int, list.
:- import_module int.
:- import_module list.
:- type wrapper ---> wrapper(int, list(int)).
:- type wrapper
---> wrapper(int, list(int)).
main -->
io__write_string("p1: "),
(
{ p([1,10,100], ListA) }
->
io__write(ListA)
;
io__write_string("failed")
),
io__nl,
io__write_string("pb: "),
(
{ p2([5,6,7], ListB) }
->
io__write(ListB)
;
io__write_string("failed")
),
io__nl.
io__write_string("p1: "),
(
{ p([1, 10, 100], ListA) }
->
io__write(ListA)
;
io__write_string("failed")
),
io__nl,
io__write_string("pb: "),
(
{ p2([5, 6, 7], ListB) }
->
io__write(ListB)
;
io__write_string("failed")
),
io__nl.
:- pred p(list(int), list(int)).
:- mode p(in, out) is semidet.
%
% Direct deconstruction unification.
%
% Direct deconstruction unification.
%
p([], [1000]).
p(X,Y) :-
X = [H|T],
p(T,T0),
T0 = [Ht | Tt],
append([Ht], [H], NewH),
append(NewH, Tt, Y).
p(X, Y) :-
X = [H | T],
p(T, T0),
T0 = [Ht | Tt],
append([Ht], [H], NewH),
append(NewH, Tt, Y).
%
% Using a deconstruction as a wrapper. Should introduce
% accumlator recursion, doesn't.
%
% Using a deconstruction as a wrapper.
% Should introduce accumlator recursion, doesn't.
%
:- pred p2(list(int), wrapper).
:- mode p2(in, out) is semidet.
p2([], wrapper(0, [])).
p2(X,W) :-
X = [H|T],
p2(T, W0),
W0 = wrapper(L0, R0),
L is L0 + 1,
append(R0, [H], R),
W = wrapper(L, R).
p2(X, W) :-
X = [H | T],
p2(T, W0),
W0 = wrapper(L0, R0),
L is L0 + 1,
append(R0, [H], R),
W = wrapper(L, R).

150
tests/accumulator/disj.m
View File

@@ -1,6 +1,10 @@
%
% Tests that disjunctions gets handled properly.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that disjunctions gets handled properly.
%
:- module disj.
:- interface.
@@ -11,106 +15,106 @@
:- implementation.
:- import_module int, list, solutions.
:- import_module int.
:- import_module list.
:- import_module solutions.
:- type wrapper ---> w(int, int, int).
:- type wrapper
---> w(int, int, int).
main -->
{ solutions(p([1,7,4]), SumList) },
io__write_string("p: "),
io__write(SumList),
io__nl,
{ pa([1,7,4], FirstSoln) },
io__write_string("First soln p: "),
io__write(FirstSoln),
io__nl,
{ solutions(p2([1,7,4]), SumList2) },
io__write_string("p2: "),
io__write(SumList2),
io__nl,
{ solutions(p3([1,7,4]), SumList3) },
io__write_string("p3: "),
io__write(SumList3),
io__nl,
{ solutions(p4a([1,7,4]), SumList4) },
io__write_string("p4: "),
io__write(SumList4),
io__nl.
{ solutions(p([1, 7, 4]), SumList) },
io__write_string("p: "),
io__write(SumList),
io__nl,
{ pa([1, 7, 4], FirstSoln) },
io__write_string("First soln p: "),
io__write(FirstSoln),
io__nl,
{ solutions(p2([1, 7, 4]), SumList2) },
io__write_string("p2: "),
io__write(SumList2),
io__nl,
{ solutions(p3([1, 7, 4]), SumList3) },
io__write_string("p3: "),
io__write(SumList3),
io__nl,
{ solutions(p4a([1, 7, 4]), SumList4) },
io__write_string("p4: "),
io__write(SumList4),
io__nl.
:- pred pa(list(int), int).
:- mode pa(in, out) is cc_multi.
pa(X, Y) :-
p(X,Y).
p(X, Y).
:- pred p(list(int), int).
:- mode p(in, out) is multi.
%
% Introduce accumulators because each arm of the disjunction
% will always produce the same value.
%
% Introduce accumulators because each arm of the disjunction
% will always produce the same value.
%
p([], 0).
p([H|T], Sum) :-
p(T, Sum0),
(
Tmp = 2*H
;
Tmp = 3*H
),
Sum is Sum0 + Tmp.
p([H | T], Sum) :-
p(T, Sum0),
(
Tmp = 2*H
;
Tmp = 3*H
),
Sum is Sum0 + Tmp.
%
% In the second arm of the disjunction, the call
% (Sum is Sum0 + Tmp) contains 2 dynamic vars so we should fail.
%
% In the second arm of the disjunction, the call
% (Sum is Sum0 + Tmp) contains 2 dynamic vars so we should fail.
%
:- pred p2(list(int), int).
:- mode p2(in, out) is nondet.
p2([], 0).
p2([H|T], Sum) :-
p2(T, Sum0),
(
Tmp = 2*H
;
Tmp = H*Sum0
),
Sum is Sum0 + Tmp.
p2([H | T], Sum) :-
p2(T, Sum0),
(
Tmp = 2*H
;
Tmp = H*Sum0
),
Sum is Sum0 + Tmp.
:- pred p3(list(int), int).
:- mode p3(in, out) is nondet.
p3([], 0).
p3([H|T], Sum) :-
p3(T, Sum0),
(
Tmp = 0
;
Tmp = Sum0
),
Sum is H + Tmp.
p3([H | T], Sum) :-
p3(T, Sum0),
(
Tmp = 0
;
Tmp = Sum0
),
Sum is H + Tmp.
:- pred p4a(list(int), wrapper).
:- mode p4a(in, out) is nondet.
p4a(X, Y) :-
p4(X,S,L,NDS),
Y = w(S,L,NDS).
p4(X, S, L, NDS),
Y = w(S, L, NDS).
:- pred p4(list(int), int, int, int).
:- mode p4(in, out, out, out) is nondet.
p4([], 0, 0, 0).
p4([H|T], Sum, Length, NonDetSum) :-
p4(T, Sum0, Length0, NonDetSum0),
Length is Length0 + 1,
Sum is H + Sum0,
(
Tmp = Length0
;
Tmp = Sum0
;
Tmp = NonDetSum0
),
NonDetSum is H + Tmp.
p4([H | T], Sum, Length, NonDetSum) :-
p4(T, Sum0, Length0, NonDetSum0),
Length is Length0 + 1,
Sum is H + Sum0,
(
Tmp = Length0
;
Tmp = Sum0
;
Tmp = NonDetSum0
),
NonDetSum is H + Tmp.

20
tests/accumulator/func.m
View File

@@ -1,4 +1,9 @@
% Test that accumulators are introduced into functions.
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Test that accumulators are introduced into functions.
%
:- module (func).
:- interface.
@@ -9,15 +14,16 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("sumlist: "),
{ Sum = sumlist([5,6,7]) },
io__write(Sum),
io__nl.
io__write_string("sumlist: "),
{ Sum = sumlist([5, 6, 7]) },
io__write(Sum),
io__nl.
:- func sumlist(list(int)) = int.
sumlist([]) = 0.
sumlist([H|T]) = H + sumlist(T).
sumlist([H | T]) = H + sumlist(T).

31
tests/accumulator/heuristic.m
View File

@@ -1,8 +1,12 @@
%
% Tests that even though it is possible to introduce an
% accumulator for p it would be counter productive because it
% makes the algorithm O(N^2).
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that even though it is possible to introduce an
% accumulator for p it would be counter productive because it
% makes the algorithm O(N^2).
%
:- module heuristic.
:- interface.
@@ -13,17 +17,18 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("p: "),
{ p([[1,10,100],[],[1,2,3],[6,5,4]], Length) },
io__write(Length),
io__nl.
io__write_string("p: "),
{ p([[1, 10, 100], [], [1, 2, 3], [6, 5, 4]], Length) },
io__write(Length),
io__nl.
:- pred p(list(list(T))::in, list(T)::out) is det.
p([], []).
p([X|Xs], L) :-
p(Xs, L0),
append(X, L0, L).
p([X | Xs], L) :-
p(Xs, L0),
append(X, L0, L).

47
tests/accumulator/highorder.m
View File

@@ -1,7 +1,11 @@
%
% Highoder functions cannot use accumulator recursion because we
% don't know anything about the assocativity of P.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Highoder functions cannot use accumulator recursion because we
% don't know anything about the assocativity of P.
%
:- module highorder.
:- interface.
@@ -12,27 +16,28 @@
:- implementation.
:- import_module int, list.
:- import_module int.
:- import_module list.
main -->
io__write_string("foldr: "),
{ highorder__foldr(minus, [1,10,100], 0, ListA) },
io__write(ListA),
io__nl.
:- pred minus(int::in, int::in, int::out) is det.
minus(A, B, C) :-
C is A - B.
io__write_string("foldr: "),
{ highorder__foldr(minus, [1, 10, 100], 0, ListA) },
io__write(ListA),
io__nl.
% highorder__foldr(Pred, List, Start, End) calls Pred with each
% element of List (working right-to-left) and an accumulator
% (with the initial value of Start), and returns the final
% value in End.
:- pred minus(int::in, int::in, int::out) is det.
minus(A, B, C) :-
C is A - B.
% highorder__foldr(Pred, List, Start, End) calls Pred with each element
% of List (working right-to-left) and an accumulator (with the initial
% value of Start), and returns the final value in End.
%
:- pred highorder__foldr(pred(X, Y, Y), list(X), Y, Y).
:- mode highorder__foldr(pred(in, in, out) is det, in, in, out) is det.
highorder__foldr(_, [], Acc, Acc).
highorder__foldr(P, [H|T], Acc0, Acc) :-
highorder__foldr(P, T, Acc0, Acc1),
call(P, H, Acc1, Acc).
highorder__foldr(P, [H | T], Acc0, Acc) :-
highorder__foldr(P, T, Acc0, Acc1),
call(P, H, Acc1, Acc).

37
tests/accumulator/identity.m
View File

@@ -1,8 +1,12 @@
%
% Tests that we can still introduce accumulators even though we
% don't initialise the base case to be the identity element for
% append.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that we can still introduce accumulators even though we
% don't initialise the base case to be the identity element for
% append.
%
:- module identity.
:- interface.
@@ -13,22 +17,23 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("r: "),
{ r([1,10,100], Reverse) },
io__write(Reverse),
io__nl.
io__write_string("r: "),
{ r([1, 10, 100], Reverse) },
io__write(Reverse),
io__nl.
:- pred r(list(int), list(int)).
:- mode r(in, out) is det.
r(X, R) :-
X = [],
R = [1000].
X = [],
R = [1000].
r(X, R) :-
X = [H | T],
r(T, R0),
Tmp = [H],
append(R0, Tmp, R).
X = [H | T],
r(T, R0),
Tmp = [H],
append(R0, Tmp, R).

43
tests/accumulator/inter.m
View File

@@ -1,7 +1,11 @@
%
% This is an interleaved version of reverse and length.
% Tests if we can introduce more then one accumulator.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This is an interleaved version of reverse and length.
% Tests if we can introduce more then one accumulator.
%
:- module inter.
:- interface.
@@ -12,26 +16,27 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("rl: "),
{ rl([1,10,100], Length, Reverse) },
io__write(Length),
io__write_string(" "),
io__write(Reverse),
io__nl.
io__write_string("rl: "),
{ rl([1, 10, 100], Length, Reverse) },
io__write(Length),
io__write_string(" "),
io__write(Reverse),
io__nl.
:- pred rl(list(T), int, list(T)).
:- mode rl(in, out, out) is det.
rl(X, L, R) :-
X = [],
L = 0,
R = [].
X = [],
L = 0,
R = [].
rl(X, L, R) :-
X = [H | T],
rl(T, L0, R0),
L is L0 + 1,
Tmp = [H],
append(R0, Tmp, R).
X = [H | T],
rl(T, L0, R0),
L is L0 + 1,
Tmp = [H],
append(R0, Tmp, R).

45
tests/accumulator/ite.m
View File

@@ -1,4 +1,9 @@
% Tests that if-then-elses are handled correctly.
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that if-then-elses are handled correctly.
:- module ite.
:- interface.
@@ -12,30 +17,30 @@
:- import_module int.
main -->
io__write_string("factorial: "),
{ Factorial = factorial(7) },
io__write(Factorial),
io__nl,
io__write_string("sort_of_factorial: "),
{ sort_of_factorial(3, Factorial2) },
io__write(Factorial2),
io__nl.
io__write_string("factorial: "),
{ Factorial = factorial(7) },
io__write(Factorial),
io__nl,
io__write_string("sort_of_factorial: "),
{ sort_of_factorial(3, Factorial2) },
io__write(Factorial2),
io__nl.
:- func factorial(int) = int.
factorial(Num)
= ( Num = 0 -> 1 ; Num * factorial(Num - 1)).
= ( Num = 0 -> 1 ; Num * factorial(Num - 1)).
:- pred sort_of_factorial(int, int).
% Here we bind a value in the If goals and use it in the Then
% goals, in an attempt to confuse the compiler.
sort_of_factorial(Num, Fac) :-
(
(Num \= 0, X = 2)
->
sort_of_factorial(Num - 1, Fac0),
Fac = X * Num * Fac0
;
Fac = 1
).
% Here we bind a value in the condition and use it in the then part,
% in an attempt to confuse the compiler.
(
(Num \= 0, X = 2)
->
sort_of_factorial(Num - 1, Fac0),
Fac = X * Num * Fac0
;
Fac = 1
).

71
tests/accumulator/nonrec.m
View File

@@ -1,9 +1,13 @@
%
% Tests that we recognise that even though the append/3 and +/3
% are assocative, the call to drop/3 will drop different
% amounts from H according to whether we start counting from the
% start or end, so don't introduce accumulator.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that we recognise that even though the append/3 and +/3
% are assocative, the call to drop/3 will drop different
% amounts from H according to whether we start counting from the
% start or end, so don't introduce accumulator.
%
:- module nonrec.
:- interface.
@@ -14,37 +18,38 @@
:- implementation.
:- import_module int, list.
:- import_module int.
:- import_module list.
main -->
io__write_string("p(in, out, out): "),
(
{ p([[4,3,2,1],[3,2,1],[2,1]], Length, ListA) }
->
io__write(Length),
io__write_string(" "),
io__write(ListA)
;
io__write_string("failed")
),
io__nl,
io__write_string("p(in, in, out): "),
(
{ p([[4,3,2,1],[3,2,1],[2,1]], 2, ListB) }
->
io__write(ListB)
;
io__write_string("failed")
),
io__nl.
io__write_string("p(in, out, out): "),
(
{ p([[4, 3, 2, 1], [3, 2, 1], [2, 1]], Length, ListA) }
->
io__write(Length),
io__write_string(" "),
io__write(ListA)
;
io__write_string("failed")
),
io__nl,
io__write_string("p(in, in, out): "),
(
{ p([[4, 3, 2, 1], [3, 2, 1], [2, 1]], 2, ListB) }
->
io__write(ListB)
;
io__write_string("failed")
),
io__nl.
:- pred p(list(list(T)), int, list(list(T))) is semidet.
:- mode p(in, out, out) is semidet.
:- mode p(in, in, out) is semidet.
p([],0,[]).
p([H|T], Length, DroppedList) :-
p(T, Length0, DroppedList0),
Length is Length0 + 1,
list__drop(Length, H, NewHead), % Length or Length0, shouldn't matter.
append([NewHead], DroppedList0, DroppedList).
p([], 0, []).
p([H | T], Length, DroppedList) :-
p(T, Length0, DroppedList0),
Length is Length0 + 1,
list__drop(Length, H, NewHead), % Length or Length0, shouldn't matter.
append([NewHead], DroppedList0, DroppedList).

63
tests/accumulator/out_to_in.m
View File

@@ -1,13 +1,16 @@
%
% Tests two things
% * Recognise that Length will hold the same value no
% matter if we process left to right or right to left.
% * Realise that OutInt will always hold 10 so change its
% mode from out to in and set it to be 10
%
% Used to work, doesn't work with the unfold/fold
% transformation.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests two things
% * Recognise that Length will hold the same value no
% matter if we process left to right or right to left.
% * Realise that OutInt will always hold 10 so change its
% mode from out to in and set it to be 10
%
% Used to work, doesn't work with the unfold/fold transformation.
%
:- module out_to_in.
:- interface.
@@ -18,29 +21,29 @@
:- implementation.
main -->
io__write_string("q: "),
(
{ q([[4,3,2,1],[3,2,1],[2,1]], 2, List, Out) }
->
io__write(List),
io__write_string(" "),
io__write(Out)
;
io__write_string("failed")
),
io__nl.
:- import_module int.
:- import_module list.
:- import_module int, list.
main -->
io__write_string("q: "),
(
{ q([[4, 3, 2, 1], [3, 2, 1], [2, 1]], 2, List, Out) }
->
io__write(List),
io__write_string(" "),
io__write(Out)
;
io__write_string("failed")
),
io__nl.
:- pred q(list(list(T)), int, list(list(T)), int) is semidet.
:- mode q(in, in, out, out) is semidet.
q([], _, [], 10).
q([H|T], Length, DroppedList, OutInt) :-
Length0 = 1,
q(T, Length0, DroppedList0, OutInt),
_X is OutInt + Length,
list__drop(Length, H, NewHead),
append(DroppedList0, [NewHead], DroppedList).
q([H | T], Length, DroppedList, OutInt) :-
Length0 = 1,
q(T, Length0, DroppedList0, OutInt),
_X is OutInt + Length,
list__drop(Length, H, NewHead),
append(DroppedList0, [NewHead], DroppedList).

49
tests/accumulator/qsort.m
View File

@@ -1,8 +1,12 @@
%
% Make sure that this doesn't get recognised as an
% opportunity to introduce accumulator recursion,
% because qsort is already tail recursive.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Make sure that this doesn't get recognised as an
% opportunity to introduce accumulator recursion,
% because qsort is already tail recursive.
%
:- module qsort.
:- interface.
@@ -13,32 +17,33 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
{ qsort([1,6,0,8,7,4], [], S) },
io__write_string("qsort: "),
io__write(S),
io__nl.
{ qsort([1, 6, 0, 8, 7, 4], [], S) },
io__write_string("qsort: "),
io__write(S),
io__nl.
:- pred qsort(list(T), list(T), list(T)).
:- mode qsort(in, in, out) is det.
qsort([], R, R).
qsort([X|L], R0, R) :-
partition(L, X, L1, L2),
qsort(L2, R0, R1),
qsort(L1, [X|R1], R).
qsort([X | L], R0, R) :-
partition(L, X, L1, L2),
qsort(L2, R0, R1),
qsort(L1, [X | R1], R).
:- pred partition(list(T), T, list(T), list(T)).
:- mode partition(in, in, out, out) is det.
partition([], _, [], []).
partition([Head|Tail], Partition, Low, High) :-
( compare(<, Head, Partition) ->
partition(Tail, Partition, Low1, High),
Low = [Head|Low1]
;
partition(Tail, Partition, Low, High1),
High = [Head|High1]
).
partition([Head | Tail], Partition, Low, High) :-
( compare(<, Head, Partition) ->
partition(Tail, Partition, Low1, High),
Low = [Head | Low1]
;
partition(Tail, Partition, Low, High1),
High = [Head | High1]
).

29
tests/accumulator/simple.m
View File

@@ -1,6 +1,10 @@
%
% The call in the compose section isn't assocative.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% The call in the compose section isn't assocative.
%
:- module simple.
:- interface.
@@ -11,19 +15,20 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
io__write_string("foldr: "),
{ foldr([1,10,100], 0, Ans) },
io__write(Ans),
io__nl.
io__write_string("foldr: "),
{ foldr([1, 10, 100], 0, Ans) },
io__write(Ans),
io__nl.
:- pred foldr(list(int), int, int).
:- mode foldr(in, in, out) is det.
foldr([], Acc, Acc).
foldr(X,Acc0,Acc) :-
X = [H|T],
foldr(T,Acc0,Acc1),
Acc is H - Acc1.
foldr(X, Acc0, Acc) :-
X = [H | T],
foldr(T, Acc0, Acc1),
Acc is H - Acc1.

25
tests/accumulator/split.m
View File

@@ -1,7 +1,11 @@
%
% Test that all the output variables must be related to
% a variable in the recursive call.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Test that all the output variables must be related to
% a variable in the recursive call.
%
:- module split.
:- interface.
@@ -12,19 +16,20 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
{ p([1,7,4], S) },
io__write_string("p: "),
io__write(S),
io__nl.
{ p([1, 7, 4], S) },
io__write_string("p: "),
io__write(S),
io__nl.
:- pred p(list(int), int).
:- mode p(in, out) is det.
p([], 0).
p([H|T], S) :-
p([H | T], S) :-
p(T, _),
Tmp = 0,
S is H + Tmp.

26
tests/accumulator/swap.m
View File

@@ -1,7 +1,11 @@
%
% Tests that the compiler recognises append is assocative if we
% swap the order of the two input arguments.
%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Tests that the compiler recognises append is assocative if we
% swap the order of the two input arguments.
%
:- module swap.
:- interface.
@@ -15,15 +19,15 @@
:- import_module list.
main -->
io__write_string("rev: "),
{ rev([5,6,7], ListA) },
io__write(ListA),
io__nl.
io__write_string("rev: "),
{ rev([5, 6, 7], ListA) },
io__write(ListA),
io__nl.
:- pred rev(list(T), list(T)).
:- mode rev(in, out) is det.
rev([], []).
rev([H|T], R) :-
rev(T, R0),
append(R0, [H], R).
rev([H | T], R) :-
rev(T, R0),
append(R0, [H], R).

12
tests/analysis_ctgc/reuse_m1.m
View File

@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module reuse_m1.
:- interface.
@@ -7,15 +9,12 @@
:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module reuse_m2.
%-----------------------------------------------------------------------------%
main(!IO) :-
F = foo(1, 2),
G = foo(3, 4),
@@ -32,6 +31,3 @@ main(!IO) :-
(void) T;
IO = IO0;
").
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

10
tests/analysis_ctgc/reuse_m2.m
View File

@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module reuse_m2.
:- interface.
@@ -8,8 +10,7 @@
:- pred fiddle2(foo::in, foo::in, foo::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -19,6 +20,3 @@
fiddle2(X, Y, Z) :-
fiddle3(X, Y, Z).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_excp/excp_m2.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module excp_m2.
:- interface.
:- pred bbb(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module excp_m3.
%-----------------------------------------------------------------------------%
:- pragma no_inline(bbb/1).
bbb(N) :-
ccc(N).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_excp/excp_m3.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module excp_m3.
:- interface.
:- pred ccc(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module excp_m1.
%-----------------------------------------------------------------------------%
:- pragma no_inline(ccc/1).
ccc(N) :-
aaa2(N).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

10
tests/analysis_external/ext.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Analysis results should be written out for exported `:- external' predicates.
% Importing modules don't care how those procedures are implemented, so results
% should exist.
@@ -12,8 +16,7 @@
:- type t
---> t(int, int).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -22,6 +25,3 @@
% For comparison.
:- pragma no_inline(bar/2).
bar(X, X).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

10
tests/analysis_external/ext2.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Same as ext.m but tests trail usage analysis separately.
:- module ext2.
@@ -10,8 +14,7 @@
:- type t
---> t(int, int).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -20,6 +23,3 @@
% For comparison.
:- pragma no_inline(bar/2).
bar(X, X).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

11
tests/analysis_sharing/sharing_m2.m
View File

@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module sharing_m2.
:- interface.
@@ -8,19 +10,14 @@
:- pred bbb(foo::in, foo::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module sharing_m3.
%-----------------------------------------------------------------------------%
:- pragma no_inline(bbb/2).
bbb(N, M) :-
ccc(N, M).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_sharing/sharing_m3.m
View File

@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module sharing_m3.
:- interface.
@@ -7,19 +9,13 @@
:- pred ccc(foo::in, foo::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module sharing_m1.
%-----------------------------------------------------------------------------%
:- pragma no_inline(ccc/2).
ccc(N, M) :-
aaa2(N, M).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_table/table_m2.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module table_m2.
:- interface.
:- pred bbb(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module table_m3.
%-----------------------------------------------------------------------------%
:- pragma no_inline(bbb/1).
bbb(N) :-
ccc(N).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_table/table_m3.m
View File

@@ -1,19 +1,18 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module table_m3.
:- interface.
:- pred ccc(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module table_m1.
%-----------------------------------------------------------------------------%
:- pragma no_inline(ccc/1).
ccc(N) :-
@@ -22,6 +21,3 @@ ccc(N) :-
;
true
).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_trail/trail_m2.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module trail_m2.
:- interface.
:- pred bbb(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module trail_m3.
%-----------------------------------------------------------------------------%
:- pragma no_inline(bbb/1).
bbb(N) :-
ccc(N).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_trail/trail_m3.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module trail_m3.
:- interface.
:- pred ccc(int::in) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module trail_m1.
%-----------------------------------------------------------------------------%
:- pragma no_inline(ccc/1).
ccc(N) :-
aaa2(N, _).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_unused_args/ua_m2.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module ua_m2.
:- interface.
:- pred bbb(int::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module ua_m3.
%-----------------------------------------------------------------------------%
:- pragma no_inline(bbb/2).
bbb(N, M) :-
ccc(N, M).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

12
tests/analysis_unused_args/ua_m3.m
View File

@@ -1,23 +1,19 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module ua_m3.
:- interface.
:- pred ccc(int::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module ua_m1.
%-----------------------------------------------------------------------------%
:- pragma no_inline(ccc/2).
ccc(N, M) :-
aaa2(N, M).
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et

123
tests/benchmarks/cqueens.m
View File

@@ -1,10 +1,17 @@
% 9-queens program
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% 9-queens program.
%
:- module cqueens.
:- interface.
:- import_module list, int, io.
:- import_module int.
:- import_module io.
:- import_module list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
@@ -16,104 +23,104 @@
:- import_module prolog.
main1(Out) :-
data(Data),
queen(Data, Out).
main1(Out) :-
data(Data),
queen(Data, Out).
main -->
( { data(Data), queen(Data, Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
( { data(Data), queen(Data, Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
:- pred data(list(int)).
:- mode data(out) is det.
data([1,2,3,4,5,6,7,8,9]).
data([1, 2, 3, 4, 5, 6, 7, 8, 9]).
:- pred queen(list(int), list(int)).
:- mode queen(in, out) is nondet.
queen(Data, Out) :-
queen_2(Data, [], Out).
queen_2(Data, [], Out).
:- pred queen_2(list(int), list(int), list(int)).
:- mode queen_2(in, in, out) is nondet.
queen_2([], _, []).
queen_2(L, History, [Q|M]) :-
L = [_|_],
qdelete(Q, L, L1),
nodiag(Q, 1, History),
queen_2(L1, [Q|History], M).
queen_2(L, History, [Q | M]) :-
L = [_ | _],
qdelete(Q, L, L1),
nodiag(Q, 1, History),
queen_2(L1, [Q | History], M).
:- pred qperm(list(int), list(int)).
:- mode qperm(in, out) is nondet.
qperm([], []).
qperm([X|Y], K) :-
qdelete(U, [X|Y], Z),
K = [U|V],
qperm(Z, V).
qperm([X | Y], K) :-
qdelete(U, [X | Y], Z),
K = [U | V],
qperm(Z, V).
:- pred qdelete(int, list(int), list(int)).
:- mode qdelete(out, in, out) is nondet.
qdelete(A, [A|L], L).
qdelete(X, [A|Z], [A|R]) :-
qdelete(X, Z, R).
qdelete(A, [A | L], L).
qdelete(X, [A | Z], [A | R]) :-
qdelete(X, Z, R).
:- pred safe(list(int)).
:- mode safe(in) is semidet.
safe([]).
safe([N|L]) :-
nodiag(N, 1, L),
safe(L).
safe([N | L]) :-
nodiag(N, 1, L),
safe(L).
:- pred nodiag(int, int, list(int)).
:- mode nodiag(in, in, in) is semidet.
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
NmB is N - B,
BmN is B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 is D + 1,
nodiag(B, D1, L).
nodiag(B, D, [N | L]) :-
NmB is N - B,
BmN is B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 is D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
print_list_2([X | Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).

169
tests/benchmarks/crypt.m
View File

@@ -1,10 +1,14 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% crypt
%
% Cryptomultiplication:
% Find the unique answer to:
% OEE
% EE
% ---
% OEE
% EE
% ---
% EOEE
% EOE
% ----
@@ -19,7 +23,9 @@
:- interface.
:- import_module list, int, io.
:- import_module int.
:- import_module io.
:- import_module list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
@@ -29,35 +35,36 @@
:- implementation.
:- import_module prolog, require.
:- import_module prolog.
:- import_module require.
main1(Out) :-
crypt(Out).
main1(Out) :-
crypt(Out).
main -->
( { main1(Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
( { main1(Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
:- pred crypt(list(int)).
:- mode crypt(out) is nondet.
crypt([A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P]) :-
crypt__odd(A), crypt__even(B), crypt__even(C), crypt__even(E),
mult([C, B, A], E, [I, H, G, F | X]),
lefteven(F), crypt__odd(G), crypt__even(H), crypt__even(I),
zero(X), lefteven(D),
mult([C, B, A], D, [L, K, J | Y]),
lefteven(J), crypt__odd(K), crypt__even(L), zero(Y),
sum2([I, H, G, F], [0, L, K, J], [P, O, N, M | Z]),
crypt__odd(M), crypt__odd(N), crypt__even(O), crypt__even(P), zero(Z).
% write(' '), write(A), write(B), write(C), nl,
% write(' '), write(D), write(E), nl,
% write(F), write(G), write(H), write(I), nl,
% write(J), write(K), write(L), nl,
% write(M), write(N), write(O), write(P), nl.
crypt__odd(A), crypt__even(B), crypt__even(C), crypt__even(E),
mult([C, B, A], E, [I, H, G, F | X]),
lefteven(F), crypt__odd(G), crypt__even(H), crypt__even(I),
zero(X), lefteven(D),
mult([C, B, A], D, [L, K, J | Y]),
lefteven(J), crypt__odd(K), crypt__even(L), zero(Y),
sum2([I, H, G, F], [0, L, K, J], [P, O, N, M | Z]),
crypt__odd(M), crypt__odd(N), crypt__even(O), crypt__even(P), zero(Z).
% write(' '), write(A), write(B), write(C), nl,
% write(' '), write(D), write(E), nl,
% write(F), write(G), write(H), write(I), nl,
% write(J), write(K), write(L), nl,
% write(M), write(N), write(O), write(P), nl.
% In the usual source this predicate is named sum. However, sum is a
% language construct in NU-Prolog, and cannot be defined as a predicate.
@@ -67,44 +74,44 @@ crypt([A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P]) :-
:- mode sum2(in, in, out) is det.
sum2(AL, BL, CL) :-
sum2(AL, BL, 0, CL).
sum2(AL, BL, 0, CL).
:- pred sum2(list(int), list(int), int, list(int)).
:- mode sum2(in, in, in, out) is det.
sum2([], [], Carry, Cs) :-
( Carry = 0 ->
Cs = []
;
Cs = [Carry]
).
( Carry = 0 ->
Cs = []
;
Cs = [Carry]
).
sum2([], [B | BL], Carry, Cs) :-
( Carry = 0 ->
Cs = [B | BL]
;
X is B + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], BL, NewCarry, CL),
Cs = [C | CL]
).
( Carry = 0 ->
Cs = [B | BL]
;
X is B + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], BL, NewCarry, CL),
Cs = [C | CL]
).
sum2([A | AL], [], Carry, Cs) :-
( Carry = 0 ->
Cs = [A | AL]
;
X is A + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], AL, NewCarry, CL),
Cs = [C | CL]
).
( Carry = 0 ->
Cs = [A | AL]
;
X is A + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], AL, NewCarry, CL),
Cs = [C | CL]
).
sum2([A | AL], [B | BL], Carry, Cs) :-
X1 is A + B,
X is X1 + Carry,
C is X mod 10,
NewCarry is X // 10,
sum2(AL, BL, NewCarry, CL),
Cs = [C | CL].
X1 is A + B,
X is X1 + Carry,
C is X mod 10,
NewCarry is X // 10,
sum2(AL, BL, NewCarry, CL),
Cs = [C | CL].
:- pred mult(list(int), int, list(int)).
:- mode mult(in, in, out) is det.
@@ -115,14 +122,14 @@ mult(AL, D, BL) :- mult(AL, D, 0, BL).
:- mode mult(in, in, in, out) is det.
mult([A | AL], D, Carry, [B | BL] ) :-
X1 is A * D,
X is X1 + Carry,
B is X mod 10,
NewCarry is X // 10,
mult(AL, D, NewCarry, BL).
X1 is A * D,
X is X1 + Carry,
B is X mod 10,
NewCarry is X // 10,
mult(AL, D, NewCarry, BL).
mult([], _, Carry, [C, Cend]) :-
C is Carry mod 10,
Cend is Carry // 10.
C is Carry mod 10,
Cend is Carry // 10.
:- pred zero(list(int)).
:- mode zero(in) is semidet.
@@ -163,27 +170,27 @@ lefteven(8).
:- mode print_list(in, di, uo) is det.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
print_list_2([X | Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).

143
tests/benchmarks/deriv.m
View File

@@ -1,5 +1,9 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% generated: 7 March 1990
% option(s):
% option(s):
%
% (deriv) times10
%
@@ -11,19 +15,20 @@
:- interface.
:- import_module int, io.
:- import_module int.
:- import_module io.
:- type expr ---> x
; num(int)
; expr + expr
; expr - expr
; expr * expr
; expr / expr
; - expr
; ^(expr, int)
; log(expr)
; exp(expr)
.
:- type expr ---> x
; num(int)
; expr + expr
; expr - expr
; expr * expr
; expr / expr
; - expr
; ^(expr, int)
; log(expr)
; exp(expr)
.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -36,18 +41,18 @@
:- import_module prolog.
main -->
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
io__write_string("\n\n"),
print_expr(E2),
io__write_string("\n\n"),
print_expr(E3),
io__write_string("\n\n"),
print_expr(E4),
io__write_string("\n")
;
[]
).
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
io__write_string("\n\n"),
print_expr(E2),
io__write_string("\n\n"),
print_expr(E3),
io__write_string("\n\n"),
print_expr(E4),
io__write_string("\n")
;
[]
).
:- pred times10(expr).
:- mode times10(out) is semidet.
@@ -68,69 +73,69 @@ main -->
:- mode print_expr(in, di, uo) is det.
print_expr(x) -->
io__write_string("x").
io__write_string("x").
print_expr(num(N)) -->
io__write_int(N).
io__write_int(N).
print_expr(log(E)) -->
io__write_string("log("),
print_expr(E),
io__write_string(")").
io__write_string("log("),
print_expr(E),
io__write_string(")").
print_expr(exp(E)) -->
io__write_string("exp("),
print_expr(E),
io__write_string(")").
io__write_string("exp("),
print_expr(E),
io__write_string(")").
print_expr(^(E, N)) -->
io__write_string("^("),
print_expr(E),
io__write_string(", "),
io__write_int(N),
io__write_string(")").
io__write_string("^("),
print_expr(E),
io__write_string(", "),
io__write_int(N),
io__write_string(")").
print_expr(E1 + E2) -->
io__write_string("("),
print_expr(E1),
io__write_string(" + "),
print_expr(E2),
io__write_string(")").
io__write_string("("),
print_expr(E1),
io__write_string(" + "),
print_expr(E2),
io__write_string(")").
print_expr(E1 - E2) -->
io__write_string("("),
print_expr(E1),
io__write_string(" + "),
print_expr(E2),
io__write_string(")").
io__write_string("("),
print_expr(E1),
io__write_string(" + "),
print_expr(E2),
io__write_string(")").
print_expr(E1 * E2) -->
io__write_string("("),
print_expr(E1),
io__write_string(" * "),
print_expr(E2),
io__write_string(")").
io__write_string("("),
print_expr(E1),
io__write_string(" * "),
print_expr(E2),
io__write_string(")").
print_expr(E1 / E2) -->
io__write_string("("),
print_expr(E1),
io__write_string(" / "),
print_expr(E2),
io__write_string(")").
io__write_string("("),
print_expr(E1),
io__write_string(" / "),
print_expr(E2),
io__write_string(")").
print_expr(-E) -->
io__write_string("- ("),
print_expr(E),
io__write_string(")").
io__write_string("- ("),
print_expr(E),
io__write_string(")").
main4(E1, E2, E3, E4) :-
ops8(E1),
divide10(E2),
log10(E3),
times10(E4).
ops8(E1),
divide10(E2),
log10(E3),
times10(E4).
times10(E) :-
d(x * x * x * x * x * x * x * x * x * x * x, x, E).
d(x * x * x * x * x * x * x * x * x * x * x, x, E).
log10(E) :-
d(log(log(log(log(log(log(log(log(log(log(x)))))))))), x, E).
d(log(log(log(log(log(log(log(log(log(log(x)))))))))), x, E).
ops8(E) :-
d((x + num(1)) * ((^(x, 2) + num(2)) * (^(x, 3) + num(3))), x, E).
d((x + num(1)) * ((^(x, 2) + num(2)) * (^(x, 3) + num(3))), x, E).
divide10(E) :-
d(x / x / x / x / x / x / x / x / x / x / x, x, E).
d(x / x / x / x / x / x / x / x / x / x / x, x, E).
d(U + V, X, DU + DV) :-
d(U, X, DU),

147
tests/benchmarks/deriv2.m
View File

@@ -1,5 +1,9 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% generated: 7 March 1990
% option(s):
% option(s):
%
% (deriv) times10
%
@@ -11,19 +15,20 @@
:- interface.
:- import_module int, io.
:- import_module int.
:- import_module io.
:- type expr ---> x
; num(int)
; expr + expr
; expr - expr
; expr * expr
; expr / expr
; - expr
; expr ** int
; log(expr)
; exp(expr)
.
:- type expr
---> x
; num(int)
; expr + expr
; expr - expr
; expr * expr
; expr / expr
; - expr
; expr ** int
; log(expr)
; exp(expr).
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -36,18 +41,18 @@
:- import_module prolog.
main -->
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
io__write_string("\n\n"),
print_expr(E2),
io__write_string("\n\n"),
print_expr(E3),
io__write_string("\n\n"),
print_expr(E4),
io__write_string("\n")
;
[]
).
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
io__write_string("\n\n"),
print_expr(E2),
io__write_string("\n\n"),
print_expr(E3),
io__write_string("\n\n"),
print_expr(E4),
io__write_string("\n")
;
[]
).
:- pred times10(expr).
:- mode times10(out) is semidet.
@@ -68,71 +73,71 @@ main -->
:- mode print_expr(in, di, uo) is det.
print_expr(x) -->
io__write_string("x").
io__write_string("x").
print_expr(num(N)) -->
io__write_string("num("),
io__write_int(N),
io__write_string(")").
io__write_string("num("),
io__write_int(N),
io__write_string(")").
print_expr(log(E)) -->
io__write_string("log("),
print_expr(E),
io__write_string(")").
io__write_string("log("),
print_expr(E),
io__write_string(")").
print_expr(exp(E)) -->
io__write_string("exp("),
print_expr(E),
io__write_string(")").
io__write_string("exp("),
print_expr(E),
io__write_string(")").
print_expr(E ** N) -->
io__write_string("pow("),
print_expr(E),
io__write_string(", "),
io__write_int(N),
io__write_string(")").
io__write_string("pow("),
print_expr(E),
io__write_string(", "),
io__write_int(N),
io__write_string(")").
print_expr(E1 + E2) -->
io__write_string("plus("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
io__write_string("plus("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
print_expr(E1 - E2) -->
io__write_string("minus("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
io__write_string("minus("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
print_expr(E1 * E2) -->
io__write_string("times("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
io__write_string("times("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
print_expr(E1 / E2) -->
io__write_string("div("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
io__write_string("div("),
print_expr(E1),
io__write_string(", "),
print_expr(E2),
io__write_string(")").
print_expr(-E) -->
io__write_string("neg("),
print_expr(E),
io__write_string(")").
io__write_string("neg("),
print_expr(E),
io__write_string(")").
main4(E1, E2, E3, E4) :-
ops8(E1),
divide10(E2),
log10(E3),
times10(E4).
ops8(E1),
divide10(E2),
log10(E3),
times10(E4).
times10(E) :-
d(x * x * x * x * x * x * x * x * x * x * x, x, E).
d(x * x * x * x * x * x * x * x * x * x * x, x, E).
log10(E) :-
d(log(log(log(log(log(log(log(log(log(log(x)))))))))), x, E).
d(log(log(log(log(log(log(log(log(log(log(x)))))))))), x, E).
ops8(E) :-
d((x + num(1)) * ((x ** 2 + num(2)) * (x ** 3 + num(3))), x, E).
d((x + num(1)) * ((x ** 2 + num(2)) * (x ** 3 + num(3))), x, E).
divide10(E) :-
d(x / x / x / x / x / x / x / x / x / x / x, x, E).
d(x / x / x / x / x / x / x / x / x / x / x, x, E).
d(U + V, X, DU + DV) :-
d(U, X, DU),

67
tests/benchmarks/nrev.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% nreverse
%
% David H. D. Warren
@@ -8,7 +12,8 @@
:- interface.
:- import_module list, io.
:- import_module io.
:- import_module list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -20,62 +25,62 @@
main --> main3(_).
main1(Out) :-
data(Data),
nreverse(Data, Out).
main1(Out) :-
data(Data),
nreverse(Data, Out).
:- pred main3(list(int), io__state, io__state).
:- mode main3(out, di, uo) is det.
main3(Out) -->
{ main1(Out) },
print_list(Out).
{ main1(Out) },
print_list(Out).
:- pred data(list(int)).
:- mode data(out) is det.
data([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
16,17,18,19,20,21,22,23, 24,25,26,27,28,29,30]).
data([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30]).
:- pred nreverse(list(int), list(int)).
:- mode nreverse(in, out) is det.
nreverse([X|L0], L) :-
nreverse(L0, L1), concatenate(L1, [X], L).
nreverse([X | L0], L) :-
nreverse(L0, L1), concatenate(L1, [X], L).
nreverse([], []).
:- pred concatenate(list(int), list(int), list(int)).
:- mode concatenate(in, in, out) is det.
concatenate([X|L1], L2, [X|L3]) :-
concatenate(L1, L2, L3).
concatenate([X | L1], L2, [X | L3]) :-
concatenate(L1, L2, L3).
concatenate([], L, L).
:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
print_list_2([X | Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).

388
tests/benchmarks/poly.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% poly_10
%
% Ralph Haygood (based on Prolog version by Rick McGeer
@@ -9,11 +13,20 @@
:- interface.
:- import_module int, io, list.
:- import_module int.
:- import_module io.
:- import_module list.
:- type poly__var ---> x ; y ; z.
:- type poly__term ---> term(int, poly).
:- type poly ---> poly(poly__var, list(poly__term)) ; const(int).
:- type poly__var
---> x
; y
; z.
:- type poly__term
---> term(int, poly).
:- type poly
---> poly(poly__var, list(poly__term))
; const(int).
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -28,16 +41,17 @@
:- import_module prolog.
main --> main3(_).
main -->
main3(_).
main3(Out) -->
{ main1(Out) },
print_poly(Out),
io__write_string("\n").
{ main1(Out) },
print_poly(Out),
io__write_string("\n").
main1(Out) :-
test_poly(P),
poly_exp(10, P, Out).
test_poly(P),
poly_exp(10, P, Out).
:- pred test_poly1(poly).
:- mode test_poly1(out) is det.
@@ -97,221 +111,221 @@ main1(Out) :-
:- mode print_term(in, di, uo) is det.
print_poly(const(N)) -->
io__write_string("const("),
io__write_int(N),
io__write_string(")").
io__write_string("const("),
io__write_int(N),
io__write_string(")").
print_poly(poly(Var, Terms)) -->
io__write_string("poly("),
print_var(Var),
io__write_string(", "),
print_terms(Terms),
io__write_string(")").
io__write_string("poly("),
print_var(Var),
io__write_string(", "),
print_terms(Terms),
io__write_string(")").
print_var(x) -->
io__write_string("x").
io__write_string("x").
print_var(y) -->
io__write_string("y").
io__write_string("y").
print_var(z) -->
io__write_string("z").
io__write_string("z").
print_terms(Terms) -->
( { Terms = [] } ->
io__write_string("[]\n")
;
io__write_string("["),
print_terms_2(Terms),
io__write_string("]")
).
( { Terms = [] } ->
io__write_string("[]\n")
;
io__write_string("["),
print_terms_2(Terms),
io__write_string("]")
).
print_terms_2([]) --> [].
print_terms_2([Term|Terms]) -->
print_term(Term),
( { Terms = [] } ->
[]
;
io__write_string(", "),
print_terms_2(Terms)
).
print_terms_2([Term | Terms]) -->
print_term(Term),
( { Terms = [] } ->
[]
;
io__write_string(", "),
print_terms_2(Terms)
).
print_term(term(N, Poly)) -->
io__write_string("term("),
io__write_int(N),
io__write_string(", "),
print_poly(Poly),
io__write_string(")").
io__write_string("term("),
io__write_int(N),
io__write_string(", "),
print_poly(Poly),
io__write_string(")").
test_poly1(P) :-
P = poly(x, [term(0,const(1)), term(1,const(1))]).
P = poly(x, [term(0, const(1)), term(1, const(1))]).
test_poly2(P) :-
P = poly(y, [term(1,const(1))]).
P = poly(y, [term(1, const(1))]).
test_poly3(P) :-
P = poly(z, [term(1,const(1))]).
P = poly(z, [term(1, const(1))]).
test_poly(P) :-
poly_add(poly(x, [term(0,const(1)), term(1,const(1))]), poly(y, [term(1, const(1))]), Q),
poly_add(poly(z, [term(1,const(1))]), Q, P).
poly_add(poly(x, [term(0, const(1)),
term(1, const(1))]), poly(y, [term(1, const(1))]), Q),
poly_add(poly(z, [term(1, const(1))]), Q, P).
poly_add(Poly1, Poly2, Result) :-
(
Poly1 = poly(Var1, Terms1),
(
Poly2 = poly(Var2, Terms2),
( Var1 = Var2 ->
term_add(Terms1, Terms2, Terms),
Result = poly(Var1, Terms)
; lt(Var1, Var2) ->
add_to_order_zero_term(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
;
add_to_order_zero_term(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
)
;
Poly2 = const(_),
add_to_order_zero_term(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
)
;
Poly1 = const(C1),
(
Poly2 = poly(Var2, Terms2),
add_to_order_zero_term(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
;
Poly2 = const(C2),
C is C1 + C2,
Result = const(C)
)
).
(
Poly1 = poly(Var1, Terms1),
(
Poly2 = poly(Var2, Terms2),
( Var1 = Var2 ->
term_add(Terms1, Terms2, Terms),
Result = poly(Var1, Terms)
; lt(Var1, Var2) ->
add_to_order_zero_term(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
;
add_to_order_zero_term(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
)
;
Poly2 = const(_),
add_to_order_zero_term(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
)
;
Poly1 = const(C1),
(
Poly2 = poly(Var2, Terms2),
add_to_order_zero_term(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
;
Poly2 = const(C2),
C is C1 + C2,
Result = const(C)
)
).
term_add(List1, List2, Result) :-
(
List1 = [],
Result = List2
;
List1 = [term(E1,C1)|Terms1],
(
List2 = [],
Result = List1
;
List2 = [term(E2,C2)|Terms2],
( E1 = E2 ->
poly_add(C1, C2, C),
term_add(Terms1, Terms2, Terms),
Result = [term(E1,C)|Terms]
; E1 < E2 ->
term_add(Terms1, List2, Terms),
Result = [term(E1,C1)|Terms]
;
term_add(List1, Terms2, Terms),
Result = [term(E2,C2)|Terms]
)
)
).
(
List1 = [],
Result = List2
;
List1 = [term(E1, C1) | Terms1],
(
List2 = [],
Result = List1
;
List2 = [term(E2, C2) | Terms2],
( E1 = E2 ->
poly_add(C1, C2, C),
term_add(Terms1, Terms2, Terms),
Result = [term(E1, C) | Terms]
; E1 < E2 ->
term_add(Terms1, List2, Terms),
Result = [term(E1, C1) | Terms]
;
term_add(List1, Terms2, Terms),
Result = [term(E2, C2) | Terms]
)
)
).
add_to_order_zero_term(List, C2, Result) :-
( List = [term(0,C1)|Terms] ->
poly_add(C1, C2, C),
Result = [term(0,C)|Terms]
;
Result = [term(0,C2)|List]
).
( List = [term(0, C1) | Terms] ->
poly_add(C1, C2, C),
Result = [term(0, C) | Terms]
;
Result = [term(0, C2) | List]
).
poly_exp(N, Poly, Result) :-
( N = 0 ->
Result = const(1)
; poly__even(N) ->
M is N // 2,
poly_exp(M, Poly, Part),
poly_mul(Part, Part, Result)
;
M is N - 1,
poly_exp(M, Poly, Part),
poly_mul(Poly, Part, Result)
).
( N = 0 ->
Result = const(1)
; poly__even(N) ->
M is N // 2,
poly_exp(M, Poly, Part),
poly_mul(Part, Part, Result)
;
M is N - 1,
poly_exp(M, Poly, Part),
poly_mul(Poly, Part, Result)
).
poly_mul(Poly1, Poly2, Result) :-
(
Poly1 = poly(Var1, Terms1),
(
Poly2 = poly(Var2, Terms2),
( Var1 = Var2 ->
term_mul(Terms1, Terms2, Terms),
Result = poly(Var1, Terms)
; lt(Var1, Var2) ->
mul_through(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
;
mul_through(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
)
;
Poly2 = const(_),
mul_through(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
)
;
Poly1 = const(C1),
(
Poly2 = poly(Var2, Terms2),
mul_through(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
;
Poly2 = const(C2),
C is C1 * C2,
Result = const(C)
)
).
(
Poly1 = poly(Var1, Terms1),
(
Poly2 = poly(Var2, Terms2),
( Var1 = Var2 ->
term_mul(Terms1, Terms2, Terms),
Result = poly(Var1, Terms)
; lt(Var1, Var2) ->
mul_through(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
;
mul_through(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
)
;
Poly2 = const(_),
mul_through(Terms1, Poly2, Terms),
Result = poly(Var1, Terms)
)
;
Poly1 = const(C1),
(
Poly2 = poly(Var2, Terms2),
mul_through(Terms2, Poly1, Terms),
Result = poly(Var2, Terms)
;
Poly2 = const(C2),
C is C1 * C2,
Result = const(C)
)
).
term_mul(List1, List2, Result) :-
(
List1 = [],
Result = []
;
List1 = [Term|Terms1],
(
List2 = [],
Result = []
;
List2 = [_|_],
single_term_mul(List2, Term, PartA),
term_mul(Terms1, List2, PartB),
term_add(PartA, PartB, Result)
)
).
(
List1 = [],
Result = []
;
List1 = [Term | Terms1],
(
List2 = [],
Result = []
;
List2 = [_ | _],
single_term_mul(List2, Term, PartA),
term_mul(Terms1, List2, PartB),
term_add(PartA, PartB, Result)
)
).
single_term_mul(List, Term, Result) :-
(
List = [],
Result = []
;
List = [term(E1,C1)|Terms1],
Term = term(E2,C2),
E is E1 + E2,
poly_mul(C1, C2, C),
single_term_mul(Terms1, Term, Terms),
Result = [term(E,C)|Terms]
).
(
List = [],
Result = []
;
List = [term(E1, C1) | Terms1],
Term = term(E2, C2),
E is E1 + E2,
poly_mul(C1, C2, C),
single_term_mul(Terms1, Term, Terms),
Result = [term(E, C) | Terms]
).
mul_through(List, Poly, Result) :-
(
List = [],
Result = []
;
List = [term(E,Term)|Terms],
poly_mul(Term, Poly, NewTerm),
mul_through(Terms, Poly, NewTerms),
Result = [term(E,NewTerm)|NewTerms]
).
(
List = [],
Result = []
;
List = [term(E, Term) | Terms],
poly_mul(Term, Poly, NewTerm),
mul_through(Terms, Poly, NewTerms),
Result = [term(E, NewTerm) | NewTerms]
).
lt(x, y).
lt(y, z).
lt(x, z).
even(N) :-
M is N // 2,
N1 is M * 2,
N = N1.
M is N // 2,
N1 is M * 2,
N = N1.

2
tests/benchmarks/primes.m
View File

@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module primes.

7
tests/benchmarks/qsort.m
View File

@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% qsort
%
@@ -26,8 +28,9 @@ main(!IO) :-
:- pred data(list(int)::out) is det.
data([27,74,17,33,94,18,46,83,65,2,32,53,28,85,99,47,28,82,6,11,55,29,39,81,
90,37,10,0,66,51,7,21,85,27,31,63,75,4,95,99,11,28,61,74,18, 92,40,53,59,8]).
data([27, 74, 17, 33, 94, 18, 46, 83, 65, 2, 32, 53, 28, 85, 99, 47, 28, 82,
6, 11, 55, 29, 39, 81, 90, 37, 10, 0, 66, 51, 7, 21, 85, 27, 31, 63, 75,
4, 95, 99, 11, 28, 61, 74, 18, 92, 40, 53, 59, 8]).
:- pred qsort(list(int)::in, list(int)::in, list(int)::out) is det.

4
tests/benchmarks/queens.m
View File

@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This program solves the N-queens problem. Given an N-by-N chessboard,
% this problem asks us to find positions for N queens on the board such
@@ -39,7 +41,7 @@ main(!IO) :-
% N integers.
:- pred data(list(int)::out) is det.
data([1,2,3,4,5,6,7,8]).
data([1, 2, 3, 4, 5, 6, 7, 8]).
:- pred queen(list(int)::in, list(int)::out) is nondet.

159
tests/benchmarks/query.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% query
%
% David H. D. Warren
@@ -19,103 +23,104 @@
:- implementation.
:- import_module int, prolog.
:- import_module int.
:- import_module prolog.
:- type quad ---> quad(string, int, string, int).
main -->
( { main1(Out), Out = quad(C1, D1, C2, D2) } ->
io__write_string(C1),
io__write_string(" has density "),
io__write_int(D1),
io__write_string(" while "),
io__write_string(C2),
io__write_string(" has density "),
io__write_int(D2),
io__write_string("\n")
;
io__write_string("No solutions\n")
).
( { main1(Out), Out = quad(C1, D1, C2, D2) } ->
io__write_string(C1),
io__write_string(" has density "),
io__write_int(D1),
io__write_string(" while "),
io__write_string(C2),
io__write_string(" has density "),
io__write_int(D2),
io__write_string("\n")
;
io__write_string("No solutions\n")
).
main1(Out) :-
query(Out).
main1(Out) :-
query(Out).
:- pred query(quad).
:- mode query(out) is nondet.
query(quad(C1, D1, C2, D2)) :-
density(C1, D1),
density(C2, D2),
D1 > D2,
T1 is 20 * D1,
T2 is 21 * D2,
T1 < T2.
query(quad(C1, D1, C2, D2)) :-
density(C1, D1),
density(C2, D2),
D1 > D2,
T1 is 20 * D1,
T2 is 21 * D2,
T1 < T2.
:- pred density(string, int).
:- mode density(out, out) is nondet.
density(C, D) :-
pop(C, P),
area(C, A),
P100 is P * 100,
D is P100 // A.
density(C, D) :-
pop(C, P),
area(C, A),
P100 is P * 100,
D is P100 // A.
:- pred pop(string, int).
:- mode pop(out, out) is multidet.
% populations in 100000s
pop("china", 8250).
pop("india", 5863).
pop("ussr", 2521).
pop("usa", 2119).
pop("indonesia", 1276).
pop("japan", 1097).
pop("brazil", 1042).
pop("bangladesh", 750).
pop("pakistan", 682).
pop("w_germany", 620).
pop("nigeria", 613).
pop("mexico", 581).
pop("uk", 559).
pop("italy", 554).
pop("france", 525).
pop("philippines", 415).
pop("thailand", 410).
pop("turkey", 383).
pop("egypt", 364).
pop("spain", 352).
pop("poland", 337).
pop("s_korea", 335).
pop("iran", 320).
pop("ethiopia", 272).
pop("argentina", 251).
pop("china", 8250).
pop("india", 5863).
pop("ussr", 2521).
pop("usa", 2119).
pop("indonesia", 1276).
pop("japan", 1097).
pop("brazil", 1042).
pop("bangladesh", 750).
pop("pakistan", 682).
pop("w_germany", 620).
pop("nigeria", 613).
pop("mexico", 581).
pop("uk", 559).
pop("italy", 554).
pop("france", 525).
pop("philippines", 415).
pop("thailand", 410).
pop("turkey", 383).
pop("egypt", 364).
pop("spain", 352).
pop("poland", 337).
pop("s_korea", 335).
pop("iran", 320).
pop("ethiopia", 272).
pop("argentina", 251).
:- pred area(string, int).
:- mode area(in, out) is semidet.
% areas in 1000s of square miles
area("china", 3380).
area("india", 1139).
area("ussr", 8708).
area("usa", 3609).
area("indonesia", 570).
area("japan", 148).
area("brazil", 3288).
area("bangladesh", 55).
area("pakistan", 311).
area("w_germany", 96).
area("nigeria", 373).
area("mexico", 764).
area("uk", 86).
area("italy", 116).
area("france", 213).
area("philippines", 90).
area("thailand", 200).
area("turkey", 296).
area("egypt", 386).
area("spain", 190).
area("poland", 121).
area("s_korea", 37).
area("iran", 628).
area("ethiopia", 350).
area("argentina", 1080).
area("china", 3380).
area("india", 1139).
area("ussr", 8708).
area("usa", 3609).
area("indonesia", 570).
area("japan", 148).
area("brazil", 3288).
area("bangladesh", 55).
area("pakistan", 311).
area("w_germany", 96).
area("nigeria", 373).
area("mexico", 764).
area("uk", 86).
area("italy", 116).
area("france", 213).
area("philippines", 90).
area("thailand", 200).
area("turkey", 296).
area("egypt", 386).
area("spain", 190).
area("poland", 121).
area("s_korea", 37).
area("iran", 628).
area("ethiopia", 350).
area("argentina", 1080).

37
tests/benchmarks/tak.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module tak.
:- interface.
@@ -12,28 +16,29 @@
:- implementation.
:- import_module int, prolog.
:- import_module int.
:- import_module prolog.
main -->
{ main1(Out) },
io__write_int(Out),
io__write_string("\n").
{ main1(Out) },
io__write_int(Out),
io__write_string("\n").
main1(Out) :-
tak(18, 12, 6, Out).
tak(18, 12, 6, Out).
:- pred tak(int, int, int, int).
:- mode tak(in, in, in, out) is det.
tak(X, Y, Z, A) :-
( X =< Y ->
Z = A
;
X1 is X - 1,
tak(X1, Y, Z, A1),
Y1 is Y - 1,
tak(Y1, Z, X, A2),
Z1 is Z - 1,
tak(Z1, X, Y, A3),
tak(A1, A2, A3, A)
).
( X =< Y ->
Z = A
;
X1 is X - 1,
tak(X1, Y, Z, A1),
Y1 is Y - 1,
tak(Y1, Z, X, A2),
Z1 is Z - 1,
tak(Z1, X, Y, A3),
tak(A1, A2, A3, A)
).

2
tests/debugger/all_solutions.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred all_solutions.main/2-0 (det) all_solutions.m:16
1: 1 1 CALL pred all_solutions.main/2-0 (det) all_solutions.m:20
mdb> echo on
Command echo enabled.
mdb> context none

11
tests/debugger/all_solutions.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% An example program to illustrate the use of all-solutions predicates
% in Mercury. This program just prints out all solutions to the
% predicate hello/1.
@@ -13,12 +17,11 @@
:- implementation.
:- import_module solutions.
main -->
{ solutions(hello, List) },
io__write_strings(List).
main -->
{ solutions(hello, List) },
io__write_strings(List).
:- pred hello(string::out) is multi.
hello("Hello, world\n").
hello("Hello again, world\n").

2
tests/debugger/ambiguity.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred ambiguity.main/2-0 (det) ambiguity.m:26
E1: C1 CALL pred ambiguity.main/2-0 (det) ambiguity.m:28
mdb> echo on
Command echo enabled.
mdb> register --quiet

4
tests/debugger/ambiguity.m
View File

@@ -1,4 +1,6 @@
% vim: sw=4 ts=4 expandtab ft=mercury
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module ambiguity.

4
tests/debugger/breakpoints.a.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints__a.
:- interface.

4
tests/debugger/breakpoints.a.testmod.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints__a__testmod.
:- interface.

4
tests/debugger/breakpoints.b.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints__b.
:- interface.

4
tests/debugger/breakpoints.b.testmod.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints__b__testmod.
:- interface.

34
tests/debugger/breakpoints.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred breakpoints.main/2-0 (cc_multi) breakpoints.m:24
E1: C1 CALL pred breakpoints.main/2-0 (cc_multi) breakpoints.m:30
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -22,7 +22,7 @@ Ambiguous procedure specification. The matches are:
Which do you want to put a breakpoint on (0-1 or *)? 1
0: + stop interface pred breakpoints.data/1-0 (det)
mdb> continue
E2: C2 CALL pred breakpoints.data/1-0 (det) breakpoints.m:58 (breakpoints.m:56)
E2: C2 CALL pred breakpoints.data/1-0 (det) breakpoints.m:64 (breakpoints.m:62)
mdb> disable 0
0: - stop interface pred breakpoints.data/1-0 (det)
mdb> break info
@@ -94,7 +94,7 @@ mdb> break_print -v -n -b1 HeadVar__1 HeadVar__2
1: + stop interface pred breakpoints.qperm/2-0 (nondet)
HeadVar__1 (verbose, nowarn), HeadVar__2 (verbose, nowarn)
mdb> continue
E3: C3 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:61)
E3: C3 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:67)
HeadVar__1
[|]
1-1
@@ -112,13 +112,13 @@ mdb> break_print -p -n -b1 HeadVar__1 HeadVar__2
1: + stop interface pred breakpoints.qperm/2-0 (nondet)
HeadVar__1 (pretty, nowarn), HeadVar__2 (pretty, nowarn)
mdb> continue
E4: C3 SWTC pred breakpoints.qperm/2-0 (nondet) s2-2; breakpoints.m:65
E4: C3 SWTC pred breakpoints.qperm/2-0 (nondet) s2-2; breakpoints.m:71
mdb> finish -N
E5: C4 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:68)
E5: C4 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:74)
HeadVar__1
[2, 3, 4, 5]
mdb> finish -n
E6: C4 EXIT pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:68)
E6: C4 EXIT pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:74)
HeadVar__1
[2, 3, 4, 5]
HeadVar__2
@@ -132,15 +132,15 @@ mdb> break_print -f -e -n -b1 HeadVar__2
1: + stop interface pred breakpoints.qperm/2-0 (nondet)
HeadVar__1 (flat, nowarn), HeadVar__2 (flat, nowarn)
mdb> continue
E7: C3 EXIT pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:61)
E7: C3 EXIT pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:67)
HeadVar__1 [1, 2, 3, 4, 5]
HeadVar__2 [1, 2, 3, 4, 5]
mdb> continue
E8: C5 CALL pred breakpoints.safe/1-0 (semidet) breakpoints.m:74 (breakpoints.m:62)
E8: C5 CALL pred breakpoints.safe/1-0 (semidet) breakpoints.m:80 (breakpoints.m:68)
mdb> finish
E9: C6 CALL pred breakpoints.nodiag/3-0 (semidet) breakpoints.m:79 (breakpoints.m:76)
E10: C6 FAIL pred breakpoints.nodiag/3-0 (semidet) breakpoints.m:79 (breakpoints.m:76)
E11: C5 FAIL pred breakpoints.safe/1-0 (semidet) breakpoints.m:74 (breakpoints.m:62)
E9: C6 CALL pred breakpoints.nodiag/3-0 (semidet) breakpoints.m:85 (breakpoints.m:82)
E10: C6 FAIL pred breakpoints.nodiag/3-0 (semidet) breakpoints.m:85 (breakpoints.m:82)
E11: C5 FAIL pred breakpoints.safe/1-0 (semidet) breakpoints.m:80 (breakpoints.m:68)
mdb> delete *
0: E stop interface pred breakpoints.nodiag/3-0 (semidet)
1: E stop interface pred breakpoints.qperm/2-0 (nondet)
@@ -162,14 +162,14 @@ mdb> break -i -I3 qperm
0: + stop interface pred breakpoints.qperm/2-0 (nondet)
(ignore next 3 interface events)
mdb> continue
E12: C7 REDO pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:68)
E12: C7 REDO pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:74)
mdb> print *
HeadVar__1 [4, 5]
mdb> ignore -E4 0
0: + stop interface pred breakpoints.qperm/2-0 (nondet)
(ignore next 4 call events)
mdb> continue
E13: C8 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:64 (breakpoints.m:68)
E13: C8 CALL pred breakpoints.qperm/2-0 (nondet) breakpoints.m:70 (breakpoints.m:74)
mdb> print *
HeadVar__1 []
mdb> delete *
@@ -238,7 +238,7 @@ mdb> break info
HeadVar__1 (flat)
mdb> continue
[1, 3, 5, 2, 4]
E14: C9 CALL func breakpoints.a.testmod.test_in_a/0-0 (det) breakpoints.a.testmod.m:10 (breakpoints.m:27)
E14: C9 CALL func breakpoints.a.testmod.test_in_a/0-0 (det) breakpoints.a.testmod.m:14 (breakpoints.m:33)
test_in_a = '_'
mdb> break_print -b0 none
0: + stop interface func breakpoints.a.testmod.test_in_a/0-0 (det)
@@ -250,12 +250,12 @@ mdb: there is no debuggable source file named nonexistent.m.
mdb> break breakpoints.m:1000
mdb: there is no event at line 1000 in breakpoints.m.
mdb> continue
E15: C9 EXIT func breakpoints.a.testmod.test_in_a/0-0 (det) breakpoints.a.testmod.m:10 (breakpoints.m:27)
E15: C9 EXIT func breakpoints.a.testmod.test_in_a/0-0 (det) breakpoints.a.testmod.m:14 (breakpoints.m:33)
HeadVar__1 "a"
mdb> continue
"a"
E16: C10 CALL func breakpoints.b.testmod.test_in_b/0-0 (det) breakpoints.b.testmod.m:10 (breakpoints.m:29)
E16: C10 CALL func breakpoints.b.testmod.test_in_b/0-0 (det) breakpoints.b.testmod.m:14 (breakpoints.m:35)
mdb: there is no variable named HeadVar__1.
E17: C10 EXIT func breakpoints.b.testmod.test_in_b/0-0 (det) breakpoints.b.testmod.m:10 (breakpoints.m:29)
E17: C10 EXIT func breakpoints.b.testmod.test_in_b/0-0 (det) breakpoints.b.testmod.m:14 (breakpoints.m:35)
HeadVar__1 "b"
"b"

80
tests/debugger/breakpoints.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints.
:- interface.
@@ -19,18 +23,20 @@
:- import_module breakpoints__a__testmod.
:- import_module breakpoints__b__testmod.
:- import_module list, int, string.
:- import_module list.
:- import_module int.
:- import_module string.
main -->
( { queen(data, Out) } ->
print_list(Out),
io__write(test_in_a),
io__nl,
io__write(test_in_b),
io__nl
;
io__write_string("No solution\n")
).
( { queen(data, Out) } ->
print_list(Out),
io__write(test_in_a),
io__nl,
io__write(test_in_b),
io__nl
;
io__write_string("No solution\n")
).
:- func data = list(int).
@@ -53,46 +59,46 @@ main -->
:- mode nodiag(in, in, in) is semidet.
data = D :-
data(D).
data(D).
data([1,2,3,4,5]).
data([1, 2, 3, 4, 5]).
queen(Data, Out) :-
qperm(Data, Out),
safe(Out).
qperm(Data, Out),
safe(Out).
qperm([], []).
qperm([X|Y], K) :-
qdelete(U, [X|Y], Z),
K = [U|V],
qperm(Z, V).
qperm([X | Y], K) :-
qdelete(U, [X | Y], Z),
K = [U | V],
qperm(Z, V).
qdelete(A, [A|L], L).
qdelete(X, [A|Z], [A|R]) :-
qdelete(X, Z, R).
qdelete(A, [A | L], L).
qdelete(X, [A | Z], [A | R]) :-
qdelete(X, Z, R).
safe([]).
safe([N|L]) :-
nodiag(N, 1, L),
safe(L).
safe([N | L]) :-
nodiag(N, 1, L),
safe(L).
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
NmB = N - B,
BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 = D + 1,
nodiag(B, D1, L).
nodiag(B, D, [N | L]) :-
NmB = N - B,
BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 = D + 1,
nodiag(B, D1, L).
X / _ = X.
:- pred test_in_both(io::di, io::uo) is det.
test_in_both(!IO) :-
io__write_string("test_in_both in breakpoints\n", !IO).
io__write_string("test_in_both in breakpoints\n", !IO).

49
tests/debugger/breakpoints.print_list.m
View File

@@ -1,8 +1,13 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module breakpoints__print_list.
:- interface.
:- import_module list, io.
:- import_module list.
:- import_module io.
:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.
@@ -17,36 +22,36 @@
:- implementation.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
print_list_2([X | Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
Str1 / Str2 = Str1 ++ "/" ++ Str2.
Str1 - Str2 = Str1 ++ "-" ++ Str2.
test_only_in_printlist(!IO) :-
io__write_string("test_only_in_printlist\n", !IO).
io__write_string("test_only_in_printlist\n", !IO).
test_in_both(!IO) :-
io__write_string("test_in_both\n", !IO).
io__write_string("test_in_both\n", !IO).

4
tests/debugger/browse_pretty.exp
View File

@@ -1,8 +1,8 @@
1: 1 1 CALL pred browse_pretty.main/2-0 (det) browse_pretty.m:12
1: 1 1 CALL pred browse_pretty.main/2-0 (det) browse_pretty.m:18
mdb> echo on
Command echo enabled.
mdb> goto 3
3: 2 2 EXIT pred browse_pretty.big_data/1-0 (det) browse_pretty.m:19 (browse_pretty.m:13)
3: 2 2 EXIT pred browse_pretty.big_data/1-0 (det) browse_pretty.m:25 (browse_pretty.m:19)
mdb> print *
Data (arg 1) big(big(big(small, [|]/2, small), [1, ...], small), [1, 2, 3], big(big/3, [|]/2, small))
mdb> browse 1

67
tests/debugger/browse_pretty.m
View File

@@ -1,45 +1,50 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module browse_pretty.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module list.
:- type big
---> big(big, list(int), big)
; small.
---> big(big, list(int), big)
; small.
main -->
{ big_data(Data) },
io__print(Data),
io__write_string(".\n").
{ big_data(Data) },
io__print(Data),
io__write_string(".\n").
:- pred big_data(big::out) is det.
big_data(Data) :-
Data = big(
big(
big(
small,
[1],
small
),
[1, 2],
small
),
[1, 2, 3],
big(
big(
small,
[1, 2, 3, 4],
big(
small,
[1, 2, 3, 4, 5],
small
)
),
[1, 2, 3, 4, 5, 6],
small
)
).
Data = big(
big(
big(
small,
[1],
small
),
[1, 2],
small
),
[1, 2, 3],
big(
big(
small,
[1, 2, 3, 4],
big(
small,
[1, 2, 3, 4, 5],
small
)
),
[1, 2, 3, 4, 5, 6],
small
)
).

16
tests/debugger/browser_test.exp3
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred browser_test.main/2-0 (det) browser_test.m:16
E1: C1 CALL pred browser_test.main/2-0 (det) browser_test.m:20
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -6,9 +6,9 @@ mdb> list_context_lines 10
mdb> break big_data
0: + stop interface pred browser_test.big_data/1-0 (det)
mdb> continue
E2: C2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:37 (browser_test.m:20)
E2: C2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:41 (browser_test.m:24)
mdb> finish
E3: C2 EXIT pred browser_test.big_data/1-0 (det) browser_test.m:37 (browser_test.m:20)
E3: C2 EXIT pred browser_test.big_data/1-0 (det) browser_test.m:41 (browser_test.m:24)
mdb> delete *
0: E stop interface pred browser_test.big_data/1-0 (det)
mdb> dump -q 1 browser_test.save.1
@@ -180,14 +180,14 @@ mdb> print Data/1/2
mdb> print 1^1^2^3
mdb: at 1^2^ the path 3 does not exist in variable 1.
mdb> retry
E2: C2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:37 (browser_test.m:20)
E2: C2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:41 (browser_test.m:24)
mdb> break list_data
0: + stop interface pred browser_test.list_data/1-0 (det)
mdb> continue
big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big(small, 5, small)), 6, small)).
E4: C3 CALL pred browser_test.list_data/1-0 (det) browser_test.m:66 (browser_test.m:23)
E4: C3 CALL pred browser_test.list_data/1-0 (det) browser_test.m:70 (browser_test.m:27)
mdb> finish
E5: C3 EXIT pred browser_test.list_data/1-0 (det) browser_test.m:66 (browser_test.m:23)
E5: C3 EXIT pred browser_test.list_data/1-0 (det) browser_test.m:70 (browser_test.m:27)
mdb> dump Data browser_test.save.2
Dumped Data to browser_test.save.2
mdb> break a_func
@@ -248,9 +248,9 @@ seq(
5
)
E6: C4 CALL func browser_test.a_func/1-0 (det) browser_test.m:112 (browser_test.m:31)
E6: C4 CALL func browser_test.a_func/1-0 (det) browser_test.m:116 (browser_test.m:35)
mdb> finish
E7: C4 EXIT func browser_test.a_func/1-0 (det) browser_test.m:112 (browser_test.m:31)
E7: C4 EXIT func browser_test.a_func/1-0 (det) browser_test.m:116 (browser_test.m:35)
mdb> print -p
a_func(big(big(...), ...)) = big(big(...), ...)
mdb> print -r

170
tests/debugger/browser_test.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module browser_test.
:- interface.
:- import_module io.
@@ -9,103 +13,103 @@
:- import_module list.
:- type big
---> big(big, int, big)
; small
; seq(int, list(big), int).
---> big(big, int, big)
; small
; seq(int, list(big), int).
main(!IO) :-
% In case we have these files lying around.
io__remove_file("browser_test.save.1", _, !IO),
io__remove_file("browser_test.save.2", _, !IO),
big_data(Data),
io__print(Data, !IO),
io__write_string(".\n", !IO),
list_data(List),
io__print(List, !IO),
io__write_string(".\n", !IO),
print_file("browser_test.save.1", !IO),
print_file("browser_test.save.2", !IO),
% Clean up after the test.
io__remove_file("browser_test.save.1", _, !IO),
io__remove_file("browser_test.save.2", _, !IO),
a_func(Data) = Data2,
write(Data2, !IO),
nl(!IO).
% In case we have these files lying around.
io__remove_file("browser_test.save.1", _, !IO),
io__remove_file("browser_test.save.2", _, !IO),
big_data(Data),
io__print(Data, !IO),
io__write_string(".\n", !IO),
list_data(List),
io__print(List, !IO),
io__write_string(".\n", !IO),
print_file("browser_test.save.1", !IO),
print_file("browser_test.save.2", !IO),
% Clean up after the test.
io__remove_file("browser_test.save.1", _, !IO),
io__remove_file("browser_test.save.2", _, !IO),
a_func(Data) = Data2,
write(Data2, !IO),
nl(!IO).
:- pred big_data(big::out) is det.
big_data(Data) :-
Data = big(
big(
big(
small,
1,
small
),
2,
small
),
3,
big(
big(
small,
4,
big(
small,
5,
small
)
),
6,
small
)
).
Data = big(
big(
big(
small,
1,
small
),
2,
small
),
3,
big(
big(
small,
4,
big(
small,
5,
small
)
),
6,
small
)
).
:- pred list_data(big::out) is det.
list_data(Data) :-
Element1 = big(
big(
small,
1,
small
),
2,
small
),
Element2 = small,
Element3 = big(
small,
4,
big(
small,
5,
small
)
),
Data = seq(1, [Element1, Element2, Element3], 5).
Element1 = big(
big(
small,
1,
small
),
2,
small
),
Element2 = small,
Element3 = big(
small,
4,
big(
small,
5,
small
)
),
Data = seq(1, [Element1, Element2, Element3], 5).
:- pred print_file(string::in, io::di, io::uo) is det.
print_file(FileName, !IO) :-
io__open_input(FileName, OpenRes, !IO),
(
OpenRes = ok(Stream),
io__read_file_as_string(Stream, ReadRes, !IO),
(
ReadRes = ok(Contents),
io__write_string(FileName, !IO),
io__write_string(":\n", !IO),
io__write_string(Contents, !IO),
io__write_string("\n", !IO)
;
ReadRes = error(_, _),
io__write_string("read failed\n", !IO)
)
;
OpenRes = error(_),
io__write_string("open failed\n", !IO)
).
io__open_input(FileName, OpenRes, !IO),
(
OpenRes = ok(Stream),
io__read_file_as_string(Stream, ReadRes, !IO),
(
ReadRes = ok(Contents),
io__write_string(FileName, !IO),
io__write_string(":\n", !IO),
io__write_string(Contents, !IO),
io__write_string("\n", !IO)
;
ReadRes = error(_, _),
io__write_string("read failed\n", !IO)
)
;
OpenRes = error(_),
io__write_string("open failed\n", !IO)
).
:- func a_func(big) = big.

176
tests/debugger/chooser_tag_test.m
View File

@@ -1,6 +1,6 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module chooser_tag_test.
:- interface.
@@ -20,8 +20,8 @@
---> xa(xaf:: a)
; xb(xbf:: b)
; xc(xcf:: c)
; xd
; xe.
; xd
; xe.
:- pred wrap_a(a::in, x::out) is det.
:- pred wrap_b(b::in, x::out) is det.
@@ -33,7 +33,7 @@
:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
@@ -52,122 +52,122 @@ unwrap_b(xb(B), B).
unwrap_c(xc(C), C).
main(!IO) :-
test_wraps(!IO),
test_solutions(30, !IO),
test_solutions(130, !IO).
test_wraps(!IO),
test_solutions(30, !IO),
test_solutions(130, !IO).
:- pred test_wraps(io::di, io::uo) is det.
test_wraps(!IO) :-
list.foldl(test_wrap_a, [a(10, 11), a(12, 20)], !IO),
list.foldl(test_wrap_b, [b(10, "eleven"), b(12, "twenty")], !IO),
list.foldl(test_wrap_c, [c("ten", 11), c("twelve", 20)], !IO).
list.foldl(test_wrap_a, [a(10, 11), a(12, 20)], !IO),
list.foldl(test_wrap_b, [b(10, "eleven"), b(12, "twenty")], !IO),
list.foldl(test_wrap_c, [c("ten", 11), c("twelve", 20)], !IO).
:- pred test_wrap_a(a::in, io::di, io::uo) is det.
test_wrap_a(A0, !IO) :-
wrap_a(A0, X),
( unwrap_a(X, A1_Prime) ->
MaybeA1 = yes(A1_Prime)
;
MaybeA1 = no
),
io.write_string("test_wrap_a: A0 = ", !IO),
io.write(A0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", A1 = ", !IO),
(
MaybeA1 = yes(A1),
io.write(A1, !IO)
;
MaybeA1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
wrap_a(A0, X),
( unwrap_a(X, A1_Prime) ->
MaybeA1 = yes(A1_Prime)
;
MaybeA1 = no
),
io.write_string("test_wrap_a: A0 = ", !IO),
io.write(A0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", A1 = ", !IO),
(
MaybeA1 = yes(A1),
io.write(A1, !IO)
;
MaybeA1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
:- pred test_wrap_b(b::in, io::di, io::uo) is det.
test_wrap_b(B0, !IO) :-
wrap_b(B0, X),
( unwrap_b(X, B1_Prime) ->
MaybeB1 = yes(B1_Prime)
;
MaybeB1 = no
),
io.write_string("test_wrap_b: B0 = ", !IO),
io.write(B0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", B1 = ", !IO),
(
MaybeB1 = yes(B1),
io.write(B1, !IO)
;
MaybeB1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
wrap_b(B0, X),
( unwrap_b(X, B1_Prime) ->
MaybeB1 = yes(B1_Prime)
;
MaybeB1 = no
),
io.write_string("test_wrap_b: B0 = ", !IO),
io.write(B0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", B1 = ", !IO),
(
MaybeB1 = yes(B1),
io.write(B1, !IO)
;
MaybeB1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
:- pred test_wrap_c(c::in, io::di, io::uo) is det.
test_wrap_c(C0, !IO) :-
wrap_c(C0, X),
( unwrap_c(X, C1_Prime) ->
MaybeC1 = yes(C1_Prime)
;
MaybeC1 = no
),
io.write_string("test_wrap_c: C0 = ", !IO),
io.write(C0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", C1 = ", !IO),
(
MaybeC1 = yes(C1),
io.write(C1, !IO)
;
MaybeC1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
wrap_c(C0, X),
( unwrap_c(X, C1_Prime) ->
MaybeC1 = yes(C1_Prime)
;
MaybeC1 = no
),
io.write_string("test_wrap_c: C0 = ", !IO),
io.write(C0, !IO),
io.write_string(", X = ", !IO),
io.write(X, !IO),
io.write_string(", C1 = ", !IO),
(
MaybeC1 = yes(C1),
io.write(C1, !IO)
;
MaybeC1 = no,
io.write_string("unwrap failed", !IO)
),
io.nl(!IO).
:- pred test_solutions(int::in, io::di, io::uo) is det.
test_solutions(N, !IO) :-
solutions(get_solutions(N), Solns),
io.format("solns for %d = ", [i(N)], !IO),
io.write(Solns, !IO),
io.nl(!IO).
solutions(get_solutions(N), Solns),
io.format("solns for %d = ", [i(N)], !IO),
io.write(Solns, !IO),
io.nl(!IO).
:- pred get_solutions(int::in, x::out) is nondet.
get_solutions(N, X) :-
( get_solutions_a(N, X)
; get_solutions_b(N, X)
; get_solutions_c(N, X)
).
( get_solutions_a(N, X)
; get_solutions_b(N, X)
; get_solutions_c(N, X)
).
:- pred get_solutions_a(int::in, x::out) is nondet.
get_solutions_a(N, X) :-
N < 100,
( X = xa(a(N, N))
; X = xa(a(N+1, N+1))
).
N < 100,
( X = xa(a(N, N))
; X = xa(a(N+1, N+1))
).
:- pred get_solutions_b(int::in, x::out) is nondet.
get_solutions_b(N, X) :-
N < 100,
( X = xb(b(N, "b2"))
; X = xb(b(N+1, "b2"))
).
N < 100,
( X = xb(b(N, "b2"))
; X = xb(b(N+1, "b2"))
).
:- pred get_solutions_c(int::in, x::out) is nondet.
get_solutions_c(N, X) :-
N < 100,
( X = xc(c("c1", N))
; X = xc(c("c1", N+1))
).
N < 100,
( X = xc(c("c1", N))
; X = xc(c("c1", N+1))
).

2
tests/debugger/class_decl.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred class_decl.main/2-0 (det) class_decl.m:21
1: 1 1 CALL pred class_decl.main/2-0 (det) class_decl.m:25
mdb> echo on
Command echo enabled.
mdb> register --quiet

134
tests/debugger/class_decl.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module class_decl.
:- interface.
@@ -8,29 +12,29 @@
:- implementation.
:- typeclass foo(T) where [
pred foo_method(T::in, io__state::di, io__state::uo) is det
pred foo_method(T::in, io__state::di, io__state::uo) is det
].
:- typeclass bar(T, U) where [
pred bar_method(T::in, U::in, io__state::di, io__state::uo) is det
pred bar_method(T::in, U::in, io__state::di, io__state::uo) is det
].
:- type t1 ---> t1(int).
:- type t2(T) ---> t2a(T) ; t2b(T, T).
main -->
foo_method("zero"),
foo_method(t1(10)),
foo_method(t2a(20)),
foo_method(t2b(30, 40)),
foo_method(t2b("thirty", "forty")),
bar_method(11, 22),
bar_method("eleven", 22),
bar_method("eleven", "twentytwo"),
bar_method(t1(111), 222),
bar_method(t1(333), t2a(444)),
bar_method(t1(333), t2b(444, 555)),
bar_method(t1(888), t2b("sixsixsix", "sevensevenseven")).
foo_method("zero"),
foo_method(t1(10)),
foo_method(t2a(20)),
foo_method(t2b(30, 40)),
foo_method(t2b("thirty", "forty")),
bar_method(11, 22),
bar_method("eleven", 22),
bar_method("eleven", "twentytwo"),
bar_method(t1(111), 222),
bar_method(t1(333), t2a(444)),
bar_method(t1(333), t2b(444, 555)),
bar_method(t1(888), t2b("sixsixsix", "sevensevenseven")).
:- instance foo(string) where [pred(foo_method/3) is foo_string].
:- instance foo(t1) where [pred(foo_method/3) is foo_t1].
@@ -41,25 +45,25 @@ main -->
:- pred foo_t2(t2(V)::in, io__state::di, io__state::uo) is det.
foo_string(S) -->
io__write_string("string: "),
io__write_string(S),
io__nl.
io__write_string("string: "),
io__write_string(S),
io__nl.
foo_t1(t1(I)) -->
io__write_string("t1: "),
io__write_int(I),
io__nl.
io__write_string("t1: "),
io__write_int(I),
io__nl.
foo_t2(t2a(I)) -->
io__write_string("t2a: "),
io__write(I),
io__nl.
io__write_string("t2a: "),
io__write(I),
io__nl.
foo_t2(t2b(I1, I2)) -->
io__write_string("t2b: "),
io__write(I1),
io__write_string(", "),
io__write(I2),
io__nl.
io__write_string("t2b: "),
io__write(I1),
io__write_string(", "),
io__write(I2),
io__nl.
:- instance bar(int, int) where [pred(bar_method/4) is bar_int_int].
:- instance bar(string, int) where [pred(bar_method/4) is bar_str_int].
@@ -68,55 +72,55 @@ foo_t2(t2b(I1, I2)) -->
:- instance bar(t1, t2(U)) where [pred(bar_method/4) is bar_t1_t2].
:- pred bar_int_int(int::in, int::in,
io__state::di, io__state::uo) is det.
io__state::di, io__state::uo) is det.
:- pred bar_str_int(string::in, int::in,
io__state::di, io__state::uo) is det.
io__state::di, io__state::uo) is det.
:- pred bar_str_str(string::in, string::in,
io__state::di, io__state::uo) is det.
io__state::di, io__state::uo) is det.
:- pred bar_t1_int(t1::in, int::in,
io__state::di, io__state::uo) is det.
io__state::di, io__state::uo) is det.
:- pred bar_t1_t2(t1::in, t2(V)::in,
io__state::di, io__state::uo) is det.
io__state::di, io__state::uo) is det.
bar_int_int(I1, I2) -->
io__write_string("ii: "),
io__write_int(I1),
io__write_string(", "),
io__write_int(I2),
io__nl.
io__write_string("ii: "),
io__write_int(I1),
io__write_string(", "),
io__write_int(I2),
io__nl.
bar_str_int(S1, I2) -->
io__write_string("si: "),
io__write_string(S1),
io__write_string(", "),
io__write_int(I2),
io__nl.
io__write_string("si: "),
io__write_string(S1),
io__write_string(", "),
io__write_int(I2),
io__nl.
bar_str_str(S1, S2) -->
io__write_string("ss: "),
io__write_string(S1),
io__write_string(", "),
io__write_string(S2),
io__nl.
io__write_string("ss: "),
io__write_string(S1),
io__write_string(", "),
io__write_string(S2),
io__nl.
bar_t1_int(t1(I1), I2) -->
io__write_string("t1int: "),
io__write_int(I1),
io__write_string(", "),
io__write_int(I2),
io__nl.
io__write_string("t1int: "),
io__write_int(I1),
io__write_string(", "),
io__write_int(I2),
io__nl.
bar_t1_t2(t1(I1), t2a(I2)) -->
io__write_string("t1t2a: "),
io__write_int(I1),
io__write_string(", "),
io__write(I2),
io__nl.
io__write_string("t1t2a: "),
io__write_int(I1),
io__write_string(", "),
io__write(I2),
io__nl.
bar_t1_t2(t1(I1), t2b(I2, I3)) -->
io__write_string("t1t2b: "),
io__write_int(I1),
io__write_string(", "),
io__write(I2),
io__write_string(", "),
io__write(I3),
io__nl.
io__write_string("t1t2b: "),
io__write_int(I1),
io__write_string(", "),
io__write(I2),
io__write_string(", "),
io__write(I3),
io__nl.

2
tests/debugger/cmd_quote.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred cmd_quote.main/2-0 (det) cmd_quote.m:7
1: 1 1 CALL pred cmd_quote.main/2-0 (det) cmd_quote.m:13
mdb> echo on
Command echo enabled.
mdb> print \ foo

8
tests/debugger/cmd_quote.m
View File

@@ -1,9 +1,15 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module cmd_quote.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
main -->
io__write_string("Hello world!\n").
io__write_string("Hello world!\n").

4
tests/debugger/completion.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred completion.main/2-0 (det) completion.m:13
1: 1 1 CALL pred completion.main/2-0 (det) completion.m:17
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -59,7 +59,7 @@ mdb: there is no such variable.
mdb>
stack stack_default_limit stack_regs
stack --detailed
0 1 1 1 pred completion.main/2-0 (det) (completion.m:13) (empty)
0 1 1 1 pred completion.main/2-0 (det) (completion.m:17) (empty)
mdb>
completion completion.sub2
completion.sub1 completion.sub2.sub3

6
tests/debugger/completion.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module completion.
:- interface.
@@ -11,7 +15,7 @@
:- implementation.
main -->
io__write_string("ok\n").
io__write_string("ok\n").
:- func z = int.
z = 0.

4
tests/debugger/completion.sub1.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module completion__sub1.
:- interface.

4
tests/debugger/completion.sub2.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module completion__sub2.
:- interface.

4
tests/debugger/completion.sub2.sub3.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module completion__sub2__sub3.
:- interface.

2
tests/debugger/cond.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred cond.main/2-0 (det) cond.m:17
E1: C1 CALL pred cond.main/2-0 (det) cond.m:23
mdb> mdb> echo on
Command echo enabled.
mdb> context none

118
tests/debugger/cond.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module cond.
:- interface.
@@ -8,90 +12,92 @@
:- implementation.
:- import_module list, int, maybe.
:- import_module list.
:- import_module int.
:- import_module maybe.
:- type t
---> empty
; node(t, int, t).
---> empty
; node(t, int, t).
main(!IO) :-
test_maybe(!IO),
test_maybe(!IO),
test_maybe(!IO),
test_maybe(!IO),
test_string(!IO),
test_string(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO).
test_maybe(!IO),
test_maybe(!IO),
test_maybe(!IO),
test_maybe(!IO),
test_string(!IO),
test_string(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO),
test_tree(!IO).
:- pred test_maybe(io::di, io::uo) is det.
test_maybe(!IO) :-
p(no, A),
p(yes(2), B),
p(yes(3), C),
io__write([A, B, C], !IO),
io__nl(!IO).
p(no, A),
p(yes(2), B),
p(yes(3), C),
io__write([A, B, C], !IO),
io__nl(!IO).
:- pred test_string(io::di, io::uo) is det.
test_string(!IO) :-
q("abc", A),
io__write_string(A, !IO),
io__nl(!IO),
q("def", B),
io__write_string(B, !IO),
io__nl(!IO),
q("ghi", C),
io__write_string(C, !IO),
io__nl(!IO).
q("abc", A),
io__write_string(A, !IO),
io__nl(!IO),
q("def", B),
io__write_string(B, !IO),
io__nl(!IO),
q("ghi", C),
io__write_string(C, !IO),
io__nl(!IO).
:- pred test_tree(io::di, io::uo) is det.
test_tree(!IO) :-
r(1, A),
s(A, AA),
io__write(AA, !IO),
io__nl(!IO),
r(2, B),
s(B, BB),
io__write(BB, !IO),
io__nl(!IO).
r(1, A),
s(A, AA),
io__write(AA, !IO),
io__nl(!IO),
r(2, B),
s(B, BB),
io__write(BB, !IO),
io__nl(!IO).
:- pred p(maybe(int)::in, maybe(int)::out) is det.
p(X, Y) :-
(
X = no,
Y = no
;
X = yes(Z),
Y = yes(Z + 1)
).
(
X = no,
Y = no
;
X = yes(Z),
Y = yes(Z + 1)
).
:- pred q(string::in, string::out) is det.
q(X, Y) :-
( X = "abc" ->
Y = "xabcx"
; X = "def" ->
Y = "ydefy"
;
Y = "else"
).
( X = "abc" ->
Y = "xabcx"
; X = "def" ->
Y = "ydefy"
;
Y = "else"
).
:- pred r(int::in, t::out) is det.
r(X, Y) :-
( X = 0 ->
Y = empty
;
r(X - 1, S),
Y = node(S, X, S)
).
( X = 0 ->
Y = empty
;
r(X - 1, S),
Y = node(S, X, S)
).
:- pred s(t::in, t::out) is det.

6
tests/debugger/debugger_regs.exp
View File

@@ -1,10 +1,10 @@
1: 1 1 CALL pred debugger_regs.main/2-0 (det) debugger_regs.m:19
1: 1 1 CALL pred debugger_regs.main/2-0 (det) debugger_regs.m:24
mdb> echo on
Command echo enabled.
mdb>
2: 2 2 CALL pred debugger_regs.data/41-0 (det) debugger_regs.m:88 (debugger_regs.m:28)
2: 2 2 CALL pred debugger_regs.data/41-0 (det) debugger_regs.m:93 (debugger_regs.m:33)
mdb>
3: 2 2 EXIT pred debugger_regs.data/41-0 (det) debugger_regs.m:88 (debugger_regs.m:28)
3: 2 2 EXIT pred debugger_regs.data/41-0 (det) debugger_regs.m:93 (debugger_regs.m:33)
mdb> print NoSuchVar
mdb: there is no such variable.
mdb> print *

145
tests/debugger/debugger_regs.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This program tests whether the tracer works for procedures with
% lots of arguments (beyond NUM_REAL_REGS and MAX_REAL_REGS).
% At the moment, MAX_REAL_REGS is 32, so a procedure with 41 args
@@ -14,79 +18,80 @@
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
main -->
% The purpose of list is to force the tracer to call the Mercury
% code to print a list of integers, when the input script asks
% for the outputs of data to be printed. In the past this was
% sufficient to cause part of the C stack to be overwritten.
% It also tests whether the values of A0 etc that the tracer prints
% are derived from the register contents produced by data,
% or from the register contents left there by the code that
% prints _List.
{ data(_List,
A0, A1, A2, A3, A4, A5, A6, A7, A8, A9,
B0, B1, B2, B3, B4, B5, B6, B7, B8, B9,
C0, C1, C2, C3, C4, C5, C6, C7, C8, C9,
D0, D1, D2, D3, D4, D5, D6, D7, D8, D9) },
io__write_string(A0),
io__write_string(A1),
io__write_string(A2),
io__write_string(A3),
io__write_string(A4),
io__write_string(A5),
io__write_string(A6),
io__write_string(A7),
io__write_string(A8),
io__write_string(A9),
io__write_string("\n"),
io__write_string(B0),
io__write_string(B1),
io__write_string(B2),
io__write_string(B3),
io__write_string(B4),
io__write_string(B5),
io__write_string(B6),
io__write_string(B7),
io__write_string(B8),
io__write_string(B9),
io__write_string("\n"),
io__write_string(C0),
io__write_string(C1),
io__write_string(C2),
io__write_string(C3),
io__write_string(C4),
io__write_string(C5),
io__write_string(C6),
io__write_string(C7),
io__write_string(C8),
io__write_string(C9),
io__write_string("\n"),
io__write_string(D0),
io__write_string(D1),
io__write_string(D2),
io__write_string(D3),
io__write_string(D4),
io__write_string(D5),
io__write_string(D6),
io__write_string(D7),
io__write_string(D8),
io__write_string(D9),
io__write_string("\n").
% The purpose of list is to force the tracer to call the Mercury
% code to print a list of integers, when the input script asks
% for the outputs of data to be printed. In the past this was
% sufficient to cause part of the C stack to be overwritten.
% It also tests whether the values of A0 etc that the tracer prints
% are derived from the register contents produced by data,
% or from the register contents left there by the code that
% prints _List.
{ data(_List,
A0, A1, A2, A3, A4, A5, A6, A7, A8, A9,
B0, B1, B2, B3, B4, B5, B6, B7, B8, B9,
C0, C1, C2, C3, C4, C5, C6, C7, C8, C9,
D0, D1, D2, D3, D4, D5, D6, D7, D8, D9) },
io__write_string(A0),
io__write_string(A1),
io__write_string(A2),
io__write_string(A3),
io__write_string(A4),
io__write_string(A5),
io__write_string(A6),
io__write_string(A7),
io__write_string(A8),
io__write_string(A9),
io__write_string("\n"),
io__write_string(B0),
io__write_string(B1),
io__write_string(B2),
io__write_string(B3),
io__write_string(B4),
io__write_string(B5),
io__write_string(B6),
io__write_string(B7),
io__write_string(B8),
io__write_string(B9),
io__write_string("\n"),
io__write_string(C0),
io__write_string(C1),
io__write_string(C2),
io__write_string(C3),
io__write_string(C4),
io__write_string(C5),
io__write_string(C6),
io__write_string(C7),
io__write_string(C8),
io__write_string(C9),
io__write_string("\n"),
io__write_string(D0),
io__write_string(D1),
io__write_string(D2),
io__write_string(D3),
io__write_string(D4),
io__write_string(D5),
io__write_string(D6),
io__write_string(D7),
io__write_string(D8),
io__write_string(D9),
io__write_string("\n").
:- pred data(list(int)::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out) is det.
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out) is det.
data([1, 2, 3, 4, 5],
"a0", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9",
"b0", "b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9",
"c0", "c1", "c2", "c3", "c4", "c5", "c6", "c7", "c8", "c9",
"d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7", "d8", "d9").
"a0", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9",
"b0", "b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9",
"c0", "c1", "c2", "c3", "c4", "c5", "c6", "c7", "c8", "c9",
"d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7", "d8", "d9").

33
tests/debugger/deeply_nested_typeinfo.m
View File

@@ -1,9 +1,13 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This is the core of the hard_coded/typeclasses/complicated_constraint test
% case. This code tests the compiler and the debugger's handling of predicates
% whose signature includes a type variable which occurs in a typeclass
% constraint but is not a direct argument of the typeclass constraint.
% As a consequence, the typeinfo describing the type variable is available
% neither as an argument nor directly inside a typeclassinfo, but only inside
% neither as an argument nor directly inside a typeclassinfo, but only inside
% a typeinfo inside a typeclassinfo. Our RTTI design doesn't (yet) have
% a mechanism for expressing this.
%
@@ -17,7 +21,9 @@
% The relevant part of the HLDS dump:
%
% variable types map:
% TypeClassInfo_for_foo (number 12): (private_builtin.typeclass_info((private_builtin.constraint((x.foo), (list.list(T))))))
% TypeClassInfo_for_foo (number 12):
% (private_builtin.typeclass_info(
% (private_builtin.constraint((x.foo), (list.list(T))))))
% type_info varmap:
% T (number 1) -> typeclass_info(TypeClassInfo_for_foo, 1) (number 12)
% typeclass_info varmap:
@@ -31,7 +37,7 @@
:- import_module list.
:- typeclass foo(A) where [
pred b(A::in) is semidet
pred b(A::in) is semidet
].
:- instance foo(int).
@@ -40,22 +46,23 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module list, int.
:- import_module list.
:- import_module int.
:- instance foo(int) where [
pred(b/1) is int_b
pred(b/1) is int_b
].
:- instance foo(list(T)) <= foo(T) where [
pred(b/1) is list_b
pred(b/1) is list_b
].
main -->
blah(101).
blah(101).
:- pred list_b(list(T)::in) is semidet <= foo(T).
list_b(List) :-
list__map((pred(A::in, A::out) is semidet :- b(A)), List, _).
list__map((pred(A::in, A::out) is semidet :- b(A)), List, _).
:- pred int_b(int::in) is semidet.
@@ -65,8 +72,8 @@ int_b(1).
:- mode blah(in, di, uo) is det.
blah(X) -->
( { b([X]) } ->
io__write_string("true\n")
;
io__write_string("false\n")
).
( { b([X]) } ->
io__write_string("true\n")
;
io__write_string("false\n")
).

194
tests/debugger/dice.exp
View File

@@ -1,115 +1,119 @@
E1: C1 CALL pred dice.main/2-0 (det) dice.m:17
E1: C1 CALL pred dice.main/2-0 (det) dice.m:24
mdb> mdb> Contexts will not be printed.
mdb> echo on
Command echo enabled.
mdb> dice -f dice.fail -p dice.passes -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.main/2-0 CALL dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:20 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:22 3 (3) 1 0.25
pred dice.merge/3-0 CALL dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:64 8 (3) 3 0.27
pred dice.merge/3-0 <s2-2;> dice.m:64 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:67 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:69 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:71 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:74 0 (0) 1 1.00
pred dice.merge_sort/2-0 CALL dice.m:31 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:31 3 (3) 1 0.25
pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:50 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:47 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
pred dice.main/2-0 CALL dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:27 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:29 3 (3) 1 0.25
pred dice.merge/3-0 CALL dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:71 8 (3) 3 0.27
pred dice.merge/3-0 <s1-2;s2-2;> dice.m:73 8 (3) 3 0.27
pred dice.merge/3-0 <s2-2;> dice.m:71 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:74 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:76 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:78 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:81 0 (0) 1 1.00
pred dice.merge_sort/2-0 CALL dice.m:38 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:38 3 (3) 1 0.25
pred dice.msort_n/4-0 CALL dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:46 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:61 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:51 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:57 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:54 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:62 8 (3) 3 0.27
mdb> fail_trace_counts dice.fail
mdb> pass_trace_counts dice.passes
mdb> dice -sS -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:74 0 (0) 1 1.00
pred dice.merge/3-0 <s2-2;> dice.m:64 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:67 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:69 10 (3) 4 0.29
pred dice.merge/3-0 CALL dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:64 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:50 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:47 11 (3) 4 0.27
pred dice.main/2-0 CALL dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:20 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:22 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:31 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:31 3 (3) 1 0.25
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:71 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:81 0 (0) 1 1.00
pred dice.merge/3-0 <s2-2;> dice.m:71 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:74 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:76 10 (3) 4 0.29
pred dice.merge/3-0 CALL dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:71 8 (3) 3 0.27
pred dice.merge/3-0 <s1-2;s2-2;> dice.m:73 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:62 8 (3) 3 0.27
pred dice.msort_n/4-0 CALL dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:46 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:61 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:51 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:57 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:54 11 (3) 4 0.27
pred dice.main/2-0 CALL dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:27 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:29 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:38 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:38 3 (3) 1 0.25
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:78 10 (3) 3 0.23
mdb> dice -sSF -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:74 0 (0) 1 1.00
pred dice.merge/3-0 <s2-2;> dice.m:64 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:67 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:69 10 (3) 4 0.29
pred dice.merge/3-0 CALL dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:64 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:50 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:47 11 (3) 4 0.27
pred dice.main/2-0 CALL dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:20 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:22 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:31 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:31 3 (3) 1 0.25
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:71 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:81 0 (0) 1 1.00
pred dice.merge/3-0 <s2-2;> dice.m:71 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:74 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:76 10 (3) 4 0.29
pred dice.merge/3-0 CALL dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 <s1-2;> dice.m:71 8 (3) 3 0.27
pred dice.merge/3-0 <s1-2;s2-2;> dice.m:73 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:62 8 (3) 3 0.27
pred dice.msort_n/4-0 CALL dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:46 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:61 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:51 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;t;> dice.m:57 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:54 11 (3) 4 0.27
pred dice.main/2-0 CALL dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:27 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:29 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:38 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:38 3 (3) 1 0.25
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:78 10 (3) 3 0.23
mdb> dice -n 3 -s P -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 CALL dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:46 19 (3) 7 0.27
mdb> dice -s Fp -m dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.merge/3-0 CALL dice.m:64 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:64 18 (3) 7 0.28
pred dice.msort_n/4-0 CALL dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:37 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:39 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:54 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:44 19 (3) 7 0.27
pred dice.merge/3-0 <s2-2;> dice.m:64 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:67 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:69 10 (3) 4 0.29
pred dice.msort_n/4-0 <e;t;> dice.m:50 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:47 11 (3) 4 0.27
pred dice.merge/3-0 <s1-2;> dice.m:64 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:55 8 (3) 3 0.27
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:71 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:74 0 (0) 1 1.00
pred dice.main/2-0 CALL dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:17 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:20 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:22 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:31 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:31 3 (3) 1 0.25
pred dice.merge/3-0 CALL dice.m:71 18 (3) 7 0.28
pred dice.merge/3-0 EXIT dice.m:71 18 (3) 7 0.28
pred dice.msort_n/4-0 CALL dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 EXIT dice.m:44 19 (3) 7 0.27
pred dice.msort_n/4-0 <?;> dice.m:46 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;> dice.m:61 19 (3) 7 0.27
pred dice.msort_n/4-0 <e;?;> dice.m:51 19 (3) 7 0.27
pred dice.merge/3-0 <s2-2;> dice.m:71 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;> dice.m:74 10 (3) 4 0.29
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;?;> dice.m:76 10 (3) 4 0.29
pred dice.msort_n/4-0 <e;t;> dice.m:57 11 (3) 4 0.27
pred dice.msort_n/4-0 <e;t;s2-2;> dice.m:54 11 (3) 4 0.27
pred dice.merge/3-0 <s1-2;> dice.m:71 8 (3) 3 0.27
pred dice.merge/3-0 <s1-2;s2-2;> dice.m:73 8 (3) 3 0.27
pred dice.msort_n/4-0 <e;e;> dice.m:62 8 (3) 3 0.27
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;t;> dice.m:78 10 (3) 3 0.23
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:81 0 (0) 1 1.00
pred dice.main/2-0 CALL dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 EXIT dice.m:24 3 (3) 1 0.25
pred dice.main/2-0 <c2;?;> dice.m:27 3 (3) 1 0.25
pred dice.main/2-0 <c2;t;> dice.m:29 3 (3) 1 0.25
pred dice.merge_sort/2-0 CALL dice.m:38 3 (3) 1 0.25
pred dice.merge_sort/2-0 EXIT dice.m:38 3 (3) 1 0.25
mdb> dice -sS -n 1 --module dice
Procedure Path/Port File:Line Pass (3) Fail Suspicion
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:74 0 (0) 1 1.00
mdb> break dice.m:74
0: + stop linenumber dice.m:74
pred dice.merge/3-0 <s2-2;c2;s2-2;c4;e;> dice.m:81 0 (0) 1 1.00
mdb> break dice.m:81
0: + stop linenumber dice.m:81
mdb> c
E2: C2 ELSE pred dice.merge/3-0 (det) s2-2;c2;s2-2;c4;e;
mdb> quit -y

2
tests/debugger/dice.inp
View File

@@ -9,6 +9,6 @@ dice -sSF -m dice
dice -n 3 -s P -m dice
dice -s Fp -m dice
dice -sS -n 1 --module dice
break dice.m:74
break dice.m:81
c
quit -y

99
tests/debugger/dice.m
View File

@@ -1,5 +1,9 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Test the mdb `dice' command.
% Buggy merge sort taken from Lee Naish's probabalistic declarative debugging
% Buggy merge sort taken from Lee Naish's probabalistic declarative debugging
% paper.
:- module dice.
@@ -12,52 +16,55 @@
:- implementation.
:- import_module int, string, list, exception.
:- import_module int.
:- import_module string.
:- import_module list.
:- import_module exception.
main(!IO) :-
io.command_line_arguments(Args, !IO),
(
list.map(string.to_int, Args, Ints)
->
merge_sort(Ints, Sorted),
io.write(Sorted, !IO),
io.nl(!IO)
;
io.write_string("usage error\n", !IO)
).
io.command_line_arguments(Args, !IO),
(
list.map(string.to_int, Args, Ints)
->
merge_sort(Ints, Sorted),
io.write(Sorted, !IO),
io.nl(!IO)
;
io.write_string("usage error\n", !IO)
).
:- pred merge_sort(list(int)::in, list(int)::out) is det.
merge_sort(Us, Ss) :-
N = list.length(Us),
msort_n(N, Us, Ss, _).
N = list.length(Us),
msort_n(N, Us, Ss, _).
:- pred msort_n(int::in, list(int)::in, list(int)::out, list(int)::out) is det.
msort_n(N, Unsorted, SortedPart, Rest) :-
(
N =< 0
->
SortedPart = [],
Rest = Unsorted
;
N = 1
->
(
Unsorted = [U | Us],
SortedPart = [U],
Rest = Us
;
Unsorted = [],
throw("Unsorted = [] and N = 0")
)
;
N1 = N // 2,
dice.msort_n(N1, Unsorted, Ss1, Us2),
N2 = N - N1,
msort_n(N2, Us2, Ss2, Rest),
dice.merge(Ss1, Ss2, SortedPart)
).
(
N =< 0
->
SortedPart = [],
Rest = Unsorted
;
N = 1
->
(
Unsorted = [U | Us],
SortedPart = [U],
Rest = Us
;
Unsorted = [],
throw("Unsorted = [] and N = 0")
)
;
N1 = N // 2,
dice.msort_n(N1, Unsorted, Ss1, Us2),
N2 = N - N1,
msort_n(N2, Us2, Ss2, Rest),
dice.merge(Ss1, Ss2, SortedPart)
).
:- pred merge(list(int)::in, list(int)::in, list(int)::out) is det.
@@ -65,12 +72,12 @@ merge([], [], []).
merge([S | Ss], [], [S | Ss]).
merge([], [S | Ss], [S | Ss]).
merge([A | As], [B | Bs], [C | Cs]) :-
(
A =< B
->
dice.merge(As, [B | Bs], Cs),
C = A
;
dice.merge(As, [B | Bs], Cs), % BUG
C = B
).
(
A =< B
->
dice.merge(As, [B | Bs], Cs),
C = A
;
dice.merge(As, [B | Bs], Cs), % BUG
C = B
).

2
tests/debugger/double_print.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred double_print.main/2-0 (det) double_print.m:13
E1: C1 CALL pred double_print.main/2-0 (det) double_print.m:17
mdb> echo on
Command echo enabled.
mdb> context none

4
tests/debugger/double_print.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module double_print.
:- interface.

2
tests/debugger/exception_cmd.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred exception_cmd.main/2-0 (det) exception_cmd.m:12
E1: C1 CALL pred exception_cmd.main/2-0 (det) exception_cmd.m:17
mdb> echo on
Command echo enabled.
mdb> exception

21
tests/debugger/exception_cmd.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
:- module exception_cmd.
:- interface.
@@ -7,15 +11,18 @@
:- implementation.
:- import_module require, int.
:- import_module require.
:- import_module int.
main --> { test(42, X) }, print(X).
main -->
{ test(42, X) },
print(X).
:- pred test(int::in, int::out) is det.
test(X, Y) :-
( X > 0 ->
error("oops")
;
Y = X + 1
).
( X > 0 ->
error("oops")
;
Y = X + 1
).

6
tests/debugger/exception_value.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred exception_value.main/2-0 (cc_multi) exception_value.m:12
E1: C1 CALL pred exception_value.main/2-0 (cc_multi) exception_value.m:18
mdb> echo on
Command echo enabled.
mdb> register --quiet
@@ -7,7 +7,7 @@ mdb> break p
mdb> break q
1: + stop interface pred exception_value.q/1-0 (det)
mdb> continue
E2: C2 CALL pred exception_value.p/1-0 (det) exception_value.m:30
E2: C2 CALL pred exception_value.p/1-0 (det) exception_value.m:36
mdb> finish
E3: C2 EXCP pred exception_value.p/1-0 (det)
mdb> print exception
@@ -17,7 +17,7 @@ mdb: warning: reached unknown label
This may result in some exception events
being omitted from the trace.
exception(univ_cons("p exception"))
E4: C3 CALL pred exception_value.q/1-0 (det) exception_value.m:35
E4: C3 CALL pred exception_value.q/1-0 (det) exception_value.m:41
mdb> finish
E5: C3 EXCP pred exception_value.q/1-0 (det)
mdb> browse exception

28
tests/debugger/exception_value.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module exception_value.
:- interface.
@@ -7,31 +11,33 @@
:- implementation.
:- import_module pair, exception, list.
:- import_module exception.
:- import_module list.
:- import_module pair.
main -->
{ test1(Res1) },
print(Res1),
io__nl,
{ test2(Res2) },
print(Res2),
io__nl.
{ test1(Res1) },
print(Res1),
io__nl,
{ test2(Res2) },
print(Res2),
io__nl.
:- pred test1(exception_result(int)::out) is cc_multi.
test1(Res) :-
try(p, Res).
try(p, Res).
:- pred test2(exception_result(int)::out) is cc_multi.
test2(Res) :-
try(q, Res).
try(q, Res).
:- pred p(int::out) is det.
p(_) :-
throw("p exception").
throw("p exception").
:- pred q(int::out) is det.
q(_) :-
throw("q oops" - [1, 2, 3]).
throw("q oops" - [1, 2, 3]).

4
tests/debugger/exception_vars.exp
View File

@@ -1,8 +1,8 @@
E1: C1 CALL pred exception_vars.main/2-0 (det) exception_vars.m:12
E1: C1 CALL pred exception_vars.main/2-0 (det) exception_vars.m:17
mdb> echo on
Command echo enabled.
mdb> goto 2
E2: C2 CALL pred exception_vars.test/2-0 (det) exception_vars.m:16 (exception_vars.m:12)
E2: C2 CALL pred exception_vars.test/2-0 (det) exception_vars.m:23 (exception_vars.m:18)
mdb> finish
E3: C2 EXCP pred exception_vars.test/2-0 (det)
mdb> print *

21
tests/debugger/exception_vars.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module exception_vars.
:- interface.
@@ -7,15 +11,18 @@
:- implementation.
:- import_module require, int.
:- import_module require.
:- import_module int.
main --> { test(42, X) }, print(X).
main -->
{ test(42, X) },
print(X).
:- pred test(int::in, int::out) is det.
test(X, Y) :-
( X > 0 ->
error("oops")
;
Y = X + 1
).
( X > 0 ->
error("oops")
;
Y = X + 1
).

76
tests/debugger/existential_type_classes.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This test case tests the combination of existential types and
% type classes, i.e. existential type class constraints.
@@ -8,26 +12,28 @@
:- pred main(io__state::di, state::uo) is det.
:- implementation.
:- import_module std_util, int, string, term.
:- import_module std_util.
:- import_module int.
:- import_module string.
:- import_module term.
:- typeclass fooable(T) where [
pred foo(T::in, int::out) is det
pred foo(T::in, int::out) is det
].
:- typeclass barable(T) where [
pred bar(T::in, int::out) is det
pred bar(T::in, int::out) is det
].
:- instance fooable(int) where [
pred(foo/2) is int_foo
pred(foo/2) is int_foo
].
:- instance fooable(string) where [
pred(foo/2) is string_foo
pred(foo/2) is string_foo
].
% my_univ_value(Univ):
% returns the value of the object stored in Univ.
% my_univ_value(Univ):
% returns the value of the object stored in Univ.
:- type my_univ ---> my_univ(c_pointer).
:- func my_univ(T) = my_univ <= fooable(T).
@@ -47,25 +53,25 @@ int_foo(X, 2*X).
string_foo(S, N) :- string__length(S, N).
main -->
{
do_foo(42, T1),
do_foo("blah", T2),
do_foo(my_exist_t, T3),
do_foo(call_my_exist_t, T4),
do_foo(my_univ_value(my_univ(45)), T5),
do_foo(call_my_univ_value(my_univ("something")), T6)
},
io__write_int(T1), nl,
io__write_int(T2), nl,
io__write_int(T3), nl,
io__write_int(T4), nl,
io__write_int(T5), nl,
io__write_int(T6), nl.
{
do_foo(42, T1),
do_foo("blah", T2),
do_foo(my_exist_t, T3),
do_foo(call_my_exist_t, T4),
do_foo(my_univ_value(my_univ(45)), T5),
do_foo(call_my_univ_value(my_univ("something")), T6)
},
io__write_int(T1), nl,
io__write_int(T2), nl,
io__write_int(T3), nl,
io__write_int(T4), nl,
io__write_int(T5), nl,
io__write_int(T6), nl.
:- pred do_foo(T::in, int::out) is det <= fooable(T).
do_foo(X, N) :-
foo(X, N).
foo(X, N).
call_my_exist_t = my_exist_t.
@@ -74,21 +80,21 @@ call_my_univ_value(Univ) = my_univ_value(Univ).
my_exist_t = 43.
:- pragma foreign_proc("C",
my_univ_value(Univ::in) = (Value::out),
[will_not_call_mercury, promise_pure],
my_univ_value(Univ::in) = (Value::out),
[will_not_call_mercury, promise_pure],
"
/* mention TypeInfo_for_T */
TypeClassInfo_for_existential_type_classes__fooable_T =
MR_field(MR_UNIV_TAG, Univ, 0);
Value = MR_field(MR_UNIV_TAG, Univ, 1);
/* mention TypeInfo_for_T */
TypeClassInfo_for_existential_type_classes__fooable_T =
MR_field(MR_UNIV_TAG, Univ, 0);
Value = MR_field(MR_UNIV_TAG, Univ, 1);
").
:- pragma foreign_proc("C",
my_univ(Value::in) = (Univ::out),
[will_not_call_mercury, promise_pure],
my_univ(Value::in) = (Univ::out),
[will_not_call_mercury, promise_pure],
"
MR_tag_incr_hp(Univ, MR_UNIV_TAG, 2);
MR_field(MR_UNIV_TAG, Univ, 0) =
(MR_Word) TypeClassInfo_for_existential_type_classes__fooable_T;
MR_field(MR_UNIV_TAG, Univ, 1) = (MR_Word) Value;
MR_tag_incr_hp(Univ, MR_UNIV_TAG, 2);
MR_field(MR_UNIV_TAG, Univ, 0) =
(MR_Word) TypeClassInfo_for_existential_type_classes__fooable_T;
MR_field(MR_UNIV_TAG, Univ, 1) = (MR_Word) Value;
").

2
tests/debugger/exported_eqv_type.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred exported_eqv_type.main/2-0 (det) exported_eqv_type.m:18
E1: C1 CALL pred exported_eqv_type.main/2-0 (det) exported_eqv_type.m:22
mdb> echo on
Command echo enabled.
mdb> context none

18
tests/debugger/exported_eqv_type.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% This test case used to cause the compiler to generate C code containing
% a reference to an undefined common cell.
@@ -16,14 +20,14 @@
:- import_module list.
main(!IO) :-
X = p(2, 55),
Y = p(3, "a"),
io__write(X, !IO),
io__nl(!IO),
io__write(Y, !IO),
io__nl(!IO).
X = p(2, 55),
Y = p(3, "a"),
io__write(X, !IO),
io__nl(!IO),
io__write(Y, !IO),
io__nl(!IO).
:- func p(int, bug(T)) = bug(list(T)).
p(Num, Item) = Dups :-
list__duplicate(Num, Item, Dups).
list__duplicate(Num, Item, Dups).

2
tests/debugger/fib.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred fib.main/2-0 (det) fib.m:13
E1: C1 CALL pred fib.main/2-0 (det) fib.m:19
mdb> echo on
Command echo enabled.
mdb> context none

52
tests/debugger/fib.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module fib.
:- interface.
@@ -8,45 +12,47 @@
:- implementation.
:- import_module benchmarking, require, int.
:- import_module benchmarking.
:- import_module require.
:- import_module int.
main(!IO) :-
perform_trial(23, !IO),
table_reset_for_mfib_2(!IO),
perform_trial(23, !IO).
perform_trial(23, !IO),
table_reset_for_mfib_2(!IO),
perform_trial(23, !IO).
:- pred perform_trial(int::in, io::di, io::uo) is det.
perform_trial(N, !IO) :-
trial(N, _Time, _MTime),
io__write_string("got same results\n", !IO).
trial(N, _Time, _MTime),
io__write_string("got same results\n", !IO).
:- pred trial(int::in, int::out, int::out) is cc_multi.
trial(N, Time, MTime) :-
benchmark_det(fib, N, Res, 1, Time),
benchmark_det(mfib, N, MRes, 1, MTime),
require(unify(Res, MRes), "tabling produces wrong answer").
benchmark_det(fib, N, Res, 1, Time),
benchmark_det(mfib, N, MRes, 1, MTime),
require(unify(Res, MRes), "tabling produces wrong answer").
:- pred fib(int::in, int::out) is det.
fib(N, F) :-
( N < 2 ->
F = 1
;
fib(N - 1, F1),
fib(N - 2, F2),
F = F1 + F2
).
( N < 2 ->
F = 1
;
fib(N - 1, F1),
fib(N - 2, F2),
F = F1 + F2
).
:- pred mfib(int::in, int::out) is det.
:- pragma memo(mfib/2, [allow_reset]).
mfib(N, F) :-
( N < 2 ->
F = 1
;
mfib(N - 1, F1),
mfib(N - 2, F2),
F = F1 + F2
).
( N < 2 ->
F = 1
;
mfib(N - 1, F1),
mfib(N - 2, F2),
F = F1 + F2
).

2
tests/debugger/field_names.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred field_names.main/2-0 (det) field_names.m:63
1: 1 1 CALL pred field_names.main/2-0 (det) field_names.m:68
mdb> echo on
Command echo enabled.
mdb> register --quiet

117
tests/debugger/field_names.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module field_names.
:- interface.
@@ -8,79 +12,80 @@
:- implementation.
:- type t1
---> t1f1(
t1a :: int,
t1b :: int,
int,
t1d :: int
)
; t1f2(
t1e :: int,
int,
t1g :: int
).
---> t1f1(
t1a :: int,
t1b :: int,
int,
t1d :: int
)
; t1f2(
t1e :: int,
int,
t1g :: int
).
:- type t2(U)
---> t2f(
t2a :: U,
int,
t2b :: t1,
t2c :: t1
).
---> t2f(
t2a :: U,
int,
t2b :: t1,
t2c :: t1
).
:- type t3(V)
---> some [W] t3f(
t3a :: V,
t3b :: int,
t3c :: W,
t3d :: t1
).
---> some [W] t3f(
t3a :: V,
t3b :: int,
t3c :: W,
t3d :: t1
).
:- type t4 == t2(float).
:- type t4 == t2(float).
:- type t5
---> t5f(
t5a :: t1
).
---> t5f(
t5a :: t1
).
:- type t6
---> t6f(
float
).
---> t6f(
float
).
:- type t7
---> t7f(
float,
int
).
---> t7f(
float,
int
).
:- type t8
---> t8a ; t8b.
---> t8a
; t8b.
:- type dummy
---> dummy.
---> dummy.
main -->
{ make_t1f1(41, 42, 43, 44, T1F1) },
{ make_t1f2(51, 52, 53, T1F2) },
{ make_t2(0.6, 61, T1F1, T1F2, T2) },
{ make_t3(T1F2, 72, T1F1, T3) },
{ make_t4(T2, T4) },
{ make_t5(T1F1, T5) },
{ make_t6(0.9, T6) },
{ make_t7(0.9, 77, T7) },
{ make_t8(T8) },
{ make_dummy(Dummy) },
io__write(T1F1), nl,
io__write(T1F2), nl,
io__write(T2), nl,
io__write(T3), nl,
io__write(T4), nl,
io__write(T5), nl,
io__write(T6), nl,
io__write(T7), nl,
io__write(T8), nl,
io__write(Dummy), nl.
{ make_t1f1(41, 42, 43, 44, T1F1) },
{ make_t1f2(51, 52, 53, T1F2) },
{ make_t2(0.6, 61, T1F1, T1F2, T2) },
{ make_t3(T1F2, 72, T1F1, T3) },
{ make_t4(T2, T4) },
{ make_t5(T1F1, T5) },
{ make_t6(0.9, T6) },
{ make_t7(0.9, 77, T7) },
{ make_t8(T8) },
{ make_dummy(Dummy) },
io__write(T1F1), nl,
io__write(T1F2), nl,
io__write(T2), nl,
io__write(T3), nl,
io__write(T4), nl,
io__write(T5), nl,
io__write(T6), nl,
io__write(T7), nl,
io__write(T8), nl,
io__write(Dummy), nl.
:- pred make_t1f1(int::in, int::in, int::in, int::in, t1::out) is det.
make_t1f1(A, B, C, D, t1f1(A, B, C, D)).

10
tests/debugger/higher_order.exp
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred higher_order.main/2-0 (det) higher_order.m:12
E1: C1 CALL pred higher_order.main/2-0 (det) higher_order.m:18
mdb> echo on
Command echo enabled.
mdb> context none
@@ -42,23 +42,23 @@ mdb> print *
mdb> step
E8: C5 CALL pred higher_order.domap/3-0 (det)
mdb> print *
P (arg 1) lambda_higher_order_m_21([6])
P (arg 1) lambda_higher_order_m_27([6])
HeadVar__2 [[1, 2], [3, 4, 5]]
mdb> finish
E9: C5 EXIT pred higher_order.domap/3-0 (det)
mdb> print *
P (arg 1) lambda_higher_order_m_21([6])
P (arg 1) lambda_higher_order_m_27([6])
HeadVar__2 [[1, 2], [3, 4, 5]]
HeadVar__3 [[6, 1, 2], [6, 3, 4, 5]]
mdb> step
E10: C6 CALL pred higher_order.domap/3-0 (det)
mdb> print *
P (arg 1) lambda_higher_order_m_22(["a"])
P (arg 1) lambda_higher_order_m_28(["a"])
HeadVar__2 [["one", "two"], ["three", "four", "five"]]
mdb> finish
E11: C6 EXIT pred higher_order.domap/3-0 (det)
mdb> print *
P (arg 1) lambda_higher_order_m_22(["a"])
P (arg 1) lambda_higher_order_m_28(["a"])
HeadVar__2 [["one", "two"], ["three", "four", "five"]]
HeadVar__3 [["a", "one", "two"], ["a", "three", "four", "five"]]
mdb> continue -S

42
tests/debugger/higher_order.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module higher_order.
:- interface.
@@ -7,33 +11,35 @@
:- implementation.
:- import_module int, float, list.
:- import_module int.
:- import_module float.
:- import_module list.
main -->
{ IntIn = [1, 2, 3, 4, 5] },
{ FloatIn = [1.0, 2.0, 3.0, 4.0, 5.0] },
{ IntListIn = [[1, 2], [3, 4, 5]] },
{ StringListIn = [["one", "two"], ["three", "four", "five"]] },
{ IntIn = [1, 2, 3, 4, 5] },
{ FloatIn = [1.0, 2.0, 3.0, 4.0, 5.0] },
{ IntListIn = [[1, 2], [3, 4, 5]] },
{ StringListIn = [["one", "two"], ["three", "four", "five"]] },
{ domap(float_add2(3.0), FloatIn, FloatAdd2Out) },
{ domap(float_op3(4.0, 5.0), FloatIn, FloatOp3Out) },
{ domap(int__max(3), IntIn, IntMaxOut) },
{ domap(do_append([6]), IntListIn, IntAppendOut) },
{ domap(do_append(["a"]), StringListIn, StringAppendOut) },
{ domap(float_add2(3.0), FloatIn, FloatAdd2Out) },
{ domap(float_op3(4.0, 5.0), FloatIn, FloatOp3Out) },
{ domap(int__max(3), IntIn, IntMaxOut) },
{ domap(do_append([6]), IntListIn, IntAppendOut) },
{ domap(do_append(["a"]), StringListIn, StringAppendOut) },
io__write(FloatAdd2Out), nl,
io__write(FloatOp3Out), nl,
io__write(IntMaxOut), nl,
io__write(IntAppendOut), nl,
io__write(StringAppendOut), nl.
io__write(FloatAdd2Out), nl,
io__write(FloatOp3Out), nl,
io__write(IntMaxOut), nl,
io__write(IntAppendOut), nl,
io__write(StringAppendOut), nl.
:- pred domap(pred(X, Y), list(X), list(Y)).
:- mode domap(pred(in, out) is det, in, out) is det.
domap(_, [], []).
domap(P, [H0 | T0], [H | T]) :-
P(H0, H),
domap(P, T0, T).
P(H0, H),
domap(P, T0, T).
:- pred float_add2(float::in, float::in, float::out) is det.
@@ -46,4 +52,4 @@ float_op3(A, B, C, A + B * C).
:- pred do_append(list(T)::in, list(T)::in, list(T)::out) is det.
do_append(A, B, C) :-
list__append(A, B, C).
list__append(A, B, C).

2
tests/debugger/implied_instance.exp
View File

@@ -1,4 +1,4 @@
1: 1 1 CALL pred implied_instance.main/2-0 (det) implied_instance.m:25
1: 1 1 CALL pred implied_instance.main/2-0 (det) implied_instance.m:30
mdb> echo on
Command echo enabled.
mdb> register --quiet

34
tests/debugger/implied_instance.m
View File

@@ -1,3 +1,7 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module implied_instance.
:- interface.
@@ -8,27 +12,28 @@
:- implementation.
:- import_module int, list.
:- import_module int.
:- import_module list.
:- typeclass sumable(A) where [
pred p(A::in, int::out) is det
pred p(A::in, int::out) is det
].
:- instance sumable(int) where [
pred(p/2) is copy_int
pred(p/2) is copy_int
].
:- instance sumable(list(T)) <= sumable(T) where [
pred(p/2) is sum_int_list
pred(p/2) is sum_int_list
].
main -->
{ p(2, SumA) },
{ p([42, 24, 1, 2, 3], SumB) },
io__write_int(SumA),
io__write_string("\n"),
io__write_int(SumB),
io__write_string("\n").
{ p(2, SumA) },
{ p([42, 24, 1, 2, 3], SumB) },
io__write_int(SumA),
io__write_string("\n"),
io__write_int(SumB),
io__write_string("\n").
:- pred copy_int(int, int).
:- mode copy_int(in, out) is det.
@@ -39,8 +44,7 @@ copy_int(N, N).
:- mode sum_int_list(in, out) is det.
sum_int_list([], 0).
sum_int_list([X|Xs], Sum) :-
p(X, SumA),
sum_int_list(Xs, SumB),
Sum = SumA + SumB.
sum_int_list([X | Xs], Sum) :-
p(X, SumA),
sum_int_list(Xs, SumB),
Sum = SumA + SumB.

109
tests/debugger/interactive.m
View File

@@ -1,26 +1,31 @@
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
:- module interactive.
:- interface.
:- import_module io, list.
:- import_module io.
:- import_module list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
% exported for use with interactive queries in the debugger
% exported for use with interactive queries in the debugger
:- pred qperm(list(T), list(T)).
:- mode qperm(in, out) is nondet.
:- implementation.
:- import_module list, int.
:- import_module int.
main -->
( { data(Data), queen(Data, Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
( { data(Data), queen(Data, Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
:- pred data(list(int)).
:- mode data(out) is det.
@@ -37,66 +42,66 @@ main -->
:- pred nodiag(int, int, list(int)).
:- mode nodiag(in, in, in) is semidet.
data([1,2,3,4,5]).
data([1, 2, 3, 4, 5]).
queen(Data, Out) :-
qperm(Data, Out),
safe(Out).
qperm(Data, Out),
safe(Out).
qperm([], []).
qperm([X|Y], K) :-
qdelete(U, [X|Y], Z),
K = [U|V],
qperm(Z, V).
qperm([X | Y], K) :-
qdelete(U, [X | Y], Z),
K = [U | V],
qperm(Z, V).
qdelete(A, [A|L], L).
qdelete(X, [A|Z], [A|R]) :-
qdelete(X, Z, R).
qdelete(A, [A | L], L).
qdelete(X, [A | Z], [A | R]) :-
qdelete(X, Z, R).
safe([]).
safe([N|L]) :-
nodiag(N, 1, L),
safe(L).
safe([N | L]) :-
nodiag(N, 1, L),
safe(L).
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
NmB is N - B,
BmN is B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 is D + 1,
nodiag(B, D1, L).
nodiag(B, D, [N | L]) :-
NmB is N - B,
BmN is B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 is D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
print_list_2([X | Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).

6
tests/debugger/interpreter.exp2
View File

@@ -1,4 +1,4 @@
E1: C1 CALL pred interpreter.main/2-0 (det) interpreter.m:34
E1: C1 CALL pred interpreter.main/2-0 (det) interpreter.m:43
mdb> echo on
Command echo enabled.
mdb> context none
@@ -30,14 +30,14 @@ mdb> finish
mdb> print *
Database (arg 1) []
VarSet (arg 2) varset(var_supply(0), empty, empty)
Term (arg 3) functor(atom(":-"), [functor(atom/1, [|]/2, context/2)], context("interpreter.m", 22))
Term (arg 3) functor(atom(":-"), [functor(atom/1, [|]/2, context/2)], context("interpreter.m", 24))
HeadVar__4 [clause(varset(var_supply/1, empty, empty), functor(atom/1, [|]/2, context/2), functor(atom/1, [], context/2))]
mdb> finish -a
This command is a no-op from this port.
mdb> print *
Database (arg 1) []
VarSet (arg 2) varset(var_supply(0), empty, empty)
Term (arg 3) functor(atom(":-"), [functor(atom/1, [|]/2, context/2)], context("interpreter.m", 22))
Term (arg 3) functor(atom(":-"), [functor(atom/1, [|]/2, context/2)], context("interpreter.m", 24))
HeadVar__4 [clause(varset(var_supply/1, empty, empty), functor(atom/1, [|]/2, context/2), functor(atom/1, [], context/2))]
mdb>
E5: C4 CALL pred interpreter.consult_until_eof/4-0 (det)

407
tests/debugger/interpreter.m
View File

@@ -1,23 +1,25 @@
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% File: interpreter.m.
% Main author: fjh.
%
% This is an interpreter for definite logic programs
% (i.e. pure Prolog with no negation or if-then-else.)
%
% This is just intended as a demonstration of the use of the
% meta-programming library modules term, varset, and term_io.
%
% There are many extensions/improvements that could be made;
% they're left as an exercise for the reader.
% they are left as an exercise for the reader.
%
% For a more efficient version (using backtrackable destructive update),
% see extras/trailed_update/samples/interpreter.m.
%
% This source file is hereby placed in the public domain. -fjh (the author).
%-----------------------------------------------------------------------------%
%
%---------------------------------------------------------------------------%
:- module interpreter.
:- interface.
@@ -26,124 +28,131 @@
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module list, string, term, varset, term_io, require, solutions.
:- import_module list.
:- import_module require.
:- import_module solutions.
:- import_module string.
:- import_module term.
:- import_module term_io.
:- import_module varset.
main -->
io__write_string("Pure Prolog Interpreter.\n\n"),
io__command_line_arguments(Args),
( { Args = [] } ->
io__stderr_stream(StdErr),
io__write_string(StdErr, "Usage: interpreter filename ...\n"),
io__set_exit_status(1)
;
{ database_init(Database0) },
consult_list(Args, Database0, Database),
main_loop(Database)
).
io__write_string("Pure Prolog Interpreter.\n\n"),
io__command_line_arguments(Args),
( { Args = [] } ->
io__stderr_stream(StdErr),
io__write_string(StdErr, "Usage: interpreter filename ...\n"),
io__set_exit_status(1)
;
{ database_init(Database0) },
consult_list(Args, Database0, Database),
main_loop(Database)
).
:- pred main_loop(database, io__state, io__state).
:- mode main_loop(in, di, uo) is det.
main_loop(Database) -->
io__write_string("?- "),
term_io__read_term(ReadTerm),
main_loop_2(ReadTerm, Database).
io__write_string("?- "),
term_io__read_term(ReadTerm),
main_loop_2(ReadTerm, Database).
:- pred main_loop_2(read_term, database, io__state, io__state).
:- mode main_loop_2(in, in, di, uo) is det.
main_loop_2(eof, _Database) --> [].
main_loop_2(error(ErrorMessage, LineNumber), Database) -->
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
main_loop(Database).
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
main_loop(Database).
main_loop_2(term(VarSet0, Goal), Database) -->
%%% It would be a good idea to add some special commands
%%% with side-effects (such as `consult' and `listing');
%%% these could be identified and processed here.
{ solutions(solve(Database, Goal, VarSet0), Solutions) },
write_solutions(Solutions, Goal),
main_loop(Database).
%%% It would be a good idea to add some special commands
%%% with side-effects (such as `consult' and `listing');
%%% these could be identified and processed here.
{ solutions(solve(Database, Goal, VarSet0), Solutions) },
write_solutions(Solutions, Goal),
main_loop(Database).
:- pred write_solutions(list(varset), term, io__state, io__state).
:- mode write_solutions(in, in, di, uo) is det.
write_solutions(Solutions, Goal) -->
( { Solutions = [] } ->
io__write_string("No.\n")
;
write_solutions_2(Solutions, Goal),
io__write_string("Yes.\n")
).
( { Solutions = [] } ->
io__write_string("No.\n")
;
write_solutions_2(Solutions, Goal),
io__write_string("Yes.\n")
).
:- pred write_solutions_2(list(varset), term, io__state, io__state).
:- mode write_solutions_2(in, in, di, uo) is det.
write_solutions_2([], _) --> [].
write_solutions_2([VarSet | VarSets], Goal) -->
term_io__write_term_nl(VarSet, Goal),
write_solutions_2(VarSets, Goal).
term_io__write_term_nl(VarSet, Goal),
write_solutions_2(VarSets, Goal).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred consult_list(list(string), database, database, io__state, io__state).
:- mode consult_list(in, in, out, di, uo) is det.
consult_list([], Database, Database) --> [].
consult_list([File | Files], Database0, Database) -->
consult(File, Database0, Database1),
consult_list(Files, Database1, Database).
consult(File, Database0, Database1),
consult_list(Files, Database1, Database).
:- pred consult(string, database, database, io__state, io__state).
:- mode consult(in, in, out, di, uo) is det.
consult(File, Database0, Database) -->
io__write_string("Consulting file `"),
io__write_string(File),
io__write_string("'...\n"),
io__see(File, Result),
( { Result = ok } ->
consult_until_eof(Database0, Database),
io__seen
;
io__write_string("Error opening file `"),
io__write_string(File),
io__write_string("' for input.\n"),
{ Database = Database0 }
).
io__write_string("Consulting file `"),
io__write_string(File),
io__write_string("'...\n"),
io__see(File, Result),
( { Result = ok } ->
consult_until_eof(Database0, Database),
io__seen
;
io__write_string("Error opening file `"),
io__write_string(File),
io__write_string("' for input.\n"),
{ Database = Database0 }
).
:- pred consult_until_eof(database, database, io__state, io__state).
:- mode consult_until_eof(in, out, di, uo) is det.
consult_until_eof(Database0, Database) -->
term_io__read_term(ReadTerm),
consult_until_eof_2(ReadTerm, Database0, Database).
term_io__read_term(ReadTerm),
consult_until_eof_2(ReadTerm, Database0, Database).
:- pred consult_until_eof_2(read_term, database, database,
io__state, io__state).
io__state, io__state).
:- mode consult_until_eof_2(in, in, out, di, uo) is det.
consult_until_eof_2(eof, Database, Database) --> [].
consult_until_eof_2(error(ErrorMessage, LineNumber), Database0, Database) -->
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
consult_until_eof(Database0, Database).
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
consult_until_eof(Database0, Database).
consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
{ database_assert_clause(Database0, VarSet, Term, Database1) },
consult_until_eof(Database1, Database).
{ database_assert_clause(Database0, VarSet, Term, Database1) },
consult_until_eof(Database1, Database).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Solve takes a database of rules and facts, a goal to be solved,
% and a varset (which includes a supply of fresh vars, a substitution,
@@ -152,7 +161,7 @@ consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
% some new vars, and returns the result.
% Goals are stored just as terms.
% (It might be more efficient to parse them
% (It might be more efficient to parse them
% before storing them in the database. Currently we do
% this parsing work every time we interpret a clause.)
@@ -161,33 +170,33 @@ consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
solve(_Database, term__functor(term__atom("true"), [], _)) --> [].
solve(Database, term__functor(term__atom(","), [A, B], _)) -->
solve(Database, A),
solve(Database, B).
solve(Database, term__functor(term__atom(", "), [A, B], _)) -->
solve(Database, A),
solve(Database, B).
solve(Database, term__functor(term__atom(";"), [A, B], _)) -->
solve(Database, A)
;
solve(Database, B).
solve(Database, A)
;
solve(Database, B).
solve(_Database, term__functor(term__atom("="), [A, B], _)) -->
unify(A, B).
unify(A, B).
solve(Database, Goal) -->
{ database_lookup_clause(Database, Goal, ClauseVarSet, Head0, Body0) },
rename_apart(ClauseVarSet, [Head0, Body0], [Head, Body]),
unify(Goal, Head),
solve(Database, Body).
{ database_lookup_clause(Database, Goal, ClauseVarSet, Head0, Body0) },
rename_apart(ClauseVarSet, [Head0, Body0], [Head, Body]),
unify(Goal, Head),
solve(Database, Body).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred rename_apart(varset, list(term), list(term), varset, varset).
:- mode rename_apart(in, in, out, in, out) is det.
rename_apart(NewVarSet, Terms0, Terms, VarSet0, VarSet) :-
varset__merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).
varset__merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% The standard library module `term' contains routines for
% unifying terms based on separate substitutions, but we are
@@ -198,144 +207,144 @@ rename_apart(NewVarSet, Terms0, Terms, VarSet0, VarSet) :-
:- mode unify(in, in, in, out) is semidet.
unify(term__variable(X, _), term__variable(Y, _), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
(
varset__search_var(VarSet0, Y, BindingOfY)
->
% both X and Y already have bindings - just
% unify the terms they are bound to
unify(BindingOfX, BindingOfY, VarSet0, VarSet)
;
% Y is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfX, VarSet0,
SubstBindingOfX),
( SubstBindingOfX = term__variable(Y, _) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfX, Y, VarSet0),
varset__bind_var(Y, SubstBindingOfX,
VarSet0, VarSet)
)
)
;
(
varset__search_var(VarSet0, Y, BindingOfY2)
->
% X is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfY2, VarSet0,
SubstBindingOfY2),
( SubstBindingOfY2 = term__variable(X, _) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfY2, X, VarSet0),
varset__bind_var(X, SubstBindingOfY2,
VarSet0, VarSet)
)
;
% both X and Y are unbound variables -
% bind one to the other
( X = Y ->
VarSet = VarSet0
;
varset__bind_var(X,
term.variable(Y, context_init), VarSet0, VarSet)
)
)
).
(
varset__search_var(VarSet0, X, BindingOfX)
->
(
varset__search_var(VarSet0, Y, BindingOfY)
->
% both X and Y already have bindings - just
% unify the terms they are bound to
unify(BindingOfX, BindingOfY, VarSet0, VarSet)
;
% Y is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfX, VarSet0,
SubstBindingOfX),
( SubstBindingOfX = term__variable(Y, _) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfX, Y, VarSet0),
varset__bind_var(Y, SubstBindingOfX,
VarSet0, VarSet)
)
)
;
(
varset__search_var(VarSet0, Y, BindingOfY2)
->
% X is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfY2, VarSet0,
SubstBindingOfY2),
( SubstBindingOfY2 = term__variable(X, _) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfY2, X, VarSet0),
varset__bind_var(X, SubstBindingOfY2,
VarSet0, VarSet)
)
;
% both X and Y are unbound variables -
% bind one to the other
( X = Y ->
VarSet = VarSet0
;
varset__bind_var(X,
term.variable(Y, context_init), VarSet0, VarSet)
)
)
).
unify(term__variable(X, _), term__functor(F, As, C), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(BindingOfX, term__functor(F, As, C), VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(X, term__functor(F, As, C), VarSet0, VarSet)
).
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(BindingOfX, term__functor(F, As, C), VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(X, term__functor(F, As, C), VarSet0, VarSet)
).
unify(term__functor(F, As, C), term__variable(X, _), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(term__functor(F, As, C), BindingOfX, VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(X, term__functor(F, As, C), VarSet0, VarSet)
).
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(term__functor(F, As, C), BindingOfX, VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(X, term__functor(F, As, C), VarSet0, VarSet)
).
unify(term__functor(F, AsX, _), term__functor(F, AsY, _)) -->
unify_list(AsX, AsY).
unify_list(AsX, AsY).
:- pred unify_list(list(term), list(term), varset, varset).
:- mode unify_list(in, in, in, out) is semidet.
unify_list([], []) --> [].
unify_list([X | Xs], [Y | Ys]) -->
unify(X, Y),
unify_list(Xs, Ys).
unify(X, Y),
unify_list(Xs, Ys).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% occurs(Term, Var, Subst) succeeds if Term contains Var,
% perhaps indirectly via the substitution. (The variable must
% not be mapped by the substitution.)
% occurs(Term, Var, Subst) succeeds if Term contains Var,
% perhaps indirectly via the substitution. (The variable must
% not be mapped by the substitution.)
:- pred occurs(term, var, varset).
:- mode occurs(in, in, in) is semidet.
occurs(term__variable(X, _), Y, VarSet) :-
X = Y
;
varset__search_var(VarSet, X, BindingOfX),
occurs(BindingOfX, Y, VarSet).
X = Y
;
varset__search_var(VarSet, X, BindingOfX),
occurs(BindingOfX, Y, VarSet).
occurs(term__functor(_F, As, _), Y, VarSet) :-
occurs_list(As, Y, VarSet).
occurs_list(As, Y, VarSet).
:- pred occurs_list(list(term), var, varset).
:- mode occurs_list(in, in, in) is semidet.
occurs_list([Term | Terms], Y, VarSet) :-
occurs(Term, Y, VarSet)
;
occurs_list(Terms, Y, VarSet).
occurs(Term, Y, VarSet)
;
occurs_list(Terms, Y, VarSet).
%-----------------------------------------------------------------------------%
% apply_rec_substitution(Term0, VarSet, Term) :
% recursively apply substitution to Term0 until
% no more substitions can be applied, and then
% return the result in Term.
%---------------------------------------------------------------------------%
% apply_rec_substitution(Term0, VarSet, Term):
%
% Recursively apply substitution to Term0 until no more substitions
% can be applied, and then return the result in Term.
%
:- pred apply_rec_substitution(term, varset, term).
:- mode apply_rec_substitution(in, in, out) is det.
apply_rec_substitution(term__variable(Var, _), VarSet, Term) :-
(
varset__search_var(VarSet, Var, Replacement)
->
% recursively apply the substition to the replacement
apply_rec_substitution(Replacement, VarSet, Term)
;
Term = term__variable(Var, context_init)
).
(
varset__search_var(VarSet, Var, Replacement)
->
% Recursively apply the substitution to the replacement.
apply_rec_substitution(Replacement, VarSet, Term)
;
Term = term__variable(Var, context_init)
).
apply_rec_substitution(term__functor(Name, Args0, Context), VarSet,
term__functor(Name, Args, Context)) :-
apply_rec_substitution_to_list(Args0, VarSet, Args).
term__functor(Name, Args, Context)) :-
apply_rec_substitution_to_list(Args0, VarSet, Args).
:- pred apply_rec_substitution_to_list(list(term), varset, list(term)).
:- mode apply_rec_substitution_to_list(in, in, out) is det.
apply_rec_substitution_to_list([], _VarSet, []).
apply_rec_substitution_to_list([Term0 | Terms0], VarSet,
[Term | Terms]) :-
apply_rec_substitution(Term0, VarSet, Term),
apply_rec_substitution_to_list(Terms0, VarSet, Terms).
[Term | Terms]) :-
apply_rec_substitution(Term0, VarSet, Term),
apply_rec_substitution_to_list(Terms0, VarSet, Terms).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% We store the database just as a list of clauses.
% (It would be more realistic to index this on the predicate name/arity
@@ -353,21 +362,21 @@ database_init([]).
:- mode database_assert_clause(in, in, in, out) is det.
database_assert_clause(Database, VarSet, Term, [Clause | Database]) :-
( Term = term__functor(term__atom(":-"), [H, B], _) ->
Head = H,
Body = B
;
Head = Term,
term__context_init(Context),
Body = term__functor(term__atom("true"), [], Context)
),
Clause = clause(VarSet, Head, Body).
( Term = term__functor(term__atom(":-"), [H, B], _) ->
Head = H,
Body = B
;
Head = Term,
term__context_init(Context),
Body = term__functor(term__atom("true"), [], Context)
),
Clause = clause(VarSet, Head, Body).
:- pred database_lookup_clause(database, term, varset, term, term).
:- mode database_lookup_clause(in, in, out, out, out) is nondet.
database_lookup_clause(Database, _Goal, VarSet, Head, Body) :-
list__member(Clause, Database),
Clause = clause(VarSet, Head, Body).
list__member(Clause, Database),
Clause = clause(VarSet, Head, Body).
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

Some files were not shown because too many files have changed in this diff Show More