% 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/


% Serge Colin
% IREMIA - University of La Reunion
% June 1998

:- module(mu,[mu/3,nu/3,fp/3,fpa/3]).

:- use_module(library(atts)).
:- use_module(library(clpb)).
:- use_module(library(lists)).
:- use_module(library(assoc)).
:- use_module(library(ordsets)).
:- use_module(library(ugraphs)).

:- op(200,xfy,v). %% universal quantification


:- attribute fpeq/5.

% fpeq(Body,Params,MaxFree,Dependancies,OldBddValue,_)
% - Formula (bdd + fp())
% - Parameters indexes
% - Free : index beyond any variable => prevents side effects
%          when evaluating a call to a relation (variable reindexing)
% - Deps : list of dependancies
% - Value of the BDD 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

verify_attributes(X,_,[]):-
	get_atts(X,fpeq(_,_,_,_,_)),!,
	fail.
verify_attributes(_,_,[]).


% mu(+Rel,+ParamList,+Body)
% Rel is a relational (Prolog) variable
% ParamList is a list of distinct first order variables (eg [X,Y,Z])
% Body is the boolean mu-calculus formula defining the relation
mu(Rel,ParamList,Body):-
	var(Rel),
	empty_assoc(Void),
	parse_params(ParamList,ParList,Void,DicParamIndex,0,Free),
	split_formula(Body,Parts),
	parse_parts(Parts,Res,Free,DicParamIndex,[],Deps),
	put_atts(Rel,fpeq(Res,ParList,_,Deps,0)).
 
% idem for a Nu expression, only the initialization differs (0 vs 1)
nu(Rel,ParamList,Body):-
	var(Rel),
	empty_assoc(Void),
	parse_params(ParamList,ParList,Void,DicParamIndex,0,Free),
	split_formula(Body,Parts),
	parse_parts(Parts,Res,Free,DicParamIndex,[],Deps),
	put_atts(Rel,fpeq(Res,ParList,_,Deps,1)).
 
%% Check that the params are all distinct and number them
parse_params([],[],DicParIdx,DicParIdx,Free,Free).
parse_params([Var|ParamList],[var(I)|ParamList2],DicParIdx0,DicParIdx,Free0,Free):-
	(get_assoc(Var,DicParIdx0,_) ->
	    fail % must be all distinct 
	;
	    put_assoc(Var,DicParIdx0,Free0,DicParIdx1),
	    Free1 is Free0 + 1,
	    I is Free0),
 	parse_params(ParamList,ParamList2,DicParIdx1,DicParIdx,Free1,Free).

% split the formula into the list of its disjonctive parts
% since the scope of the variables is local to such a part
% we may rename the variables and get smaller bdds	
split_formula(Term,[Term]):-
	var(Term),!.
split_formula(Term,Parts):-
	(Term = +(A,B) ->
	    split_formula(A,Parts1),
	    split_formula(B,Parts2),
	    append(Parts1,Parts2,Parts)
	;
	Parts = [Term]).

% compute the Bdds corresponding to the disjonctive parts of the formula
parse_parts([Part],Body,Free,Dic,DepGraph1,DepGraph):-
	parse_bdd(Part,Body,Free,Dic,_,_,DepGraph1,DepGraph).
parse_parts([Part1,Part2|Parts],Body+Reste,Free,Dic,DepGraph1,DepGraph):-
	parse_bdd(Part1,Body,Free,Dic,_,_,DepGraph1,DepGraph2),
	parse_parts([Part2|Parts],Reste,Free,Dic,DepGraph2,DepGraph).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Evaluates the value of a relation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
fpa(Var, F, Sol):-
	findall(Var, (sat(F),labeling(Var)), Sol).

fp(Rel,ResParams,Formula):-
	dependancies(Rel,SDP),
	eval_all_dependancy_nodes(SDP),
	get_atts(Rel,fpeq(_,ParamIdx,_,_,BddValue)),
	bdd_2_formula(BddValue,Formula,t,Dic), 	
	tr_pl(ParamIdx,Dic,ResParams).

dependancies(Rel,SDP):-
	cons_dep_graph([Rel],t,DP0),
	assoc_to_list(DP0,DP),
	reduce(DP,RDP),
	top_sort(RDP,RDP2),
	reverse(RDP2,SDP).

tr_pl([],_,[]).
tr_pl([var(V)|BDD],Dic1,[Val|PL]):-
	(get_assoc(V,Dic1,Val) ->
	    Dic2 = Dic1
	;
	    put_assoc(V,Dic1,Val,Dic2)),
	tr_pl(BDD,Dic2,PL).

