From Hammer Require Import Hammer.

Require Import Bool.
Require Import NArith.
Require Import Ndec.
Require Import Ndigits.
Require Import ZArith.
Require Import Classical_Prop.
From IntMap Require Import Allmaps.
From TreeAutomata Require Import bases.
From TreeAutomata Require Import defs.
From TreeAutomata Require Import semantics.
From TreeAutomata Require Import signature.
From TreeAutomata Require Import refcorrect.
From TreeAutomata Require Import union.

Lemma upl_conv_0_correct_wrt_sign_invar :
forall (p : prec_list) (n : nat),
pl_tl_length p n -> pl_tl_length (upl_conv_0 p) n.
Proof. hammer_hook "union_correct" "union_correct.upl_conv_0_correct_wrt_sign_invar".
simple induction p; intros. simpl in |- *. inversion H1. simpl in |- *. exact (pl_tl_S (uad_conv_0 a) (upl_conv_0 p0) n0 (H _ H6)).
exact
(pl_tl_propag (uad_conv_0 a) (upl_conv_0 p0) (upl_conv_0 p1) n0
(H _ H6) (H0 _ H7)). simpl in |- *. inversion H. exact pl_tl_O.
Qed.

Lemma upl_conv_1_correct_wrt_sign_invar :
forall (p : prec_list) (n : nat),
pl_tl_length p n -> pl_tl_length (upl_conv_1 p) n.
Proof. hammer_hook "union_correct" "union_correct.upl_conv_1_correct_wrt_sign_invar".
simple induction p; intros. simpl in |- *. inversion H1. simpl in |- *. exact (pl_tl_S (uad_conv_1 a) (upl_conv_1 p0) n0 (H _ H6)).
exact
(pl_tl_propag (uad_conv_1 a) (upl_conv_1 p0) (upl_conv_1 p1) n0
(H _ H6) (H0 _ H7)). simpl in |- *. inversion H. exact pl_tl_O.
Qed.

Lemma umpl_conv_0_correct_wrt_sign_invar_0 :
forall (s : state) (sigma : signature) (pa : pre_ad),
state_correct_wrt_sign_with_offset s sigma pa ->
state_correct_wrt_sign_with_offset (umpl_conv_0 s) sigma pa.
Proof. hammer_hook "union_correct" "union_correct.umpl_conv_0_correct_wrt_sign_invar_0".
simple induction s. intros. simpl in |- *. exact H. intros. simpl in |- *.
unfold state_correct_wrt_sign_with_offset in H.
unfold state_correct_wrt_sign_with_offset in |- *. intros.
simpl in H0. elim (H a a0). intros. split with x. elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H2 in H0. inversion H0. elim H1. intros. rewrite (Neqb_complete _ _ H2) in H3. split. exact H3. exact (upl_conv_0_correct_wrt_sign_invar _ _ H5). inversion H0. simpl in |- *. rewrite (Neqb_correct a).
reflexivity. intros. unfold state_correct_wrt_sign_with_offset in H1.
unfold state_correct_wrt_sign_with_offset in |- *. intros. unfold state_correct_wrt_sign_with_offset in H. unfold state_correct_wrt_sign_with_offset in H0. induction  a as [| p0]. simpl in H2.
elim (H sigma (pre_ad_O pa)) with (a := N0) (p := p). intros.
split with x. simpl in H3. exact H3. intros. elim (H1 (N.double a) p0). intros. split with x. simpl in |- *. exact H4. induction  a as [| p1]; simpl in |- *; exact H3. exact H2. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. elim (H0 sigma (pre_ad_I pa)) with (a := Npos p0) (p := p). intros. split with x. simpl in H3. exact H3.
intros. elim (H1 (Ndouble_plus_one a) p1). intros. split with x.
induction  a as [| p2]. simpl in H4. simpl in |- *. exact H4. simpl in H4. simpl in |- *.
exact H4. induction  a as [| p2]; simpl in |- *; exact H3. simpl in H2. exact H2.
elim (H sigma (pre_ad_O pa)) with (a := Npos p0) (p := p). intros.
split with x. simpl in H3. exact H3. intros. elim (H1 (N.double a) p1). intros. split with x. induction  a as [| p2]; simpl in H4; simpl in |- *; exact H4. induction  a as [| p2]; simpl in |- *; exact H3. simpl in H2. exact H2.
elim (H0 sigma (pre_ad_I pa)) with (a := N0) (p := p). intros. split with x. simpl in H3. exact H3. intros. elim (H1 (Ndouble_plus_one a) p0). intros. split with x. induction  a as [| p1]; simpl in |- *; simpl in H4; exact H4. induction  a as [| p1]; simpl in |- *; exact H3. simpl in H2. exact H2.
Qed.

Lemma umpl_conv_0_correct_wrt_sign_invar :
forall (s : state) (sigma : signature),
state_correct_wrt_sign s sigma ->
state_correct_wrt_sign (umpl_conv_0 s) sigma.
Proof. hammer_hook "union_correct" "union_correct.umpl_conv_0_correct_wrt_sign_invar".
unfold state_correct_wrt_sign in |- *. intros. elim
(umpl_conv_0_correct_wrt_sign_invar_0 s sigma pre_ad_empty)
with (a := a) (p := p). intros. split with x. simpl in H1. exact H1.
unfold state_correct_wrt_sign_with_offset in |- *. simpl in |- *. exact H.
exact H0.
Qed.

Lemma umpl_conv_1_correct_wrt_sign_invar_0 :
forall (s : state) (sigma : signature) (pa : pre_ad),
state_correct_wrt_sign_with_offset s sigma pa ->
state_correct_wrt_sign_with_offset (umpl_conv_1 s) sigma pa.
Proof. hammer_hook "union_correct" "union_correct.umpl_conv_1_correct_wrt_sign_invar_0".
simple induction s. intros. simpl in |- *. exact H. intros. simpl in |- *.
unfold state_correct_wrt_sign_with_offset in H.
unfold state_correct_wrt_sign_with_offset in |- *. intros.
simpl in H0. elim (H a a0). intros. split with x. elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H2 in H0. inversion H0. elim H1. intros. rewrite (Neqb_complete _ _ H2) in H3. split. exact H3. exact (upl_conv_1_correct_wrt_sign_invar _ _ H5). inversion H0. simpl in |- *. rewrite (Neqb_correct a).
reflexivity. intros. unfold state_correct_wrt_sign_with_offset in H1.
unfold state_correct_wrt_sign_with_offset in |- *. intros. unfold state_correct_wrt_sign_with_offset in H. unfold state_correct_wrt_sign_with_offset in H0. induction  a as [| p0]. simpl in H2.
elim (H sigma (pre_ad_O pa)) with (a := N0) (p := p). intros.
split with x. simpl in H3. exact H3. intros. elim (H1 (N.double a) p0). intros. split with x. simpl in |- *. exact H4. induction  a as [| p1]; simpl in |- *; exact H3. exact H2. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. elim (H0 sigma (pre_ad_I pa)) with (a := Npos p0) (p := p). intros. split with x. simpl in H3. exact H3.
intros. elim (H1 (Ndouble_plus_one a) p1). intros. split with x.
induction  a as [| p2]. simpl in H4. simpl in |- *. exact H4. simpl in H4. simpl in |- *.
exact H4. induction  a as [| p2]; simpl in |- *; exact H3. simpl in H2. exact H2.
elim (H sigma (pre_ad_O pa)) with (a := Npos p0) (p := p). intros.
split with x. simpl in H3. exact H3. intros. elim (H1 (N.double a) p1). intros. split with x. induction  a as [| p2]; simpl in H4; simpl in |- *; exact H4. induction  a as [| p2]; simpl in |- *; exact H3. simpl in H2. exact H2.
elim (H0 sigma (pre_ad_I pa)) with (a := N0) (p := p). intros. split with x. simpl in H3. exact H3. intros. elim (H1 (Ndouble_plus_one a) p0). intros. split with x. induction  a as [| p1]; simpl in |- *; simpl in H4; exact H4. induction  a as [| p1]; simpl in |- *; exact H3. simpl in H2. exact H2.
Qed.

Lemma umpl_conv_1_correct_wrt_sign_invar :
forall (s : state) (sigma : signature),
state_correct_wrt_sign s sigma ->
state_correct_wrt_sign (umpl_conv_1 s) sigma.
Proof. hammer_hook "union_correct" "union_correct.umpl_conv_1_correct_wrt_sign_invar".
unfold state_correct_wrt_sign in |- *. intros. elim
(umpl_conv_1_correct_wrt_sign_invar_0 s sigma pre_ad_empty)
with (a := a) (p := p). intros. split with x. simpl in H1. exact H1.
unfold state_correct_wrt_sign_with_offset in |- *. simpl in |- *. exact H.
exact H0.
Qed.

Lemma udta_conv_0_correct_wrt_sign_invar_0 :
forall (d : preDTA) (sigma : signature),
predta_correct_wrt_sign d sigma ->
predta_correct_wrt_sign (udta_conv_0_aux d) sigma.
Proof. hammer_hook "union_correct" "union_correct.udta_conv_0_correct_wrt_sign_invar_0".
unfold predta_correct_wrt_sign in |- *. simple induction d. intros. inversion H0.
intros. simpl in H0. elim (bool_is_true_or_false (N.eqb a a1)); intros. rewrite H1 in H0. inversion H0. apply (umpl_conv_0_correct_wrt_sign_invar a0 sigma). apply (H a a0).
simpl in |- *. rewrite (Neqb_correct a). reflexivity. rewrite H1 in H0.
inversion H0. intros. simpl in H2. induction  a as [| p]. apply (H sigma) with (a := N0) (s := s). intros. apply (H1 (N.double a) s0).
induction  a as [| p]; simpl in |- *; exact H3. exact H2. induction  p as [p Hrecp| p Hrecp| ]; simpl in H2.
apply (H0 sigma) with (a := Npos p) (s := s). intros. apply (H1 (Ndouble_plus_one a) s0). induction  a as [| p0]; simpl in |- *; exact H3. exact H2.
apply (H sigma) with (a := Npos p) (s := s). intros. apply (H1 (N.double a) s0). induction  a as [| p0]; simpl in |- *; exact H3. exact H2. apply (H0 sigma) with (a := N0) (s := s). intros. apply (H1 (Ndouble_plus_one a) s0).
induction  a as [| p]; simpl in |- *; exact H3. exact H2.
Qed.

