Require Import Coq.Numbers.BinNums.
Require Import Coq.PArith.BinPosDef.
Require Import Logic.lib.PTree.
Require Import Coq.Sets.Ensembles.
Require Import Coq.Lists.List.
Import ListNotations.

Module Type LanguageSig.
  Parameter Inline expr : Type .
  Definition context := (expr -> Prop) .
  Parameter provable : (expr -> Prop) .
  Parameter andp : (expr -> expr -> expr) .
  Parameter orp : (expr -> expr -> expr) .
  Parameter falsep : expr .
  Parameter Inline sepcon : (expr -> expr -> expr) .
  Parameter wand : (expr -> expr -> expr) .
  Parameter Inline emp : expr .
  Parameter impp : (expr -> expr -> expr) .
  Parameter iffp : (expr -> expr -> expr) .
End LanguageSig.

Module DerivedNames (Names: LanguageSig).
Include Names.
  Definition negp := (fun x : expr => impp x falsep) .
  Definition truep := (impp falsep falsep) .
  Definition multi_imp := (fun (xs : list expr) (y : expr) => fold_right impp y xs) .
  Definition iter_andp := (fun xs : list expr => fold_left andp xs truep) .
  Definition iter_sepcon := (fun xs : list expr => fold_left sepcon xs emp) .
  Definition empty_context := (Empty_set expr) .
  Definition derivable := (fun (Phi : expr -> Prop) (x : expr) => exists xs : list expr, Forall Phi xs /\ provable (multi_imp xs x)) .
  Definition derivable1 := (fun x y : expr => provable (impp x y)) .
  Definition logic_equiv := (fun x y : expr => provable (impp x y) /\ provable (impp y x)) .
End DerivedNames.

Module Type PrimitiveRuleSig (Names: LanguageSig).
Include DerivedNames (Names).
  Axiom deduction_contrapositivePP : (forall (Phi : Ensemble expr) (x y : expr), derivable (Union expr Phi (Singleton expr y)) x -> derivable (Union expr Phi (Singleton expr (negp x))) (negp y)) .
  Axiom deduction_contradiction_elim : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi (negp x) -> derivable Phi y) .
  Axiom deduction_double_negp_intros : (forall (Phi : context) (x : expr), derivable Phi x -> derivable Phi (negp (negp x))) .
  Axiom deduction_iffp_intros : (forall (Phi : Ensemble expr) (x y : expr), derivable (Union expr Phi (Singleton expr x)) y -> derivable (Union expr Phi (Singleton expr y)) x -> derivable Phi (iffp x y)) .
  Axiom deduction_iffp_elim1 : (forall (Phi : context) (x y : expr), derivable Phi (iffp x y) -> derivable (Union expr Phi (Singleton expr x)) y) .
  Axiom deduction_iffp_elim2 : (forall (Phi : context) (x y : expr), derivable Phi (iffp x y) -> derivable (Union expr Phi (Singleton expr y)) x) .
  Axiom deduction_truep_intros : (forall Phi : context, derivable Phi truep) .
  Axiom deduction_falsep_elim : (forall (Phi : context) (x : expr), derivable Phi falsep -> derivable Phi x) .
  Axiom deduction_orp_intros1 : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi (orp x y)) .
  Axiom deduction_orp_intros2 : (forall (Phi : context) (x y : expr), derivable Phi y -> derivable Phi (orp x y)) .
  Axiom deduction_orp_elim : (forall (Phi : Ensemble expr) (x y z : expr), derivable (Union expr Phi (Singleton expr x)) z -> derivable (Union expr Phi (Singleton expr y)) z -> derivable (Union expr Phi (Singleton expr (orp x y))) z) .
  Axiom deduction_andp_intros : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi y -> derivable Phi (andp x y)) .
  Axiom deduction_andp_elim1 : (forall (Phi : context) (x y : expr), derivable Phi (andp x y) -> derivable Phi x) .
  Axiom deduction_andp_elim2 : (forall (Phi : context) (x y : expr), derivable Phi (andp x y) -> derivable Phi y) .
  Axiom deduction_modus_ponens : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi (impp x y) -> derivable Phi y) .
  Axiom deduction_impp_intros : (forall (Phi : Ensemble expr) (x y : expr), derivable (Union expr Phi (Singleton expr x)) y -> derivable Phi (impp x y)) .
  Axiom derivable_finite_witnessed : (forall (Phi : context) (y : expr), derivable Phi y -> exists xs : list expr, Forall Phi xs /\ derivable (fun x : expr => In x xs) y) .
  Axiom deduction_weaken : (forall (Phi Psi : Ensemble expr) (x : expr), Included expr Phi Psi -> derivable Phi x -> derivable Psi x) .
  Axiom derivable_assum : (forall (Phi : Ensemble expr) (x : expr), Ensembles.In expr Phi x -> derivable Phi x) .
  Axiom deduction_subst : (forall (Phi Psi : context) (y : expr), (forall x : expr, Psi x -> derivable Phi x) -> derivable (Union expr Phi Psi) y -> derivable Phi y) .
  Axiom falsep_sepcon_impp : (forall x : expr, provable (impp (sepcon falsep x) falsep)) .
  Axiom orp_sepcon_impp : (forall x y z : expr, provable (impp (sepcon (orp x y) z) (orp (sepcon x z) (sepcon y z)))) .
  Axiom iter_sepcon_spec_left1 : (forall xs : list expr, provable (impp (iter_sepcon xs) (fold_left sepcon xs emp))) .
  Axiom iter_sepcon_spec_left2 : (forall xs : list expr, provable (impp (fold_left sepcon xs emp) (iter_sepcon xs))) .
  Axiom sepcon_emp1 : (forall x : expr, provable (impp (sepcon x emp) x)) .
  Axiom sepcon_emp2 : (forall x : expr, provable (impp x (sepcon x emp))) .
  Axiom wand_sepcon_adjoint : (forall x y z : expr, provable (impp (sepcon x y) z) <-> provable (impp x (wand y z))) .
  Axiom sepcon_comm_impp : (forall x y : expr, provable (impp (sepcon x y) (sepcon y x))) .
  Axiom sepcon_assoc1 : (forall x y z : expr, provable (impp (sepcon x (sepcon y z)) (sepcon (sepcon x y) z))) .
  Axiom sepcon_mono : (forall x1 x2 y1 y2 : expr, provable (impp x1 x2) -> provable (impp y1 y2) -> provable (impp (sepcon x1 y1) (sepcon x2 y2))) .
  Axiom iter_andp_spec_left : (forall xs : list expr, provable (iffp (iter_andp xs) (fold_left andp xs truep))) .
  Axiom contrapositivePP : (forall x y : expr, provable (impp (impp y x) (impp (negp x) (negp y)))) .
  Axiom contradiction_elim1 : (forall x y : expr, provable (impp (negp x) (impp x y))) .
  Axiom double_negp_intros : (forall x : expr, provable (impp x (negp (negp x)))) .
  Axiom iffp_intros : (forall x y : expr, provable (impp (impp x y) (impp (impp y x) (iffp x y)))) .
  Axiom iffp_elim1 : (forall x y : expr, provable (impp (iffp x y) (impp x y))) .
  Axiom iffp_elim2 : (forall x y : expr, provable (impp (iffp x y) (impp y x))) .
  Axiom truep_intros : (provable truep) .
  Axiom falsep_elim : (forall x : expr, provable (impp falsep x)) .
  Axiom orp_intros1 : (forall x y : expr, provable (impp x (orp x y))) .
  Axiom orp_intros2 : (forall x y : expr, provable (impp y (orp x y))) .
  Axiom orp_elim : (forall x y z : expr, provable (impp (impp x z) (impp (impp y z) (impp (orp x y) z)))) .
  Axiom andp_intros : (forall x y : expr, provable (impp x (impp y (andp x y)))) .
  Axiom andp_elim1 : (forall x y : expr, provable (impp (andp x y) x)) .
  Axiom andp_elim2 : (forall x y : expr, provable (impp (andp x y) y)) .
  Axiom modus_ponens : (forall x y : expr, provable (impp x y) -> provable x -> provable y) .
  Axiom axiom1 : (forall x y : expr, provable (impp x (impp y x))) .
  Axiom axiom2 : (forall x y z : expr, provable (impp (impp x (impp y z)) (impp (impp x y) (impp x z)))) .
End PrimitiveRuleSig.

