1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module( pdt_xref,
   15         [ find_reference_to/9 % +Term,+ExactMatch,?Root,
   16                               % -RefModule,-RefName,-RefArity,-RefFile,-RefLine,-PropertyList
   17         ]
   18         ).   19
   20:- use_module(pdt_prolog_library(utils4modules)).   21:- use_module(pdt_prolog_library(utils4modules_visibility)).   22
   23:- use_module( pdt_common_pl(properties), [properties_for_predicate/4] ).   24:- use_module(library(lists)).   25
   26:- use_module(pdt_common_pl('callgraph/pdt_call_graph')).   27
   28%:- ensure_loaded('../pdt_factbase.pl').
   29%:- use_module('../modules_and_visibility').
   30    /*********************************************
   31     * FIND REFERENCES TO A PARTICULAR PREDICATE *
   32     ********************************************/
   33find_unique( Goal ) :-
   34    setof( Goal, Goal, Set),
   35    member(Goal, Set).
   36    
   37:- dynamic(result/5).   38:- dynamic(result_transparent/6).   39
   40assert_result(IsAlias, QGoal, Caller, clause_term_position(Ref, TermPosition), Kind) :-
   41	QGoal = M:Goal,
   42	(	predicate_property(Caller, transparent),
   43		\+ predicate_property(Caller, meta_predicate(_)),
   44		(	Kind = metacall(_, _)
   45		;	Kind = database(_, _)
   46		)
   47	->	(	retract(result_transparent(IsAlias, Goal, Ref, TermPosition, Kind, Modules))
   48		->	(	member(M, Modules)
   49			->	NewModules = Modules
   50			;	NewModules = [M|Modules]
   51			)
   52		;	NewModules = [M]
   53		),
   54		assertz(result_transparent(IsAlias, Goal, Ref, TermPosition, Kind, NewModules))
   55	;	assertz(result(IsAlias, QGoal, Ref, TermPosition, Kind))
   56	),
   57	!.
   58assert_result(IsAlias, QGoal, _, file_term_position(File, TermPosition), Kind) :-
   59	QGoal = _:_Goal,
   60	assertz(result(IsAlias, QGoal, File, TermPosition, Kind)),
   61	!.
   62
   63assert_result(IsAlias, QGoal, _, clause(Ref), Kind) :-
   64	QGoal = _:_Goal,
   65	assertz(result(IsAlias, QGoal, Ref, no_term_position, Kind)),
   66	!.
   67
   68assert_result(_,_,_,_,_).

 find_reference_to(Term, ExactMatch, Root, RefModule, RefName, RefArity, RefFile, Position, PropertyList)

   71find_reference_to(Term, ExactMatch, Root, RefModule, RefName, RefArity, RefFile, Position, PropertyList) :-
   72	(	Term = predicate(SearchMod, _, Functor, Separator, Arity0)
   73	->	(	Separator == (//),
   74			nonvar(Arity0)
   75		->	Arity is Arity0 + 2
   76		;	Arity = Arity0
   77		)
   78	;	Term = goal(SearchGoal),
   79		nonvar(SearchGoal),
   80		SearchGoal = SearchMod:H,
   81		callable(H),
   82		functor(H, Functor, Arity)
   83	),
   84	(	var(Functor),
   85		var(SearchMod)
   86	->	fail
   87	;	true
   88	),
   89	retractall(result(_, _, _, _, _)),
   90	retractall(result_transparent(_, _, _, _, _, _)),
   91	(	var(SearchGoal)
   92	->	perform_search(Functor, Arity, SearchMod, ExactMatch)
   93	;	perform_search_for_goal(SearchMod, Functor, Arity, SearchGoal)
   94	),
   95	!,
   96	(	retract(result(Alias, M0:ReferencingGoal, ClauseRefOrFile, Termposition, _))
   97	;	retract(result_transparent(Alias, ReferencingGoal, ClauseRefOrFile, Termposition, _, M0s))
   98	),
   99	(	atom(ClauseRefOrFile)
  100	->	RefFile = ClauseRefOrFile,
  101		(	nonvar(Root)
  102		->	sub_atom(RefFile, 0, _, _, Root)
  103		;	true
  104		),
  105		Line = 1,
  106		once(module_of_file(RefFile, RefModule)),
  107		RefName = (initialization),
  108		RefArity = 1
  109	;	ClauseRef = ClauseRefOrFile,
  110		clause_property(ClauseRef, predicate(RefModule:RefName/RefArity)),
  111		(	nonvar(SearchMod),
  112			var(Functor),
  113			var(Arity)
  114		->	SearchMod \== RefModule
  115		;	true
  116		),
  117		clause_property(ClauseRef, file(RefFile)),
  118		(	nonvar(Root)
  119		->	sub_atom(RefFile, 0, _, _, Root)
  120		;	true
  121		),
  122		% check that RefFile is not derived from another file
  123		clause_property(ClauseRef, source(RefFile)),
  124		clause_property(ClauseRef, line_count(Line))
  125	),
  126	properties_for_predicate(RefModule,RefName,RefArity,PropertyList0),
  127	(	(	Termposition = term_position(Start, End, _, _, _)
  128		;	Termposition = Start-End
  129		)
  130	->	format(atom(Position), '~w-~w', [Start, End])
  131	;	Position = Line
  132	),
  133	functor(ReferencingGoal, N, A),
  134	(	nonvar(M0)
  135	->	(	declared_in_module(M0, N, A, M)
  136		->	true
  137		;	M0 = M
  138		)
  139	;	nonvar(M0s),
  140		setof(
  141			M2,
  142			M1^N^A^M0s^(	
  143				member(M1, M0s),
  144				(	declared_in_module(M1, N, A, M2)
  145				->	true
  146				;	M2 = M1
  147				)
  148			),
  149			Ms
  150		),
  151		atomic_list_concat(Ms, ', ', ModuleList),
  152		format(atom(TransparentTargetsAtom), ' in execution context ~w (context dependend)', [ModuleList])
  153	),
  154	(	Separator == (//)
  155	->	format(atom(Label), '~w//~w', [N, Arity0])
  156	;	format(atom(Label), '~w/~w', [N, A])
  157	),
  158	PropertyList1 = [label(Label),line(Line)|PropertyList0],
  159	(	nonvar(M),
  160		M \== RefModule
  161	->	format(atom(Prefix), '~w:', [M]),
  162		PropertyList2 = [prefix(Prefix)|PropertyList1]
  163	;	PropertyList2 = PropertyList1
  164	),
  165	(	nonvar(Alias)
  166	->	format(atom(AliasAtom), ' [alias for ~w]', [Alias]),
  167		(	nonvar(TransparentTargetsAtom)
  168		->	atom_concat(TransparentTargetsAtom, AliasAtom, Suffix)
  169		;	Suffix = AliasAtom
  170		)
  171	;	Suffix = TransparentTargetsAtom
  172	),
  173	(	nonvar(Suffix)
  174	->	PropertyList = [suffix(Suffix)|PropertyList2]
  175	;	PropertyList = PropertyList2
  176	).
  177
  178perform_search(Functor, Arity, Module, ExactMatch) :-
  179	(	nonvar(Functor)
  180	->	setof(
  181			p(SearchModule, SearchFunctor, SearchArity, IsAlias),
  182			Module^Functor^Arity^ExactMatch^search_predicate_indicator(Module, Functor, Arity, ExactMatch, SearchModule, SearchFunctor, SearchArity, IsAlias),
  183			Predicates
  184			),
  185		member(p(SearchModule, SearchFunctor, SearchArity, IsAlias), Predicates)
  186	;	Module = SearchModule
  187	),
  188	(	nonvar(SearchFunctor),
  189		nonvar(SearchArity)
  190	->	functor(Goal, SearchFunctor, SearchArity)
  191	;	true
  192	),
  193	collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates),
  194	pdt_walk_code([trace_reference(SearchModule:Goal), predicates(Candidates), on_trace(pdt_xref:assert_result(IsAlias))]),
  195	fail.
  196
  197perform_search(_Functor, _Arity, _SearchMod, _ExactMatch).
  198
  199search_predicate_indicator(SearchModule0, SearchFunctor0, SearchArity, true, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
  200	nonvar(SearchArity),
  201	!,
  202	(	declared_in_module(SearchModule0, SearchFunctor0, SearchArity, SearchModule0),
  203		possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
  204		IsAlias = SearchModule0:SearchFunctor0/SearchArity
  205	;	SearchModule0 = SearchModule,
  206		SearchFunctor0 = SearchFunctor
  207	).
  208
  209search_predicate_indicator(SearchModule0, SearchFunctor0, Arity, true, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
  210	var(Arity),
  211	!,
  212	setof(
  213		M-A,
  214		declared_in_module(M, SearchFunctor0, A, M),
  215		MAs
  216	),
  217	member(SearchModule0-SearchArity, MAs),
  218	(	SearchModule0 = SearchModule,
  219		SearchFunctor0 = SearchFunctor
  220	;	possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
  221		IsAlias = SearchModule0:SearchFunctor0/SearchArity
  222	).
  223
  224search_predicate_indicator(SearchModule0, Functor, SearchArity, false, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
  225	nonvar(SearchArity),
  226	!,
  227	setof(
  228		M-F,
  229		(declared_in_module(M, F, SearchArity, M), once(sub_atom(F, _, _, _, Functor))),
  230		MFs
  231	),
  232	member(SearchModule0-SearchFunctor0, MFs),
  233	(	SearchModule0 = SearchModule,
  234		SearchFunctor0 = SearchFunctor
  235	;	possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
  236		IsAlias = SearchModule0:SearchFunctor0/SearchArity
  237	).
  238
  239search_predicate_indicator(SearchModule0, Functor, Arity, false, SearchModule, SearchFunctor, SearchArity, IsAlias) :-
  240	var(Arity),
  241	!,
  242	setof(
  243		M-F-A,
  244		(declared_in_module(M, F, A, M), once(sub_atom(F, _, _, _, Functor))),
  245		MFAs
  246	),
  247	member(SearchModule0-SearchFunctor0-SearchArity, MFAs),
  248	(	SearchModule0 = SearchModule,
  249		SearchFunctor0 = SearchFunctor
  250	;	possible_alias(SearchModule0, SearchFunctor0, SearchArity, SearchModule, SearchFunctor),
  251		IsAlias = SearchModule0:SearchFunctor0/SearchArity
  252	).
  253
  254possible_alias(Module, Name, Arity, ImportingModule, AliasName) :-
  255	functor(Head, Name, Arity),
  256	\+ predicate_property(Module:Head, multifile),
  257	predicate_property(Module:Head, file(File)),
  258	source_file_property(File, load_context(ImportingModule, _Position, Options)),
  259	memberchk(imports(Imports), Options),
  260	memberchk(Name/Arity as AliasName, Imports).
  261
  262perform_search_for_goal(SearchModule, SearchFunctor, SearchArity, SearchGoal) :-
  263	collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates),
  264	pdt_walk_code([trace_reference(SearchGoal), predicates(Candidates), on_trace(pdt_xref:assert_result(_))]).
  265
  266collect_candidates(SearchModule, SearchFunctor, SearchArity, Candidates) :-
  267	ensure_call_graph_generated,
  268	setof(Module:Name/Arity, (
  269		SearchModule^SearchFunctor^SearchArity^NumberOfCalls^calls(SearchModule, SearchFunctor, SearchArity, Module, Name, Arity, NumberOfCalls)
  270	), Candidates).
  271	
  272%find_reference_to(Functor,Arity,DefFile, SearchMod, ExactMatch,
  273%                  RefModule,RefName,RefArity,RefFile,RefLine,Nth,Kind,PropertyList) :-
  274%    find_unique(  find_reference_to__(Functor,Arity,DefFile, SearchMod, ExactMatch,
  275%                  RefModule,RefName,RefArity,RefFile,RefLine,Nth,Kind,PropertyList) ).
  276%    
  277%find_reference_to__(Functor,Arity,DefFile, SearchMod, ExactMatch,
  278%                  RefModule,RefName,RefArity,RefFile,RefLine,Nth,Kind,PropertyList) :-                  
  279%	( nonvar(DefFile)
  280%    -> module_of_file(DefFile,SearchMod)
  281%    ; true % Defining File and defining Module remain free ==> 
  282%           % Search for references to independent definitions
  283%           % <-- Does that make sense???
  284%    ),
  285%%    ( var(Arity) % Need to backtrack over all declared Functor/Arity combinations:
  286%%    -> ( setof( Functor/Arity, SearchMod^current_predicate(SearchMod:Functor/Arity), Set),
  287%%         member(Functor/Arity, Set)
  288%%       )
  289%%    ; true % Arity already bound in input
  290%%    ),
  291%%    functor(SearchTerm,Functor,Arity),
  292%    pdt_xref_data(SearchMod:Functor/Arity,ExactMatch,RefModule:RefHead,Ref,Kind),
  293%
  294%    functor(RefHead,RefName,RefArity),
  295%    predicate_property(RefModule:RefHead,_),
  296%    nth_clause(RefModule:RefHead,Nth,Ref),
  297%    clause_property(Ref, file(RefFile)),
  298%    clause_property(Ref, line_count(RefLine)),
  299%    properties_for_predicate(RefModule,RefName,RefArity,PropertyList),
  300%    ( var(Functor) -> Functor = '' ; true),
  301%    ( var(Arity) -> Arity = '' ; true),
  302%    ( var(DefFile) -> DefFile = '' ; true),
  303%    ( var(SearchMod) -> SearchMod = '' ; true).
  304%
  305%go :- % To list all results quickly call 
  306%      % ?- pdt_xref:go, fail.
  307%    find_reference_to(defined_in_file,6,__DefFile, __DefModule,RefModule,RefName,RefArity,RefFile,RefLine,Nth,Kind,_PropertyList),
  308%    format( '~a reference from ~a:~w clause ~a, line ~a, file ~n~a~n~n',
  309%            [Kind, RefModule,RefName,RefArity, Nth, RefLine, RefFile]
  310%    ).
  311%	
  312%
  313%pdt_xref_data(DefModule:DefFunctor/DefArity,ExactMatch,RefModule:RefHead,Ref, Kind) :-
  314%	current_predicate(RefModule:F/A),     % For all defined predicates
  315%	functor(RefHead,F,A),   
  316%	nth_clause(RefModule:RefHead,_N,Ref),   % For all their clauses
  317%	'$xr_member'(Ref, QualifiedTerm),					% Get a term referenced by that clause
  318%	(	var(DefFunctor),
  319%		QualifiedTerm = M:_
  320%	->	M \== RefModule
  321%	;	true
  322%	), 
  323%	is_reference_to(DefModule:DefFunctor/DefArity,ExactMatch,RefHead,QualifiedTerm,Kind).     % (via SWI-Prolog's internal xref data)
  324% 
  325%
  326%   
  327%%pdt_xref_data(DefModule:DefHead,RefModule:RefHead,Ref, Kind) :-
  328%%    functor(DefHead, DefFunctor, DefArity),
  329%%    modules_and_visibility:get_predicate_referenced_as(DefModule, DefFunctor, DefArity, DefId),
  330%%    (	DefId = predefined(DeclModule, Functor, Arity)
  331%%    ->	parse_util:call_built_in(Functor, Arity, DeclModule, RefLitId)
  332%%    ;	parse_util:call_edge(DefId, RefLitId)
  333%%    ),
  334%%    parse_util:literalT(RefLitId, _, RefClauseId, _, _, _),
  335%%    parse_util:clauseT(RefClauseId, _, RefModule, RefFunctor, RefArity),
  336%%    functor(RefHead, RefFunctor, RefArity),
  337%%    predicate_property(RefModule:RefHead, _),
  338%%    clause(RefModule:RefHead, Ref),
  339%%	 parse_util:termT(RefLitId, RefTerm),
  340%%    is_reference_to(DeclModule:DefHead,RefHead,RefModule:RefTerm,Kind).
  341%	    
  342%
  343%is_reference_to(DefModule:DefSignature, ExactMatch, RefHead, Reference, RefKind) :-
  344%    ( Reference = RefModule:RefTerm
  345%    -> is_reference_to__(DefModule,DefSignature, ExactMatch, RefHead, RefModule, RefTerm,   RefKind)
  346%    ;  is_reference_to__(DefModule,DefSignature, ExactMatch, RefHead, _,         Reference, RefKind)
  347%    ).
  348%
  349%is_reference_to__(DefModule,DefFunctor/DefArity, ExactMatch, RefHead, RefModule, RefTerm, RefKind) :-
  350%	nonvar(DefModule),
  351%	var(DefFunctor),
  352%    nonvar(RefTerm),
  353%    !, % Reference to module
  354%    (	ExactMatch == true
  355%    ->	DefModule == RefModule
  356%    ;	nonvar(RefModule),
  357%    	once(sub_atom(RefModule, _, _, _, DefModule))
  358%    ),
  359%    ref_kind(DefModule, DefFunctor/DefArity, RefHead, RefModule,  RefKind).
  360%
  361%is_reference_to__(DefModule,DefFunctor/DefArity, ExactMatch, RefHead, RefModule, RefTerm, RefKind) :- 
  362%    nonvar(DefFunctor),
  363%    nonvar(RefTerm),
  364%    functor(RefTerm, RefFunctor, RefArity),
  365%    (	ExactMatch == true
  366%    ->	DefFunctor == RefFunctor
  367%    ;	once(sub_atom(RefFunctor, _, _, _, DefFunctor))
  368%    ),
  369%    (	(var(DefArity); DefArity == -1)
  370%    ->	true
  371%    ;	DefArity == RefArity
  372%    ),
  373%%    DefTerm=RefTerm,  % It is a reference! Determine its kind:
  374%    ref_kind(DefModule, DefFunctor/DefArity, RefHead, RefModule,  RefKind).
  375%
  376%ref_kind(DefModule, _, _, RefModule, RefKind) :-     
  377%    DefModule == RefModule,
  378%    !,
  379%    RefKind = call.
  380%ref_kind(_, _, '$mode'(_, _), _, RefKind) :- 
  381%    !,
  382%    RefKind=prologdoc.   
  383%ref_kind(_, _, _, _, RefKind) :- 
  384%    RefKind=termORmetacall.
  385             
  386
  387%               /********************************************
  388%                * FIND REFERENCES TO A PREDICATE DEFINITON *
  389%                ********************************************/
  390%       Version von Toias, die auf Paarsen des Outputs von "explain" basierte
  391%       (war langsamer, fand weniger Referenzen (keine Metaterme) und war 
  392%       nicht in der Lage, die Art der Referenzen (Call, Metacall, PrologDoc)
  393%       zu unterscheiden. "expalin" bot f�r all das keinen Ansatzpunkt 
  394%
  395%%% get_references(+EnclFile,+PredSignature,?Module, -FileName,-Line,-RefModule,-Name,-Arity) is nondet.
  396%%
  397%%  @param PredSignature PredName/Arity
  398%%  @author TRHO
  399%%
  400%get_references(EnclFile, Name/Arity,Module, RefFile,Line,RefModule,RefName,RefArity):-
  401%    (  atom(Module)
  402%    -> true                              % Explicit module qualification
  403%    ;  module_of_file(EnclFile,Module)   % Implicit module qualification
  404%    ),
  405%    functor(Pred,Name,Arity),            % Predicate to be searched 
  406%    % INTERNAL, works for swi 5.11.X
  407%    prolog_explain:explain_predicate(Module:Pred,Explanation), 
  408%%    writeln(Explanation),
  409%    decode_reference(Explanation,Nth, RefModule,RefName, RefArity),
  410%    number(RefArity),
  411%    defined_in_file(RefModule,RefName,RefArity,Nth,RefFile,Line).
  412%%   <-- Extracted predicate for:
  413%%    nth_clause(RefModule:Head,Nth,Ref),
  414%%    clause_property(Ref,file(FileName)),
  415%%    clause_property(Ref,line_count(Line)).
  416%
  417%      
  418%
  419%%% decode_reference(+RefStr,-Nth, -RefModule, +Pred,-Arity) is nondet.
  420%%
  421%% Reference string from explain/2 predicate
  422%% 
  423%%  IMPORTANT: Hardcoded reference to the user module!
  424%%  Only works for predicates defined in the user module!
  425%%
  426%decode_reference(RefStr,Nth, RefModule,Pred,Arity):-
  427%    atom_concat('        Referenced from ',Rest,RefStr),
  428%    atom_concat(NthAtom,Help0,Rest),
  429%    atom_concat('-th clause of ',PredRef,Help0),
  430%    atom_concat(RefModule,Help1,PredRef),
  431%    atom_concat(':',PredicateIndicator,Help1),
  432%    atom_concat(Pred,Help2,PredicateIndicator),
  433%    atom_concat('/',ArityAtom,Help2),
  434%    atom_number(NthAtom,Nth),
  435%    atom_number(ArityAtom,Arity),
  436%    !.
  437%
  438%%%%%%%%%%% Tests %%%%%%%%%%%
  439%
  440%user:setUp(decode_reference) :-
  441%	assert(user:testpred(1,2)).
  442%user:test(decode_reference) :-
  443%    decode_reference('        Referenced from 1-th clause of user:testpred/2',
  444%                     1, 'testpred',2).
  445%
  446%user:tearDown(decode_reference) :-
  447%	retract(user:testpred(1,2)).