

% a version of the interpreter with small-step semantics for animation with ProB's XTL interface

% specifying the start state:
start(state(PC,In)) :- 
   PC=0, init_env([],In).

% specifying the next state relation:
trans(Opcode,state(PC,In),NewState) :-
    % print('> '),print(PC), print('   '), print(In), %%
	instr(PC,Opcode,Size), !,
	NextPC is PC+Size,
	% print('  --> '),print(Opcode),nl, %%
	ex_opcode(Opcode,NextPC,In,NewState).

% specifying properties that appear in the State Properties view:
prop(state(PC,_),'='('PC',PC)).
prop(state(_,env(Stack,_)),'='('STACK',Stack)).
prop(state(_,env(_,Local)),'='(LocalVar,Val)) :- member(VarNr/Val,Local),tools:ajoin(['VAR_',VarNr],LocalVar).

animation_image(_,_) :- fail.
animation_function_result(state(PC,env(Stack,Local)),
      [((0,0),'PC'),((0,1),PC)|Rest]) :-
      get_stack_anim_func(Local,1,1,Env),
      append(Env,SAF,Rest),
      get_stack_anim_func(Stack,-1,-1,SAF).

get_stack_anim_func([],_,_,[]).
get_stack_anim_func([H|T],Idx,Incr,[((Idx,0),Content0),((Idx,1),Content1)|AF]) :- 
  (H=Content0/Content1 -> true
   ; Content1=H, Content0='S>'),
  I1 is Idx+Incr,
  get_stack_anim_func(T,I1,Incr,AF).


% ------------------------------------

interpreter_loop(PC,Out,state(PC,Out)). % just execute a single step; do not execute program in one go

ex_opcode(nop,NextPC,In,Out) :- interpreter_loop(NextPC,In,Out).
ex_opcode(return,_,In,state(finished,In)).
ex_opcode(ireturn,_,In,state(result(Ret),Out)) :- pop(In,Ret,Out),
   print('Return value: '), print(Ret),nl.
ex_opcode(goto(Label),_,In,Out) :-
    interpreter_loop(Label,In,Out).
