%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  PDSS (PIMOS Development Support System)  Version 2.52		 %
%  (C) Copyright 1988,1989,1990,1991,1992.				 %
%  Institute for New Generation Computer Technology (ICOT), Japan.	 %
%  Read "../COPYRIGHT" for detailed information.			 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- module comparator.
:- with_macro pimos.
:- public sort/5,descending_sort/5,
        sort0/5.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sort(X,Y,^Smaller,^Larger,^Swapped)
%%      X,Y     :: values to be compared
%%      Smaller :: smaller value
%%      Larger  :: larger value
%%      Swapped :: it is bound to 'yes' if X is larger than Y, otherwise 'no'.

sort(X,Y,S,L,Swapped) :- true |
        sort0(X,Y,X1,Y1,Res),
        wait_sorted(X1,Y1,S,L,Swapped,Res).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% descending_sort(X,Y,^Larger,^Smaller,^Swapped)
%%      X,Y     :: values to be compared
%%      Larger  :: larger value
%%      Smaller :: smaller value
%%      Swapped :: it is bound to 'yes' if X is smaller than Y, otherwise 'no'.

descending_sort(X,Y,L,S,Swapped) :- true |
        sort0(Y,X,Y1,X1,Res),
        wait_sorted(X1,Y1,L,S,Swapped,Res).


sort0(X,Y,X2,Y2,Res) :- true |
        get_type(X,X1,T),
        get_type(Y,Y1,T1),
        do_sort(X1,Y1,X2,Y2,Res,T,T1).

wait_sorted(X,Y,A,B,Swapped,greater) :- true | A=Y,B=X,Swapped=yes.
wait_sorted(X,Y,A,B,Swapped,same) :- true | A=X,B=Y,Swapped=no.
wait_sorted(X,Y,A,B,Swapped,less) :- true | A=X,B=Y,Swapped=no.

get_type(X,X1,T) :- wait(X) | get_type1(X,X1,T).

get_type1(X,X1,T) :- integer(X)        | X1:=X,T:=0.
get_type1(X,X1,T) :- floating_point(X) | X1$:=X,T:=1.
get_type1(X,X1,T) :- atom(X)           | X1=X,T:=2.
get_type1(X,X1,T) :- string(X,_,_)     | X1=X,T:=3.
get_type1(X,X1,T) :- list(X)           | X1=X,T:=4.
get_type1(X,X1,T) :- vector(X,_)       | X1=X,T:=5.
%get_type1(X,X1,T) :- module(X,_)       | X1=X,T:=6.
%get_type1(X,X1,T) :- code(X,_,_,_)     | X1=X,T:=7.
otherwise.
get_type1(X,X1,T) :- true | X1=X,T:=8.

do_sort(X,Y,X1,Y1,Res,T,T) :- true | comp(X,Y,X1,Y1,Res,T).
do_sort(X,Y,X1,Y1,Res,0,1) :- true |
        X0$:=float(X),X1:=X,
        comp_real(X0,Y,_,Y1,R),
        wait_compared_real(R,less,Res).
do_sort(X,Y,X1,Y1,Res,1,0) :- true |
        Y0$:=float(Y),Y1:=Y,
        comp_real(X,Y0,X1,_,R),
        wait_compared_real(R,greater,Res).
otherwise.
do_sort(X,Y,X1,Y1,Res,T,T1) :- true |
        X1=X,Y1=Y,
        comp_int(T,T1,_,_,Res).

wait_compared_real(same,R,Res) :- true | Res=R.
otherwise.
wait_compared_real(R,_,Res) :- true | Res=R.


comp(X,Y,X1,Y1,Res,0) :- true | comp_int(X,Y,X1,Y1,Res).
comp(X,Y,X1,Y1,Res,1) :- true | comp_real(X,Y,X1,Y1,Res).
comp(X,Y,X1,Y1,Res,2) :- tag_and_value(X,_,M),tag_and_value(Y,_,N) |
        X=X1,Y=Y1,
        comp_int(M,N,_,_,Res).
