#!/usr/bin/swipl -q -s

:- multifile proverif/1.

:- dynamic dominating/1.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the operator 'nonce' is used to delcare the nonces' forms.

:- op( 1180, fx, fun ).
:- op( 1180, fx, rule ).
:- op( 1180, fx, secret).
:- op( 1180, fx, dominating ).
:- op( 1180, fx, query ).
:- op( 1180, fx, nonce ).
:- op( 1180, fx, proverif ).

proverif 'pred begin/1 block'.
proverif 'pred i/1 elimVar,decompData'.
proverif 'nounif i:x'.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                          AUXILIARY PREDICATES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

sublist([], []).
sublist([_|Xs], Ys)  :- sublist(Xs, Ys).
sublist([X|Xs], [X|Ys])  :- sublist(Xs, Ys).

nonempty([_|_]).

mapterm( SubList, T, MT) :-
    T =.. [F|Args],
    maplist(mapterm(SubList), Args, MappedArgs),
    ( member( F/SF, SubList )
        -> MF = SF
        ;  MF = F ),
    MT =.. [MF|MappedArgs].

append_lists([], []).
append_lists([L|Ls], Res) :-
    append_lists(Ls, Res1),
    append(L, Res1, Res).

% vsubtract  --- like subtract with == instad of unification

vsubtract([], _, []).
vsubtract([X|Xs], L, Res) :-
    vmember(X,L), !,
    vsubtract(Xs, L, Res).
vsubtract([X|Xs], L, [X|Res]) :-
    % \+vmember(X,L)  -- by the cut above
    vsubtract(Xs, L, Res).
    
vmember(X, [Y|_] ) :- X==Y.    
vmember(X, [_|Ys] ) :- vmember(X,Ys).

vlist_to_set([], []).
vlist_to_set([X|Xs], Res) :-
    vmember(X,Xs), !,
    vlist_to_set(Xs,Res).
vlist_to_set([X|Xs], [X|Res]) :-
    % \+ vmember(X,Xs) -- by the cut above
    vlist_to_set(Xs,Res).
    

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

%%
% ground_rule(R) -- R is a grounded verion of some (user defined)
% rule. This version is obtained by numbervars.
%
ground_rule(R) :- (rule R), make_ground(R).

make_ground(R) :- numbervars(R,23,_).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% FUNCTORS AND TERMS
%

% Predefined functors:
%
std_functor( (,)/2 ).
std_functor( (->)/2 ).
std_functor( (+)/2 ).
std_functor( 0/0 ).
std_functor( begin/1 ).

