(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Abstract specification of RTL generation *)
(** In this module, we define inductive predicates that specify the translations from Cminor to RTL performed by the functions in module [RTLgen].  We then show that these functions satisfy these relational specifications.  The relational specifications will then be used instead of the actual functions to show semantic equivalence between the source Cminor code and the the generated RTL code (see module [RTLgenproof]). *)
Require Errors.
(** * Reasoning about monadic computations *)
(** The tactics below simplify hypotheses of the form [f ... = OK x s i] where [f] is a monadic computation.  For instance, the hypothesis [(do x <- a; b) s = OK y s' i] will generate the additional witnesses [x], [s1], [i1], [i'] and the additional hypotheses [a s = OK x s1 i1] and [b x s1 = OK y s' i'], reflecting the fact that both monadic computations [a] and [b] succeeded. *)
Remark bind_inversion:
forall (A B: Type) (f: mon A) (g: A -> mon B)
(y: B) (s1 s3: state) (i: state_incr s1 s3),
bind f g s1 = OK y s3 i ->
exists x, exists s2, exists i1, exists i2,
f s1 = OK x s2 i1 /\ g x s2 = OK y s3 i2.
Remark bind2_inversion:
forall (A B C: Type) (f: mon (A*B)) (g: A -> B -> mon C)
(z: C) (s1 s3: state) (i: state_incr s1 s3),
bind2 f g s1 = OK z s3 i ->
exists x, exists y, exists s2, exists i1, exists i2,
f s1 = OK (x, y) s2 i1 /\ g x y s2 = OK z s3 i2.
Ltac monadInv1 H :=
match type of H with
| (OK _ _ _ = OK _ _ _) =>
inversion H; clear H; try subst
| (Error _ _ = OK _ _ _) =>
discriminate
| (ret _ _ = OK _ _ _) =>
inversion H; clear H; try subst
| (error _ _ = OK _ _ _) =>
discriminate
| (bind ?F ?G ?S = OK ?X ?S' ?I) =>
let x := fresh "x" in (
let s := fresh "s" in (
let i1 := fresh "INCR" in (
let i2 := fresh "INCR" in (
let EQ1 := fresh "EQ" in (
let EQ2 := fresh "EQ" in (
destruct (bind_inversion _ _ F G X S S' I H) as [x [s [i1 [i2 [EQ1 EQ2]]]]];
clear H;
try (monadInv1 EQ2)))))))
| (bind2 ?F ?G ?S = OK ?X ?S' ?I) =>
let x1 := fresh "x" in (
let x2 := fresh "x" in (
let s := fresh "s" in (
let i1 := fresh "INCR" in (
let i2 := fresh "INCR" in (
let EQ1 := fresh "EQ" in (
let EQ2 := fresh "EQ" in (
destruct (bind2_inversion _ _ _ F G X S S' I H) as [x1 [x2 [s [i1 [i2 [EQ1 EQ2]]]]]];
clear H;
try (monadInv1 EQ2))))))))
end.
Ltac monadInv H :=
match type of H with
| (ret _ _ = OK _ _ _) => monadInv1 H
| (error _ _ = OK _ _ _) => monadInv1 H
| (bind ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
| (bind2 ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
| (?F _ _ _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
| (?F _ = OK _ _ _) =>
((progress simpl in H) || unfold F in H); monadInv1 H
end.
(** * Monotonicity properties of the state *)
Hint Resolve state_incr_refl: rtlg.
Hint Resolve instr_at_incr: rtlg.
(** The following tactic saturates the hypotheses with [state_incr] properties that follow by transitivity from the known hypotheses. *)
Ltac saturateTrans :=
match goal with
| H1: state_incr ?x ?y, H2: state_incr ?y ?z |- _ =>
match goal with
| H: state_incr x z |- _  =>
fail 1
| _ =>
let i := fresh "INCR" in
(generalize (state_incr_trans x y z H1 H2); intro i;
saturateTrans)
end
| _ => idtac
end.
(** * Validity and freshness of registers *)
(** An RTL pseudo-register is valid in a given state if it was created earlier, that is, it is less than the next fresh register of the state. Otherwise, the pseudo-register is said to be fresh. *)
Definition reg_valid (r: reg) (s: state) : Prop :=
Plt r s.(st_nextreg).
Definition reg_fresh (r: reg) (s: state) : Prop :=
~(Plt r s.(st_nextreg)).
Hint Resolve valid_fresh_absurd: rtlg.
Hint Resolve valid_fresh_different: rtlg.
Hint Resolve reg_valid_incr: rtlg.
Hint Resolve reg_fresh_decr: rtlg.
(** Validity of a list of registers. *)
Definition regs_valid (rl: list reg) (s: state) : Prop :=
forall r, In r rl -> reg_valid r s.
Hint Resolve regs_valid_nil: rtlg.
Hint Resolve regs_valid_incr: rtlg.
(** A register is ``in'' a mapping if it is associated with a Cminor local or let-bound variable. *)
Definition reg_in_map (m: mapping) (r: reg) : Prop :=
(exists id, m.(map_vars)!id = Some r) \/ In r m.(map_letvars).
(** A compilation environment (mapping) is valid in a given state if the registers associated with Cminor local variables and let-bound variables are valid in the state. *)
Definition map_valid (m: mapping) (s: state) : Prop :=
forall r, reg_in_map m r -> reg_valid r s.
Hint Resolve map_valid_incr: rtlg.
(** * Properties of basic operations over the state *)
(** Properties of [add_instr]. *)
Hint Resolve add_instr_at: rtlg.
(** Properties of [update_instr]. *)
Hint Resolve update_instr_at: rtlg.
(** Properties of [new_reg]. *)
Hint Resolve new_reg_valid: rtlg.
Hint Resolve new_reg_fresh: rtlg.
Hint Resolve new_reg_not_in_map: rtlg.
(** * Properties of operations over compilation environments *)
(** Properties of [find_var]. *)
Hint Resolve find_var_in_map: rtlg.
Hint Resolve find_var_valid: rtlg.
(** Properties of [find_letvar]. *)
Hint Resolve find_letvar_in_map: rtlg.
Hint Resolve find_letvar_valid: rtlg.
(** Properties of [add_var]. *)
(** Properties of [add_letvar]. *)
(** * Properties of [alloc_reg] and [alloc_regs] *)
Hint Resolve alloc_reg_valid: rtlg.
Hint Resolve alloc_regs_valid: rtlg.
Hint Resolve alloc_optreg_valid: rtlg.
(** A register is an adequate target for holding the value of an expression if - either the register is associated with a Cminor let-bound variable or a Cminor local variable; - or the register is not associated with any Cminor variable and does not belong to the preserved set [pr]. *)
Inductive target_reg_ok (map: mapping) (pr: list reg): expr -> reg -> Prop :=
| target_reg_var:
forall id r,
map.(map_vars)!id = Some r ->
target_reg_ok map pr (Evar id) r
| target_reg_letvar:
forall idx r,
nth_error map.(map_letvars) idx = Some r ->
target_reg_ok map pr (Eletvar idx) r
| target_reg_other:
forall a r,
~(reg_in_map map r) -> ~In r pr ->
target_reg_ok map pr a r.
Inductive target_regs_ok (map: mapping) (pr: list reg): exprlist -> list reg -> Prop :=
| target_regs_nil:
target_regs_ok map pr Enil nil
| target_regs_cons: forall a1 al r1 rl,
target_reg_ok map pr a1 r1 ->
target_regs_ok map (r1 :: pr) al rl ->
target_regs_ok map pr (Econs a1 al) (r1 :: rl).
Hint Resolve new_reg_target_ok alloc_reg_target_ok
alloc_regs_target_ok: rtlg.
(** The following predicate is a variant of [target_reg_ok] used to characterize registers that are adequate for holding the return value of a function. *)
Inductive return_reg_ok: state -> mapping -> option reg -> Prop :=
| return_reg_ok_none:
forall s map,
return_reg_ok s map None
| return_reg_ok_some:
forall s map r,
~(reg_in_map map r) -> reg_valid r s ->
return_reg_ok s map (Some r).
Hint Resolve return_reg_ok_incr: rtlg.
(** * Relational specification of the translation *)
(** We now define inductive predicates that characterize the fact that the control-flow graph produced by compilation of a Cminor function contains sub-graphs that correspond to the translation of each Cminor expression or statement in the original code. *)
(** [tr_move c ns rs nd rd] holds if the graph [c], between nodes [ns] and [nd], contains instructions that move the value of register [rs] to register [rd]. *)
Inductive tr_move (c: code):
node -> reg -> node -> reg -> Prop :=
| tr_move_0: forall n r,
tr_move c n r n r
| tr_move_1: forall ns rs nd rd,
c!ns = Some (Iop Omove (rs :: nil) rd nd) ->
tr_move c ns rs nd rd.
(** [reg_map_ok map r optid] characterizes the destination register for an expression: if [optid] is [None], the destination is a fresh register (not associated with any variable); if [optid] is [Some id], the destination is the register associated with local variable [id]. *)
Inductive reg_map_ok: mapping -> reg -> option ident -> Prop :=
| reg_map_ok_novar: forall map rd,
~reg_in_map map rd ->
reg_map_ok map rd None
| reg_map_ok_somevar: forall map rd id,
map.(map_vars)!id = Some rd ->
reg_map_ok map rd (Some id).
Hint Resolve reg_map_ok_novar: rtlg.
(** [tr_expr c map pr expr ns nd rd optid] holds if the graph [c], between nodes [ns] and [nd], contains instructions that compute the value of the Cminor expression [expr] and deposit this value in register [rd].  [map] is a mapping from Cminor variables to the corresponding RTL registers.  [pr] is a list of RTL registers whose values must be preserved during this computation.  All registers mentioned in [map] must also be preserved during this computation. (Exception: if [optid = Some id], the register associated with local variable [id] can be assigned, but only at the end of the expression evaluation.) To ensure this property, we demand that the result registers of the instructions appearing on the path from [ns] to [nd] are not in [pr], and moreover that they satisfy the [reg_map_ok] predicate. *)
Inductive tr_expr (c: code):
mapping -> list reg -> expr -> node -> node -> reg -> option ident -> Prop :=
| tr_Evar: forall map pr id ns nd r rd dst,
map.(map_vars)!id = Some r ->
((rd = r /\ dst = None) \/ (reg_map_ok map rd dst /\ ~In rd pr)) ->
tr_move c ns r nd rd ->
tr_expr c map pr (Evar id) ns nd rd dst
| tr_Eop: forall map pr op al ns nd rd n1 rl dst,
tr_exprlist c map pr al ns n1 rl ->
c!n1 = Some (Iop op rl rd nd) ->
reg_map_ok map rd dst -> ~In rd pr ->
tr_expr c map pr (Eop op al) ns nd rd dst
| tr_Eload: forall map pr chunk addr al ns nd rd n1 rl dst,
tr_exprlist c map pr al ns n1 rl ->
c!n1 = Some (Iload chunk addr rl rd nd) ->
reg_map_ok map rd dst -> ~In rd pr ->
tr_expr c map pr (Eload chunk addr al) ns nd rd dst
| tr_Econdition: forall map pr a ifso ifnot ns nd rd ntrue nfalse dst,
tr_condition c map pr a ns ntrue nfalse ->
tr_expr c map pr ifso ntrue nd rd dst ->
tr_expr c map pr ifnot nfalse nd rd dst ->
tr_expr c map pr (Econdition a ifso ifnot) ns nd rd dst
| tr_Elet: forall map pr b1 b2 ns nd rd n1 r dst,
~reg_in_map map r ->
tr_expr c map pr b1 ns n1 r None ->
tr_expr c (add_letvar map r) pr b2 n1 nd rd dst ->
tr_expr c map pr (Elet b1 b2) ns nd rd dst
| tr_Eletvar: forall map pr n ns nd rd r dst,
List.nth_error map.(map_letvars) n = Some r ->
((rd = r /\ dst = None) \/ (reg_map_ok map rd dst /\ ~In rd pr)) ->
tr_move c ns r nd rd ->
tr_expr c map pr (Eletvar n) ns nd rd dst
| tr_Ebuiltin: forall map pr ef al ns nd rd dst n1 rl,
tr_exprlist c map pr al ns n1 rl ->
c!n1 = Some (Ibuiltin ef rl rd nd) ->
reg_map_ok map rd dst -> ~In rd pr ->
tr_expr c map pr (Ebuiltin ef al) ns nd rd dst
| tr_Eexternal: forall map pr id sg al ns nd rd dst n1 rl,
tr_exprlist c map pr al ns n1 rl ->
c!n1 = Some (Icall sg (inr _ id) rl rd nd) ->
reg_map_ok map rd dst -> ~In rd pr ->
tr_expr c map pr (Eexternal id sg al) ns nd rd dst
(** [tr_condition c map pr a ns ntrue nfalse rd] holds if the graph [c], starting at node [ns], contains instructions that compute the truth value of the Cminor conditional expression [a] and terminate on node [ntrue] if the condition holds and on node [nfalse] otherwise. *)
with tr_condition (c: code):
mapping -> list reg -> condexpr -> node -> node -> node -> Prop :=
| tr_CEcond: forall map pr cond bl ns ntrue nfalse n1 rl,
tr_exprlist c map pr bl ns n1 rl ->
c!n1 = Some (Icond cond rl ntrue nfalse) ->
tr_condition c map pr (CEcond cond bl) ns ntrue nfalse
| tr_CEcondition: forall map pr a1 a2 a3 ns ntrue nfalse n2 n3,
tr_condition c map pr a1 ns n2 n3 ->
tr_condition c map pr a2 n2 ntrue nfalse ->
tr_condition c map pr a3 n3 ntrue nfalse ->
tr_condition c map pr (CEcondition a1 a2 a3) ns ntrue nfalse
| tr_CElet: forall map pr a b ns ntrue nfalse r n1,
~reg_in_map map r ->
tr_expr c map pr a ns n1 r None ->
tr_condition c (add_letvar map r) pr b n1 ntrue nfalse ->
tr_condition c map pr (CElet a b) ns ntrue nfalse
(** [tr_exprlist c map pr exprs ns nd rds] holds if the graph [c], between nodes [ns] and [nd], contains instructions that compute the values of the list of Cminor expression [exprlist] and deposit these values in registers [rds]. *)
with tr_exprlist (c: code):
mapping -> list reg -> exprlist -> node -> node -> list reg -> Prop :=
| tr_Enil: forall map pr n,
tr_exprlist c map pr Enil n n nil
| tr_Econs: forall map pr a1 al ns nd r1 rl n1,
tr_expr c map pr a1 ns n1 r1 None ->
tr_exprlist c map (r1 :: pr) al n1 nd rl ->
tr_exprlist c map pr (Econs a1 al) ns nd (r1 :: rl).
(** Auxiliary for the compilation of [switch] statements. *)
Definition tr_jumptable (nexits: list node) (tbl: list nat) (ttbl: list node) : Prop :=
forall v act,
list_nth_z tbl v = Some act ->
exists n, list_nth_z ttbl v = Some n /\ nth_error nexits act = Some n.
Inductive tr_switch
(c: code) (map: mapping) (r: reg) (nexits: list node):
comptree -> node -> Prop :=
| tr_switch_action: forall act n,
nth_error nexits act = Some n ->
tr_switch c map r nexits (CTaction act) n
| tr_switch_ifeq: forall key act t' n ncont nfound,
tr_switch c map r nexits t' ncont ->
nth_error nexits act = Some nfound ->
c!n = Some(Icond (Ccompimm Ceq key) (r :: nil) nfound ncont) ->
tr_switch c map r nexits (CTifeq key act t') n
| tr_switch_iflt: forall key t1 t2 n n1 n2,
tr_switch c map r nexits t1 n1 ->
tr_switch c map r nexits t2 n2 ->
c!n = Some(Icond (Ccompuimm Clt key) (r :: nil) n1 n2) ->
tr_switch c map r nexits (CTiflt key t1 t2) n
| tr_switch_jumptable: forall ofs sz tbl t n n1 n2 n3 rt ttbl,
~reg_in_map map rt -> rt <> r ->
c!n = Some(Iop (if Int.eq ofs Int.zero then Omove else Oaddimm (Int.neg ofs))
(r ::nil) rt n1) ->
c!n1 = Some(Icond (Ccompuimm Clt sz) (rt :: nil) n2 n3) ->
c!n2 = Some(Ijumptable rt ttbl) ->
tr_switch c map r nexits t n3 ->
tr_jumptable nexits tbl ttbl ->
tr_switch c map r nexits (CTjumptable ofs sz tbl t) n.
(** [tr_stmt c map stmt ns ncont nexits nret rret] holds if the graph [c], starting at node [ns], contains instructions that perform the Cminor statement [stmt].   These instructions branch to node [ncont] if the statement terminates normally, to the [n]-th node in [nexits] if the statement terminates prematurely on a [exit n] statement, and to [nret] if the statement terminates prematurely on a [return] statement.  Moreover, if the [return] statement has an argument, its value is deposited in register [rret]. *)
Inductive tr_stmt (c: code) (map: mapping):
stmt -> node -> node -> list node -> labelmap -> node -> option reg -> Prop :=
| tr_Sskip: forall ns nexits ngoto nret rret,
tr_stmt c map Sskip ns ns nexits ngoto nret rret
| tr_Sassign: forall id a ns nd nexits ngoto nret rret r,
map.(map_vars)!id = Some r ->
tr_expr c map nil a ns nd r (Some id) ->
tr_stmt c map (Sassign id a) ns nd nexits ngoto nret rret
| tr_Sstore: forall chunk addr al b ns nd nexits ngoto nret rret rd n1 rl n2,
tr_exprlist c map nil al ns n1 rl ->
tr_expr c map rl b n1 n2 rd None ->
c!n2 = Some (Istore chunk addr rl rd nd) ->
tr_stmt c map (Sstore chunk addr al b) ns nd nexits ngoto nret rret
| tr_Scall: forall optid sig b cl ns nd nexits ngoto nret rret rd n1 rf n2 rargs,
tr_expr c map nil b ns n1 rf None ->
tr_exprlist c map (rf :: nil) cl n1 n2 rargs ->
c!n2 = Some (Icall sig (inl _ rf) rargs rd nd) ->
reg_map_ok map rd optid ->
tr_stmt c map (Scall optid sig (inl _ b) cl) ns nd nexits ngoto nret rret
| tr_Scall_imm: forall optid sig id cl ns nd nexits ngoto nret rret rd n2 rargs,
tr_exprlist c map nil cl ns n2 rargs ->
c!n2 = Some (Icall sig (inr _ id) rargs rd nd) ->
reg_map_ok map rd optid ->
tr_stmt c map (Scall optid sig (inr _ id) cl) ns nd nexits ngoto nret rret
| tr_Stailcall: forall sig b cl ns nd nexits ngoto nret rret n1 rf n2 rargs,
tr_expr c map nil b ns n1 rf None ->
tr_exprlist c map (rf :: nil) cl n1 n2 rargs ->
c!n2 = Some (Itailcall sig (inl _ rf) rargs) ->
tr_stmt c map (Stailcall sig (inl _ b) cl) ns nd nexits ngoto nret rret
| tr_Stailcall_imm: forall sig id cl ns nd nexits ngoto nret rret n2 rargs,
tr_exprlist c map nil cl ns n2 rargs ->
c!n2 = Some (Itailcall sig (inr _ id) rargs) ->
tr_stmt c map (Stailcall sig (inr _ id) cl) ns nd nexits ngoto nret rret
| tr_Sbuiltin: forall optid ef al ns nd nexits ngoto nret rret rd n1 rargs,
tr_exprlist c map nil al ns n1 rargs ->
c!n1 = Some (Ibuiltin ef rargs rd nd) ->
reg_map_ok map rd optid ->
tr_stmt c map (Sbuiltin optid ef al) ns nd nexits ngoto nret rret
| tr_Sseq: forall s1 s2 ns nd nexits ngoto nret rret n,
tr_stmt c map s2 n nd nexits ngoto nret rret ->
tr_stmt c map s1 ns n nexits ngoto nret rret ->
tr_stmt c map (Sseq s1 s2) ns nd nexits ngoto nret rret
| tr_Sifthenelse: forall a strue sfalse ns nd nexits ngoto nret rret ntrue nfalse,
tr_stmt c map strue ntrue nd nexits ngoto nret rret ->
tr_stmt c map sfalse nfalse nd nexits ngoto nret rret ->
tr_condition c map nil a ns ntrue nfalse ->
tr_stmt c map (Sifthenelse a strue sfalse) ns nd nexits ngoto nret rret
| tr_Sloop: forall sbody ns nd nexits ngoto nret rret nloop nend,
tr_stmt c map sbody nloop nend nexits ngoto nret rret ->
c!ns = Some(Inop nloop) ->
c!nend = Some(Inop nloop) ->
tr_stmt c map (Sloop sbody) ns nd nexits ngoto nret rret
| tr_Sblock: forall sbody ns nd nexits ngoto nret rret,
tr_stmt c map sbody ns nd (nd :: nexits) ngoto nret rret ->
tr_stmt c map (Sblock sbody) ns nd nexits ngoto nret rret
| tr_Sexit: forall n ns nd nexits ngoto nret rret,
nth_error nexits n = Some ns ->
tr_stmt c map (Sexit n) ns nd nexits ngoto nret rret
| tr_Sswitch: forall a cases default ns nd nexits ngoto nret rret n r t,
validate_switch default cases t = true ->
tr_expr c map nil a ns n r None ->
tr_switch c map r nexits t n ->
tr_stmt c map (Sswitch a cases default) ns nd nexits ngoto nret rret
| tr_Sreturn_none: forall nret nd nexits ngoto rret,
tr_stmt c map (Sreturn None) nret nd nexits ngoto nret rret
| tr_Sreturn_some: forall a ns nd nexits ngoto nret rret,
tr_expr c map nil a ns nret rret None ->
tr_stmt c map (Sreturn (Some a)) ns nd nexits ngoto nret (Some rret)
| tr_Slabel: forall lbl s ns nd nexits ngoto nret rret n,
ngoto!lbl = Some n ->
c!n = Some (Inop ns) ->
tr_stmt c map s ns nd nexits ngoto nret rret ->
tr_stmt c map (Slabel lbl s) ns nd nexits ngoto nret rret
| tr_Sgoto: forall lbl ns nd nexits ngoto nret rret,
ngoto!lbl = Some ns ->
tr_stmt c map (Sgoto lbl) ns nd nexits ngoto nret rret.
(** [tr_function f tf] specifies the RTL function [tf] that [RTLgen.transl_function] returns.  *)
Inductive tr_function: CminorSel.function -> RTL.function -> Prop :=
| tr_function_intro:
forall f code rparams map1 s0 s1 i1 rvars map2 s2 i2 nentry ngoto nret rret orret,
add_vars init_mapping f.(CminorSel.fn_params) s0 = OK (rparams, map1) s1 i1 ->
add_vars map1 f.(CminorSel.fn_vars) s1 = OK (rvars, map2) s2 i2 ->
orret = ret_reg f.(CminorSel.fn_sig) rret ->
tr_stmt code map2 f.(CminorSel.fn_body) nentry nret nil ngoto nret orret ->
code!nret = Some(Ireturn orret) ->
tr_function f (RTL.mkfunction
f.(CminorSel.fn_sig)
rparams
f.(CminorSel.fn_stackspace)
code
nentry).
(** * Correctness proof of the translation functions *)
(** We now show that the translation functions in module [RTLgen] satisfy the specifications given above as inductive predicates. *)

Lemma tr_move_incr:
forall s1 s2, state_incr s1 s2 ->
forall ns rs nd rd,
tr_move s1.(st_code) ns rs nd rd ->
tr_move s2.(st_code) ns rs nd rd.