Module Type LogicTheoremSig (Names: LanguageSig) (Rules: PrimitiveRuleSig Names).
Include Rules.
Parameter Inline tree_pos : Type .
  Axiom logic_equiv_derivable1 : (forall x y : expr, logic_equiv x y <-> derivable1 x y /\ derivable1 y x) .
  Axiom provable_derivable : (forall x : expr, provable x <-> derivable empty_context x) .
  Axiom logic_equiv_impp : (forall x1 x2 y1 y2 : expr, logic_equiv x1 x2 -> logic_equiv y1 y2 -> logic_equiv (impp x1 y1) (impp x2 y2)) .
  Axiom logic_equiv_refl : (forall x : expr, logic_equiv x x) .
  Axiom logic_equiv_symm : (forall x y : expr, logic_equiv x y -> logic_equiv y x) .
  Axiom logic_equiv_trans : (forall x y z : expr, logic_equiv x y -> logic_equiv y z -> logic_equiv x z) .
  Axiom sepcon_emp_left : (forall x : expr, derivable1 (sepcon x emp) x) .
  Axiom sepcon_emp_right : (forall x : expr, derivable1 x (sepcon x emp)) .
  Axiom derivable1_wand_sepcon_adjoint : (forall x y z : expr, derivable1 (sepcon x y) z <-> derivable1 x (wand y z)) .
  Axiom derivable1_sepcon_comm : (forall x y : expr, derivable1 (sepcon x y) (sepcon y x)) .
  Axiom derivable1_sepcon_assoc1 : (forall x y z : expr, derivable1 (sepcon x (sepcon y z)) (sepcon (sepcon x y) z)) .
  Axiom derivable1_sepcon_mono : (forall x1 x2 y1 y2 : expr, derivable1 x1 x2 -> derivable1 y1 y2 -> derivable1 (sepcon x1 y1) (sepcon x2 y2)) .
  Axiom derivable1_refl : (forall x : expr, derivable1 x x) .
  Axiom derivable1_trans : (forall x y z : expr, derivable1 x y -> derivable1 y z -> derivable1 x z) .
  Axiom provable_impp_refl : (forall x : expr, provable (impp x x)) .
  Axiom provable_impp_refl' : (forall x y : expr, x = y -> provable (impp x y)) .
  Axiom provable_impp_arg_switch : (forall x y z : expr, provable (impp (impp x (impp y z)) (impp y (impp x z)))) .
  Axiom provable_impp_trans : (forall x y z : expr, provable (impp (impp x y) (impp (impp y z) (impp x z)))) .
  Axiom provable_multi_imp_shrink : (forall (xs : list expr) (x y : expr), provable (impp (impp x (multi_imp xs (impp x y))) (multi_imp xs (impp x y)))) .
  Axiom provable_multi_imp_arg_switch1 : (forall (xs : list expr) (x y : expr), provable (impp (impp x (multi_imp xs y)) (multi_imp xs (impp x y)))) .
  Axiom provable_multi_imp_arg_switch2 : (forall (xs : list expr) (x y : expr), provable (impp (multi_imp xs (impp x y)) (impp x (multi_imp xs y)))) .
  Axiom provable_add_multi_imp_left_head : (forall (xs1 xs2 : list expr) (y : expr), provable (impp (multi_imp xs2 y) (multi_imp (xs1 ++ xs2) y))) .
  Axiom provable_add_multi_imp_left_tail : (forall (xs1 xs2 : list expr) (y : expr), provable (impp (multi_imp xs1 y) (multi_imp (xs1 ++ xs2) y))) .
  Axiom provable_multi_imp_modus_ponens : (forall (xs : list expr) (y z : expr), provable (impp (multi_imp xs y) (impp (multi_imp xs (impp y z)) (multi_imp xs z)))) .
  Axiom provable_multi_imp_weaken : (forall (xs : list expr) (x y : expr), provable (impp x y) -> provable (impp (multi_imp xs x) (multi_imp xs y))) .
  Axiom provable_impp_refl_instance : (RelationClasses.Reflexive (fun x y : expr => provable (impp x y))) .
  Axiom deduction_impp_elim : (forall (Phi : context) (x y : expr), derivable Phi (impp x y) -> derivable (Union expr Phi (Singleton expr x)) y) .
  Axiom deduction_theorem : (forall (Phi : context) (x y : expr), derivable (Union expr Phi (Singleton expr x)) y <-> derivable Phi (impp x y)) .
  Axiom deduction_theorem_multi_imp : (forall (Phi : context) (xs : list expr) (y : expr), derivable (Union expr Phi (fun x : expr => In x xs)) y <-> derivable Phi (multi_imp xs y)) .
  Axiom derivable_impp_refl : (forall (Phi : context) (x : expr), derivable Phi (impp x x)) .
  Axiom deduction_left_impp_intros : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi (impp y x)) .
  Axiom derivable_modus_ponens : (forall (Phi : context) (x y : expr), derivable Phi (impp x (impp (impp x y) y))) .
  Axiom deduction_impp_trans : (forall (Phi : context) (x y z : expr), derivable Phi (impp x y) -> derivable Phi (impp y z) -> derivable Phi (impp x z)) .
  Axiom deduction_impp_arg_switch : (forall (Phi : context) (x y z : expr), derivable Phi (impp x (impp y z)) -> derivable Phi (impp y (impp x z))) .
  Axiom provable_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) Basics.impl) provable) .
  Axiom impp_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) impp) .
  Axiom derivable_proper_impp : (Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful (fun x y : expr => provable (impp x y)) Basics.impl)) derivable) .
  Axiom negp_fold_unfold : (forall x : expr, provable (iffp (negp x) (impp x falsep))) .
  Axiom deduction_negp_fold : (forall (Phi : Ensemble expr) (x : expr), derivable (Union expr Phi (Singleton expr x)) falsep -> derivable Phi (negp x)) .
  Axiom deduction_negp_unfold : (forall (Phi : context) (x : expr), derivable Phi (negp x) -> derivable (Union expr Phi (Singleton expr x)) falsep) .
  Axiom demorgan_orp_negp : (forall x y : expr, provable (impp (orp (negp x) (negp y)) (negp (andp x y)))) .
  Axiom demorgan_negp_orp : (forall x y : expr, provable (iffp (negp (orp x y)) (andp (negp x) (negp y)))) .
  Axiom provable_truep : (provable truep) .
  Axiom andp_comm : (forall x y : expr, provable (iffp (andp x y) (andp y x))) .
  Axiom andp_assoc : (forall x y z : expr, provable (iffp (andp (andp x y) z) (andp x (andp y z)))) .
  Axiom orp_comm : (forall x y : expr, provable (iffp (orp x y) (orp y x))) .
  Axiom orp_assoc : (forall x y z : expr, provable (iffp (orp (orp x y) z) (orp x (orp y z)))) .
  Axiom andp_dup : (forall x : expr, provable (iffp (andp x x) x)) .
  Axiom orp_dup : (forall x : expr, provable (iffp (orp x x) x)) .
  Axiom impp_curry : (forall x y z : expr, provable (impp (impp x (impp y z)) (impp (andp x y) z))) .
  Axiom impp_uncurry : (forall x y z : expr, provable (impp (impp (andp x y) z) (impp x (impp y z)))) .
  Axiom solve_impp_trans : (forall x y z : expr, provable (impp x y) -> provable (impp y z) -> provable (impp x z)) .
  Axiom solve_andp_intros : (forall x y : expr, provable x -> provable y -> provable (andp x y)) .
  Axiom solve_andp_elim1 : (forall x y : expr, provable (andp x y) -> provable x) .
  Axiom solve_andp_elim2 : (forall x y : expr, provable (andp x y) -> provable y) .
  Axiom negp_fold : (forall x : expr, provable (impp (impp x falsep) (negp x))) .
  Axiom negp_unfold : (forall x : expr, provable (impp (negp x) (impp x falsep))) .
  Axiom andp_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) andp) .
  Axiom orp_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) orp) .
  Axiom negp_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (fun x y : expr => provable (impp x y))) negp) .
  Axiom provable_iffp_equiv : (RelationClasses.Equivalence (fun x y : expr => provable (iffp x y))) .
  Axiom provable_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) iff) provable) .
  Axiom impp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) impp) .
  Axiom andp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) andp) .
  Axiom orp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) orp) .
  Axiom iffp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) iffp) .
  Axiom negp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y))) negp) .
  Axiom derivable_proper_iffp : (Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful (fun x y : expr => provable (iffp x y)) iff)) derivable) .
  Axiom iter_andp_spec_right : (forall xs : list expr, provable (iffp (iter_andp xs) (fold_right andp truep xs))) .
  Axiom iter_andp_unfold_left_assoc : (forall xs : list expr, provable (iffp (iter_andp xs) match xs with
                                                                                | []%list => truep
                                                                                | x :: xs0 => (fix f (xs1 : list expr) (x0 : expr) {struct xs1} : expr := match xs1 with
                                                                                | []%list => x0
                                                                                | x1 :: xs2 => f xs2 (andp x0 x1)
                                                                                end) xs0 x
                                                                                end)) .
  Axiom iter_andp_unfold_right_assoc : (forall xs : list expr, provable (iffp (iter_andp xs) ((fix f (xs0 : list expr) : expr := match xs0 with
                                                                                | []%list => truep
                                                                                | [x]%list => x
                                                                                | x :: (_ :: _) as xs1 => andp x (f xs1)
                                                                                end) xs))) .
  Axiom falsep_sepcon : (forall x : expr, provable (iffp (sepcon falsep x) falsep)) .
  Axiom provable_wand_sepcon_modus_ponens1 : (forall x y : expr, provable (impp (sepcon (wand x y) x) y)) .
  Axiom wand_andp : (forall x y z : expr, provable (iffp (wand x (andp y z)) (andp (wand x y) (wand x z)))) .
  Axiom sepcon_falsep : (forall x : expr, provable (iffp (sepcon x falsep) falsep)) .
  Axiom provable_wand_sepcon_modus_ponens2 : (forall x y : expr, provable (impp (sepcon x (wand x y)) y)) .
  Axiom wand_mono : (forall x1 x2 y1 y2 : expr, provable (impp x2 x1) -> provable (impp y1 y2) -> provable (impp (wand x1 y1) (wand x2 y2))) .
  Axiom orp_wand : (forall x y z : expr, provable (iffp (wand (orp x y) z) (andp (wand x z) (wand y z)))) .
  Axiom sepcon_iter_sepcon : (forall xs ys : list expr, provable (iffp (sepcon (iter_sepcon xs) (iter_sepcon ys)) (iter_sepcon (xs ++ ys)))) .
  Axiom cancel_ready : (forall x y : expr, provable (impp (sepcon x emp) y) -> provable (impp x y)) .
  Axiom cancel_one_succeed : (forall u x y z : expr, provable (impp (sepcon x y) z) -> provable (impp (sepcon (sepcon u x) y) (sepcon u z))) .
  Axiom cancel_one_giveup : (forall x y z w v : expr, provable (impp (sepcon x (sepcon y z)) (sepcon w v)) -> provable (impp (sepcon (sepcon y x) z) (sepcon w v))) .
  Axiom cancel_rev : (forall x y z w : expr, provable (impp (sepcon (sepcon y x) z) w) -> provable (impp (sepcon x (sepcon y z)) w)) .
  Axiom cancel_finish : (forall x : expr, provable (impp (sepcon x emp) x)) .
  Axiom iter_sepcon_unfold_right_assoc : (forall xs : list expr, provable (iffp (iter_sepcon xs) ((fix f (xs0 : list expr) : expr := match xs0 with
                                                                                | []%list => emp
                                                                                | [x]%list => x
                                                                                | x :: (_ :: _) as xs1 => sepcon x (f xs1)
                                                                                end) xs))) .
  Axiom iter_sepcon_unfold_left_assoc : (forall xs : list expr, provable (iffp (iter_sepcon xs) match xs with
                                                                                | []%list => emp
                                                                                | x :: xs0 => (fix f (xs1 : list expr) (x0 : expr) {struct xs1} : expr := match xs1 with
                                                                                | []%list => x0
                                                                                | x1 :: xs2 => f xs2 (sepcon x0 x1)
                                                                                end) xs0 x
                                                                                end)) .
  Axiom sepcon_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) sepcon) .
  Axiom wand_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) wand) .
  Axiom sepcon_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) sepcon) .
  Axiom wand_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) wand) .
  Axiom expr_deep : Set .
  Axiom impp_deep : (expr_deep -> expr_deep -> expr_deep) .
  Axiom sepcon_deep : (expr_deep -> expr_deep -> expr_deep) .
  Axiom emp_deep : expr_deep .
  Axiom varp_deep : (nat -> expr_deep) .
  Axiom var_pos : (expr -> option positive -> tree_pos) .
  Axiom sepcon_pos : (tree_pos -> tree_pos -> tree_pos) .
  Axiom cancel_mark : (expr_deep -> expr_deep -> tree_pos -> tree_pos -> tree_pos * tree_pos) .
  Axiom cancel_different : (tree_pos -> tree_pos -> expr) .
  Axiom cancel_same : (tree_pos -> tree_pos -> Prop) .
  Axiom restore : (tree_pos -> tree_pos -> expr) .
  Axiom cancel_sound : (forall tep teq : tree_pos, cancel_same tep teq -> provable (cancel_different tep teq) -> provable (restore tep teq)) .
  Axiom impp_proper_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv (Morphisms.respectful logic_equiv logic_equiv)) impp) .
  Axiom sepcon_proper_logic_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv (Morphisms.respectful logic_equiv logic_equiv)) sepcon) .
  Axiom provable_proper_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv iff) provable) .
  Axiom logic_equiv_refl_instance : (RelationClasses.Reflexive logic_equiv) .
  Axiom logic_equiv_symm_instance : (RelationClasses.Symmetric logic_equiv) .
  Axiom logic_equiv_trans_instance : (RelationClasses.Transitive logic_equiv) .
  Axiom sepcon_comm_logic_equiv : (forall x y : expr, logic_equiv (sepcon x y) (sepcon y x)) .
  Axiom sepcon_assoc_logic_equiv : (forall x y z : expr, logic_equiv (sepcon x (sepcon y z)) (sepcon (sepcon x y) z)) .
  Axiom sepcon_emp_logic_equiv : (forall x : expr, logic_equiv (sepcon x emp) x) .
  Existing Instance provable_impp_refl_instance .
  Existing Instance provable_proper_impp .
  Existing Instance impp_proper_impp .
  Existing Instance derivable_proper_impp .
  Existing Instance andp_proper_impp .
  Existing Instance orp_proper_impp .
  Existing Instance negp_proper_impp .
  Existing Instance provable_iffp_equiv .
  Existing Instance provable_proper_iffp .
  Existing Instance impp_proper_iffp .
  Existing Instance andp_proper_iffp .
  Existing Instance orp_proper_iffp .
  Existing Instance iffp_proper_iffp .
  Existing Instance negp_proper_iffp .
  Existing Instance derivable_proper_iffp .
  Existing Instance sepcon_proper_impp .
  Existing Instance wand_proper_impp .
  Existing Instance sepcon_proper_iffp .
  Existing Instance wand_proper_iffp .
  Existing Instance impp_proper_equiv .
  Existing Instance sepcon_proper_logic_equiv .
  Existing Instance provable_proper_equiv .
  Existing Instance logic_equiv_refl_instance .
  Existing Instance logic_equiv_symm_instance .
  Existing Instance logic_equiv_trans_instance .
End LogicTheoremSig.

Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.ProofTheory.BasicDeduction.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.ProofTheory.RewriteClass.
Require Import Logic.MinimumLogic.ProofTheory.TheoryOfJudgement.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.DeMorgan.
Require Import Logic.PropositionalLogic.ProofTheory.GodelDummett.
Require Import Logic.PropositionalLogic.ProofTheory.Classical.
Require Import Logic.PropositionalLogic.ProofTheory.RewriteClass.
Require Import Logic.PropositionalLogic.ProofTheory.ProofTheoryPatterns.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfIteratedConnectives.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfClassicalAxioms.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfPropositionalConnectives.
Require Import Logic.MetaLogicInj.Syntax.
Require Import Logic.MetaLogicInj.ProofTheory.ProofRules.
Require Import Logic.SeparationLogic.Syntax.
Require Import Logic.SeparationLogic.ProofTheory.SeparationLogic.
Require Import Logic.SeparationLogic.ProofTheory.RewriteClass.
Require Import Logic.SeparationLogic.ProofTheory.DerivedRules.
Require Import Logic.SeparationLogic.ProofTheory.TheoryOfCancel.
Require Import Logic.SeparationLogic.ProofTheory.TheoryOfSeparationAxioms.
Require Import Logic.SeparationLogic.ProofTheory.IterSepcon.
Require Import Logic.SeparationLogic.ProofTheory.Corable.
Require Import Logic.SeparationLogic.ProofTheory.Deduction.
Require Import Logic.GeneralLogic.ProofTheory.BasicLogicEquiv.

