/*  DRIVER.PL  */
/*  Shelved on the 3rd of October 1988  */ 


/*
I've received several requests for the  benchmarks that were used in the
June issue of  AI Expert. The purpose  of these benchmarks is  to try to
identify  strengths and  weaknesses  in  the basic  engine  of a  Prolog
system.  In particular,  I try  to separate  costs normaly  conflated in
other benchmark suites,  such as procedure call cost,  term matching and
term construction costs  and the costs of tail calls  vs. nontail calls.
I'm sure the benchmarks could be improved, but I don't have time to work
on them right now. Also, I must  say that I have relatively little faith
on  small benchmark  programs. I  find that  performance (both  time and
space)  on  substantial programs,  reliability,  adherence  to de  facto
standards and ease of use are far more important in practice. I've tried
several  Prolog systems  that performed  very well  on small  benchmarks
(including  mine),  but that  failed  badly  on  one  or more  of  these
criteria.

Some of  the benchmarks are inspired  on a benchmark suite  developed at
ICOT for their SIM project,  and other benchmark choices were influenced
by  discussions with  ICOT researchers  on the  relative performance  of
SIM-I vs. Prolog-20.

[Fernando Pereira]
*/



%   File   : driver.pl
%   Author : Richard O'Keefe based on earlier versions due to
%            Paul Wilk, Fernando Pereira, David Warren et al.
%   Updated: 29 December 1986
%   Defines: from/3 and get_cpu_time/1.
%   Version: Dec-10 Prolog & Quintus Prolog.

:- public
        from/3,
        get_cpu_time/1.

:- mode
        from(+, +, -),
        get_cpu_time(-).

%   from(LowerBound, UpperBound, I)
%   binds I to successive integers in the range LowerBound..UpperBound.
%   It is designed solely for use in this application; for a general
%   way of doing this use the standard library predicate between/3, or
%   perhaps repeat/1.

from(I, I, I) :- !.
from(L, U, I) :- M is (L+U) >> 1,       from(L, M, I).
from(L, U, I) :- M is (L+U) >> 1 + 1,   from(M, U, I).


%   get_cpu_time(T)
%   unifies T with the run time since start-up in milliseconds.
%   (We can't use the second element of the list, as some of the
%   tests will call statistics/2 and reset it.)

get_cpu_time(T) :-
        statistics(runtime, [T,_]).


%   report(N, T0, T1, T2)
%   takes the three times yielded by get_cpu_time and the number
%   of iterations and prints the total, overhead, and average.

report(N, T0, T1, T2) :-
        TestTime is T1-T0,
        OverHead is T2-T1,
        Average  is (TestTime-OverHead)/N,
        write((TestTime-OverHead)/N=Average),
        write(' milli-seconds/iteration'), nl.


%   bench_mark(Name)
%   is the new top level.  It calls bench_mark/4 to find out
%   how many Iterations of the Action and its Control to perform.
%   To get the old effect, do something like
%   bench_mark(nrev, 50, nrev(L), dummy(L)) :- data(L).

bench_mark(Name) :-
        bench_mark(Name, Iterations, Action, Control),
        get_cpu_time(T0),
        (   repeat(Iterations), call(Action), fail
        ;   get_cpu_time(T1)
        ),
        (   repeat(Iterations), call(Control), fail
        ;   get_cpu_time(T2)
        ),
        write(Name), write(' took '),
        report(Iterations, T0, T1, T2).


%   repeat(N)
%   succeeds precisely N times.

repeat(N) :-
        N > 0,
        from(1, N).

from(I, I) :- !.
from(L, U) :- M is (L+U)>>1,   from(L, M).
from(L, U) :- M is (L+U)>>1+1, from(M, U).