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(cross_reference_builder, [derive_edges/0,
   15									cross_references_for_predicate/1]).   16
   17:- ensure_loaded(modules_and_visibility).   18:- ensure_loaded(parse_util).   19:- ensure_loaded(pdt_prolog_library(utils4modules)).   20
   21derive_edges:-
   22    forall( 
   23    	literalT(LId,_,_,Module,Functor,Arity),
   24		find_reference_for(LId,Module,Functor,Arity)
   25    ).
   26
   27
   28cross_references_for_predicate(PredId):-
   29    predicateT(PredId,_,Functor,Arity,_),
   30    visible_in_module(PredId, Module),
   31    forall(
   32    	literalT_ri(Functor,Arity,Module,LitId),
   33    	assert(call_edge(PredId,LitId))
   34    	).
   35cross_references_for_predicate(PredId):-
   36    forall(
   37    	(	pred_edge(ClauseId,PredId),
   38    		literalT(LId,_,ClauseId,Module,Functor,Arity)
   39    	),
   40    	find_reference_for(LId,Module,Functor,Arity)
   41    ).
   42    
   43find_reference_for(LId,Module,Functor,Arity):-    	
   44    (	(	predicateT_ri(Functor,Arity,Module,Id)
   45    	->	true
   46   		;	(	predicateT_ri(Functor ,Arity ,_DecModule, Id),
   47   				visible_in_module(Id, Module)
   48   			)
   49   					%get_predicate_referenced_as(Module, Functor, Arity, Id)
   50   		)
   51   	->	assert(call_edge(Id,LId))	
   52	;	catch(	(	(	functor(Term, Functor, Arity),
   53    					defined_in(Module, Term, DefModule),
   54    					/*(	var(Module)
   55    					->	
   56    					;	*/predicate_property(DefModule:Term, built_in)
   57    			  		%)
   58    		  		)
   59    			->	assert(call_built_in(Functor, Arity, DefModule, LId))
   60    			;	true			%TODO: here is a possible place to create a warning as soon as it's reduced to "real" problems...
   61    			),
   62    			_Error,
   63    			%(	format('Problem with crossref -> Module: ~w, Functor: ~w, Arity: ~w, LId: ~w, Error: ~n',[Module,Functor,Arity,LId, Error]),
   64    				true 
   65    			%)
   66   			)
   67	)