Module LogicTheorem (Names: LanguageSig) (Rules: PrimitiveRuleSig Names) <: LogicTheoremSig Names Rules.
Include Rules.
  Instance L : Language := (Build_Language expr) .
  Instance andpL : (AndLanguage L) := (Build_AndLanguage L andp) .
  Instance orpL : (OrLanguage L) := (Build_OrLanguage L orp) .
  Instance falsepL : (FalseLanguage L) := (Build_FalseLanguage L falsep) .
  Instance sepconL : (SepconLanguage L) := (Build_SepconLanguage L sepcon) .
  Instance wandL : (WandLanguage L) := (Build_WandLanguage L wand) .
  Instance empL : (EmpLanguage L) := (Build_EmpLanguage L emp) .
  Instance minL : (MinimumLanguage L) := (Build_MinimumLanguage L impp) .
  Instance iffpL : (IffLanguage L) := (Build_IffLanguage L iffp) .
  Instance negpL : (NegLanguage L) := (Build_NegLanguage L negp) .
  Instance truepL : (TrueLanguage L) := (Build_TrueLanguage L truep) .
  Instance iter_andp_L : (IterAndLanguage L) := (Build_IterAndLanguage L iter_andp) .
  Instance iter_sepcon_L : (IterSepconLanguage L) := (Build_IterSepconLanguage L iter_sepcon) .
  Instance GammaP : (Provable L) := (Build_Provable L provable) .
  Instance GammaD : (Derivable L) := (Build_Derivable L derivable) .
  Instance GammaD1 : (Derivable1 L) := (Build_Derivable1 L derivable1) .
  Instance GammaE : (LogicEquiv L) := (Build_LogicEquiv L logic_equiv) .
  Instance minAX : (MinimumAxiomatization L GammaP) := (Build_MinimumAxiomatization L minL GammaP modus_ponens axiom1 axiom2) .
  Instance andpAX : (AndAxiomatization L GammaP) := (Build_AndAxiomatization L minL andpL GammaP andp_intros andp_elim1 andp_elim2) .
  Instance orpAX : (OrAxiomatization L GammaP) := (Build_OrAxiomatization L minL orpL GammaP orp_intros1 orp_intros2 orp_elim) .
  Instance falsepAX : (FalseAxiomatization L GammaP) := (Build_FalseAxiomatization L minL falsepL GammaP falsep_elim) .
  Instance truepAX : (TrueAxiomatization L GammaP) := (Build_TrueAxiomatization L truepL GammaP truep_intros) .
  Instance iffpAX : (IffAxiomatization L GammaP) := (Build_IffAxiomatization L minL iffpL GammaP iffp_intros iffp_elim1 iffp_elim2) .
  Instance inegpAX : (IntuitionisticNegAxiomatization L GammaP) := (Build_IntuitionisticNegAxiomatization L minL negpL GammaP contrapositivePP contradiction_elim1 double_negp_intros) .
  Instance iter_andp_AXL : (IterAndAxiomatization_left L GammaP) := (Build_IterAndAxiomatization_left L truepL andpL iffpL iter_andp_L GammaP iter_andp_spec_left) .
  Instance sepconAX : (SepconAxiomatization L GammaP) := (Build_SepconAxiomatization L minL sepconL GammaP sepcon_comm_impp sepcon_assoc1 sepcon_mono) .
  Instance wandAX : (WandAxiomatization L GammaP) := (Build_WandAxiomatization L minL sepconL wandL GammaP wand_sepcon_adjoint) .
  Instance empAX : (EmpAxiomatization L GammaP) := (Build_EmpAxiomatization L minL sepconL empL GammaP sepcon_emp1 sepcon_emp2) .
  Instance iter_sepcon_AXL : (IterSepconAxiomatization_left L GammaP) := (Build_IterSepconAxiomatization_left L minL sepconL empL iter_sepcon_L GammaP iter_sepcon_spec_left1 iter_sepcon_spec_left2) .
  Instance sepcon_orp_AX : (SepconOrAxiomatization L GammaP) := (Build_SepconOrAxiomatization L minL orpL sepconL GammaP orp_sepcon_impp) .
  Instance sepcon_falsep_AX : (SepconFalseAxiomatization L GammaP) := (Build_SepconFalseAxiomatization L minL falsepL sepconL GammaP falsep_sepcon_impp) .
  Instance sepconAX_weak : (SepconAxiomatization_weak L GammaP) := (Build_SepconAxiomatization_weak L minL sepconL GammaP sepcon_comm_impp sepcon_assoc1) .
  Instance bSC : (BasicSequentCalculus L GammaD) := (Build_BasicSequentCalculus L GammaD deduction_weaken derivable_assum deduction_subst) .
  Instance fwSC : (FiniteWitnessedSequentCalculus L GammaD) := (Build_FiniteWitnessedSequentCalculus L GammaD derivable_finite_witnessed) .
  Instance minSC : (MinimumSequentCalculus L GammaD) := (Build_MinimumSequentCalculus L minL GammaD deduction_modus_ponens deduction_impp_intros) .
  Instance andpSC : (AndSequentCalculus L GammaD) := (Build_AndSequentCalculus L andpL GammaD deduction_andp_intros deduction_andp_elim1 deduction_andp_elim2) .
  Instance orpSC : (OrSequentCalculus L GammaD) := (Build_OrSequentCalculus L orpL GammaD deduction_orp_intros1 deduction_orp_intros2 deduction_orp_elim) .
  Instance falsepSC : (FalseSequentCalculus L GammaD) := (Build_FalseSequentCalculus L falsepL GammaD deduction_falsep_elim) .
  Instance truepSC : (TrueSequentCalculus L GammaD) := (Build_TrueSequentCalculus L truepL GammaD deduction_truep_intros) .
  Instance iffpSC : (IffSequentCalculus L GammaD) := (Build_IffSequentCalculus L iffpL GammaD deduction_iffp_intros deduction_iffp_elim1 deduction_iffp_elim2) .
  Instance inegpSC : (IntuitionisticNegSequentCalculus L GammaD) := (Build_IntuitionisticNegSequentCalculus L negpL GammaD deduction_contrapositivePP deduction_contradiction_elim deduction_double_negp_intros) .
  Instance negpDef : (NegDefinition_False_Imp L) := FalseImp2Neg_Normal .
  Instance truepDef : (TrueDefinition_False_Imp L) := FalseImp2True_Normal .
  Instance iter_andp_DL : (IterAndDefinition_left L) := FoldLeftAnd2IterAnd_Normal .
  Instance iter_sepcon_DL : (IterSepconDefinition_left L) := FoldLeftSepcon2IterSepcon_Normal .
  Instance GammaDP : (DerivableProvable L GammaP GammaD) := Provable2Derivable_Normal .
  Instance GammaD1P : (Derivable1Provable L GammaP GammaD1) := Provable2Derivable1_Normal .
  Instance GammaEP : (EquivProvable L GammaP GammaE) := Provable2Equiv_Normal .
  Instance GammaPD : (ProvableDerivable L GammaP GammaD) := Axiomatization2SequentCalculus_GammaPD .
  Instance sepcon_mono_AX : (SepconMonoAxiomatization L GammaP) := TheoryOfSeparationAxioms.Adj2SepconMono .
  Instance bD : (BasicDeduction L GammaD1) := Axiomatization2Deduction_bD .
  Instance sepconD : (SepconDeduction L GammaD1) := SeparationLogic.Axiomatization2Deduction_sepconD .
  Instance wandD : (WandDeduction L GammaD1) := Axiomatization2Deduction_wandD .
  Instance empD : (EmpDeduction L GammaD1) := Axiomatization2Deduction_empD .
  Instance bE : (BasicLogicEquiv L GammaE) := Axiomatization2Equiv_bE .
  Instance GammaED1 : (EquivDerivable1 L GammaD1 GammaE) := Axiomatization2Deduction_GammaED1 .
  Instance imppE : (ImpLogicEquiv L GammaE) := Axiomatization2LogicEquiv_imppE .