Lemma udta_conv_0_correct_wrt_sign_invar :
forall (d : preDTA) (sigma : signature),
predta_correct_wrt_sign d sigma ->
predta_correct_wrt_sign (udta_conv_0 d) sigma.
Proof. hammer_hook "union_correct" "union_correct.udta_conv_0_correct_wrt_sign_invar".
unfold udta_conv_0 in |- *. intros. unfold predta_correct_wrt_sign in |- *. intros.
induction  a as [| p]. simpl in H0. exact (udta_conv_0_correct_wrt_sign_invar_0 d sigma H N0 s H0). induction  p as [p Hrecp| p Hrecp| ]; simpl in H0. inversion H0.
exact (udta_conv_0_correct_wrt_sign_invar_0 d sigma H (Npos p) s H0).
inversion H0.
Qed.

Lemma udta_conv_1_correct_wrt_sign_invar_0 :
forall (d : preDTA) (sigma : signature),
predta_correct_wrt_sign d sigma ->
predta_correct_wrt_sign (udta_conv_1_aux d) sigma.
Proof. hammer_hook "union_correct" "union_correct.udta_conv_1_correct_wrt_sign_invar_0".
unfold predta_correct_wrt_sign in |- *. simple induction d. intros. inversion H0.
intros. simpl in H0. elim (bool_is_true_or_false (N.eqb a a1)); intros. rewrite H1 in H0. inversion H0. apply (umpl_conv_1_correct_wrt_sign_invar a0 sigma). apply (H a a0).
simpl in |- *. rewrite (Neqb_correct a). reflexivity. rewrite H1 in H0.
inversion H0. intros. simpl in H2. induction  a as [| p]. apply (H sigma) with (a := N0) (s := s). intros. apply (H1 (N.double a) s0).
induction  a as [| p]; simpl in |- *; exact H3. exact H2. induction  p as [p Hrecp| p Hrecp| ]; simpl in H2.
apply (H0 sigma) with (a := Npos p) (s := s). intros. apply (H1 (Ndouble_plus_one a) s0). induction  a as [| p0]; simpl in |- *; exact H3. exact H2.
apply (H sigma) with (a := Npos p) (s := s). intros. apply (H1 (N.double a) s0). induction  a as [| p0]; simpl in |- *; exact H3. exact H2. apply (H0 sigma) with (a := N0) (s := s). intros. apply (H1 (Ndouble_plus_one a) s0).
induction  a as [| p]; simpl in |- *; exact H3. exact H2.
Qed.

Lemma udta_conv_1_correct_wrt_sign_invar :
forall (d : preDTA) (sigma : signature),
predta_correct_wrt_sign d sigma ->
predta_correct_wrt_sign (udta_conv_1 d) sigma.
Proof. hammer_hook "union_correct" "union_correct.udta_conv_1_correct_wrt_sign_invar".
unfold udta_conv_1 in |- *. intros. unfold predta_correct_wrt_sign in |- *. intros.
induction  a as [| p]. simpl in H0. inversion H0. induction  p as [p Hrecp| p Hrecp| ]; simpl in H0.
exact (udta_conv_1_correct_wrt_sign_invar_0 d sigma H (Npos p) s H0).
inversion H0. exact (udta_conv_1_correct_wrt_sign_invar_0 d sigma H N0 s H0).
Qed.

Lemma umerge_correct_wrt_sign_invar :
forall (d0 d1 : preDTA) (sigma : signature),
predta_correct_wrt_sign d0 sigma ->
predta_correct_wrt_sign d1 sigma ->
predta_correct_wrt_sign (u_merge d0 d1) sigma.
Proof. hammer_hook "union_correct" "union_correct.umerge_correct_wrt_sign_invar".
unfold predta_correct_wrt_sign in |- *. intros. elim (adcnv_disj a).
intros. elim H2; intros. elim (u_conv_0_invar_5 d0 x s). intros.
elim H4. intros. apply (udta_conv_0_correct_wrt_sign_invar d0 sigma H a s). exact (u_merge_0r d0 d1 a s H1 x H3). rewrite <- H3.
exact (u_merge_0r d0 d1 a s H1 x H3). elim (u_conv_1_invar_5 d1 x s).
intros. elim H4. intros. apply (udta_conv_1_correct_wrt_sign_invar d1 sigma H0 a s). exact (u_merge_1r d0 d1 a s H1 x H3). rewrite <- H3. exact (u_merge_1r d0 d1 a s H1 x H3).
Qed.

Lemma union_pl_correct_wrt_sign_invar :
forall (p0 p1 : prec_list) (n : nat),
pl_tl_length p0 n -> pl_tl_length p1 n -> pl_tl_length (union_pl p0 p1) n.
Proof. hammer_hook "union_correct" "union_correct.union_pl_correct_wrt_sign_invar".
simple induction p0. intros. simpl in |- *. inversion H1. simpl in |- *. rewrite <- H4 in H2. exact (pl_tl_propag a p p2 n0 H7 H2). rewrite <- H5 in H2. exact (pl_tl_propag a p (union_pl p1 p2) n0 H7 (H0 p2 (S n0) H8 H2)). intros. inversion H. rewrite <- H2 in H0. inversion H0. simpl in |- *. exact pl_tl_O.
Qed.

Lemma union_mpl_correct_wrt_sign_invar_0 :
forall (s : state) (a : ad) (p : prec_list) (pa : pre_ad)
(sigma : signature),
state_correct_wrt_sign_with_offset s sigma pa ->
state_correct_wrt_sign_with_offset (M1 prec_list a p) sigma pa ->
state_correct_wrt_sign_with_offset (union_mpl_0 a p s) sigma pa.
Proof. hammer_hook "union_correct" "union_correct.union_mpl_correct_wrt_sign_invar_0".
simple induction s. unfold state_correct_wrt_sign_with_offset in |- *. intros.
exact (H0 _ _ H1). unfold state_correct_wrt_sign_with_offset in |- *.
intros. simpl in H1. elim (bool_is_true_or_false (N.eqb a1 a)); intros; rewrite H2 in H1. elim (H a a0). intros. elim (H0 a p).
intros. elim H3. elim H4. intros. simpl in H1. elim (bool_is_true_or_false (N.eqb a1 a2)); intros; rewrite H9 in H1;
inversion H1. rewrite H7 in H5. inversion H5. split with x.
rewrite <- H12 in H6. split. rewrite <- (Neqb_complete _ _ H9). rewrite (Neqb_complete _ _ H2). exact H7. exact (union_pl_correct_wrt_sign_invar p a0 x H6 H8). simpl in |- *. rewrite H2. reflexivity. simpl in |- *. rewrite (Neqb_correct a). reflexivity. elim (N.discr (Nxor a a1)).
intro y. elim y. intros x y0. rewrite y0 in H1. rewrite (MapPut1_semantics prec_list x a a1 a0 p y0) in H1. elim (bool_is_true_or_false (N.eqb a a2)); intros; rewrite H3 in H1. inversion H1. elim (H a a0). intros.
elim H4. intros. split with x0. rewrite <- (Neqb_complete _ _ H3).
rewrite <- H5. exact H4. simpl in |- *. rewrite (Neqb_correct a).
reflexivity. elim (bool_is_true_or_false (N.eqb a1 a2)); intros.
rewrite H4 in H1. inversion H1. elim (H0 a1 p). intros. split with x0. rewrite (Neqb_complete _ _ H4) in H5. rewrite H6 in H5.
exact H5. simpl in |- *. rewrite (Neqb_correct a1). reflexivity.
rewrite H4 in H1. inversion H1. intros y. rewrite (Neqb_comm a1 a) in H2. rewrite (Nxor_eq_true _ _ y) in H2. inversion H2.
intros. unfold state_correct_wrt_sign_with_offset in |- *. intros.
cut (state_correct_wrt_sign_with_offset m sigma (pre_ad_O pa)).
cut (state_correct_wrt_sign_with_offset m0 sigma (pre_ad_I pa)).
intros. induction  a as [| p1]. simpl in H3. cut
(state_correct_wrt_sign_with_offset (M1 prec_list N0 p) sigma
(pre_ad_O pa)). intros. induction  a0 as [| p1].
elim (H _ _ _ _ H5 H6 N0 p0). intros. split with x. simpl in H7.
exact H7. exact H3. induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]. elim (H4 (Npos p1) p0). intros.
split with x. simpl in H7. exact H7. exact H3. elim (H _ _ _ _ H5 H6 (Npos p1) p0). intros. split with x. simpl in H7. exact H7.
exact H3. elim (H4 N0 p0). intros. split with x. simpl in H7.
exact H7. exact H3. unfold state_correct_wrt_sign_with_offset in |- *.
intros. elim (H2 (N.double a) p1). intros. split with x.
induction  a as [| p2]; simpl in |- *; simpl in H7; exact H7. simpl in H6.
elim (N.discr a). intros y. elim y. intros x y0. rewrite y0 in H6.
inversion H6. intros y. rewrite y in H6. rewrite y. simpl in |- *.
exact H6. induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]. cut
(state_correct_wrt_sign_with_offset (M1 prec_list (Npos p1) p) sigma
(pre_ad_I pa)). intro. induction  a0 as [| p2]. simpl in H3. elim (H5 N0 p0). intros. split with x. simpl in H7. exact H7. exact H3. induction  p2 as [p2 Hrecp2| p2 Hrecp2| ]; simpl in H3. elim (H0 _ _ _ _ H4 H6 (Npos p2) p0). intros. split with x. simpl in H7.
exact H7. exact H3. elim (H5 (Npos p2) p0). intros. split with x.
simpl in H7. exact H7. exact H3. elim (H0 _ _ _ _ H4 H6 N0 p0).
intros. split with x. simpl in H7. exact H7. exact H3.
unfold state_correct_wrt_sign_with_offset in |- *. intros. elim (H2 (Ndouble_plus_one a) p2). intros. split with x. induction  a as [| p3]; simpl in |- *; simpl in H7; exact H7. induction  a as [| p3]; simpl in |- *; exact H6. cut
(state_correct_wrt_sign_with_offset (M1 prec_list (Npos p1) p) sigma
(pre_ad_O pa)). intros. induction  a0 as [| p2]. simpl in H3.
elim (H _ _ _ _ H5 H6 N0 p0). intros. split with x. simpl in H7.
exact H7. exact H3. induction  p2 as [p2 Hrecp2| p2 Hrecp2| ]; simpl in H3. elim (H4 (Npos p2) p0).
intros. split with x. simpl in H7. exact H7. exact H3. elim (H _ _ _ _ H5 H6 (Npos p2) p0). intros. split with x. simpl in H7.
exact H7. exact H3. elim (H4 N0 p0). intros. split with x. simpl in H7. exact H7. exact H3. unfold state_correct_wrt_sign_with_offset in |- *.
intros. elim (H2 (N.double a) p2). intros. split with x.
induction  a as [| p3]; simpl in |- *; simpl in H7; exact H7. induction  a as [| p3]; simpl in |- *; exact H6. cut
(state_correct_wrt_sign_with_offset (M1 prec_list N0 p) sigma
(pre_ad_I pa)). intro. induction  a0 as [| p1]. simpl in H3.
elim (H5 N0 p0). intros. split with x. simpl in H7. exact H7.
exact H3. induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]; simpl in H3. elim (H0 _ _ _ _ H4 H6 (Npos p1) p0). intros. split with x. simpl in H7. exact H7.
exact H3. elim (H5 (Npos p1) p0). intros. split with x. simpl in H7. exact H7. exact H3. elim (H0 _ _ _ _ H4 H6 N0 p0).
intros. split with x. simpl in H7. exact H7. exact H3. unfold state_correct_wrt_sign_with_offset in |- *. intros. elim (H2 (Ndouble_plus_one a) p1). intros. split with x. induction  a as [| p2]; simpl in |- *; simpl in H7; exact H7. induction  a as [| p2]; simpl in |- *. simpl in H6. exact H6. simpl in H6. inversion H6. unfold state_correct_wrt_sign_with_offset in |- *.
intros. elim (H1 (Ndouble_plus_one a1) p1). intros. split with x.
induction  a1 as [| p2]; simpl in H5; simpl in |- *; exact H5. induction  a1 as [| p2]; simpl in |- *; exact H4. unfold state_correct_wrt_sign_with_offset in |- *. intros.
elim (H1 (N.double a1) p1). intros. split with x. induction  a1 as [| p2]; simpl in |- *; simpl in H5; exact H5. induction  a1 as [| p2]; simpl in |- *; exact H4.
Qed.

