%% $Id: methcall.mercury,v 1.1 2001/07/28 22:15:46 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% from Fergus Henderson
% "This test uses a base class Toggle, which implements a simple boolean
% flip-flop device and a derived class NthToggle, which only flips every
% Nth time it is activated."
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module bool, int, string, list.
% "The base Toggle class should define a boolean
% (or integer) field to hold a true/false value. It should define methods
% to access the value, and to activate the toggle (flip it's value)."
:- type toggle ---> toggle(toggle_value::bool).
:- typeclass toggle(T) where [
func value(T) = bool,
func 'value :='(T, bool) = T,
func activate(T) = T
].
:- instance toggle(toggle) where [
func(value/1) is toggle_value,
func('value :='/2) is 'toggle_value :=',
activate(toggle(yes)) = toggle(no),
activate(toggle(no)) = toggle(yes)
].
% "The derived NthToggle class should inherit the boolean field, and add a
% counter and limit field. It should override the activate method so that
% the boolean state is flipped after the activate method is called count
% times. The constructor for NthToggle should use the constructor for
% Toggle to inherit the boolean field and value() method."
% Mercury doesn't have any direct support for inheritence of fields,
% so we need to use composition instead.
:- type nth_toggle ---> nth_toggle(base::toggle, counter::int, limit::int).
:- func make_nth_toggle(bool, int) = nth_toggle.
make_nth_toggle(Val, Max) = nth_toggle(toggle(Val), 0, Max).
% If the nth_toggle class added its own methods, then we'd want to
% create a derived typeclass like this:
%
% :- typeclass nth_toggle(T) <= toggle(T) where [ ... ].
% :- instance nth_toggle(nth_toggle) where [ ... ].
%
% But nth_toggle doesn't add any new methods, so we don't need that.
% We just need to make it an instance of the base class,
% delegating the field accessors.
:- instance toggle(nth_toggle) where [
value(T) = T^base^value,
'value :='(T, V) = T^base^value := V,
(activate(T) = NewT :-
C = T^counter + 1,
(if C >= T^limit then
NewT = (T^counter := 0)^base := activate(T^base)
else
NewT = T^counter := C
))
].
main -->
io__command_line_arguments(Args),
{ N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
{ loop(N, yes, toggle(yes),
(pred(_V0::in, T0::in, V::out, T::out) is det :-
T = T0^activate, V = T^value),
Value1, _Toggle1) },
write_string(if Value1 = yes then "true" else "false"), nl,
{ loop(N, yes, make_nth_toggle(yes, 3),
(pred(_V0::in, T0::in, V::out, T::out) is det :-
T = T0^activate, V = T^value),
Value2, _Toggle2) },
write_string(if Value2 = yes then "true" else "false"), nl.
:- pred loop(int, T1, T2, pred(T1, T2, T1, T2), T1, T2).
:- mode loop(in, in, in, pred(in, in, out, out) is det, out, out) is det.
loop(N, V0, T0, P, V, T) :-
(if N = 0 then
V = V0, T = T0
else
P(V0, T0, V1, T1),
loop(N - 1, V1, T1, P, V, T)
).
% Alternatively, it can be written a little more elegantly as
%
% main -->
% io__command_line_arguments(Args),
% { N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
%
% { {Value1, _Toggle1} = repeat_n(N, {yes, toggle(yes)},
% (func({_V0, T0}) = {V, T} :- T = T0^activate, V = T^value)) },
% write_string(if Value1 = yes then "true" else "false"), nl,
%
% { {Value2, _Toggle2} = repeat_n(N, {yes, make_nth_toggle(yes, 3)},
% (func({_V0, T0}) = {V, T} :- T = T0^activate, V = T^value)) },
% write_string(if Value2 = yes then "true" else "false"), nl.
%
% :- func repeat_n(int, T, func(T) = T) = T.
% repeat_n(N, X, F) =
% (if N = 0 then X
% else repeat_n(N - 1, F(X), F)).
%
% but the earlier code above is a little more efficient.