(** * 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 CminorSel 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 (List.map (@BA reg) rl) (BR 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] holds if the graph [c], starting at node [ns], contains instructions that compute the truth value of the CminorSel 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 CminorSel 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.
(** [tr_exitexpr c map pr a ns nexits] holds if the graph [c], starting at node [ns], contains instructions that compute the exit number of the CminorSel exit expression [a] and terminate on the node corresponding to this exit number according to the mapping [nexits]. *)
Inductive tr_exitexpr (c: code):
mapping -> exitexpr -> node -> list node -> Prop :=
| tr_XEcond: forall map x n nexits,
nth_error nexits x = Some n ->
tr_exitexpr c map (XEexit x) n nexits
| tr_XEjumptable: forall map a tbl ns nexits n1 r tbl',
tr_jumptable nexits tbl tbl' ->
tr_expr c map nil a ns n1 r None ->
c!n1 = Some (Ijumptable r tbl') ->
tr_exitexpr c map (XEjumptable a tbl) ns nexits
| tr_XEcondition: forall map a1 a2 a3 ns nexits n2 n3,
tr_condition c map nil a1 ns n2 n3 ->
tr_exitexpr c map a2 n2 nexits ->
tr_exitexpr c map a3 n3 nexits ->
tr_exitexpr c map (XEcondition a1 a2 a3) ns nexits
| tr_XElet: forall map a b ns nexits r n1,
~reg_in_map map r ->
tr_expr c map nil a ns n1 r None ->
tr_exitexpr c (add_letvar map r) b n1 nexits ->
tr_exitexpr c map (XElet a b) ns nexits.
(** Auxiliary for the compilation of [builtin] statements. *)
Inductive tr_builtin_res: mapping -> builtin_res ident -> builtin_res reg -> Prop :=
| tr_builtin_res_var: forall map id r,
map.(map_vars)!id = Some r ->
tr_builtin_res map (BR id) (BR r)
| tr_builtin_res_none: forall map,
tr_builtin_res map BR_none BR_none
| tr_builtin_res_fresh: forall map r,
~reg_in_map map r ->
tr_builtin_res map BR_none (BR r).
(** [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 res ef args ns nd nexits ngoto nret rret res' n1 rargs,
tr_exprlist c map nil (exprlist_of_expr_list (params_of_builtin_args args)) ns n1 rargs ->
c!n1 = Some (Ibuiltin ef (convert_builtin_args args rargs) res' nd) ->
tr_builtin_res map res res' ->
tr_stmt c map (Sbuiltin res ef args) 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 ns nd nexits ngoto nret rret,
tr_exitexpr c map a ns nexits ->
tr_stmt c map (Sswitch a) 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 transl_expr_charact:
forall a map rd nd s ns s' pr INCR
(TR: transl_expr map a rd nd s = OK ns s' INCR)
(WF: map_valid map s)
(OK: target_reg_ok map pr a rd)
(VALID: regs_valid pr s)
(VALID2: reg_valid rd s),
tr_expr s'.(st_code) map pr a ns nd rd None
with transl_exprlist_charact:
forall al map rl nd s ns s' pr INCR
(TR: transl_exprlist map al rl nd s = OK ns s' INCR)
(WF: map_valid map s)
(OK: target_regs_ok map pr al rl)
(VALID1: regs_valid pr s)
(VALID2: regs_valid rl s),
tr_exprlist s'.(st_code) map pr al ns nd rl
with transl_condexpr_charact:
forall a map ntrue nfalse s ns s' pr INCR
(TR: transl_condexpr map a ntrue nfalse s = OK ns s' INCR)
(WF: map_valid map s)
(VALID: regs_valid pr s),
tr_condition s'.(st_code) map pr a ns ntrue nfalse.