From Hammer Require Import Hammer.

Require Import Bool.
Require Import Arith.
Require Import NArith.
Require Import Ndec.
Require Import ZArith.
From IntMap Require Import Allmaps.
From TreeAutomata Require Import bases.
From TreeAutomata Require Import defs.
From TreeAutomata Require Import semantics.
From TreeAutomata Require Import refcorrect.
From TreeAutomata Require Import lattice_fixpoint.

Inductive coacc : preDTA -> ad -> ad -> Prop :=
| coacc_id :
forall (d : preDTA) (a : ad) (s : state),
MapGet state d a = Some s -> coacc d a a
| coacc_nxt :
forall (d : preDTA) (a0 a1 a2 : ad) (s1 s2 : state)
(pl : prec_list) (c : ad),
MapGet state d a2 = Some s2 ->
MapGet state d a1 = Some s1 ->
MapGet prec_list s1 c = Some pl ->
prec_occur pl a2 -> coacc d a0 a1 -> coacc d a0 a2.

Definition coacc_transitive_def (d : preDTA) (a0 a1 : ad) : Prop :=
forall a2 : ad, coacc d a0 a1 -> coacc d a2 a0 -> coacc d a2 a1.

Lemma coacc_transitive_0 :
forall (d : preDTA) (a : ad) (s : state),
MapGet state d a = Some s -> coacc_transitive_def d a a.
Proof. hammer_hook "coacc_test" "coacc_test.coacc_transitive_0".
unfold coacc_transitive_def in |- *. intros. exact H1.
Qed.

Lemma coacc_transitive_1 :
forall (d : preDTA) (a0 a1 a2 : ad) (s1 s2 : state)
(pl : prec_list) (c : ad),
MapGet state d a2 = Some s2 ->
MapGet state d a1 = Some s1 ->
MapGet prec_list s1 c = Some pl ->
prec_occur pl a2 ->
coacc d a0 a1 ->
coacc_transitive_def d a0 a1 -> coacc_transitive_def d a0 a2.
Proof. hammer_hook "coacc_test" "coacc_test.coacc_transitive_1".
unfold coacc_transitive_def in |- *. intros. exact (coacc_nxt d a3 a1 a2 s1 s2 pl c H H0 H1 H2 (H4 _ H3 H6)).
Qed.

Lemma coacc_transitive :
forall (d : preDTA) (a0 a1 a2 : ad),
coacc d a0 a1 -> coacc d a1 a2 -> coacc d a0 a2.
Proof. hammer_hook "coacc_test" "coacc_test.coacc_transitive".
intros. exact
(coacc_ind coacc_transitive_def coacc_transitive_0 coacc_transitive_1 d a1
a2 H0 a0 H0 H).
Qed.

Fixpoint map_replace (A : Set) (m : Map A) {struct m} :
ad -> A -> Map A :=
fun (a : ad) (x : A) =>
match m with
| M0 => M0 A
| M1 b y => if N.eqb a b then M1 A b x else M1 A b y
| M2 m n =>
match a with
| N0 => M2 A (map_replace A m N0 x) n
| Npos q =>
match q with
| xH => M2 A m (map_replace A n N0 x)
| xO p => M2 A (map_replace A m (Npos p) x) n
| xI p => M2 A m (map_replace A n (Npos p) x)
end
end
end.

Fixpoint map_or (m0 m1 : Map bool) {struct m1} : Map bool :=
match m0, m1 with
| M0, _ => M0 bool
| _, M0 => M0 bool
| M1 a0 b0, M1 a1 b1 =>
if N.eqb a0 a1 then M1 bool a0 (b0 || b1) else M0 bool
| M1 _ _, M2 _ _ => M0 bool
| M2 _ _, M1 _ _ => M0 bool
| M2 x0 y0, M2 x1 y1 => M2 bool (map_or x0 x1) (map_or y0 y1)
end.

Fixpoint pl_coacc (d : preDTA) (pl : prec_list) {struct pl} :
Map bool :=
match pl with
| prec_empty => map_mini state d
| prec_cons a la ls =>
map_replace bool (map_or (pl_coacc d la) (pl_coacc d ls)) a true
end.

Fixpoint st_coacc (d : preDTA) (s : state) {struct s} :
Map bool :=
match s with
| M0 => map_mini state d
| M1 a pl => pl_coacc d pl
| M2 x y => map_or (st_coacc d x) (st_coacc d y)
end.

Fixpoint predta_coacc_0 (d d' : preDTA) {struct d'} :
Map bool -> Map bool :=
fun m : Map bool =>
match d', m with
| M0, M0 => map_mini state d
| M1 a s, M1 a' b =>
if N.eqb a a' && b then st_coacc d s else map_mini state d
| M2 x y, M2 z t => map_or (predta_coacc_0 d x z) (predta_coacc_0 d y t)
| _, _ => map_mini state d
end.

Definition predta_coacc (d : preDTA) (a : ad) (m : Map bool) :
Map bool := map_replace bool (predta_coacc_0 d d m) a true.

Definition predta_coacc_states (d : preDTA) (a : ad) :
Map bool :=
power (Map bool) (predta_coacc d a) (map_mini state d)
(S (MapCard state d)).

Definition predta_coacc_states_0 (d : preDTA) (a : ad) :
Map bool :=
lazy_power bool eqm_bool (predta_coacc d a) (map_mini state d)
(S (MapCard state d)).

Lemma map_or_mapget_true_l :
forall (m0 m1 : Map bool) (a : ad),
domain_equal bool bool m0 m1 ->
MapGet bool m0 a = Some true ->
MapGet bool (map_or m0 m1) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_or_mapget_true_l".
simple induction m0. intros. inversion H0. simple induction m1.
intros. inversion H. intros. simpl in H. simpl in H0.
elim (bool_is_true_or_false (N.eqb a a3)); intros; rewrite H1 in H0. inversion H0. rewrite <- (Neqb_complete _ _ H1). rewrite <- H. simpl in |- *. rewrite (Neqb_correct a).
simpl in |- *. rewrite (Neqb_correct a). reflexivity. inversion H0.
intros. inversion H1. simple induction m2. intros. inversion H1.
intros. inversion H1. intros. simpl in |- *. elim H3; intros.
induction  a as [| p]. exact (H _ _ H5 H4). induction  p as [p Hrecp| p Hrecp| ]. exact (H0 _ _ H6 H4). exact (H _ _ H5 H4). exact (H0 _ _ H6 H4).
Qed.

Lemma map_or_mapget_true_ld :
forall (d : preDTA) (m0 m1 : Map bool) (a : ad),
ensemble_base state d m0 ->
ensemble_base state d m1 ->
MapGet bool m0 a = Some true ->
MapGet bool (map_or m0 m1) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_or_mapget_true_ld".
intros. exact
(map_or_mapget_true_l m0 m1 a
(domain_equal_transitive bool state bool m0 d m1
(domain_equal_symmetric state bool d m0 H) H0) H1).
Qed.

Lemma map_or_mapget_true_r :
forall (m0 m1 : Map bool) (a : ad),
domain_equal bool bool m0 m1 ->
MapGet bool m0 a = Some true ->
MapGet bool (map_or m1 m0) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_or_mapget_true_r".
simple induction m0. intros. inversion H0. simple induction m1; intros.
inversion H. simpl in H. simpl in H0. rewrite <- H.
elim (bool_is_true_or_false (N.eqb a a3)); intros; rewrite H1 in H0;
inversion H0. rewrite <- (Neqb_complete _ _ H1). simpl in |- *. rewrite (Neqb_correct a). simpl in |- *.
rewrite (Neqb_correct a). elim (bool_is_true_or_false a2); intros; rewrite H2; reflexivity. inversion H1. intros.
induction  m2 as [| a0 a1| m2_1 Hrecm2_1 m2_0 Hrecm2_0]. inversion H1. inversion H1. simpl in |- *.
elim H1; intros. induction  a as [| p]. exact (H _ _ H3 H2).
induction  p as [p Hrecp| p Hrecp| ]. exact (H0 _ _ H4 H2). exact (H _ _ H3 H2).
exact (H0 _ _ H4 H2).
Qed.

Lemma map_or_mapget_true_rd :
forall (d : preDTA) (m0 m1 : Map bool) (a : ad),
ensemble_base state d m0 ->
ensemble_base state d m1 ->
MapGet bool m1 a = Some true ->
MapGet bool (map_or m0 m1) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_or_mapget_true_rd".
intros. exact
(map_or_mapget_true_r m1 m0 a
(domain_equal_transitive bool state bool m1 d m0
(domain_equal_symmetric state bool d m1 H0) H) H1).
Qed.

