%

%	listing predicate

%

%	for Xprolog 2.0

%	by Andreas Toenne



% listing :-

%	all known and not hidden procedures are written to the output

%	stream. The output of listing can be reread.

% listing(name) :-

%	all known and not hidden procedures with the named head are

%	written as in listing.

% listing(ListOfNames) :-

%	applies listing(name) to all members of the list.



listing :-

	next_functor(Name, Arity),

	functor(Head, Name, Arity),		% construct clause head

	clause(Head, Body),			% find matching clause

	check_for_new_procedure(Name, Arity),	% nl if new procedure

	nl,

	write_clause(Head, Body),		% output the clause

	fail.					% search for next solution

listing :- nl.



listing(X) :- var(X), !.			% don't list variables

listing([]) :- !.				% stop at empty list

listing([Name|Names]) :-

	!,

	listing(Name),

	listing(Names).

listing(Name) :-

	next_functor(Name, Arity),

	functor(Head, Name, Arity),

	clause(Head, Body),

	check_for_new_procedure(Name, Arity),

	nl,

	write_clause(Head, Body),

	fail.

listing(_) :- nl.



next_functor(Name, Arity) :- $functor(Name, Arity, Help).



check_for_new_procedure(Name, Arity) :-		% no changes

	lastlisted(Name, Arity),

	!.

check_for_new_procedure(Name, Arity) :-		% new procedure

	retract(lastlisted(_,_)),

	assert(lastlisted(Name, Arity)),

	nl.

	

write_clause(Head, true) :-

	writeq(Head),

	put(['.']),

	!.

write_clause(Head, Body) :-

	writeq(Head),

	write(' :- '),

	write_body(Body, 8, start),

	put(['.']),

	!.

	

write_body(X, _, _) :-				% Xprolog has no variable terms

	var(X),

	nl,

	!,

	write('***** variable goal is bad *****').

write_body((A,B), Tab, _) :-

	!,

	write_body(A, Tab, comma),

	put([',']),

	write_body(B, Tab, comma).

write_body((A;B), Tab, FromWhere) :-

	(

		FromWhere = start

		;

		FromWhere = semicolon

	),

	!,

	write_body(A, Tab, semicolon),

	nl,

	tab(Tab),

	put([';']),

	write_body(B, Tab, semicolon).

write_body((A;B), Tab, _) :-

	!,

	nl,

	tab(Tab),

	put(['(']),

	NewTab is Tab + 8,

	write_body(A, NewTab, semicolon),

	nl,

	tab(NewTab),

	put([';']),

	write_body(B, NewTab, semicolon),

	nl,

	tab(Tab),

	put([')']).

write_body(X, _, start) :-			% simple body

	!,

	writeq(X).

write_body(X, Tab, _) :-

	!,

	nl,

	tab(Tab),

	writeq(X).



lastlisted(foo, foo).				% for output formatting



% hide all new procedures



:- hide([listing, listing(_), next_functor(_,_), check_for_new_procedure(_,_),

	 write_clause(_,_), write_body(_,_,_), lastlisted(_,_)]).