/* SCOPE.

Neil Davy's Identity Assimilator

*/

 :- op(950,xfy,(->)).
 :- op(950,xfy,<->).




/**************************************************

     TRY E IN ALL THE SYNTACTIC GROUPS

**************************************************/


use(E) :-
	use_for_attraction(E,X,Y),
	fail.

use(E) :-
	use_for_isolation(E,X),
	fail.

use(E) :-
	use_for_collection(E,X),
	fail.

use(E) :-
	use_for_tidy1(E,X),
	fail.

use(E) :-
	use_for_tidy2(E,X),
	fail.

use(E) :-
	use_for_normalize1(E,X),
	fail.

use(E) :-
	use_for_normalize2(E,Foo),
	fail.


use(E) :- writef('%t has now been used in as many cases as possible.\n\n',[E]).


/**************************************************

     TRY E AS AN ISOLATION AXIOM

**************************************************/


use_for_isolation(Cond->(L->R), U) :-
	use_for_isolation(L->R,U).


use_for_isolation(L->R,U) :-
	wordsin(L,S),
	member(U,S),
	soln(R,U),
	assert(isolax(L->R,U)),
	writef('%t->%t has been used as an isolation axiom on the variable %t .\n\n',[L,R,U]).


/**************************************************
    
     TRY E AS A COLLECTION AXIOM

**************************************************/
	
	
	
use_for_collection(E,U) :-
	axiom(E,L,R),
	wordsin(E,S),
	member(U,S),
	occ(U,L,N1),
	occ(U,R,N2),
	N1>0,
	N2>0,
	(N1>N2,
	assert(collax(L,R,U)),
	writef('%t has been used as a collection axiom from left to right \n on the variable %t .\n\n',[E,U]);
	N1<N2,
	assert(collax(R,L,U)),
	writef('%t has been used as a collection axiom from right to left \n on the variable %t .\n\n',[E,U])).
	
/*************************************************

     TRY E AS AN ATTRACTION AXIOM

*************************************************/
	
	
use_for_attraction(E,X,Y) :-
	axiom(E,L,R),
	wordsin(E,S),
	pair(X,Y,S),
	position(X,L,XL),
	position(Y,L,YL),
	position(X,R,XR),
	position(Y,R,YR),
	occ(X,L,1),
	occ(X,R,1),
	occ(Y,L,1),
	occ(Y,R,1),
	distance(XL,YL,DL),
	distance(XR,YR,DR),
	(DL>DR,
	assert(attrax(X,Y,L,R)),
	writef('%t has been used as an attraction axiom from left to right \n on the variables %t and %t .\n\n',[E,X,Y]);
	DL<DR,
	assert(attrax(X,Y,R,L)),
	writef('%t has been used as an attraction axiom from right to left \n on the variables %t and %t .\n\n',[E,X,Y])).


	
/*************************************************

     TRY E AS A TIDY AXIOM

*************************************************/

/*   TRY THE FIRST TYPE OF TIDY AXIOM   */

use_for_tidy1(E,U) :-
	axiom(E,L,R),
	wordsin(E,S),
	member(U,S),
	occ(U,L,NL),
	occ(U,R,NR),
	(NL>0,
	NR=0,
	assert(tidyax(L,R,U)),
	writef('%t has been used as a tidy axiom from left to right \n on the variable %t .\n\n',[E,U]);
	NL=0,
	NR>0,
	assert(tidyax(R,L,U)),
	writef('%t has been used as a tidy axiom from right to left \n on the variable %t .\n\n',[E,U])).

/*   TRY THE SECOND TYPE OF TIDY AXIOM   */


use_for_tidy2(L=R,U) :-
	wordsin(L,S),
	member(U,S),
	(R=U,
	assert(tidy_ax(L,R,U)),
	writef('%t has been used as a tidy axiom from left to right \n on the variable %t .\n\n',[E,U]);
	L=U,
	assert(tidy_ax(R,L,U)),
	writef('%t has been used as a tidy axiom from right to left \n on tne variable %t .\n\n',[E,U])).

/**************************************************

     TRY E AS A NORMALIZE AXIOM

***************************************************/
	
/*   TRY THE FIRST TYPE OF NORMALIZE AXIOM   */

