Skip to content

Commit e5a412c

Browse files
hurufuhurufu
committed
Add benchmark and unit tests to reif.pl
Benchmarks compare performace of memberd/2 with and without goal expansion to memberchk/2. Unit test mostly capture the current behavior, do some sanity checks, couple of corner cases (like handling of cyclic terms) and property test of tfilter/3 and tpartition/4.
1 parent 864b85b commit e5a412c

File tree

7 files changed

+252
-0
lines changed

7 files changed

+252
-0
lines changed

‎benches/reif.pl

+63
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
/*
2+
Copied from^W^W Inspired by memberbench[1], but has only benchmarks relevant to
3+
goal expansion of if_/3 and is adapted to be better integrated into Scryer's
4+
benchmarking subsystem: which doesn't need time reporting, and supports only
5+
single test at a time.
6+
7+
[1]: http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/sicstus/memberbench.pl
8+
*/
9+
10+
:- use_module(library(reif)).
11+
:- use_module(library(lists)).
12+
:- use_module(library(si)).
13+
14+
15+
run(Test, Count) :-
16+
atom_si(Test),
17+
integer_si(Count),
18+
exptrue(Count),
19+
\+ benchmark(Test, z, "abcdefghijklmnopqrstuvwxyz ")
20+
; true.
21+
22+
23+
% Baseline test – the fastest possible implementation
24+
benchmark(memberchk, E, Es) :- memberchk(E, Es).
25+
26+
% Expanded if_/3
27+
benchmark(memberd_ifc, E, Es) :- memberd_ifc(E, Es).
28+
29+
% Non-expanded if_/3
30+
benchmark(memberd_fif, E, Es) :- memberd_fif(E, Es).
31+
32+
33+
memberd_ifc(X, [E|Es]) :-
34+
if_(X = E, true, memberd_ifc(X, Es)).
35+
36+
memberd_fif(X, [E|Es]) :-
37+
fif_(X = E, true, memberd_fif(X, Es)).
38+
39+
40+
% Copy of _if/3, but with a different name, so it won't be expanded
41+
fif_(If_1, Then_0, Else_0) :-
42+
call(If_1, T),
43+
( T == true -> Then_0
44+
; T == false -> Else_0
45+
; nonvar(T) -> throw(error(type_error(boolean, T), _))
46+
; throw(error(instantiation_error, _))
47+
).
48+
49+
50+
%% exptrue(N).
51+
%
52+
% Succeeds 10^N times if N is ground, usefull as a cheap way to repeat a given
53+
% predicate many times in benchmarks. There are many more ways to generate
54+
% choice points, but this one by far has the lowest overhead.
55+
exptrue(0).
56+
exptrue(1) :- ten.
57+
exptrue(2) :- ten, ten.
58+
exptrue(3) :- ten, ten, ten.
59+
exptrue(4) :- ten, ten, ten, ten.
60+
exptrue(5) :- ten, ten, ten, ten, ten.
61+
exptrue(6) :- ten, ten, ten, ten, ten, ten.
62+
63+
ten. ten. ten. ten. ten. ten. ten. ten. ten. ten.

‎benches/run_iai.rs

