(** ** Relational specification of CFG expansion *)
Section INLINING_SPEC.
Variable fenv: funenv.
Definition context_below (ctx1 ctx2: context): Prop :=
Ple (Pos.add ctx1.(dreg) ctx1.(mreg)) ctx2.(dreg).
Definition context_stack_call (ctx1 ctx2: context): Prop :=
ctx1.(mstk) >= 0 /\ ctx1.(dstk) + ctx1.(mstk) <= ctx2.(dstk).
Definition context_stack_tailcall (ctx1: context) (f: function) (ctx2: context) : Prop :=
ctx2.(dstk) = align ctx1.(dstk) (min_alignment f.(fn_stacksize)).
Section INLINING_BODY_SPEC.
Variable stacksize: Z.
Inductive tr_instr: context -> node -> instruction -> code -> Prop :=
| tr_nop: forall ctx pc c s,
c!(spc ctx pc) = Some (Inop (spc ctx s)) ->
tr_instr ctx pc (Inop s) c
| tr_op: forall ctx pc c op args res s,
Ple res ctx.(mreg) ->
c!(spc ctx pc) = Some (Iop (sop ctx op) (sregs ctx args) (sreg ctx res) (spc ctx s)) ->
tr_instr ctx pc (Iop op args res s) c
| tr_load: forall ctx pc c chunk addr args res s,
Ple res ctx.(mreg) ->
c!(spc ctx pc) = Some (Iload chunk (saddr ctx addr) (sregs ctx args) (sreg ctx res) (spc ctx s)) ->
tr_instr ctx pc (Iload chunk addr args res s) c
| tr_store: forall ctx pc c chunk addr args src s,
c!(spc ctx pc) = Some (Istore chunk (saddr ctx addr) (sregs ctx args) (sreg ctx src) (spc ctx s)) ->
tr_instr ctx pc (Istore chunk addr args src s) c
| tr_call: forall ctx pc c sg ros args res s,
Ple res ctx.(mreg) ->
c!(spc ctx pc) = Some (Icall sg (sros ctx ros) (sregs ctx args) (sreg ctx res) (spc ctx s)) ->
tr_instr ctx pc (Icall sg ros args res s) c
| tr_call_inlined:forall ctx pc sg id args res s c f pc1 ctx',
Ple res ctx.(mreg) ->
fenv!id = Some f ->
c!(spc ctx pc) = Some(Inop pc1) ->
tr_moves c pc1 (sregs ctx args) (sregs ctx' f.(fn_params)) (spc ctx' f.(fn_entrypoint)) ->
tr_funbody ctx' f c ->
ctx'.(retinfo) = Some(spc ctx s, sreg ctx res) ->
context_below ctx ctx' ->
context_stack_call ctx ctx' ->
tr_instr ctx pc (Icall sg (inr _ id) args res s) c
| tr_tailcall: forall ctx pc c sg ros args,
c!(spc ctx pc) = Some (Itailcall sg (sros ctx ros) (sregs ctx args)) ->
ctx.(retinfo) = None ->
tr_instr ctx pc (Itailcall sg ros args) c
| tr_tailcall_call: forall ctx pc c sg ros args res s,
c!(spc ctx pc) = Some (Icall sg (sros ctx ros) (sregs ctx args) res s) ->
ctx.(retinfo) = Some(s, res) ->
tr_instr ctx pc (Itailcall sg ros args) c
| tr_tailcall_inlined: forall ctx pc sg id args c f pc1 ctx',
fenv!id = Some f ->
c!(spc ctx pc) = Some(Inop pc1) ->
tr_moves c pc1 (sregs ctx args) (sregs ctx' f.(fn_params)) (spc ctx' f.(fn_entrypoint)) ->
tr_funbody ctx' f c ->
ctx'.(retinfo) = ctx.(retinfo) ->
context_below ctx ctx' ->
context_stack_tailcall ctx f ctx' ->
tr_instr ctx pc (Itailcall sg (inr _ id) args) c
| tr_builtin: forall ctx pc c ef args res s,
match res with BR r => Ple r ctx.(mreg) | _ => True end ->
c!(spc ctx pc) = Some (Ibuiltin ef (map (sbuiltinarg ctx) args) (sbuiltinres ctx res) (spc ctx s)) ->
tr_instr ctx pc (Ibuiltin ef args res s) c
| tr_cond: forall ctx pc cond args s1 s2 c,
c!(spc ctx pc) = Some (Icond cond (sregs ctx args) (spc ctx s1) (spc ctx s2)) ->
tr_instr ctx pc (Icond cond args s1 s2) c
| tr_jumptable: forall ctx pc r tbl c,
c!(spc ctx pc) = Some (Ijumptable (sreg ctx r) (List.map (spc ctx) tbl)) ->
tr_instr ctx pc (Ijumptable r tbl) c
| tr_return: forall ctx pc or c,
c!(spc ctx pc) = Some (Ireturn (option_map (sreg ctx) or)) ->
ctx.(retinfo) = None ->
tr_instr ctx pc (Ireturn or) c
| tr_return_inlined: forall ctx pc or c rinfo,
c!(spc ctx pc) = Some (inline_return ctx or rinfo) ->
ctx.(retinfo) = Some rinfo ->
tr_instr ctx pc (Ireturn or) c
with tr_funbody: context -> function -> code -> Prop :=
| tr_funbody_intro: forall ctx f c,
(forall r, In r f.(fn_params) -> Ple r ctx.(mreg)) ->
(forall pc i, f.(fn_code)!pc = Some i -> tr_instr ctx pc i c) ->
ctx.(mstk) = Z.max f.(fn_stacksize) 0 ->
(min_alignment f.(fn_stacksize) | ctx.(dstk)) ->
ctx.(dstk) >= 0 -> ctx.(dstk) + ctx.(mstk) <= stacksize ->
tr_funbody ctx f c.
Definition fenv_agree (fe: funenv) : Prop :=
forall id f, fe!id = Some f -> fenv!id = Some f.
Section EXPAND_INSTR.
Variable fe: funenv.
Hypothesis FE: fenv_agree fe.
Variable rec: forall fe', (size_fenv fe' < size_fenv fe)%nat -> context -> function -> mon unit.
Hypothesis rec_unchanged:
forall fe' (L: (size_fenv fe' < size_fenv fe)%nat) ctx f s x s' i pc,
rec fe' L ctx f s = R x s' i ->
Ple ctx.(dpc) s.(st_nextnode) ->
Plt pc ctx.(dpc) ->
s'.(st_code)!pc = s.(st_code)!pc.
Remark set_instr_other:
forall pc instr s x s' i pc',
set_instr pc instr s = R x s' i ->
pc' <> pc ->
s'.(st_code)!pc' = s.(st_code)!pc'.
Remark set_instr_same:
forall pc instr s x s' i c,
set_instr pc instr s = R x s' i ->
c!(pc) = s'.(st_code)!pc ->
c!(pc) = Some instr.

(* Specifications: *)
Lemma expand_instr_unchanged:
forall ctx pc instr s x s' i pc',
expand_instr fe rec ctx pc instr s = R x s' i ->
Ple ctx.(dpc) s.(st_nextnode) ->
Plt pc' s.(st_nextnode) ->
pc' <> spc ctx pc ->
s'.(st_code)!pc' = s.(st_code)!pc'.
Lemma iter_expand_instr_unchanged:
forall ctx pc l s x s' i,
mlist_iter2 (expand_instr fe rec ctx) l s = R x s' i ->
Ple ctx.(dpc) s.(st_nextnode) ->
Plt pc s.(st_nextnode) ->
~In pc (List.map (spc ctx) (List.map (@fst _ _) l)) ->
list_norepet (List.map (@fst _ _) l) ->
s'.(st_code)!pc = s.(st_code)!pc.
Lemma expand_cfg_rec_unchanged:
forall ctx f s x s' i pc,
expand_cfg_rec fe rec ctx f s = R x s' i ->
Ple ctx.(dpc) s.(st_nextnode) ->
Plt pc ctx.(dpc) ->
s'.(st_code)!pc = s.(st_code)!pc.