Lemma union_mpl_correct_wrt_sign_invar_1 :
forall (s0 s1 : state) (pa : pre_ad) (sigma : signature),
state_correct_wrt_sign_with_offset s0 sigma pa ->
state_correct_wrt_sign_with_offset s1 sigma pa ->
state_correct_wrt_sign_with_offset (union_mpl s0 s1) sigma pa.
Proof. hammer_hook "union_correct" "union_correct.union_mpl_correct_wrt_sign_invar_1".
simple induction s0. simpl in |- *. simple induction s1; intros. exact H0. exact H0. exact H2.
simpl in |- *. simple induction s1. intros. exact (union_mpl_correct_wrt_sign_invar_0 (M0 prec_list) a a0 pa sigma H0 H). intros. elim (bool_is_true_or_false (N.eqb a1 a)); intros; rewrite H1. unfold state_correct_wrt_sign_with_offset in |- *.
intros. simpl in H2. elim (bool_is_true_or_false (N.eqb a1 a3)); intros; rewrite H3 in H2. inversion H2. elim (H a a0). intros. elim (H0 a1 a2).
intros. split with x. rewrite (Neqb_complete _ _ H1) in H6. split.
elim H4. intros. rewrite <- (Neqb_complete _ _ H3). rewrite (Neqb_complete _ _ H1). exact H7. elim H4. elim H6. intros.
rewrite H9 in H7. inversion H7. rewrite H12 in H10. exact (union_pl_correct_wrt_sign_invar _ _ _ H8 H10). simpl in |- *. rewrite (Neqb_correct a1). reflexivity. simpl in |- *. rewrite (Neqb_correct a).
reflexivity. inversion H2. elim (N.discr (Nxor a a1)); intro y. elim y.
intros x y0. rewrite y0. unfold state_correct_wrt_sign_with_offset in |- *. intros.
rewrite (MapPut1_semantics prec_list x a a1 a0 a2) in H2. elim (bool_is_true_or_false (N.eqb a a3)); intros. rewrite H3 in H2.
inversion H2. elim (H a a0). intros. split with x0. rewrite (Neqb_complete _ _ H3) in H4. rewrite H5 in H4. exact H4. simpl in |- *.
rewrite (Neqb_correct a). reflexivity. rewrite H3 in H2. elim (bool_is_true_or_false (N.eqb a1 a3)); intros. rewrite H4 in H2.
inversion H2. elim (H0 a1 a2). intros. split with x0. rewrite (Neqb_complete _ _ H4) in H5. rewrite H6 in H5. exact H5. simpl in |- *.
rewrite (Neqb_correct a1). reflexivity. rewrite H4 in H2. inversion H2. exact y0. rewrite (Neqb_comm a1 a) in H1. rewrite (Nxor_eq_true _ _ y) in H1. inversion H1. intros. simpl in |- *. induction  a as [| p]. exact (union_mpl_correct_wrt_sign_invar_0 _ _ _ _ _ H2 H1). induction  p as [p Hrecp| p Hrecp| ].
clear Hrecp. replace
(state_correct_wrt_sign_with_offset
(M2 prec_list m (union_mpl_0 (Npos p) a0 m0)) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos (xI p)) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos (xI p)) a0 pa sigma H2 H1). reflexivity.
clear Hrecp. replace
(state_correct_wrt_sign_with_offset
(M2 prec_list (union_mpl_0 (Npos p) a0 m) m0) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos (xO p)) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos (xO p)) a0 pa sigma H2 H1). reflexivity.
replace
(state_correct_wrt_sign_with_offset
(M2 prec_list m (union_mpl_0 N0 a0 m0)) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos 1) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos 1) a0 pa sigma H2 H1). reflexivity. simple induction s1. intros. simpl in |- *. exact H1.
intros. simpl in |- *. induction  a as [| p]. replace
(state_correct_wrt_sign_with_offset
(M2 prec_list (union_mpl_0 N0 a0 m) m0) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 N0 a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0) N0 a0 pa sigma H1
H2). reflexivity. induction  p as [p Hrecp| p Hrecp| ].
replace
(state_correct_wrt_sign_with_offset
(M2 prec_list m (union_mpl_0 (Npos p) a0 m0)) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos (xI p)) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos (xI p)) a0 pa sigma H1 H2). reflexivity. replace
(state_correct_wrt_sign_with_offset
(M2 prec_list (union_mpl_0 (Npos p) a0 m) m0) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos (xO p)) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos (xO p)) a0 pa sigma H1 H2). reflexivity.
replace
(state_correct_wrt_sign_with_offset
(M2 prec_list m (union_mpl_0 N0 a0 m0)) sigma pa) with
(state_correct_wrt_sign_with_offset
(union_mpl_0 (Npos 1) a0 (M2 prec_list m m0)) sigma pa). exact
(union_mpl_correct_wrt_sign_invar_0 (M2 prec_list m m0)
(Npos 1) a0 pa sigma H1 H2). reflexivity. intros. simpl in |- *. elim (state_correct_wrt_sign_with_offset_M2 _ _ _ _ H3). elim (state_correct_wrt_sign_with_offset_M2 _ _ _ _ H4). intros. cut
(state_correct_wrt_sign_with_offset (union_mpl m m1) sigma (pre_ad_O pa)).
cut
(state_correct_wrt_sign_with_offset (union_mpl m0 m2) sigma (pre_ad_I pa)). intros. unfold state_correct_wrt_sign_with_offset in |- *. intros.
induction  a as [| p0]. elim (H10 N0 p). intros. split with x. simpl in H12.
exact H12. simpl in H11. exact H11. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. elim (H9 (Npos p0) p).
intros. split with x. simpl in H12. exact H12. simpl in H11.
exact H11. elim (H10 (Npos p0) p). intros. split with x. simpl in H12. exact H12. simpl in H11. exact H11. elim (H9 N0 p). intros.
simpl in H12. simpl in H11. split with x. exact H12. exact H11.
exact (H0 _ _ _ H8 H6). exact (H _ _ _ H7 H5).
Qed.

Lemma union_mpl_correct_wrt_sign_invar :
forall (s0 s1 : state) (sigma : signature),
state_correct_wrt_sign s0 sigma ->
state_correct_wrt_sign s1 sigma ->
state_correct_wrt_sign (union_mpl s0 s1) sigma.
Proof. hammer_hook "union_correct" "union_correct.union_mpl_correct_wrt_sign_invar".
intros. replace (state_correct_wrt_sign (union_mpl s0 s1) sigma) with
(state_correct_wrt_sign_with_offset (union_mpl s0 s1) sigma pre_ad_empty). apply (union_mpl_correct_wrt_sign_invar_1 s0 s1 pre_ad_empty sigma). unfold state_correct_wrt_sign_with_offset in |- *.
simpl in |- *. exact H. unfold state_correct_wrt_sign_with_offset in |- *. simpl in |- *.
exact H0. unfold state_correct_wrt_sign_with_offset in |- *. reflexivity.
Qed.

Lemma union_0_correct_wrt_sign_invar :
forall (d : preDTA) (a0 a1 : ad) (s : state) (sigma : signature),
predta_correct_wrt_sign d sigma ->
union_0 d a0 a1 = Some s -> state_correct_wrt_sign s sigma.
Proof. hammer_hook "union_correct" "union_correct.union_0_correct_wrt_sign_invar".
unfold union_0 in |- *. unfold union_opt_state in |- *. intros. elim (option_sum state (MapGet state d (uad_conv_0 a0))); intros y. elim y. intros x y0.
rewrite y0 in H0. elim (option_sum state (MapGet state d (uad_conv_1 a1))); intros y1. elim y1. intros x0 y2. rewrite y2 in H0. inversion H0. apply (union_mpl_correct_wrt_sign_invar x x0 sigma). unfold predta_correct_wrt_sign in H. exact (H _ _ y0). unfold predta_correct_wrt_sign in H. exact (H _ _ y2).
rewrite y1 in H0. inversion H0. rewrite <- H2. exact (H _ _ y0).
rewrite y in H0. elim (option_sum state (MapGet state d (uad_conv_1 a1))).
intros y0. elim y0. intros x y1. rewrite y1 in H0. inversion H0. rewrite <- H2.
exact (H _ _ y1). intros y0. rewrite y0 in H0. inversion H0.
Qed.

Lemma insert_ostate_correct_wrt_sign_invar :
forall (d : preDTA) (a : ad) (s : state) (sigma : signature),
predta_correct_wrt_sign d sigma ->
state_correct_wrt_sign s sigma ->
predta_correct_wrt_sign (insert_ostate d a (Some s)) sigma.
Proof. hammer_hook "union_correct" "union_correct.insert_ostate_correct_wrt_sign_invar".
unfold predta_correct_wrt_sign in |- *. unfold insert_ostate in |- *. intros.
rewrite (MapPut_semantics state d a s) in H1. elim (bool_is_true_or_false (N.eqb a a0)); intros; rewrite H2 in H1.
inversion H1. rewrite <- H4. exact H0. exact (H a0 s0 H1).
Qed.

