/*  $Id: explain.pl,v 1.6 1998/02/18 13:56:36 jan Exp $

    Part of SWI-Prolog
    Designed and implemented by Jan Wielemaker
    E-mail: jan@swi.psy.uva.nl

    Copyright (C) 1996 University of Amsterdam. All rights reserved.
*/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The   library(explain)   describes   prolog-terms.   The   most   useful
functionality is its cross-referencing function.

Note  that  the  help-tool  for   XPCE    provides   a   nice  graphical
cross-referencer.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- module(explain,
	  [ explain/1,
	    explain/2
	  ]).
:- use_module(library(helpidx)).

explain(Item) :-
	explain(Item, Explanation),
	write_ln(Explanation),
	fail.
explain(_).

		/********************************
		*           BASIC TYPES         *
		*********************************/

explain(Var, Explanation) :-
	var(Var), !,
	utter(Explanation, '"~w" is an unbound variable', [Var]).
explain(I, Explanation) :-
	integer(I), !,
	utter(Explanation, '"~w" is an integer', [I]).
explain(F, Explanation) :-
	float(F), !,
	utter(Explanation, '"~w" is a floating point number', [F]).
explain(S, Explanation) :-
	string(S), !,
	utter(Explanation, '"~w" is a string', S).
explain([], Explanation) :- !,
	utter(Explanation, '"[]" is an atom denoting an empty list', []).
explain(A, Explanation) :-
	atom(A),
	utter(Explanation, '"~w" is an atom', [A]).
explain(A, Explanation) :-
	current_op(Pri, F, A),
	op_type(F, Type),
	utter(Explanation, '"~w" is a ~w (~w) operator of priority ~d',
	      [A, Type, F, Pri]).
explain(A, Explanation) :-
	atom(A), !,
	explain_atom(A, Explanation).
explain([H|T], Explanation) :-
	proper_list(T), !,
	List = [H|T],
	length(List, L),
	(   utter(Explanation, '"~p" is a proper list with ~d elements',
	          [List, L])
	;   checklist(printable, List),
	    utter(Explanation, '~t~8|Text is "~s"',  [List])
	).
explain([H|T], Explanation) :- !,
	length([H|T], L), !,
	utter(Explanation, '"~p" is a not-closed list with ~d elements',
	      [[H|T], L]).
explain(Name/Arity, Explanation) :-
	atom(Name),
	integer(Arity), !,
	functor(Head, Name, Arity),
	current_predicate(_, Module:Head),
	(   Module == system
	->  true
	;   \+ predicate_property(Module:Head, imported_from(_))
	),
	explain_predicate(Module:Head, Explanation).
explain(Term, Explanation) :-
	utter(Explanation, '"~w" is a compound term', [Term]).
explain(Term, Explanation) :-
	explain_functor(Term, Explanation).
	