Definition tree_pos : Type := tree_pos.
  Definition logic_equiv_derivable1 : (forall x y : expr, logic_equiv x y <-> derivable1 x y /\ derivable1 y x) := logic_equiv_derivable1 .
  Definition provable_derivable : (forall x : expr, provable x <-> derivable empty_context x) := provable_derivable .
  Definition logic_equiv_impp : (forall x1 x2 y1 y2 : expr, logic_equiv x1 x2 -> logic_equiv y1 y2 -> logic_equiv (impp x1 y1) (impp x2 y2)) := logic_equiv_impp .
  Definition logic_equiv_refl : (forall x : expr, logic_equiv x x) := logic_equiv_refl .
  Definition logic_equiv_symm : (forall x y : expr, logic_equiv x y -> logic_equiv y x) := logic_equiv_symm .
  Definition logic_equiv_trans : (forall x y z : expr, logic_equiv x y -> logic_equiv y z -> logic_equiv x z) := logic_equiv_trans .
  Definition sepcon_emp_left : (forall x : expr, derivable1 (sepcon x emp) x) := sepcon_emp_left .
  Definition sepcon_emp_right : (forall x : expr, derivable1 x (sepcon x emp)) := sepcon_emp_right .
  Definition derivable1_wand_sepcon_adjoint : (forall x y z : expr, derivable1 (sepcon x y) z <-> derivable1 x (wand y z)) := derivable1_wand_sepcon_adjoint .
  Definition derivable1_sepcon_comm : (forall x y : expr, derivable1 (sepcon x y) (sepcon y x)) := derivable1_sepcon_comm .
  Definition derivable1_sepcon_assoc1 : (forall x y z : expr, derivable1 (sepcon x (sepcon y z)) (sepcon (sepcon x y) z)) := derivable1_sepcon_assoc1 .
  Definition derivable1_sepcon_mono : (forall x1 x2 y1 y2 : expr, derivable1 x1 x2 -> derivable1 y1 y2 -> derivable1 (sepcon x1 y1) (sepcon x2 y2)) := derivable1_sepcon_mono .
  Definition derivable1_refl : (forall x : expr, derivable1 x x) := derivable1_refl .
  Definition derivable1_trans : (forall x y z : expr, derivable1 x y -> derivable1 y z -> derivable1 x z) := derivable1_trans .
  Definition provable_impp_refl : (forall x : expr, provable (impp x x)) := provable_impp_refl .
  Definition provable_impp_refl' : (forall x y : expr, x = y -> provable (impp x y)) := provable_impp_refl' .
  Definition provable_impp_arg_switch : (forall x y z : expr, provable (impp (impp x (impp y z)) (impp y (impp x z)))) := provable_impp_arg_switch .
  Definition provable_impp_trans : (forall x y z : expr, provable (impp (impp x y) (impp (impp y z) (impp x z)))) := provable_impp_trans .
  Definition provable_multi_imp_shrink : (forall (xs : list expr) (x y : expr), provable (impp (impp x (multi_imp xs (impp x y))) (multi_imp xs (impp x y)))) := provable_multi_imp_shrink .
  Definition provable_multi_imp_arg_switch1 : (forall (xs : list expr) (x y : expr), provable (impp (impp x (multi_imp xs y)) (multi_imp xs (impp x y)))) := provable_multi_imp_arg_switch1 .
  Definition provable_multi_imp_arg_switch2 : (forall (xs : list expr) (x y : expr), provable (impp (multi_imp xs (impp x y)) (impp x (multi_imp xs y)))) := provable_multi_imp_arg_switch2 .
  Definition provable_add_multi_imp_left_head : (forall (xs1 xs2 : list expr) (y : expr), provable (impp (multi_imp xs2 y) (multi_imp (xs1 ++ xs2) y))) := provable_add_multi_imp_left_head .
  Definition provable_add_multi_imp_left_tail : (forall (xs1 xs2 : list expr) (y : expr), provable (impp (multi_imp xs1 y) (multi_imp (xs1 ++ xs2) y))) := provable_add_multi_imp_left_tail .
  Definition provable_multi_imp_modus_ponens : (forall (xs : list expr) (y z : expr), provable (impp (multi_imp xs y) (impp (multi_imp xs (impp y z)) (multi_imp xs z)))) := provable_multi_imp_modus_ponens .
  Definition provable_multi_imp_weaken : (forall (xs : list expr) (x y : expr), provable (impp x y) -> provable (impp (multi_imp xs x) (multi_imp xs y))) := provable_multi_imp_weaken .
  Definition provable_impp_refl_instance : (RelationClasses.Reflexive (fun x y : expr => provable (impp x y))) := provable_impp_refl_instance .
  Definition deduction_impp_elim : (forall (Phi : context) (x y : expr), derivable Phi (impp x y) -> derivable (Union expr Phi (Singleton expr x)) y) := deduction_impp_elim .
  Definition deduction_theorem : (forall (Phi : context) (x y : expr), derivable (Union expr Phi (Singleton expr x)) y <-> derivable Phi (impp x y)) := deduction_theorem .
  Definition deduction_theorem_multi_imp : (forall (Phi : context) (xs : list expr) (y : expr), derivable (Union expr Phi (fun x : expr => In x xs)) y <-> derivable Phi (multi_imp xs y)) := deduction_theorem_multi_imp .
  Definition derivable_impp_refl : (forall (Phi : context) (x : expr), derivable Phi (impp x x)) := derivable_impp_refl .
  Definition deduction_left_impp_intros : (forall (Phi : context) (x y : expr), derivable Phi x -> derivable Phi (impp y x)) := deduction_left_impp_intros .
  Definition derivable_modus_ponens : (forall (Phi : context) (x y : expr), derivable Phi (impp x (impp (impp x y) y))) := derivable_modus_ponens .
  Definition deduction_impp_trans : (forall (Phi : context) (x y z : expr), derivable Phi (impp x y) -> derivable Phi (impp y z) -> derivable Phi (impp x z)) := deduction_impp_trans .
  Definition deduction_impp_arg_switch : (forall (Phi : context) (x y z : expr), derivable Phi (impp x (impp y z)) -> derivable Phi (impp y (impp x z))) := deduction_impp_arg_switch .
  Definition provable_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) Basics.impl) provable) := provable_proper_impp .
  Definition impp_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) impp) := impp_proper_impp .
  Definition derivable_proper_impp : (Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful (fun x y : expr => provable (impp x y)) Basics.impl)) derivable) := derivable_proper_impp .
  Definition negp_fold_unfold : (forall x : expr, provable (iffp (negp x) (impp x falsep))) := negp_fold_unfold .
  Definition deduction_negp_fold : (forall (Phi : Ensemble expr) (x : expr), derivable (Union expr Phi (Singleton expr x)) falsep -> derivable Phi (negp x)) := deduction_negp_fold .
  Definition deduction_negp_unfold : (forall (Phi : context) (x : expr), derivable Phi (negp x) -> derivable (Union expr Phi (Singleton expr x)) falsep) := deduction_negp_unfold .
  Definition demorgan_orp_negp : (forall x y : expr, provable (impp (orp (negp x) (negp y)) (negp (andp x y)))) := demorgan_orp_negp .
  Definition demorgan_negp_orp : (forall x y : expr, provable (iffp (negp (orp x y)) (andp (negp x) (negp y)))) := demorgan_negp_orp .
  Definition provable_truep : (provable truep) := provable_truep .
  Definition andp_comm : (forall x y : expr, provable (iffp (andp x y) (andp y x))) := andp_comm .
  Definition andp_assoc : (forall x y z : expr, provable (iffp (andp (andp x y) z) (andp x (andp y z)))) := andp_assoc .
  Definition orp_comm : (forall x y : expr, provable (iffp (orp x y) (orp y x))) := orp_comm .
  Definition orp_assoc : (forall x y z : expr, provable (iffp (orp (orp x y) z) (orp x (orp y z)))) := orp_assoc .
  Definition andp_dup : (forall x : expr, provable (iffp (andp x x) x)) := andp_dup .
  Definition orp_dup : (forall x : expr, provable (iffp (orp x x) x)) := orp_dup .
  Definition impp_curry : (forall x y z : expr, provable (impp (impp x (impp y z)) (impp (andp x y) z))) := impp_curry .
  Definition impp_uncurry : (forall x y z : expr, provable (impp (impp (andp x y) z) (impp x (impp y z)))) := impp_uncurry .
  Definition solve_impp_trans : (forall x y z : expr, provable (impp x y) -> provable (impp y z) -> provable (impp x z)) := solve_impp_trans .
  Definition solve_andp_intros : (forall x y : expr, provable x -> provable y -> provable (andp x y)) := solve_andp_intros .
  Definition solve_andp_elim1 : (forall x y : expr, provable (andp x y) -> provable x) := solve_andp_elim1 .
  Definition solve_andp_elim2 : (forall x y : expr, provable (andp x y) -> provable y) := solve_andp_elim2 .
  Definition negp_fold : (forall x : expr, provable (impp (impp x falsep) (negp x))) := negp_fold .
  Definition negp_unfold : (forall x : expr, provable (impp (negp x) (impp x falsep))) := negp_unfold .
  Definition andp_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) andp) := andp_proper_impp .
  Definition orp_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) orp) := orp_proper_impp .
  Definition negp_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (fun x y : expr => provable (impp x y))) negp) := negp_proper_impp .
  Definition provable_iffp_equiv : (RelationClasses.Equivalence (fun x y : expr => provable (iffp x y))) := provable_iffp_equiv .
  Definition provable_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) iff) provable) := provable_proper_iffp .
  Definition impp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) impp) := impp_proper_iffp .
  Definition andp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) andp) := andp_proper_iffp .
  Definition orp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) orp) := orp_proper_iffp .
  Definition iffp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) iffp) := iffp_proper_iffp .
  Definition negp_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y))) negp) := negp_proper_iffp .
  Definition derivable_proper_iffp : (Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful (fun x y : expr => provable (iffp x y)) iff)) derivable) := derivable_proper_iffp .
  Definition iter_andp_spec_right : (forall xs : list expr, provable (iffp (iter_andp xs) (fold_right andp truep xs))) := iter_andp_spec_right .
  Definition iter_andp_unfold_left_assoc : (forall xs : list expr, provable (iffp (iter_andp xs) match xs with
                                                                                | []%list => truep
                                                                                | x :: xs0 => (fix f (xs1 : list expr) (x0 : expr) {struct xs1} : expr := match xs1 with
                                                                                | []%list => x0
                                                                                | x1 :: xs2 => f xs2 (andp x0 x1)
                                                                                end) xs0 x
                                                                                end)) := iter_andp_unfold_left_assoc .
  Definition iter_andp_unfold_right_assoc : (forall xs : list expr, provable (iffp (iter_andp xs) ((fix f (xs0 : list expr) : expr := match xs0 with
                                                                                | []%list => truep
                                                                                | [x]%list => x
                                                                                | x :: (_ :: _) as xs1 => andp x (f xs1)
                                                                                end) xs))) := iter_andp_unfold_right_assoc .
  Definition falsep_sepcon : (forall x : expr, provable (iffp (sepcon falsep x) falsep)) := falsep_sepcon .
  Definition provable_wand_sepcon_modus_ponens1 : (forall x y : expr, provable (impp (sepcon (wand x y) x) y)) := provable_wand_sepcon_modus_ponens1 .
  Definition wand_andp : (forall x y z : expr, provable (iffp (wand x (andp y z)) (andp (wand x y) (wand x z)))) := wand_andp .
  Definition sepcon_falsep : (forall x : expr, provable (iffp (sepcon x falsep) falsep)) := sepcon_falsep .
  Definition provable_wand_sepcon_modus_ponens2 : (forall x y : expr, provable (impp (sepcon x (wand x y)) y)) := provable_wand_sepcon_modus_ponens2 .
  Definition wand_mono : (forall x1 x2 y1 y2 : expr, provable (impp x2 x1) -> provable (impp y1 y2) -> provable (impp (wand x1 y1) (wand x2 y2))) := wand_mono .
  Definition orp_wand : (forall x y z : expr, provable (iffp (wand (orp x y) z) (andp (wand x z) (wand y z)))) := orp_wand .
  Definition sepcon_iter_sepcon : (forall xs ys : list expr, provable (iffp (sepcon (iter_sepcon xs) (iter_sepcon ys)) (iter_sepcon (xs ++ ys)))) := sepcon_iter_sepcon .
  Definition cancel_ready : (forall x y : expr, provable (impp (sepcon x emp) y) -> provable (impp x y)) := cancel_ready .
  Definition cancel_one_succeed : (forall u x y z : expr, provable (impp (sepcon x y) z) -> provable (impp (sepcon (sepcon u x) y) (sepcon u z))) := cancel_one_succeed .
  Definition cancel_one_giveup : (forall x y z w v : expr, provable (impp (sepcon x (sepcon y z)) (sepcon w v)) -> provable (impp (sepcon (sepcon y x) z) (sepcon w v))) := cancel_one_giveup .
  Definition cancel_rev : (forall x y z w : expr, provable (impp (sepcon (sepcon y x) z) w) -> provable (impp (sepcon x (sepcon y z)) w)) := cancel_rev .
  Definition cancel_finish : (forall x : expr, provable (impp (sepcon x emp) x)) := cancel_finish .
  Definition iter_sepcon_unfold_right_assoc : (forall xs : list expr, provable (iffp (iter_sepcon xs) ((fix f (xs0 : list expr) : expr := match xs0 with
                                                                                | []%list => emp
                                                                                | [x]%list => x
                                                                                | x :: (_ :: _) as xs1 => sepcon x (f xs1)
                                                                                end) xs))) := iter_sepcon_unfold_right_assoc .
  Definition iter_sepcon_unfold_left_assoc : (forall xs : list expr, provable (iffp (iter_sepcon xs) match xs with
                                                                                | []%list => emp
                                                                                | x :: xs0 => (fix f (xs1 : list expr) (x0 : expr) {struct xs1} : expr := match xs1 with
                                                                                | []%list => x0
                                                                                | x1 :: xs2 => f xs2 (sepcon x0 x1)
                                                                                end) xs0 x
                                                                                end)) := iter_sepcon_unfold_left_assoc .
  Definition sepcon_proper_impp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (impp x y)) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) sepcon) := sepcon_proper_impp .
  Definition wand_proper_impp : (Morphisms.Proper (Morphisms.respectful (Basics.flip (fun x y : expr => provable (impp x y))) (Morphisms.respectful (fun x y : expr => provable (impp x y)) (fun x y : expr => provable (impp x y)))) wand) := wand_proper_impp .
  Definition sepcon_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) sepcon) := sepcon_proper_iffp .
  Definition wand_proper_iffp : (Morphisms.Proper (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (Morphisms.respectful (fun x y : expr => provable (iffp x y)) (fun x y : expr => provable (iffp x y)))) wand) := wand_proper_iffp .
  Definition expr_deep : Set := expr_deep .
  Definition impp_deep : (expr_deep -> expr_deep -> expr_deep) := impp_deep .
  Definition sepcon_deep : (expr_deep -> expr_deep -> expr_deep) := sepcon_deep .
  Definition emp_deep : expr_deep := emp_deep .
  Definition varp_deep : (nat -> expr_deep) := varp_deep .
  Definition var_pos : (expr -> option positive -> tree_pos) := var_pos .
  Definition sepcon_pos : (tree_pos -> tree_pos -> tree_pos) := sepcon_pos .
  Definition cancel_mark : (expr_deep -> expr_deep -> tree_pos -> tree_pos -> tree_pos * tree_pos) := cancel_mark .
  Definition cancel_different : (tree_pos -> tree_pos -> expr) := cancel_different .
  Definition cancel_same : (tree_pos -> tree_pos -> Prop) := cancel_same .
  Definition restore : (tree_pos -> tree_pos -> expr) := restore .
  Definition cancel_sound : (forall tep teq : tree_pos, cancel_same tep teq -> provable (cancel_different tep teq) -> provable (restore tep teq)) := cancel_sound .
  Definition impp_proper_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv (Morphisms.respectful logic_equiv logic_equiv)) impp) := impp_proper_equiv .
  Definition sepcon_proper_logic_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv (Morphisms.respectful logic_equiv logic_equiv)) sepcon) := sepcon_proper_logic_equiv .
  Definition provable_proper_equiv : (Morphisms.Proper (Morphisms.respectful logic_equiv iff) provable) := provable_proper_equiv .
  Definition logic_equiv_refl_instance : (RelationClasses.Reflexive logic_equiv) := logic_equiv_refl_instance .
  Definition logic_equiv_symm_instance : (RelationClasses.Symmetric logic_equiv) := logic_equiv_symm_instance .
  Definition logic_equiv_trans_instance : (RelationClasses.Transitive logic_equiv) := logic_equiv_trans_instance .
  Definition sepcon_comm_logic_equiv : (forall x y : expr, logic_equiv (sepcon x y) (sepcon y x)) := sepcon_comm_logic_equiv .
  Definition sepcon_assoc_logic_equiv : (forall x y z : expr, logic_equiv (sepcon x (sepcon y z)) (sepcon (sepcon x y) z)) := sepcon_assoc_logic_equiv .
  Definition sepcon_emp_logic_equiv : (forall x : expr, logic_equiv (sepcon x emp) x) := sepcon_emp_logic_equiv .
  Existing Instance provable_impp_refl_instance .
  Existing Instance provable_proper_impp .
  Existing Instance impp_proper_impp .
  Existing Instance derivable_proper_impp .
  Existing Instance andp_proper_impp .
  Existing Instance orp_proper_impp .
  Existing Instance negp_proper_impp .
  Existing Instance provable_iffp_equiv .
  Existing Instance provable_proper_iffp .
  Existing Instance impp_proper_iffp .
  Existing Instance andp_proper_iffp .
  Existing Instance orp_proper_iffp .
  Existing Instance iffp_proper_iffp .
  Existing Instance negp_proper_iffp .
  Existing Instance derivable_proper_iffp .
  Existing Instance sepcon_proper_impp .
  Existing Instance wand_proper_impp .
  Existing Instance sepcon_proper_iffp .
  Existing Instance wand_proper_iffp .
  Existing Instance impp_proper_equiv .
  Existing Instance sepcon_proper_logic_equiv .
  Existing Instance provable_proper_equiv .
  Existing Instance logic_equiv_refl_instance .
  Existing Instance logic_equiv_symm_instance .
  Existing Instance logic_equiv_trans_instance .
End LogicTheorem.

(*Require Logic.PropositionalLogic.DeepEmbedded.Solver.
Module IPSolver (Names: LanguageSig).
  Import Names.
  Ltac ip_solve :=
    change expr with Base.expr;
    change provable with Base.provable;
    change impp with Syntax.impp;
    change andp with Syntax.andp;
    intros; Solver.SolverSound.ipSolver.
End IPSolver.*)


Require Import Coq.Classes.Equivalence.
Require Import VST.msl.base.
Require Import VST.msl.simple_CCC.
Require Import VST.msl.seplog.
Require Import VST.msl.log_normalize.
Require Import VST.msl.Coqlib2.
Require Import VST.msl.ramification_lemmas.
Require Import RamifyCoq.msl_ext.log_normalize.

Local Open Scope logic.

Section EnvironBox_EnvironStable.

Context {A Env : Type}.
Context {ND : NatDed A}.
Context {SL : SepLog A}.
Context {CoSL: CorableSepLog A}.

Variable M: Env -> Env -> Prop.
Context {EqM: Equivalence M}.

