Module CompilerCorrectness.
Definition globvar_eq {V1 V2: Type} (v1:globvar V1) (v2:globvar V2) :=
match v1, v2 with
| mkglobvar _ init1 readonly1 volatile1,
mkglobvar _ init2 readonly2 volatile2 =>
init1 = init2 /\ readonly1 =  readonly2 /\ volatile1 = volatile2
end.
Inductive external_description :=
| extern_func: signature -> external_description
| extern_globvar: external_description.
Definition entryPts_ok  {F1 V1 F2 V2:Type}
(P1 : AST.program F1 V1)    (P2 : AST.program F2 V2)
(ExternIdents: list (ident * external_description))
(entryPts: list (val * val * signature)): Prop :=
forall e d, In (e,d) ExternIdents ->
exists b, Genv.find_symbol  (Genv.globalenv P1) e = Some b /\
Genv.find_symbol (Genv.globalenv P2) e = Some b /\
match d with
extern_func sig => In (Vptr b Int.zero,Vptr b Int.zero, sig) entryPts /\
exists f1, exists f2, Genv.find_funct_ptr (Genv.globalenv P1) b = Some f1 /\
Genv.find_funct_ptr (Genv.globalenv P2) b = Some f2
| extern_globvar  => exists v1, exists v2,
Genv.find_var_info (Genv.globalenv P1) b = Some v1 /\
Genv.find_var_info (Genv.globalenv P2) b = Some v2 /\
globvar_eq v1 v2
end.
Definition entryPts_inject_ok {F1 V1 F2 V2:Type}
(P1 : AST.program F1 V1) (P2 : AST.program F2 V2) (j: meminj)
(ExternIdents : list (ident * external_description))
(entryPts: list (val * val * signature)): Prop :=
forall e d, In (e,d) ExternIdents ->
exists b1, exists b2, Genv.find_symbol (Genv.globalenv P1) e = Some b1 /\
Genv.find_symbol (Genv.globalenv P2) e = Some b2 /\
j b1 = Some(b2,0) /\
match d with
| extern_func sig =>
In (Vptr b1 Int.zero,Vptr b2 Int.zero, sig) entryPts /\
exists f1, exists f2,
Genv.find_funct_ptr (Genv.globalenv P1) b1 = Some f1 /\
Genv.find_funct_ptr (Genv.globalenv P2) b2 = Some f2
| extern_globvar =>
exists v1, exists v2,
Genv.find_var_info  (Genv.globalenv P1) b1 = Some v1 /\
Genv.find_var_info  (Genv.globalenv P2) b2 = Some v2 /\
globvar_eq v1 v2
end.
Definition externvars_ok  {F1 V1:Type}  (P1 : AST.program F1 V1)
(ExternIdents : list (ident * external_description)) : Prop :=
forall b v, Genv.find_var_info  (Genv.globalenv P1) b = Some v ->
exists e, Genv.find_symbol (Genv.globalenv P1) e = Some b /\
In (e,extern_globvar) ExternIdents.
Definition GenvHyp {F1 V1 F2 V2}
(P1 : AST.program F1 V1) (P2 : AST.program F2 V2): Prop :=
(forall id : ident,
Genv.find_symbol (Genv.globalenv P2) id =
Genv.find_symbol (Genv.globalenv P1) id) /\
(forall b : block,
block_is_volatile (Genv.globalenv P2) b =
block_is_volatile (Genv.globalenv P1) b).
Inductive core_correctness
(I: forall F C V
(Sem : CoreSemantics (Genv.t F V) C mem)
(P : AST.program F V),Prop)
(ExternIdents: list (ident * external_description))
entrypoints :
forall (F1 C1 V1 F2 C2 V2:Type)
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2), Type :=
corec_eq : forall  (F1 C1 V1 F2 C2 V2:Type)
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2)
(Eq_init : forall m1 : mem,
Genv.init_mem P1 = Some m1 -> Genv.init_mem P2 = Some m1)
(*(Eq_init: forall m1, initial_mem Sem1  (Genv.globalenv P1)  m1 P1.(prog_defs)-> (exists m2, initial_mem Sem2  (Genv.globalenv P2)  m2 P2.(prog_defs) /\ m1 = m2))*)
(ePts_ok: entryPts_ok P1 P2 ExternIdents entrypoints)
(R:Forward_simulation_eq.Forward_simulation_equals Sem1 Sem2
(Genv.globalenv P1) (Genv.globalenv P2) entrypoints),
prog_main P1 = prog_main P2 ->
(*HERE IS THE INJECTION OF THE GENV-ASSUMPTIONS INTO THE PROOF:*)
GenvHyp P1 P2 ->
I _ _ _  Sem1 P1 -> I _ _ _  Sem2 P2 ->
core_correctness I ExternIdents entrypoints F1 C1 V1 F2 C2 V2 Sem1 Sem2 P1 P2
| corec_ext: forall (F1 C1 V1 F2 C2 V2:Type)
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2)
(Extends_init : forall m1 : mem, Genv.init_mem P1 = Some m1 ->
exists m2, Genv.init_mem P2 = Some m2 /\ Mem.extends m1 m2)
(*(Extends_init: forall m1, initial_mem Sem1  (Genv.globalenv P1)  m1 P1.(prog_defs)-> (exists m2, initial_mem Sem2  (Genv.globalenv P2)  m2 P2.(prog_defs) /\ Mem.extends m1 m2))*)
(ePts_ok: entryPts_ok P1 P2 ExternIdents entrypoints)
(R:Forward_simulation_ext.Forward_simulation_extends Sem1 Sem2
(Genv.globalenv P1) (Genv.globalenv P2) entrypoints),
prog_main P1 = prog_main P2 ->
(*HERE IS THE INJECTION OF THE GENV-ASSUMPTIONS INTO THE PROOF:*)
GenvHyp P1 P2 ->
I _ _ _ Sem1 P1 -> I _ _ _ Sem2 P2 ->
core_correctness I ExternIdents entrypoints F1 C1 V1 F2 C2 V2 Sem1 Sem2 P1 P2
| corec_inj : forall (F1 C1 V1 F2 C2 V2:Type)
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2)
jInit
(Inj_init : forall m1 : mem, Genv.init_mem P1 = Some m1 ->
exists m2, Genv.init_mem P2 = Some m2 /\ Mem.inject jInit m1 m2)
(*(Inj_init: forall m1, initial_mem Sem1  (Genv.globalenv P1)  m1 P1.(prog_defs)-> (exists m2, initial_mem Sem2  (Genv.globalenv P2)  m2 P2.(prog_defs) /\ Mem.inject jInit m1 m2))*)
(ePts_ok: entryPts_inject_ok P1 P2 jInit ExternIdents entrypoints)
(preserves_globals: meminj_preserves_globals (Genv.globalenv P1) jInit)
(R:Forward_simulation_inj.Forward_simulation_inject Sem1 Sem2
(Genv.globalenv P1) (Genv.globalenv P2) entrypoints),
prog_main P1 = prog_main P2 ->
(*HERE IS THE INJECTION OF THE GENV-ASSUMPTIONS INTO THE PROOF:*)
GenvHyp P1 P2 ->
externvars_ok P1 ExternIdents ->
I _ _ _ Sem1 P1 -> I _ _ _ Sem2 P2 ->
core_correctness I ExternIdents entrypoints F1 C1 V1 F2 C2 V2 Sem1 Sem2 P1 P2
| corec_trans: forall  (F1 C1 V1 F2 C2 V2 F3 C3 V3:Type)
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(Sem3 : CoreSemantics (Genv.t F3 V3) C3 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2)
(P3 : AST.program F3 V3),
core_correctness I ExternIdents entrypoints F1 C1 V1 F2 C2 V2 Sem1 Sem2 P1 P2 ->
core_correctness I ExternIdents entrypoints F2 C2 V2 F3 C3 V3 Sem2 Sem3 P2 P3 ->
core_correctness I ExternIdents entrypoints F1 C1 V1 F3 C3 V3 Sem1 Sem3 P1 P3.

(* Specifications: *)
Lemma corec_I: forall {F1 C1 V1 F2 C2 V2}
(Sem1 : CoreSemantics (Genv.t F1 V1) C1 mem)
(Sem2 : CoreSemantics (Genv.t F2 V2) C2 mem)
(P1 : AST.program F1 V1)
(P2 : AST.program F2 V2)  ExternIdents I entrypoints,
core_correctness I ExternIdents entrypoints F1 C1 V1 F2 C2 V2 Sem1 Sem2 P1 P2 ->
I _ _ _ Sem1 P1 /\ I _ _ _ Sem2 P2.