Lemma union_correct_wrt_sign_invar :
forall (d0 d1 : DTA) (sigma : signature),
dta_correct_wrt_sign d0 sigma ->
dta_correct_wrt_sign d1 sigma -> dta_correct_wrt_sign (union d0 d1) sigma.
Proof. hammer_hook "union_correct" "union_correct.union_correct_wrt_sign_invar".
unfold union in |- *. simple induction d0. simple induction d1. unfold union_1 in |- *. unfold insert_main_ostate in |- *. unfold dta_correct_wrt_sign in |- *. intros. unfold insert_main_ostate_0 in |- *. elim (option_sum state (union_0 (u_merge p p0) a a0)).
intros y. elim y. intros x y0. rewrite y0. exact
(insert_ostate_correct_wrt_sign_invar (u_merge p p0)
(new_preDTA_ad (u_merge p p0)) x sigma
(umerge_correct_wrt_sign_invar _ _ _ H H0)
(union_0_correct_wrt_sign_invar (u_merge p p0) a a0 x sigma
(umerge_correct_wrt_sign_invar _ _ _ H H0) y0)).
intro y. rewrite y. simpl in |- *. exact (umerge_correct_wrt_sign_invar _ _ _ H H0).
Qed.

Lemma upl_conv_0_ref_ok_invar :
forall (p : prec_list) (a : ad),
prec_occur (upl_conv_0 p) a ->
exists b : ad, a = uad_conv_0 b /\ prec_occur p b.
Proof. hammer_hook "union_correct" "union_correct.upl_conv_0_ref_ok_invar".
simple induction p. intros. simpl in H1. inversion H1. split with a. split.
reflexivity. exact (prec_hd a p0 p1). elim (H a0 H6). intros. split with x. elim H7. intros. split. exact H8. exact (prec_int0 a x p0 p1 H9). elim (H0 a0 H6). intros. split with x. elim H7. intros. split.
exact H8. exact (prec_int1 a x p0 p1 H9). intros. simpl in H.
inversion H.
Qed.

Lemma upl_conv_1_ref_ok_invar :
forall (p : prec_list) (a : ad),
prec_occur (upl_conv_1 p) a ->
exists b : ad, a = uad_conv_1 b /\ prec_occur p b.
Proof. hammer_hook "union_correct" "union_correct.upl_conv_1_ref_ok_invar".
simple induction p. intros. simpl in H1. inversion H1. split with a. split.
reflexivity. exact (prec_hd a p0 p1). elim (H a0 H6). intros. split with x. elim H7. intros. split. exact H8. exact (prec_int0 a x p0 p1 H9). elim (H0 a0 H6). intros. split with x. elim H7. intros. split.
exact H8. exact (prec_int1 a x p0 p1 H9). intros. simpl in H.
inversion H.
Qed.

Lemma udta_conv_0_ref_ok_invar_0 :
forall (d : preDTA) (a : ad) (s : state) (c : ad) (p : prec_list) (b : ad),
MapGet state (udta_conv_0 d) (uad_conv_0 a) = Some s ->
MapGet prec_list s c = Some p ->
prec_occur p b ->
exists s' : state,
(exists p' : prec_list,
(exists b' : ad,
MapGet state d a = Some s' /\
MapGet prec_list s' c = Some p' /\
p = upl_conv_0 p' /\
s = umpl_conv_0 s' /\ b = uad_conv_0 b' /\ prec_occur p' b')).
Proof. hammer_hook "union_correct" "union_correct.udta_conv_0_ref_ok_invar_0".
intros. elim (u_conv_0_invar_5 d a s H). intros. split with x. elim H2.
intros. rewrite H3 in H0. elim (u_conv_0_invar_7 x c p H0). intros. split with x0. elim H5. intros. rewrite H6 in H1. elim (upl_conv_0_ref_ok_invar x0 b H1). intros. split with x1. elim H8. intros. split. exact H4. split.
exact H7. split. exact H6. split. exact H3. split. exact H9. exact H10.
Qed.

Lemma udta_conv_1_ref_ok_invar_0 :
forall (d : preDTA) (a : ad) (s : state) (c : ad) (p : prec_list) (b : ad),
MapGet state (udta_conv_1 d) (uad_conv_1 a) = Some s ->
MapGet prec_list s c = Some p ->
prec_occur p b ->
exists s' : state,
(exists p' : prec_list,
(exists b' : ad,
MapGet state d a = Some s' /\
MapGet prec_list s' c = Some p' /\
p = upl_conv_1 p' /\
s = umpl_conv_1 s' /\ b = uad_conv_1 b' /\ prec_occur p' b')).
Proof. hammer_hook "union_correct" "union_correct.udta_conv_1_ref_ok_invar_0".
intros. elim (u_conv_1_invar_5 d a s H). intros. split with x. elim H2.
intros. rewrite H3 in H0. elim (u_conv_1_invar_7 x c p H0). intros. split with x0. elim H5. intros. rewrite H6 in H1. elim (upl_conv_1_ref_ok_invar x0 b H1). intros. split with x1. elim H8. intros. split. exact H4. split.
exact H7. split. exact H6. split. exact H3. split. exact H9. exact H10.
Qed.

Lemma udta_conv_0_ref_ok_invar :
forall d : preDTA, preDTA_ref_ok d -> preDTA_ref_ok (udta_conv_0 d).
Proof. hammer_hook "union_correct" "union_correct.udta_conv_0_ref_ok_invar".
unfold preDTA_ref_ok in |- *. intros. elim (u_conv_0_invar_8 _ _ _ H0). intros.
rewrite H3 in H0. elim (udta_conv_0_ref_ok_invar_0 _ _ _ _ _ _ H0 H1 H2).
intros. elim H4. intros. elim H5. intros. decompose [and] H6. elim (H _ _ _ _ _ H7 H9 H13). intros. split with (umpl_conv_0 x3). rewrite H11.
exact (u_conv_0_invar_0 _ _ _ H12).
Qed.

Lemma udta_conv_1_ref_ok_invar :
forall d : preDTA, preDTA_ref_ok d -> preDTA_ref_ok (udta_conv_1 d).
Proof. hammer_hook "union_correct" "union_correct.udta_conv_1_ref_ok_invar".
unfold preDTA_ref_ok in |- *. intros. elim (u_conv_1_invar_8 _ _ _ H0). intros.
rewrite H3 in H0. elim (udta_conv_1_ref_ok_invar_0 _ _ _ _ _ _ H0 H1 H2).
intros. elim H4. intros. elim H5. intros. decompose [and] H6. elim (H _ _ _ _ _ H7 H9 H13). intros. split with (umpl_conv_1 x3). rewrite H11.
exact (u_conv_1_invar_0 _ _ _ H12).
Qed.

Lemma MapMerge_ref_ok_invar :
forall d0 d1 : preDTA,
preDTA_ref_ok d0 -> preDTA_ref_ok d1 -> preDTA_ref_ok (MapMerge state d0 d1).
Proof. hammer_hook "union_correct" "union_correct.MapMerge_ref_ok_invar".
unfold preDTA_ref_ok in |- *. intros. rewrite (MapMerge_semantics state d0 d1) in H1. rewrite (MapMerge_semantics state d0 d1). elim (option_sum state (MapGet state d1 a)); intros y. elim y. intros x y0. rewrite y0 in H1. inversion H1. rewrite <- H5 in H2. elim (H0 a x c pl b y0 H2 H3). intros. rewrite H4. split with x0. reflexivity. rewrite y in H1. elim (H a s c pl b H1 H2 H3). intros. rewrite H4. elim (option_sum state (MapGet state d1 b)).
intros y0. elim y0. intros x0 y1. rewrite y1. split with x0. reflexivity. intro y0.
rewrite y0. split with x. reflexivity.
Qed.

Lemma u_merge_ref_ok_invar :
forall d0 d1 : preDTA,
preDTA_ref_ok d0 -> preDTA_ref_ok d1 -> preDTA_ref_ok (u_merge d0 d1).
Proof. hammer_hook "union_correct" "union_correct.u_merge_ref_ok_invar".
unfold u_merge in |- *. exact
(fun (d0 d1 : preDTA) (p0 : preDTA_ref_ok d0) (p1 : preDTA_ref_ok d1) =>
MapMerge_ref_ok_invar (udta_conv_0 d0) (udta_conv_1 d1)
(udta_conv_0_ref_ok_invar d0 p0) (udta_conv_1_ref_ok_invar d1 p1)).
Qed.

