Section ClightSelfSim.
Context (ge: genv).
(*Separate state and memory*)
Definition core:= state. (* this contains a useless memory*)
Definition state_to_memcore st:=
(st, get_mem st).
Definition memcore_to_state:= set_mem .
(* Doesn't exactly hold. Lemma state_to_memcore_correct: forall c m, state_to_memcore (memcore_to_state c m) = (c,m). *)
Definition memcore_to_state_correct: forall s c m,
state_to_memcore  s = (c,m) -> s = memcore_to_state c m:=
CC_core_CC_state_2.
Definition expr_inject (e e': expr):= e=e'.
(* Function expr_inject (j:meminj) (e e': expr):Prop := match e, e' with | Econst_int i t, Econst_int i' t' => i=i' /\ t=t' | Econst_float f t, Econst_float f' t' => f=f' /\ t=t' | Econst_single f t, Econst_single f' t' => f=f' /\ t=t' | Econst_long i t, Econst_long i' t' => i=i' /\ t=t' | Evar x t, Evar x' t' => x=x' /\ t=t' | Etempvar x t, Etempvar x' t' => x=x' /\ t=t' | Ederef a t, Ederef a' t' => expr_inject j a a' /\ t=t' | Eaddrof a t, Eaddrof a' t' => expr_inject j a a' /\ t=t' | Eunop f a t, Eunop f' a' t' => expr_inject j a a' /\ t=t' /\ f=f' | Ebinop f a1 a2 t, Ebinop f' a1' a2' t' => expr_inject j a1 a1' /\ expr_inject j a2 a2' /\ t=t' /\ f=f' | Ecast a t, Ecast a' t' => expr_inject j a a' /\ t=t' | Efield a x t, Efield a' x' t' => expr_inject j a a' /\ t=t' /\ x=x' | Esizeof t1 t2, Esizeof t1' t2' => t1=t1' /\ t2=t2' | Ealignof t1 t2, Ealignof t1' t2' => t1=t1' /\ t2=t2' | _, _ => False end.  Lemma expr_inject_type_of j: forall e e' (E: expr_inject j e e'), typeof e = typeof e'. *)
Definition exprlist_inject (*j*):= Forall2 (expr_inject (*j*)).
(* Function stmt_inject (j:meminj) (st st':statement) {struct st}:Prop := match st, st' with | Sskip, Skip => True | Sassign e1 e2, Sassign e1' e2' => expr_inject j e1 e1' /\ expr_inject j e2 e2' | Sset x e, Sset x' e' => x=x' /\ expr_inject j e e' | Scall optid e es, Scall optid' e' es' => match optid, optid' with None, None => True | Some x, Some x' => x=x' | _, _ => False end /\ expr_inject j e e' /\ exprlist_inject j es es' | Sbuiltin optid ef typs es, Sbuiltin optid' ef' typs' es' => match optid, optid' with None, None => True | Some x, Some x' => x=x' | _, _ => False end /\ ef=ef' /\ typs=typs' /\ exprlist_inject j es es' | Ssequence s1 s2, Ssequence s1' s2' => stmt_inject j s1 s1' /\ stmt_inject j s2 s2' | Sifthenelse e s1 s2, Sifthenelse e' s1' s2' => expr_inject j e e' /\ stmt_inject j s1 s1' /\ stmt_inject j s2 s2' | Sloop s1 s2, Sloop s1' s2' => stmt_inject j s1 s1' /\ stmt_inject j s2 s2' | Sbreak, Sbreak => True | Scontinue, Scontinue => True | Sreturn opte, Sreturn opte' => match opte, opte' with | None, None => True | Some e, Some e' => expr_inject j e e' | _, _ => False end | Sswitch e ls, Sswitch e' ls' => expr_inject j e e' /\ lstmts_inject j ls ls' | Slabel l s, Slabel l' s' => l=l' /\ stmt_inject j s s' | Sgoto l, Sgoto l' => l=l' | _, _ => False end with lstmts_inject (j:meminj) (st st':labeled_statements) {struct st}:Prop := match st, st' with | LSnil, LSnil => True | LScons optz s ls, LScons optz' s' ls' => match optz, optz' with None, None => True | Some z, Some z' => z=z' | _, _ => False end /\ stmt_inject j s s' /\ lstmts_inject j ls ls' | _, _ => False end. (*Check stmt_inject_ind.*)
Functional Scheme stmt_inject_indX := Induction for stmt_inject Sort Prop
with lstmts_inject_indX := Induction for lstmts_inject Sort Prop.
Check lstmts_inject_indX.
*)
Definition stmt_inject (st st':statement):=st=st'.
Definition lstmts_inject (st st':labeled_statements):=st=st'.
Definition env_inject (j:meminj) (e e': env):Prop :=
forall x, match PTree.get x e, PTree.get x e' with
None, None => True
| Some (b,t), Some (b',t') => t=t' /\ j b = Some(b',0)
| _, _ => False
end.
Definition tenv_inject (j:meminj) (e e': temp_env):Prop :=
forall x, match PTree.get x e, PTree.get x e' with
None, None => True
| Some v, Some v' => Val.inject j v v'
| _, _ => False
end.
Function cont_inject (j:meminj) (k k':cont):Prop :=
match k, k' with
Kstop, Kstop => True
| Kseq s kk, Kseq s' kk' => stmt_inject (*j*) s s' /\ cont_inject j kk kk'
| Kloop1 s1 s2 kk, Kloop1 s1' s2' kk' => stmt_inject (*j*) s1 s1' /\
stmt_inject (*j*) s2 s2' /\ cont_inject j kk kk'
| Kloop2 s1 s2 kk, Kloop2 s1' s2' kk' => stmt_inject (*j*) s1 s1' /\
stmt_inject (*j*) s2 s2' /\ cont_inject j kk kk'
| Kswitch kk, Kswitch kk' => cont_inject j kk kk'
| Kcall optid f e te kk, Kcall optid' f' e' te' kk' =>
match optid, optid' with
None, None => True
| Some x, Some x' => x=x'
| _, _ => False
end /\ f=f'/\ env_inject j e e' /\ tenv_inject j te te' /\ cont_inject j kk kk'
| _, _ => False
end.
(* Definition code_inject (j:meminj) (st st': state): Prop:= match st, st' with | State f s k e lenv m, State f' s' k' e' lenv' m' => f=f' /\ stmt_inject (*j*) s s' /\ cont_inject j k k' /\ env_inject j e e' /\ tenv_inject j lenv lenv' /\ match_mem j m m' | Callstate fd args k m, Callstate fd' args' k' m' => fd=fd' /\ Forall2 (Val.inject j) args args' /\ cont_inject j k k' /\ match_mem j m m' | Returnstate r k m, Returnstate r' k' m' => Val.inject j r r' /\ cont_inject j k k' /\ match_mem j m m' | _, _ => False end. *)
Definition code_inject (j:meminj) (st st': core): Prop:=
match st, st' with
| CC_core_State f s k e lenv, CC_core_State f' s' k' e' lenv' =>
f=f' /\ stmt_inject (*j*) s s' /\ cont_inject j k k' /\
env_inject j e e' /\ tenv_inject j lenv lenv'
| CC_core_Callstate fd args k, CC_core_Callstate fd' args' k' =>
fd=fd' /\ Forall2 (Val.inject j) args args' /\
cont_inject j k k'
| CC_core_Returnstate r k, CC_core_Returnstate r' k' => Val.inject j r r' /\ cont_inject j k k'
| _, _ => False
end.
Definition myP g e te m (a:expr) (v:val):Prop :=
forall (j:meminj) (a':expr) (e':env) (te':temp_env) (m':mem),
expr_inject (*j*) a a' -> env_inject j e e' -> tenv_inject j te te' ->
Mem.inject j m m' -> exists v', eval_expr g e' te' m' a' v' /\ Val.inject j v v'.
Definition myQ g e te m (a : expr) (b : block) (i : Integers.Int.int):Prop :=
forall (j:meminj) (a':expr) (e':env) (te':temp_env) (m':mem),
expr_inject (*j*) a a' -> env_inject j e e' -> tenv_inject j te te' ->
Mem.inject j m m' -> exists b' i', eval_lvalue g e' te' m' a' b' i' /\ Val.inject j (Vptr b i) (Vptr b' i').
Definition block_inject j (z z': block * Z * Z) :=
match z, z' with (b,lo,hi), (b',lo',hi') =>
exists d, j b = Some (b',d) /\ lo'=lo+d /\ hi'=hi+d
end.
Definition blocks_inject j (l l' : list (block * Z * Z)) := Forall2 (block_inject j) l l'.
(*Proof ok but Qed fails Lemma find_label_inject: forall s (*s'*) lbl k, match find_label lbl s k with | None => forall j (*(SI: stmt_inject (*j*) s s')*) k' (CI: cont_inject j k k'), find_label lbl s(*'*) k' = None | Some(s1, k1) => forall j (*(SI: stmt_inject (*j*) s s')*) k' (CI: cont_inject j k k'), exists (*s1'*) k1', find_label lbl s(*'*) k' = Some(s1(*'*), k1') /\ cont_inject j k1 k1' (*/\ stmt_inject (*j*) s1 s1'*)
end
with find_label_ls_inject:
forall ls lbl k,
match find_label_ls lbl ls k with
| None => forall ls' j (LLSI: lstmts_inject (*j*) ls ls') k' (CI: cont_inject j k k'),
find_label_ls lbl ls' k' = None
| Some(s1, k1) => forall ls' j (LLSI: lstmts_inject (*j*) ls ls') k' (CI: cont_inject j k k'),
exists (*s1'*) k1',
find_label_ls lbl ls' k' = Some(s1(*'*), k1') /\
cont_inject j k1 k1' (*/\ stmt_inject (*j*) s1 s1'*)
end.

Lemma perm_freelist_B b ofs k p:
forall (l : list (block * Z * Z)) m m' (FL: Mem.free_list m l = Some m')
(HH: forall bb lo hi, In (bb,lo,hi) l -> bb<>b \/ ofs<lo \/ hi<=ofs)
(P:Mem.perm m b ofs k p),
Mem.perm m' b ofs k p.