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(term_based_metapred_finder, [	infer_meta_arguments_for/3,
   15										find_meta_pred_args_in_clause/3]).   16:- use_module(pdt_prolog_library(utils4modules)).   17:- use_module(library(lists)).   18:- use_module(metafile_referencer).   19
   20/*
   21 * infer_meta_arguments_for(?Module,?AHead,?MetaSpec) is det
   22 *
   23 * Arg3 is the infered meta_predicate specification of the
   24 * predicat Arg2 in module Arg1. 
   25 * 
   26 * Fails, if Arg2 is not a meta-predicate.
   27 * 
   28 * Currently only infers ? and 0.
   29 * For built-in predicates the original specification is used. 
   30 **/
   31infer_meta_arguments_for(Module,AHead,MetaSpec):-
   32    (	var(AHead)
   33    ->	defined_in_module(Module,Functor,Arity)
   34    ;	functor(AHead, Functor, Arity)	
   35    ),
   36    functor(Head, Functor, Arity), 	%get most general head to find all clauses of the predicate
   37    findall(	MetaArgs,
   38				find_meta_pred_args_in_clause(Module, Head, MetaArgs),
   39				AllMetaArgs
   40			),
   41	(	AllMetaArgs = []
   42	->	fail
   43	;	(	combine_meta_args(AllMetaArgs,CombinedArgs),
   44			MetaSpec =.. [Functor|CombinedArgs]
   45		)
   46	). 
   47
   48
   49find_meta_pred_args_in_clause(Module, Head, MetaArgs):-
   50    \+(var(Head)),
   51    predicate_property(Module:Head, built_in), !,
   52    predicate_property(Module:Head, meta_predicate(Spec)),
   53    Spec =.. [_|MetaArgs].
   54find_meta_pred_args_in_clause(Module, Head, MetaArgs):-
   55	clause(Module:Head, Body), !,
   56	find_meta_vars_in_body(Body, Module, [],  MetaVars),
   57	find_meta_vars_in_head(Head, MetaVars, MetaArgs).
   58find_meta_pred_args_in_clause(AModule, Head, MetaArgs):-
   59    defined_in(AModule, Head, Module),
   60	clause(Module:Head, Body), !,
   61	find_meta_vars_in_body(Body, Module, [],  MetaVars),
   62	find_meta_vars_in_head(Head, MetaVars, MetaArgs).
   63	 
   64	 
   65
   66
   67	 
   68/*
   69 * find_meta_vars_in_body(+Term, +Context, +MetaVars, -MetaVars) is det
   70 * 
   71 * Analyses the code of Arg1 for calls to known meta_predicates (in the
   72 * module context of Arg2).
   73 * If such a meta-call is found, all terms that appear 
   74 *  - as arguments of those meta-calls,  
   75 *  - are unified / aliased to them,
   76 *  - are part of those terms, 
   77 *  - or are connected to them via term-manupilation
   78 * previously in the code of Arg1, are stored in Arg4. 
   79 * Arg3 helps as an accumulator of previously found arguments / terms.
   80 */  	 
   81find_meta_vars_in_body(A, _, MetaVars, MetaVars):-
   82    (	atomic(A)
   83    ;	var(A)
   84    ),
   85    !.
   86  
   87find_meta_vars_in_body(Module:Term, _, KnownMetaVars, MetaVars):-
   88    !, 
   89    find_meta_vars_in_body(Term, Module, KnownMetaVars, MetaVars).
   90    
   91find_meta_vars_in_body((Cond -> Then ; Else), Context, KnownMetaVars, MetaVars):-
   92    !,			%TODO: check ob das in jedem Fall stimmt - vor allem die Bedingung
   93    find_meta_vars_in_body(Then, Context, KnownMetaVars, MetaVarsA),	
   94    (	(KnownMetaVars \= MetaVarsA)										% for meta vars in the true case
   95    ->	find_meta_vars_in_body(Cond, Context, MetaVarsA, MetaVars)		% the condition may be relevant
   96    ;	find_meta_vars_in_body(Else, Context, KnownMetaVars, MetaVars)	% the else case does not 
   97    ).																	% have bindings of the condition or true case
   98   	      
   99find_meta_vars_in_body((TermA, TermB), Context, KnownMetaVars, MetaVars):-
  100	!, 														
  101   	find_meta_vars_in_body(TermB, Context, KnownMetaVars, MetaVarsB),		
  102   	find_meta_vars_in_body(TermA, Context, MetaVarsB, MetaVars).		%erst B dann A -> nach vorne propagieren
  103   															% alternativ evtl einfach aliasse / unifizierungen merken
  104find_meta_vars_in_body((TermA; TermB), Context, KnownMetaVars, MetaVars):-
  105    !, 
  106   	find_meta_vars_in_body(TermB, Context, KnownMetaVars, MetaVarsB),
  107   	find_meta_vars_in_body(TermA, Context, MetaVarsB, MetaVars).
  108   	
  109find_meta_vars_in_body((TermA = TermB), _Context, KnownMetaVars, MetaVars):-
  110    !,
  111   	(	occurs_in(TermA, KnownMetaVars)
  112   	->	add_var_to_set(TermB, KnownMetaVars, OwnMetaVars2)
  113   	;	OwnMetaVars2 = KnownMetaVars
  114   	),
  115   	(	occurs_in(TermB, OwnMetaVars2)
  116   	->	add_var_to_set(TermA, OwnMetaVars2, MetaVars3)
  117   	;	MetaVars3 = OwnMetaVars2
  118   	),
  119   	check_inner_vars(TermA, TermB, MetaVars3, MetaVars).
  120   	
  121find_meta_vars_in_body(functor(Term,Functor,_), _Context, KnownMetaVars, MetaVars):-  
  122    !,
  123    (  occurs_in(Term,KnownMetaVars)
  124    -> add_var_to_set(Functor, KnownMetaVars, MetaVars)
  125    ;	(	occurs_in(Functor,KnownMetaVars)
  126    	-> 	add_var_to_set(Term, KnownMetaVars, MetaVars)
  127    	;  	MetaVars = KnownMetaVars
  128    	)
  129    ).
  130find_meta_vars_in_body(atom_concat(A,B,C), _Context, KnownMetaVars, AllMeta):-  
  131    !,
  132    free_vars_of([A,B,C],Candidates),
  133    add_meta_vars(Candidates,KnownMetaVars,AllMeta).
  134          
  135find_meta_vars_in_body(( Term =.. List ), _Context, KnownMetaVars, MetaVars):-
  136    !,
  137    (	occurs_in(Term,KnownMetaVars)
  138    ->  (	add_var_to_set(List, KnownMetaVars, MetaVars1),
  139    		(	(	\+(var(List)),
  140					List = [Functor|_]											
  141				)
  142%    	->	combine_sets_nonbinding(List, [List|KnownMetaVars], MetaVars) TODO: etwas in der Art um Zahl raus zu kriegen 
  143			->	add_var_to_set(Functor, MetaVars1, MetaVars)				%	oder versteckte meta-pred-Suche	
  144    		;	MetaVars = MetaVars1
  145    		)	
  146    	)
  147    ;  (	(	occurs_in(List,KnownMetaVars)
  148    		-> 	add_var_to_set(Term, KnownMetaVars, MetaVars)
  149    		;  (	(	\+(var(List)),
  150    					List = [Functor|_],
  151    					occurs_in(Functor, KnownMetaVars)
  152    				)
  153    			->	add_var_to_set(Term, KnownMetaVars, MetaVars)	
  154    			;	MetaVars = KnownMetaVars
  155    			)
  156    		)
  157    	)
  158    ).
  159find_meta_vars_in_body(arg(_,Term,Arg), _Context, KnownMetaVars, MetaVars):-
  160    !,							%TODO: das doch nur in bestimtmen F�llen (mit functor/3 das erste Argument z.B.)
  161    (  occurs_in(Term,KnownMetaVars)
  162    -> add_var_to_set(Arg, KnownMetaVars, MetaVars)
  163    ;  (	occurs_in(Arg,KnownMetaVars)
  164    	-> 	add_var_to_set(Term, KnownMetaVars, MetaVars)
  165    	;  	MetaVars = KnownMetaVars
  166    	)
  167    ).
  168
  169     
  170find_meta_vars_in_body(Term, Context, KnownMetaVars, MetaVars):-
  171    is_metaterm(Context, Term, MetaCombos), !, 
  172    extract_vars(MetaCombos, MetaArgs),
  173    handel_meta_args(MetaArgs, Context, KnownMetaVars, MetaVars).
  174
  175find_meta_vars_in_body(_Term, _Context, MetaVars, MetaVars). 
  176		% everything else is a direct call [aliasing]
  177      
  178      
  179
  180/*
  181 * find_meta_vars_in_head(+Head, +MetaVars, ?MetaArgs) is det
  182 *
  183 * Succeeds if Arg1 is the head of a meta-predicate-clause and Arg2 all
  184 * possible bindings for meta-arguments used in the body in the clause.
  185 * In this case, Arg3 is bound to a list that represents the 
  186 * meta-argument-binding of the arguments of the Clause.
  187 * 
  188 * (Currently only working with ? and 0, but should work for each 
  189 *  number and +, - in the futuroe.)
  190 */
  191find_meta_vars_in_head(Head, MetaVars, MetaArgs):-		%TODO: hier noch sharing realisieren
  192    Head =.. [_Functor|Args],
  193    find_args_in_list(Args, MetaVars, MetaArgs, IsMeta),
  194    (	IsMeta = true
  195    ->	true
  196    ;	fail
  197    ).
  198    
  199    
  200find_args_in_list([],_,[], false).
  201find_args_in_list([Arg|Rest], MetaVars, MetaArgs, IsMeta):-
  202    find_args_in_list(Rest,MetaVars,RestMetaArgs, MetaFound),
  203    (	occurs_in(Arg,MetaVars)
  204    ->	(	MetaArgs=[0|RestMetaArgs],
  205    		IsMeta = true
  206    	)
  207    ;	(	MetaArgs=[?|RestMetaArgs],
  208    		IsMeta = MetaFound
  209    	)
  210    ).
  211
  212
  213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%      
  214      
  215extract_vars([],[]).
  216extract_vars([(_,Var)|RestCombo], [Var|RestVars]):-
  217    extract_vars(RestCombo, RestVars).
  218    
  219    
  220    
  221    
  222  
  223handel_meta_args([], _, Known, Known).
  224handel_meta_args([A|Rest], Context, Known, MetaVars):-
  225    var(A), !,  
  226    add_var_to_set(A, Known, OwnMetaVars),
  227    handel_meta_args(Rest, Context, OwnMetaVars, MetaVars).
  228handel_meta_args([A|Rest], Context, Known, MetaVars):-
  229    handel_meta_args(Rest, Context, Known, AllOthers),
  230    find_meta_vars_in_body(A, Context, AllOthers, MetaVars).
  231   
  232   
  233
  234	 
  235	
  236check_inner_vars(TermA,TermB,OldMetaVars,NewMetaVars):-
  237	unifiable(TermA, TermB, Unifiers),	!,		%TODO: diese L�sung funktioniert nur f�r Variablen nicht f�r
  238	check_unifier_list(Unifiers,OldMetaVars,NewMetaVars).%      Terme in OldMetaVars			
  239check_inner_vars(_, _, MetaVars, MetaVars).
  240
  241
  242check_unifier_list([], Metas, Metas).
  243check_unifier_list([A=B|Rest], OldMetas, Metas):-	%	TODO: p(A):- term(A,B)= term(C,C), call(B)
  244	(	occurs_in(A, OldMetas)						% 	funktioniert so nicht! 
  245	->	add_var_to_set(B, OldMetas, Metas1)			
  246	;	Metas1 = OldMetas
  247	),
  248	(	occurs_in(B, OldMetas)
  249	->	add_var_to_set(A, Metas1, Metas2)
  250	;	Metas2 = Metas1
  251	),
  252	check_unifier_list(Rest, Metas2, Metas). 

 free_vars_of(+List, -Free)