eval_all_dependancy_nodes([]).
eval_all_dependancy_nodes([Rel|Rs]):- 
	eval_1_dependancy_node(Rel,OldBdds,NewBdds), 
	(equiv_bdds(OldBdds,NewBdds) ->
	    eval_all_dependancy_nodes(Rs)
	;	eval_all_dependancy_nodes([Rel|Rs])).

equiv_bdds([],[]).
equiv_bdds([B|Old],[N|New]):-
	prolog:'$bdd_equiv'(B,N),
	equiv_bdds(Old,New).

eval_1_dependancy_node([],[],[]).
eval_1_dependancy_node([R|Rel],[OldBddValue|OldBdds],[Bdd|ResBdds]):- 
	get_atts(R,fpeq(Body,Params,MaxFree,Dependancies,OldBddValue)),	
	eval_bdd(Body,Bdd1,1,_),
	get_vars(Bdd1,[],VarsIdx),
	get_param_var(Params,[],ParamIdx),
	ord_subtract(VarsIdx,ParamIdx,Vars_2_Del),
	% projection over the parameters/variables
	bdd_var_del(Vars_2_Del,Bdd1,Bdd),
	put_atts(R,fpeq(Body,Params,MaxFree,Dependancies,Bdd)),	
	eval_1_dependancy_node(Rel,OldBdds,ResBdds).

get_vars(0,Dic,Dic).
get_vars(1,Dic,Dic).
get_vars(Bdd,Dic0,Dic):-
	prolog:'$bdd_parts'(Bdd,V,Q,R),
	ord_add_element(Dic0,V,Dic1),
	get_vars(Q,Dic1,Dic2),
	get_vars(R,Dic2,Dic).