comp(X,Y,X1,Y1,Res,3) :- true | comp_str(X,Y,X1,Y1,Res).
comp(X,Y,X1,Y1,Res,4) :- true | comp_list(X,Y,X1,Y1,Res).
comp(X,Y,X1,Y1,Res,5) :- vector(X,Sx),vector(Y,Sy) |
        comp_vect(X,Y,X1,Y1,Res,Sx,Sy).
%comp(X,Y,X1,Y1,Res,6) :- module(X,Sx),module(Y,Sy) |
%        comp_mod(X,Y,X1,Y1,Res,Sx,Sy).
%comp(X,Y,X1,Y1,Res,7) :- code(X,_,Mx,Px),code(Y,_,My,Py) |
%        X1=X,Y1=Y,
%        comp_cod(Mx,My,Px,Py,Res).
comp(X,Y,X1,Y1,Res,8) :- tag_and_value(X,Tx,Vx),tag_and_value(Y,Ty,Vy) |
        X1=X,Y1=Y,
        comp_tag_and_value(Tx,Ty,Vx,Vy,Res).

comp_int(X,Y,X1,Y1,Res) :- X<Y | X1:=X,Y1:=Y,Res=less.
comp_int(X,Y,X1,Y1,Res) :- X>Y | X1:=X,Y1:=Y,Res=greater.
comp_int(X,Y,X1,Y1,Res) :- X=:=Y | X1:=X,Y1:=Y,Res=same.

comp_real(X,Y,X1,Y1,Res) :- X$<Y | X1$:=X,Y1$:=Y,Res=less.
comp_real(X,Y,X1,Y1,Res) :- X$>Y | X1$:=X,Y1$:=Y,Res=greater.
comp_real(X,Y,X1,Y1,Res) :- X$=:=Y | X1$:=X,Y1$:=Y,Res=same.

%comp_str(X,Y,X1,Y1,Res) :- string_less_than(X,Y) | X=X1,Y=Y1,Res=less.
%comp_str(X,Y,X1,Y1,Res) :- string_less_than(Y,X) | X=X1,Y=Y1,Res=greater.
comp_str(X,Y,X1,Y1,Res) :- X=Y | X=X1,Y=Y1,Res=same.
otherwise.
comp_str(X,Y,X1,Y1,Res) :- string(X,Lx,Tx),string(Y,Ly,Ty) |
        comp_str(X,Y,X1,Y1,Res,0,Lx,Ly,Tx,Ty).

comp_str(X,Y,X1,Y1,Res,I,Lx,Ly,T,T) :- true |
        comp_str(X,Y,X1,Y1,Res,I,Lx,Ly).
otherwise.
comp_str(X,Y,X1,Y1,Res,_,_,_,Tx,Ty) :- true |
        X1=X,Y1=Y,
        comp_int(Tx,Ty,_,_,Res).

comp_str(X,Y,X1,Y1,Res,I,Lx,Ly) :- Lx>I,Ly>I,
    string_element(X,I,E),string_element(Y,I,F) |
        comp_int(E,F,_,_,R),
        wait_compared_str(X,Y,X1,Y1,Res,I,Lx,Ly,R).
otherwise.
comp_str(X,Y,X1,Y1,Res,I,I,Ly) :- Ly>I | X1=X,Y1=Y,Res=less.
comp_str(X,Y,X1,Y1,Res,I,Lx,I) :- Lx>I | X1=X,Y1=Y,Res=greater.
comp_str(X,Y,X1,Y1,Res,I,I,I) :- true | X1=X,Y1=Y,Res=same.

wait_compared_str(X,Y,X1,Y1,Res,I,Lx,Ly,same) :- true | comp_str(X,Y,X1,Y1,Res,~(I+1),Lx,Ly).
otherwise.
wait_compared_str(X,Y,X1,Y1,Res,_,_,_,R) :- true | X1=X,Y1=Y,Res=R.

