[m-dev.] diff: test cases for accumulator introduction.
Peter Ross
petdr at cs.mu.OZ.AU
Wed Jun 16 16:18:50 AEST 1999
Hi,
This is the test cases directory for accumulator introduction phase.
Any comments, welcome.
===================================================================
Estimated hours taken: 10
Test cases for accumulator introduction.
INTRODUCED:
Special file which records which procedures should be optimised.
README:
Explain what the INTRODUCED file is for.
runtests:
Run the tests.
base.exp:
base.m:
call_in_base.exp:
call_in_base.m:
chain.exp:
chain.m:
construct.exp:
construct.m:
dcg.exp:
dcg.m:
deconstruct.exp:
deconstruct.m:
disj.exp:
disj.m:
heuristic.exp:
heuristic.m:
highorder.exp:
highorder.m:
identity.exp:
identity.m:
inter.exp:
inter.m:
nonrec.exp:
nonrec.m:
out_to_in.exp:
out_to_in.m:
qsort.exp:
qsort.m:
simple.exp:
simple.m:
split.exp:
split.m:
swap.exp:
swap.m:
The actual tests.
Mmakefile:
the usual.
Index: INTRODUCED
===================================================================
RCS file: INTRODUCED
diff -N INTRODUCED
--- /dev/null Wed Jun 16 16:13:40 1999
+++ INTRODUCED Wed Jun 16 16:12:35 1999
@@ -0,0 +1,10 @@
+ % mode 0 `base:AccFrom__pred__p__23__0/4' (det):
+ % mode 0 `call_in_base:AccFrom__pred__l__23__0/4' (det):
+ % mode 0 `chain:AccFrom__pred__pa__39__0/4' (det):
+ % mode 0 `chain:AccFrom__pred__pc__67__0/4' (det):
+ % mode 0 `construct:AccFrom__pred__p2__46__0/5' (det):
+ % mode 0 `dcg:AccFrom__pred__p__38__0/7' (det):
+ % mode 0 `disj:AccFrom__pred__p__47__0/3' (multi):
+ % mode 0 `identity:AccFrom__pred__r__25__0/4' (det):
+ % mode 0 `inter:AccFrom__pred__rl__26__0/6' (det):
+ % mode 0 `swap:AccFrom__pred__rev__24__0/4' (det):
Index: Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Wed Jun 16 16:13:40 1999
+++ Mmakefile Wed Jun 16 15:51:47 1999
@@ -0,0 +1,62 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../../Mmake.common
+
+#-----------------------------------------------------------------------------#
+
+ifeq ($(HAVE_NUPROLOG),yes)
+%.exp: %.nu
+ { [ -f $*.inp ] && cat $*.inp; } | ./$< > $@ 2>&1;
+endif
+
+#-----------------------------------------------------------------------------#
+
+# Any program added here should also be added to the `.cvsignore' file.
+
+PROGS= base \
+ call_in_base \
+ chain \
+ construct \
+ deconstruct \
+ dcg \
+ disj \
+ highorder \
+ heuristic \
+ identity \
+ inter \
+ nonrec \
+ out_to_in \
+ qsort \
+ simple \
+ split \
+ swap
+
+MCFLAGS = -d39 --introduce-accumulators --optimize-constructor-last-call
+
+ # programs which aren't working.
+NOT_WORKING =
+
+DEPENDS=$(PROGS:%=%.depend)
+OUTS= $(PROGS:%=%.out)
+EXPS= $(PROGS:%=%.exp)
+RESS= $(PROGS:%=%.res)
+MODS= $(PROGS:%=%.mod)
+
+depend: $(DEPENDS)
+
+exp: $(EXPS)
+
+check: $(OUTS) $(RESS)
+
+mods: $(MODS)
+
+all: $(PROGS)
+
+realclean: clean_hlds_dump
+
+clean_hlds_dump:
+ -rm -f *hlds_dump*
+
+#-----------------------------------------------------------------------------#
Index: README
===================================================================
RCS file: README
diff -N README
--- /dev/null Wed Jun 16 16:13:40 1999
+++ README Wed Jun 16 15:59:06 1999
@@ -0,0 +1,4 @@
+The file INTRODUCED contains the procedures which should have an
+accumulator introduced for them, when the following options are set
+
+ --introduce-accumulators --optimize-constructor-last-call
Index: base.exp
===================================================================
RCS file: base.exp
diff -N base.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ base.exp Tue Apr 20 19:57:16 1999
@@ -0,0 +1 @@
+l: 103
Index: base.m
===================================================================
RCS file: base.m
diff -N base.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ base.m Wed Jun 16 16:13:31 1999
@@ -0,0 +1,28 @@
+ %
+ % Tests that we handle the case of a dynamic value for the base
+ % case coming from the previous call.
+ %
+:- module base.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ io__write_string("l: "),
+ { p([1,10,100], 5, Length) },
+ io__write(Length),
+ io__nl.
+
+:- 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.
Index: call_in_base.exp
===================================================================
RCS file: call_in_base.exp
diff -N call_in_base.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ call_in_base.exp Tue Apr 20 19:57:21 1999
@@ -0,0 +1 @@
+l: 3
Index: call_in_base.m
===================================================================
RCS file: call_in_base.m
diff -N call_in_base.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ call_in_base.m Wed Jun 16 16:13:35 1999
@@ -0,0 +1,34 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ io__write_string("l: "),
+ { l([1,10,100], Length) },
+ io__write(Length),
+ io__nl.
+
+:- pred l(list(T)::in, int::out) is det.
+
+l([], Init) :-
+ init(Init).
+l([_|T], L) :-
+ l(T, L0),
+ L is L0 + 1.
+
+:- pred init(int::out) is det.
+:- pragma no_inline(init/1).
+
+init(0).
Index: chain.exp
===================================================================
RCS file: chain.exp
diff -N chain.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ chain.exp Tue Jun 1 17:12:44 1999
@@ -0,0 +1,4 @@
+pa: [7, 1, 6, 1, 5, 1]
+pb: [5, 1, 6, 1, 7, 1]
+pc: 27
+pd: 30
Index: chain.m
===================================================================
RCS file: chain.m
diff -N chain.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ chain.m Wed Jun 16 16:13:40 1999
@@ -0,0 +1,87 @@
+ %
+ % Tests chained calls to a predicate that requires
+ % rearrangement.
+ %
+:- module chain.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, 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.
+
+ %
+ % 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).
+
+ %
+ % 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).
+
+ %
+ % 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.
+
+ %
+ % 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.
Index: construct.exp
===================================================================
RCS file: construct.exp
diff -N construct.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ construct.exp Tue Apr 20 19:57:31 1999
@@ -0,0 +1,2 @@
+p1: [1, 10, 100]
+pb: [5, 6, 7, 1, 1, 1]
Index: construct.m
===================================================================
RCS file: construct.m
diff -N construct.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ construct.m Wed Jun 16 16:13:43 1999
@@ -0,0 +1,53 @@
+ %
+ % Tests that any construction unifications get handled properly.
+ %
+:- module construct.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- 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.
+
+:- pred p(list(T), list(T)).
+:- mode p(in, out) is det.
+
+ %
+ % Direct construction unification.
+ %
+p([], []).
+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.
+ %
+:- 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].
Index: dcg.exp
===================================================================
RCS file: dcg.exp
diff -N dcg.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ dcg.exp Tue Apr 20 19:57:41 1999
@@ -0,0 +1,4 @@
+p A: [0, 9, 100, 10, 1]
+p B: [0, 9, 100, 10, 1]
+p2 A2: [0, 9, 100, 10, 1]
+p2 B2: [1, 10, 100, 9, 0, 0, 9, 100, 10, 1]
Index: dcg.m
===================================================================
RCS file: dcg.m
diff -N dcg.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ dcg.m Wed Jun 16 16:13:47 1999
@@ -0,0 +1,69 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- 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.
+
+ %
+ % 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) }.
+
+
+ %
+ % 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) }.
+
+
+:- 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].
Index: deconstruct.exp
===================================================================
RCS file: deconstruct.exp
diff -N deconstruct.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ deconstruct.exp Tue Apr 20 19:57:36 1999
@@ -0,0 +1,2 @@
+p1: [1000, 1, 10, 100]
+pb: wrapper(3, [7, 6, 5])
Index: deconstruct.m
===================================================================
RCS file: deconstruct.m
diff -N deconstruct.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ deconstruct.m Wed Jun 16 16:13:51 1999
@@ -0,0 +1,66 @@
+ %
+ % Tests that any deconstruction unifications get handled properly.
+ %
+:- module deconstruct.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+
+:- 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.
+
+:- pred p(list(int), list(int)).
+:- mode p(in, out) is semidet.
+
+ %
+ % 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).
+
+ %
+ % 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).
Index: disj.exp
===================================================================
RCS file: disj.exp
diff -N disj.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ disj.exp Tue Apr 20 19:57:47 1999
@@ -0,0 +1,5 @@
+p: [24, 25, 28, 29, 31, 32, 35, 36]
+First soln p: 24
+p2: [0, 2, 16, 24, 28, 44, 66, 128]
+p3: [1, 8, 12]
+p4: [w(12, 3, 3), w(12, 3, 9), w(12, 3, 12)]
Index: disj.m
===================================================================
RCS file: disj.m
diff -N disj.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ disj.m Wed Jun 16 16:13:53 1999
@@ -0,0 +1,116 @@
+ %
+ % Tests that disjunctions gets handled properly.
+ %
+:- module disj.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module int, list, std_util.
+
+:- 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.
+
+:- pred pa(list(int), int).
+:- mode pa(in, out) is cc_multi.
+
+pa(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.
+ %
+p([], 0).
+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.
+ %
+:- 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.
+
+
+:- 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.
+
+:- pred p4a(list(int), wrapper).
+:- mode p4a(in, out) is nondet.
+
+p4a(X, Y) :-
+ 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.
Index: heuristic.exp
===================================================================
RCS file: heuristic.exp
diff -N heuristic.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ heuristic.exp Tue Apr 20 19:57:58 1999
@@ -0,0 +1 @@
+p: [1, 10, 100, 1, 2, 3, 6, 5, 4]
Index: heuristic.m
===================================================================
RCS file: heuristic.m
diff -N heuristic.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ heuristic.m Wed Jun 16 16:13:57 1999
@@ -0,0 +1,29 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ 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).
Index: highorder.exp
===================================================================
RCS file: highorder.exp
diff -N highorder.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ highorder.exp Tue Apr 20 19:57:52 1999
@@ -0,0 +1 @@
+foldr: 91
Index: highorder.m
===================================================================
RCS file: highorder.m
diff -N highorder.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ highorder.m Wed Jun 16 16:14:01 1999
@@ -0,0 +1,38 @@
+ %
+ % Highoder functions cannot use accumulator recursion because we
+ % don't know anything about the assocativity of P.
+ %
+:- module highorder.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, 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.
+
+ % 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).
Index: identity.exp
===================================================================
RCS file: identity.exp
diff -N identity.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ identity.exp Tue Apr 20 19:58:03 1999
@@ -0,0 +1 @@
+r: [1000, 100, 10, 1]
Index: identity.m
===================================================================
RCS file: identity.m
diff -N identity.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ identity.m Wed Jun 16 16:14:07 1999
@@ -0,0 +1,34 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ 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].
+r(X, R) :-
+ X = [H | T],
+ r(T, R0),
+ Tmp = [H],
+ append(R0, Tmp, R).
Index: inter.exp
===================================================================
RCS file: inter.exp
diff -N inter.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ inter.exp Tue Apr 20 19:58:08 1999
@@ -0,0 +1 @@
+rl: 3 [100, 10, 1]
Index: inter.m
===================================================================
RCS file: inter.m
diff -N inter.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ inter.m Wed Jun 16 16:14:09 1999
@@ -0,0 +1,37 @@
+ %
+ % This is an interleaved version of reverse and length.
+ % Tests if we can introduce more then one accumulator.
+ %
+:- module inter.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ 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 = [].
+rl(X, L, R) :-
+ X = [H | T],
+ rl(T, L0, R0),
+ L is L0 + 1,
+ Tmp = [H],
+ append(R0, Tmp, R).
Index: nonrec.exp
===================================================================
RCS file: nonrec.exp
diff -N nonrec.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ nonrec.exp Tue Apr 20 19:58:13 1999
@@ -0,0 +1,2 @@
+p(in, out, out): 3 [[1], [1], [1]]
+p(in, in, out): failed
Index: nonrec.m
===================================================================
RCS file: nonrec.m
diff -N nonrec.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ nonrec.m Wed Jun 16 16:14:14 1999
@@ -0,0 +1,50 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, 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.
+
+:- 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).
Index: out_to_in.exp
===================================================================
RCS file: out_to_in.exp
diff -N out_to_in.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ out_to_in.exp Tue Apr 20 19:58:19 1999
@@ -0,0 +1 @@
+q: [[1], [2, 1], [2, 1]] 10
Index: out_to_in.m
===================================================================
RCS file: out_to_in.m
diff -N out_to_in.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ out_to_in.m Wed Jun 16 16:14:17 1999
@@ -0,0 +1,46 @@
+ %
+ % 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.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- 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, list.
+
+:- 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).
Index: qsort.exp
===================================================================
RCS file: qsort.exp
diff -N qsort.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ qsort.exp Tue Apr 20 19:58:24 1999
@@ -0,0 +1 @@
+qsort: [0, 1, 4, 6, 7, 8]
Index: qsort.m
===================================================================
RCS file: qsort.m
diff -N qsort.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ qsort.m Wed Jun 16 16:14:22 1999
@@ -0,0 +1,44 @@
+ %
+ % Make sure that this doesn't get recognised as an
+ % opportunity to introduce accumulator recursion,
+ % because qsort is already tail recursive.
+ %
+:- module qsort.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ { 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).
+
+:- 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]
+ ).
Index: runtests
===================================================================
RCS file: runtests
diff -N runtests
--- /dev/null Wed Jun 16 16:13:40 1999
+++ runtests Tue Jun 15 15:56:40 1999
@@ -0,0 +1,51 @@
+#!/bin/sh
+# Test whether the code generated by the Mercury compiler is producing
+# the same output as code generated by the NU-Prolog compiler.
+# Return a status of 0 (true) if everything is all right, and 1 otherwise.
+#
+# The .exp files containing the expected output of each test should be under
+# CVS control. They can be updated by running
+#
+# mmake realclean
+# mmake depend
+# mmake exp
+#
+# on a machine that has NU-Prolog installed.
+
+. ../../handle_options
+. ../../startup
+
+mmake $jfactor depend || exit 1
+eval mmake -k $jfactor $gradeopt $flagsopt $cflagsopt check
+checkstatus=$?
+
+cat *.res > .allres
+if test ! -s .allres -a "$checkstatus" = 0
+then
+ grep -h "% mode.*AccFrom" *hlds*acc* | sed -e 's/number//' \
+ | sed -e 's/ of predicate//g' > I.$$
+ diff -u INTRODUCED I.$$ > INTRODUCED.diff
+ rm -f I.$$
+
+ if [ -s INTRODUCED.diff ]; then
+ echo "the tests in the general/accumulator directory failed"
+ echo "as some predicates didn't have accumulators introduced"
+ echo "gradeopt=$gradeopt, flagsopt=$flagsopt, cflagsopt=$cflagsopt"
+ echo "the predicates are:"
+ cat INTRODUCED.diff
+ exit 1
+ fi
+
+ echo "the tests in the general/accumulator directory succeeded"
+ echo "gradeopt=$gradeopt, flagsopt=$flagsopt, cflagsopt=$cflagsopt"
+ rm -f .allres INTRODUCED.diff
+ . ../../shutdown
+ exit 0
+else
+ echo "the tests in the general/accumulator directory failed"
+ echo "as some test cases didn't produce the correct output"
+ echo "gradeopt=$gradeopt, flagsopt=$flagsopt, cflagsopt=$cflagsopt"
+ echo "the differences are:"
+ cat .allres
+ exit 1
+fi
Index: simple.exp
===================================================================
RCS file: simple.exp
diff -N simple.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ simple.exp Tue Apr 20 19:58:30 1999
@@ -0,0 +1 @@
+foldr: 91
Index: simple.m
===================================================================
RCS file: simple.m
diff -N simple.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ simple.m Wed Jun 16 16:14:24 1999
@@ -0,0 +1,29 @@
+ %
+ % The call in the compose section isn't assocative.
+ %
+:- module simple.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ 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.
Index: split.exp
===================================================================
RCS file: split.exp
diff -N split.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ split.exp Tue Apr 20 19:58:36 1999
@@ -0,0 +1 @@
+p: 1
Index: split.m
===================================================================
RCS file: split.m
diff -N split.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ split.m Wed Jun 16 16:15:06 1999
@@ -0,0 +1,30 @@
+ %
+ % Test that all the output variables must be related to
+ % a variable in the recursive call.
+ %
+:- module split.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int.
+
+main -->
+ { 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(T, _),
+ Tmp = 0,
+ S is H + Tmp.
Index: swap.exp
===================================================================
RCS file: swap.exp
diff -N swap.exp
--- /dev/null Wed Jun 16 16:13:40 1999
+++ swap.exp Tue Apr 20 19:58:50 1999
@@ -0,0 +1 @@
+rev: [7, 6, 5]
Index: swap.m
===================================================================
RCS file: swap.m
diff -N swap.m
--- /dev/null Wed Jun 16 16:13:40 1999
+++ swap.m Wed Jun 16 16:15:08 1999
@@ -0,0 +1,29 @@
+ %
+ % Tests that the compiler recognises append is assocative if we
+ % swap the order of the two input arguments.
+ %
+:- module swap.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+main -->
+ 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).
----
+----------------------------------------------------------------------+
| Peter Ross M Sci/Eng Melbourne Uni |
| petdr at cs.mu.oz.au WWW: www.cs.mu.oz.au/~petdr/ ph: +61 3 9344 9158 |
+----------------------------------------------------------------------+
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list