op_type(X, prefix) :-
	atom_chars(X, [0'f, _]).
op_type(X, infix) :-
	atom_chars(X, [_, 0'f, _]).
op_type(X, postfix) :-
	atom_chars(X, [_, 0'f]).

printable(C) :-
	integer(C),
	between(32, 126, C).

		/********************************
		*             ATOMS             *
		*********************************/

explain_atom(A, Explanation) :-
	referenced(A, Explanation).
explain_atom(A, Explanation) :-
	current_predicate(A, Module:Head),
	(   Module == system
	->  true
	;   \+ predicate_property(Module:Head, imported_from(_))
	),
	explain_predicate(Module:Head, Explanation).

		/********************************
		*            FUNCTOR             *
		*********************************/

explain_functor(Head, Explanation) :-
	referenced(Head, Explanation).
explain_functor(Head, Explanation) :-
	current_predicate(_, Module:Head),
	\+ predicate_property(Module:Head, imported_from(_)),
	explain_predicate(Module:Head, Explanation).
explain_functor(Head, Explanation) :-
	predicate_property(M:Head, undefined),
	(   functor(Head, N, A),
	    utter(Explanation, '~w:~w/~d is an undefined predicate', [M,N,A])
	;   referenced(M:Head, Explanation)
	).
	
	
		/********************************
		*           PREDICATE           *
		*********************************/

lproperty(built_in,	' built-in', []).
lproperty(dynamic,	' dynamic', []).
lproperty(multifile,	' multifile', []).
lproperty(transparent,	' meta', []).

tproperty(imported_from(Module), ' imported from module ~w', [Module]).
tproperty(file(File),		' defined in~n~t~8|~w', [File]).
tproperty(line_count(Number),	':~d', [Number]).

combine_utterances(Pairs, Explanation) :-
	maplist(first, Pairs, Fmts),
	concat_atom(Fmts, Format),
	maplist(second, Pairs, ArgList),
	flatten(ArgList, Args),
	utter(Explanation, Format, Args).

first(A-_B, A).
second(_A-B, B).

explain_predicate(Pred, Explanation) :-
	Pred = Module:Head,
	functor(Head, Name, Arity),
	
	U0 = '~w:~w/~d is a' - [Module, Name, Arity],
	findall(Fmt-Arg, (lproperty(Prop, Fmt, Arg),
			  predicate_property(Pred, Prop)),
		U1),
 	U2 = ' predicate' - [],
	findall(Fmt-Arg, (tproperty(Prop, Fmt, Arg),
			  predicate_property(Pred, Prop)),
		U3),
	flatten([U0, U1, U2, U3], Utters),
	combine_utterances(Utters, Explanation).
explain_predicate(Pred, Explanation) :-
	predicate_property(Pred, built_in),
	Pred = _Module:Head,
	functor(Head, Name, Arity),
	predicate(Name, Arity, Summary, _, _),
	utter(Explanation, '~t~8|Summary: ``~w''''', [Summary]).
explain_predicate(Pred, Explanation) :-
	referenced(Pred, Explanation).
	
		/********************************
		*          REFERENCES           *
		*********************************/

referenced(Term, Explanation) :-
	current_predicate(_, Module:Head),
	\+ predicate_property(Module:Head, built_in),
	\+ predicate_property(Module:Head, imported_from(_)),
	Module:Head \= help_index:predicate(_,_,_,_,_),
	Head \= '$user_query'(_,_),
	nth_clause(Module:Head, N, Ref),
	'$xr_member'(Ref, Term),
	utter_referenced(Module:Head, N, Ref,
			 'Referenced', Explanation).

referenced(_Module:Head, Explanation) :-
	current_predicate(_, Module:Head),
	\+ predicate_property(Module:Head, built_in),
	\+ predicate_property(Module:Head, imported_from(_)),
	nth_clause(Module:Head, N, Ref),
	'$xr_member'(Ref, Head),
	utter_referenced(Module:Head, N, Ref,
			 'Possibly referenced', Explanation).

utter_referenced(_Module:class(_,_,_,_,_,_), _, _, _, _) :-
	feature(xpce, true), !,
	fail.
utter_referenced(_Module:lazy_send_method(_,_,_), _, _, _, _) :-
	feature(xpce, true), !,
	fail.
utter_referenced(_Module:lazy_get_method(_,_,_), _, _, _, _) :-
	feature(xpce, true), !,
	fail.
utter_referenced(Module:Head, _N, Ref, Text, Explanation) :-
	feature(xpce, true),
	functor(Head, Name, _Arity),
	concat(send_, Class, Name),
	selector(Ref, Selector),
	check_xpce_method(Module, Class, send, Selector), !,
	utter(Explanation,
	      '~t~8|~w from ~w->~w',
	      [Text, Class, Selector]).
utter_referenced(Module:Head, _N, Ref, Text, Explanation) :-
	feature(xpce, true),
	functor(Head, Name, _Arity),
	concat(get_, Class, Name),
	selector(Ref, Selector),
	check_xpce_method(Module, Class, get, Selector), !,
	utter(Explanation,
	      '~t~8|~w from ~w<-~w',
	      [Text, Class, Selector]).
utter_referenced(Module:Head, N, _Ref, Text, Explanation) :-
	functor(Head, Name, Arity),
	utter(Explanation,
	      '~t~8|~w from ~d-th clause of ~w:~w/~d',
	      [Text, N, Module, Name, Arity]).
	
selector(Ref, Selector) :-
	clause(Head, _Body, Ref),
	'$strip_module'(Head, _, Plain),
	arg(1, Plain, Selector),
	atom(Selector).

%	Verifies the detection of a clause implementing an XCE method.

check_xpce_method(Module, Class, send, Selector) :-
	catch(Module:lazy_send_method(Selector, Class, _), _, fail).
check_xpce_method(Module, Class, get, Selector) :-
	catch(Module:lazy_get_method(Selector, Class, _), _, fail).

		/********************************
		*             UTTER            *
		*********************************/

utter(Explanation, Fmt, Args) :-
	sformat(Explanation, Fmt, Args).