[mercury-users] challenge

[Daniel Hazel]

On Fri, 25 Sep 1998, Peter Schachte wrote:

> assume the trees will contain the same numbers of nodes if you like,
> or just collect as many pairs as there are nodes in the smaller tree.
> Take your pick.

%==========================================================================
% Here's one for those who dislike variables
% It walks the trees backwards to build the list in the right order.
% First assumption applies I guess.
%==========================================================================
:- implementation.
:- import_module list, string, std_util.

:- type tree(T) ---> empty ; tree(tree(T), T, tree(T)).
:- type thread(T) --->
    t(tree(T), tree(T), list(pair(T, T))).

:- pred collect_pairs(tree(T)::in, tree(T)::in, list(pair(T, T))::out) is det.
collect_pairs(T1, T2, L) :-
    collect_pairs1(t(T1, T2, []), t(_, _, L)).

:- pred collect_pairs1(thread(T)::in, thread(T)::out) is det.
collect_pairs1 -->
    (
        lookup_two(empty) ->
            []
    ;
        lookup_one(tree(L1, E1, R1)) ->
            ({ R1 = empty } ->
                collect_pairs2,
                collect_pairs1
            ;
                replace_one(R1),
                collect_pairs1,
                lookup_one(NewOne),
                replace_one(tree(L1, E1, NewOne)),
                collect_pairs1
            )
    ;
        []
    ).

:- pred collect_pairs2(thread(T)::in, thread(T)::out) is det.
collect_pairs2 -->
    (lookup_two(tree(L2, E2, R2)) ->
        ({ R2 = empty } ->
            (lookup_one(tree(L1, E1, _)) ->
                found(E1 - E2),
                replace_one(L1),
                replace_two(L2),
                collect_pairs1
            ;
                []
            )
        ;
            replace_two(R2),
            collect_pairs2,
            lookup_two(NewTwo),
            replace_two(tree(L2, E2, NewTwo)),
            collect_pairs1
        )
    ;
        []
    ).

:- pred found(pair(T, T)::in, thread(T)::in, thread(T)::out) is det.
found(P, t(T1, T2, LIn), t(T1, T2, [P | LIn])).

:- pred lookup_one(tree(T)::out, thread(T)::in, thread(T)::out) is det.
lookup_one(T1, t(T1, T2, L), t(T1, T2, L)).
:- pred lookup_two(tree(T)::out, thread(T)::in, thread(T)::out) is det.
lookup_two(T2, t(T1, T2, L), t(T1, T2, L)).

:- pred replace_one(tree(T)::in, thread(T)::in, thread(T)::out) is det.
replace_one(T1, t(_, T2, L), t(T1, T2, L)).
:- pred replace_two(tree(T)::in, thread(T)::in, thread(T)::out) is det.
replace_two(T2, t(T1, _, L), t(T1, T2, L)).