+3
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,9 @@ mod iai {
1313
#[bench::count_edges(setup::prolog_benches()["count_edges"].setup())]
1414
#[bench::numlist(setup::prolog_benches()["numlist"].setup())]
1515
#[bench::csv_codename(setup::prolog_benches()["csv_codename"].setup())]
16+
#[bench::memberbench_baseline(setup::prolog_benches()["memberbench_baseline"].setup())]
17+
#[bench::memberbench_if_expanded(setup::prolog_benches()["memberbench_if_expanded"].setup())]
18+
#[bench::memberbench_if_not_expanded(setup::prolog_benches()["memberbench_if_not_expanded"].setup())]
1619
fn bench(mut run: impl FnMut() -> Vec<LeafAnswer>) -> Vec<LeafAnswer> {
1720
run()
1821
}

‎benches/setup.rs

+27
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,33 @@ pub fn prolog_benches() -> BTreeMap<&'static str, PrologBenchmark> {
2626
Strategy::Reuse,
2727
btreemap! { "Name" => Term::string("SPACE") },
2828
),
29+
/* FIXME: Following 3 benchmarks don't bind any variables and shouldn't
30+
* produce any leaf answer, but test validate_benchmarks() fails if last
31+
* element is `btreemap! {}`, because result of a query is `[True]`, but
32+
* test case expects `[LeafAnswer { bindings: {} }]`. As a workaround
33+
* I've just added dummy variable unification.
34+
*/
35+
(
36+
"memberbench_baseline",
37+
"benches/reif.pl",
38+
"run(memberchk,4),X=done.",
39+
Strategy::Reuse,
40+
btreemap! { "X" => Term::atom("done") },
41+
),
42+
(
43+
"memberbench_if_expanded",
44+
"benches/reif.pl",
45+
"run(memberd_ifc,4),Y=done.",
46+
Strategy::Reuse,
47+
btreemap! { "Y" => Term::atom("done") },
48+
),
49+
(
50+
"memberbench_if_not_expanded",
51+
"benches/reif.pl",
52+
"run(memberd_fif,4),Z=done.",
53+
Strategy::Reuse,
54+
btreemap! { "Z" => Term::atom("done") },
55+
),
2956
]
3057
.map(|b| {
3158
(

‎src/tests/reif.pl

+147
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
:- module(reif_tests, []).
2+
3+
:- use_module(library(reif)).
4+
:- use_module(library(lists)).
5+
:- use_module(library(dif)).
6+
:- use_module(library(lambda)).
7+
:- use_module(library(random)).
8+
:- use_module(test_framework).
9+
10+
/*
11+
Those tests are just sanity checks – examples from the paper, to make sure I
12+
haven't messed up.
13+
*/
14+
test("indexing dif/2 p6#1", (
15+
findall(X-Fs, tfilter(=(X),[1,2,3,2,3,3],Fs), [1-[1], 2-[2,2], 3-[3,3,3], Y-[]]),
16+
maplist(dif(Y), [1,2,3])
17+
)).
18+
test("indexing dif/2 p6#2", findall(X, duplicate(X,[1,2,3,2,3,3]), [2,3])).
19+
test("indexing dif/2 p7#1", firstduplicate(1, [1,2,3,1])).
20+
test("indexing dif/2 p7#2",(
21+
firstduplicate(X, [1,2,3,1]),
22+
X == 1
23+
)).
24+
test("indexing dif/2 p7#3", (
25+
findall(Y-A-B-C, firstduplicate(Y,[A,B,C]), [X-X-X-_, X-X-B1-X, X-A2-X-X]),
26+
dif(B1,X),
27+
dif(A2,X)
28+
)).
29+
30+
test("doesnt modify free variables", (reif:goal_expanded(A,B), A == B, var(A))).
31+
test("expands call/1", reif:goal_expanded(call(a), a)).
32+
test("expands call/1 for modules", reif:goal_expanded(call(a:b(1)), a:b(1))).
33+
test("expands call/2 for modules", reif:goal_expanded(call(a:b,c), a:b(c))).
34+
test("doesn't expand call/2", reif:goal_expanded(call(b,c), call(b,c))).
35+
test("doesn't expand cyclic terms", (
36+
X=a(X),
37+
reif:goal_expanded(call(X), Y),
38+
call(X) == Y
39+
)).
40+
test("doesn't expand cyclic call/1", (
41+
X=call(X),
42+
reif:goal_expanded(X, Y),
43+
X == Y
44+
)).
45+
test("doesn't expand higher order predicates", (
46+
X = maplist(=(1), _),
47+
reif:goal_expanded(X, Y),
48+
X == Y
49+
)).
50+
51+
/*
52+
Following tests capture current results of goal expansion
53+
TODO: Investigate if if_/3 can be further expanded, and if it will be beneficial
54+
*/
55+
test("goal_expansion (=)", (
56+
subsumes_full_expansion(if_(1=2,a,b), (
57+
1 \= 2 -> b
58+
; 1 == 2 -> a
59+
; 1 = 2, a
60+
; dif(1,2), b)))).
61+
62+
test("goal_expansion (;)", (
63+
subsumes_full_expansion(if_((1=2;3=3),a,b), (
64+
1 \= 2 -> if_(3=3,a,b)
65+
; 1 == 2 -> a
66+
; 1 = 2, a
67+
; dif(1,2), if_(3=3,a,b))))).
68+
69+
test("goal_expansion (,)", (
70+
subsumes_full_expansion(if_((1=2,3=3),a,b), (
71+
1 \= 2 -> b
72+
; 1 == 2 -> if_(3=3,a,b)
73+
; 1 = 2, if_(3=3,a,b)
74+
; dif(1,2), b)))).
75+
76+
test("goal_expansion memberd_t", (
77+
subsumes_full_expansion(if_(memberd_t(f,"abcdefgh"),t,f), (
78+
call(memberd_t(f,"abcdefgh"),A),
79+
( A == true -> t
80+
; A == false -> f
81+
; nonvar(A) -> throw(error(type_error(boolean,A),_))
82+
; throw(error(instantiation_error,_))))))).
83+
84+
test("goal_expansion cond_t", (
85+
subsumes_full_expansion(if_(cond_t(a,b),t,f), (
86+
call(cond_t(a,b),A),
87+
( A == true -> t
88+
; A == false -> f
89+
; nonvar(A) -> throw(error(type_error(boolean,A),_))
90+
; throw(error(instantiation_error,_))))))).
91+
92+
test("set of solutions found by tpartition/4 and tfilter/3 is the same and correct", (
93+
random_test_vector(TestVector),
94+
findall((N,Ts), tpartition(=(N),TestVector,Ts,_), S),
95+
findall((N,Ts), tfilter(=(N),TestVector,Ts), S),
96+
maplist(_+\(N,Ts)^maplist(=(N),Ts), S)
97+
)).
98+
99+
test("cut in one of the branches does not influence condition", (
100+
findall(X-Y, if_(X=1,!,Y=a), Solutions),
101+
Expected = [1-Y1,X2-a],
102+
subsumes_term(Expected, Solutions),
103+
Solutions = Expected,
104+
var(Y1),
105+
var(X2), dif(X2, 1)
106+
)).
107+
108+
test("non-callable branch throws meaningful error", (
109+
findall(R, result_or_exception(if_(_=1, _=a, 2), R), Solutions),
110+
Solutions == [if_(1=1,a=a,2), error(type_error(callable,2),call/1)]
111+
)).
112+
113+
result_or_exception(Goal, Result) :-
114+
catch((Goal,Result=Goal), Result, true).
115+
116+
random_test_vector(TestVector) :-
117+
random_integer(0, 1000, Length),
118+
length(TestVector, Length),
119+
maplist(random_integer(1,5), TestVector).
120+
121+
% Expand goal until fix point is found
122+
full_expansion(G, X) :-
123+
user:goal_expansion(G, Gx) -> full_expansion(Gx, X); G = X.
124+
125+
% X is more general than fully expanded goal G
126+
subsumes_full_expansion(G, X) :-
127+
full_expansion(G, Y),
128+
subsumes_term(X, Y).
129+
130+
/*
131+
Extra predicates from the paper
132+
*/
133+
duplicate(X, Xs) :-
134+
tfilter(=(X), Xs, [_,_|_]).
135+
136+
firstduplicate(X, [E|Es]) :-
137+
if_(memberd_t(E,Es), X=E, firstduplicate(X, Es)).
138+
139+
treememberd_t(_, nil, false).
140+
treememberd_t(E, t(F,L,R), T) :-
141+
call((E=F; treememberd_t(E,L); treememberd_t(E,R)), T).
142+
143+
tree_non_member(_, nill).
144+
tree_non_member(E, t(F,L,R)) :-
145+
dif(E,F),
146+
tree_non_member(E, L),
147+
tree_non_member(E, R).

‎tests/scryer/cli/src_tests/reif_tests.stderr

Whitespace-only changes.

‎tests/scryer/cli/src_tests/reif_tests.stdout

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
All tests passed

‎tests/scryer/cli/src_tests/reif_tests.toml

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
args = [
2+
"-f",
3+
"--no-add-history",
4+
"-g", "use_module(library(reif_tests))",
5+
"-g", "use_module(library(reif))",
6+
"-g", "use_module(library(dif))",
7+
"-g", "use_module(library(lambda))",
8+
"-g", "use_module(library(lists))",
9+
"-g", "reif_tests:main_quiet(reif_tests)",
10+
"src/tests/reif.pl"
11+
]

0 commit comments

Comments
 (0)