#!/usr/bin/swipl -q -s
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Protocol Transformer (With Types)
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%
% AUXILIARY predicates/functions (needed for transformation process)

:- multifile proverif/1.
:- dynamic stages/1.
:- dynamic exponent/1.
:- dynamic (::)/2.

%
% Operations that may be found in the protocol that is being transformed
%
:- op( 1180, fx,  fun ).
:- op( 1180, fx,  type ).
:- op( 1180, fx,  query ).
:- op( 1180, fx,  proverif ).
:- op( 1150, xfx, :: ).
:- op( 1140, yfx, # ).
:- op( 1130, fx, forall ).
:- op(  200, yfx, ^ ).
:- op(  200, yfx, ^~ ).
:- op(  210, yfx, * ).
:- op(  215, yfx, *~ ).
:- op(  100, yfx, : ).
:- op(  50,  xf, '()' ).

%
% Some proverif clauses that will be inserted into the output file
%

% Normalization predicates: E,M,P
proverif 'pred nexp(gt,exponent,gt)'.
proverif 'pred nrexp(gt,exponent,gt)'.
proverif 'pred nmult(g1,exponent,g1)'.
proverif 'pred nrmult(g1,exponent,g1)'.
proverif 'pred npair(g1,g1,gt)'.

proverif 'pred incr(any_type,any_type) [decompData, elimVar]'.
proverif 'pred decr(any_type,any_type) [decompData, elimVar]'.
proverif 'pred add(integer,integer,integer) [elimVar]'.

proverif 'pred i(any_type) [decompData, elimVar]'.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% SUBSTITUTION
%

substitute(Subst, T, S) :-
    member(T/S, Subst), !.

substitute(Subst, T, S) :-
    T =.. [F|Args],
    maplist(substitute(Subst), Args, NewArgs),
    S =.. [F|NewArgs].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% HANDLING EXPONENTS (and therefore the multipliers)
%

assert_exponent(S) :-
    exponent(S), !.

assert_exponent(S) :-
    assert(exponent(S)).

exponents(L) :-
    setof(X, exponent(X), L).

num_exponents(N) :-
    exponents(L), length(L,N).

make_exp_indices :-
    exponents(Es),
    make_exp_indices(1,Es).

make_exp_indices(_,[]).
make_exp_indices(N,[E|Es]) :-
    assert(expind(N,E)),
    N1 is N+1,
    make_exp_indices(N1,Es).

exponent_indices(L) :-
    bagof(X, E^expind(X,E), L).

out_exponents :-
    exponents(L),
    length(L,N),
    format('+ Exponents(multipliers): ~p  (~p)\n', [L,N]).

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

%%
% 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).

%%
% Predefined functors:
%
std_functor( (,)/2 ).
std_functor( (->)/2 ).
std_functor( (^)/2 ).
std_functor( (^~)/2 ).
std_functor( (\=)/2 ).
std_functor( (*)/2 ).
std_functor( (*~)/2 ).
std_functor( (:)/2 ).

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

%
% 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) :-
    check_exponent(T).
    %T =.. [F|Args],
    %length(Args,N),
    %funct(F/N), !.

check_term_locally(T) :-
    format('*** Invalid term: ~p\n', [T]),
    fail.

check_exponent(T^S) :- !,
    ground(S) 
        -> assert_exponent(S)
        ; ( format('*** Non ground exponent: ~p\n', [T^S]), fail ).

check_exponent(T^~S) :- !,
    ground(S) 
        -> assert_exponent(S)
        ; ( format('*** Non ground exponent: ~p\n', [T^~S]), fail ).

check_exponent(T*S) :- !,
    ground(S)
        -> assert_exponent(S)
        ; ( format('*** Non ground multiplier: ~p\n', [T*S]), fail ).

check_exponent(T*~S) :- !,
    ground(S)
        -> assert_exponent(S)
        ; ( format('*** Non ground multiplier: ~p\n', [T*~S]), fail ).

check_exponent(_).


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

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

check_rule(X) :-
    check_term(X).

check_stage(Q) :-
    cons_stages(_,Q), !.

check_stage(Q) :-
    format('*** Bad stage: ~p\n', [Q]),
    fail.
    
%
% check all the user rules
%
check_rules :-
    forall( (rule :: R), check_rule(R) ),
    forall( (rule(Q) :: R), (check_rule(R), check_stage(Q)) ),
    write_ln('+ Rules are valid.').


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% STAGES