ex_opcode(istore(Var),NextPC,In,Out) :-
    pop(In,Top,In2),
    store(In2,Var,Top,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(pop,NextPC,In,Out) :-
    pop(In,_Discarded,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(iload(Var),NextPC,In,Out) :-
    load(Var,In,Val),
    push(In,Val,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(iconst(Const),NextPC,In,Out) :-
    push(In,Const,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(if(OP,Label),NextPC,In,Out) :-
    pop(In,RHSVAL1,In1),
    pop(In1,RHSVAL2,In2),
    if_then_else(OP,RHSVAL1,RHSVAL2,Label,NextPC,In2,Out).
ex_opcode(if1(OP,Cst,Label),NextPC,In,Out) :-
    pop(In,RHSVAL1,In2),
    if_then_else(OP,RHSVAL1,Cst,Label,NextPC,In2,Out).
ex_opcode(iop(OP),NextPC,In,Out) :-
    pop(In,RHSVAL1,In1),
    pop(In1,RHSVAL2,In2),
    ex_op(OP,RHSVAL1,RHSVAL2,Res),
    push(In2,Res,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(iinc(Var,Offset),NextPC,In,Out) :-
    load(Var,In,Val),
    ex_op(+,Val,Offset,Res),
    store(In,Var,Res,Out2),
    interpreter_loop(NextPC,Out2,Out).
ex_opcode(println(Var),NextPC,In,Out) :-  /* artificial opcode for debugging */
    load(Var,In,Val),
    print('Value of variable '), print(Var), print(' = '), print(Val),nl,
    interpreter_loop(NextPC,In,Out).
    
if_then_else(OP,Arg1,Arg2,TrueLabel,_FalseLabel,In,Out) :-
    test_op(OP,Arg1,Arg2), %print(test_op(OP,Arg1,Arg2)),nl,
    interpreter_loop(TrueLabel,In,Out).
if_then_else(OP,Arg1,Arg2,_TrueLabel,FalseLabel,In,Out) :-
    false_op(OP,Arg1,Arg2),
    interpreter_loop(FalseLabel,In,Out).

ex_op(OP,A1,A2,R) :- ex_op_concrete(OP,A1,A2,R).
ex_op_concrete(*,A1,A2,R) :- R is A1 * A2.
ex_op_concrete(+,A1,A2,R) :- R is A1 + A2.
ex_op_concrete(-,A1,A2,R) :- R is A1 - A2.
ex_op_concrete(mod,A1,A2,R) :- R is A2 mod A1.

test_op(OP,A1,A2) :- test_op_concrete(OP,A1,A2).
test_op_concrete(=,A1,A2) :- A1 = A2.
test_op_concrete('!=',A1,A2) :- A1 \= A2.
test_op_concrete(<,A1,A2) :- A1 < A2.
test_op_concrete(>,A1,A2) :- A1 > A2.
test_op_concrete(<=,A1,A2) :- A1 =< A2.
test_op_concrete(>=,A1,A2) :- A1 >= A2.

false_op(OP,A1,A2) :- false_op_concrete(OP,A1,A2).
false_op_concrete(=,A1,A2) :- A1 \= A2.
false_op_concrete('!=',A1,A2) :- A1 = A2.
false_op_concrete(<,A1,A2) :- A1 >= A2.
false_op_concrete(>,A1,A2) :- A1 =< A2.
false_op_concrete(<=,A1,A2) :- A1 > A2.
false_op_concrete(>=,A1,A2) :- A1 < A2.

/* --------------------------------------- */
/*  Generic Environment Related Predicates */
/* --------------------------------------- */

init_env(Parameters,env([],Parameters)). % Parameters should be [0/Para1,...]

pop(env([X|S],Vars),Top,R) :- !, Top=X, R=env(S,Vars).
pop(E,_,_) :- add_error(xtl,'Could not pop from stack: ',E),fail.

push(env(S,Vars),X,env([X|S],Vars)).

store(env(Stack,Vars),Key,Value,env(Stack,NVars)) :-
    update(Vars,Key,Value,NVars).
    
load(Key,env(_S,Env),Val) :- lookup(Key,Env,Val).

/* --------------------------------------- */

/* update(OldEnv, VariableName, NewValue, NewEnv) */
update([],Key,Value,[Key/Value]).
update([Key/_Value2|T],Key,Value,[Key/Value|T]).
update([Key2/Value2|T],Key,Value,Res) :- Key2 \= Key,
   (Key @< Key2 -> Res = [Key/Value, Key2/Value2|T]
              ;  (Res = [Key2/Value2|BT], update(T,Key,Value,BT))
   ).

/* lookup(VariableName, Env, CurrentValue) */
lookup(Key,[],Value) :- add_error(xtl,'Could not find variable:',Key),
     Value=undefined.  /* This can be due to parameters which are passed as variables  0..n-1 */
lookup(Key,[Key/Value|_T],Value).
lookup(Key,[Key2/_Value2|T],Value) :-
   (Key @> Key2 -> lookup(Key,T,Value) ; 
     Key \= Key2 -> add_error(xtl,'Could not find variable:',Key), Value=undefined).

% --------------------------------

/* Prolog Encoding of Byte Code */
instr(0,iconst(2),1).
instr(1,istore(1),1).
instr(2,iconst(5),1).
instr(3,istore(2),1).
instr(4,iload(2),1).
instr(5,istore(3),1).
instr(6,iconst(1),1).
instr(7,istore(4),2).
instr(9,iload(3),1).
instr(10,if1(<=,0,25),3).
instr(13,iinc(3,-1),3).
instr(16,iload(4),2).
instr(18,iload(1),1).
instr(19,iop(*),1).
instr(20,istore(4),2).
instr(22,goto(9),3).
instr(25,println(4),2).
instr(27,return,1).

% -----------------------------------