Lemma union_pl_ref_ok_invar :
forall (p p' : prec_list) (d : preDTA),
prec_list_ref_ok p d ->
prec_list_ref_ok p' d -> prec_list_ref_ok (union_pl p p') d.
Proof. hammer_hook "union_correct" "union_correct.union_pl_ref_ok_invar".
simple induction p. simpl in |- *. intros. unfold prec_list_ref_ok in |- *. elim (prec_list_ref_ok_destr a p0 p1 d H1). intros. inversion H5.
rewrite <- H6. exact (H1 a (prec_hd a p0 p1)). exact (H3 a0 H10).
exact (H0 p' d H4 H2 a0 H10). intros. unfold prec_list_ref_ok in |- *.
intros. simpl in H1. exact (H0 a H1).
Qed.

Lemma union_mpl_0_ref_ok_invar :
forall (s : state) (a : ad) (p : prec_list) (d : preDTA),
state_ref_ok (M1 prec_list a p) d ->
state_ref_ok s d -> state_ref_ok (union_mpl_0 a p s) d.
Proof. hammer_hook "union_correct" "union_correct.union_mpl_0_ref_ok_invar".
simple induction s. simpl in |- *. intros. exact H. intros. simpl in |- *.  unfold state_ref_ok in |- *.
intros. elim (bool_is_true_or_false (N.eqb a1 a)); intros; rewrite H2 in H1.
simpl in H1. elim (bool_is_true_or_false (N.eqb a1 a2)); intros; rewrite H3 in H1. inversion H1. apply (union_pl_ref_ok_invar p a0 d). apply (H a1).
simpl in |- *. rewrite (Neqb_correct a1). reflexivity. apply (H0 a). simpl in |- *.
rewrite (Neqb_correct a). reflexivity. inversion H1. elim (N.discr (Nxor a a1)); intros y. elim y. intros x y0. rewrite y0 in H1. rewrite (MapPut1_semantics prec_list x a a1 a0 p) in H1. elim (bool_is_true_or_false (N.eqb a a2)); intros; rewrite H3 in H1. inversion H1. rewrite <- H5.
apply (H0 a). simpl in |- *. rewrite (Neqb_correct a). reflexivity. elim (bool_is_true_or_false (N.eqb a1 a2)); intros; rewrite H4 in H1;
inversion H1. rewrite <- H6. apply (H a1). simpl in |- *. rewrite (Neqb_correct a1). reflexivity. exact y0. rewrite (Neqb_comm a1 a) in H2. rewrite (Nxor_eq_true _ _ y) in H2. inversion H2. intros. simpl in |- *. unfold state_ref_ok in |- *. intros. cut (state_ref_ok m0 d). cut (state_ref_ok m d).
intros. induction  a as [| p1]. induction  a0 as [| p1]. simpl in H3. exact (H _ _ _ H1 H4 N0 p0 H3). induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]; simpl in H3. exact (H5 _ _ H3). exact (H _ _ _ H1 H4 _ _ H3). exact (H5 _ _ H3). induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]. clear Hrecp1.
induction  a0 as [| p2]. simpl in H3. exact (H4 _ _ H3). cut (state_ref_ok (M1 prec_list (Npos p1) p) d). intro. induction  p2 as [p2 Hrecp2| p2 Hrecp2| ]; simpl in H3. exact (H0 _ _ _ H6 H5 _ _ H3). exact (H4 _ _ H3). exact (H0 _ _ _ H6 H5 _ _ H3).
unfold state_ref_ok in |- *. intros. apply (H1 (Ndouble_plus_one a) p3).
induction  a as [| p4]; simpl in |- *; exact H6. cut (state_ref_ok (M1 prec_list (Npos p1) p) d). intro. induction  a0 as [| p2]. simpl in H3. exact (H _ _ _ H6 H4 _ _ H3).
induction  p2 as [p2 Hrecp2| p2 Hrecp2| ]; simpl in H3. exact (H5 _ _ H3). exact (H _ _ _ H6 H4 _ _ H3). exact (H5 _ _ H3). unfold state_ref_ok in |- *. intros. apply (H1 (N.double a) p2). induction  a as [| p3]; simpl in |- *; exact H6. cut (state_ref_ok (M1 prec_list N0 p) d). intros. induction  a0 as [| p1]. simpl in H3. exact (H4 _ _ H3). induction  p1 as [p1 Hrecp1| p1 Hrecp1| ]; simpl in H3. exact (H0 _ _ _ H6 H5 _ _ H3). exact (H4 _ _ H3). exact (H0 _ _ _ H6 H5 _ _ H3). unfold state_ref_ok in |- *. intros. apply (H1 (Ndouble_plus_one a) p1). induction  a as [| p2]; exact H6. unfold state_ref_ok in |- *. intros. apply (H2 (N.double a1) p1).
induction  a1 as [| p2]; exact H4. unfold state_ref_ok in |- *. intros. apply (H2 (Ndouble_plus_one a1) p1). induction  a1 as [| p2]; exact H4.
Qed.

Lemma union_mpl_correct_ref_ok_invar :
forall (s0 s1 : state) (d : preDTA),
state_ref_ok s0 d -> state_ref_ok s1 d -> state_ref_ok (union_mpl s0 s1) d.
Proof. hammer_hook "union_correct" "union_correct.union_mpl_correct_ref_ok_invar".
simple induction s0. simpl in |- *. intros. induction  s1 as [| a a0| s1_1 Hrecs1_1 s1_0 Hrecs1_0]. exact H. exact H0.
exact H0. simple induction s1. simpl in |- *. intros. exact H. intros.
replace (union_mpl (M1 prec_list a a0) (M1 prec_list a1 a2)) with
(union_mpl_0 a1 a2 (M1 prec_list a a0)). exact (union_mpl_0_ref_ok_invar _ _ _ _ H0 H). reflexivity. intros. replace (union_mpl (M1 prec_list a a0) (M2 prec_list m m0)) with
(union_mpl_0 a a0 (M2 prec_list m m0)).
exact (union_mpl_0_ref_ok_invar _ _ _ _ H1 H2). reflexivity.
simple induction s1. intros. simpl in |- *. exact H1. intros. replace (union_mpl (M2 prec_list m m0) (M1 prec_list a a0)) with
(union_mpl_0 a a0 (M2 prec_list m m0)). exact (union_mpl_0_ref_ok_invar _ _ _ _ H2 H1). reflexivity. intros. elim (state_ref_ok_M2_destr _ _ _ H3).
intros. elim (state_ref_ok_M2_destr _ _ _ H4). intros. simpl in |- *.
unfold state_ref_ok in |- *. intros. induction  a as [| p0]. simpl in H9. exact (H _ _ H5 H7 _ _ H9). induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]; simpl in H9. exact (H0 _ _ H6 H8 _ _ H9). exact (H _ _ H5 H7 _ _ H9). exact (H0 _ _ H6 H8 _ _ H9).
Qed.

Lemma union_ref_ok :
forall d0 d1 : DTA,
DTA_ref_ok d0 -> DTA_ref_ok d1 -> DTA_ref_ok (union d0 d1).
Proof. hammer_hook "union_correct" "union_correct.union_ref_ok".
simple induction d0. simple induction d1. unfold union in |- *. unfold DTA_ref_ok in |- *.
unfold union_1 in |- *. unfold insert_main_ostate in |- *. unfold insert_main_ostate_0 in |- *. unfold insert_ostate in |- *. intros. unfold preDTA_ref_ok in |- *. unfold union_0 in |- *. unfold union_opt_state in |- *.
elim (option_sum state (MapGet state (u_merge p p0) (uad_conv_0 a))). intro y. elim y. intro x. intro y0. rewrite y0. elim (option_sum state (MapGet state (u_merge p p0) (uad_conv_1 a0)));
intro y1.
elim y1. intro x0. intro y2. rewrite y2. intros. rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0))
(union_mpl x x0)). rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0))
(union_mpl x x0)) in H1. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) a1));
intros; rewrite H4 in H1. inversion H1.
elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) b));
intros; rewrite H5. split with (union_mpl x x0).
reflexivity. cut (state_ref_ok (union_mpl x x0) (u_merge p p0)).
intro. rewrite <- H6 in H2. exact (H7 c pl H2 b H3).
apply (union_mpl_correct_ref_ok_invar x x0 (u_merge p p0)).
elim (preDTA_ref_ok_def (u_merge p p0)). intros. exact (H7 (u_merge_ref_ok_invar p p0 H H0) _ _ y0). elim (preDTA_ref_ok_def (u_merge p p0)). intros. exact (H7 (u_merge_ref_ok_invar p p0 H H0) _ _ y2). elim (u_merge_ref_ok_invar p p0 H H0 a1 s c pl b H1 H2 H3). intros. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) b));
intros; rewrite H6.
split with (union_mpl x x0). reflexivity. split with x1.
exact H5. rewrite y1. intros. rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0)) x)
. rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0)) x)
in H1. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) a1));
intros; rewrite H4 in H1.
inversion H1. rewrite <- H6. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) b));
intros; rewrite H5.
split with x. reflexivity. elim (preDTA_ref_ok_def (u_merge p p0)).
intros. rewrite <- H6 in H2. exact (H7 (u_merge_ref_ok_invar _ _ H H0) (uad_conv_0 a) x y0 c pl H2 b H3). elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) b));
intros; rewrite H5. split with x. reflexivity. exact (u_merge_ref_ok_invar _ _ H H0 a1 s c pl b H1 H2 H3).
intro y. rewrite y. elim (option_sum state (MapGet state (u_merge p p0) (uad_conv_1 a0)));
intros. elim a1. intros x y1.
rewrite y1. rewrite y1 in H1. rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0)) x)
. rewrite
(MapPut_semantics state (u_merge p p0) (new_preDTA_ad (u_merge p p0)) x)
in H1. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) b));
intros; rewrite H4.
split with x. reflexivity. elim (bool_is_true_or_false (N.eqb (new_preDTA_ad (u_merge p p0)) a2));
intros; rewrite H5 in H1.
inversion H1. rewrite <- H7 in H2. exact (u_merge_ref_ok_invar _ _ H H0 _ _ c pl b y1 H2 H3). exact (u_merge_ref_ok _ _ H H0 _ _ _ _ _ H1 H2 H3). rewrite b. rewrite b in H1.
exact (u_merge_ref_ok _ _ H H0 _ _ _ _ _ H1 H2 H3).
Qed.

Lemma union_DTA_main_state_correct_invar :
forall d0 d1 : DTA,
DTA_main_state_correct d0 ->
DTA_main_state_correct d1 -> DTA_main_state_correct (union d0 d1).
Proof. hammer_hook "union_correct" "union_correct.union_DTA_main_state_correct_invar".
simple induction d0. simple induction d1. simpl in |- *. unfold addr_in_preDTA in |- *.
intros. elim H. elim H0. intros. unfold union_0 in |- *.
rewrite
(u_merge_0 p p0 (uad_conv_0 a) (umpl_conv_0 x0)
(u_conv_0_invar_0 p a x0 H2)). rewrite
(u_merge_1 p p0 (uad_conv_1 a0) (umpl_conv_1 x)
(u_conv_1_invar_0 p0 a0 x H1)). unfold insert_ostate in |- *. unfold union_opt_state in |- *.
split with (union_mpl (umpl_conv_0 x0) (umpl_conv_1 x)).
rewrite
(MapPut_semantics state (u_merge p p0)
(N.min
(N.double
(new_preDTA_ad (MapMerge state (udta_conv_0_aux p) (M0 state))))
(Ndouble_plus_one (new_preDTA_ad (udta_conv_1_aux p0))))
(union_mpl (umpl_conv_0 x0) (umpl_conv_1 x))). rewrite
(Neqb_correct
(N.min
(N.double
(new_preDTA_ad (MapMerge state (udta_conv_0_aux p) (M0 state))))
(Ndouble_plus_one (new_preDTA_ad (udta_conv_1_aux p0)))))
. reflexivity.
Qed.


From iris.algebra Require Import
  proofmode_classes.

From caml5 Require Import
  prelude.
From caml5.common Require Export
  natinf.
From caml5.algebra Require Export
  base.
From caml5.algebra Require Import
  auth
  natinf_max.

Implicit Types n m p : natinf.

Definition auth_natinf_max :=
  auth natinf_max_UR.
Definition auth_natinf_max_R :=
  authR natinf_max_UR.
Definition auth_natinf_max_UR :=
  authUR natinf_max_UR.

Definition auth_natinf_max_auth dq n : auth_natinf_max_UR :=
  ●{dq} Build_natinf_max n ⋅ ◯ Build_natinf_max n.
Definition auth_natinf_max_frag n : auth_natinf_max_UR :=
  ◯ Build_natinf_max n.

#[global] Instance auth_natinf_max_cmra_discrete :
  CmraDiscrete auth_natinf_max_R.
Proof.
  apply _.
Qed.