mk_stages :-
    stages(_), !. % stages are defined by the user
mk_stages :-
    assert( stages([0]) ).

stage(Q) :- stages(L), member(Q,L).
first_stage(Q) :- stages([Q|_]).
last_stage(Q) :- stages(L), append(_,[Q],L).
cons_stages(Q,P) :- stages(L), append(_, [Q,P|_], L).

stage_pred(Stage, StagePred) :-
    sformat(Str, 'i~p', [Stage] ),
    string_to_atom(Str, StagePred).

stage_pred(Pred) :-
    stage(Q), stage_pred(Q,Pred).

first_stage_pred(Pred) :- stages([Q|_]), stage_pred(Q,Pred).

stage_predicates(Preds) :-
    bagof(P, stage_pred(P), Preds).

phase_rules :-
    stage_predicates(L),
    phase_promotions(L),
    nl.

phase_promotions([]).
phase_promotions([_]).
phase_promotions([Q,R|L]) :- 
    out_phase_promotion(Q,R),
    phase_promotions([R|L]).

out_phase_promotion(Q,R) :-
    out_rule( Q:x -> R:x ).

out_multi_stage_rule( R -> S ) :-
    stage_pred(I),
    out_rule( I:R -> I:S ),
    fail ; true.

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

%
%  out_rule( Continuation, Rule )  
%       --- Continuation=true, if there were some previous assumptions
%

out_rule( true, L->R ) :- !,
    format(' &\n'), out_rule(L->R).