use_for_normalize1(E,Foo) :-
	axiom(E,L,R),
	sugaryist(E,Foo),
	foosin(L,SL),
	occ(Foo,SL,NL),
	foosin(R,SR),
	occ(Foo,SR,NR),
	(NL>0,
	NR=0,
	assert(normax(L,R,Foo)),
	writef('%t has been used as a normalize axiom from left to right \n on the function %t .\n\n',[E,Foo]);
	NR>0,
	NL=0,
	assert(normax(R,L,Foo)),
	writef('%t has been used as a normalize axiom from right to left \n on the function %t .\n\n',[E,Foo])).

/*   TRY THE SECOND TYPE OF NORMALIZE AXIOM   */

use_for_normalize2(E,Foo) :-
	axiom(E,L,R),
	inner(Foo),
	(foosin(L,SL),
	occ(Foo,SL,1),
	footerm(T,Foo,L),
	forall(footerm(S,Foo,R), check1(S,T)),
	assert(normax(L,R,Foo)),
	writef('%t has been used for a normalize axiom from \n left to right on the funtion %t .\n\n',[E,Foo]);
	foosin(R,SR),
	occ(Foo,SR,1),
	footerm(T,Foo,R),
	forall(footerm(S,Foo,L), check1(S,T)),
	assert(normax(R,L,Foo)),
	writef('%t has been used for a normalize axiom from \n right to left on the function %t .\n\n',[E,Foo])).


/**************************************************

     THE SUBROUTINES USED IN THE PROGRAM

***************************************************/

soln(U=R,U) :-
	wordsin(R,S),
	not(member(U,S)).
	
soln(A#B,U) :-
	soln(A,U),
	soln(B,U).
	
	
	
wordsin([],[]) :- !.
	
wordsin([First|Rest],Set) :- !,
	wordsin(First,S1),
	wordsin(Rest,S2),
	union(S1,S2,Set).
	
wordsin(X,[]) :- integer(X), !.

wordsin(X,[X]) :- atom(X), !.

wordsin(Term,Set) :-
	
	Term=..[Functor|Args],
	wordsin(Args,Set).


axiom(L=R,L,R).
axiom(L<->R,L,R).


position(X,E,[]) :-
	E=..[X|Args].
position(X,E,L) :-
	argn(N,E,T),
	L=[N|L1],
	position(X,T,L1).
	

distance(X,Y,D) :-
	common_ancestor(X,Y,L),
	length(X,N1),
	length(Y,N2),
	length(L,N3),
	D is (N1-N3)+(N2-N3).


common_ancestor([F1|R1],[F2|R2],[]) :- F1=\=F2.
common_ancestor([F|R1],[F|R2],[F|R]) :-
	common_ancestor(R1,R2,R).


argn(N,T,X) :- T=..[_|L],nmember(X,L,N).



sugaryist(E,Foo) :-
	foosin(E,S),
	sugarlist(D),
	qsort(S,L,D),
	L=[Foo|Rest].

foosin([],[]) :- !.
foosin([F|R],S) :- !,
	foosin(F,S1),
	foosin(R,S2),
	append(S1,S2,S).

foosin(X,[]) :-
	atomic(X), !.
foosin(Term,S) :-
	Term=..[Functor|Args],
	foosin(Args,S1),
	S=[Functor|S1].



qsort(L,R,D) :-
	qsort(L,[],R,D).

qsort([X|L],R0,R,D) :-
	partition(L,X,L1,L2,D),
	qsort(L2,R0,R1,D),
	qsort(L1,[X|R1],R,D).
qsort([],R,R,D).

partition([X|L],Y,[X|L1],L2,D) :-
	nmember(X,D,NX),
	nmember(Y,D,NY),
	NX=<NY,
	partition(L,Y,L1,L2,D).
partition([X|L],Y,L1,[X|L2],D) :-
	nmember(X,D,NX),
	nmember(Y,D,NY),
	NX>NY,
	partition(L,Y,L1,L2,D).
partition([],_,[],[],D).


pair(X,Y,[X|R]) :-
	member(Y,R).

pair(X,Y,[_|R]) :-
	pair(X,Y,R).





footerm(T,Foo,E) :-
	E=..[Foo|_],
	E=T.

footerm(T,Foo,E) :-
	E=..[_|Args],
	member(X,Args),
	footerm(T,Foo,X).
height(T,H) :-
	atomic(T),
	H is 0.

height(T,H) :-
	T=..[_|Args],
	member(X,Args),
	forall(member(Y,Args), check1(X,Y)),
	height(X,HX),
	!,
	H is HX+1.

check1(X,Y) :- height(X,HX),
	height(Y,HY),
	HX =< HY.