%%
% funct(X) -- X is a functor (standard, as defined above, or defined
% by the user.
%
funct(X) :- std_functor(X) ; (fun X).

%%
% xt_var(T) -- T is a variable (technically, a term substituted for a
% variable by numbervars.
% 
xt_var(T)  :- T =.. ['$VAR'|_].

%%
% xt_ground(T) -- T does not contains subterms S such that xt_var(S).
% 
xt_ground(T) :-
    xt_var(T), !, fail.

xt_ground(T) :-
    T =.. [_|Args],
    maplist(xt_ground, Args).

%%
% check_term(T) -- check, whether T is a proper term. If is not, the
% fact is reported and the program halts.
%
check_term_locally(T) :-
    T =.. [F|Args],
    length(Args,N),
    funct(F/N), !.

check_term_locally(_). 
%:-
 %   format('***  term: ~p\n', [T]),
  %  halt(-1).


check_term(V) :- var(V), !.

check_term(T) :-
    check_term_locally(T),
    T =.. [_|Args],
    maplist(check_term, Args).

check_rule(X) :-
    % format('  >> ~p\n', [X]),
    check_term(X).
    

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Checking if a term is dominated
%

%%
% indom(X) -- X is on the list of dominating atoms (the set of
% dominated atoms closed under + is the dominated set)
%
indom(0).
indom(X) :- (domset(L)), member(X,L).

%%
% standard, nonstandard terms
%
non_standard(_+_).

standard(T) :- var(T) ; \+ non_standard(T).

%%
% xor(X,Y,Z) -- Z == X+Y (Z is somehow simplified)
%
xor( 0, X, X ) :- !.
xor( X, 0, X ) :- !.
xor( X, Y, X+Y).

xorspec( 0, X, X ) :- !.
xorspec( X, 0, X ) :- !.
xorspec( X, Y, xx(X,Y)).

%%
% inxor( X, L ) -- X occurs in L an odd number of times
%
inxor(X, [X|L]) :- !, \+ inxor(X,L).
inxor(X, [_|L]) :- inxor(X,L).

%%
% flat( +T, -Ds, -Ss )
%
%    T is a non-standard term which can be splitted into elements of
%    the dominating set given in Ds and other standard elements given
%    in Ss.
%
flat( T , [T], [] ) :-
    indom(T), !.

flat(xx(X,Y), Ds, Ss) :- !,
    flat(X, XD, XS),
    flat(Y, YD, YS),
    append(XD,YD,Ds),
    append(XS,YS,Ss).

flat( X+Y, Ds, Ss ) :- !,
    flat(X, XD, XS),
    flat(Y, YD, YS),
    append(XD,YD,Ds),
    append(XS,YS,Ss).

flat( T, [], [T] ) :-
    standard(T).

check_dominated(Parent,T) :-
    flat(T, _, Ss),
    check_f_dominated(Parent,Ss,T).

check_f_dominated(_Parent, [], _) :- !.
check_f_dominated(_Parent, [T], _) :- !, T =.. [_|Args], maplist(check_dominated(T), Args).
check_f_dominated(Parent, _, S) :-
    format('*** Term: ~p (in ~p) is not C-dominated\n', [S,Parent]),
    halt(-1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Computing the C set
%


%%
% nonstandard_flat(T,L)
% 
%    T is a nonstandard term and L is the list of its arguments
%
nonstandard_flat(V, [V]) :- var(V), !.

nonstandard_flat(X+Y, Res) :- !,
    nonstandard_flat(X,ResX),
    nonstandard_flat(Y,ResY),
    append(ResX, ResY, Res).

nonstandard_flat(0, []) :- !.
nonstandard_flat(X, [X]).

%% where


%%
% nonstandard_subterms(L, NS) 
%
%       L is a list of terms, NS is the list of nonstandard terms
%       presented as lists (i.e. a+b+c is presented as [a,b,c]).
%

nonstandard_subterms(V, []) :- var(V), !.

nonstandard_subterms([], []) :- !.

nonstandard_subterms([T|Ts], Res) :- !,
    nonstandard_subterms(T, Res1),
    nonstandard_subterms(Ts, Res2),
    append(Res1, Res2, Res).

nonstandard_subterms(T, Res) :-
    standard(T), !,
    nonstandard_rec(T,Res).

nonstandard_subterms(T, Res) :-
    non_standard(T),
    nonstandard_flat(T, TArgs),
    check_linear(TArgs),
    nonstandard_subterms(TArgs, Res1),
    Res = [TArgs | Res1].

%% where
nonstandard_rec(T, Res) :-
    T =.. [_|Args],
    maplist(nonstandard_subterms, Args, ArgsRes),
    append_lists(ArgsRes, Res).

%% where
check_linear(T) :-
    select(X, T, Res),
    \+ground(X),
    \+ground(Res), !,
    format('*** Term ~p is not XOR-linear.\n\n', [T]),
    fail.

check_linear(_). 
    
sieve_init( Ts, InitBase ) :-
    append_lists(Ts, B ),
    vlist_to_set(B, InitBase).

sieve_step([], B, B).

sieve_step([[]|Ls], Base, NewBase) :-
    sieve_step(Ls, Base, NewBase).

sieve_step([L|Ls], Base, NewBase) :-
    ( sieve_select(L, Base, _, _) 
        -> 
            sieve_select(L, Base, _, Rest),  
            vsubtract(Base, Rest, Base1), 
            sieve_step(Ls, Base1, NewBase)
         ;
            sieve_step(Ls, Base, NewBase)
    ).
    
sieve(Ts, C) :-
    sieve_init(Ts, InitBase),
    setof( Base, sieve_step(Ts, InitBase, Base), Results ),
    find_max(Results,_,Max),
    vsubtract(InitBase,Max,C).


%% where
sieve_select(L, Base, X, Rest) :-
    select(X,L,Rest), ground(Rest), 
    sieve_sel_check(X,Base).

sieve_sel_check(X, Base) :-
    (\+ground(X) ; vmember(X,Base)), !.

%% where
find_max([], -1, none).

find_max([L|Ls], N, X ) :-
    find_max(Ls, PrevN, PrevX),
    length(L, NL),
    (NL<PrevN ->  N=PrevN, X=PrevX
               ;  N=NL, X=L).

%%

comp_dominating_set(ListOfTerms, C) :-
    nonstandard_subterms(ListOfTerms, Ts0),
    vlist_to_set(Ts0,Ts1),
    predsort(mycomp, Ts1, Ts2),
    sublist(filterpred, Ts2, Ts),
    %format('\n *** ~p ***\n', [Ts]),
    sieve(Ts,C).

%%

mycomp('<', X, Y ) :- \+ground(X), ground(Y), !.
mycomp(Op, X, Y ) :- compare(Op,X,Y).

filterpred(X) :- 
    X \= [_].

domset(C) :- (dominating C), !.

domset(_) :- 
    format('\n *** Dominating set not defined. ***\n'),
    halt(-1).

%%

copute_dominating_set_if_necessary :-
    (dominating C), !,
    format('    + Dominating set (~p) defined by the user.\n', [C]).

copute_dominating_set_if_necessary :-
    % not given by the user
    bagof( R, (rule R), Rules),
    % format('    + Rules  =  ~p\n', [Rules]),
    comp_dominating_set(Rules, C),
    format('    + Dominating set =  ~p\n', [C]),
    assert(dominating C).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% normal form of a term
%
normal_form(T, NFT) :-
    standard(T),
    T =.. [F|Args],
    maplist(normal_form, Args, NFArgs),
    NFT =.. [F|NFArgs].

normal_form(T, NFT) :-
    non_standard(T),
    flat(T, Ds, Ss),
    % format('   >>> ~p, ~p, ~p\n',  [T,Ds,Ss] ),
    maplist(normal_form, Ds, Ds1),
    dom_normal_form(Ds1, NFDs),
    maplist(normal_form, Ss, NFSs),
    nf_join(NFDs, NFSs, NFT).


nf_join(X, [], X) :- !.
nf_join(X, [S], Res) :- !, xor(X,S,Res).
nf_join(_, Z, _) :-
    format('*** Term not C-dominated: ~p\n', [Z]),
    halt(-1).

dom_normal_form( Ds , Res ) :-
    (domset(DomList) ),
    dnf_loop(DomList, Ds, Res). % !!!

% enc_dnf_loop(DomList, Ds, Res) :-
%     dnf_loop(DomList, Ds, Res1),
%     ( Res1 = _+_  ->  Res = xx(Res1) ; Res = Res1  ).

dnf_loop( [], _, 0 ).    

dnf_loop( [X|Xs], Ds, Res ) :-
    dnf_loop( Xs, Ds, Res1 ),
    ( inxor(X,Ds) 
        ->  xorspec(Res1,X,Res)
        ;   Res = Res1 ).

inC(Dom,X) :- sublist(Dom, S), dom_normal_form(S,X).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% matching
%

%%
% matching(S, T, Sigma) 
%
%   Sigma is the result of matching S against (ground) T. We assume
%   that both S and T are in normal form. We assume also that
%   these terms are C-dominated.

matching(S, T, Sigma) :-        % 1. S is a variable
    xt_var(S), !,
    Sigma = [T/S].

matching(S, T, Sigma) :-        % 2. S is ground
    % it holds: \+ xt_var(S),
    xt_ground(S), !,
    % format(' [Case2: ~p ~p ]\n', [S, T]),
    S=T,
    Sigma = [].

matching(S, T, Sigma) :-        % 3. S is non-ground, non-standard
    S = C+SP, !,
    normal_form(C+T, CT),
    % format(' [Case3 ~p ~p -- ~p ]\n', [S, T, CT]),
    matching(SP, CT, Sigma).

matching(S, T, Sigma) :-        % 4. S is non-ground, non-variable, standard
    % format(' [Case4 ~p ~p ]\n', [S, T]),
    S =.. [_|SS],
    T =.. [_|TT],
    maplist(matching, SS, TT, Sigmas),
    merge_subst(Sigmas, Sigma).

% where

merge_subst(Sigmas, Sigma) :-
    append_lists(Sigmas, L),
    list_to_set(L,Sigma),
    % format('  .(~p)  ', [Sigma]),
    \+ (select(_/X, Sigma, Rest),  member(_/X,Rest)). % no duplicates.

%%

matchnf(S,T,Sigma) :-
    format('\n'),
    make_ground(S),
    make_ground(T),
    normal_form(S, SNF),
    normal_form(T, TNF),
    matching(SNF,TNF,Sigma).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% XOR-RULES
%
gen_xarg :-
    (domset(DomList)),
    sublist(DomList,A), 
    dom_normal_form(A,AA),
    write('xarg: '), out_term(AA), write(';\n'),
    fail ; true.

% gen_notxarg :-
%     (dominating DomList),
%     sublist(DomList,A), 
%     dom_normal_form(A,AA),
%     write('X <> '), out_term(AA), write(' & '),
%     fail ; write('o<>(o,o) -> notxarg:X;\n').

out_xtab(A,B):-
     A\==[o],B\==[o],A\==B,
    top_de(A,Ta),
    top_de(B,Tb),
    (compare('<',Ta,Tb);Ta==Tb),!,
    append(A,B,C),
    dom_normal_form(A,AA),
    dom_normal_form(B,BB),
    dom_normal_form(C,CC),
    write('xtab: '), 
    out_term(AA), write(', '),
    out_term(BB), write(', '),
    out_term(CC), write(';\n').
out_xtab(_,_).


gen_xtab :-
    (domset(DomList)),
    sublist(DomList,A), 
    sublist(DomList,B),
    out_xtab(A,B), 
    fail ; true.
top_de([X],X):-!.
top_de([X|Y],T):-
     top_de(Y,T1),
     compare('<',X,T1),!,
     T=X.
top_de([_|Y],T):-
     top_de(Y,T).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% variant2 is added for the optimization in Sect 4.5

gen_xor_rules :-
    write_ln('xarg:X  &  i:X  &  i:Y  ->  i:XOR(X,Y);             (* comp *)'),
    write_ln('xarg:X  &  i:XOR(X,Y)  &  i:X  ->   i:Y;            (* decomp *)'),
    write_ln('xtab:X,Y,Z  &   i:XOR(X,T)  &  i:Y  ->  i:XOR(Z,T); (* variant *)'),
    write_ln('xtab:X,Y,Z  &   i:XOR(X,T)  &  i:XOR(Y,T)  ->  i:Z; (* gen *)'),
    write_ln('xtab:X,Y,Z  &   i:XOR(Y,T)  &  i:X  ->  i:XOR(Z,T); (* variant2 *)'),
    nl,
    gen_xarg,
    gen_xtab,
    write('i:o.\n').


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% PRINTING RULES AND TERMS
%

out_rule( L -> R ) :- !,
    out_tuple(L), write('  ->  '), out_fact(R), write(';\n').

out_rule( R ) :- out_tuple(R),write(';\n').

out_tuple((X,Y)) :- X=..[th|_],out_tuple(Y),!.
out_tuple((X,Y)) :- X=begin(Ev),mapterm( [(+)/'XOR', 0/o], Ev, MT),
    MT = (_,c,_),!,out_tuple(Y).

out_tuple((X,Y)) :- !,out_tuple(X), write(' & '), out_tuple(Y).

out_tuple(X) :- out_fact(X).


out_fact(Begin) :-
    nonvar(Begin), Begin=begin(Ev), !,
    write('begin:'), out_term(Ev).

out_fact(F) :-
    write('i:'), out_term(F).

out_term(T) :-
    mapterm( [(+)/'XOR', 0/o], T, MT),
    ( MT = (_,_) -> write('('), print(MT), write(')')
                ; print(MT) ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% INSTANTIATING THE PROTOCOL RULES 
%

%%
% fragile_terms(T, L) 
%   L is the list of fragile variables of T (the set F(t))
%
fragile_terms(T+S, FF) :- !,
    ( standard(T), \+ xt_ground(T) 
      -> AT = [T]
      ;  AT = [] ),
    ( standard(S), \+ xt_ground(S) 
      -> AS = [S]
      ;  AS = [] ),
    fragile_terms(T, FT),
    fragile_terms(S, FS),
    append_lists([AT, AS, FT, FS], FF).

fragile_terms(T, FT) :- 
    T =.. [_|Args],
    fvlist(Args,FT).

% where
fvlist( [], [] ).
fvlist( [A|As], FV) :-
    fragile_terms(A, FA),
    fvlist(As,FAs),
    append(FA,FAs,FV).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% bigSigma(Dom, T, Sigma) is to compute the set of substitutions Sigma for T based on Dom.


bigSigma(_,[], []).
bigSigma(Dom,[T|Ts], Sigma) :-
    sigmaForFT(Dom, T,Sigma1),
    bigSigma(Dom,Ts,Sigma2),
    merge_subst([Sigma1, Sigma2], Sigma).

sigmaForFT(_,_, []).

sigmaForFT(Dom, T, Sigma) :-
    xt_var(T), !,
    (inC(Dom,C), Sigma=[C/T]  ;  inC(Dom,C), C\=0, Sigma=[(C+T)/T]).
    
sigmaForFT(Dom,T, Sigma) :-
    % we have: \+ xt_var(T), 
    inC(Dom,C), normal_form(C,CN),
    matching(T, CN, Sigma),
    format('    (* !!! *)\n', [Sigma]).
    
%%
substitute(Sigma, Term, Instance) :-
    % format('    (* substitution: ~p *)\n', [Sigma]),
    subst_tmp(Sigma, Term, Instance).

subst_tmp([], Term, Term).
subst_tmp([(T/X)|Rest], Term, Instance) :-
    subst_var(X, T, Term, Term1),
    subst_tmp(Rest, Term1, Instance).

%%
% subst_var(X,S,T,-Res) 
%   -- Res is the result of substituting S for X in term T
%

subst_var(X,S,X,S) :- !.
subst_var(X,S,T,Res) :-
    T =.. [F|Args],
    maplist(subst_var(X,S), Args, SArgs),
    Res =.. [F|SArgs].

sigma_subst( Dom, FT, Term, Instance ) :-
    bigSigma(Dom,FT, Sigma),
    substitute(Sigma, Term, Instance).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%The following parts are the functions for the optimizations in 
% Sect. 4.2 and 4.3.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%get_th(Rule,Res) is used to extract the term Res containing the imformation of rule Rule 

get_th(L->_,Res):-
    L=..[_|Args],
    select(X,Args,_), X=..[th|_],!,
    Res=X.
    %format('\n Left part is ~p',[L]).

get_th(L,Res):-    
    L=.. [_|Args],select(X,Args,_), X=..[th|_],!,
    Res=X.
    
 
get_th(_,_). 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% rm_late_session(List1,List2, Res): List1 is the list of dominating elements,
%% List2 is the list of new nonces in the challenging rule.
%% Res is the set of dominating elements from List1 after removing all the nonces in later sessions.

rm_late_session([],_,[]):-!.
    
rm_late_session([X|Xs], Re,D) :-
    %format('\n Ns is ~p.\n',[X]),
    X=.. [F,A,B,Sid],
    select(Y,Re,_),
    Y=.. [F,A,B,S],
    compare(>,Sid,S),!,
    %format('big is ~p\n',[Xs]),
    rm_late_session(Xs,Re,D).

rm_late_session([X|Xs],Re,D) :-
    %format('before less is ~p\n',[Xs]),
    rm_late_session(Xs,Re,Dom),
    append([X],Dom,D),!.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%challenging_rule(Res) computes the set of terms of the form of th() in all challenging rules%%%

challenging_rule(Res):-
     bagof(R,(rule R),Rs),
     challenging_rule(Rs,Res).

challenging_rule([],[]):-!.

challenging_rule([X|Y],Res):-
     challenging_rule(Y,R),
     make_ground(X),
     new_nonces(X,Re),
     Re\==[],
     %get_th(X,T),
     append([X],R,Res),!.


challenging_rule([_|Y],Res):-
    challenging_rule(Y,Res).
    
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%if Rule is not the first challenging rule

challenging_pos(_,_,_,_,[],0):-!.

challenging_pos(A,B,_,Role,Crs,Pos):-
    select(R,Crs,_),
    get_th(R,X),
    X=.. [th,A,B,Pos,Role|_],!.
challenging_pos(_,_,_,_,_,0).

if_after_cr(O,Pos) :-
    %challenging_rule(Rs),
    %format('th is ~p\n',[Rs]),
    compare(>,O,Pos).


new_domset(_,_,_,_,O,_,D,Pos,_) :-
    if_after_cr(O,Pos),
    domset(D),!.
new_domset(_,A,B,S,O,Role,D,Pos,Crs) :-
    Pos==O,!,
    dom_before_cr(A,B,S,Role,D,Crs).

new_domset(Rule,_,_,_,_,_,D,_,_):-
    new_nonces(Rule,Re),
    domset(L),
    vsubtract(L,Re,Dom),
    rm_late_session(Dom,Re,D).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%dom_before_cr() to compute the domset before the first challenging rule

dom_before_cr(A,B,S,Role,D,Crs) :-
     domset(L),
     dom_before_cr(L,Crs,A,B,S,Role,D).

dom_before_cr([],_,_,_,_,_,[]):-!.
dom_before_cr(L,Rs,A,B,S,Role,D):-
     select(R,Rs,_),
     get_th(R,T),
     T=..[th,A,B,_,Role,S],!,
     new_nonces(R,Re), 
     vsubtract(L,Re,Dom), 
     %nformat('\nAfter=~p\n',[Dom]), 
     rm_late_session(Dom,Re,D).
dom_before_cr(L,_,_,_,_,_,L).
     
%gen_new_domset :-
 %   ground_rule(R),new_domset(R,_).
gen_domset(Rule,FT,Crs,Dom):-
    FT\==[],!,
    get_th(Rule,Res),
    Res=..[th,A,B,O,Role,S],
    challenging_pos(A,B,O,Role,Crs,Pos),
    %format('Res=~p.\n',[Res]),
    new_domset(Rule,A,B,S,O,Role,Dom,Pos,Crs),
    %domset(Dom),
    format('whose new domset is ~p. *)\n',[Dom]).
gen_domset(_,_,_,[]):-
    format('*)\n').

gen_instances( ORule, Rule,Sec,Crs ) :-
    fragile_terms(Rule, FT),
    list_to_set(FT,FTSet),
    format('\n(* Instances of  ~p ', [ORule] ),
    gen_domset(Rule,FT,Crs,Dom),
    sigma_subst(Dom,FTSet, Rule, Instance),
    \+agt_secrecy(Instance,Sec),
    normal_form(Instance, NFInstance),
    %format('Instance is ~p\n.',[Instance]),
    out_rule(NFInstance).
gen_instances(_,_,_,_).

gen_instances(Sec,Crs) :-
    ground_rule(R), % for old version
    normal_form(R, R1),
    gen_instances(R,R1,Sec,Crs),
    fail.

gen_instances(_,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% OUTPUTING

gen_header(InFile) :-
    format('(* This file is generated automatically by xlpt from ~p *)\n\n', 
            [InFile]).

out_proverif_directives :-
    forall( (proverif D), format('~p.\n', [D]) ).

gen_fun :-    
    format('fun o/0.\n'),
    format('fun XOR/2.\n'),
    format('fun xx/2.\n'),
    forall( (fun F), format('fun ~p.\n', [F]) ).
   
gen_query :-
    (query Q),
    write('query i:'),
    make_ground(Q),
    %format('Q=~p.\n',[Q]),
    %query_ms(Sn,Q,Res),
    normal_form(Q,NFQ),
    out_term(NFQ),
    write('.\n').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%generate all the nonces occuring in a term

gen_nonce_list(T,Res) :-
     nonce_set(Ns),select(X,Ns,_),X=.. [F|_], T=.. [F|_],!,
     Res=[T].

gen_nonce_list(T, Res) :-
     T=.. [_|Args],!,
     %format('T=~p\n',[T]), 
     maplist(gen_nonce_list,Args,SArgs),
     append(SArgs,Res).

gen_nonce_list(_,[]).  

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%generate the set of nonces Ns declared.

nonce_set(Ns) :-
   bagof(N, (nonce N), Ns).

%%%check if there are some new nonces generated.%%%%%%%

new_nonces(L->R,Res) :-
    !,
    gen_nonce_list(L,Llist),
    gen_nonce_list(R,Rlist),
    vsubtract(Rlist,Llist,Res).
    
new_nonces(R,Res):-
    gen_nonce_list(R,Res),!.

new_nonces(_,[]).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% gen_ms_var(Sn,N,R,R1) check if R contains a session identifier.
%% If it is, replace the session identifier with a constant of the form 'sN'.
%% Sn is the number of sessions to extend.
%% this is used for multi-session transformation in Sect. 3.
     
gen_ms_var(Sn,N,R,R1) :-
   N=<Sn, R=..[th,A,B,Th,Role|_],!,
   %format('th rule=~p',[R]),m
   concat_atom(['s',N],T),
   R1=.. [th,A,B,Th,Role,T].

gen_ms_var(Sn,N,R,R1) :-
   N=<Sn, nonce_set(Ns),select(X,Ns,_),X=.. [F|_], R=.. [F,A,B|_],  !, 
   concat_atom(['s',N],T),
   R1=.. [F,A,B,T].

gen_ms_var(Sn,N,R,R1) :-!,
    N=<Sn,
    R=.. [F|Args],
    maplist(gen_ms_var(Sn,N),Args, SArgs),
    R1=.. [F|SArgs].

gen_ms_var(Sn,N,X,X):-!,N=<Sn.

gen_ms_rule(R,Sn,N) :-
   gen_nonce_list(R,Res),
   Res\==[],!,
   N=<Sn,
   gen_ms_var(Sn,N,R,R1),
   format('rule ~p.\n',[R1]), N1 is N+1,  
   gen_ms_rule(R,Sn,N1),!.

gen_ms_rule(R,_,_):-format('rule ~p.\n',[R]).
    
gen_ms_rule(Sn):-
    ground_rule(R),
    gen_ms_rule(R,Sn,1),
    fail.
gen_ms_rule(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
gen_fun_m :- 
    forall( (fun F), (format('fun ~p.\n', [F])) ).
   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% delcare the session identifiers used in the transformation
            
gen_sids(Sn,N) :-
        N=<Sn, 
        concat_atom(['s',N],T),
        format('fun ~p/0.\n',[T]),
        N1 is N+1,
        gen_sids(Sn,N1),!.
gen_sids(_,_).

ground_nonce(N) :- (nonce N), make_ground(N).

gen_nonces :-
      ground_nonce(N), format('nonce ~p.\n',[N]),fail.
gen_nonces.

gen_query_m :- (query Q),make_ground(Q),
             format('query ~p.\n',[Q]).


gen_header_m(InFile) :-
    format('%% This file is generated automaticall by mst form ~p \n\n%% Functors\n',     [InFile]).


 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%agt_secrecy(R) to determine if R has a term that goes against principle of secrecy.

agt_secrecy(R,Dev):-
    domset(L), 
    vsubtract(L,Dev,Sec),
    agt_secrecy(Sec,Dev,R),!.
agt_secrecy(_):-fail.

agt_secrecy(S,D,L->R):-
    (agt_secrecy(S,D,L);
    agt_secrecy(S,D,R)),!.

agt_secrecy(S,_,(X,_)):-
    ground(X),
    subset([X],S),!.

agt_secrecy(S,D,(X,_)):-
    ground(X),
    X=..[xx|_],
    xor_sec(X,S,D),!.
agt_secrecy(S,D,(_,Y)):-
    agt_secrecy(S,D,Y),!.

agt_secrecy(S,D,X):-
    ground(X),
    X=..[xx|_],
    %format('rule=~p.\n',[X]),
    xor_sec(X,S,D),!.
agt_secrecy(S,_,X):-
    
    ground(X),
    %format('X=~p,S=~p.\n',[X,S]),
    subset([X],S),!.

agt_secrecy(_,_,_):-fail.
   
xor_sec(X,S,D):-
    flat(X,Ds,SS),
    append(Ds,SS,Re),
    vlist_to_set(Re,M),
    %format('M=~p,D=~p\n',[M,D]),
    vsubtract(M,[0|D],L),
    length(L,E),
    E==1,
    %format('L=~p,  S=~p,  D=~p.\n',[L,S,D]),
    subset(L,S).

xor_sec(_,_,_):-fail.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% get_secrecy(Sec,Sn,SC) is used to get the list of secrecies. Sn is the number of sessions.

get_secrecy(Res,Sn,SC):-
    SC=='-sc',!,
    get_sec(Se),  
    extend_sec(Se,Sn,Sec),
    vsubtract(Sec,[0],Res).
get_secrecy([],_,SC):-
    SC=='-nsc',!.
get_secrecy(_,_,_):-
    format('Secrecy check option is not clear.\n'),
    halt(-1).  
    


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%get_sec is used to read the original form of secrecies

get_sec(Se):-
    ['seclist'],
    bagof(S,(secret S),Se),
    seen.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%extend_sec(S,Sn,Sec) is to expand the secrecy list to multiple sessions. 

extend_sec([],_,[]):-!.
extend_sec([X|Y],Sn,Sec):-
     nonce_set(Ns),
     select(Z,Ns,_),
     Z=.. [F|_],   
     X=.. [F|_], !,
     add_sec(X,Sn,1,Sec1),
     extend_sec(Y,Sn,Sec2),
     append(Sec1,Sec2,Sec).
extend_sec([X|Y],Sn,Sec):-
     extend_sec(Y,Sn,Sec1),
     append([X],Sec1,Sec).

add_sec(X,Sn,N,Sec1):-
      N=<Sn,X=..[F,A,B|_],!,
      concat_atom(['s',N],Sid),
      Y=..[F,A,B,Sid],
      N1 is N+1,
      add_sec(X,Sn,N1,Sec2),
      append([Y],Sec2,Sec1).
add_sec(_,_,_,[]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
out_sec_info(Sec,SC):-
     SC=='-sc',!,
     format('    + Secrecy set = ~p.\n', [Sec]).
out_sec_info(_,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% declare the known terms in the front of output file

gen_known_dom(Sec,SC):-
    SC=='-sc',!,
    format('\n(***** known dominating elements: *****)\n'),
    domset(L),
    vsubtract(L,Sec,NT),
    gen_known_de(NT).
gen_known_dom(_,_).

gen_known_de([]):-!.
gen_known_de([X]):-format('i:~p;\n',[X]),!.
gen_known_de([X|Y]):-
     format('i:~p;\n',[X]),
     gen_known_de(Y).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MAIN

main :- 
    say_hello, !,
    get_args(InFile, OutFile,SC), !,
    see(user),
    write('Please enter the number of sessions to process (end with period): '),
    read(Sn),
    seen,
    [InFile],
    concat_atom([InFile,'-ms'],MFile),
    tell(MFile), 
    gen_header_m(InFile),
    gen_fun_m,
    gen_sids(Sn,1),
    nl,
    gen_ms_rule(Sn),nl, 
    told, 
    seen,
    get_secrecy(Sec,Sn,SC),
      % consulting the user file:
    [MFile],
    % print secrecies
    out_sec_info(Sec,SC),
    % computing the dominating set (if not given by the user)
    copute_dominating_set_if_necessary,
    % checking the rules given by the user:    
    check_rules,

    tell(OutFile),
    % output the header
    gen_header(InFile),
    gen_fun, nl,
    out_proverif_directives, nl,
    gen_query, nl,
    
    format('reduc\n\n'),
    format('\n(***** known dominating elements: *****)\n'),
    gen_known_dom(Sec,SC),
    format('\n(***** User rules: *****)\n'),
    challenging_rule(Crs),
    gen_instances(Sec,Crs), nl,

    format('(***** XOR-rules: *****)\n'),
    gen_xor_rules,
    told,
    %format('    + Derivable Dominating elements = ~p.\n', [Dev]),
    format('    + output written to ~p.\n\n', [OutFile]).


say_hello :- !,
    format('\nXLPT -- XOR-Linear Protocol Transformer.\n\n').

get_args(InFile, OutFile,SC) :-
    unix(argv(Args)), 
    append( _, [--, InFile,OutFile,SC],  Args), !.
get_args(_,_,_) :-
    format('*** Exactly three commandline arguments needed:\n*** input filename,output filename and if secrecy checking is needed.\n\n'),
    halt(-1).

check_rules :-
    forall( (rule R), check_rule(R) ),
    write_ln('    + rules are valid'),
    forall( ground_rule(R), check_dominated(R,R) ),
    write_ln('    + rules are C-dominated').
    
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- main.
:- halt.%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%