comp_list([A|X],[B|Y],X1,Y1,Res) :- true |
        sort0(A,B,A1,B1,R),
        X1=[A1|Rx1],Y1=[B1|Ry1],
        wait_compared_list(X,Y,Rx1,Ry1,Res,R).
comp_list([],[B|Y],X1,Y1,Res) :- true | X1=[],Y1=[B|Y],Res=less.
comp_list([A|X],[],X1,Y1,Res) :- true | X1=[A|X],Y1=[],Res=greater.
comp_list([],[],X1,Y1,Res) :- true | X1=[],Y1=[],Res=same.
otherwise.
comp_list(X,Y,X1,Y1,Res) :- true | sort0(X,Y,X1,Y1,Res).

wait_compared_list(X,Y,X1,Y1,Res,same) :- true | comp_list(X,Y,X1,Y1,Res).
otherwise.
wait_compared_list(X,Y,X1,Y1,Res,R) :- true | X1=X,Y1=Y,Res=R.

comp_vect(X,Y,X1,Y1,Res,S,S) :- true | comp_e(X,Y,X1,Y1,Res,0,S).
otherwise.
comp_vect(X,Y,X1,Y1,Res,Sx,Sy) :- true |
        X1=X,Y1=Y,
        comp_int(Sx,Sy,_,_,Res).

comp_e(X,Y,X1,Y1,Res,I,Size) :- I<Size |
        set_vector_element(X,I,E,E1,X0),
        set_vector_element(Y,I,F,F1,Y0),
        sort0(E,F,E1,F1,R),
        wait_compared_vect(X0,Y0,X1,Y1,Res,I,Size,R).
comp_e(X,Y,X1,Y1,Res,I,I) :- true | X1=X,Y1=Y,Res=same.

wait_compared_vect(X,Y,X1,Y1,Res,I,Size,same) :- true |
        comp_e(X,Y,X1,Y1,Res,~(I+1),Size).
otherwise.
wait_compared_vect(X,Y,X1,Y1,Res,_,_,R) :- true | X1=X,Y1=Y,Res=R.

%comp_mod(X,Y,X1,Y1,Res,S,S) :- true |
%        X1=X,Y1=Y,
%        comp_e_mod(X,Y,Res,0,S).
%otherwise.
%comp_mod(X,Y,X1,Y1,Res,Sx,Sy) :- true |
%        X1=X,Y1=Y,
%        comp_int(Sx,Sy,_,_,Res).

%comp_e_mod(X,Y,Res,I,Size) :- I<Size |
%        module_element(X,I,Ex),
%        module_element(Y,I,Ey),
%        sort0(Ex,Ey,_,_,R),
%        wait_compared_mod(X,Y,Res,I,Size,R).
%comp_e_mod(X,Y,Res,I,I) :- true | Res=same.

%wait_compared_mod(X,Y,Res,I,Size,same) :- true |
%        comp_e_mod(X,Y,Res,~(I+1),Size).
%otherwise.
%wait_compared_mod(X,Y,Res,_,_,R) :- true | Res=R.

%comp_cod(Mx,My,Px,Py,Res) :- module(Mx,Sx),module(My,Sy) |
%        comp_mod(Mx,My,_,_,R,Sx,Sy),
%        wait_compared_cod(R,Px,Py,Res).

%wait_compared_cod(same,Px,Py,Res) :- true |
%        comp_int(Px,Py,_,_,Res).
%otherwise.
%wait_compared_cod(R,_,_,Res) :- true | Res=R.

comp_tag_and_value(Tx,Ty,Vx,Vy,Res) :- true |
        comp_int(Tx,Ty,_,_,R),
        wait_compared_tag(R,Vx,Vy,Res).

wait_compared_tag(same,Vx,Vy,Res) :- true |
        comp_int(Vx,Vy,_,_,Res).
otherwise.
wait_compared_tag(R,_,_,Res) :- true | Res=R.