Free contains the element of List that are free variables. If there are none, Free is an empty list.

  259free_vars_of(List,Free) :-
  260    ( setof( X, (member(X,List), var(X)), Free),  
  261      !
  262    ; Free = []
  263    ).

 add_meta_vars(+Candidates, +KnownMeta, ?AllMeta)

Candidates and KnownMeta are lists of free variables. If some variable from Candidates is in AllMeta all the other candidates that do not occur in KnownMeta are prepended to KnownMeta yielding AllMeta.

  272add_meta_vars(Candidates,KnownMeta,AllMeta) :- 
  273    select(Var,Candidates,OtherCandidates),
  274    occurs_in(Var,KnownMeta), 
  275    combine_sets_nonbinding(OtherCandidates, KnownMeta, AllMeta),
  276    !.
  277
  278combine_sets_nonbinding([],Set,Set).
  279combine_sets_nonbinding([E|Rest],OldSet,NewSet):-
  280    add_var_to_set(E,OldSet,Set),
  281    combine_sets_nonbinding(Rest,Set,NewSet).
  282    
  283    
  284/* add_var_to_set(?Var, +Set, ?NewSet) is det.
  285 * 
  286 * Arg3 is the same as Arg2 but if Arg1 is not already an element
  287 * of Arg2 it is addes as a first element to Arg3.
  288 * 
  289 * Attention: the comparision is based on == instead of =, so
  290 * 			  different variables are treated differently.
  291 */
  292add_var_to_set(Var, Set, NewSet):-
  293    (	occurs_in(Var, Set)
  294    ->	NewSet = Set
  295    ;	NewSet = [Var|Set]
  296    ).
  297    
  298    
  299/* occurs_in(?Var, +Set) is det.
  300 * 
  301 * Succseds, if Arg1 is equal to a member of Arg2.
  302 * The comparision is done with == instead of =!
  303 */ 
  304occurs_in(Var, Set):-
  305	nth1(_, Set, OldVar),
  306    OldVar == Var,
  307    !. 
  308
  309combine_meta_args([],[]):- !.    
  310combine_meta_args([List],List):- !.
  311combine_meta_args([MetaArgs|RestMetaArgs],CombinedArgs):-
  312    combine_meta_args(RestMetaArgs,RestCombinedArgs),
  313    combine_two_arg_lists(MetaArgs, RestCombinedArgs, CombinedArgs).
  314    
  315combine_two_arg_lists([], [], []):- !.
  316combine_two_arg_lists([ArgA|ArgsA], [ArgB|ArgsB], [CombinedArg|CombinedRest]):-
  317	 combine_two_arg_lists(ArgsA,ArgsB,CombinedRest),
  318	(	number(ArgA)
  319	->	(	number(ArgB)
  320		->	max_list([ArgA,ArgB],CombinedArg)
  321		;	CombinedArg = ArgA
  322		)
  323	;	(	number(ArgB)
  324		->	CombinedArg = ArgB
  325		;	CombinedArg = ?
  326		)   
  327	)