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(predicates,[	derive_all_predicates/0,
   15						derive_predicates_of_files/1,
   16						%derive_predicate_for_clause/6,
   17						derive_directive_collections/0,
   18						derive_directive_collection_of_files/1,
   19						compute_all_predicate_properties/0,
   20						compute_predicate_properties_for_files/1]).   21:- ensure_loaded(pdt_factbase).   22:- use_module(library(lists)).   23
   24derive_all_predicates:-
   25    forall(
   26    	fileT(FileId,_,_),
   27    	derive_predicates_of_file(FileId)
   28    ).
   29    
   30    
   31    
   32derive_predicates_of_files(Files):-
   33	forall(
   34		member(File,Files),
   35	    (	fileT_ri(File,FileId)
   36	    	->	derive_predicates_of_file(FileId)
   37			;	true   %if a file does not exist as a PEF, the rest should be evaluated, anyway
   38	    )
   39	).
   40
   41	
   42	
   43derive_predicates_of_file(FileId):-
   44    forall( 
   45    	clauseT(CId,FileId,Module,Functor,Arity),
   46    	derive_predicate_for_clause(CId,Functor,Arity,Module,FileId,_PId)
   47    ),!.
   48derive_predicates_of_file(File):-
   49	format('Warning: An error occured while coputing predicates for file-id: ~w.~n',[File]).
   50    
   51    	  
   52derive_predicate_for_clause(CId,Functor,Arity,Module,_File,PId):-
   53	predicateT_ri(Functor,Arity,Module,PId),
   54	!,
   55	compute_new_length(PId,CId),
   56    assert(pred_edge(CId,PId)).
   57derive_predicate_for_clause(CId,Functor,Arity,Module,File,PId):-    
   58    assert_predicate(CId,Functor,Arity,Module,File,PId),
   59    assert(pred_edge(CId,PId)).
   60    
   61    
   62derive_directive_collections:-
   63    forall(
   64    	fileT(File,_,_),
   65    	derive_directive_collection_of_file(File)
   66    ).
   67    
   68    
   69derive_directive_collection_of_files(Files):-
   70    forall(
   71    	member(FileName,Files),
   72    	(	fileT_ri(FileName,File)
   73    	->	derive_directive_collection_of_file(File)
   74    	;	true	%if a file does not exist as a PEF, the rest should be evaluated, anyway
   75    	)
   76    ).
   77    
   78    
   79derive_directive_collection_of_file(File):-
   80   % fileT(File,FileName,_),
   81    forall( 
   82    	directiveT(Id,File,Module),
   83		(	(	(	onloadT(PId,File,Module)	
   84    			->	(	assert(onload_edge(Id,PId)),
   85    					compute_new_length(PId,Id)
   86    				)	  					
   87    			;	(	new_node_id_pdt(PId),	
   88    					assert(node_id(PId)),
   89    					assert(onloadT(PId,File,Module)),  
   90    						
   91    					filePosT(Id,Begin,Length),
   92    					assert(filePosT(PId,Begin,Length)),  
   93   
   94    					assert(onload_edge(Id,PId))
   95    				)	
   96    		  	) 			
   97    		)
   98    	; 	termT(Id,Term),
   99    		writeln(Term)
  100    	)
  101	),!.
  102derive_directive_collection_of_file(File):-
  103	format('Warning: An error occured while collecting directives for file-id: ~w.~n',[File]).
  104	
  105
  106compute_new_length(PId,Id) :-
  107	filePosT(PId,PBegin,PLength),
  108    PEnd is PBegin + PLength,
  109    filePosT(Id,Begin,Length),
  110   	End is Begin + Length,
  111    NewBegin is min(PBegin,Begin),
  112    NewEnd is max(PEnd,End),
  113    NewLength is NewEnd - NewBegin,
  114    retract(filePosT(PId,PBegin,PLength)),
  115    assert(filePosT(PId,NewBegin,NewLength)).
  116    
  117    
  118
  119compute_all_predicate_properties:-
  120    forall(	
  121    	property_dir(DirectiveId, Functor, Args),
  122    	(	directiveT(DirectiveId, File, Module),
  123    		compute_predicate_property(Functor, Args, DirectiveId, File, Module)
  124    	)
  125    ).
  126
  127
  128compute_predicate_properties_for_files(Files):-
  129	forall(
  130		member(File,Files),
  131	    (	fileT_ri(File,FileId)
  132		->	compute_predicate_properties_for_file(FileId)
  133		;	true   	%if a file does not exist as a PEF, the rest should be evaluated, anyway
  134	    )
  135	).
  136
  137compute_predicate_properties_for_file(File):-
  138    forall(
  139    	directiveT(DirectiveId, File, Module),
  140    	(	property_dir(DirectiveId,Functor,Args)
  141    	->	compute_predicate_property(Functor, Args, DirectiveId, File, Module)
  142    	;	true	%it may be another kind of property
  143    	)
  144    ),!.
  145compute_predicate_properties_for_file(File):-
  146	format('Warning: An error occured while computing predicate properties for file-id: ~w.~n',[File]).
  147
  148/*
  149 * analyse_directive(+Directive,+ParentId,+Module)
  150 *   looks into the term of Arg1 and if it is a known 
  151 *   kind of directive term stores accordingly information
  152 *   that can be used in the former parsing or x-referencing
  153 *   process (like modules, operators, dynamics, transparencies,
  154 *   metafile,...)
  155 **/
  156compute_predicate_property(Prop, Preds, DirectiveId, File, Module):-     % dynamic
  157	conjunction_to_list(Preds,Predicates),
  158	forall(	
  159		member(Functor/Arity, Predicates),
  160		(	(	predicateT_ri(Functor,Arity,Module,PId)
  161			->	true
  162			;	%(Prop = dynamic)	% because order is not deterministic it is easier to not do this check
  163									% this also represents the read code, more. But this should lead to a later
  164									% check for missing dynamic declarations - or for a smell about this...
  165
  166    			%directiveT(DirectiveId, File, _),
  167    			assert_predicate(DirectiveId,Functor,Arity,Module,File,PId)
  168			),
  169			assert_prop(Prop, PId, DirectiveId)
  170		)
  171	),!.	
  172compute_predicate_property(Prop, Preds, _DirectiveId, _File, Module):-
  173	format('Warning: Error occured while computing predicate property ~w for ~w of Module ~w~n.',[Prop,Preds,Module]). 
  174
  175 	
  176
  177conjunction_to_list([],[]).
  178conjunction_to_list([A|B],[A|B]).
  179conjunction_to_list((A,B),[A,B]) :-
  180   atom(B),!. 
  181conjunction_to_list((A,B),[A|BasList]) :-
  182   conjunction_to_list(B,BasList).
  183   
  184   
  185assert_prop(dynamic, PredId, DirectiveId):-
  186    assert(dynamicT(PredId, DirectiveId)).
  187assert_prop(module_transparent, PredId, DirectiveId):-
  188    assert(transparentT(PredId, DirectiveId)).
  189assert_prop(multifile, PredId, DirectiveId):-
  190    assert(multifileT(PredId, DirectiveId)).
  191assert_prop(meta_predicate, PredId, DirectiveId):-
  192    assert(meta_predT(PredId, DirectiveId)). 
  193assert_prop(_,_,_).
  194
  195
  196
  197assert_predicate(CId,Functor,Arity,Module,File,PId):-
  198    new_node_id_pdt(PId),	
  199    assert(node_id(PId)),
  200    assert(predicateT(PId,File,Functor,Arity,Module)),
  201    assert(predicateT_ri(Functor,Arity,Module,PId)),
  202    filePosT(CId,Begin,Length),
  203    assert(filePosT(PId,Begin,Length))