#[global] Instance auth_natinf_max_auth_core_id n :
  CoreId (auth_natinf_max_auth DfracDiscarded n).
Proof.
  apply _.
Qed.
#[global] Instance auth_natinf_max_frag_core_id n :
  CoreId (auth_natinf_max_frag n).
Proof.
  apply _.
Qed.

Lemma auth_natinf_max_auth_dfrac_op dq1 dq2 n :
  auth_natinf_max_auth (dq1 ⋅ dq2) n ≡ auth_natinf_max_auth dq1 n ⋅ auth_natinf_max_auth dq2 n.
Proof.
  rewrite /auth_natinf_max_auth auth_auth_dfrac_op.
  rewrite (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)) -core_id_dup (comm _ (◯ _)) //.
Qed.
#[global] Instance auth_natinf_max_auth_dfrac_is_op dq dq1 dq2 n :
  IsOp dq dq1 dq2 →
  IsOp' (auth_natinf_max_auth dq n) (auth_natinf_max_auth dq1 n) (auth_natinf_max_auth dq2 n).
Proof.
  rewrite /IsOp' /IsOp => ->. rewrite auth_natinf_max_auth_dfrac_op //.
Qed.

Lemma auth_natinf_max_frag_op n1 n2 :
  auth_natinf_max_frag (natinf.natinf_max n1 n2) = auth_natinf_max_frag n1 ⋅ auth_natinf_max_frag n2.
Proof.
  rewrite -auth_frag_op natinf_max_op_eq //.
Qed.
#[global] Instance auth_natinf_max_frag_is_op n n1 n2 :
  IsOp (Build_natinf_max n) (Build_natinf_max n1) (Build_natinf_max n2) →
  IsOp' (auth_natinf_max_frag n) (auth_natinf_max_frag n1) (auth_natinf_max_frag n2).
Proof.
  rewrite /IsOp' /IsOp /auth_natinf_max_frag => -> //.
Qed.

Lemma auth_natinf_max_auth_frag_op dq n :
  auth_natinf_max_auth dq n ≡ auth_natinf_max_auth dq n ⋅ auth_natinf_max_frag n.
Proof.
  rewrite -!assoc -auth_frag_op -core_id_dup //.
Qed.

Lemma auth_natinf_max_frag_op_le n n' :
  natinf_le n' n →
  auth_natinf_max_frag n = auth_natinf_max_frag n' ⋅ auth_natinf_max_frag n.
Proof.
  intros. rewrite -auth_natinf_max_frag_op natinf_max_r //.
Qed.

Lemma auth_natinf_max_auth_dfrac_valid dq n :
  ✓ auth_natinf_max_auth dq n ↔
  ✓ dq.
Proof.
  rewrite auth_both_dfrac_valid_discrete /=. naive_solver.
Qed.
Lemma auth_natinf_max_auth_valid n :
  ✓ auth_natinf_max_auth (DfracOwn 1) n.
Proof.
  apply auth_both_valid. done.
Qed.

Lemma auth_natinf_max_auth_dfrac_op_valid dq1 n1 dq2 n2 :
  ✓ (auth_natinf_max_auth dq1 n1 ⋅ auth_natinf_max_auth dq2 n2) ↔
  ✓ (dq1 ⋅ dq2) ∧ n1 = n2.
Proof.
  rewrite /auth_natinf_max_auth (comm _ (●{dq2} _)) -!assoc (assoc _ (◯ _)).
  rewrite -auth_frag_op (comm _ (◯ _)) assoc. split.
  - move => /cmra_valid_op_l /auth_auth_dfrac_op_valid. naive_solver.
  - intros [? ->]. rewrite -core_id_dup -auth_auth_dfrac_op.
    apply auth_both_dfrac_valid_discrete. done.
Qed.
Lemma auth_natinf_max_auth_op_valid n1 n2 :
  ✓ (auth_natinf_max_auth (DfracOwn 1) n1 ⋅ auth_natinf_max_auth (DfracOwn 1) n2) ↔
  False.
Proof.
  rewrite auth_natinf_max_auth_dfrac_op_valid. naive_solver.
Qed.

Lemma auth_natinf_max_both_dfrac_valid dq n m :
  ✓ (auth_natinf_max_auth dq n ⋅ auth_natinf_max_frag m) ↔
  ✓ dq ∧ natinf_le m n.
Proof.
  rewrite -assoc -auth_frag_op auth_both_dfrac_valid_discrete.
  rewrite natinf_max_included natinf_max_op_eq /=. split.
  - intros (Hle_max & Hle & _). split; first done.
    destruct (total natinf_le m n); first done.
    rewrite natinf_max_r // in Hle.
  - intros []. split_and!; try done.
    rewrite natinf_max_l; done.
Qed.
Lemma auth_natinf_max_both_valid n m :
  ✓ (auth_natinf_max_auth (DfracOwn 1) n ⋅ auth_natinf_max_frag m) ↔
  natinf_le m n.
Proof.
  rewrite auth_natinf_max_both_dfrac_valid dfrac_valid_own. naive_solver.
Qed.

Lemma auth_natinf_max_frag_mono n1 n2 :
  natinf_le n1 n2 →
  auth_natinf_max_frag n1 ≼ auth_natinf_max_frag n2.
Proof.
  intros. apply auth_frag_mono, natinf_max_included. done.
Qed.

Lemma auth_natinf_max_included dq n :
  auth_natinf_max_frag n ≼ auth_natinf_max_auth dq n.
Proof.
  apply cmra_included_r.
Qed.

Lemma auth_natinf_max_auth_persist dq n :
  auth_natinf_max_auth dq n ~~> auth_natinf_max_auth DfracDiscarded n.
Proof.
  eapply cmra_update_op_proper; last done.
  eapply auth_update_auth_persist.
Qed.
Lemma auth_natinf_max_auth_update {n} n' :
  natinf_le n n' →
  auth_natinf_max_auth (DfracOwn 1) n ~~> auth_natinf_max_auth (DfracOwn 1) n'.
Proof.
  intros. apply auth_update, natinf_max_local_update. done.
Qed.

#[global] Opaque auth_natinf_max_auth.
#[global] Opaque auth_natinf_max_frag.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition rvic_test_flag_spec0 (intid: Z64) (bitmap: Pointer) (adt: RData) : option Z :=
    match intid, bitmap with
    | VZ64 _intid, (_bitmap_base, _bitmap_ofst) =>
      rely is_int64 _intid;
      when' _idx == interrupt_bitmap_dword_spec (VZ64 _intid) adt;
      rely is_int64 _idx;
      when' _bit == interrupt_bit_spec (VZ64 _intid) adt;
      rely is_int64 _bit;
      when'' _t'3_base, _t'3_ofst == get_bitmap_loc_spec (_bitmap_base, _bitmap_ofst) (VZ64 _idx) adt;
      rely is_int _t'3_ofst;
      rely is_int _bit;
      when _t'4 == test_bit_acquire_64_spec (_t'3_base, _t'3_ofst) _bit adt;
      rely is_int _t'4;
      let _ret := _t'4 in
      Some _ret
     end
    .

End SpecLow.


Set Implicit Arguments.
Set Maximal Implicit Insertion.
Set Contextual Implicit.
Set Universe Polymorphism.

Require Import GHC.Base.
Require Import Fix.

From Coq Require Import
     Relation_Definitions
     RelationClasses
.

Class AdverbAlg (D : (Set -> Set) -> Set -> Set) (R : Set -> Set) (name : nat) :=
  { adverbAlg : Alg1 D R }.

(** A helper method to interpret sums of a composed adverb by
    interpreting each individual adverb. *)

#[export] Instance AdverbAlgSum
         (D1 D2 : (Set -> Set) -> Set -> Set) (R : Set -> Set) (name : nat)
         `{AdverbAlg D1 R name} `{AdverbAlg D2 R name} :
  AdverbAlg (D1 ⊕ D2) R name :=
  {| adverbAlg := fun _ a => match a with
                          | Inl1 a => adverbAlg _ a
                          | Inr1 a => adverbAlg _ a
                          end
  |}.

(* begin composable_adverb *)
Class ComposableAdverb (F : (Set -> Set) -> Set -> Set) :=
  { Bisim {E} `{F -≪ E} `{Functor1 E} :
      (forall (A : Set), relation (Fix1 E A)) ->
      forall (A : Set), relation (Fix1 E A) ;
    equiv {E} `{F -≪ E} `{Functor1 E} {A} : Equivalence (FixRel Bisim A) ;
    Refines {E} `{F -≪ E} `{Functor1 E} :
      (forall (A : Set), relation (Fix1 E A)) ->
      forall (A : Set), relation (Fix1 E A) ;
    pre {E} `{F -≪ E} `{Functor1 E} {A} : PreOrder (FixRel Refines A) ;
  }.
(* end composable_adverb *)

Declare Scope composable_adverb_scope.
Delimit Scope composable_adverb_scope with composable_adverb.

Notation "a ≅ b" := (FixRel Bisim _ a b) (at level 42)
                    : composable_adverb_scope.
Notation "a ⊆ b" := (FixRel Refines _ a b) (at level 42)
                    : composable_adverb_scope.

