% Copyright (C) 2003 Fred Mesnard <fred@univ-reunion.fr>
%
% This file is part of cTI.
%
% cTI is free software; you can redistribute it and/or modify it
% under the terms of the GNU General Public License as published by the
% Free Software Foundation; either version 2 of the License, or (at your
% option) any later version.
%
% cTI is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
% FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
% for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; if not, write to the Free Software
% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
% USA.
%
% For the most up-to-date information see the cTI's web site:
% http://www.cs.unipr.it/cTI/

:- module(term_cond,[term_cond/4]).

:- use_module(library(lists),[member/2]).
:- use_module(library(clpb)).
:- use_module(library(terms),[term_variables/2]).
:- use_module(library(timeout)).

:- use_module(predef).
:- use_module(bool_op,[]).
:- use_module(contrib_mu).
:- use_module(bool_dc).
:- use_module(utils).
:- use_module(db).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% term_cond(+SccsClsB,+DbIn,-DbOut,+TimeOut)

term_cond(SccsClsB,Db0,Db,TimeOut) :-
	%trace,
	tc1(SccsClsB,Db0,Db,TimeOut).	

%% tc1(SccsClsB,Db0,Db,TimeOut)
tc1([],Db,Db,_).
tc1([Ps|Pss],Db0,Db,TimeOut) :-
	associer_pred_vars_tc(Ps,P_V_Ts,Blms,Db0),
	tc2(Ps,Blms,P_V_Ts,Db0,Db1,TimeOut),
	tc1(Pss,Db1,Db,TimeOut).
	
associer_pred_vars_tc([],[],[],_).
associer_pred_vars_tc([P/N-_|Ps],[P/N-Vars-Tcp|P_V_Ts],[P/N-VarsP-Blm|Blms],Db) :-
	length(Vars,N),var(Tcp),
	get_db(P,N,blm,Db,VarsP-Blm),
	associer_pred_vars_tc(Ps,P_V_Ts,Blms,Db).

tc2(Ps,MesB,P_V_Ts,Db0,Db,TimeOut) :-
	time_out(term_cond:tc3(Ps,MesB,P_V_Ts,Db0,Db),TimeOut,Result),
	(Result=time_out ->
	    (   write('% bool term cond: '),
		virer_ref(Ps,PIs),write(PIs),
		write(' time_out!'),nl,
		pvts_timeout(Ps,Db0,Db), 
		true)
	;
	    true).

    pvts_timeout([],Db,Db).
    pvts_timeout([P/N-_|Ps],Db0,Db) :-
	    length(Vars,N),
	    put_db(P,N,termcond,Db0,Vars-0,Db1),
	    pvts_timeout(Ps,Db1,Db).

tc3(Ps,MesB,P_V_Ts,Db0,Db) :-
	tc4(Ps,MesB,P_V_Ts,Db0,System),
	poser_syst(System),
	cal_fp(P_V_Ts,Db0,Db).

tc4([],_,_P_V_Ts,_Db,[]).
tc4([P/N-Refs|Ps],MesB,P_V_Ts,Db,[P/N-Syst|Systs]):-
	member(P/N-Vars-Mbpn,MesB),
	member(P/N-Vars-Tcpn,P_V_Ts),!,
	tc5(Refs,P/N,Vars,Mbpn,Syst_Bool,P_V_Ts,Db),
	Syst=nu(Tcpn,Vars,Syst_Bool),
	tc4(Ps,MesB,P_V_Ts,Db,Systs).

% aff_cycle_syst(Ps,Syst):-
% 	write('-------------'),nl,
% 	write('Pour le cycle '),write(Ps),write(', on obtient le systeme : '),nl,
% 	\+ \+ ((numbervars(Syst,0,_),afc(Syst))).
%   afc([]).
%   afc([P/N-Spn|S]):-write('  '),write(P/N),write(' : '),write(Spn),nl,afc(S).

poser_syst([]).
poser_syst([_P/_N-Syst|S]) :- Syst,poser_syst(S).

% cal_fp(P_V_Ts,Module)
cal_fp([],Db,Db).
cal_fp([P/N-_-T|P_V_Ts],Db0,Db) :-
	fp(T,Vars,Tcpn),
	dc(Vars,Tcpn,T_Dc),
	put_db(P,N,termcond,Db0,Vars-T_Dc,Db1),
	cal_fp(P_V_Ts,Db1,Db).