out_rule( true, F # R ) :- !,
    format(' &\n'), out_rule(F # R).

out_rule( true, R ) :- !,
    format(' ->\n'), out_rule(R).

out_rule( _, Rule ) :-
    out_rule(Rule).

out_rule(F # R) :- !,
    write(F),write(';'),out_fact(R), write(';\n').

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

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

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

out_tuple(X) :- out_fact(X).

out_fact(T \= S) :- !,
    out_term(T), write('<>'), out_term(S).
    
out_fact(P:F) :-
    write(P), write('('), out_term(F), write(')').

out_term(T) :-
    ( T = (_,_) -> write('('), print(T), write(')')
                 ; print(T) ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ground_rule(R) -- R is a grounded verion of some (user defined)
% rule. This version is obtained by numbervars.
% Also, appropriate predicates are added.
%

ground_rule(Rule) :-
    (rule :: R),  % multi-stage predicate
    stage_pred(I),
    make_ground(R),
    add_pred(R,I,I,Rule).

ground_rule(Rule) :-
    (rule(J) :: R ), 
    cons_stages(I,J),
    stage_pred(I,PI),
    stage_pred(J,PJ),
    make_ground(R),
    add_pred(R,PI,PJ,Rule).

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

add_pred( L -> R, I, J, (I:L -> J:R) ) :- !.
add_pred( F # L -> R, I, J, F # (I:L -> J:R) ) :- !.
add_pred( A, _, J, J:A ).
add_pred( F # A, _, J, F # J:A ).
    

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% PRINTING INTRUDER RULES
%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% AUXILIARY PREDICATES FOR GENERATING LISTS

    unifo('o()').
    unif_integer('integer').
    addo('o()').

    addos(Selected, Selected, 's(o())') :- !.
    addos(_Selected, _Exponent, 'o()').

    addop(Selected, Selected, 'p(o())') :- !.
    addop(_Selected, _Exponent, 'o()').

    addsn(Char, Selected, Selected, X) :- !, sformat(X, 's(~p~p)', [Char,Selected]).
    addsn(Char,_Selected, Exponent, X) :- sformat(X, '~p~p', [Char,Exponent]).

    addpn(Char, Selected, Selected, X) :- !, sformat(X, 'p(~p~p)', [Char,Selected]).
    addpn(Char,_Selected, Exponent, X) :- sformat(X, '~p~p', [Char,Exponent]).

    addn(Char, Exponent, X) :- sformat(X, '~p~p', [Char,Exponent]).
    addnm(_Char1,Char2,Selected, Selected, X) :- !, sformat(X, '~p~p', [Char2,Selected]).
    addnm(Char1,_Char2,_Selected, Exponent, X) :- sformat(X, '~p~p', [Char1,Exponent]).

    %%
    % This is used for generating "add(x1,y1,z1) & .... & add(xm,ym,zm)"
    % Xs is the list of variables. For example, Xs = [x,y,z]
    %
    create_predicate_and_list(Pred,Xs,1,Result):-
        list_to_string(Xs,1,S),
        sformat(Result, '~p(~p)', [Pred,S]).

    create_predicate_and_list(Pred,Xs,N,Result):-
        M is N - 1,
        create_predicate_and_list(Pred,Xs,M,Result2),
        list_to_string(Xs,N,S),
        sformat(Result, '~p & ~p(~p)', [Result2,Pred,S]).

    %%
    %translates [x1,x2,...,xn] to string 'x1,x2,...,xn'
    % 

    %This is for supporting "add(xi,yi,'o()')"
    list_to_string(['o()'|[]],_,'o()'):- !.

    list_to_string([X|[]],N,Y):-
        concat(X,N,Y).

    list_to_string([X|Xs],N,Result):-
        concat(X,N,Y),
        list_to_string(Xs,N,Result2),
        sformat(Result,'~p,~p',[Y,Result2]).

    %%
    % Generates a list of "forall" variables: Xs - variable names, Ys - data types
    %
    gen_forall_list([X],[Y|_],S):-
        sformat(S,'~p:~p; ',[X,Y]).

    gen_forall_list([X|_],[Y],S):-
        sformat(S,'~p:~p; ',[X,Y]).

    gen_forall_list([X|Xs],[Y|Ys],S):-
        gen_forall_list(Xs,Ys,S1),
        sformat(S,'~p:~p, ~p',[X,Y,S1]).
        

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% EXPONENTIATION RULES:

dh_id_rules :-
    num_exponents(N),
    length(L,N),
    maplist(unifo,L),
    E =.. [exp, 'x' | L],
    format('forall x:gt; '),
    out_multi_stage_rule( E -> x ),
    format('forall x:gt; '),
    out_multi_stage_rule( x -> E ).

intruder_dh_rules :-
    exponent_indices(Es), num_exponents(N),
    intruder_dh_rules(Es,Es,N),
    nl.

intruder_dh_rules([],_,_).
intruder_dh_rules([A|As],Exponents,N) :-
    expind(A,AA),
    length(L1,N), maplist( addn('x'), Exponents, L1),
    length(L2,N), maplist( addnm('x','y',A), Exponents, L2),
    length(L3,N), maplist('unif_integer',L3),

    concat('y',A,Y),
    gen_forall_list([x,Y|L1],[gt,integer|L3],S),
    E1 =.. [exp, 'x' | L1],
    E2 =.. [exp, 'x' | L2],
    sformat(Str, 'y~p', [A] ),
    string_to_atom(Str, Ap),
    format('forall ~p ',[S]),
    out_multi_stage_rule( (AA, Ap, E1) -> E2 ),
    intruder_dh_rules(As,Exponents,N).

normalisation_rules :-
    exponent_indices(Es),
    num_exponents(N),
    normalisation_rules(Es,Es,N),
    nl.
   
normalisation_rules([],_,_).
normalisation_rules([A|As],Exponents,N) :-
    expind(A,AA),

    length(L0,N), maplist( addos(A), Exponents, L0),
    E0 =.. [exp, 'x' | L0],
    format('forall x:gt; nexp(x, ~p, ~p); \n', [AA,E0]),

    length(L1,N), maplist( addop(A), Exponents, L1),
    E1 =.. [exp, 'x' | L1],
    format('forall x:gt; nexp(~p, ~p, x); \n', [E1,AA]),

    length(L2,N), maplist( addn('x'), Exponents, L2),
    length(Ints,N), maplist('unif_integer',Ints),
    gen_forall_list([x|L2],[gt|Ints],S),

    E2 =.. [exp, 'x' | L2],
    length(L2r,N), maplist( addsn('x',A), Exponents, L2r),
    E2r =.. [exp, 'x' | L2r],
    format('forall ~p nexp(~p, ~p, ~p); \n', [S,E2,AA,E2r]),

    length(L3,N), maplist( addpn('x',A), Exponents, L3),
    E3 =.. [exp, 'x' | L3],
    E3r = E2,
    format('forall ~p nexp(~p, ~p, ~p); \n', [S,E3,AA,E3r]),
    
    normalisation_rules(As,Exponents,N).

rev_normalisation_rules :-
    exponent_indices(Es),
    num_exponents(N),
    rev_normalisation_rules(Es,Es,N),
    nl.
   
rev_normalisation_rules([],_,_).
rev_normalisation_rules([A|As],Exponents,N) :-
    expind(A,AA),

    length(L0,N), maplist( addop(A), Exponents, L0),
    E0 =.. [exp, 'x' | L0],
    format('forall x:gt; nrexp(x, ~p, ~p); \n', [AA,E0]),

    length(L1,N), maplist( addos(A), Exponents, L1),
    E1 =.. [exp, 'x' | L1],
    format('forall x:gt; nrexp(~p, ~p, x); \n', [E1,AA]),

    length(L2,N), maplist( addn('x'), Exponents, L2),
    length(Ints,N), maplist('unif_integer',Ints),
    gen_forall_list([x|L2],[gt|Ints],S),

    E2 =.. [exp, 'x' | L2],
    length(L2r,N), maplist( addpn('x',A), Exponents, L2r),
    E2r =.. [exp, 'x' | L2r],
    format('forall ~p nrexp(~p, ~p, ~p); \n', [S,E2,AA,E2r]),

    length(L3,N), maplist( addsn('x',A), Exponents, L3),
    E3 =.. [exp, 'x' | L3],
    E3r = E2,
    format('forall ~p nrexp(~p, ~p, ~p); \n', [S,E3,AA,E3r]),
    
    rev_normalisation_rules(As,Exponents,N).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MULTIPLICATION RULES:

mult_id_rules :-
    num_exponents(N),
    length(L,N),
    maplist(unifo,L),
    E =.. [mult, 'x' | L],
    format('forall x:g1; '),
    out_multi_stage_rule( E -> x ),
    format('forall x:g1; '),
    out_multi_stage_rule( x -> E ).

intruder_mult_rules :-
    exponent_indices(Es), num_exponents(N),
    intruder_mult_rules(Es,Es,N),
    nl.

intruder_mult_rules([],_,_).
intruder_mult_rules([A|As],Exponents,N) :-
    expind(A,AA),
    length(L1,N), maplist( addn('x'), Exponents, L1),
    length(L2,N), maplist( addnm('x','y',A), Exponents, L2),
    length(L3,N), maplist('unif_integer',L3),

    concat('y',A,Y),
    gen_forall_list([x,Y|L1],[g1,integer|L3],S),
    E1 =.. [mult, 'x' | L1],
    E2 =.. [mult, 'x' | L2],
    sformat(Str, 'y~p', [A] ),
    string_to_atom(Str, Ap),
    format('forall ~p ',[S]),
    out_multi_stage_rule( (AA, Ap, E1) -> E2 ),
    intruder_mult_rules(As,Exponents,N).

mult_normalisation_rules :-
    exponent_indices(Es),
    num_exponents(N),
    mult_normalisation_rules(Es,Es,N),
    nl.
   
mult_normalisation_rules([],_,_).
mult_normalisation_rules([A|As],Exponents,N) :-
    expind(A,AA),

    length(L0,N), maplist( addos(A), Exponents, L0),
    E0 =.. [mult, 'x' | L0],
    format('forall x:g1; nmult(x, ~p, ~p); \n', [AA,E0]),

    length(L1,N), maplist( addop(A), Exponents, L1),
    E1 =.. [mult, 'x' | L1],
    format('forall x:g1; nmult(~p, ~p, x); \n', [E1,AA]),

    length(L2,N), maplist( addn('x'), Exponents, L2),
    length(Ints,N), maplist('unif_integer',Ints),
    gen_forall_list([x|L2],[g1|Ints],S),

    E2 =.. [mult, 'x' | L2],
    length(L2r,N), maplist( addsn('x',A), Exponents, L2r),
    E2r =.. [mult, 'x' | L2r],
    format('forall ~p nmult(~p, ~p, ~p); \n', [S,E2,AA,E2r]),

    length(L3,N), maplist( addpn('x',A), Exponents, L3),
    E3 =.. [mult, 'x' | L3],
    E3r = E2,
    format('forall ~p nmult(~p, ~p, ~p); \n', [S,E3,AA,E3r]),
    
    mult_normalisation_rules(As,Exponents,N).

mult_rev_normalisation_rules :-
    exponent_indices(Es),
    num_exponents(N),
    mult_rev_normalisation_rules(Es,Es,N),
    nl.
   
mult_rev_normalisation_rules([],_,_).
mult_rev_normalisation_rules([A|As],Exponents,N) :-
    expind(A,AA),

    length(L0,N), maplist( addop(A), Exponents, L0),
    E0 =.. [mult, 'x' | L0],
    format('forall x:g1; nrmult(x, ~p, ~p); \n', [AA,E0]),

    length(L1,N), maplist( addos(A), Exponents, L1),
    E1 =.. [mult, 'x' | L1],
    format('forall x:g1; nrmult(~p, ~p, x); \n', [E1,AA]),

    length(L2,N), maplist( addn('x'), Exponents, L2),
    length(Ints,N), maplist('unif_integer',Ints),
    gen_forall_list([x|L2],[g1|Ints],S),

    E2 =.. [mult, 'x' | L2],
    length(L2r,N), maplist( addpn('x',A), Exponents, L2r),
    E2r =.. [mult, 'x' | L2r],
    format('forall ~p nrmult(~p, ~p, ~p); \n', [S,E2,AA,E2r]),

    length(L3,N), maplist( addsn('x',A), Exponents, L3),
    E3 =.. [mult, 'x' | L3],
    E3r = E2,
    format('forall ~p nrmult(~p, ~p, ~p); \n', [S,E3,AA,E3r]),
    
    mult_rev_normalisation_rules(As,Exponents,N).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% RULES FOR BILINEAR MAPPING

intruder_pairing_rules:-
    exponent_indices(Es),
    num_exponents(N),
    length(LX,N), maplist( addn('x'), Es, LX),
    length(LY,N), maplist( addn('y'), Es, LY),
    length(LZ,N), maplist( addn('z'), Es, LZ),
    N1 is N * 3,
    length(Ints,N1), maplist('unif_integer',Ints),

    create_predicate_and_list(add,[x,y,z],N,E0),

    append(LX,LY,LXY),
    append(LXY,LZ,LXYZ),
    gen_forall_list([x,y|LXYZ],[g1,g1|Ints],S),

    E1 =.. [mult,'x'     | LX],
    E2 =.. [mult,'y'     | LY],
    E3 =.. [exp,'e(x,y)' | LZ],

    format('forall ~p \n',[S]),
    format('~p &\n', [E0]),
    out_multi_stage_rule( (E1,E2) -> E3 ).

pairing_normalisation_rules :-

    integer_addition_rules,
    exponent_indices(Es), 
    num_exponents(N),    

    length(LX,N), maplist( addn('x'), Es, LX),
    length(LY,N), maplist( addn('y'), Es, LY),
    length(LZ,N), maplist( addn('z'), Es, LZ),

    N2 is N * 2,
    N3 is N * 3,
    length(Ints,N), maplist('unif_integer',Ints),
    length(Ints_2,N2), maplist('unif_integer',Ints_2),
    length(Ints_3,N3), maplist('unif_integer',Ints_3),

    create_predicate_and_list(add,[x,y,z],N,E0),
    create_predicate_and_list(add,[x,y,'o()'],N,E2),

    append(LX,LY,LXY),
    append(LXY,LZ,LXYZ),

    gen_forall_list([x,y|LXYZ],[g1,g1|Ints_3],S_XYZ),
    gen_forall_list([x,y|LX],[g1,g1|Ints],S_X),
    gen_forall_list([x,y|LXY],[g1,g1|Ints_2],S_XY),

    E1 =.. [exp, 'e(x,y)'| LX],

    EX =.. [mult,'x'     | LX],
    EY =.. [mult,'y'     | LY],
    EZ =.. [exp,'e(x,y)' | LZ],

    format('forall x:g1, y:g1; npair(x, y, e(x,y)); \n'),
    format('forall ~p npair(~p,  y, ~p); \n', [S_X, EX,E1]),
    format('forall ~p npair( y, ~p, ~p); \n', [S_X, EX,E1]),

    format('\nforall ~p \n~p -> \nnpair(~p, ~p, ~p); \n', [S_XYZ, E0,EX,EY,EZ]),
    format('\nforall ~p \n~p -> \nnpair(~p, ~p, ~p); \n', [S_XY,  E2,EX,EY,'e(x,y)']),
    nl.
  
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  
% RULES FOR ADDITION OF INTEGERS

integer_addition_rules:-

    format('incr(o(), s(o()));\n'),
    format('forall x:integer; incr(s(x), s(s(x)));\n'),
    format('forall x:integer; incr(p(x), x);\n\n'),

    format('decr(o(), p(o()));\n'),
    format('forall x:integer; decr(p(x), p(p(x)));\n'),
    format('forall x:integer; decr(s(x), x);\n\n'),

    format('forall x:integer; add(x, o(), x);\n\n'),

    format('forall x:integer, y:integer, z:integer, w:integer; add(x, y, z) & incr(z, w) -> add(x, s(y), w);\n'),
    format('forall x:integer, y:integer, z:integer, w:integer; add(x, y, z) & decr(z, w) -> add(x, p(y), w);\n\n').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  
% RULES FOR DERIVING ANY INTEGER TERM

intruder_rules :-
    first_stage_pred(I),
    format('\
        ~p(o());\n\
        forall x:integer; ~p(x) -> ~p(s(x));\n\
        forall x:integer; ~p(x) -> ~p(p(x));\n\n',
        [I,I,I,I,I]),
    dh_id_rules,
    intruder_dh_rules,
    mult_id_rules,
    intruder_mult_rules,
    intruder_pairing_rules,
    write('\n').

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

out_proverif_directives :-
    forall( (proverif D), format('~p.\n', [D]) ),
    forall( stage(Q),  format('pred i~p(any_type) [decompData, elimVar].\n', [Q]) ).

gen_fun :-    
    format('fun o():integer.\n'),
    format('fun s(integer):integer.\n'),
    format('fun p(integer):integer.\n'),

    num_exponents(N),
    length(Xs,N),
    maplist(unif_integer,Xs),
    Exp  =.. [exp, gt | Xs],
    Mult =.. [mult, g1 | Xs],
    format('fun ~p:gt.\n', [Exp]),
    format('fun ~p:g1.\n', [Mult]),
    format('fun e(g1,g1):gt.\n'),
    % Do not print the auxiliary function e_ !
    forall( ((fun F), (F \= e_(g1, g1):gt)), format('fun ~p.\n', [F]) ).

gen_types :-    
    format('type integer.\n'),
    format('type exponent.\n'),
    format('type g1.\n'),
    format('type gt.\n'),
    forall( ((type T), (\+memberchk(T,[integer,exponent,g1,gt]))), format('type ~p.\n', [T]) ).

gen_query :-
    last_stage(Last),
    (query Q),
    format('query i~p(', [Last]),
    make_ground(Q),
    out_term(Q),
    write(').\n').


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% REWRITING PROTOCOL RULES
%

substitute_ground_exp(R,S) :- sugrex(R,S).

sugrex(R, S) :-
    xt_ground(R),  (R= _ ^ _  ;  R= _ ^~ _ ), !,
    flatex(R,[T|L]),
    sugrex(T,TT),
    S =.. [exp, TT | L].    

sugrex(R, S) :-
    xt_ground(R),  (R= _ * _  ;  R= _ *~ _ ), !,
    flatex(R,[T|L]),
    sugrex(T,TT),
    S =.. [mult, TT | L].

%%%
% We want co carry the exponents out of G_1 into G_T
%
sugrex(R, S) :-
    xt_ground(R),  (R= e_(_,_)), !,
    flatex(R,[T|RR]),
    S =.. [exp, T | RR].

%%
% Standard terms
%
sugrex(R, S) :-
    R =.. [F|Args],
    maplist(sugrex, Args, Args1),
    S =.. [F|Args1].

%%%
% Encoding the multiplication / exponentiation
%
flatex(T^S, L) :- !,
    flatex(T,L0),
    exp_pos(L0,S,L).

flatex(T^~S, L) :- !,
    flatex(T,L0),
    exp_neg(L0,S,L).

flatex(T*S, L) :- !,
    flatex(T,L0),
    exp_pos(L0,S,L).
flatex(T*~S, L) :- !,
    flatex(T,L0),
    exp_neg(L0,S,L).

%%
% Carrying the exponents from G_1 to G_T one by one
%
flatex(e_(R*S,T),L):- !,
    flatex(e_(R,T),L0),
    exp_pos(L0,S,L).

flatex(e_(R*~S,T),L):- !,
    flatex(e_(R,T),L0),
    exp_neg(L0,S,L).

flatex(e_(R,T*S),L):- !,
    flatex(e_(R,T),L0),
    exp_pos(L0,S,L).

flatex(e_(R,T*~S),L):- !,
    flatex(e_(R,T),L0),
    exp_neg(L0,S,L).

%%
% Substute ground expressions in the arguments of e_(_,_)
% Prepare the e(_,_) for beign exponentiated!(flatten the expression)
%
flatex(e_(R,S),L):- !,
    sugrex(R,RR),
    sugrex(S,SS),
    flatex(e(RR,SS),L).

%%
% A standard term: encode x -> x,0,...,0
%
flatex(T, [T|L]) :-
    num_exponents(N),
    length(L,N),
    maplist(unifo,L).

%%
% Adding / subtracting the exponents one by one (for multiplication / exponentiation)
%
exp_pos(L,A,L1) :-
    expind(N, A),
    nth_ch(N, X, Y, L, L1),
    successor(X,Y).

exp_neg(L,A,L1) :-
    expind(N, A),
    nth_ch(N, X, Y, L, L1),
    predecessor(X,Y).

nth_ch(0, A, B, [A|Xs], [B|Xs]) :- !.
nth_ch(N, A, B, [X|Xs], [X|Ys]) :-
    N>0,
    N1 is N-1,
    nth_ch(N1, A, B, Xs, Ys).

successor(p(X), X) :- !.    
successor(X, s(X)).

predecessor(s(X), X) :- !.    
predecessor(X, p(X)).


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

nonstandard_subterm(T^S, T^S).
nonstandard_subterm(T^~S, T^~S).
nonstandard_subterm(T*S, T*S).
nonstandard_subterm(T*~S, T*~S).
nonstandard_subterm(e_(T,S), e_(T,S)).

nonstandard_subterm(T, NST) :-
    T =.. [_|Args],
    member(A,Args),
    nonstandard_subterm(A,NST).

nonstandard_subterms(T,L) :-
    setof(X, nonstandard_subterm(T,X), L), !.
nonstandard_subterms(_,[]). % if setof fails

make_aux_vars(Ts, Ps) :-
    make_aux_vars(1,Ts,Ps).
make_aux_vars(_, [], []).
make_aux_vars(N, [T|Ts], [T/Id|Ps]) :-  sformat(Id, 'x~p', [N]),
    N1 is N+1,  
    make_aux_vars(N1, Ts, Ps).

%%
%Create "forall" for auxiliary variables
%

%It's possible that there are no aux variables
create_forall_list([],"").

create_forall_list([X], Result):-
    var_datatype(X,Result).

create_forall_list([X|Xs], Result):-
    var_datatype(X,Result1),    
    create_forall_list(Xs,Result2),
    sformat(Result,'~p, ~p',[Result1,Result2]).

%Exponentiation: type gt
var_datatype((_^_)/V, Result):-
    sformat(Result,'~p:~p',[V,'gt']).
var_datatype((_^~_)/V, Result):-
    sformat(Result,'~p:~p',[V,'gt']).

%Multiplication: type g1
var_datatype((_*_)/V, Result):-
    sformat(Result,'~p:~p',[V,'g1']).
var_datatype((_*~_)/V, Result):-
    sformat(Result,'~p:~p',[V,'g1']).

%Pairing: type gt
var_datatype((e_(_,_))/V, Result):-
    sformat(Result,'~p:~p',[V,'gt']).

print_aux([]).
print_aux([T/V]) :-
    format(' ~p = ~p ', [V,T]), !. 
print_aux([T/V | Ps]) :-
    format(' ~p = ~p,', [V,T]), 
    print_aux(Ps).

print_aux_assumptions([], _, false).

print_aux_assumptions([(T^S)/V], M, true) :- !,
    print_nexp(M,T,S,V).

print_aux_assumptions([(T^S)/V | Rest], M, true) :- !,
    print_nexp(M,T,S,V), format(' & '),
    print_aux_assumptions(Rest, M, _).

print_aux_assumptions([(T^~S)/V], M, true) :- !,
    print_nrexp(M,T,S,V).

print_aux_assumptions([(T^~S)/V | Rest], M, true) :- !,
    print_nrexp(M,T,S,V), format(' & '),
    print_aux_assumptions(Rest, M, _).

print_aux_assumptions([(T*S)/V], M, true) :- !,
    print_nmult(M,T,S,V).

print_aux_assumptions([(T*S)/V | Rest], M, true) :- !,
    print_nmult(M,T,S,V), format(' & '),
    print_aux_assumptions(Rest, M, _).

print_aux_assumptions([(T*~S)/V], M, true) :- !,
    print_nrmult(M,T,S,V).

print_aux_assumptions([(T*~S)/V | Rest], M, true) :- !,
    print_nrmult(M,T,S,V), format(' & '),
    print_aux_assumptions(Rest, M, _).

print_aux_assumptions([(e_(T,S))/V], M, true) :- !,
    print_npair(M,T,S,V).

print_aux_assumptions([(e_(T,S))/V | Rest], M, true) :- !,
    print_npair(M,T,S,V), format(' & '),
    print_aux_assumptions(Rest, M, _).

print_aux_assumptions([(T/_)|_], _, _) :-
    format('\n*** Something wrong: ~p. \n\n', [T]),
    fail.

    %%% where
    print_nexp(M,T,S,V) :-
        substitute(M,T,TT),
        format('nexp(~p,~p,~p)', [TT,S,V]).

    print_nrexp(M,T,S,V) :-
        substitute(M,T,TT),
        format('nrexp(~p,~p,~p)', [TT,S,V]).

    print_nmult(M,T,S,V) :-
        substitute(M,T,TT),
        format('nmult(~p,~p,~p)', [TT,S,V]).

    print_nrmult(M,T,S,V) :-
        substitute(M,T,TT),
        format('nrmult(~p,~p,~p)', [TT,S,V]).

    print_npair(M,T,S,V) :-
        substitute(M,T,TT),
        substitute(M,S,SS),
        format('npair(~p,~p,~p)', [TT,SS,V]).

rewrite_and_print(F # R) :- !,
    substitute_ground_exp(R,R1),
    nonstandard_subterms(R1,L),
    make_aux_vars(L,M),
    create_forall_list(M,F2),
    substitute(M,R1,R2),
    format('  (*    rule:  ~p *)\n', [R]),
    format('  (* aux.var: '), print_aux(M), format('*)\n'),
    format('  (*  result:  ~p *)\n\n', [R2]),    
    (F2 \= "" -> format('~p, ~p;\n',[F,F2]) ; format('~p;\n',[F])),
    print_aux_assumptions(M,M,Cont),
    out_rule(Cont,R2), 
    nl.

rewrite_and_print(R) :-
    substitute_ground_exp(R,R1),
    nonstandard_subterms(R1,L),
    make_aux_vars(L,M),
    create_forall_list(M,F),
    substitute(M,R1,R2),
    format('  (*    rule:  ~p *)\n', [R]),
    format('  (* aux.var: '), print_aux(M), format('*)\n'),
    format('  (*  result:  ~p *)\n\n', [R2]),
    (F \= "" -> format('forall ~p;\n',[F]) ; true),
    print_aux_assumptions(M,M,Cont),
    out_rule(Cont,R2), 
    nl.

gen_user_rules :-
    forall(ground_rule(R), rewrite_and_print(R)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% A VERY IMPORTANT EQUATION FOR BILINEAR MAPPINGS:

%tell ProVerif that e(X,Y) = e(Y,X), he does not know that!
equation_rule:-
    format('equation forall x:g1, y:g1; e(x,y) = e(y,x).\n\n').

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% CALLING TRANSFORMATION
%

main :- 
    say_hello, !,
    get_args(InFile, OutFile), !,

    % consulting the user file:
    format('Reading from file ~p.\n\n', [InFile]),
    [InFile],

    mk_stages,
    check_rules,
    out_exponents,
    make_exp_indices,
 
    tell(OutFile),
 
    gen_header(InFile),
    gen_types, nl,
    gen_fun, nl,
    out_proverif_directives, nl,
    equation_rule,
    gen_query, nl,
 
    format('clauses\n\n'),
 
    format('(***** Phase rules: *****)\n'),
    phase_rules,
    format('(***** Intruder rules: *****)\n'),
    intruder_rules,
    format('(***** Normalisation rules: *****)\n\n'),

    normalisation_rules,
    rev_normalisation_rules,
    mult_normalisation_rules,
    mult_rev_normalisation_rules,
    pairing_normalisation_rules,  

    format('(***** User rules: *****)\n\n'),
    gen_user_rules, 
    format('(***** End of User rules *****)\n'),
    format('forall x:bitstring; i(x) -> i(x).\n'),
    told,
    format('+ Output written to ~p.\n\n', [OutFile]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% AUXILIARIES FOR MAIN:
%

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

get_args(InFile,OutFile) :-
    unix(argv(Args)),
    append( _, [--, InFile,OutFile],  Args), !.

get_args(_,_) :-
    format('*** Exactly two commandline arguments needed:\n*** input filename and output filename.\n\n'),
    halt(-1).

gen_header(InFile) :-
    format('(* This file is generated automatically by protocol transformer with using types from ~p *)\n\n', 
            [InFile]).
   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% RUN
%
:- main.
:- halt.