Class ComposableAdverbSim
      (D : (Set -> Set) -> Set -> Set)
      (C : (Set -> Type) -> Type)  (* Would I run into trouble here? *)
      (T : (Set -> Set) -> Set -> Set) :=
  { interpAlg {I : Set -> Set} `{C I} : Alg1 D (T I) }.

Definition IdT (C : Set -> Set) : Set -> Set := C.

Notation "D ⊧ C 'UNDER' T" := (ComposableAdverbSim D C T) (at level 39) : composable_adverb_scope.


(* * FOL Reductions *)

From Undecidability.DiophantineConstraints Require Import H10C.
From Undecidability.DiophantineConstraints.Util Require Import H10UPC_facts.
From Undecidability.FOL Require Import Syntax.Facts Deduction.FragmentNDFacts Semantics.Tarski.FragmentSoundness Semantics.Tarski.FragmentFacts Syntax.BinSig Semantics.Kripke.FragmentCore  Semantics.Kripke.FragmentSoundness Semantics.Kripke.FragmentToTarski.
From Undecidability.Shared Require Import Dec.
From Undecidability.Shared.Libs.PSL Require Import Numbers.
From Coq Require Import Arith Lia List.
From Undecidability.FOL.Undecidability.Reductions Require Import H10UPC_to_FOL_friedman H10UPC_to_FOL_constructions.

(* ** Validity *)

(*
Idea: The relation (###) has the following properties:#
#
#
#n ~ p: n is left component of p#
#
#
#p ~ n: p is right component of p#
#
#
#p ~ p: the special relationship of H10UPC#
#
#
#n ~ m: n = m. Special case n=0, m=1: #
#
          The instance h10 of H10UPC is a yes-instance. #
#
          This is to facilitate Friedman translation#
#
*)

Set Default Proof Using "Type".
Set Default Goal Selector "!".

Require Import Undecidability.Synthetic.Definitions Undecidability.Synthetic.Undecidability.

(* Final collection of undecidability reductions *)
Section undecResults.

  Definition minimalSignature (f:funcs_signature) (p:preds_signature) : Prop :=
    match f,p with
     {|syms := F; ar_syms := aF|},{|preds := P; ar_preds := aP|}
       => (F -> False) /\ exists pp : P, aP pp = 2
    end.

  Lemma sig_is_minimal : minimalSignature sig_empty sig_binary.
  Proof.
  split.
  * intros [].
  * now exists tt.
  Qed.

  Theorem validReduction : H10UPC_SAT ⪯ @valid sig_empty sig_binary falsity_off.
  Proof.
  exists (fun l => @F falsity_off l). split.
  * apply transport.
  * apply inverseTransport.
  Qed.

  Theorem satisReduction : complement H10UPC_SAT ⪯ @satis sig_empty sig_binary falsity_on.
  Proof.
  exists (fun l => @F falsity_on l → falsity). split.
  * apply satisTransport.
  * apply satisInverseTransport.
  Qed.

  Theorem proveReduction : H10UPC_SAT ⪯ (fun (k:@form sig_empty sig_binary frag_operators falsity_off) => nil ⊢M k).
  Proof.
  exists (fun l => @F falsity_off l). split.
  * apply proofTransport.
  * apply inverseProofTransport.
  Qed.

  Theorem classicalProveReduction :
    H10UPC_SAT ⪯ (fun (k:@form sig_empty sig_binary frag_operators falsity_off) => nil ⊢C k).
  Proof.
  exists (fun l => @F falsity_off l). split.
  * apply classicalProvabilityTransport.
  * apply classicalProvabilityInverseTransport.
  Qed.

  Theorem kripkeValidReduction : H10UPC_SAT ⪯ @kvalid sig_empty sig_binary falsity_off.
  Proof.
  exists (fun l => @F falsity_off l). split.
  * apply kripkeTransport.
  * apply kripkeInverseTransport.
  Qed.

  Theorem kripkeSatisReduction : complement H10UPC_SAT ⪯ @ksatis sig_empty sig_binary falsity_on.
  Proof.
  exists (fun l => @F falsity_on l → falsity). split.
  * apply ksatisTransport.
  * apply ksatisInverseTransport.
  Qed.

End undecResults.


Require Import RamifyCoq.msl_application.ArrayGraph.
Require Import VST.veric.SeparationLogic.
Require Import RamifyCoq.sample_mark.env_unionfind_arr.
Require Import RamifyCoq.floyd_ext.share.

Instance SAGA_VST: SpatialArrayGraphAssum mpred. Proof. refine (Build_SpatialArrayGraphAssum _ _ _ _ _). Defined.

Definition vgamma2cdata (rpa : nat * Z) : reptype vertex_type :=
  match rpa with
  | (r, pa) => (Vint (Int.repr pa), Vint (Int.repr (Z.of_nat r)))
  end.

Instance SAG_VST (sh: share): SpatialArrayGraph pointer_val mpred := fun pt lst => data_at sh (tarray vertex_type (Z.of_nat (length lst))) (map vgamma2cdata lst) (pointer_val_val pt).


Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import bedrock2.BasicC64Semantics.
Require Import bedrock2.NotationsCustomEntry.
Require Import bedrock2.ProgramLogic.
Require Import bedrock2.Scalars.
Require Import bedrock2.Syntax. Import Syntax.Coercions.
Require Import bedrock2.Map.Separation.
Require Import bedrock2.Map.SeparationLogic.
Require Import Rupicola.Examples.Swap.Swap.
Require bedrock2.WeakestPrecondition.
Require bedrock2.Semantics.
Local Open Scope Z_scope. Local Open Scope string_scope.
Import ListNotations.
Import Swap.Bedrock2.

Local Infix "~>" := scalar (at level 40, only parsing).

Section Proofs.
  Instance spec_of_swap : spec_of swap :=
    fun functions =>
      forall a_ptr a b_ptr b tr R mem,
        seps [a_ptr ~> a; b_ptr ~> b; R] mem ->
        WeakestPrecondition.call
          functions swap tr mem [a_ptr; b_ptr]
          (fun tr' mem' rets =>
             tr = tr' /\ rets = nil
             /\ seps [a_ptr ~> b; b_ptr ~> a; R] mem').

  Lemma swap_correct : program_logic_goal_for_function! swap.
  Proof.
    repeat straightline. cbn [seps] in *.
    eexists; split; [ solve [repeat straightline] | ].
    repeat straightline.
    repeat split; ecancel_assumption.
  Qed.
End Proofs.


(* En este archivo se demuestra la propiedad que postula que
*  si en un estado inicial válido se le revoca correctamente un permiso p
*  a una aplicación a, mientras la aplicación no sea desinstalada ni el permiso
*  reotorgado, la aplicación no contará con él *)
Require Export Exec.
Require Export Implementacion.
Require Export AuxFunsCorrect.
Require Import Classical.
Require Import Estado.
Require Import DefBasicas.
Require Import Semantica.
Require Import Operaciones.
Require Import ErrorManagement.
Require Import Maps.
Require Import Tacticas.
Require Import MyList.
Require Import ListAuxFuns.
Require Import ValidStateLemmas.
Require Import SameEnvLemmas.
Require Import Semantica.
Require Import RuntimePermissions.
Require Import EqTheorems.
Require Import Trace.
Require Export PropertiesAuxFuns.
Require Export IfPermThenGranted.

Section RvkAndNotGrant.

    Theorem revokeAndNotGrantProof : forall
    (initState sndState lastState:System)
    (initStateValid:validstate initState)
    (a:idApp)
    (p:Perm)
    (pDangerous:pl p=dangerous)
    (pNotSelfDefined : ~exists lPerm : list Perm, map_apply idApp_eq (defPerms (environment initState)) a = Value idApp lPerm /\ In p lPerm)
    (sndStateStep: sndState = system (step initState (revoke p a)))
    (revokeWasOk : response (step initState (revoke p a))=ok)
    (l:list Action)
    (aIsTheSame :~In (uninstall a) l)
    (notRegranted : ~In (grant p a) l)
    (notAutoRegranted : ~In (grantAuto p a) l)
    (fromSndToLast : last (trace sndState l) sndState = lastState),
    ~appHasPermission a p lastState.
Proof.
    intros.
    unfold not;intros.

    assert (~(In (grant p a) l \/ In (grantAuto p a) l)) as notGrantedAtAll.
    unfold not; intros.
    destruct H0; contradiction.
    apply notGrantedAtAll.
    rewrite sndStateStep in *.
    clear sndStateStep.
    case_eq (revoke_pre p a initState);intros.
    simpl in *.
    unfold revoke_safe in revokeWasOk.
    rewrite H0 in revokeWasOk.
    simpl in revokeWasOk.
    inversion revokeWasOk.
    assert (exists x, map_apply idApp_eq (perms (state initState)) a= Value idApp x) as hasPerms.
    unfold revoke_pre in H0.
    unfold grantedPermsForApp in H0.
    case_eq (map_apply idApp_eq (perms (state initState)) a);intros;rewrite H1 in H0.
    exists l0;auto.
    assert (negb (InBool Perm Perm_eq p nil)=true).
    rewrite negb_true_iff.
    unfold InBool.
    auto.
    rewrite H2 in H0.
    inversion H0.
    destruct hasPerms as [ps].
    apply (ifPermThenGrantedProof (system (step initState (revoke p a))) lastState);auto.
    apply stepIsInvariant;auto.
    simpl in *.
    unfold revoke_safe in *.
    rewrite H0 in *.
    simpl.
    apply (ifPermsThenInApp initState initStateValid a ps);auto.
    unfold appHasPermission.
    unfold not;intros.
    destruct H2.
    destruct H2.
    destruct H2.
    simpl in H2.
    unfold revoke_safe in H2.
    rewrite H0 in H2.
    simpl in H2.
    unfold revokePermission in H2.
    rewrite H1 in H2.
    rewrite <-addAndApply in H2.
    inversion H2.
    rewrite <- H5 in H3.
    rewrite <-removeSthElse in H3.
    destruct H3.
    destruct H3.
    auto.
    destruct H2.
    destruct H3.
    destruct H3.
    destruct H4.
    simpl in H4.
    unfold revoke_safe in H4.
    rewrite H0 in H4.
    simpl in H4.
    contradiction.
    rewrite pDangerous in H4.
    destruct H4.
    inversion H4.
    destruct H4.
    destruct H4.
    destruct H5.
    destruct H5.
    destruct H5.
    inversion H5.
    destruct H4; inversion H4.
    destruct H4; inversion H4.
    destruct H4; inversion H4.
Qed.

End RvkAndNotGrant.


(* seplog (c) AIST 2005-2013. R. Affeldt, N. Marti, et al. GNU GPLv3. *)
(* seplog (c) AIST 2014-2018. R. Affeldt et al. GNU GPLv3. *)
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Require Import ssrZ ZArith_ext seq_ext uniq_tac machine_int.
Import MachineInt.
Require Import mips_cmd mips_tactics mips_contrib.
Require Import multi_add_u_u_prg.
Import expr_m.

Local Open Scope mips_expr_scope.
Local Open Scope mips_cmd_scope.
Local Open Scope machine_int_scope.
Local Open Scope uniq_scope.

(* NB: no hypothesis about a0 (could be =ry) *)
Lemma multi_add_u_u_termination s h a0 rk one rx ry a1 a2 a3 :
  uniq(rk, one, rx, ry, a1, a2, a3, r0) ->
  { si | Some (s, h) -- multi_add_u_u rk one rx ry a0 a1 a2 a3 ---> si }.
Proof.
move=> Hset; rewrite /multi_add_u_u.
apply exists_addiu_seq.
repeat Reg_upd.
rewrite add0i.
apply exists_addiu_seq.
repeat Reg_upd.
rewrite sext_Z2u // addi0.
apply exists_multu_seq.
repeat Reg_upd.
rewrite umul_0.
set s0 := store.multu_op _ _.
have [k Hk] : { k | u2Z [rk]_s0 - u2Z [a2]_s0 = Z_of_nat k}.
  have [k Hk] : { k | u2Z [rk]_s0 - u2Z [a2]_s0 = k} by eapply exist; reflexivity.
  have : 0 <= k.
    rewrite -Hk /s0. repeat Reg_upd. rewrite Z2uK // subZ0; exact: min_u2Z.
  case/Z_of_nat_complete_inf => k' H.
  exists k'; by rewrite -H.
move: k s0 Hk h.
elim.
- move=> s0 Hk h.
  eapply exist.
  apply while.exec_while_false.
  rewrite /= in Hk *.
  apply/negPn/eqP; lia.
- move=> k IH s0 Hk h.
  apply exists_while.
  + rewrite /=; apply/eqP; omegaz. (*rewrite Z_S in Hk; lia *)
  + apply exists_seq_P2 with (fun s => u2Z [rk]_(fst s) - u2Z [a2]_(fst s) = Z_of_nat k).
    * exists_lwxs l_m_ H_l_m_ z_m_ H_z_m_.
      apply exists_maddu_seq_P.
      repeat Reg_upd.
      exists_lwxs l Hl z Hz.
      apply exists_maddu_seq_P.
      repeat Reg_upd.
      apply exists_mflhxu_seq_P.
      exists_sw_P l' Hl' x' Hx'.
      repeat Reg_upd.
      apply exists_addiu_seq_P.
      repeat Reg_upd.
      apply exists_addiu_P.
      repeat Reg_upd.
      simpl.
      repeat Reg_upd.
      rewrite Z_S in Hk.
      rewrite sext_Z2u // u2Z_add_Z2u //; last first.
        move: (min_u2Z [a2]_s0) (min_u2Z [rk]_s0) (max_u2Z [a2]_s0) (max_u2Z [rk]_s0) => ? ? ? ?; lia.
      lia.
    * move=> [si hi] Hi.
      exact: IH.
Qed.


Require Export MinBFTass_knew1.
Require Export MinBFTass_knew2.
Require Export MinBFTass_knew0.

Section MinBFTass_knew.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext        }.
  Context { minbft_context      : MinBFT_context      }.
  Context { m_initial_keys      : MinBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys   }.
  Context { usig_hash           : USIG_hash           }.
  Context { minbft_auth         : MinBFT_auth         }.

  Lemma in_minbft_data_rdata_prepare2request_data_MinBFT_auth2data_prepare2auth_data :
    forall p,
      In (minbft_data_rdata (prepare2request_data p))
         (MinBFT_auth2data (prepare2auth_data p)).
  Proof.
    introv.
    destruct p as [p ui], p as [v r], ui; simpl in *; tcsp.
  Qed.
  Hint Resolve in_minbft_data_rdata_prepare2request_data_MinBFT_auth2data_prepare2auth_data : minbft.

  Lemma in_minbft_data_rdata_commit2request_data_i_MinBFT_auth2data_commit2auth_data :
    forall c,
      In (minbft_data_rdata (commit2request_data_i c))
         (MinBFT_auth2data (commit2auth_data c)).
  Proof.
    introv.
    destruct c as [b uj], b as [v m ui], ui; simpl in *; tcsp.
  Qed.
  Hint Resolve in_minbft_data_rdata_commit2request_data_i_MinBFT_auth2data_commit2auth_data : minbft.

(*  Lemma in_minbft_data_rdata_commit2request_data_j_MinBFT_auth2data_commit2auth_data :
    forall c,
      In (minbft_data_rdata (commit2request_data_j c))
         (MinBFT_auth2data (commit2auth_data c)).
  Proof.
    introv.
    destruct c as [b uj], b as [v m ui], uj; simpl in *; tcsp.
  Qed.
  Hint Resolve in_minbft_data_rdata_commit2request_data_j_MinBFT_auth2data_commit2auth_data : minbft.*)

  Lemma implies_learns_prepare2rdata :
    forall {eo : EventOrdering} (e : Event) p n s u l,
      loc e = MinBFT_replica n
      -> trigger_op e = Some (MinBFT_prepare p)
      -> M_run_ls_before_event (MinBFTlocalSys n) e = Some (MinBFTlocalSys_new n s u l)
      -> verify_UI (prepare2view p) (prepare2request p) (prepare2ui p) u = true
      -> learns_data e (minbft_data_rdata (prepare2request_data p)).
  Proof.
    introv eqloc eqtrig runBef verif.
    exists n (prepare2auth_data p).
    simpl; allrw; simpl; dands; eauto 3 with minbft;[].
    unfold MinBFT_ca_verify.
    rewrite prepare2auth_data_eq.
    unfold M_byz_state_sys_before_event; simpl.
    allrw; simpl.
    unfold M_byz_state_ls_before_event.
    applydup @M_run_ls_before_event_M_byz_run_ls_before_event in runBef as byzRunBef.
    allrw; simpl.
    unfold state_of_trusted; simpl.
    autorewrite with minbft; smash_minbft.
  Qed.
  Hint Resolve implies_learns_prepare2rdata : minbft.

  Lemma implies_learns_commit2rdata_i :
    forall {eo : EventOrdering} (e : Event) c n s u l,
      loc e = MinBFT_replica n
      -> trigger_op e = Some (MinBFT_commit c)
      -> M_run_ls_before_event (MinBFTlocalSys n) e = Some (MinBFTlocalSys_new n s u l)
      -> verify_UI (commit2view c) (commit2request c) (commit2ui_j c) u = true
      -> verify_UI (commit2view c) (commit2request c) (commit2ui_i c) u = true
      -> learns_data e (minbft_data_rdata (commit2request_data_i c)).
  Proof.
    introv eqloc eqtrig runBef verifj verifi.
    exists n (commit2auth_data c).
    simpl; allrw; simpl; dands; eauto 3 with minbft;[].
    unfold MinBFT_ca_verify.
    rewrite commit2auth_data_eq.
    unfold M_byz_state_sys_before_event; simpl.
    allrw; simpl.
    unfold M_byz_state_ls_before_event.
    applydup @M_run_ls_before_event_M_byz_run_ls_before_event in runBef as byzRunBef.
    allrw; simpl.
    unfold state_of_trusted; simpl.
    autorewrite with minbft; smash_minbft.
  Qed.
  Hint Resolve implies_learns_commit2rdata_i : minbft.

(*  Lemma implies_learns_commit2rdata_j :
    forall {eo : EventOrdering} (e : Event) c n s u l,
      loc e = MinBFT_replica n
      -> trigger_op e = Some (MinBFT_commit c)
      -> M_run_ls_before_event (MinBFTlocalSys n) e = Some (MinBFTlocalSys_new n s u l)
      -> verify_UI (commit2view c) (commit2request c) (commit2ui_j c) u = true
      -> verify_UI (commit2view c) (commit2request c) (commit2ui_i c) u = true
      -> learns_data e (minbft_data_rdata (commit2request_data_j c)).
  Proof.
    introv eqloc eqtrig runBef verifj verifi.
    exists n (commit2auth_data c).
    simpl; allrw; simpl; dands; eauto 3 with minbft;[].
    unfold MinBFT_ca_verify.
    rewrite commit2auth_data_eq.
    unfold M_byz_state_sys_before_event_of_trusted; simpl.
    allrw; simpl.
    unfold M_byz_state_ls_before_event_of_trusted.
    applydup @M_run_ls_before_event_M_byz_run_ls_before_event in runBef as byzRunBef.
    allrw; simpl.
    unfold state_of_trusted; simpl.
    autorewrite with minbft; smash_minbft.
  Qed.
  Hint Resolve implies_learns_commit2rdata_j : minbft.*)

  Lemma ASSUMPTION_all_knew_or_learns_or_gen_true :
    forall (eo : EventOrdering), assume_eo eo ASSUMPTION_all_knew_or_learns_or_gen.
  Proof.
    introv kn.
    Opaque KE_TKNEW.
    Opaque KE_KNEW.
    Opaque KE_FALSE.
    simpl in *; repnd.
    rewrite interp_KE_KNEW.
    rewrite interp_KE_FALSE.

    unfold knows_after in kn; exrepnd; simpl in *.
    unfold MinBFT_data_knows in *; simpl in *.
    unfold state_after in *; exrepnd; simpl in *.
    unfold M_state_sys_on_event in *; simpl in *.
    rewrite kn1 in *; simpl in *.
    apply map_option_Some in kn2; exrepnd; rev_Some.
    applydup M_run_ls_on_event_ls_is_minbft in kn2; exrepnd; subst; simpl in *.
    unfold state_of_component in *; simpl in *; ginv.
    dup kn2 as runOn; hide_hyp runOn.
    dup kn2 as eqid.
    apply (preserves_usig_id2 _ _ _ s1) in eqid; simpl; tcsp;[].
    rewrite M_run_ls_on_event_unroll2 in kn2.
    apply map_option_Some in kn2; exrepnd; rev_Some.

    applydup M_run_ls_before_event_ls_is_minbft in kn2; exrepnd; subst; simpl in *.
    apply map_option_Some in kn3; exrepnd; subst; simpl in *; rev_Some; minbft_simp.
    rename kn2 into runBef.
    rename kn1 into eqloc.

    applydup @M_run_ls_before_event_M_byz_run_ls_before_event in runBef as runByzBef.

    unfold M_run_ls_on_input_ls, M_run_ls_on_input in *; simpl in *.
    autorewrite with minbft in *; simpl in *.

    Time minbft_dest_msg Case;
      repeat (simpl in *; autorewrite with minbft in *; smash_minbft2);
      try (destruct c; simpl in * );
      repeat (simpl in *; autorewrite with minbft in *; smash_minbft2);
             try (complete (left; eexists; simpl; unfold state_before; simpl;
                            rewrite M_state_sys_before_event_unfold;
                              rewrite eqloc; simpl; rewrite runBef; simpl; dands;[eexists;dands|];
                                try reflexivity; simpl; auto));
             try (complete (right; right; left;
                              unfold data_is_owned_by; simpl; unfold ui2rep; simpl; dands; eauto;
                                eapply on_request_implies_generates_trusted; eauto; simpl; tcsp;
                                  eauto 3 with comp minbft));
             try (complete (right; right; left;
                              unfold data_is_owned_by; simpl; unfold ui2rep; simpl; dands; eauto;
                                eapply on_request_implies_generates; eauto; simpl; tcsp;
                                  eauto 3 with comp minbft));
             try (complete (right; left; eauto 3 with minbft;
                              try (applydup invalid_prepare_false_implies_eq_prepare2view in Heqx as eqv; try rewrite <- eqv);
                              try (applydup invalid_commit_false_implies_eq_commit2view in Heqx as eqv; try rewrite <- eqv);
                              autorewrite with minbft; eauto 3 with minbft)).
  Qed.
  Hint Resolve ASSUMPTION_all_knew_or_learns_or_gen_true : minbft.

End MinBFTass_knew.

Hint Resolve ASSUMPTION_all_knew_or_learns_or_gen_true : minbft.