% tc5(Refs,P/N,Vars,Mbpn,Syst_Bool,P_V_Ts,Db),	
tc5([],_,_,Syst_Bool,Syst_Bool,_,_).
tc5([R|Refs],P/N,Vars,S0,S,P_V_Ts,Db) :-
	clause_head(R,H),clause_body(R,Body),
	bool_op:true(Cinit), H=..[P|Vars],
	tc6(Body,Cinit,Vars,S0,S1,P_V_Ts,Db),
	tc5(Refs,P/N,Vars,S1,S,P_V_Ts,Db).

% tc6(Body,Cb,Vars,S1,S2,P_V_Ts,Db)
tc6([],_,_,Syst_Bool,Syst_Bool,_,_).
tc6(['$constraint'(C)|Bs],Cb,Vars,S0,S,P_V_Ts,Db):-
	!,tc6(Bs,C*Cb,Vars,S0,S,P_V_Ts,Db).
tc6(['$predef'(A)|Bs],Cb,Vars,S0,S,P_V_Ts,Db):-
	!,predef_nat_bool_tc(A,_,Model,TcA),
	Formula = (Cb =< TcA), %%
	free_vars(Formula,Vars,FreeVars),
	quantif_univ(FreeVars,Formula,S1),
	tc6(Bs,Cb*Model,Vars,S0*S1,S,P_V_Ts,Db).
tc6([B|Bs],Cb,Vars,S0,S,P_V_Ts,Db):-
	functor(B,Q,M),
	member(Q/M-_-Tcqm,P_V_Ts),!,    % B est dans le Scc
	B=..[Q|VarsQ],
	Formula = (Cb =< eval(Tcqm,VarsQ)),
	free_vars(Formula,Vars,FreeVars),
	quantif_univ(FreeVars,Formula,S1),
	get_db(Q,M,modelb,Db,VarsQ-Modbq-_-_),
	tc6(Bs,Cb*Modbq,Vars,S0*S1,S,P_V_Ts,Db).
tc6([B|Bs],Cb,Vars,S0,S,P_V_Ts,Db):-
	functor(B,Q,M),    % B n'est pas dans le Scc
	get_db(Q,M,termcond,Db,VarsQ-TcQ),
	bool_op:satisfiable(TcQ),!,
	B=..[_Q|VarsQ],
	Formula = (Cb =< TcQ),
	free_vars(Formula,Vars,FreeVars),
	quantif_univ(FreeVars,Formula,S1),
	get_db(Q,M,modelb,Db,VarsQ-ModbQ-_-_),
	tc6(Bs,Cb*ModbQ,Vars,S0*S1,S,P_V_Ts,Db).
tc6([_B|_Bs],_Cb,_Vars,_S,0,_P_V_Ts,_Db).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% quantif_univ(FreeVars,Tb,For_All_Tb)
%% 'v' is an operator defined in contrib_mu
%% it denotes universal quantification

quantif_univ([],Tb,Tb).
quantif_univ([X|Xs],Tb1,Tb2):-quantif_univ(Xs,(X v Tb1),Tb2).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% free_vars(Term,Vars,FreeVars)
%% 	FreeVars est l'ensemble des var libres de Term
%% 	qui n'apparaissent pas dans Vars

free_vars(Term,Vars,FreeVars):-fv(Term,Vars,[],FreeVars).

fv(X,Vars,FV,FV):-var(X), (member_var(Vars,X) ; member_var(FV,X)),!.
fv(X,_,FV,[X|FV]):-var(X),!.
fv(X,_,FV,FV):-ground(X),!.
fv(~T,Vars,FV1,FV2):-!,fv(T,Vars,FV1,FV2).
fv(X^T,Vars,FV1,FV2):-!,fv(T,[X|Vars],FV1,FV2).
fv(eval(_,Params),Vars,FV1,FV2):-!,fv(Params,Vars,FV1,FV2).
fv(T,Vars,FV1,FV2):-T=..[_,T1,T2],fv(T1,Vars,FV1,FV3),fv(T2,Vars,FV3,FV2).
	
member_var([Y|_],X):-X==Y,!.
member_var([_|Ys],X):-member_var(Ys,X).















