/*  COMPARE_TERMS.PL  */
 
 
:- module compare_terms.
 
 
:- public
    @> / 2,
    @> / 2,
    @>= / 2,
    @=< / 2,
    compare_terms / 3.
 
 
/*
SPECIFICATION
-------------
 
This module defines the following operators:
*/
:- op(40,xfx,@>).
:- op(40,xfx,@<).
:- op(40,xfx,@>=).
:- op(40,xfx,@=<).
/*
These can be used for comparing arbitrary terms, and are built-in to
many Prologs. The Tutor uses them for comparing keys in the arrays
module.
 
We define a standard ordering on terms, increasing down the following
table:
    Uninstantiated variables.
    Numbers.
    Atoms.
    Lists and structures.
 
Within a type, terms are ordered as follows:
 
1)  Uninstantiated variables.
    Two uninstantiated variables A,B are equal if A==B. Otherwise,
    we arbitrarily say that A @< B.
 
2)  Numbers.
    There is no distinction between integers and reals. A @< B if
    A < B.
 
3)  Atoms.
    We use lexical (dictionary) ordering on their characters, where
    the characters themselves are ordered by their character codes.
    Thus a@<aa, aa@<ab.
 
4)  Structures are ordered first by arity (lowest first), then lexically
    by functor name, then by comparing their arguments (left to right).
 
 
PUBLIC compare_terms( Relation, Item1, Item2 ):
-----------------------------------------------
 
Relation will be unified with '<', '>' or '=', for where the first item
is before, after, or the same as the second in the standard ordering.
 
 
PUBLIC A @< B:
--------------
 
A is before B in the standard ordering.
 
 
PUBLIC A @=< B:
---------------
 
A isn't after B.
 
 
PUBLIC A @> B:
 
A is after B.
-------------
 
 
PUBLIC A @>= B:
---------------
 
A isn't before B.
 
 
Note: this module isn't used in Poplog, as that defines these operators
as built-ins.
*/
 
 
/*
IMPLEMENTATION
--------------
 
This is fairly straightforward. The only point worth noting is that
the subordinate predicates, and compare_terms itself, must be steadfast.
This will ensure that calls such as
    compare_terms( >, 1, 2 )
do not give misleading results.
 
I implement steadfastness by defining all clauses logically. For further
comments on steadfastness, see MODULES.
*/
 
 
:- needs real/1.
 
 
compare_terms( Order, A, B ) :-
    term_type( A, Type ),
    term_type( B, Type ),
    !,
    compare_goal( Type, A,B,Order, Goal ),
    call( Goal ).
 
compare_terms( Order, A, B ) :-
    term_type( A, _, AN ),
    term_type( B, _, BN ),
    !,
    compare_numbers( AN, BN, Order ).
 
 
/*  term_type( Term+, Type? ):
        Term has type Type, one of { variable, number, atom, structure
        }.
*/
term_type( A, AType ) :-
    term_type( A, AType, AN ).
 
 
/*  term_type( Term+, Type?, Order? ):
        As above, but Order indicates Term's place in the ordering.      
*/
term_type( A, variable, 0 ) :-
    var(A), !.
 
term_type( A, number, 1 ) :-
    ( integer(A) ; real(A) ), !.
 
term_type( A, atom, 2 ) :-
    atom(A), !.
 
term_type( A, structure, 3 ).
 
 
/*  compare_goal( Type+, A+, B+, Order?, Goal- ):
        Goal can be called to compare terms A,B of type Type. It will
        unify the result with Order.
*/
compare_goal( variable, A,B,Order, compare_variables(A,B,Order) ) :- !.
compare_goal( atom, A,B,Order, compare_atoms(A,B,Order) ) :- !.
compare_goal( number, A,B,Order, compare_numbers(A,B,Order) ) :- !.
compare_goal( structure, A,B,Order, compare_structures(A,B,Order) ).
 
 
compare_variables( X, Y, = ) :-
    X == Y, !.
 
compare_variables( X, Y, < ) :-
    X \== Y.
 
 
compare_numbers( A, B, < ) :-
    A < B, !.
 
compare_numbers( A, A, = ) :- !.
 
compare_numbers( A, B, > ) :-
    A > B.
 
 
compare_atoms( A, B, Order ) :-
    name( A, AL ),
    name( B, BL ),
    compare_lists( AL, BL, Order ).
 
 
compare_structures( A, B, Order ) :-
    functor( A, AF, AArity ),
    functor( B, BF, BArity ),
    compare_structures( A, AF, AArity, B, BF, BArity, Order ).
 
 
compare_structures( A, F, Arity, B, F, Arity, Order ) :-
    !,
    compare_args( A, B, Order ).
    /*  Compare argument lists if arities and functors are identical.  */
 
compare_structures( _, AF, Arity, _, BF, Arity, Order ) :-
    !,
    compare_atoms( AF, BF, Order ).
    /*  Compare functors if they are different but arities are identical.  */
 
compare_structures( _, _, AArity, _, _, BArity, Order ) :-
    compare_numbers( AArity, BArity, Order ).
    /*  Otherwise compare the arities.  */
 
 
compare_args( A, B, Order ) :-
    A =.. [ _ | AArgs ],
    B =.. [ _ | BArgs ],
    compare_lists( AArgs, BArgs, Order ).
 
 
compare_lists( [], [], = ) :- !.
 
compare_lists( [], L, < ) :-
    L \= [], !.
 
compare_lists( L, [], > ) :-
    L \= [].
 
compare_lists( [H1|T1], [H2|T2], Order ) :-
    compare_terms( Order_, H1, H2 ),
    compare_lists_1( T1, T2, Order_, Order ).
 
 
compare_lists_1( T1, T2, =, Order ) :-
    compare_lists( T1, T2, Order ), !.
 
compare_lists_1( _, _, Order, Order ).
 
 
(A @> B) :-
    compare_terms( (>), A, B ).
 
(A @< B) :-                     
    compare_terms( (<), A, B ).
 
(A @>= B) :-
    compare_terms( N, A, B ),
    N \= (<).
 
(A @=< B) :-
    compare_terms( N, A, B ),
    N \= (>).
 
 
:- endmodule.