Definition EnvironBox (P: Env -> A) : Env -> A :=
  fun rho: Env => (ALL rho': Env, !! M rho rho' --> P rho').

Definition EnvironStable (P: Env -> A) : Prop :=
  forall rho rho', M rho rho' -> P rho = P rho'.

Lemma EnvironStable_sepcon: forall P Q,
  EnvironStable P ->
  EnvironStable Q ->
  EnvironStable (P * Q).
Proof.
  unfold EnvironStable.
  intros.
  specialize (H _ _ H1).
  specialize (H0 _ _ H1).
  simpl.
  f_equal; auto.
Qed.

Lemma EnvironBox_EnvironStable: forall P, EnvironStable (EnvironBox P).
(* This lemma is the reason why EqM is required. *)
Proof.
  intros.
  unfold EnvironBox, EnvironStable; intros.
  apply pred_ext; apply allp_right; intro rho''; apply (allp_left _ rho'');
  apply imp_andp_adjoint; normalize; rewrite prop_imp; auto.
  + rewrite H; auto.
  + rewrite <- H; auto.
Qed.

Lemma EnvironBox_T: forall P, EnvironBox P |-- P.
Proof.
  intros P rho.
  apply (allp_left _ rho).
  rewrite prop_imp by reflexivity.
  auto.
Qed.

Lemma EnvironBox_derives: forall P Q, P |-- Q -> EnvironBox P |-- EnvironBox Q.
Proof.
  intros P Q ? rho.
  apply allp_right; intro rho'.
  apply (allp_left _ rho').
  apply imp_andp_adjoint.
  apply derives_extract_prop'; intro.
  rewrite prop_imp by auto.
  auto.
Qed.

Lemma EnvironBox_sepcon: forall P Q, EnvironBox P * EnvironBox Q |-- EnvironBox (P * Q).
Proof.
  intros.
  unfold EnvironBox; simpl; intro rho.
  apply allp_right; intro rho'.
  apply imp_andp_adjoint; normalize.
  apply sepcon_derives; apply (allp_left _ rho');
  rewrite prop_imp by auto; auto.
Qed.

Lemma EnvironBox_andp: forall P Q, EnvironBox (P && Q) = EnvironBox P && EnvironBox Q.
Proof.
  intros.
  unfold EnvironBox; apply pred_ext; simpl; intro rho.
  + apply andp_right.
    - apply allp_right; intro rho'.
      apply -> imp_andp_adjoint; normalize.
      apply (allp_left _ rho');
      rewrite prop_imp by auto.
      apply andp_left1; auto.
    - apply allp_right; intro rho'.
      apply -> imp_andp_adjoint; normalize.
      apply (allp_left _ rho');
      rewrite prop_imp by auto.
      apply andp_left2; auto.
  + apply allp_right; intro rho'.
    apply -> imp_andp_adjoint; normalize.
    apply andp_derives; apply (allp_left _ rho');
    rewrite prop_imp by auto; auto.
Qed.

Lemma EnvironStable_allp: forall {T} P, (forall a: T, EnvironStable (P a)) -> EnvironStable (allp P).
Proof.
  intros.
  unfold EnvironStable in *.
  intros.
  simpl.
  apply allp_congr; intro a.
  apply H; auto.
Qed.

Lemma EnvironBox_TT: EnvironBox TT = TT.
Proof.
  intros.
  apply pred_ext.
  + apply TT_right.
  + unfold EnvironBox; intro rho.
    apply allp_right; intro rho'.
    apply imp_andp_adjoint.
    simpl; apply TT_right.
Qed.

Lemma EnvironStable_EnvironBox: forall P, EnvironStable P -> EnvironBox P = P.
Proof.
  intros.
  apply pred_ext; [apply EnvironBox_T |].
  unfold EnvironBox; intro rho.
  apply allp_right; intro rho'.
  apply imp_andp_adjoint; normalize.
  rewrite (H _ _ H0).
  auto.
Qed.

Lemma sepcon_EnvironBox_weaken: forall P Q R R', R |-- R' -> P |-- Q * EnvironBox R -> P |-- Q * EnvironBox R'.
Proof.
  intros.
  eapply derives_trans; [apply H0 |].
  apply sepcon_derives; auto.
  apply EnvironBox_derives; auto.
Qed.

Lemma sepcon_EnvironBox_weaken': forall TC P Q R R', R |-- R' ->
  P |-- Q * EnvironBox (TC --> R) -> P |-- Q * EnvironBox (TC --> R').
Proof.
  intros.
  eapply derives_trans; [apply H0 |].
  apply sepcon_derives; auto.
  apply EnvironBox_derives; auto.
  apply imp_derives; auto.
Qed.

Lemma EnvironBox_corable: forall P, corable P -> corable (EnvironBox P).
Proof.
  intros.
  simpl in H |- *.
  intro.
  unfold EnvironBox.
  auto.
Qed.

Lemma solve_ramify_P: forall (g l g' l' F: Env -> A),
  EnvironStable F ->
  g |-- l * F ->
  F * l' |-- g' ->
  g |-- l * EnvironBox (l' -* g').
Proof.
  intros.
  apply derives_trans with (l * F); auto.
  apply sepcon_derives; auto.
  unfold EnvironBox; simpl; intros rho.
  apply allp_right; intro rho'.
  apply imp_andp_adjoint.
  normalize.
  rewrite (H rho rho' H2).
  apply wand_sepcon_adjoint.
  apply H1.
Qed.

Lemma ramify_P_frame: forall g l g' l' F,
  EnvironStable F ->
  g |-- l * EnvironBox (l' -* g') ->
  g * F |-- l * EnvironBox (l' -* g' * F).
Proof.
  intros.
  apply solve_ramify_P with (EnvironBox (l' -* g') * F).
  + apply EnvironStable_sepcon; auto.
    apply EnvironBox_EnvironStable.
  + rewrite <- sepcon_assoc.
    apply sepcon_derives; auto.
  + rewrite (sepcon_comm _ l'), <- sepcon_assoc.
    apply sepcon_derives; [| auto].
    rewrite sepcon_comm; apply wand_sepcon_adjoint.
    apply EnvironBox_T.
Qed.

Lemma split_ramify_P: forall g1 g2 l1 l2 g1' g2' l1' l2',
  g1 |-- l1 * EnvironBox (l1' -* g1') ->
  g2 |-- l2 * EnvironBox (l2' -* g2') ->
  g1 * g2 |-- (l1 * l2) * EnvironBox (l1' * l2' -* g1' * g2').
Proof.
  intros.
  apply solve_ramify_P with (EnvironBox (l1' -* g1') * EnvironBox (l2' -* g2')).
  + apply EnvironStable_sepcon;
    apply EnvironBox_EnvironStable.
  + rewrite (sepcon_assoc l1), <- (sepcon_assoc l2), (sepcon_comm l2), (sepcon_assoc _ l2), <- (sepcon_assoc l1).
    apply sepcon_derives; auto.
  + apply wand_sepcon_adjoint.
    eapply derives_trans; [apply EnvironBox_sepcon |].
    eapply derives_trans; [apply EnvironBox_T |].
    apply wand_sepcon_wand.
Qed.

Lemma go_lower_ramify_P: forall (g l g' l': A),
  g |-- l * (l' -* g') ->
  @Basics.const A Env g |-- Basics.const l * EnvironBox (Basics.const l' -* Basics.const g').
Proof.
  intros.
  intro rho; unfold EnvironBox, Basics.const; simpl.
  eapply derives_trans; [exact H |].
  apply sepcon_derives; [auto |].
  apply allp_right; intro rho'.
  apply imp_andp_adjoint.
  apply andp_left1.
  auto.
Qed.

Lemma ramify_PQ_reduce0: forall {B} g l (g' l': B -> Env -> A),
  g |-- l * EnvironBox (allp (l' -* g')) ->
  g |-- l * EnvironBox (exp l' -* exp g').
Proof.
  intros.
  eapply derives_trans; [exact H |].
  apply sepcon_derives; [auto |].
  apply EnvironBox_derives.
  apply wand_sepcon_adjoint.
  rewrite exp_sepcon2.
  apply exp_left; intro x; apply (exp_right x).
  apply wand_sepcon_adjoint.
  apply (allp_left _ x).
  simpl.
  auto.
Qed.

Lemma ramify_PQ_reduce1: forall {B} g l g0 l0 (g' l': B -> Env -> A),
  corable l0 ->
  g0 |-- l0 ->
  g |-- l * EnvironBox (allp (l' -* g')) ->
  g0 && g |-- (l0 && l) * EnvironBox (allp (l' -* g')).
Proof.
  intros.
  rewrite corable_andp_sepcon1 by auto.
  apply andp_derives; auto.
Qed.

Lemma ramify_PQ_reduce2: forall {B} g l g0 g' l' g0',
  corable g0 ->
  EnvironStable g0 ->
  (forall x: B, g0 |-- g0' x) ->
  g |-- l * EnvironBox (allp (l' -* g')) ->
  g0 && g |-- l * EnvironBox (allp (l' -* g0' && g')).
Proof.
  intros.
  eapply derives_trans; [apply andp_derives; [apply derives_refl | apply H2] |].
  rewrite <- corable_sepcon_andp1 by auto.
  apply sepcon_derives; [auto |].
  rewrite <- (EnvironStable_EnvironBox g0) at 1 by auto.
  rewrite <- EnvironBox_andp.
  apply EnvironBox_derives.
  apply allp_right; intro x.
  rewrite (andp_comm g0).
  apply imp_andp_adjoint.
  apply (allp_left _ x).
  apply imp_andp_adjoint.
  apply wand_sepcon_adjoint.
  rewrite corable_andp_sepcon2 by auto.
  change ((g0' && g') x) with (g0' x && g' x).
  change ((l' -* g') x) with (l' x -* g' x).
  apply andp_derives; auto.
  apply wand_sepcon_adjoint.
  auto.
Qed.

Lemma ramify_PQ_reduce3: forall {B} g l g' l' g0 l0 p,
  (forall x: B, corable (l0 x)) ->
  (forall x: B, l0 x |-- g0 x) ->
  (forall x: B, l0 x |-- p x) ->
  g |-- l * EnvironBox (allp (p --> (l' -* g'))) ->
  g |-- l * EnvironBox (allp (l0 && l' -* g0 && g')).
Proof.
  intros.
  apply derives_trans with (l * EnvironBox (allp (p --> (l' -* g')))).
  + auto.
  + apply sepcon_derives; auto.
    apply EnvironBox_derives.
    apply allp_right; intro x.
    apply (allp_left _ x).
    change ((l0 && l' -* g0 && g') x) with (l0 x && l' x -* g0 x && g' x).
    change ((p --> (l' -* g')) x) with (p x --> (l' x -* g' x)).
    apply wand_sepcon_adjoint.
    rewrite sepcon_comm, corable_andp_sepcon1, <- corable_sepcon_andp1 by auto.
    eapply derives_trans; [apply sepcon_derives; [apply derives_refl |] |].
    - apply andp_right; [apply andp_left1; apply derives_refl |].
      eapply derives_trans; [apply andp_derives; [apply H1 | apply derives_refl] |].
      apply modus_ponens.
    - rewrite corable_sepcon_andp1 by auto.
      apply andp_derives; auto.
      apply modus_ponens_wand.
Qed.

Lemma solve_ramify_PQ: forall {B} g l p g' l' F,
  EnvironStable F ->
  (forall x: B, corable (p x)) ->
  g |-- l * F ->
  (forall x: B, p x && (F * l' x) |-- g' x) ->
  g |-- l * EnvironBox (allp (p --> (l' -* g'))).
Proof.
  intros.
  apply derives_trans with (l * F); auto.
  apply sepcon_derives; auto.
  unfold EnvironBox; simpl; intros rho.
  apply allp_right; intro rho'.
  apply imp_andp_adjoint.
  normalize.
  rewrite (H rho rho' H3).
  clear rho H3; rename rho' into rho.
  apply allp_right; intro x.
  apply imp_andp_adjoint, wand_sepcon_adjoint.
  rewrite corable_andp_sepcon2 by apply (H0 x rho).
  apply (H2 x rho).
Qed.

Lemma ramify_PQ_frame: forall {B} g l p g' l' F,
  EnvironStable F ->
  (forall x: B, corable (p x)) ->
  g |-- l * EnvironBox (allp (p --> (l' -* g'))) ->
  g * F |-- l * EnvironBox (allp (p --> (l' -* g' * Basics.const F))).
Proof.
  intros.
  eapply derives_trans with (l * EnvironBox (allp (p --> (l' -* g'))) * F).
  + apply sepcon_derives; auto.
  + rewrite sepcon_assoc.
    apply sepcon_derives; auto.
    rewrite <- (EnvironStable_EnvironBox F) at 1 by auto.
    eapply derives_trans; [apply EnvironBox_sepcon |].
    apply EnvironBox_derives.
    apply allp_right; intro x.
    apply wand_sepcon_adjoint.
    apply (allp_left _ x).
    apply wand_sepcon_adjoint.
    change ((p --> (l' -* g' * Basics.const F)) x) with (p x --> (l' x -* g' x * F)).
    change ((p --> (l' -* g')) x) with (p x --> (l' x -* g' x)).
    apply imp_andp_adjoint.
    rewrite andp_comm, <- corable_andp_sepcon1 by auto.
    apply wand_sepcon_adjoint.
    eapply derives_trans; [apply modus_ponens |].
    rewrite wand_wand_comm.
    apply wand_derives; auto.
    apply wand_sepcon_adjoint; auto.
Qed.

Lemma split_ramify_PQ: forall {B} g1 g2 l1 l2 p g1' g2' l1' l2',
  (forall x: B, corable (p x)) ->
  g1 |-- l1 * EnvironBox (allp (p --> (l1' -* g1'))) ->
  g2 |-- l2 * EnvironBox (allp (p --> (l2' -* g2'))) ->
  g1 * g2 |-- (l1 * l2) * EnvironBox (allp (p --> (l1' * l2' -* g1' * g2'))).
Proof.
  intros.
  apply solve_ramify_PQ with (EnvironBox (allp (p --> (l1' -* g1'))) * EnvironBox (allp (p --> (l2' -* g2')))).
  + apply EnvironStable_sepcon;
    apply EnvironBox_EnvironStable.
  + auto.
  + rewrite (sepcon_assoc l1), <- (sepcon_assoc l2), (sepcon_comm l2), (sepcon_assoc _ l2), <- (sepcon_assoc l1).
    apply sepcon_derives; auto.
  + intros x.
    change ((l1' * l2') x) with (l1' x * l2' x).
    rewrite <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l1' x)), (sepcon_comm _ (l1' x)), <- (sepcon_assoc _ (l1' x)), (sepcon_assoc _ _ (l2' x)).
    rewrite <- (andp_dup (p x)), andp_assoc.
    rewrite <- corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
    rewrite <- !corable_sepcon_andp1 by auto.
    apply sepcon_derives.
    - apply wand_sepcon_adjoint; (eapply derives_trans; [apply EnvironBox_T |]).
      apply (allp_left _ x).
      apply wand_sepcon_adjoint.
      rewrite corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
      (eapply derives_trans; [apply sepcon_derives; [simpl; intros; apply modus_ponens | apply derives_refl] |]).
      apply wand_sepcon_adjoint; apply derives_refl.
    - apply wand_sepcon_adjoint; (eapply derives_trans; [apply EnvironBox_T |]).
      apply (allp_left _ x).
      apply wand_sepcon_adjoint.
      rewrite corable_sepcon_andp1, <- corable_andp_sepcon1 by auto.
      (eapply derives_trans; [apply sepcon_derives; [simpl; intros; apply modus_ponens | apply derives_refl] |]).
      apply wand_sepcon_adjoint; apply derives_refl.
Qed.

Lemma go_lower_ramify_PQ: forall {B} g l (p g' l': B -> A),
  g |-- l * (allp (p --> (l' -* g'))) ->
  Basics.const g |-- Basics.const l *
    EnvironBox (allp ((fun (x: B) (rho: Env) => p x) -->
      ((fun x _ => l' x) -* (fun x _ => g' x)))).
Proof.
  intros.
  intro rho; unfold EnvironBox, Basics.const; simpl.
  eapply derives_trans; [exact H |].
  apply sepcon_derives; [auto |].
  apply allp_right; intro rho'.
  apply imp_andp_adjoint.
  apply andp_left1.
  simpl.
  auto.
Qed.

Lemma reduce_frame_from_ramification: forall F Q, EnvironStable F -> F |-- EnvironBox (Q -* Q * F).
Proof.
  intros.
  unfold EnvironBox.
  simpl; intros rho.
  apply allp_right; intros rho'.
  apply imp_andp_adjoint.
  normalize.
  apply wand_sepcon_adjoint.
  rewrite sepcon_comm.
  specialize (H _ _ H0).
  rewrite H.
  auto.
Qed.

End EnvironBox_EnvironStable.


Set Warnings "-notation-overridden,-parsing".
From Coq Require Import Bool.Bool Init.Nat Arith.Arith Arith.EqNat
     Init.Datatypes Strings.String Program Logic.FunctionalExtensionality.
Require Export Coq.Strings.String.
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype seq fintype ssrnat ssrfun.
From TLC Require Import LibTactics LibLogic.
From Coq_intermittent Require Export programs semantics algorithms lemmas_1
     lemmas_0 proofs_0 proofs_w.
Implicit Types N: nvmem. Implicit Types V: vmem.
Implicit Types O: obseq.
Implicit Types c: command.
Implicit Types W: the_write_stuff.
Implicit Types x: smallvar.

(*The exciting proofs are at the bottom. More important lemmas are briefly commented.*)

(*Invariants*)

(*My memory invariant. I like it because it is minimalistic, yet sufficient (along with its weaker version, which differs only in the ommision of the requirement that end_com c2) to prove the final correctness result. Further, it is preserved after arbitrary reboot, provided that the DINO checkpointing scheme is followed, which facillitates reasoning about intermittent execution.
 Also, it is an equivalence relation, as proved below.*)
Inductive all_diff_in_fw: nvmem -> vmem -> command -> nvmem -> Prop :=
  Diff_in_FW: forall{N1 V1 c1 N2 V2 c2 N1c O W} (T: trace_cs (N1, V1, c1) (N2, V2, c2) O W),
    end_com c2 -> checkpoint \notin O ->
( forall(l: loc ), ((getmap N1) l <> (getmap N1c) l) -> (l \in getfstwt W))
-> all_diff_in_fw N1 V1 c1 N1c.

(*Definition 5 in Technical Appendix*)
Inductive current_init_pt: nvmem -> vmem -> command -> nvmem -> nvmem -> nvmem -> Prop:=
  valid_mem: forall {N Ni0 N1 Nc0 Nend: nvmem}
                  {V V1 Vend: vmem}
                  {c crem: command}
                  {W : the_write_stuff}
                  {O: obseq}
                  {w: warvars}
                  (T: trace_cs (Ni0, V, c) (Nend, Vend, crem) O W),
    crem = skip \/ (exists(w: warvars) (crem2: command), crem = ((incheckpoint w);;crem2)) ->
    subseq (getdomain Nc0) (getdomain N1)
    -> subset_nvm N Nc0
                  -> (checkpoint \notin O)
                 -> (forall(l: loc),
                      not((getmap N1) l = (getmap Nc0) l)
                      -> (l \in (getfstwt W)) \/ (l \in (getdomain N)))
                 -> current_init_pt N V c Ni0 N1 Nc0.

(*Definition 4 in Technical Appendix*)
Inductive same_pt: nvmem -> vmem -> command -> command -> nvmem -> nvmem -> Prop :=
same_mem: forall {N0 N1 Ncomp N2: nvmem}
                  {V0 V1 V2: vmem}
                  {c0 c1 crem: command}
                  {W1 W2: the_write_stuff}
                  {O1 O2: obseq}
                  (T1: trace_cs (N0, V0, c0) (N1, V1, c1) O1 W1)
                  (T2: trace_cs (N1, V1, c1) (N2, V2, crem) O2 W2),
    crem = skip \/ (exists(w: warvars) (crem2: command), crem = ((incheckpoint w);;crem2)) ->
                  subseq (getdomain Ncomp) (getdomain Ncomp)
                  -> (checkpoint \notin O1)
                  -> (checkpoint \notin O2)
                 -> (forall(l: loc),
                      not((getmap N1) l = (getmap Ncomp) l)
                      -> ((l \in (getwt W2)) /\ (l \in (getfstwt (append_write W1 W2))) /\ not (l \in (getwt W1))))
                  -> same_pt N0 V0 c0 c1 N1 Ncomp.

(*Definition 6 in Technical Appendix*)
Inductive same_config: nvmem -> iconf -> context -> Prop :=
  SameConfig: forall(Nstart N0 N1 N2: nvmem)
                (V0 V: vmem)
                (c0 c: command),
    subset_nvm N0 Nstart ->
    same_pt Nstart V0 c0 c N1 N2 ->
    same_config Nstart ((N0, V0, c0), N1, V, c) (N2, V, c).

(*helper lemmas about all_diff_in_fw*)

  Lemma adifw_adif {N V c N1}:
    all_diff_in_fw N V c N1 ->
    all_diff_in_fww N V c N1.
    intros Hdiff. inversion Hdiff. subst.
    econstructor; try apply T; try assumption. Qed.

 Lemma agreeonread: forall{N Nend N2: nvmem} {V Vend: vmem}
                        {c c1: command}
                   {O : obseq} {W: the_write_stuff},
  all_diff_in_fw N V c N2 ->
             cceval_w (N, V, c) O (Nend, Vend, c1) W ->
             ( forall(z: loc), z \in (getrd W) -> (getmap N) z = (getmap N2) z).
   intros. apply adifw_adif in H. eapply agreeonread_w_l; try apply H; try apply H0; try assumption. Qed.

 Lemma add_skip_ins {N1 V l N2}: all_diff_in_fw N1 V (Ins l) N2 ->
                                 all_diff_in_fw N1 V (l;; skip) N2.
   intros Hdiff. inversion Hdiff; subst.
   inversion T; subst.
   - destruct H as [one | two]. inversion one. subst.
     econstructor.
     eapply CsTrace_Single. eapply Skip. by left. by []. assumption. destruct two as [crem [w contra] ]. discriminate contra.
     move: (cceval_skip H2) => one. subst.
     econstructor. eapply CsTrace_Single.
     eapply Seq. intros w contra. subst. inversion H2.
     intros contra. subst. inversion H2. apply H2. by left.
     assumption. assumption.
     destruct Cmid as [ [nm vm] cm].
     move: (cceval_skip H4) => eq. subst.
     econstructor. eapply CsTrace_Single.
     eapply Seq. intros w contra. subst. inversion H4.
     intros contra. subst. inversion H4.
     apply H4. by left.
     rewrite mem_cat in H0. move/ norP: H0 => [Ho1 Ho2].
     assumption.
     suffices: W2 = emptysets. move => eq. subst.
     rewrite append_write_empty in H1.
     assumption.
     move: (trace_skip H2) => Heq. subst. by move/empty_trace_cs1: H2 => [one two].
 Qed.

 Lemma adif_cceval {N1 N2 V c Nend Vend O1 W cend}:
  all_diff_in_fw N1 V c N2 ->
  cceval_w (N1, V, c) O1 (Nend, Vend, cend) W ->
  end_com cend ->
    forall(l: loc ), ((getmap N1) l <> (getmap N2) l) -> (l \in getfstwt W).
  intros. move: l H2. inversion H; subst.
  destruct (O == [::]) eqn: Hbool; move/ eqP: Hbool => Hnil. subst.
  apply empty_trace_cs1 in T. destruct T as [one two]. inversion one. subst.
  intros l contra. apply (H4 l) in contra.
  rewrite in_nil in contra. discriminate contra.
  move: (single_step_alls T Hnil H0). => [Wrest [Orest [ Trest [Hsub Hw] ] ] ].
  suffices: checkpoint \notin Orest. move => Hrest.
  move: (same_endcom_help Trest Hrest H1 H2) => one. subst.
  move/ empty_trace_cs: Trest => [one [two [three four] ] ]. subst.
 by rewrite append_write_empty in H4.
 apply/negP. intros contra.
 exfalso.
 rewrite Hsub in H3.
 move/ negP : H3. apply. rewrite mem_cat. apply/orP.
by right.
 Qed.

(*if adif holds at the end of a checkpointed segment, then the related memories
 must be equal*)
Lemma trace_converge {N V cend Nc} :
  all_diff_in_fw N V cend Nc ->
  end_com cend ->
  N = Nc.
  intros Hdiff Hend. apply nvmem_eq.
  inversion Hdiff. subst.
  suffices: O = [::]. move => Heq. subst.
  move/ empty_trace_cs1 : T => [one [two three] ]. subst.
  apply/ eqP /negPn /negP. intros contra.
  move/ eqP : contra => contra.
  apply (H1 three) in contra. rewrite in_nil in contra. discriminate contra.
  move: (same_endcom_help T H0 Hend H) => one. subst.
    by move/ empty_trace_cs : T => [one [two three] ].
    Qed.

Lemma trace_converge_minus1 {N V N' Nmid Vmid Nmid'
                            O W} {l: instruction}:
  all_diff_in_fw N V l N' ->
  cceval_w (N, V, Ins l) O (Nmid, Vmid, Ins skip) W ->
  cceval_w (N', V, Ins l) O (Nmid', Vmid, Ins skip) W ->
  Nmid = Nmid'.
   intros. apply adifw_adif in H.
   eapply trace_converge_minus1w; try apply H; try apply H0; try assumption. Qed.

  Lemma two_bc {Ni Ni1 V V1 l c1 crem Nc O W} : all_diff_in_fw Ni V (l;;crem) Nc ->
                              cceval_w (Ni, V, Ins l) O (Ni1, V1, c1) W ->
                              exists(Nc1: nvmem), (cceval_w (Nc, V, Ins l) O (Nc1, V1, c1) W /\
                                              forall(l: loc), l \in (getwt W) -> ((getmap Ni1) l = (getmap Nc1) l)).
      intros.
      apply adifw_adif in H.
      eapply two_bcw; try apply H; try assumption. Qed.

  (*all_diff_in_fw preserved under single step continuous evaluation*)
Lemma two {Ni Ni1 V V1 c c1 Nc O W} : all_diff_in_fw Ni V c Nc ->
                              cceval_w (Ni, V, c) O (Ni1, V1, c1) W ->
                              exists(Nc1: nvmem), (cceval_w (Nc, V, c) O (Nc1, V1, c1) W /\
                                              (forall(l: loc), l \in (getwt W) -> ((getmap Ni1) l = (getmap Nc1) l))

                                             /\
                                             (checkpoint \notin O -> all_diff_in_fw Ni1 V1 c1 Nc1)
                                             ).
  intros.
  induction c.
  - move: (two_bc (add_skip_ins H) H0). => [Nc1 [Hcceval Hl] ].
    exists Nc1. repeat (split; try assumption).
    move: (cceval_skip Hcceval) => Heq. subst.
    pose proof (trace_converge_minus1 H H0 Hcceval). subst. intros.
    econstructor; try reflexivity.
    apply (CsTrace_Empty (Nc1, V1, Ins skip)). by left.
      by rewrite in_nil.
      move => l0 contra. exfalso. by apply contra.
   - inversion H0; subst.
     +
       assert (end_com (incheckpoint w;; c1)) as Hcp.
       right. by exists c1 w.
       move: (trace_converge H Hcp) => one. subst.
       exists Nc. repeat split. apply CheckPoint; try assumption.
       move/ negP => contra. exfalso. by apply contra.
     + exists Nc. repeat split. apply Skip. move => l contra.
       rewrite in_nil in contra. by exfalso. intros.
       inversion H; subst.
       suffices: O <> [::]. intros Ho.
       move: (single_step_alls T Ho H0). => [Wrest [Orest
                                                     [Trest
                                [Hsubseq Hwrite] ] ] ].
       econstructor; try apply Trest; try assumption.
       apply/negP. intros contra.
       apply/negP / negPn: H3.
 rewrite Hsubseq.
rewrite mem_cat. apply/orP.
by right.
       rewrite append_write_empty_l in Hwrite. by rewrite - Hwrite.
       intros contra. subst.
       move: (empty_trace_cs1 T) => [Eq1 Eq2].
       inversion Eq1. subst. inversion H2.
       inversion H5.
       move : H5 => [crem [w contra] ]. inversion contra.
     + move: (two_bc H H12) => [Nc1 [Hsmall Hdone] ]. exists Nc1. repeat split; try assumption.
       apply Seq; try assumption.
       inversion H; subst.
       suffices: O0 <> [::]. intros Ho.
       move: (single_step_alls T Ho H0). => [Wrest [Orest
                                                     [Trest
                                [Hsubseq Hwrite] ] ] ].
       econstructor; try apply Trest; try assumption.
       apply/negP. intros contra.
       apply/negP / negPn: H2.
 rewrite Hsubseq.
rewrite mem_cat. apply/orP.
by right.
       intros l0 Hl0. remember Hl0 as Hneq.
           clear HeqHneq.
           suffices: getmap Ni1 l0 <> getmap Nc1 l0 -> l0 \notin getwt W.
           intros Hdonec. apply Hdonec in Hl0.
           suffices: (l0 \in getfstwt W0).
           intros Hfw.
           subst. move/ fw_split : Hfw => [one | two].
           apply (in_subseq (fw_subst_wt_c H12)) in one.
           exfalso. move/ negP : Hl0. by apply.
             by move: two => [whatever done].
             apply H3.
             move: (update_one_contra l0 H12 Hl0) => Heq1.
             move: (update_one_contra l0 Hsmall Hl0) => Heq2.
             by rewrite Heq1 Heq2.
             clear Hneq. intros Hneq. apply/negP. intros contra.
             apply Hneq. by apply Hdone.
       intros contra. subst.
       move: (empty_trace_cs1 T) => [Eq1 Eq2].
       inversion Eq1. subst. inversion H1.
       inversion H4.
       move : H4 => [crem [w contra] ]. inversion contra.
       by apply (H10 w).
     + inversion H0; subst; exists Nc; repeat split. apply If_T.
       move: (agreeonread H H0) => agr.
       apply (agr_imp_age H11); try assumption.
       move => l contra.
       rewrite in_nil in contra. by exfalso.
       intros.
       inversion H. subst. suffices: O <> [::]. intros Ho.
       move: (single_step_alls T Ho H0). => [Wrest [Orest
                                                     [Trest
                                [Hsubseq Hwrite] ] ] ].
       econstructor; try apply Trest; try assumption.
       apply/negP.
       move => contra. rewrite Hsubseq mem_cat in H3.
       move/ norP : H3 => [one two].
       move/negP: two.
         by apply.
         destruct W as [ [w1 w2 ] w3].
         destruct Wrest as [ [wr1 wr2] wr3]. inversion Hwrite.
         rewrite cats0 in H8.
         intros l Hneq. apply H4 in Hneq. subst. simpl in Hneq.
         simpl. rewrite mem_filter in Hneq.
         by move/ andP : Hneq => [one two].
       intros contra. subst. move: (empty_trace_cs1 T) => [Eq1 Eq2].
       inversion Eq1. subst. inversion H2.
       inversion H5.
       move : H5 => [crem [w contra] ]. inversion contra.
       apply If_F.
       move: (agreeonread H H0) => agr.
       apply (agr_imp_age H11); try assumption. move => l contra.
       rewrite in_nil in contra. by exfalso.
       intros.
       inversion H. subst. suffices: O <> [::]. intros Ho.
       move: (single_step_alls T Ho H0). => [Wrest [Orest
                                                     [Trest
                                [Hsubseq Hwrite] ] ] ].
       econstructor; try apply Trest; try assumption.
       apply/negP.
       move => contra. rewrite Hsubseq mem_cat in H3.
       move/ norP : H3 => [one two].
       move/negP: two.
         by apply.
         destruct W as [ [w1 w2 ] w3].
         destruct Wrest as [ [wr1 wr2] wr3]. inversion Hwrite.
         rewrite cats0 in H8.
         intros l Hneq. apply H4 in Hneq. subst. simpl in Hneq.
         simpl. rewrite mem_filter in Hneq.
         by move/ andP : Hneq => [one two].
       intros contra. subst. move: (empty_trace_cs1 T) => [Eq1 Eq2].
       inversion Eq1. subst. inversion H2.
       inversion H5.
       move : H5 => [crem [w contra] ]. inversion contra.
Qed.

Lemma two_p_five {Ni Ni1 V V1 c c1 Nc O W} : all_diff_in_fw Ni V c Nc ->
                                             cceval_w (Ni, V, c) O (Ni1, V1, c1) W ->
                                             checkpoint \notin O ->
                              exists(Nc1: nvmem), (cceval_w (Nc, V, c) O (Nc1, V1, c1) W /\
                              all_diff_in_fw Ni1 V1 c1 Nc1).
  intros.
  move: (two H H0) => [Nc1 [Hcceval [Hl Hdone] ] ]. exists Nc1. split; try assumption. by apply Hdone.
Qed.

(*if two memories are related and there is a continuous trace starting from one and ending
at the end of a checkpointed segment, there is an identical continuous trace starting from the other *)
Lemma adif_works {N1 N2 V c Nend Vend O1 W1 cend}:
  all_diff_in_fw N1 V c N2 ->
  trace_cs (N1, V, c) (Nend, Vend, cend) O1 W1 ->
  end_com cend -> checkpoint \notin O1 ->
  trace_cs (N2, V, c) (Nend, Vend, cend) O1 W1.
  intros. move: N2 H.
  dependent induction H0; intros.
  + move: (trace_converge H H1) => Heq. subst.
    apply (CsTrace_Empty (N2, Vend, cend)).
  + move: (adif_cceval H0 H H1) => Hl.
    move: (two H0 H) => [Nend1 [Hcceval Hl2] ].
    suffices: Nend = Nend1.
    intros. subst. by apply CsTrace_Single.
    apply nvmem_eq.  intros l.
    destruct (l \in getwt(W)) eqn: Hbool.
       - apply Hl2. apply Hbool.
       -
         suffices: getmap N1 l = getmap N2 l.
         intros Heq.
         move: (update_one_c l H) => Himp1.
         apply contra in Himp1.
         move: (update_one_c l Hcceval) => Himp2.
         apply contra in Himp2.
         move /negPn/ eqP: Himp1.
         move /negPn/ eqP: Himp2.
         intros. rewrite - Himp1.
           by rewrite - Himp2.
           by move/ negbT: Hbool.
             by move/ negbT: Hbool.
          apply/ eqP.
          destruct (getmap N1 l == getmap N2 l) eqn: Hbool1.
          auto.
          move/ eqP : Hbool1.
          move/Hl => Hcontra.
          move: (fw_subst_wt_c H) => Hsub.
          apply (in_subseq Hsub) in Hcontra.
            by rewrite Hbool in Hcontra.
         + destruct Cmid as [ [Ni1 V1] c1].
           assert (checkpoint \notin O1) as Hcp1.
           apply/negP. intros contra.
           apply/negP/ negPn: H3.
           by apply in_app_l.
           move: (two_p_five H4 H1 Hcp1) => [Nmid [Hccevalmid Hdiff] ].
           eapply CsTrace_Cons.
           eapply IHtrace_cs; try reflexivity;
             try assumption; try apply Hdiff.
           apply/negP. intros contra.
           apply/negP/ negPn: H3.
           by apply in_app_r. assumption. assumption.
Qed.

(*ramping up to the final proof*)
Lemma adif_refl {N V c c1 Nend Vend O W}:
  trace_cs (N, V, c) (Nend, Vend, c1) O W ->
  end_com c1 ->
  checkpoint \notin O ->
        all_diff_in_fw N V c N.
  intros. econstructor; try apply H; try assumption; try by [].
  Qed.

   Lemma adif_sym {N1 V1 c1 Nc1}:
  all_diff_in_fw N1 V1 c1 Nc1 ->
  all_diff_in_fw Nc1 V1 c1 N1.
  intros Hdiff. inversion Hdiff. subst.
  move: (adif_works Hdiff T H H0) => Tdone.
  econstructor; try apply Tdone; try assumption.
 intros z Hz.
 apply not_eq_sym in Hz. by apply H1.
Qed.

Lemma adif_trans {Nc0 V1 c1 Nc1 Nc2}:
  all_diff_in_fw Nc0 V1 c1 Nc1 ->
  all_diff_in_fw Nc1 V1 c1 Nc2 ->
  all_diff_in_fw Nc0 V1 c1 Nc2.
  intros Hd1 Hd2. inversion Hd1. inversion Hd2. subst.
  move: (adif_works Hd1 T H H0) => Td1.
  move: (same_endcom Td1 T0 H H6 H0 H7) => Heq. subst.
  move: (determinism Td1 T0) => [one two]. subst.
  econstructor; try apply T; try assumption.
  intros l Hneq.
  destruct (getmap Nc0 l == getmap Nc1 l) eqn:Hbool; move/ eqP : Hbool => Heq. rewrite Heq in Hneq. by apply H8 in Hneq.
  by apply H1 in Heq.
Qed.

Lemma three_bc1 {Ni Ni1 V V1 c c1 Nc O W} :
  all_diff_in_fw Ni V c Nc ->
  cceval_w ( Ni, V, c) O (Ni1, V1, c1) W ->
    checkpoint \notin O ->
  ( exists(Nc1: nvmem), cceval_w (Nc, V, c) O (Nc1, V1, c1) W /\
                   all_diff_in_fw Ni1 V1 c1 Nc1).
intros. move: (two H H0) => [Nc1 [Hcceval Heq] ]. exists Nc1.
    split. assumption.
    inversion H. subst.
    assert (O0 <> [::]) as Ho0.
-
  intros Heq1. subst.
  move/empty_trace_cs1 : T => [ [contra10 [contra11 contra12] ] contra2]. subst. case H2 as [Hskip | [crem [w Hcp] ] ]; subst.
    inversion Hcceval. move/negP : H1. apply.
    apply (observe_checkpt_s Hcceval).
         move: (single_step_alls T Ho0 H0) => [W1 [O1 [T1 [Hsub Hw ] ] ] ].
         econstructor; try apply T1; try assumption.
         apply/ negP => contra.
         move/ negP : H3. apply.
 rewrite Hsub.
rewrite mem_cat. apply/orP.
by right.
         move => l Hl.
         destruct ((getmap Ni l) == (getmap Nc l)) eqn: Hcase;
           move/eqP: Hcase => Hcase.
         move: (update_onec H0 Hcceval Hcase Hl) => Hw1.
         apply Heq in Hw1. exfalso. by apply Hl.
         apply H4 in Hcase. subst. move/fw_split : Hcase => [Hc1 | Hc2].
         move : (in_subseq (fw_subst_wt_c H0) Hc1) => contra.
         apply Heq in contra.
         exfalso. by apply Hl. by destruct Hc2.
Qed.

(*if two memories are related and there is a continuous trace starting from one, there
 is a continuous trace starting from the other with identical observations*)
  Lemma three_bc  {Ni Ni1 V V1 c c1 Nc O W} :
  all_diff_in_fw Ni V c Nc ->
  trace_cs (Ni, V, c) (Ni1, V1, c1) O W ->
  checkpoint \notin O ->
  ( exists(Nc1: nvmem), trace_cs (Nc, V, c) (Nc1, V1, c1) O W /\
                   all_diff_in_fw Ni1 V1 c1 Nc1).
Proof. intros. move: Nc H. dependent induction H0; intros.
    (*empty trace case*)
  - exists Nc; split; auto; constructor.
    (*cceval case*)
  -  move: (three_bc1 H0 H H1) => [Nc1 [Hcceval Hdiff] ].
     exists Nc1. split; try assumption. apply (CsTrace_Single Hcceval).
  - (*inductive cs case*)
    destruct Cmid as [ [Nmid Vmid] cmid]. Check three_bc1.
    rewrite mem_cat in H2. move/norP : H2 => [H21 H22].
    move: (three_bc1 H3 H1 H21) => [Ncmid [Tmid Hmid] ].
    suffices: exists Nc1,
               trace_cs (Ncmid, Vmid, cmid) (Nc1, V1, c1) O2 W2 /\
               all_diff_in_fw Ni1 V1 c1 Nc1.
  - move => [ Nc1 [Tmid2end Hmid2end] ]. exists Nc1. split; try assumption.
    eapply CsTrace_Cons; try apply Tmid2end; try assumption.
    eapply IHtrace_cs; try reflexivity; try assumption.
 Qed.

(*if two memories are related and there is an intermittent trace starting from one which does
not cross a checkpoint boundary, there is a continuous trace starting from the other
with identical observations (only unbroken by reboots).
further, the relation is preserved from starting memories to ending memories,
 and given that the intermittent ending memory can proceed continuously to the end of
 a segment, the continuous ending memory can do the same, with related observations*)
Lemma threeIS1 {N0 Ni Ni1 Nend V V1 Vend c c1 Nc O W Oend Wend cend}:
  all_diff_in_fw Ni V c Nc ->
  trace_i1 ((N0, V, c), Ni, V, c) ((N0, V, c), Ni1, V1, c1) O W ->
  WARok (getdomain N0) [::] [::] c ->
  subset_nvm N0 Ni ->
  checkpoint \notin O ->
  trace_cs (Ni1, V1, c1) (Nend, Vend, cend) Oend Wend ->
  end_com cend -> checkpoint \notin Oend ->
  (exists(Oc Oendc: obseq) (Nc1: nvmem) (Wc Wendc: the_write_stuff),
      trace_cs (Nc, V, c) (Nc1, V1, c1) Oc Wc /\
      all_diff_in_fw Ni1 V1 c1 Nc1 /\ (O ++ Oend <=m Oc ++ Oendc)
     /\ trace_cs (Nc1, V1, c1) (Nend, Vend, cend) Oendc Wendc
  ).
Proof. intros. move: Nc H H3.
       dependent induction H0; intros.
  + move: (three_bc H3 H H0) => [ Nc1 [Tdone Hdone] ].
 exists O Oend Nc1 W Wend. repeat split; try assumption.
    apply RB_Base; try (rewrite mem_cat; apply/ norP; split);
    try assumption.
    apply (neg_observe_rb H).
    apply (neg_observe_rb H4).
      apply (adif_works Hdone H4); try assumption.
  + assert (all_diff_in_fw Ni V c (N0 U! Nmid)) as Hdiffrb.
    - inversion H8. subst.  econstructor; try apply T; try assumption.
   move => l. move/eqP/update_diff => [ [diff11 diff12] | [diff21 diff22] ]. case diff11. apply (H4 l diff12).
   move: (update H (not_eq_sym diff21)) => Hdiff.
   move: (wts_cped_sv H H3 H1 diff22 Hdiff)  => [good | bad].
   rewrite/remove filter_predT in good.
   apply (fw_gets_bigger H H1 T H10 good).
   rewrite in_nil in bad. by discriminate bad.
   suffices:
               exists Oc Oendc Nc1 Wc Wendc,
  trace_cs (Nc, V, c) (Nc1, V1, c1) Oc Wc /\
  all_diff_in_fw Ni1 V1 c1 Nc1 /\
  (O2 ++ Oend <=m Oc ++ Oendc) /\
  trace_cs (Nc1, V1, c1) (Nend, Vend, cend) Oendc Wendc.
   intros [Oc [Oendc [Nc1 [Wc [Wendc
                                 [ass1
                                    [ass2
                                       [ass3 ass4] ] ] ] ] ] ] ].
   exists Oc Oendc Nc1 Wc Wendc.
   repeat split; try assumption.
    assert (checkpoint \notin Oc ++ Oendc).
    apply no_CP_in_seq in ass3.
    by move: ass3 => [Ha1 Ha2].
   rewrite- catA.
   rewrite - catA.
   apply RB_Ind; try assumption.
   apply (neg_observe_rb H).
   rewrite mem_cat; apply/ norP; split.
    apply (neg_observe_rb ass1).
    apply (neg_observe_rb ass4).
    rewrite mem_cat.
    apply/ norP.
    split; assumption.
      move: (three_bc H8 H H1) => [Nc3 [threetrace whatever] ].
      move: (append_c ass1 ass4) => bigtrace.
      apply (ctrace_det_obs threetrace H1 bigtrace); try assumption.
   eapply IHtrace_i1; try reflexivity; try assumption.
   apply sub_update. apply (adif_trans (adif_sym Hdiffrb) H8).

  + repeat rewrite mem_cat in H3. move/norP: H3 => [Hb H3].
        move/norP: H3 => [contra Hb1]. by case/negP : contra.
Qed.

(*the same as threeIS1, only the intermittent trace can cross arbitrary checkpoint boundaries.
 the final result follows pretty quickly from this; one need only apply three with (the continuous trace ending
 at cend) equal to the empty trace*)
Lemma three {N0 N01 V01 c01 Ni Ni1 Nend V V1 Vend c c1 Nc O W Oend Wend cend}:
  all_diff_in_fw Ni V c Nc ->
  trace_i1 ((N0, V, c), Ni, V, c) ((N01, V01, c01), Ni1, V1, c1) O W ->
  WARok (getdomain N0) [::] [::] c ->
  subset_nvm N0 Ni ->
  trace_cs (Ni1, V1, c1) (Nend, Vend, cend) Oend Wend ->
  end_com cend -> checkpoint \notin Oend ->
  (exists(Oc Oendc: obseq) (Nc1: nvmem) (Wc Wendc: the_write_stuff) ,
      trace_cs (Nc, V, c) (Nc1, V1, c1) Oc Wc /\
      all_diff_in_fw Ni1 V1 c1 Nc1 /\ (O ++ Oend <=f (Oc ++ Oendc)) /\
      trace_cs (Nc1, V1, c1) (Nend, Vend, cend) Oendc Wendc
  ).
Proof.
  intros. move: Nc H H3. dependent induction H0; intros.
  + move: (three_bc H3 H H0) => [ Nc1 [Tdone Hdone] ].
    exists O Oend Nc1 W Wend. repeat split; try assumption.
    apply CP_Base. apply RB_Base; try (rewrite mem_cat; apply/ norP; split);
    try assumption.
    apply (neg_observe_rb H).
    apply (neg_observe_rb H6).
    apply (adif_works Hdone H6); try assumption.
  +
    move: (iTrace_RB H H0 H1 H2) => bigtrace.
    assert (checkpoint \notin O1 ++ [:: reboot] ++ O2) as Hcp.
    rewrite mem_cat. apply/ norP. split; try assumption.
move: (threeIS1 H7 bigtrace H3 H4 Hcp H8 H5 H6) =>
[Oc
   [Oendc
      [Nc1
         [Wc [
              Wendc
               [ ass1 [
                     ass2
                       [ass3 ass4]
                   ]
               ]
            ]
         ]
      ]
   ]
].
exists Oc Oendc Nc1 Wc Wendc. repeat split; try assumption.
repeat rewrite - catA.
apply CP_Base.
by repeat rewrite - catA in ass3.
  +
        remember ((incheckpoint w);;crem) as ccp.
       assert (end_com ccp) as Hend. unfold end_com. right.
       subst.
         by exists crem w.
        suffices: (exists Oc Oendc Nc1 Wc
                 Wendc Nc1end Vc1end cend,
                 trace_cs (Nc, V, c)
                          (Nc1, Vmid, ccp) Oc Wc /\
                 all_diff_in_fw Nmid Vmid ccp Nc1 /\
                 (O1 <=m Oc) /\
                 trace_cs (Nc1, Vmid, crem)
                   (Nc1end, Vc1end, cend) Oendc
                   Wendc /\ checkpoint \notin Oendc /\ end_com cend
                  ).
    - move => [Oc1 [Oendc1 [Nc1 [Wc1 [Wendc1 [ Nc1end [ Vc1end
            [ ccend [H11 [H12 [Ho1 [H13 [H14 H15] ] ] ] ] ] ] ] ] ] ] ] ]. subst.
      move: (trace_converge H12 Hend) => Heq. subst.
      assert (WARok (getdomain
                       (restrict Nc1 w Hw)) [::] [::] crem) as Hwarok2.
      destruct Nc1 as [mc1 dc1 Hnc1]. rewrite/getdomain. simpl.
      apply (warok_cp H1 H11).
        remember ((incheckpoint w);;crem) as ccp.
      suffices: (
                 exists Oc2 Oendc2 Nc2 Wc2 Wendc2,
                   trace_cs (Nc1, Vmid, crem)
                            (Nc2, V1, c1) Oc2 Wc2 /\
                   all_diff_in_fw Ni1 V1 c1 Nc2 /\
                   (O2 ++ Oend <=f Oc2 ++ Oendc2) /\
                 trace_cs (Nc2, V1, c1)
                   (Nend, Vend, cend) Oendc2 Wendc2
                ).
      move => [Oc2 [Oendc2 [Nc2 [Wc2 [Wendc2 [H21 [H22 [Ho2 H23] ] ] ] ] ] ] ].
     - subst. move: (append_cps H11 H21 Hw) => T1.
      exists (Oc1 ++ [::checkpoint] ++ Oc2) Oendc2 Nc2 (append_write Wc1 Wc2) Wendc2.
      repeat split; try assumption.
      repeat rewrite - catA. apply CP_IND; try assumption.
      - eapply IHtrace_i1_2;try reflexivity; try assumption;
        try apply sub_restrict.
        apply (adif_refl H13 H15 H14).
       move: (trace_append_ic H0_0 H3 H5) => Tendi.
              assert ( checkpoint \notin [::]) as Hcp.
              by rewrite in_nil.
       move: (threeIS1 H0 H0_ H1 H2 H
                       (CsTrace_Empty
                          (Nmid, Vmid, ccp )) Hend Hcp).
       => [Oc [Oendc [Nc1 [Wc [ Wendc500 [T1 [Hdiff [Hm Tempty] ] ] ] ] ] ] ].
       subst.
       move: (trace_converge Hdiff) => Hsamemem. subst.
       move/ empty_trace_cs : Tempty => [Heq
                                          blah ].
       subst.
       move: (exist_endcom Tendi H4) => [Oendc0 [Wendc0 [Nc1end0 [Vc1end
                                                           [cend0 [Tend [Hendcom Hoendc] ] ] ] ] ] ].
      apply trace_converge in Hdiff. subst.
      assert (WARok (getdomain
                       (restrict Nc1 w Hw)) [::] [::] crem) as Hwarok2.
      destruct Nc1 as [mc1 dc1 Hnc1]. rewrite/getdomain. simpl.
      subst.
      move: (same_comi H1 H2 H0_ H) => [Nend1 [Oc1 [Wc1 [Tc1 Hoc1] ] ] ].
      apply (warok_cp H1 Tc1).
       subst.
      move: (same_comi Hwarok2 (sub_restrict Nc1 w Hw) Tend Hoendc).
      =>
      [Nc1end [Oendc [Wendc [Tendc Hcpoendc] ] ] ].
       exists Oc Oendc Nc1 Wc Wendc Nc1end. exists Vc1end cend0. subst.
       repeat split; try assumption.
       econstructor; try eapply CsTrace_Empty; auto.
       by repeat rewrite cats0 in Hm. assumption.
Qed.

(*proof that definition 1 from 'Towards a Formal Foundation' holds for
 any intermittent trace which satisfies the WARok relation*)
Theorem One {N0 V c N01 V01 c01 N Oi Nendi Vend Wi
           }:
      trace_i1 ((N0, V, c), N, V, c) ((N01, V01, c01), Nendi, Vend, Ins skip) Oi Wi ->
subset_nvm N0 N ->
WARok (getdomain N0) [::] [::] c ->
(exists (Oc: obseq) (Wc: the_write_stuff) , trace_cs (N, V, c) (Nendi, Vend, Ins skip) Oc Wc /\
                                                     (Oi <=f Oc)).
  intros.
assert (end_com skip) as Hskip. by left.
suffices:
  (exists(Oc Oendc: obseq) (Nendc: nvmem) (Wc Wendc: the_write_stuff),
      trace_cs (N, V, c) (Nendc, Vend, Ins skip) Oc Wc /\
 all_diff_in_fw Nendi Vend skip Nendc /\ trace_cs (Nendc, Vend, Ins skip)
            (Nendc, Vend, Ins skip) Oendc Wendc
  ).
move => [Oc
          [ Oendc [Nendc
             [Wc
                [Wendc
                   [Tc
                      [Hdiff Tend] ] ] ] ] ] ].
exists Oc Wc. repeat skip; try assumption.
suffices: all_diff_in_fw N V c N.
move => Hdiff.
move: (three Hdiff H H1 H0 (CsTrace_Empty (Nendi, Vend, (Ins skip))) Hskip
      (notin checkpoint)).
=> [Oc [Oendc [Nendc [Wc [ Wendc [T1 [Hdiffend [Hm Tempty] ] ] ] ] ] ] ].
exists Oc Oendc Nendi Wc Wendc.
move: (empty_trace_cs Tempty). => [Ho [Hn [Hv Hw] ] ]. subst.
repeat split; try assumption.
move: (exist_endcom H Hskip) => [Osmall
                                  [Wsmall
                                     [Nmid
                                     [Vmid
                                           [cmid
                                              [Tsmall
                                                 [Hend Hcp ]  ] ] ] ] ] ].
move: (same_comi H1 H0 Tsmall Hcp) => [N2 [Osc [c2 [Tsc Hosc] ] ] ].
econstructor; try apply Tsc; try assumption.
  by intros.
 Qed.


Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.Classical_Prop.
Require Import Coq.Logic.Classical_Pred_Type.
Require Import Logic.lib.Bijection.
Require Import Logic.lib.Countable.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.KripkeModel.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.Semantics.Kripke.
Require Import Logic.GeneralLogic.Complete.ContextProperty_Kripke.

Local Open Scope logic_base.
Local Open Scope kripke_model.
Import KripkeModelFamilyNotation.
Import KripkeModelNotation_Intuitionistic.

Section Canonical.

Context {L: Language}
        {Gamma: ProofTheory L}
        {bSC: BasicSequentCalculus L Gamma}
        {MD: Model}
        {kMD: KripkeModel MD}
        {M: Kmodel}
        {R: Relation (Kworlds M)}
        {SM: Semantics L MD}.

Context (cP: context -> Prop)
        (rel: bijection (Kworlds M) (sig cP)).

Hypothesis H_R: forall m n Phi Psi, rel m Phi -> rel n Psi -> (m <= n <-> Included _ (proj1_sig Phi) (proj1_sig Psi)).

Lemma denote_monotonic (x: expr):
  (forall m Phi, rel m Phi -> (KRIPKE: M, m |= x <-> proj1_sig Phi x)) ->
  upwards_closed_Kdenote (Kdenotation M x).
Proof.
  intros.
  hnf; intros.
  change (KRIPKE: M, m |= x).
  change (KRIPKE: M, n |= x) in H1.
  destruct (im_bij _ _ rel n) as [Phi ?].
  destruct (im_bij _ _ rel m) as [Psi ?].
  erewrite H in H1 |- * by eauto.
  eapply H_R in H0; eauto.
  apply H0; auto.
Qed.

Instance po_R: PreOrder (@KI.Krelation _ R).
Proof.
  constructor.
  + hnf; intros m.
    destruct (im_bij _ _ rel m) as [Phi ?].
    apply (H_R _ _ _ _ H H).
    hnf; intros; auto.
  + hnf; intros m1 m2 m3.
    destruct (im_bij _ _ rel m1) as [Phi1 ?].
    destruct (im_bij _ _ rel m2) as [Phi2 ?].
    destruct (im_bij _ _ rel m3) as [Phi3 ?].
    rewrite (H_R _ _ _ _ H H0).
    rewrite (H_R _ _ _ _ H0 H1).
    rewrite (H_R _ _ _ _ H H1).
    clear; unfold Included, Ensembles.In; firstorder.
Qed.

End Canonical.