/* XRFCOL.PL :  Collecting up module of XREF.

						Dave Bowen
						Updated: 11 March 82
*/

 :- mode callers(+,+,-).   
 :- mode defn_file(+,-).
 :- mode entries(+,+).   
 :- mode exts(+,+,+).    
 :- mode fentries(-). 
 :- mode got_defn(+,-).
 :- mode lt2(+,+,+,+).   
 :- mode lte(+,+).  
 :- mode multiple_defn(+,+,-,-).
 :- mode notin(+,+).
 :- mode partition(+,+,-,-).  
 :- mode qsort(+,-,+).   


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

Data for collecting up

   $ext(File, Predicate)
			  Held on key: File.
			  $ext(I,P) means P is an external (import) of I

   $entry(File, Predicate)
			  Held on key: File.
			  $entry(I,P) means P is an entry (export) of I

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


collect :-
   fentries(L),		%  Make list of all predicates with all associated data
   qsort(L,L1,[]),	%  Sort them
   do_output(L1).

				/* Find entries. Search through all encountered
				   predicates */
fentries([e(F,N,f(I,Cs))|L]) :- 
	recorded('$pred',P,Ptr),		% Find a predicate P
	erase(Ptr),
	functor(P,F,N),				% P is F/N
	defn_file(P,I),				% P is defined in file I
	callers(P,I,Cs),			% Cs is list of callers c(F,N)
	((I=undefined,warn(P,'not defined')); true),
	((Cs=[],warn(P,'not called')); true),
	multiple_defn(P,[I],L,L1),		% Any multiple definitions?
	((nonvar(L),warn(P,'multiply defined')); true), !,
	fentries(L1).
fentries([]).

				/* Find I where P is defined, or else
				   set I=undefined.*/
defn_file(P,I) :- 
	got_defn(P,I), !.
defn_file(P,undefined).

				/* Is P defined in a file, or is it known? */
got_defn(P,I) :- 
	recorded(P,'$defn'(I,P),_).
got_defn(P,I) :- 
	recorded(P,'$known'(I),_).

				/* Look for multiple defns of P. List contains
				   all places P is already known to be defined.
				   3rd arg is var & tail of e-list. Instantiate
				   its head to any multiple defn, and return
				   4th arg as new var tail of e-list */

multiple_defn(P,List,[e(F,N,f(I,[]))|L],L1) :-
   got_defn(P,I), notin(I,List), !,
   functor(P,F,N),
   multiple_defn(P,[I|List],L,L1).
multiple_defn(P,_,L,L).

				/* True if X is not in List */
notin(X,List) :- 
	\+ member(X,List).

				/* Return a (possibly empty) list of all
				   callers of the procedure P */
callers(P,I,[c(F,N)|Cs]) :-
	recorded(P,'$caller'(P,F,N,J),Ptr),
	erase(Ptr), !,
	exts(I,J,P),
	callers(P,I,Cs).
callers(_,_,[]).

				/* Record externals. P is defined in I (entry/
				   export), used in J (external/import) */

exts(I,I,_) :- !.			% Do nothing if defn & use in same file
exts(I,undefined,P) :- !,		% Get here if P was mark_interpreted
	entries(I,P).			% Record P is exported from I
exts(I,J,P) :-
	entries(I,P),			% Record P is exported from I
	crecord(J,'$ext'(J,P)).		% Record P is imported to J

				/* Record exports */
entries(undefined,_) :- !.
entries(I,P) :- crecord(I,'$entry'(I,P)).


				/* Quick sort of functor entries. qsort(A,B,C)
				   returns B as the concatenation of sorted
				   A and C (which should already be sorted). */
qsort([X|L],R,R0) :-
	partition(L,X,L1,L2),
	qsort(L2,R1,R0),
	qsort(L1,R,[X|R1]).
qsort([],R,R).

				/* Partition list arg1 on the value of Y
				   into arg3 and arg4 */
partition([X|L],Y,[X|L1],L2) :-
	lte(X,Y), !,
	partition(L,Y,L1,L2).
partition([X|L],Y,L1,[X|L2]) :-
	partition(L,Y,L1,L2).
partition([],_,[],[]).

				/* Comparison predicate for sort */
lte(e(F1,N1,_),e(F2,N2,_)) :-
	lt2(F1,N1,F2,N2).

				/* Order first by functor name, then arity */
lt2(F,N1,F,N2) :- !, N1=<N2.
lt2(F1,_,F2,_) :- F1 @< F2.