#!/usr/bin/swipl -q -s
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Protocol Transformer (Without 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,  query ).
:- op( 1180, fx,  proverif ).
:- op( 1150, xfx, :: ).
:- op(  200, yfx, ^ ).
:- op(  200, yfx, ^~ ).
:- op(  210, yfx, * ).
:- op(  215, yfx, *~ ).

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

% Normalization predicates: E,M,P
proverif 'pred nexp/3 elimVar,decompData'.
proverif 'pred nrexp/3 elimVar,decompData'.
proverif 'pred nmult/3 elimVar,decompData'.
proverif 'pred nrmult/3 elimVar,decompData'.
proverif 'pred npair/3 elimVar,decompData'.

proverif 'pred incr/2 elimVar,decompData'.
proverif 'pred decr/2 elimVar,decompData'.
proverif 'pred add/3 elimVar,decompData'.

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

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

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

substitute(Subst, T, S) :-
    % \+ member(T/S, Subst),
    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 ).

%
% 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, R ) :- !,
    format(' ->\n'), out_rule(R).
out_rule( _, Rule ) :-
    out_rule(Rule).

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

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
    make_ground(R),
    stage_pred(I),
    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( A, _I, J, J:A ).
    

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

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

    unifo(o).
    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]).


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

dh_id_rules :-
    num_exponents(N),
    length(L,N),
    maplist(unifo,L),
    E =.. [exp, 'x' | L],
    out_multi_stage_rule( E -> x ),
    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),
    E1 =.. [exp, 'x' | L1],
    E2 =.. [exp, 'x' | L2],
    sformat(Str, 'y~p', [A] ),
    string_to_atom(Str, Ap),
    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('nexp: x, ~p, ~p; \n', [AA,E0]),

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

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

    length(L3,N), maplist( addpn('x',A), Exponents, L3),
    E3 =.. [exp, 'x' | L3],
    E3r = E2,
    format('nexp: ~p, ~p, ~p; \n', [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('nrexp: x, ~p, ~p; \n', [AA,E0]),

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

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

    length(L3,N), maplist( addsn('x',A), Exponents, L3),
    E3 =.. [exp, 'x' | L3],
    E3r = E2,
    format('nrexp: ~p, ~p, ~p; \n', [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],
    out_multi_stage_rule( E -> x ),
    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),
    E1 =.. [mult, 'x' | L1],
    E2 =.. [mult, 'x' | L2],
    sformat(Str, 'y~p', [A] ),
    string_to_atom(Str, Ap),
    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('nmult: x, ~p, ~p; \n', [AA,E0]),

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

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

    length(L3,N), maplist( addpn('x',A), Exponents, L3),
    E3 =.. [mult, 'x' | L3],
    E3r = E2,
    format('nmult: ~p, ~p, ~p; \n', [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('nrmult: x, ~p, ~p; \n', [AA,E0]),

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

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

    length(L3,N), maplist( addsn('x',A), Exponents, L3),
    E3 =.. [mult, 'x' | L3],
    E3r = E2,
    format('nrmult: ~p, ~p, ~p; \n', [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),

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

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

    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),

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

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

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

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

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

integer_addition_rules:-

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

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

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

    format('add: x, y, z & incr: z, w  -> add: x, s(y), w;\n'),
    format('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\
        ~p:x -> ~p:s(x);\n\
        ~p:x -> ~p:p(x);\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/1 elimVar,decompData.\nnounif i~p:x.\n', [Q,Q]) ).

gen_fun :-    
    format('fun o/0.\n'),
    format('fun s/1.\n'),
    format('fun p/1.\n'),
    num_exponents(N), N1 is N+1,
    format('fun exp/~p.\n', [N1]),
    format('fun mult/~p.\n', [N1]),
    format('fun e/2.\n'),
    % Do not print the auxiliary function e_ !
    forall( ((fun F), (F \= e_/2)), format('fun ~p.\n', [F]) ).

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

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(R) :-
    substitute_ground_exp(R,R1),
    nonstandard_subterms(R1,L),
    make_aux_vars(L,M),
    substitute(M,R1,R2),
    format('  (*    rule:  ~p *)\n', [R]),
    format('  (* aux.var: '), print_aux(M), format('*)\n'),
    format('  (*  result:  ~p *)\n\n', [R2]),
    print_aux_assumptions(M,M,Cont),
    out_rule(Cont,R2), 
    nl.

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

gen_user_rules.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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 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_fun, nl,
    out_proverif_directives, nl,
    equation_rule,
    gen_query, nl,
 
    format('reduc\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('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 without using types from ~p *)\n\n', 
            [InFile]).
   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% RUN
%
:- main.
:- halt.
