1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Andreas Becker
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15:- module(pdt_call_analysis, [find_undefined_call/11, find_dead_predicate/9, find_undeclared_meta_predicate/10]).   16
   17:- use_module(pdt_prolog_codewalk).   18:- use_module(pdt_call_graph).   19:- use_module(pdt_prolog_library(utils4modules_visibility)).   20:- use_module(pdt_common_pl('metainference/pdt_prolog_metainference')).   21:- use_module(pdt_common_pl('metainference/pdt_meta_specification')).   22:- use_module(pdt_common_pl(pdt_entry_points)).   23:- use_module(pdt_common_pl(properties)).   24:- use_module(library(prolog_clause)).   25:- use_module(pdt_prolog_library(compatibility), [
   26	pdt_source_file/2
   27]).   28
   29:- dynamic(result/4).   30:- dynamic(result_transparent/5).   31
   32assert_result(M:Goal, Caller, clause_term_position(Ref, TermPosition), Kind) :-
   33	(	predicate_property(Caller, transparent),
   34		\+ predicate_property(Caller, meta_predicate(_)),
   35		Kind = undefined(NestedKind),
   36		(	NestedKind = metacall(_, _)
   37		;	NestedKind = database(_, _)
   38		)
   39	->	(	retract(result_transparent(Goal, Ref, TermPosition, Kind, Modules))
   40		->	(	member(M, Modules)
   41			->	NewModules = Modules
   42			;	NewModules = [M|Modules]
   43			)
   44		;	NewModules = [M]
   45		),
   46		assertz(result_transparent(Goal, Ref, TermPosition, Kind, NewModules))
   47	;	(	result(M:Goal, Ref, TermPosition, Kind)
   48		->	true
   49		;	assertz(result(M:Goal, Ref, TermPosition, Kind))
   50		)
   51	),
   52	!.
   53assert_result(_,_,_,_).
 find_undefined_call(Root, IncludeSomeExecutionContext, Module, Name, Arity, File, Start, End, UndefName, UndefArity, PropertyList)
   56find_undefined_call(Root, IncludeSomeExecutionContext, Module, Name, Arity, File, Start, End, UndefName, UndefArity, [line(Line)|PropertyList]) :-
   57	retractall(result(_, _, _, _)),
   58	retractall(result_transparent(_, _, _, _, _)),
   59	pdt_walk_code([undefined(trace), on_trace(pdt_call_analysis:assert_result)]),
   60	!,
   61	(	retract(result(M:Goal, Ref, TermPosition, _Kind))
   62	;	retract(result_transparent(Goal, Ref, TermPosition, _Kind, Ms))
   63	),
   64	(	TermPosition = term_position(Start, End, _, _, _)
   65	->	true
   66	;	TermPosition = Start-End
   67	),
   68	clause_property(Ref, file(File)),
   69	(	nonvar(Root)
   70	->	sub_atom(File, 0, _, _, Root)
   71	;	true
   72	),
   73	clause_property(Ref, predicate(Module:Name/Arity)),
   74	clause_property(Ref, line_count(Line)),
   75	properties_for_predicate(Module,Name,Arity,PropertyList0),
   76	(	nonvar(M)
   77	->	(	M \== Module
   78		->	format(atom(Prefix), '~w:', [M]),
   79			PropertyList = [prefix(Prefix)|PropertyList0]
   80		;	PropertyList = PropertyList0
   81		)
   82	;	nonvar(Ms),
   83		sort(Ms, SortedMs),
   84		(	IncludeSomeExecutionContext \== true
   85		->	functor(Head, Name, Arity),
   86			setof(TM,
   87				Module^Head^(
   88					(	TM = Module
   89					;	predicate_property(TM:Head, imported_from(Module))
   90					)
   91				),
   92				TargetModules
   93			),
   94			TargetModules == SortedMs
   95		;	true
   96		),
   97		atomic_list_concat(SortedMs, ', ', ModuleList),
   98		format(atom(TransparentTargetsAtom), ' in execution context ~w (context dependend)', [ModuleList]),
   99		PropertyList = [suffix(TransparentTargetsAtom)|PropertyList0]
  100	),
  101	functor(Goal, UndefName, UndefArity).
  102%	format(atom(GoalAsAtom), '~w', [Goal]).
 find_dead_predicate(Root, Module, Functor, Arity, File, HeadLocation, ClauseStart, ClauseEnd, PropertyList)
  106find_dead_predicate(Root, Module, Functor, Arity, File, HeadLocation, ClauseStart, ClauseEnd, PropertyList) :-
  107	find_dead_predicates,
  108	!,
  109	is_dead(Module, Functor, Arity),
  110	\+ find_blacklist(Functor, Arity, Module),
  111%	once(accept_dead_predicate(Module:Functor/Arity)),
  112	defined_in_files(Module, Functor, Arity, Locations),
  113	member(File-LineAndClauseRefs, Locations),
  114	(	nonvar(Root)
  115	->	sub_atom(File, 0, _, _, Root)
  116	;	true
  117	),
  118    member(location(Line, Ref), LineAndClauseRefs),
  119    properties_for_predicate(Module, Functor, Arity, PropertyList0),
  120    (	positions_of_clause(Ref, Position, ClauseStart, ClauseEnd)
  121    ->	HeadLocation = Position,
  122    	PropertyList = [line(Line)|PropertyList0]
  123    ;	HeadLocation = Line,
  124    	PropertyList = PropertyList0
  125    ).
  126
  127positions_of_clause(Ref, Position, ClauseStart, ClauseEnd) :-
  128	catch(clause_info(Ref, _, TermPosition, _),_,fail),
  129	(	clause_property(Ref, fact)
  130	->	% fact
  131		TermPosition = HeadPosition,
  132		Start = ClauseStart,
  133		End = ClauseEnd
  134	;	% clause with body
  135		TermPosition = term_position(ClauseStart, ClauseEnd, _, _, [HeadPosition|_])
  136	),
  137	(	HeadPosition = Start-End
  138	->	% no arguments
  139		true
  140	;	% at least one argument
  141		HeadPosition = term_position(Start, End, _, _, _)
  142	),
  143	format(atom(Position), '~w-~w', [Start, End]).
  144
  145
  146:- multifile(entry_point/1).  147
  148:- multifile(accept_dead_predicate/1).  149
  150:- dynamic(is_called/3).  151:- dynamic(is_dead/3).  152
  153find_dead_predicates :-
  154	ensure_call_graph_generated,
  155	retractall(is_called(_, _, _)),
  156	retractall(is_dead(_, _, _)),
  157	forall((
  158		entry_point_predicate(M, F, A)
  159	),(
  160		(	is_called(M, F, A)
  161		->	true
  162		;	assertz(is_called(M, F, A)),
  163			follow_call_edge(M, F, A)
  164		)
  165	)),
  166	(	is_called(_, _, _)
  167	->	forall((
  168			declared_in_module(M, F, A, M),
  169			\+ is_called(M, F, A)
  170		),(
  171			(	is_dead(M, F, A)
  172			->	true
  173			;	assertz(is_dead(M, F, A))
  174			)
  175		))
  176	;	true
  177	).
  178
  179entry_point_predicate(M, F, A) :-
  180	entry_point(M), % module
  181	atomic(M),
  182	(	M == user
  183	->	declared_in_module(user, F, A, user)
  184	;	module_property(M, exports(ExportList)),
  185		member(F/A, ExportList)
  186	).
  187entry_point_predicate(M, F, A) :-
  188	entry_point(M:F/A). % predicate
  189entry_point_predicate(M, F, A) :-
  190	pdt_entry_point(File),
  191	(	module_property(M, file(File))
  192	*->	module_property(M, exports(ExportList)),
  193		member(F/A, ExportList)
  194	;	pdt_source_file(M:Head, File),
  195		functor(Head, F, A)
  196	).
  197
  198follow_call_edge(M, F, A) :-
  199	calls(M2, F2, A2, M, F, A, _),
  200	\+ is_called(M2, F2, A2),
  201	assertz(is_called(M2, F2, A2)),
  202	follow_call_edge(M2, F2, A2),
  203	fail.
  204follow_call_edge(_, _, _).
  205
  206find_blacklist('$load_context_module',2,_).
  207find_blacklist('$load_context_module',3,_).
  208find_blacklist('$mode',2,_).
  209find_blacklist('$pldoc',4,_).
 find_undeclared_meta_predicate(Root, Module, Name, Arity, MetaSpec, MetaSpecAtom, File, Line, PropertyList, Directive)
  212find_undeclared_meta_predicate(Root, Module, Name, Arity, MetaSpec, MetaSpecAtom, File, Line, [label(MetaSpecAtom)|PropertyList], Directive) :-
  213	ensure_call_graph_generated,
  214	!,
  215	declared_in_module(Module, Name, Arity, Module),
  216	functor(Head, Name, Arity),
  217	\+ predicate_property(Module:Head, built_in),
  218%	\+ predicate_property(Module:Head, multifile),
  219	inferred_meta(Module:Head, MetaSpec),
  220	predicate_property(Module:Head, line_count(Line)),
  221	\+ extended_meta_predicate(Module:Head, _ExtendedMetaSpec),
  222	(	predicate_property(Module:Head, meta_predicate(DeclaredMetaSpec))
  223	->	DeclaredMetaSpec \== MetaSpec
  224	;	true
  225	),
  226	properties_for_predicate(Module, Name, Arity, PropertyList),
  227	member(file(File), PropertyList),
  228	(	nonvar(Root)
  229	->	sub_atom(File, 0, _, _, Root)
  230	;	true
  231	),
  232	format(atom(MetaSpecAtom), '~w', [MetaSpec]),
  233	(	swi_meta_predicate_spec(MetaSpec)
  234	->	format(atom(Directive), ':- meta_predicate(~w).~n', [MetaSpec])
  235	;	format(atom(Directive), ':- extended_meta_predicate(~w).~n', [MetaSpec])
  236	).
  237
  238swi_meta_predicate_spec(Head) :-
  239	swi_meta_predicate_spec(Head, 1).
  240
  241swi_meta_predicate_spec(Head, N) :-
  242	arg(N, Head, Arg),
  243	!,
  244	swi_meta_spec(Arg),
  245	N2 is N + 1,
  246	swi_meta_predicate_spec(Head, N2).
  247swi_meta_predicate_spec(_, _).
  248
  249swi_meta_spec(I) :- integer(I), !.
  250swi_meta_spec(^).                 
  251swi_meta_spec(//).                
  252swi_meta_spec(:).                
  253swi_meta_spec(?).                
  254swi_meta_spec(+).                
  255swi_meta_spec(-).                
  256swi_meta_spec(*)