Lemma map_or_mapget_true_inv :
forall (m0 m1 : Map bool) (a : ad),
MapGet bool (map_or m0 m1) a = Some true ->
MapGet bool m0 a = Some true \/ MapGet bool m1 a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_or_mapget_true_inv".
simple induction m0; intros. induction  m1 as [| a0 a1| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in H. inversion H.
simpl in H. inversion H. simpl in H. inversion H. induction  m1 as [| a2 a3| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in H. inversion H. simpl in H. elim (bool_is_true_or_false (N.eqb a a2)); intros; rewrite H0 in H.
simpl in H. elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H1 in H;
inversion H. rewrite H3. elim (bool_is_true_or_false a0); intros; rewrite H2 in H3; rewrite H2. left. rewrite <- (Neqb_complete _ _ H1). simpl in |- *.
rewrite (Neqb_correct a). reflexivity. elim (bool_is_true_or_false a3); intros; rewrite H4 in H3; rewrite H4.
right. rewrite <- (Neqb_complete _ _ H0). rewrite <- (Neqb_complete _ _ H1). simpl in |- *. rewrite (Neqb_correct a).
reflexivity. inversion H3. inversion H. inversion H.
induction  m2 as [| a0 a1| m2_1 Hrecm2_1 m2_0 Hrecm2_0]. inversion H1. inversion H1. simpl in H1.
induction  a as [| p]. elim (H _ _ H1). intros. left. simpl in |- *. assumption.
intros. right. simpl in |- *. assumption. induction  p as [p Hrecp| p Hrecp| ]. elim (H0 _ _ H1); intros; simpl in |- *. left. assumption. right. assumption.
elim (H _ _ H1); intros; simpl in |- *. left. assumption. right.
assumption. elim (H0 _ _ H1); intros; simpl in |- *. left. assumption.
right. assumption.
Qed.

Lemma map_replace_mapget_ins_true_0 :
forall (m : Map bool) (a : ad) (b : bool),
MapGet bool m a = Some b ->
MapGet bool (map_replace bool m a true) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_mapget_ins_true_0".
simple induction m. intros. inversion H. intros. simpl in H.
elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H0 in H;
inversion H. simpl in |- *. rewrite <- (Neqb_complete _ _ H0). rewrite (Neqb_correct a).
simpl in |- *. rewrite (Neqb_correct a). reflexivity. intros.
induction  a as [| p]; simpl in H1. simpl in |- *. exact (H _ _ H1).
induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *. exact (H0 _ _ H1). exact (H _ _ H1). exact (H0 _ _ H1).
Qed.

Lemma map_replace_mapget_ins_true_1 :
forall (m : Map bool) (a a' : ad),
MapGet bool m a = Some true ->
MapGet bool (map_replace bool m a' true) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_mapget_ins_true_1".
simple induction m. intros. inversion H. intros. simpl in H.
elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H0 in H. inversion H. simpl in |- *. elim (bool_is_true_or_false (N.eqb a' a)); intros; rewrite H1.
simpl in |- *. rewrite H0. reflexivity. simpl in |- *. rewrite H0.
reflexivity. inversion H. intros. induction  a as [| p]; simpl in H1; simpl in |- *. induction  a' as [| p]. simpl in |- *. exact (H _ _ H1).
induction  p as [p Hrecp| p Hrecp| ]. simpl in |- *. exact H1. exact (H _ _ H1). exact H1.
induction  p as [p Hrecp| p Hrecp| ]. induction  a' as [| p0]; simpl in |- *. exact H1. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]; simpl in |- *. exact (H0 _ _ H1). exact H1. exact (H0 _ _ H1).
induction  a' as [| p0]; simpl in |- *. exact (H _ _ H1). induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]; simpl in |- *. exact H1. exact (H _ _ H1). exact H1. induction  a' as [| p]; simpl in |- *. exact H1. induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *. exact (H0 _ _ H1). exact H1. exact (H0 _ _ H1).
Qed.

Lemma map_replace_mapget_true_inv :
forall (m : Map bool) (a b : ad),
MapGet bool (map_replace bool m a true) b = Some true ->
b = a \/ MapGet bool m b = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_mapget_true_inv".
simple induction m. intros. inversion H. simpl in |- *. intros. elim (bool_is_true_or_false (N.eqb a1 a)); intros; rewrite H0 in H. simpl in H. elim (bool_is_true_or_false (N.eqb a b)); intros; rewrite H1 in H. rewrite H1. left.
rewrite (Neqb_complete _ _ H0). rewrite <- (Neqb_complete _ _ H1). reflexivity. inversion H. simpl in H. elim (bool_is_true_or_false (N.eqb a b)); intros; rewrite H1 in H;
inversion H. rewrite H1. right. reflexivity. intros.
simpl in H1. induction  a as [| p]; simpl in H1. induction  b as [| p]; simpl in |- *; simpl in H1. exact (H _ _ H1). induction  p as [p Hrecp| p Hrecp| ]. right. exact H1.
elim (H _ _ H1). intros. inversion H2. intros. right.
exact H2. right. exact H1. induction  p as [p Hrecp| p Hrecp| ]. induction  b as [| p0].
simpl in |- *. simpl in H1. right. exact H1. simpl in H1.
induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. elim (H0 _ _ H1). intros. inversion H2.
left. reflexivity. intros. simpl in |- *. right. exact H2. simpl in |- *.
right. exact H1. elim (H0 _ _ H1). intros. inversion H2.
intros. simpl in |- *. right. exact H2. induction  b as [| p0]; simpl in |- *; simpl in H1. elim (H _ _ H1). intros. inversion H2.
right. exact H2. induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. right. exact H1. elim (H _ _ H1). intros. inversion H2. left. reflexivity.
intros. right. exact H2. right. exact H1. induction  b as [| p].
simpl in H1. simpl in |- *. right. exact H1. induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *; simpl in H1. elim (H0 _ _ H1). intros. inversion H2.
intros. right. exact H2. right. exact H1. left. reflexivity.
Qed.

Lemma map_or_def_ok :
forall m0 m1 : Map bool,
domain_equal bool bool m0 m1 -> domain_equal bool bool m0 (map_or m0 m1).
Proof. hammer_hook "coacc_test" "coacc_test.map_or_def_ok".
simple induction m0. simple induction m1. intros. exact I. intros. inversion H.
intros. inversion H1. simple induction m1. intros. inversion H. intros.
simpl in H. simpl in |- *. rewrite H. rewrite (Neqb_correct a1). simpl in |- *.
reflexivity. intros. inversion H1. simple induction m2. intros. inversion H1.
intros. inversion H1. intros. elim H3. intros. simpl in |- *. split.
exact (H _ H4). exact (H0 _ H5).
Qed.

Lemma map_or_def_ok_d :
forall (d : preDTA) (m0 m1 : Map bool),
ensemble_base state d m0 ->
ensemble_base state d m1 -> ensemble_base state d (map_or m0 m1).
Proof. hammer_hook "coacc_test" "coacc_test.map_or_def_ok_d".
unfold ensemble_base in |- *. intros. apply (domain_equal_transitive state bool bool d m0 (map_or m0 m1)). exact H. apply (map_or_def_ok m0 m1). apply (domain_equal_transitive bool state bool m0 d m1).
exact (domain_equal_symmetric state bool d m0 H). exact H0.
Qed.

Lemma map_replace_def_ok :
forall (A : Set) (m : Map A) (a : ad) (x : A),
domain_equal A A m (map_replace A m a x).
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_def_ok".
intro. simple induction m. intros. exact I. intros. simpl in |- *. elim (bool_is_true_or_false (N.eqb a1 a)); intros; rewrite H.
simpl in |- *. reflexivity. simpl in |- *. reflexivity. intros. simpl in |- *.
induction  a as [| p]. simpl in |- *. split. exact (H N0 x). exact (domain_equal_reflexive A m1). induction  p as [p Hrecp| p Hrecp| ]. split. exact (domain_equal_reflexive A m0). exact (H0 (Npos p) x). split.
exact (H (Npos p) x). exact (domain_equal_reflexive A m1).
split. exact (domain_equal_reflexive A m0). exact (H0 N0 x).
Qed.

Lemma map_replace_def_ok_d :
forall (d : preDTA) (m : Map bool) (a : ad) (x : bool),
ensemble_base state d m -> ensemble_base state d (map_replace bool m a x).
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_def_ok_d".
unfold ensemble_base in |- *. intros. apply
(domain_equal_transitive state bool bool d m (map_replace bool m a x) H).
exact (map_replace_def_ok bool m a x).
Qed.

Lemma pl_coacc_def_ok :
forall (d : preDTA) (pl : prec_list), ensemble_base state d (pl_coacc d pl).
Proof. hammer_hook "coacc_test" "coacc_test.pl_coacc_def_ok".
simple induction pl. simpl in |- *. intros. exact
(map_replace_def_ok_d d (map_or (pl_coacc d p) (pl_coacc d p0)) a true
(map_or_def_ok_d _ _ _ H H0)).
simpl in |- *. exact (map_mini_appartient state d).
Qed.

Lemma st_coacc_def_ok :
forall (d : preDTA) (s : state), ensemble_base state d (st_coacc d s).
Proof. hammer_hook "coacc_test" "coacc_test.st_coacc_def_ok".
simple induction s. simpl in |- *. exact (map_mini_appartient state d). simpl in |- *.
intros. exact (pl_coacc_def_ok d a0). intros. simpl in |- *. exact (map_or_def_ok_d _ _ _ H H0).
Qed.

Lemma predta_coacc_0_def_ok :
forall (d d' : preDTA) (m : Map bool),
ensemble_base state d (predta_coacc_0 d d' m).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_0_def_ok".
simple induction d'. simpl in |- *. intros. induction  m as [| a a0| m1 Hrecm1 m0 Hrecm0];
exact (map_mini_appartient state d). simpl in |- *. intros. induction  m as [| a1 a2| m1 Hrecm1 m0 Hrecm0].
exact (map_mini_appartient state d). elim (bool_is_true_or_false (N.eqb a a1 && a2)); intros; rewrite H. exact (st_coacc_def_ok d a0). exact (map_mini_appartient state d). exact (map_mini_appartient state d). intros. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in |- *.
exact (map_mini_appartient state d). simpl in |- *. exact (map_mini_appartient state d). simpl in |- *. exact (map_or_def_ok_d _ _ _ (H m1_1) (H0 m1_0)).
Qed.

Lemma predta_coacc_def_ok :
forall (d : preDTA) (a : ad) (m : Map bool),
ensemble_base state d (predta_coacc d a m).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_def_ok".
unfold predta_coacc in |- *. intros. exact (map_replace_def_ok_d d _ a true (predta_coacc_0_def_ok d d m)).
Qed.

Definition lemd (d : preDTA) : mRelation bool :=
fun m0 m1 : Map bool =>
ensemble_base state d m0 /\ ensemble_base state d m1 /\ lem m0 m1.

Lemma lemd_reflexive :
forall (d : preDTA) (m : Map bool), ensemble_base state d m -> lemd d m m.
Proof. hammer_hook "coacc_test" "coacc_test.lemd_reflexive".
unfold ensemble_base in |- *. simple induction d. intros. unfold lemd in |- *.
unfold ensemble_base in |- *. induction  m as [| a a0| m1 Hrecm1 m0 Hrecm0]. split. exact I.
split; exact I. inversion H. inversion H. intros.
unfold lemd in |- *. unfold ensemble_base in |- *. induction  m as [| a1 a2| m1 Hrecm1 m0 Hrecm0]. inversion H.
simpl in H. rewrite H. simpl in |- *. split. reflexivity. split.
reflexivity. rewrite (Neqb_correct a1). exact (leb_reflexive a2). inversion H. unfold lemd in |- *. unfold ensemble_base in |- *.
simple induction m1. intros. inversion H1. intros. inversion H1.
intros. elim H3. intros. elim (H _ H4). elim (H0 _ H5).
intros. split; split. exact H4. exact H5. split. exact H4.
exact H5. split. elim H9. intros. exact H11. elim H7.
intros. exact H11.
Qed.

Lemma lemd_antisymmetric :
forall (d : preDTA) (m0 m1 : Map bool),
lemd d m0 m1 -> lemd d m1 m0 -> m0 = m1.
Proof. hammer_hook "coacc_test" "coacc_test.lemd_antisymmetric".
unfold lemd in |- *. unfold ensemble_base in |- *. simple induction d. simple induction m0.
intros. elim H. intros. elim H0. intros. elim H4. intros.
induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. reflexivity. inversion H6. inversion H6.
intros. elim H0. intros. elim H2. intros. decompose [and] H.
induction  m1 as [| a1 a2| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H8. inversion H5. inversion H8.
intros. decompose [and] H1.  inversion H3. intros.
decompose [and] H. decompose [and] H0. induction  m0 as [| a1 a2| m0_1 Hrecm0_1 m0_0 Hrecm0_0].
inversion H1. induction  m1 as [| a3 a4| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H3. simpl in H1.
simpl in H2. rewrite <- H1. rewrite <- H2. simpl in H4.
simpl in H7. rewrite <- H2 in H4. rewrite <- H1 in H4.
rewrite (Neqb_correct a) in H4. rewrite <- H1 in H7.
rewrite <- H2 in H7. rewrite (Neqb_correct a) in H7.
rewrite (leb_antisymmetric _ _ H4 H7). reflexivity.
inversion H2. inversion H1. intros. decompose [and] H1.
decompose [and] H2. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H3. inversion H3.
induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0]. inversion H4. inversion H9. elim H4. elim H3.
elim H6. intros. rewrite (H m1_1 m2_1). rewrite (H0 m1_0 m2_0). reflexivity. split. exact H12. split. exact H14.
exact H10. split. exact H14. split. exact H12. elim H9.
intros. exact H16. elim H9. intros. split. exact H11.
split. exact H13. exact H7. elim H9. intros. split.
exact H13. split. exact H11. exact H15.
Qed.

Lemma lemd_transitive :
forall (d : preDTA) (m0 m1 m2 : Map bool),
lemd d m0 m1 -> lemd d m1 m2 -> lemd d m0 m2.
Proof. hammer_hook "coacc_test" "coacc_test.lemd_transitive".
simple induction d. unfold lemd in |- *. unfold ensemble_base in |- *. intros.
decompose [and] H. decompose [and] H0. induction  m0 as [| a a0| m0_1 Hrecm0_1 m0_0 Hrecm0_0].
induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0]. split. exact I. split; exact I.
inversion H6. inversion H7. inversion H2. inversion H2.
inversion H1. inversion H1. unfold lemd in |- *. unfold ensemble_base in |- *.
intros. decompose [and] H. decompose [and] H0. induction  m0 as [| a1 a2| m0_1 Hrecm0_1 m0_0 Hrecm0_0].
inversion H1. induction  m1 as [| a3 a4| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H2. induction  m2 as [| a5 a6| m2_1 Hrecm2_1 m2_0 Hrecm2_0].
inversion H6. simpl in H2. simpl in H1. simpl in H6.
simpl in H4. rewrite <- H2 in H4. rewrite <- H1 in H4.
rewrite (Neqb_correct a) in H4. simpl in H7. rewrite <- H3 in H7. rewrite <- H6 in H7. rewrite (Neqb_correct a) in H7.
rewrite <- H1. rewrite <- H6. split. simpl in |- *. reflexivity.
simpl in |- *. split. reflexivity. rewrite (Neqb_correct a).
exact (leb_transitive _ _ _ H4 H7). inversion H6.
inversion H3. inversion H1. unfold lemd in |- *. unfold ensemble_base in |- *.
intros. decompose [and] H1. decompose [and] H2. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0].
inversion H3. inversion H3. clear Hrecm1_1 Hrecm1_0.
induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0]. inversion H5. inversion H5. clear Hrecm2_1.
clear Hrecm2_0. intros. induction  m3 as [| a a0| m3_1 Hrecm3_1 m3_0 Hrecm3_0]. inversion H8.
inversion H8. clear Hrecm3_1. clear Hrecm3_0. simpl in |- *.
elim H3. elim H8. elim H6. elim H5. elim H9. intros.
split. split. exact H17. exact H18. split. split. exact H15.
exact H16. split. exact (lem_transitive _ _ _ H13 H7).
exact (lem_transitive _ _ _ H14 H10).
Qed.

Lemma map_or_inc_ld :
forall (d : preDTA) (m m0 m1 : Map bool),
ensemble_base state d m ->
lemd d m0 m1 -> lemd d (map_or m0 m) (map_or m1 m).
Proof. hammer_hook "coacc_test" "coacc_test.map_or_inc_ld".
unfold lemd in |- *. unfold ensemble_base in |- *. simple induction d. intros.
decompose [and] H0. induction  m as [| a a0| m2 Hrecm1 m3 Hrecm0]. induction  m0 as [| a a0| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in |- *. split. exact I. split; exact I. inversion H3.
inversion H3. inversion H1. inversion H1. inversion H.
inversion H. intros. decompose [and] H0. induction  m as [| a1 a2| m2 Hrecm1 m3 Hrecm0].
inversion H. induction  m0 as [| a3 a4| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. inversion H1. induction  m1 as [| a5 a6| m1_1 Hrecm1_1 m1_0 Hrecm1_0].
inversion H3. simpl in |- *. simpl in H1. simpl in H3. simpl in H4. simpl in H. rewrite <- H. rewrite <- H3. rewrite <- H1. rewrite (Neqb_correct a). simpl in |- *. rewrite (Neqb_correct a). split. reflexivity. split. reflexivity. rewrite <- H3 in H4. rewrite <- H1 in H4. rewrite (Neqb_correct a) in H4. exact (orb_inc_l a2 _ _ H4). inversion H4.
inversion H1. inversion H. intros. decompose [and] H2.
induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H1. inversion H1. induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0].
inversion H3. inversion H3. induction  m3 as [| a a0| m3_1 Hrecm3_1 m3_0 Hrecm3_0]. inversion H5.
inversion H5. clear Hrecm3_1 Hrecm3_0 Hrecm2_1 Hrecm2_0 Hrecm1_1 Hrecm1_0. simpl in |- *. elim H5. elim H3. elim H6.
intros. elim H1. intros. elim (H m1_1 m2_1 m3_1).
elim (H0 m1_0 m2_0 m3_0). intros. split. split; assumption.
split. split. elim H17; intros. assumption. elim H15; intros; assumption. elim H15. intros. elim H17. intros.
split; assumption. assumption. split. assumption. split; assumption. assumption. split. assumption. split; assumption.
Qed.

Lemma map_or_inc_rd :
forall (d : preDTA) (m m0 m1 : Map bool),
ensemble_base state d m ->
lemd d m0 m1 -> lemd d (map_or m m0) (map_or m m1).
Proof. hammer_hook "coacc_test" "coacc_test.map_or_inc_rd".
unfold lemd in |- *. unfold ensemble_base in |- *. simple induction d. intros.
decompose [and] H0. induction  m as [| a a0| m2 Hrecm1 m3 Hrecm0]. induction  m0 as [| a a0| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in |- *. split. exact I. split; exact I. inversion H3.
inversion H3. inversion H1. inversion H1. inversion H.
inversion H. intros. decompose [and] H0. induction  m as [| a1 a2| m2 Hrecm1 m3 Hrecm0].
inversion H. induction  m0 as [| a3 a4| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. inversion H1. induction  m1 as [| a5 a6| m1_1 Hrecm1_1 m1_0 Hrecm1_0].
inversion H3. simpl in |- *. simpl in H1. simpl in H3. simpl in H4. simpl in H. rewrite <- H. rewrite <- H3. rewrite <- H1. rewrite (Neqb_correct a). simpl in |- *. rewrite (Neqb_correct a). split. reflexivity. split. reflexivity. rewrite <- H3 in H4. rewrite <- H1 in H4. rewrite (Neqb_correct a) in H4. exact (orb_inc_r a2 _ _ H4). inversion H4.
inversion H1. inversion H. intros. decompose [and] H2.
induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H1. inversion H1. induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0].
inversion H3. inversion H3. induction  m3 as [| a a0| m3_1 Hrecm3_1 m3_0 Hrecm3_0]. inversion H5.
inversion H5. clear Hrecm3_1 Hrecm3_0 Hrecm2_1 Hrecm2_0 Hrecm1_1 Hrecm1_0. simpl in |- *. elim H5. elim H3. elim H6.
intros. elim H1. intros. elim (H m1_1 m2_1 m3_1).
elim (H0 m1_0 m2_0 m3_0). intros. split. split; assumption.
split. split. elim H17; intros. assumption. elim H15; intros; assumption. elim H15. intros. elim H17. intros.
split; assumption. assumption. split. assumption. split; assumption. assumption. split. assumption. split; assumption.
Qed.

Lemma map_or_inc_d :
forall (d : preDTA) (m0 m1 m2 m3 : Map bool),
lemd d m0 m1 -> lemd d m2 m3 -> lemd d (map_or m0 m2) (map_or m1 m3).
Proof. hammer_hook "coacc_test" "coacc_test.map_or_inc_d".
intros. apply (lemd_transitive d (map_or m0 m2) (map_or m1 m2) (map_or m1 m3)). apply (map_or_inc_ld d m2 m0 m1).
unfold lemd in H0. decompose [and] H0. exact H1. exact H.
apply (map_or_inc_rd d m1 m2 m3). unfold lemd in H.
decompose [and] H. exact H3. exact H0.
Qed.

Lemma predta_coacc_0_incr :
forall (d d' : preDTA) (m0 m1 : Map bool),
lemd d' m0 m1 -> lemd d (predta_coacc_0 d d' m0) (predta_coacc_0 d d' m1).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_0_incr".
unfold lemd in |- *. unfold ensemble_base in |- *. simple induction d'. intros.
decompose [and] H. induction  m0 as [| a a0| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in |- *.
split. exact (map_mini_appartient state d). split.
exact (map_mini_appartient state d). exact (lem_reflexive (map_mini state d)). inversion H2. inversion H2. induction  m1 as [| a1 a2| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H0. simpl in H3. simpl in |- *. apply (lemd_reflexive d (map_mini state d)). exact (map_mini_appartient state d).
inversion H2. simpl in |- *. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0];
exact (lemd_reflexive d (map_mini state d) (map_mini_appartient state d)). intros.
decompose [and] H. induction  m0 as [| a1 a2| m0_1 Hrecm0_1 m0_0 Hrecm0_0]. induction  m1 as [| a1 a2| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. simpl in |- *.
exact (lemd_reflexive d (map_mini state d) (map_mini_appartient state d)). inversion H0. inversion H0. induction  m1 as [| a3 a4| m1_1 Hrecm1_1 m1_0 Hrecm1_0].
inversion H2. simpl in |- *. simpl in H0. simpl in H2.
simpl in H3.
rewrite <- H0; rewrite <- H2; rewrite <- H0 in H3;
rewrite <- H2 in H3.  rewrite (Neqb_correct a); simpl in |- *.
rewrite (Neqb_correct a) in H3. elim (bool_is_true_or_false a2); intros; rewrite H1;
elim (bool_is_true_or_false a4); intros; rewrite H4.
exact (lemd_reflexive d (st_coacc d a0) (st_coacc_def_ok d a0)). rewrite H4 in H3. rewrite H1 in H3.
inversion H3.
split. exact (map_mini_appartient state d). split. exact (st_coacc_def_ok d a0). elim (map_mini_mini state d). intros. exact (H6 (st_coacc d a0) (st_coacc_def_ok d a0)). exact (lemd_reflexive d (map_mini state d) (map_mini_appartient state d)).
inversion H3. inversion H0. intros. decompose [and] H1.
induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H2. inversion H2. induction  m2 as [| a a0| m2_1 Hrecm2_1 m2_0 Hrecm2_0].
inversion H4. inversion H4. clear Hrecm2_0 Hrecm2_1 Hrecm1_0 Hrecm1_1. elim H5. intros. elim H4. elim H2. intros. simpl in |- *.
elim (H m1_1 m2_1). intros. elim H12. intros. elim (H0 m1_0 m2_0). intros. elim H16. intros. split. exact (map_or_def_ok_d d _ _ H11 H15). split. exact (map_or_def_ok_d _ _ _ H13 H17). elim
(map_or_inc_d d (predta_coacc_0 d m m1_1) (predta_coacc_0 d m m2_1)
(predta_coacc_0 d m0 m1_0) (predta_coacc_0 d m0 m2_0)).
intros. elim H20. intros. exact H22. unfold lemd in |- *.
split. assumption. split; assumption. unfold lemd in |- *.
split. assumption. split; assumption.  split.
assumption. split; assumption. split. assumption.
split; assumption.
Qed.

Lemma map_replace_inc :
forall (m0 m1 : Map bool) (a : ad) (b : bool),
lem m0 m1 -> lem (map_replace bool m0 a b) (map_replace bool m1 a b).
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_inc".
simple induction m0. simple induction m1. intros. exact (lem_reflexive (map_replace bool (M0 bool) a b)). intros. inversion H.
intros. inversion H1. simple induction m1. intros. inversion H.
simpl in |- *. intros. elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H0 in H. elim (bool_is_true_or_false (N.eqb a3 a)); intros; rewrite H1. rewrite (Neqb_complete _ _ H1). rewrite H0. rewrite (Neqb_complete _ _ H0).
exact (lem_reflexive (M1 bool a1 b)). elim (bool_is_true_or_false (N.eqb a3 a1)); intros; rewrite H2.
rewrite <- (Neqb_complete _ _ H0) in H2. rewrite H2 in H1.
inversion H1. rewrite <- (Neqb_complete _ _ H0). simpl in |- *.
rewrite (Neqb_correct a). exact H. elim H. intros.
inversion H1. simple induction m2. intros. inversion H1.
intros. inversion H1. intros. simpl in |- *. elim H3; intros.
induction  a as [| p]. simpl in |- *. split. exact (H m3 N0 b H4).
exact H5. induction  p as [p Hrecp| p Hrecp| ]; simpl in |- *; split. exact H4. exact (H0 m4 (Npos p) b H5). exact (H m3 (Npos p) b H4). exact H5.
exact H4. exact (H0 m4 N0 b H5).
Qed.

Lemma map_replace_inc_d :
forall (d : preDTA) (m0 m1 : Map bool) (a : ad) (b : bool),
lemd d m0 m1 -> lemd d (map_replace bool m0 a b) (map_replace bool m1 a b).
Proof. hammer_hook "coacc_test" "coacc_test.map_replace_inc_d".
unfold lemd in |- *. intros. decompose [and] H. split.
exact (map_replace_def_ok_d d m0 a b H0). split.
exact (map_replace_def_ok_d d m1 a b H2). exact (map_replace_inc m0 m1 a b H3).
Qed.

Lemma predta_coacc_increasing :
forall (d : preDTA) (a : ad),
increasing_app bool (lemd d) (predta_coacc d a).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_increasing".
unfold increasing_app in |- *. unfold predta_coacc in |- *. intros.
exact
(map_replace_inc_d d (predta_coacc_0 d d x) (predta_coacc_0 d d y) a true
(predta_coacc_0_incr d d x y H)).
Qed.

Definition lattice_lemd_bounded_0_def (p : prechain bool) : Prop :=
forall d : preDTA,
chain bool (ensemble_base state d) (lemd d) p ->
chain bool (ensemble_base state d) lem p.

Lemma lattice_lemd_bounded_0 :
forall m : Map bool, lattice_lemd_bounded_0_def (single bool m).
Proof. hammer_hook "coacc_test" "coacc_test.lattice_lemd_bounded_0".
unfold lattice_lemd_bounded_0_def in |- *. intros. inversion H.
exact (chain_single bool m (ensemble_base state d) lem H3).
Qed.

Definition lattice_lemd_bounded_1_def (p : prechain bool) : Prop :=
lattice_lemd_bounded_0_def p ->
forall m : Map bool, lattice_lemd_bounded_0_def (concat bool p m).

Lemma lattice_lemd_bounded_1 :
forall m : Map bool, lattice_lemd_bounded_1_def (single bool m).
Proof. hammer_hook "coacc_test" "coacc_test.lattice_lemd_bounded_1".
unfold lattice_lemd_bounded_1_def in |- *. unfold lattice_lemd_bounded_0_def in |- *. intros. inversion H0.
inversion H7. inversion H9. exact (chain_concat_s bool m m0 (ensemble_base state d) lem H8 H10 H11).
Qed.

Lemma lattice_lemd_bounded_2 :
forall p : prechain bool,
lattice_lemd_bounded_1_def p ->
forall m : Map bool, lattice_lemd_bounded_1_def (concat bool p m).
Proof. hammer_hook "coacc_test" "coacc_test.lattice_lemd_bounded_2".
unfold lattice_lemd_bounded_1_def in |- *. unfold lattice_lemd_bounded_0_def in |- *.
intros. inversion H1. inversion H8. inversion H11. exact
(chain_concat_m bool m m0 p (ensemble_base state d) lem H12 H13 (H0 _ H9)).
Qed.

Lemma lattice_lemd_bounded_3 :
forall (p : prechain bool) (d : preDTA),
chain bool (ensemble_base state d) (lemd d) p ->
chain bool (ensemble_base state d) lem p.
Proof. hammer_hook "coacc_test" "coacc_test.lattice_lemd_bounded_3".
exact
(prechain_ind bool lattice_lemd_bounded_0_def lattice_lemd_bounded_0
(prechain_ind bool lattice_lemd_bounded_1_def lattice_lemd_bounded_1
lattice_lemd_bounded_2)).
Qed.

Lemma lattice_lemd_bounded :
forall (p : prechain bool) (d : preDTA),
sas_chain bool (ensemble_base state d) (lemd d) p ->
sas_chain bool (ensemble_base state d) lem p.
Proof. hammer_hook "coacc_test" "coacc_test.lattice_lemd_bounded".
intros. inversion H. split. exact (lattice_lemd_bounded_3 p d H0). exact H1.
Qed.

Lemma lattice_bounded :
forall d : preDTA,
bounded_sas_chain bool (ensemble_base state d) (lemd d)
(S (MapCard state d)).
Proof. hammer_hook "coacc_test" "coacc_test.lattice_bounded".
unfold bounded_sas_chain in |- *. intros. exact (lattice_bounded state d p (lattice_lemd_bounded p d H)).
Qed.

Lemma pl_coacc_contain_coacc_ads :
forall (d : preDTA) (p : prec_list) (a : ad),
prec_occur p a ->
prec_list_ref_ok p d -> MapGet bool (pl_coacc d p) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.pl_coacc_contain_coacc_ads".
simple induction p. intros. inversion H1. simpl in |- *. elim (H2 _ H1).
intros. elim
(domain_equal_mapget state bool d (map_or (pl_coacc d p0) (pl_coacc d p1))
a0 x
(map_or_def_ok_d _ _ _ (pl_coacc_def_ok d p0) (pl_coacc_def_ok d p1)) H7).
intros. exact (map_replace_mapget_ins_true_0 _ _ _ H8).
simpl in |- *. apply
(map_replace_mapget_ins_true_1 (map_or (pl_coacc d p0) (pl_coacc d p1)) a0
a). apply
(map_or_mapget_true_ld _ _ _ a0 (pl_coacc_def_ok d p0)
(pl_coacc_def_ok d p1)). elim (prec_list_ref_ok_destr _ _ _ _ H2). intros. exact (H _ H7 H8). simpl in |- *. apply
(map_replace_mapget_ins_true_1 (map_or (pl_coacc d p0) (pl_coacc d p1)) a0
a). apply
(map_or_mapget_true_rd _ _ _ a0 (pl_coacc_def_ok d p0)
(pl_coacc_def_ok d p1)).
elim (prec_list_ref_ok_destr _ _ _ _ H2). intros.
exact (H0 _ H7 H9). simpl in |- *. intros. inversion H.
Qed.

Lemma st_coacc_contain_coacc_ads :
forall (d : preDTA) (s : state) (c : ad) (p : prec_list) (a : ad),
state_ref_ok s d ->
MapGet prec_list s c = Some p ->
prec_occur p a -> MapGet bool (st_coacc d s) a = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.st_coacc_contain_coacc_ads".
simple induction s. intros. inversion H0. intros. simpl in H0.
elim (bool_is_true_or_false (N.eqb a c)); intros; rewrite H2 in H0. simpl in |- *. apply (pl_coacc_contain_coacc_ads d a0 a1). inversion H0. exact H1. apply (H a a0). simpl in |- *.
rewrite (Neqb_correct a). reflexivity. inversion H0.
intros. elim (state_ref_ok_M2_destr _ _ _ H1); intros.
simpl in |- *. induction  c as [| p0]. simpl in H2. apply
(map_or_mapget_true_ld _ _ _ a (st_coacc_def_ok d m) (st_coacc_def_ok d m0)).
apply (H _ _ _ H4 H2 H3). induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]. apply
(map_or_mapget_true_rd _ _ _ a (st_coacc_def_ok d m) (st_coacc_def_ok d m0)). exact (H0 _ _ _ H5 H2 H3).
apply
(map_or_mapget_true_ld _ _ _ a (st_coacc_def_ok d m) (st_coacc_def_ok d m0)). apply (H _ _ _ H4 H2 H3).
apply
(map_or_mapget_true_rd _ _ _ a (st_coacc_def_ok d m) (st_coacc_def_ok d m0)). exact (H0 _ _ _ H5 H2 H3).
Qed.

Lemma predta_coacc_0_contain_coacc_ads :
forall (d d' : preDTA) (a : ad) (s : state) (c : ad)
(p : prec_list) (b : ad) (m : Map bool),
preDTA_ref_ok_distinct d' d ->
MapGet state d' a = Some s ->
MapGet prec_list s c = Some p ->
prec_occur p b ->
ensemble_base state d' m ->
MapGet bool m a = Some true ->
MapGet bool (predta_coacc_0 d d' m) b = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_0_contain_coacc_ads".
simple induction d'. intros. inversion H0. simpl in |- *. intros.
induction  m as [| a2 a3| m1 Hrecm1 m0 Hrecm0]. inversion H3. unfold ensemble_base in H3.
simpl in H3. rewrite <- H3. rewrite (Neqb_correct a).
simpl in H4. elim (bool_is_true_or_false (N.eqb a2 a1)); intros; rewrite H5 in H4;
inversion H4. simpl in |- *. apply (st_coacc_contain_coacc_ads d a0 c p b). elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H6 in H0;
inversion H0. rewrite H9 in H. apply (H a s).
simpl in |- *. rewrite (Neqb_correct a). reflexivity. elim (bool_is_true_or_false (N.eqb a a1)); intros; rewrite H6 in H0. inversion H0. exact H1. inversion H0. exact H2.
inversion H3. intros. induction  m1 as [| a0 a1| m1_1 Hrecm1_1 m1_0 Hrecm1_0]. inversion H5.
inversion H5. elim H5. intros. elim (preDTA_ref_ok_distinct_dest _ _ _ H1). intros. simpl in |- *.
induction  a as [| p0]. simpl in H6. simpl in H2. apply
(map_or_mapget_true_ld _ _ _ b (predta_coacc_0_def_ok d m m1_1)
(predta_coacc_0_def_ok d m0 m1_0)). exact (H _ _ _ _ _ _ H9 H2 H3 H4 H7 H6). induction  p0 as [p0 Hrecp0| p0 Hrecp0| ]; simpl in H2; simpl in H6. apply
(map_or_mapget_true_rd _ _ _ b (predta_coacc_0_def_ok d m m1_1)
(predta_coacc_0_def_ok d m0 m1_0)). exact (H0 _ _ _ _ _ _ H10 H2 H3 H4 H8 H6).
exact
(map_or_mapget_true_ld _ _ _ b (predta_coacc_0_def_ok d m m1_1)
(predta_coacc_0_def_ok d m0 m1_0) (H _ _ _ _ _ _ H9 H2 H3 H4 H7 H6)). exact
(map_or_mapget_true_rd _ _ _ b (predta_coacc_0_def_ok d m m1_1)
(predta_coacc_0_def_ok d m0 m1_0) (H0 _ _ _ _ _ _ H10 H2 H3 H4 H8 H6)).
Qed.

Lemma predta_coacc_contain_coacc_ads_0 :
forall (d : preDTA) (a0 a : ad) (s : state) (c : ad)
(p : prec_list) (b : ad) (m : Map bool),
preDTA_ref_ok d ->
MapGet state d a = Some s ->
MapGet prec_list s c = Some p ->
prec_occur p b ->
ensemble_base state d m ->
MapGet bool m a = Some true ->
MapGet bool (predta_coacc d a0 m) b = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_contain_coacc_ads_0".
unfold predta_coacc in |- *. intros. apply (map_replace_mapget_ins_true_1 (predta_coacc_0 d d m) b a0). apply
(fun hyp : preDTA_ref_ok_distinct d d =>
predta_coacc_0_contain_coacc_ads d d a s c p b m hyp H0 H1 H2 H3 H4). elim (preDTA_ref_ok_def d). intros. exact (H5 H).
Qed.

Definition predta_coacc_contain_coacc_ads_def_0 (d : preDTA)
(a0 a1 : ad) : Prop :=
coacc d a0 a1 ->
preDTA_ref_ok d ->
exists n : nat,
MapGet bool (power (Map bool) (predta_coacc d a0) (map_mini state d) n)
a1 = Some true.

Lemma predta_coacc_contain_coacc_ads_1 :
forall (d : preDTA) (a : ad) (s : state),
MapGet state d a = Some s ->
predta_coacc_contain_coacc_ads_def_0 d a a.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_contain_coacc_ads_1".
unfold predta_coacc_contain_coacc_ads_def_0 in |- *. intros.
split with 1. simpl in |- *. unfold predta_coacc in |- *. elim
(domain_equal_mapget state bool d (predta_coacc_0 d d (map_mini state d)) a
s (predta_coacc_0_def_ok d d (map_mini state d)) H). intros. apply
(map_replace_mapget_ins_true_0 (predta_coacc_0 d d (map_mini state d)) a x
H2).
Qed.

Lemma predta_coacc_contain_coacc_ads_2 :
forall (d : preDTA) (a0 a1 a2 : ad) (s1 s2 : state)
(pl : prec_list) (c : ad),
MapGet state d a2 = Some s2 ->
MapGet state d a1 = Some s1 ->
MapGet prec_list s1 c = Some pl ->
prec_occur pl a2 ->
coacc d a0 a1 ->
predta_coacc_contain_coacc_ads_def_0 d a0 a1 ->
predta_coacc_contain_coacc_ads_def_0 d a0 a2.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_contain_coacc_ads_2".
unfold predta_coacc_contain_coacc_ads_def_0 in |- *. intros.
elim (H4 H3 H6). intros. split with (S x). simpl in |- *.
apply
(predta_coacc_contain_coacc_ads_0 d a0 a1 s1 c pl a2
(power (Map bool) (predta_coacc d a0) (map_mini state d) x) H6 H0 H1 H2). apply
(power_def_ok bool (ensemble_base state d) (predta_coacc d a0)
(map_mini state d) x). unfold def_ok_app in |- *. intros. exact (predta_coacc_def_ok d a0 x0).
exact (map_mini_appartient state d). exact H7.
Qed.

Lemma predta_coacc_contain_coacc_ads_3 :
forall (d : preDTA) (a0 a1 : ad),
coacc d a0 a1 ->
preDTA_ref_ok d ->
exists n : nat,
MapGet bool (power (Map bool) (predta_coacc d a0) (map_mini state d) n) a1 =
Some true.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_contain_coacc_ads_3".
intros. exact
(coacc_ind predta_coacc_contain_coacc_ads_def_0
predta_coacc_contain_coacc_ads_1 predta_coacc_contain_coacc_ads_2 d a0
a1 H H H0).
Qed.

Lemma pl_coacc_rev :
forall (d : preDTA) (pl : prec_list) (a : ad),
MapGet bool (pl_coacc d pl) a = Some true -> prec_occur pl a.
Proof. hammer_hook "coacc_test" "coacc_test.pl_coacc_rev".
simple induction pl. simpl in |- *. intros. elim
(map_replace_mapget_true_inv (map_or (pl_coacc d p) (pl_coacc d p0)) _ _ H1). intros. rewrite <- H2.
exact (prec_hd a0 p p0). intros. elim (map_or_mapget_true_inv (pl_coacc d p) (pl_coacc d p0) a0 H2). intros. exact (prec_int0 a a0 p p0 (H _ H3)). intros. exact (prec_int1 a a0 p p0 (H0 _ H3)). intros. simpl in H. cut (true <> false).
intro. elim (H0 (map_mini_mapget_false _ _ _ _ H)). intro.
inversion H0.
Qed.

Lemma st_coacc_rev :
forall (d : preDTA) (s : state) (a : ad),
MapGet bool (st_coacc d s) a = Some true ->
exists c : ad,
(exists p : prec_list,
MapGet prec_list s c = Some p /\ prec_occur p a).
Proof. hammer_hook "coacc_test" "coacc_test.st_coacc_rev".
simple induction s. intros. simpl in H. elim (map_mini_mapget_true _ _ _ H). intros. simpl in H. split with a. split with a0.
simpl in |- *. rewrite (Neqb_correct a). split. reflexivity.
exact (pl_coacc_rev _ _ _ H). intros. simpl in H1.
elim (map_or_mapget_true_inv (st_coacc d m) (st_coacc d m0) a H1). intros. elim (H _ H2). intros. elim H3. intros.
split with (N.double x). split with x0. induction  x as [| p]; simpl in |- *; exact H4. intros. elim (H0 _ H2). intros. elim H3. intros.
split with (Ndouble_plus_one x). split with x0.
induction  x as [| p]; simpl in |- *; exact H4.
Qed.

Lemma predta_coacc_0_rev :
forall (d d' : preDTA) (b : ad) (m : Map bool),
MapGet bool (predta_coacc_0 d d' m) b = Some true ->
ensemble_base state d' m ->
exists a : ad,
(exists s : state,
(exists c : ad,
(exists p : prec_list,
MapGet state d' a = Some s /\
MapGet prec_list s c = Some p /\
prec_occur p b /\ MapGet bool m a = Some true))).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_0_rev".
simple induction d'; intros. induction  m as [| a a0| m1 Hrecm1 m0 Hrecm0]. simpl in H. elim (map_mini_mapget_true _ _ _ H). inversion H0.
inversion H0. induction  m as [| a1 a2| m1 Hrecm1 m0 Hrecm0]. inversion H0. unfold ensemble_base in H0. simpl in H0. rewrite <- H0 in H.
rewrite <- H0. simpl in H. rewrite (Neqb_correct a) in H. elim (bool_is_true_or_false a2); intros; rewrite H1 in H. simpl in H. split with a. split with a0. elim (st_coacc_rev _ _ _ H). intros. elim H2. intros. split with x. split with x0. simpl in |- *. rewrite (Neqb_correct a). rewrite H1. elim H3. intros. split. reflexivity. split. assumption.
split. assumption. reflexivity. simpl in H. elim (map_mini_mapget_true _ _ _ H). inversion H0. induction  m1 as [| a a0| m1_1 Hrecm1_1 m1_0 Hrecm1_0].
inversion H2. inversion H2. clear Hrecm1_0 Hrecm1_1.
unfold ensemble_base in H2. elim H2. intros. simpl in H1.
elim (map_or_mapget_true_inv _ _ _ H1). intros. elim (H _ _ H5 H3). intros. elim H6. intros. elim H7. intros.
elim H8. intros. decompose [and] H9. split with (N.double x). split with x0. split with x1. split with x2. split. induction  x as [| p]; simpl in |- *; exact H10. split. exact H12. split. exact H11. induction  x as [| p]; simpl in |- *; exact H14.
intros. elim (H0 _ _ H5 H4). intros. elim H6. intros.
elim H7. intros. elim H8. intros. decompose [and] H9.
split with (Ndouble_plus_one x). split with x0.
split with x1. split with x2. induction  x as [| p]; simpl in |- *; exact H9.
Qed.

Lemma predta_coacc_rev :
forall (d : preDTA) (a : ad) (m : Map bool) (b : ad),
MapGet bool (predta_coacc d a m) b = Some true ->
ensemble_base state d m ->
(exists a0 : ad,
(exists s : state,
(exists c : ad,
(exists p : prec_list,
MapGet state d a0 = Some s /\
MapGet prec_list s c = Some p /\
prec_occur p b /\ MapGet bool m a0 = Some true)))) \/
a = b.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_rev".
unfold predta_coacc in |- *. intros. elim (map_replace_mapget_true_inv _ _ _ H). intros.
right. symmetry  in |- *. exact H1. intros. left. elim (predta_coacc_0_rev d d b m H1 H0). elim (predta_coacc_0_rev d d b m H1 H0). intros. elim H3.
intros. elim H4. intros. elim H5. intros. decompose [and] H6. split with x0. split with x1. exact H4.
Qed.

Lemma predta_coacc_reverse :
forall (n : nat) (d : preDTA) (a b : ad),
MapGet bool (power (Map bool) (predta_coacc d a) (map_mini state d) n) b =
Some true -> coacc d a b.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_reverse".
simple induction n. simpl in |- *. intros. elim (map_mini_mapget_true _ _ _ H). intros. simpl in H0. elim (predta_coacc_rev d a _ _ H0).
intros. elim H1. intros. elim H2. intros. elim H3. intros.
elim H4. intros. decompose [and] H5. elim
(domain_equal_mapget bool state
(predta_coacc d a
(power (Map bool) (predta_coacc d a) (map_mini state d) n0)) d b true). intros. apply (coacc_nxt d a x b x0 x3 x2 x1 H9 H6 H8 H7). exact (H d a x H10). exact
(domain_equal_symmetric state bool _ _
(predta_coacc_def_ok d a
(power (Map bool) (predta_coacc d a) (map_mini state d) n0))). exact H0. intros. rewrite H1. elim
(domain_equal_mapget bool state
(predta_coacc d a
(power (Map bool) (predta_coacc d a) (map_mini state d) n0)) d b true). intros. exact (coacc_id d b x H2). apply
(domain_equal_symmetric state bool d
(predta_coacc d a
(power (Map bool) (predta_coacc d a) (map_mini state d) n0))).
exact
(predta_coacc_def_ok d a
(power (Map bool) (predta_coacc d a) (map_mini state d) n0)). exact H0.
apply
(power_def_ok bool (ensemble_base state d) (predta_coacc d a)
(map_mini state d) n0). unfold def_ok_app in |- *. intros. exact (predta_coacc_def_ok d a x).
exact (map_mini_appartient state d).
Qed.

Lemma predta_coacc_fix_0 :
forall (d : preDTA) (a : ad),
lower_fix_point bool (ensemble_base state d) (lemd d)
(predta_coacc d a) (predta_coacc_states d a).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_fix_0".
intros. unfold predta_coacc_states in |- *. apply
(iteres_lower_fix_point bool (ensemble_base state d)
(lemd d) (predta_coacc d a) (map_mini state d)
(S (MapCard state d)) (S (MapCard state d))). unfold mini in |- *.
split. exact (map_mini_appartient state d). intros.
split. exact (map_mini_appartient state d). split.
exact H. elim (map_mini_mini state d). intros.
exact (H1 x H). unfold def_ok_app in |- *. intros. exact (predta_coacc_def_ok d a x). exact (predta_coacc_increasing d a). exact (lattice_bounded d). exact (le_n_n _).
Qed.

Lemma predta_coacc_fix_1 :
forall (d : preDTA) (a a0 : ad) (n : nat),
MapGet bool (power (Map bool) (predta_coacc d a) (map_mini state d) n) a0 =
Some true -> MapGet bool (predta_coacc_states d a) a0 = Some true.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_fix_1".
intros. elim
(domain_equal_mapget bool bool
(power (Map bool) (predta_coacc d a) (map_mini state d) n)
(predta_coacc_states d a) a0 true). intros. elim (bool_is_true_or_false x); intros; rewrite H1 in H0.
exact H0. elim (predta_coacc_fix_0 d a); intros.
unfold inf_fix_points in H3. elim
(lem_get_leb (power (Map bool) (predta_coacc d a) (map_mini state d) n)
(predta_coacc_states d a) a0 true false).
elim
(iteres_inf_fps bool (ensemble_base state d) (lemd d)
(predta_coacc d a) (map_mini state d) (predta_coacc_states d a) n). intros. elim H5. intros.
exact H7. unfold mini in |- *. split. exact (map_mini_appartient state d). intros. split. exact (map_mini_appartient state d). split. exact H4. elim (map_mini_mini state d). intros. exact (H6 x0 H4). exact H2. exact (predta_coacc_increasing d a). exact H. exact H0.
apply
(domain_equal_transitive bool state bool
(power (Map bool) (predta_coacc d a) (map_mini state d) n) d
(predta_coacc_states d a)). apply
(domain_equal_symmetric state bool d
(power (Map bool) (predta_coacc d a) (map_mini state d) n)). apply
(power_def_ok bool (ensemble_base state d) (predta_coacc d a)
(map_mini state d) n). unfold def_ok_app in |- *. intros.
exact (predta_coacc_def_ok d a x). exact (map_mini_appartient state d). unfold predta_coacc_states in |- *.
apply
(power_def_ok bool (ensemble_base state d) (predta_coacc d a)
(map_mini state d) (S (MapCard state d))). unfold def_ok_app in |- *. intros. exact (predta_coacc_def_ok d a x). exact (map_mini_appartient state d). exact H.
Qed.

Lemma predta_coacc_fix_2 :
forall (d : preDTA) (a a0 : ad),
MapGet bool (predta_coacc_states d a) a0 = Some true ->
exists n : nat,
MapGet bool (power (Map bool) (predta_coacc d a) (map_mini state d) n) a0 =
Some true.
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_fix_2".
unfold predta_coacc_states in |- *. intros. split with (S (MapCard state d)). exact H.
Qed.

Lemma predta_coacc_fix :
forall (d : preDTA) (a a0 : ad),
preDTA_ref_ok d ->
(MapGet bool (predta_coacc_states d a) a0 = Some true <-> coacc d a a0).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_fix".
intros. split. intros. elim (predta_coacc_fix_2 _ _ _ H0). intros. exact (predta_coacc_reverse x d a a0 H1). intros. elim (predta_coacc_contain_coacc_ads_3 _ _ _ H0). intros. exact (predta_coacc_fix_1 d a a0 x H1). exact H.
Qed.

Lemma predta_coacc_0_fix :
forall (d : preDTA) (a a0 : ad),
preDTA_ref_ok d ->
(MapGet bool (predta_coacc_states_0 d a) a0 = Some true <->
coacc d a a0).
Proof. hammer_hook "coacc_test" "coacc_test.predta_coacc_0_fix".
intros. unfold predta_coacc_states_0 in |- *. rewrite
(lazy_power_eg_power bool eqm_bool (predta_coacc d a)
(map_mini state d) (S (MapCard state d))). exact (predta_coacc_fix d a a0 H). split. exact (eqm_bool_equal a1 b). intros. rewrite H0. exact (equal_eqm_bool b).
Qed.


From Undecidability.TM Require Import Util.TM_facts.

(* * Basic 1-Tape Machines *)

(* ** Helper functions *)
Section Mk_Mono.
  Variable (sig state : finType).
  Variable mono_trans : state -> option sig -> state * (option sig * move).
  Variable (init : state) (fin : state -> bool).

  Definition Mk_Mono_TM : TM sig 1.
  Proof.
    split with (state := state).
    - intros (q&tape).
      pose proof (mono_trans q (tape[@Fin0])) as (q', act).
      apply (q', [| act |]).
    - apply init.
    - apply fin.
  Defined. (* because definition *)

  Variable (F : finType) (R : Rel (tape sig) (F * tape sig)).

  Definition Mk_R_p : Rel (tapes sig 1) (F * tapes sig 1) :=
      fun tps1 '(p, tps2) => R (tps1[@Fin0]) (p, tps2[@Fin0]).

End Mk_Mono.

Arguments Mk_R_p { sig F } ( R ) x y /.

(* ** Do a single action *)
Section DoAct.
  Variable sig : finType.
  Variable c : sig.

  Variable act : option sig * move.

  Definition DoAct_TM :=
    {|
      trans := fun '(q, sym) => (true, [| act |]);
      start := false;
      halt x := x;
    |}.

  Definition DoAct : pTM sig unit 1 := (DoAct_TM; fun _ => tt).

  Definition DoAct_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = doAct t act)).

  Lemma DoAct_Sem : DoAct ⊨c(1) DoAct_Rel.
  Proof. intros t. destruct_tapes. cbn. unfold initc; cbn. eexists (mk_mconfig _ _); cbn; eauto. Qed.

End DoAct.

Arguments DoAct : simpl never.
Arguments DoAct_Rel { sig } act x y /.

(* *** Derived Machines *)

Section DoAct_Derived.
  Variable sig : finType.
  Variable c : sig. (* for Write *)
  Variable (D : move). (* for Move *)

  Definition Write : pTM sig unit 1 := DoAct (Some c, Nmove).

  Definition Write_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = midtape (left t) c (right t))).

  Lemma Write_Sem :
    Write ⊨c(1) Write_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

  Definition Move : pTM sig unit 1 := DoAct (None, D).

  Definition Move_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = tape_move (sig := sig) t D)).

  Lemma Move_Sem :
    Move ⊨c(1) Move_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

  Definition WriteMove : pTM sig unit 1 := DoAct (Some c, D).

  Definition WriteMove_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = tape_move (tape_write t (Some c)) D)).

  Lemma WriteMove_Sem :
    WriteMove ⊨c(1) WriteMove_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

End DoAct_Derived.

Arguments Write : simpl never.
Arguments Write_Rel { sig } c x y / : rename.

Arguments Move : simpl never.
Arguments Move { sig } D.
Arguments Move_Rel { sig } ( D ) x y /.

Arguments WriteMove : simpl never.
Arguments WriteMove_Rel { sig } (w D) x y / : rename.

(* ** Read a symbol *)

Section CaseChar.
  Variable sig : finType.
  Variable (F : finType) (f : option sig -> F).

  Definition CaseChar_TM : TM sig 1 :=
    {|
      trans := fun '(_, sym) => (Some (f sym[@Fin0]), [| (None, Nmove) |]);
      start := None;
      halt := fun s => match s with
                    | None => false
                    | Some _ => true
                    end;
    |}.

  Definition CaseChar : pTM sig F 1 := (CaseChar_TM; fun s => match s with None => f None (* not terminated yet *) | Some y => y end).

  Definition CaseChar_Rel : pRel sig F 1 :=
    fun t '(y, t') =>
      y = f (current t[@Fin0]) /\
      t' = t.

  Definition CaseChar_Sem : CaseChar ⊨c(1) CaseChar_Rel.
  Proof.
    intros t. destruct_tapes. cbn. unfold initc; cbn. cbv [step]; cbn. unfold current_chars; cbn.
    eexists (mk_mconfig _ _); cbv [step]; cbn. split. eauto. cbn. auto.
  Qed.

End CaseChar.

Arguments CaseChar : simpl never.
Arguments CaseChar {sig F} f.
Arguments CaseChar_Rel sig F f x y /.

Section ReadChar.

  Variable sig : finType.

  Definition ReadChar : pTM sig (option sig) 1 := CaseChar id.

  Definition ReadChar_Rel : pRel sig (option sig) 1 :=
    fun t '(y, t') =>
      y = current t[@Fin0] /\
      t' = t.

  Definition ReadChar_Sem : ReadChar ⊨c(1) ReadChar_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply CaseChar_Sem.
    - reflexivity.
    - intros tin (yout, tout) (->&->). hnf. split; auto.
  Qed.

End ReadChar.

Arguments ReadChar : simpl never.
Arguments ReadChar {sig}.
Arguments ReadChar_Rel sig x y /.

(* ** Tactic Support *)

Ltac smpl_TM_Mono :=
  once lazymatch goal with
  | [ |- DoAct _ ⊨ _] => eapply RealiseIn_Realise; eapply DoAct_Sem
  | [ |- DoAct _ ⊨c(_) _] => eapply DoAct_Sem
  | [ |- projT1 (DoAct _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply DoAct_Sem
  | [ |- Write _ ⊨ _] => eapply RealiseIn_Realise; eapply Write_Sem
  | [ |- Write _ ⊨c(_) _] => eapply Write_Sem
  | [ |- projT1 (Write _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply Write_Sem
  | [ |- Move _ ⊨ _] => eapply RealiseIn_Realise; eapply Move_Sem
  | [ |- Move _ ⊨c(_) _] => eapply Move_Sem
  | [ |- projT1 (Move _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply Move_Sem
  | [ |- WriteMove _ _ ⊨ _] => eapply RealiseIn_Realise; eapply WriteMove_Sem
  | [ |- WriteMove _ _ ⊨c(_) _] => eapply WriteMove_Sem
  | [ |- projT1 (WriteMove _ _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply WriteMove_Sem
  | [ |- CaseChar _ ⊨ _] => eapply RealiseIn_Realise; eapply CaseChar_Sem
  | [ |- CaseChar _ ⊨c(_) _] => eapply CaseChar_Sem
  | [ |- projT1 (CaseChar _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply CaseChar_Sem
  | [ |- ReadChar ⊨ _] => eapply RealiseIn_Realise; eapply ReadChar_Sem
  | [ |- ReadChar ⊨c(_) _] => eapply ReadChar_Sem
  | [ |- projT1 (ReadChar) ↓ _] => eapply RealiseIn_TerminatesIn; eapply ReadChar_Sem
  end.

Smpl Add smpl_TM_Mono : TM_Correct.


(** * Facts about H-VHDL Abstract Syntax *)

Require Import common.CoqLib.
Require Import common.ListLib.

Require Import hvhdl.AbstractSyntax.
Require Import hvhdl.WellDefinedDesign.
Require Import hvhdl.HVhdlTypes.

(** ** Facts about [FoldLCs] and [foldl_cs] *)

Section FoldLCsFacts.

  Functional Scheme foldl_cs_ind := Induction for foldl_cs Sort Prop.

  Lemma FoldLCs_ex :
    forall {A : Type} (f : A -> cs -> A) cstmt a, exists res, FoldLCs f cstmt a res.
  Proof.
    induction cstmt; intros; try
                               (match goal with
                                | |- exists _, FoldLCs ?f ?cstmt ?a _ =>
                                    exists (f a cstmt); constructor
                                end).
    destruct (IHcstmt1 a) as (res, FoldLCs1).
    destruct (IHcstmt2 res) as (res', FoldLCs2).
    eexists; econstructor.
    eexact (FoldLCs1). eexact FoldLCs2.
  Qed.

  Lemma FoldLCs_determ :
    forall {A : Type} {f : A -> cs -> A} {cstmt a res res'},
      FoldLCs f cstmt a res ->
      FoldLCs f cstmt a res' ->
      res = res'.
  Proof.
    induction cstmt; try (inversion_clear 1; inversion_clear 1; auto).
    assert (e : a' = a'0) by (eapply IHcstmt1; eauto).
    rewrite e in *; eapply IHcstmt2; eauto.
  Qed.

  Lemma foldl_cs_build_list_by_app_In :
    forall {A : Type} {f : list A -> cs -> list A},
      (forall lofAs1 a,
        exists lofAs2, f lofAs1 a = lofAs1 ++ lofAs2) ->
      forall {cstmt} {lofAs} a, In a lofAs -> In a (foldl_cs f cstmt lofAs).
  Proof.
    intros A f ex_app cstmt lofAs.
    functional induction (foldl_cs f cstmt lofAs) using foldl_cs_ind; cbn.
    1, 2, 4: (match goal with
              | |- forall (_ : _), _ -> In _ (_ ?acc ?cstmt)  =>
                  destruct (ex_app acc cstmt) as [ acc1 f_app ];
                  rewrite f_app; auto
              end).
    auto.
  Qed.

  Lemma foldl_cs_build_list_by_app_nil :
    forall {A : Type} {f : list A -> cs -> list A} {g : cs -> list A},
      (forall lofAs1 a, f lofAs1 a = lofAs1 ++ g a) ->
      forall {cstmt} {lofAs}, foldl_cs f cstmt lofAs = lofAs ++ foldl_cs f cstmt [].
  Proof.
    intros A f g ex_app.
    induction cstmt; cbn; intros lofAs.
    1, 2, 4: match goal with
             | |- ?f ?acc ?cstmt = ?acc ++ ?f [] ?cstmt  =>
                 rewrite (ex_app acc cstmt); rewrite (ex_app [] cstmt); auto
             end.
    rewrite (IHcstmt1 lofAs).
    rewrite (IHcstmt2 (lofAs ++ foldl_cs f cstmt1 [])).
    rewrite (IHcstmt2 (foldl_cs f cstmt1 [])).
    rewrite app_assoc; reflexivity.
  Qed.

End FoldLCsFacts.

(** ** Facts about [get_cids] *)

Section GetCIdsFacts.

  Lemma get_cids_InCs :
    forall cstmt id__c id__e g i o, InCs (cs_comp id__c id__e g i o) cstmt -> In id__c (get_cids cstmt).
  Proof.
    unfold get_cids.
    set (build_cids := (fun (cids : list HVhdlTypes.ident) (cstmt : cs) => match cstmt with
                                                                           | cs_comp id _ _ _ _ => cids ++ [id]
                                                                           | _ => cids
                                                                           end)).
    intros cstmt.
    functional induction (foldl_cs build_cids cstmt []) using foldl_cs_ind;
    try (solve [inversion_clear 1]).

    (* CASE [cstmt = cs_comp] *)
    - inversion_clear 1; cbn; auto.

    (* CASE [cs_comp ∈ cstmt1 || cstmt2] *)
    - inversion_clear 1 as [ InCs0 | InCs1 ].
      (* SUBCASE [cs_comp ∈ cstmt1] *)
      + eapply foldl_cs_build_list_by_app_In; eauto; destruct a; cbn.
        1, 3, 4: (exists []; eapply app_nil_end).
        exists [id__c0]; reflexivity.
      + eauto.
  Qed.

  Lemma get_cids_app:
    forall cstmt1 cstmt2 : cs, get_cids (cs_par cstmt1 cstmt2) = get_cids cstmt1 ++ get_cids cstmt2.
  Proof.
    unfold get_cids.
    set (build_cids := (fun (cids : list HVhdlTypes.ident) (cstmt : cs) => match cstmt with
                                                                           | cs_comp id _ _ _ _ => cids ++ [id]
                                                                           | _ => cids
                                                                           end)).
    cbn; intros *.
    erewrite @foldl_cs_build_list_by_app_nil with (lofAs := foldl_cs build_cids cstmt1 [])
                                                  (g := fun cstmt => match cstmt with
                                                                     | cs_comp id _ _ _ _ => [id]
                                                                     | _ => []
                                                                     end).
    reflexivity.
    destruct a; cbn.
    1, 3, 4: (eapply app_nil_end).
    reflexivity.
  Qed.

  Lemma get_cids_In_ex:
    forall (cstmt : cs) (id__c : ident),
      In id__c (get_cids cstmt) ->
      exists (id__e : ident) (g : genmap) (i : inputmap) (o : outputmap), InCs (cs_comp id__c id__e g i o) cstmt.
  Proof.
    induction cstmt; try (solve [inversion_clear 1]).
    inversion_clear 1 as [ eq_idc | False_ ];
      [ subst; exists id__e, g, i, o; reflexivity | destruct False_ ].
    rewrite get_cids_app.
    intros id__c In_app; edestruct in_app_or as [ In1 | In2 ]; eauto;
      [ edestruct IHcstmt1 as [ id__e [ g [ i [ o InCs1 ] ] ] ]
      | edestruct IHcstmt2 as [ id__e [ g [ i [ o InCs2 ] ] ] ] ];
      eauto; do 4 eexists; [ left | right ]; eauto.
  Qed.

End GetCIdsFacts.

(** ** Facts about [InCs] *)

Section InCsFacts.

  Lemma InCs_NoDup_comp_eq :
    forall {cstmt id__c id__e0 g0 i0 o0 id__e1 g1 i1 o1},
      InCs (cs_comp id__c id__e0 g0 i0 o0) cstmt ->
      InCs (cs_comp id__c id__e1 g1 i1 o1) cstmt ->
      NoDup (get_cids cstmt) ->
      cs_comp id__c id__e0 g0 i0 o0 = cs_comp id__c id__e1 g1 i1 o1.
  Proof.
    induction cstmt; try (solve [inversion 1]).
    destruct 1; destruct 1; reflexivity.

    inversion_clear 1 as [ InCs0 | InCs0 ];
      inversion_clear 1 as [ InCs1 | InCs1 ]; intros NoDup_par;
      [ eapply IHcstmt1; eauto | | | eapply IHcstmt2; eauto ].

    (* CASE [c0, c1 ∈ cstmt1] and CASE [c0, c1 ∈ cstmt2]. *)
    1,4 : (rewrite get_cids_app in NoDup_par; eauto with nodup).

    (* CASE [c0 ∈ cstmt1] and [c1 ∈ cstmt2], and CASE [c0 ∈ cstmt2]
       and [c1 ∈ cstmt1]. Contradicts NoDup in the two cases. *)
    1, 2: (elimtype False;
           rewrite get_cids_app in NoDup_par;
           eapply nodup_app_not_in; eauto; eapply get_cids_InCs; eauto).
  Qed.

End InCsFacts.

Lemma flatten_cs_ex : forall beh, exists lofcs, FlattenCs beh lofcs.
Proof.
  induction beh.

  (* CASE simple Process *)
  - exists [cs_ps id__p vars body]; auto.

  (* CASE simple Component Instance *)
  - exists [cs_comp id__c id__e g i o]; auto.

  (* CASE parallel stmts *)
  - lazymatch goal with
    | [ IH1: exists _, _, IH2: exists _, _ |- _ ] =>
      inversion_clear IH1 as (lofcs1, Hflat1);
        inversion_clear IH2 as (lofcs2, Hflat2);
        exists (lofcs1 ++ lofcs2);
        auto
    end.

  (* CASE null *)
  - exists nil; auto.
Qed.

(** FlattenCs is a deterministic relation *)

Lemma flatten_cs_determ :
  forall {behavior lofcs },
    FlattenCs behavior lofcs ->
    forall {lofcs'},
    FlattenCs behavior lofcs' ->
    lofcs = lofcs'.
Proof.
  induction 1; only 1 - 6: inversion_clear 1; auto.
  - inversion H1; auto.
  - rewrite (IHFlattenCs l0 H1); reflexivity.
  - inversion_clear H1; rewrite (IHFlattenCs l' H2); reflexivity.
  - rewrite (IHFlattenCs l0 H1); reflexivity.
  - inversion_clear H1; rewrite (IHFlattenCs l' H2); reflexivity.
  - inversion_clear 1 in H H0; auto.
    + inversion H; apply IHFlattenCs2; auto.
    + inversion H; rewrite (IHFlattenCs2 l0 H2); reflexivity.
    + inversion H; rewrite (IHFlattenCs2 l0 H2); reflexivity.
    + rewrite (IHFlattenCs1 l0 H2); rewrite (IHFlattenCs2 l'0 H3); reflexivity.
Defined.


From Mtac2 Require Import Mtac2.

Set Universe Polymorphism.

Set Printing Universes.

(* Demonstrate that id indeed has the right type *)
Definition test@{i j} : Type@{i} -> Type@{max(i,j)} := id.

(* Demonstrate that ltac gets it right *)
Lemma testL@{i j} : Type@{i} -> Type@{max(i,j)}.
Proof. exact id. Qed.

(* M.ret somehow works in 8.8 *)
Lemma testM@{i j} : Type@{i} -> Type@{max(i,j)}.
MProof.
M.ret id.
Qed.

(* runTac works too *)
Lemma testMTac@{i j} : Type@{i} -> Type@{max(i,j)}.
MProof.
T.exact id.
Qed.

(* apply doesn't generate a new universe index (it used to be the case) *)
Lemma testMTacApply@{i j} : Type@{i} -> Type@{max(i,j)}.
MProof.
T.apply (@id).
Qed.

(* and ltac's 8.8  doesn't do that either *)
Lemma testLApply@{i j} : Type@{i} -> Type@{max(i,j)}.
Proof. apply @id. Qed.

Notation "p '=e>' b" := (pbase p%core (fun _ => b%core) UniEvarconv)
  (no associativity, at level 201) : pattern_scope.
Notation "p '=e>' [ H ] b" := (pbase p%core (fun H => b%core) UniEvarconv)
  (no associativity, at level 201, H at next level) : pattern_scope.

Definition test_match@{k m+} {A:Type@{k}} (x:A) : tactic :=
  mmatch A with
  | [? B:Type@{m}] B =e> T.exact x
  end.

Lemma testMmatch@{i j} : Type@{i} -> Type@{max(i,j)}.
MProof.
test_match (fun x=>x).
Qed.

Lemma testMmatch'@{i j} : Type@{i} -> Type@{j}.
MProof.
test_match (fun x=>x).
Qed.
Print testMmatch.
Print testMmatch'.

Definition testdef : Type -> Type := fun x=>x.
Lemma testret : Type -> Type.
MProof.
M.ret (fun x=>x).
Qed. (* If this fails we likely swapped LHS & RHS of the cumulative unification in [ifM] *)
Print testret.

Lemma testexact : Type -> Type.
MProof.
T.exact (fun x=>x).
Qed.
About testexact.


Require compcert.backend.Mach.

Import Coqlib.
Import Integers.
Import AST.
Import Values.
Import Memory.
Import Globalenvs.
Import Events.
Import Smallstep.
Import Locations.
Import Conventions.
Export Mach.

Section WITHCONFIG.
Context `{compiler_config: CompilerConfiguration}.

(** Execution of Mach functions with Asm-style arguments (long long 64-bit integers NOT allowed) *)

Inductive initial_state (lm: regset) (init_sp: val) (p: Mach.program) (i: ident) (sg: signature) (args: list val) (m: mem): state -> Prop :=
| initial_state_intro
    b
    (Hb: Genv.find_symbol (Genv.globalenv p) i = Some b)
    (Hargs: extcall_arguments lm m init_sp sg args)
  :
      initial_state lm init_sp p i sg args m (Callstate nil b lm m)
.

Inductive final_state (lm: regset) (sg: signature): state -> (list val * mem) -> Prop :=
| final_state_intro
    rs
    v
    (Hv: v = List.map rs (loc_result sg))
    (** Callee-save registers.
        We use Val.lessdef instead of eq because the Stacking pass does not exactly preserve their values. *)
    (CALLEE_SAVE: forall r,
       ~ In r destroyed_at_call ->
       Val.lessdef (lm r) (rs r))
    m :
    final_state lm sg (Returnstate nil rs m) (v, m)
.

Definition semantics
           (return_address_offset: function -> code -> int -> Prop)
           (lm: regset) (init_sp init_ra: val)
           (p: Mach.program) (i: ident) (sg: signature) (args: list val) (m: mem) :=
  Semantics (Mach.step return_address_offset init_sp init_ra) (initial_state lm init_sp p i sg args m) (final_state lm sg) (Genv.globalenv p).

End WITHCONFIG.


From Undecidability Require Import TM.Util.Prelim TM.Util.TM_facts.

Set Default Goal Selector "!".

(* * Mirror Operator *)

Section Mirror.
  Variable (n : nat) (sig : finType).

  Definition mirror_act : (option sig * move) -> (option sig * move) :=
    map_snd mirror_move.

  Definition mirror_acts : Vector.t (option sig * move) n -> Vector.t (option sig * move) n :=
    Vector.map mirror_act.

  Variable F : finType.
  Variable pM : pTM sig F n.

  Definition Mirror_trans :
    state (projT1 pM) * Vector.t (option sig) n ->
    state (projT1 pM) *
    Vector.t (option sig * move) n :=
    fun qsym =>
      let (q', act) := trans qsym in
      (q', mirror_acts act).

  Definition MirrorTM : TM sig n :=
    {|
      trans := Mirror_trans;
      start := start (projT1 pM);
      halt := halt (m := projT1 pM);
    |}.

  Definition Mirror : pTM sig F n :=
    (MirrorTM; projT2 pM).

  Definition mirrorConf : mconfig sig (state (projT1 pM)) n -> mconfig sig (state (projT1 pM)) n :=
    fun c => mk_mconfig (cstate c) (mirror_tapes (ctapes c)).

  Lemma mirrorConf_involution c : mirrorConf (mirrorConf c) = c.
  Proof. destruct c as [q t]. unfold mirrorConf. cbn. f_equal. apply mirror_tapes_involution. Qed.

  Lemma mirrorConf_injective c1 c2 : mirrorConf c1 = mirrorConf c2 -> c1 = c2.
  Proof. destruct c1 as [q1 t1], c2 as [q2 t2]. unfold mirrorConf. cbn. intros H; inv H. f_equal. now apply mirror_tapes_injective. Qed.

  Lemma current_chars_mirror_tapes (t : tapes sig n) :
    current_chars (mirror_tapes t) = current_chars t.
  Proof. apply Vector.eq_nth_iff; intros i ? <-. autounfold with tape. now simpl_tape. Qed.

  Lemma doAct_mirror (t : tape sig) (act : option sig * move) :
    doAct (mirror_tape t) act = mirror_tape (doAct t (mirror_act act)).
  Proof. now destruct act as [ [ s | ] [ | | ]]; cbn; simpl_tape. Qed.

  Lemma doAct_mirror_multi (t : tapes sig n) (acts : Vector.t (option sig * move) n) :
    doAct_multi (mirror_tapes t) acts = mirror_tapes (doAct_multi t (mirror_acts acts)).
  Proof. apply Vector.eq_nth_iff; intros i ? <-. unfold doAct_multi, mirror_acts, mirror_tapes. simpl_tape. apply doAct_mirror. Qed.

  Lemma mirror_step c :
    step (M := projT1 pM) (mirrorConf c) = mirrorConf (step (M := projT1 Mirror) c).
  Proof.
    unfold step; cbn -[doAct_multi]. unfold Mirror_trans. cbn.
    destruct c as [q t]; cbn. rewrite current_chars_mirror_tapes.
    destruct (trans (q, current_chars t)) as [q' acts].
    unfold mirrorConf; cbn. f_equal. apply doAct_mirror_multi.
  Qed.

  Lemma mirror_lift k c1 c2 :
    loopM (M := projT1 Mirror)             c1  k = Some             c2 ->
    loopM (M := projT1 pM    ) (mirrorConf c1) k = Some (mirrorConf c2).
  Proof.
    unfold loopM. intros HLoop.
    apply loop_lift with (lift := mirrorConf) (f' := step (M:=projT1 pM)) (h' := haltConf (M:=projT1 pM)) in HLoop; auto.
    - intros ? _. now apply mirror_step.
  Qed.

  Lemma mirror_unlift k c1 c2 :
    loopM (M := projT1     pM) (mirrorConf c1) k = Some (mirrorConf c2) ->
    loopM (M := projT1 Mirror) (           c1) k = Some (           c2).
  Proof.
    unfold loopM. intros HLoop.
    apply loop_unlift with (lift := mirrorConf) (f := step (M:=MirrorTM)) (h := haltConf (M:=MirrorTM)) in HLoop
      as (? & HLoop & <- % mirrorConf_injective); auto.
    - intros ? _. now apply mirror_step.
  Qed.

  Definition Mirror_Rel (R : pRel sig F n) : pRel sig F n :=
    fun t '(l, t') => R (mirror_tapes t) (l, mirror_tapes t').

  Lemma Mirror_Realise R :
    pM ⊨ R -> Mirror ⊨ Mirror_Rel R.
  Proof.
    intros HRealise. intros t i outc HLoop.
    apply (HRealise (mirror_tapes t) i (mirrorConf outc)).
    now apply mirror_lift in HLoop.
  Qed.

  Definition Mirror_T (T : tRel sig n) : tRel sig n :=
    fun t k => T (mirror_tapes t) k.

  Lemma Mirror_Terminates T :
    projT1 pM ↓ T -> projT1 Mirror ↓ Mirror_T T.
  Proof.
    intros HTerm. hnf. intros t1 k H1. hnf in HTerm. specialize (HTerm (mirror_tapes t1) k H1) as (outc&H).
    exists (mirrorConf outc). apply mirror_unlift. cbn. now rewrite mirrorConf_involution.
  Qed.

  Lemma Mirror_RealiseIn R (k : nat) :
    pM ⊨c(k) R -> Mirror ⊨c(k) Mirror_Rel R.
  Proof.
    intros H.
    eapply Realise_total. split.
    - eapply Mirror_Realise. now eapply Realise_total.
    - eapply TerminatesIn_monotone.
      + eapply Mirror_Terminates. now eapply Realise_total.
      + firstorder.
  Qed.

End Mirror.

Arguments Mirror : simpl never.
Arguments Mirror_Rel { n sig F } R x y /.
Arguments Mirror_T { n sig } T x y /.


Require Import Raft.
Require Import RaftRefinementInterface.
Require Import CommonDefinitions.

Section RequestVoteReplyTermSanity.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition requestVoteReply_term_sanity (net : network) : Prop :=
    forall t p,
      In p (nwPackets net) ->
      pBody p = RequestVoteReply t true ->
      t <= currentTerm (snd (nwState net (pDst p))).

  Class requestVoteReply_term_sanity_interface : Prop :=
    {
      requestVoteReply_term_sanity_invariant :
        forall net,
          refined_raft_intermediate_reachable net ->
          requestVoteReply_term_sanity net
    }.
End RequestVoteReplyTermSanity.


From iris.proofmode Require Import tactics.
From iris.program_logic Require Export weakestpre.
From iris.base_logic Require Export invariants.
From iris_examples.logrel.F_mu_ref Require Export rules_binary typing.
From iris.algebra Require Import list.
From stdpp Require Import tactics.
Import uPred.

(* HACK: move somewhere else *)
Ltac auto_equiv :=
  (* Deal with "pointwise_relation" *)
  repeat lazymatch goal with
  | |- pointwise_relation _ _ _ _ => intros ?
  end;
  (* Normalize away equalities. *)
  repeat match goal with
  | H : _ ≡{_}≡ _ |-  _ => apply (discrete_iff _ _) in H
  | _ => progress simplify_eq
  end;
  (* repeatedly apply congruence lemmas and use the equalities in the hypotheses. *)
  try (f_equiv; fast_done || auto_equiv).

Definition logN : namespace := nroot .@ "logN".

(** interp : is a unary logical relation. *)
Section logrel.
  Context `{heapG Σ, cfgSG Σ}.
  Notation D := (prodO valO valO -n> iPropO Σ).
  Implicit Types τi : D.
  Implicit Types Δ : listO D.
  Implicit Types interp : listO D → D.

  Definition interp_expr (τi : listO D -n> D) (Δ : listO D)
      (ee : expr * expr) : iProp Σ := (∀ K,
    ⤇ fill K (ee.2) →
    WP ee.1 {{ v, ∃ v', ⤇ fill K (of_val v') ∗ τi Δ (v, v') }})%I.
  Global Instance interp_expr_ne n :
    Proper (dist n ==> dist n ==> (=) ==> dist n) interp_expr.
  Proof. solve_proper. Qed.

  Program Definition ctx_lookup (x : var) : listO D -n> D := λne Δ,
    from_option id (cconst True)%I (Δ !! x).
  Solve Obligations with solve_proper.

  Program Definition interp_unit : listO D -n> D := λne Δ ww,
    (⌜ww.1 = UnitV⌝ ∧ ⌜ww.2 = UnitV⌝)%I.
  Solve Obligations with solve_proper_alt.

  Program Definition interp_prod
      (interp1 interp2 : listO D -n> D) : listO D -n> D := λne Δ ww,
    (∃ vv1 vv2, ⌜ww = (PairV (vv1.1) (vv2.1), PairV (vv1.2) (vv2.2))⌝ ∧
                interp1 Δ vv1 ∧ interp2 Δ vv2)%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Program Definition interp_sum
      (interp1 interp2 : listO D -n> D) : listO D -n> D := λne Δ ww,
    ((∃ vv, ⌜ww = (InjLV (vv.1), InjLV (vv.2))⌝ ∧ interp1 Δ vv) ∨
     (∃ vv, ⌜ww = (InjRV (vv.1), InjRV (vv.2))⌝ ∧ interp2 Δ vv))%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Program Definition interp_arrow
          (interp1 interp2 : listO D -n> D) : listO D -n> D :=
    λne Δ ww,
    (□ ∀ vv, interp1 Δ vv →
             interp_expr
               interp2 Δ (App (of_val (ww.1)) (of_val (vv.1)),
                          App (of_val (ww.2)) (of_val (vv.2))))%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Program Definition interp_forall
      (interp : listO D -n> D) : listO D -n> D := λne Δ ww,
    (□ ∀ τi,
          ⌜∀ ww, Persistent (τi ww)⌝ →
          interp_expr
            interp (τi :: Δ) (TApp (of_val (ww.1)), TApp (of_val (ww.2))))%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Program Definition interp_rec1
      (interp : listO D -n> D) (Δ : listO D) (τi : D) : D := λne ww,
    (□ ∃ vv, ⌜ww = (FoldV (vv.1), FoldV (vv.2))⌝ ∧ ▷ interp (τi :: Δ) vv)%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Global Instance interp_rec1_contractive
    (interp : listO D -n> D) (Δ : listO D) : Contractive (interp_rec1 interp Δ).
  Proof. by solve_contractive. Qed.

  Lemma fixpoint_interp_rec1_eq (interp : listO D -n> D) Δ x :
    fixpoint (interp_rec1 interp Δ) x ≡ interp_rec1 interp Δ (fixpoint (interp_rec1 interp Δ)) x.
  Proof. exact: (fixpoint_unfold (interp_rec1 interp Δ) x). Qed.

  Program Definition interp_rec (interp : listO D -n> D) : listO D -n> D := λne Δ,
    fixpoint (interp_rec1 interp Δ).
  Next Obligation.
    intros interp n Δ1 Δ2 HΔ; apply fixpoint_ne => τi ww. solve_proper.
  Qed.

  Program Definition interp_ref_inv (ll : loc * loc) : D -n> iPropO Σ := λne τi,
    (∃ vv, ll.1 ↦ vv.1 ∗ ll.2 ↦ₛ vv.2 ∗ τi vv)%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Program Definition interp_ref
      (interp : listO D -n> D) : listO D -n> D := λne Δ ww,
    (∃ ll, ⌜ww = (LocV (ll.1), LocV (ll.2))⌝ ∧
           inv (logN .@ ll) (interp_ref_inv ll (interp Δ)))%I.
  Solve Obligations with repeat intros ?; simpl; auto_equiv.

  Fixpoint interp (τ : type) : listO D -n> D :=
    match τ return _ with
    | TUnit => interp_unit
    | TProd τ1 τ2 => interp_prod (interp τ1) (interp τ2)
    | TSum τ1 τ2 => interp_sum (interp τ1) (interp τ2)
    | TArrow τ1 τ2 => interp_arrow (interp τ1) (interp τ2)
    | TVar x => ctx_lookup x
    | TForall τ' => interp_forall (interp τ')
    | TRec τ' => interp_rec (interp τ')
    | Tref τ' => interp_ref (interp τ')
    end.
  Notation "⟦ τ ⟧" := (interp τ).

  Definition interp_env (Γ : list type)
      (Δ : listO D) (vvs : list (val * val)) : iProp Σ :=
    (⌜length Γ = length vvs⌝ ∗ [∗] zip_with (λ τ, ⟦ τ ⟧ Δ) Γ vvs)%I.
  Notation "⟦ Γ ⟧*" := (interp_env Γ).

  Class env_Persistent Δ :=
    ctx_persistentP : Forall (λ τi, ∀ vv, Persistent (τi vv)) Δ.
  Global Instance ctx_persistent_nil : env_Persistent [].
  Proof. by constructor. Qed.
  Global Instance ctx_persistent_cons τi Δ :
    (∀ vv, Persistent (τi vv)) → env_Persistent Δ → env_Persistent (τi :: Δ).
  Proof. by constructor. Qed.
  Global Instance ctx_persistent_lookup Δ x vv :
    env_Persistent Δ → Persistent (ctx_lookup x Δ vv).
  Proof. intros HΔ; revert x; induction HΔ=>-[|?] /=; apply _. Qed.
  Global Instance interp_persistent τ Δ vv :
    env_Persistent Δ → Persistent (⟦ τ ⟧ Δ vv).
  Proof.
    revert vv Δ; induction τ=> vv Δ HΔ; simpl; try apply _.
    rewrite /Persistent fixpoint_interp_rec1_eq /interp_rec1 /= intuitionistically_into_persistently.
    by apply persistently_intro'.
  Qed.
  Global Instance interp_env_base_persistent Δ Γ vs :
  env_Persistent Δ → TCForall Persistent (zip_with (λ τ, ⟦ τ ⟧ Δ) Γ vs).
  Proof.
    intros HΔ. revert vs.
    induction Γ => vs; simpl; destruct vs; constructor; apply _.
  Qed.
  Global Instance interp_env_persistent Γ Δ vvs :
    env_Persistent Δ → Persistent (⟦ Γ ⟧* Δ vvs) := _.

  Lemma interp_weaken Δ1 Π Δ2 τ :
    ⟦ τ.[upn (length Δ1) (ren (+ length Π))] ⟧ (Δ1 ++ Π ++ Δ2)
    ≡ ⟦ τ ⟧ (Δ1 ++ Δ2).
  Proof.
    revert Δ1 Π Δ2. induction τ=> Δ1 Π Δ2; simpl; auto.
    - intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - unfold interp_expr.
      intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - apply fixpoint_proper=> τi ww /=.
      properness; auto. apply (IHτ (_ :: _)).
    - rewrite iter_up; destruct lt_dec as [Hl | Hl]; simpl.
      { by rewrite !lookup_app_l. }
      (* FIXME: Ideally we wouldn't have to do this kinf of surgery. *)
      change (bi_ofeO (uPredI (iResUR Σ))) with (uPredO (iResUR Σ)).
      rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia.
    - unfold interp_expr.
      intros ww; simpl; properness; auto. by apply (IHτ (_ :: _)).
    - intros ww; simpl; properness; auto. by apply IHτ.
  Qed.

  Lemma interp_subst_up Δ1 Δ2 τ τ' :
    ⟦ τ ⟧ (Δ1 ++ interp τ' Δ2 :: Δ2)
    ≡ ⟦ τ.[upn (length Δ1) (τ' .: ids)] ⟧ (Δ1 ++ Δ2).
  Proof.
    revert Δ1 Δ2; induction τ=> Δ1 Δ2; simpl; auto.
    - intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - unfold interp_expr.
      intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
    - apply fixpoint_proper=> τi ww /=.
      properness; auto. apply (IHτ (_ :: _)).
    - rewrite iter_up; destruct lt_dec as [Hl | Hl]; simpl.
      { by rewrite !lookup_app_l. }
      (* FIXME: Ideally we wouldn't have to do this kinf of surgery. *)
      change (bi_ofeO (uPredI (iResUR Σ))) with (uPredO (iResUR Σ)).
      rewrite !lookup_app_r; [|lia ..].
      case EQ: (x - length Δ1) => [|n]; simpl.
      { symmetry. asimpl. apply (interp_weaken [] Δ1 Δ2 τ'). }
      change (bi_ofeO (uPredI (iResUR Σ))) with (uPredO (iResUR Σ)).
      rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia.
    - unfold interp_expr.
      intros ww; simpl; properness; auto. apply (IHτ (_ :: _)).
    - intros ww; simpl; properness; auto. by apply IHτ.
  Qed.

  Lemma interp_subst Δ2 τ τ' v : ⟦ τ ⟧ (⟦ τ' ⟧ Δ2 :: Δ2) v ≡ ⟦ τ.[τ'/] ⟧ Δ2 v.
  Proof. apply (interp_subst_up []). Qed.

  Lemma interp_env_length Δ Γ vvs : ⟦ Γ ⟧* Δ vvs ⊢ ⌜length Γ = length vvs⌝.
  Proof. by iIntros "[% ?]". Qed.

  Lemma interp_env_Some_l Δ Γ vvs x τ :
    Γ !! x = Some τ → ⟦ Γ ⟧* Δ vvs ⊢ ∃ vv, ⌜vvs !! x = Some vv⌝ ∧ ⟦ τ ⟧ Δ vv.
  Proof.
    iIntros (?) "[Hlen HΓ]"; iDestruct "Hlen" as %Hlen.
    destruct (lookup_lt_is_Some_2 vvs x) as [v Hv].
    { by rewrite -Hlen; apply lookup_lt_Some with τ. }
    iExists v; iSplit. done. iApply (big_sepL_elem_of with "HΓ").
    apply elem_of_list_lookup_2 with x.
    rewrite lookup_zip_with; by simplify_option_eq.
  Qed.

  Lemma interp_env_nil Δ : ⟦ [] ⟧* Δ [].
  Proof. iSplit; simpl; auto. Qed.
  Lemma interp_env_cons Δ Γ vvs τ vv :
    ⟦ τ :: Γ ⟧* Δ (vv :: vvs) ⊣⊢ ⟦ τ ⟧ Δ vv ∗ ⟦ Γ ⟧* Δ vvs.
  Proof.
    rewrite /interp_env /= (assoc _ (⟦ _ ⟧ _ _)) -(comm _ ⌜_ = _⌝%I) -assoc.
    by apply sep_proper; [apply pure_proper; lia|].
  Qed.

  Lemma interp_env_ren Δ (Γ : list type) vvs τi :
    ⟦ subst (ren (+1)) <$> Γ ⟧* (τi :: Δ) vvs ⊣⊢ ⟦ Γ ⟧* Δ vvs.
  Proof.
    apply sep_proper; [apply pure_proper; by rewrite fmap_length|].
    revert Δ vvs τi; induction Γ=> Δ [|v vs] τi; csimpl; auto.
    apply sep_proper; auto. apply (interp_weaken [] [τi] Δ).
  Qed.

End logrel.

Typeclasses Opaque interp_env.
Notation "⟦ τ ⟧" := (interp τ).
Notation "⟦ τ ⟧ₑ" := (interp_expr (interp τ)).
Notation "⟦ Γ ⟧*" := (interp_env Γ).