Section Composition.
Variables L1 L2 L3: semantics.
Variable get_mem1: state L1 -> mem.
Variable get_mem2: state L2 -> mem.
Variable get_mem3: state L3 -> mem.
eapply list_val_inject_lessdef_compose; eauto.
- (* symbols *)
intros. transitivity (Senv.public_symbol (symbolenv L2) id);
[eapply Extfsim_public_preserved|eapply Injfsim_public_preserved]; eauto.
Qed.
(* Lemma injection_extension_composition: forward_injection L1 L2 get_mem1 get_mem2 -> forward_extension L2 L3 get_mem2 get_mem3 -> forward_injection L1 L3 get_mem1 get_mem3.  Lemma extension_injection_composition: @fsim_properties_ext L1 L2 get_mem1 get_mem2 -> @fsim_properties_inj L2 L3 get_mem2 get_mem3 -> @fsim_properties_inj L1 L3 get_mem1 get_mem3. eapply list_lessdef_val_inject_compose; eauto. - (* symbols *)
intros. transitivity (Senv.public_symbol (symbolenv L2) id);
[eapply Injfsim_public_preserved|eapply Extfsim_public_preserved]; eauto.
Qed.
(* Lemma extension_injection_composition: forward_extension L1 L2 get_mem1 get_mem2 -> forward_injection L2 L3 get_mem2 get_mem3 -> forward_injection L1 L3 get_mem1 get_mem3.  Lemma compose_inject_incr: forall f1 f2 f1' f2', inject_incr f1 f1' -> inject_incr f2 f2' -> inject_incr (compose_meminj f1 f2) (compose_meminj f1' f2').  Lemma inject_trace_strong_trans: forall f12 f23 t1 t2 t3, inject_trace_strong f12 t1 t2 -> inject_trace_strong f23 t2 t3 -> inject_trace_strong (compose_meminj f12 f23) t1 t3.  Lemma inject_trace_compose: forall f12 f23 t1 t2 t3, inject_trace f12 t1 t2 -> inject_trace f23 t2 t3 -> inject_trace (compose_meminj f12 f23) t1 t3.   Lemma injection_injection_composition: @fsim_properties_inj L1 L2 get_mem1 get_mem2-> @fsim_properties_inj L2 L3 get_mem2 get_mem3 -> @fsim_properties_inj L1 L3 get_mem1 get_mem3.  intros SIM12 SIM23. set (index13:= (Injindex SIM23 * Injindex SIM12)%type). set (order13:=  (lex_ord (clos_trans _ (Injorder SIM23)) (Injorder SIM12))). set (match_states13:= (fun (i: _ ) f (s1: state L1) (s3: state L3) => exists s2 f12 f23,  Injmatch_states SIM12 (snd i) f12 s1 s2 /\ Injmatch_states SIM23 (fst i) f23 s2 s3 /\ f = compose_meminj f12 f23)). eapply Build_fsim_properties_inj with (Injindex:= index13) (Injorder:=order13) (Injmatch_states:=match_states13). - (* well founded *)
apply wf_lex_ord. apply wf_clos_trans.
eapply Injfsim_order_wf; eauto. eapply Injfsim_order_wf; eauto.
- (* inject. *)
intros ? ? ? ? [s2' [f12 [f23 [MATCH12 [MATCH23 INJCOMP]]]]].
subst.
eapply Mem.inject_compose; [eapply SIM12| eapply SIM23]; eauto.
- (* Full *)
intros ? ? ? s3 [s2 [f12 [f23 [MATCH12 [MATCH23 INJCOMP]]]]] b VALID.
subst f.
eapply SIM12 in VALID; try (exact MATCH12).
destruct (f12 b) eqn:F12; auto. destruct p.
unfold compose_meminj; rewrite F12.
assert (VALID2 : Mem.valid_block (get_mem2 s2) b0).
{ eapply SIM12; eauto. }
eapply SIM23 in VALID2; try (exact MATCH23).
intros HH. apply VALID2. destruct (f23 b0); inversion HH; auto.
destruct p. inversion HH.
- (* initial states *)
intros. exploit (Injfsim_match_initial_states SIM12); eauto.
intros [i [ f12 [s2 [A B]]]].
exploit (Injfsim_match_initial_states SIM23); eauto. intros [i' [f23 [s3 [C D]]]].
exists (i', i); exists (compose_meminj f12 f23); exists s3; split; auto. exists s2; auto.
exists f12, f23; repeat (split; auto).
- (* final states *)
intros. destruct H as [s3 [ f12 [ f23 [A [B C]]]]].
eapply (Injfsim_match_final_states SIM23); eauto.
eapply (Injfsim_match_final_states SIM12); eauto.
- (* simulation *)
intros. destruct H0 as [s3 [f12 [f23 [A [B C]]]]].
destruct i as [i2 i1]; simpl in *.
exploit (Injfsim_simulation' SIM12); eauto.
intros [[i1' [s3'[ f' [t' [D [E [F G]]]]]]] | [i1' [f' [D [E [F G]]]]]].
+ (* L2 makes one or several steps. *)
exploit Injsimulation_plus; eauto.
intros [[i2' [f'' [s2' [t'' [P [? [? ?]]]]]]] | [i2' [f'' [P [Q [R SS]]]]]].
* (* L3 makes one or several steps *)
exists (i2', i1').
exists s2'; exists (compose_meminj f' f''), t''. repeat (split; auto).
exists s3', f', f''; repeat (split; auto).
subst f.
eapply compose_inject_incr; eauto.
eapply inject_trace_strong_trans; eauto.
* (* L3 makes no step *)
exists (i2', i1'); exists s2; exists (compose_meminj f' f''), t'. repeat (split; auto).
right; split. subst t'; apply star_refl. left. auto.
exists s3', f', f''; auto.
repeat (split;auto).
subst f.
eapply compose_inject_incr; eauto.
subst t'; inv G. constructor.
+ (* L2 makes no step *)
exists (i2, i1'); exists s2; exists (compose_meminj f' f23), t. repeat (split; auto).
right; split. subst t; apply star_refl. right. auto.
exists s3, f', f23; auto.
subst f.
eapply compose_inject_incr; eauto.
subst t; constructor.
- (*simulation at_external*)
unfold simulation_atx_inj; intros.
destruct H1 as [s3 [f12 [f23 [A [B C]]]]]. destruct i as [i2 i1]; simpl in *.
exploit (Injsim_simulation_atx SIM12); eauto.
intros [i1' [s2'[ f12' [t2' [? [? [? ?]]]]]]].
eapply Injsim_atx in H; eauto.
destruct H as (?&?&?).
exploit (Injsim_simulation_atx SIM23); eauto.
intros [i2' [s3'[ f23' [t3' [? [? [? ?]]]]]]].
exists (i2', i1'); exists s3'; exists (compose_meminj f12' f23'), t3'. repeat (split; auto).
+ exists s2',f12', f23'; auto.
+ subst; eapply compose_inject_incr; auto.
+ subst; eapply inject_trace_strong_trans ; eauto.
- (*match_states preserves at_external *)
unfold preserves_atx_inj; intros.
destruct H as (?&?&?&?&?&?).
eapply Injsim_atx in H0; try eapply H.
destruct H0 as (?&?&?).
eapply Injsim_atx in H0; eauto.
destruct H0 as (args'&Hatx&Hinj).
exists args'.
split; eauto.

Lemma inject_list_compose_meminj:
forall lv1 lv2 lv3 j12 j23 j13,
Val.inject_list j12 lv1 lv2 ->
Val.inject_list j23 lv2 lv3 ->
j13 = compose_meminj j12 j23 ->
Val.inject_list j13 lv1 lv3.