bdd_var_del([],BDD,BDD).
bdd_var_del([V|Subst],BDD0,BDDRes):-
	prolog:'$bdd_subst_reset',
	(prolog:'$bdd_build'(-16'2000000, 1, 0, Node),
	clpb:bdd_subst_set([V-Node], BDD0, BDD2),
	prolog:'$bdd_parts'(BDD2, -16'2000000, Q, R) ->
	    clpb:bdd_univ(Q, 1, R, P)
	;
	    P = BDD0),
	bdd_var_del(Subst,P,BDDRes).

cons_dep_graph([],DepGraph,DepGraph).
cons_dep_graph([Rel|DepGraph],DepGraph0,Res) :-
	(get_assoc(Rel,DepGraph0,_) ->
	    cons_dep_graph(DepGraph,DepGraph0,Res)
	;	get_atts(Rel,fpeq(_,_,_, DepGraph1,_)),
	put_assoc(Rel,DepGraph0,DepGraph1,DepGraph2),
	cons_dep_graph(DepGraph1,DepGraph2,DepGraph3),
	cons_dep_graph(DepGraph,DepGraph3,Res)).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% computess the Bdd associated to the formula, excepted 
% for the calls to other relations
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


parse_bdd(V, var(Idx), Free0, Dic0, Free, Dic,DepList,DepList):- 
	var(V),!,
	(get_assoc(V,Dic0,Idx) ->
	    Dic = Dic0,
	    Free = Free0 ;
	    put_assoc(V, Dic0, Free0, Dic),
	    Free is Free0+1,
	    Idx is Free0).

parse_bdd(0, 0, Free, Dic, Free, Dic,DepList,DepList).
parse_bdd(1, 1, Free, Dic, Free, Dic,DepList,DepList).

parse_bdd(~X, ~Res, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res,Free0,Dic0,Free,Dic,DepList0,DepList).

parse_bdd(Var v Y, var(Idx) v Res, Free0, Dic0, Free, Dic,DepList0,DepList):-
	var(Var),!,
	(get_assoc(Var,Dic0,Idx) ->
	    Dic1 = Dic0,
	    Free1 = Free0 ;
	    put_assoc(Var, Dic0, Free0, Dic1),
	    Free1 is Free0+1,
	    Idx is Free0
	),
	parse_bdd(Y,Res,Free1,Dic1,Free,Dic,DepList0,DepList).
	
	    
parse_bdd(Var ^ Y,var(Idx) ^ Res, Free0, Dic0, Free, Dic,DepList0,DepList):-
	var(Var),!,
	(get_assoc(Var,Dic0,Idx) ->
	    Dic1 = Dic0,
	    Free1 = Free0 ;
	    put_assoc(Var, Dic0, Free0, Dic1),
	    Free1 is Free0+1,
	    Idx is Free0
	),	    
	parse_bdd(Y,Res,Free1,Dic1,Free,Dic,DepList0,DepList).
	

parse_bdd(X*Y, Res1 * Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X+Y, Res1+Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X#Y, Res1 # Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X =\= Y, Res1 =\= Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X=:=Y, Res1 =:= Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X=<Y, Res1 =< Res2, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(X>=Y, Res2 =< Res1, Free0, Dic0, Free, Dic,DepList0,DepList):-
	parse_bdd(X,Res1,Free0,Dic0,Free1,Dic1,DepList0,DepList1),
	parse_bdd(Y,Res2,Free1,Dic1,Free,Dic,DepList1,DepList).

parse_bdd(eval(Rel,Param), fp(Rel,ParamsIdx), Free0, Dic0, Free, Dic,DepList,DepList2):-
	ord_add_element(DepList,Rel,DepList2),
	idx_params2(Param,ParamsIdx, Dic0, Dic, Free0,Free).



%  numbers and translates  the parameters into indexes
idx_params2([],[],DicParIdx,DicParIdx,Free,Free).
idx_params2([Var|ParamList],[var(Idx)|IdxParams],DicParIdx0,DicParIdx,Free0,Free):-
	var(Var),!,
	(get_assoc(Var,DicParIdx0,Val) ->
	    Idx = Val,
	    Free1 = Free0,
	    DicParIdx1 = DicParIdx0
	;
	    put_assoc(Var,DicParIdx0,Free0,DicParIdx1),
	    Free1 is Free0 + 1,
	    Idx = Free0),
 	idx_params2(ParamList,IdxParams,DicParIdx1,DicParIdx,Free1,Free).
idx_params2([0|ParamList],[bdd(0)|IdxParams],DicParIdx0,DicParIdx,Free0,Free):-
 	idx_params2(ParamList,IdxParams,DicParIdx0,DicParIdx,Free0,Free).
idx_params2([1|ParamList],[bdd(1)|IdxParams],DicParIdx0,DicParIdx,Free0,Free):-
 	idx_params2(ParamList,IdxParams,DicParIdx0,DicParIdx,Free0,Free).




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% one step iteration of the evaluation of the relation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

eval_bdd(var(N),BDD,Free0,Free):- 
	!, 
	prolog:'$bdd_build'(N,1,0,BDD),
	(N >= Free0 ->
	    Free is N+1
	;
	    Free = Free0).

eval_bdd(0, 0, Free, Free):-!.
eval_bdd(1, 1, Free, Free):-!.

eval_bdd(~X, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free),!,
	prolog:'$bdd_negate'(BDD1,BDD).

eval_bdd(var(N) v Y, BDD, Free0, Free):-
	eval_bdd(Y,BDD2,Free0,Free),	
	prolog:'$bdd_subst_reset',
	(prolog:'$bdd_build'(-16'2000000, 1, 0, Node),
	clpb:bdd_subst_set([N-Node], BDD2, BDD3),
	prolog:'$bdd_parts'(BDD3, -16'2000000, Q, R) ->
	    clpb:bdd_univ(Q, R, 0, BDD)
	;
	    BDD = BDD2).

eval_bdd(var(N)^Y, BDD, Free0, Free):-
	eval_bdd(Y,BDD2,Free0,Free),	
	prolog:'$bdd_subst_reset',
	(prolog:'$bdd_build'(-16'2000000, 1, 0, Node),
	clpb:bdd_subst_set([N-Node], BDD2, BDD3),
	prolog:'$bdd_parts'(BDD3, -16'2000000, Q, R) ->
	    clpb:bdd_univ(Q, 1, R, BDD)
	;   
	    BDD = BDD2).

eval_bdd(X*Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	clpb:bdd_univ(BDD1,BDD2,0,BDD).

eval_bdd(X+Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	clpb:bdd_univ(BDD1,1,BDD2,BDD).

eval_bdd(X#Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	prolog:'$bdd_negate'(BDD2,BDD3),
	clpb:bdd_univ(BDD1,BDD3,BDD2,BDD).

eval_bdd(X =\= Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	prolog:'$bdd_negate'(BDD2,BDD3),
	clpb:bdd_univ(BDD1,BDD3,BDD2,BDD).

eval_bdd(X=:=Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	prolog:'$bdd_negate'(BDD2,BDD3),
	clpb:bdd_univ(BDD1,BDD2,BDD3,BDD).

eval_bdd(X=<Y, BDD, Free0, Free):-
	eval_bdd(X,BDD1,Free0,Free1),!,
	eval_bdd(Y,BDD2,Free1,Free),
	clpb:bdd_univ(BDD1,BDD2,1,BDD).


%%%%%%%% calcul de relation %%%%%%%

eval_bdd(fp(Rel,Param), BDD, Free0, Free):-
	get_atts(Rel,fpeq(_,OldIdx,_,_, OldBdd)),!,
	(OldBdd = 0 ->
	    BDD = 0,
	    Free = Free0
	;
	    (OldBdd = 1 ->
		BDD = 1,
		Free = Free0
	    ;
		% renames the variable of the old BDD value of Rel
	    bdd_map_to_unifier_rename(OldIdx,Unifier,Free0,Free,[],DicTmp),
	    prolog:'$bdd_subst_reset',
	    clpb:bdd_subst_set(Unifier, OldBdd, Graph),
		% substitutes the parameters of the call to the formal parameters
	    create_subst(DicTmp,Param,Subst),
	    prolog:'$bdd_subst_reset',
	    clpb:bdd_subst_set(Subst,Graph,BDD1),
		% projection over the parameters/variables
	    get_vars(BDD1,[],VarsIdx),
	    get_param_var(Param,[],ParamIdx),
	    ord_subtract(VarsIdx,ParamIdx,Vars_2_Del), 
	    bdd_var_del(Vars_2_Del,BDD1,BDD))).

get_param_var([],ParamVars,ParamVars).
get_param_var([bdd(0)|Params],ParamVars0,ParamVars):-
	get_param_var(Params,ParamVars0,ParamVars).
get_param_var([bdd(1)|Params],ParamVars0,ParamVars):-
	get_param_var(Params,ParamVars0,ParamVars).
get_param_var([var(I)|Params],ParamVars0,ParamVars):-
	ord_add_element(ParamVars0,I,ParamVars1),
	get_param_var(Params,ParamVars1,ParamVars).

bdd_map_to_unifier_rename([], [], Free, Free,DicTmp,DicTmp).
bdd_map_to_unifier_rename([var(PI)|ParamIdx],
			  [PI-NewBdd|Unifier], Free0, Free,DicTmp0,DicTmp) :-
	prolog:'$bdd_build'(Free0,1,0,NewBdd),
	Free1 is Free0 +1,
	ord_add_element(DicTmp0,Free0,DicTmp1),
	bdd_map_to_unifier_rename(ParamIdx, Unifier, Free1, Free,DicTmp1,DicTmp).

create_subst([],[],[]).
create_subst([P|PL],[bdd(V)|BDD],[P-V|Subst]):-
	create_subst(PL,BDD,Subst).
create_subst([P|PL],[var(V)|BDD],[P-B|Subst]):-
	integer(V),
	prolog:'$bdd_build'(V,1,0,B),
	create_subst(PL,BDD,Subst).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Translating from BDD to internal polynomial format.
% P*Q + ~P*R =:= P*Q # P*R # R.

bdd_2_formula(0, 0, Dic, Dic) :- !.
bdd_2_formula(1, 1, Dic, Dic) :- !.
bdd_2_formula(Graph, F, Dic0, Dic) :- 
	prolog:'$bdd_parts'(Graph, V, Q, R),
	prolog:'$bdd_type'(Q, R, Type),
	bdd_2_formula(Type, V, Q, R, Dic0, Dic, F).

bdd_2_formula(0, V, _, _, Dic0, Dic, Var):-
	(get_assoc(V,Dic0,Var) ->
	    Dic = Dic0
	;	put_assoc(V,Dic0,Var,Dic)).

bdd_2_formula(1, V, _, _, Dic0, Dic, ~Var):-
	(get_assoc(V,Dic0,Var) ->
	    Dic = Dic0
	;	put_assoc(V,Dic0,Var,Dic)).

bdd_2_formula(2, V, _, R, Dic0, Dic, (Var + R1)) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	bdd_2_formula(R, R1, Dic1, Dic).

bdd_2_formula(3, V, _, R, Dic0, Dic, (~Var * R1)) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	bdd_2_formula(R, R1, Dic1, Dic).

bdd_2_formula(4, V, Q, _, Dic0, Dic, (Var * Q1)) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	bdd_2_formula(Q, Q1, Dic1, Dic).

bdd_2_formula(5, V, Q, _, Dic0, Dic, (Var =< Q1)) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	bdd_2_formula(Q, Q1, Dic1, Dic).

bdd_2_formula(6, V, _, R, Dic0, Dic, (Var =:= R1)) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	prolog:'$bdd_negate'(R,R2),
	bdd_2_formula(R2, R1,Dic1,Dic).

bdd_2_formula(7, V, Q, R, Dic0, Dic, ((Var * Q1) + (~Var * R1))) :-
	(get_assoc(V,Dic0,Var) ->
	    Dic1 = Dic0
	;	put_assoc(V,Dic0,Var,Dic1)),
	bdd_2_formula(Q, Q1, Dic1, Dic2),
	bdd_2_formula(R, R1, Dic2, Dic).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%






