(* File: My_Nth.v  (last edited on 25/10/2000) (c) Klaus Weich  *)

Require Export List.
Require Export Plus.

Section My_Nth.

Variable B : Set.

Inductive my_nth : nat -> list B -> B -> Prop :=
  | My_NthO : forall (l : list B) (a : B), my_nth 0 (a :: l) a
  | My_NthS :
      forall (n : nat) (l : list B) (b : B),
      my_nth n l b -> forall a : B, my_nth (S n) (a :: l) b.

Lemma inv_nth_nil : forall (n : nat) (a : B), my_nth n nil a -> False.
intros.
inversion H.
Qed.

Lemma inv_nthO :
 forall (a : B) (l : list B) (b : B), my_nth 0 (a :: l) b -> a = b.
intros.
inversion H.
trivial.
Qed.

Lemma inv_nthS :
 forall (n : nat) (a : B) (l : list B) (b : B),
 my_nth (S n) (a :: l) b -> my_nth n l b.
intros.
inversion H.
assumption.
Qed.

Lemma my_nth_rec :
 forall P : nat -> list B -> B -> Set,
 (forall (l : list B) (a : B), P 0 (a :: l) a) ->
 (forall (n : nat) (l : list B) (b : B),
  my_nth n l b -> P n l b -> forall a : B, P (S n) (a :: l) b) ->
 forall (n : nat) (l : list B) (y : B), my_nth n l y -> P n l y.
intros P base step n.
elim n; clear n.
intros l; case l; clear l.
intros y nth; elimtype False.
apply (inv_nth_nil 0 y nth).
intros a l b nth.
 rewrite (inv_nthO a l b nth).
apply base.

intros n ih l.
case l; clear l.
intros y nth; elimtype False.
apply (inv_nth_nil (S n) y nth).
intros a l b nth.
apply step.
apply (inv_nthS n a l b nth).
apply ih.
apply (inv_nthS n a l b nth).
Qed.

Lemma nth_in : forall (n : nat) (l : list B) (a : B), my_nth n l a -> In a l.
intros n l a nth.
elim nth; clear nth.
intros.
simpl in |- *; left; trivial.
intros.
simpl in |- *; right; assumption.
Qed.

Lemma nth_app0 :
 forall (n : nat) (l0 l1 : list B) (a : B),
 my_nth n l0 a -> my_nth n (l0 ++ l1) a.
intros n l0.
generalize n; clear n.
elim l0; clear l0.
intros n l1 a nth; elimtype False.
apply (inv_nth_nil n a nth).
intros a0 l0 ih n.
case n; clear n.
intros l1 a nth.
 rewrite (inv_nthO a0 l0 a nth).
simpl in |- *; apply My_NthO.
intros n l1 a nth.
simpl in |- *; apply My_NthS.
apply ih.
apply (inv_nthS n a0 l0 a nth).
Qed.

Lemma nth_app1 :
 forall (n : nat) (l0 l1 : list B) (a : B),
 my_nth n l1 a -> my_nth (length l0 + n) (l0 ++ l1) a.
intros n l0; elim l0; clear l0.
simpl in |- *; trivial.
intros a0 l0 ih l1 a nth.
simpl in |- *.
apply My_NthS.
apply ih.
assumption.
Qed.

Inductive inv_my_nth_app (n : nat) (l0 l1 : list B) (a : B) : Set :=
  | Inv_Nth_App0 : my_nth n l0 a -> inv_my_nth_app n l0 l1 a
  | Inv_Nth_App1 :
      forall n' : nat, my_nth n' l1 a -> inv_my_nth_app n l0 l1 a.

Lemma inv_nth_app :
 forall (n : nat) (l0 l1 : list B) (a : B),
 my_nth n (l0 ++ l1) a -> inv_my_nth_app n l0 l1 a.
intros n l0 l1 a.
generalize n; clear n.
elim l0; clear l0; simpl in |- *.
intros n nth.
right with n.
assumption.
intros a0 l0 ih_l0 n.
case n; clear n.
intros nth.
left.
 rewrite (inv_nthO a0 (l0 ++ l1) a nth).
apply My_NthO.
intros n nth.
elim (ih_l0 n).
intros nth_l0.
left.
apply My_NthS; assumption.
intros n' nth_l1.
right with n'; assumption.
apply inv_nthS with a0; assumption.
Qed.

Inductive nth_split (a : B) (l : list B) : Set :=
    Nth_Split_Intro :
      forall l1 l2 : list B, l = l1 ++ a :: l2 -> nth_split a l.

Lemma my_nth_split :
 forall (n : nat) (l : list B) (a : B), my_nth n l a -> nth_split a l.
intros n; elim n; clear n.
intros l a nth.
apply Nth_Split_Intro with (nil (A:=B)) (tail l).
inversion_clear nth.
simpl in |- *; trivial.
intros n ih l a.
case l; clear l.
intros nth; elimtype False; inversion_clear nth.
intros a0 l nth.
elim (ih l a); clear ih.
intros l1 l2 H.
apply Nth_Split_Intro with (a0 :: l1) l2.
 rewrite H; simpl in |- *; trivial.
inversion_clear nth; assumption.
Qed.

Lemma in_nth :
 forall (a : B) (l : list B), In a l -> exists n : nat, my_nth n l a.
intros b l; elim l; clear l.
intros in_b; inversion_clear in_b.
intros a l ih in_a.
inversion_clear in_a.
exists 0.
 rewrite H.
apply My_NthO.
elim ih; try assumption.
intros n nth.
exists (S n).
apply My_NthS; assumption.
Qed.

End My_Nth.


Require Import notations decidables Setoid Morphisms.
Require Export vectors.
Require Import List.

Definition transp n := prod (fin n) (fin n).
Definition perm n := list (transp n).

Definition vect_transp {A n} (v: vect A n) (t: transp n) := vect_swap (fst t) (snd t) v.
Definition vect_perm {A n} (p: perm n) (v: vect A n) := fold_left vect_transp p v.

Definition transp_eq {n} (t1 t2: transp n) := forall A (v: vect A n), vect_eq (vect_transp v t1) (vect_transp v t2).
Definition perm_eq {n} (p1 p2: perm n) := forall A (v: vect A n), vect_eq (vect_perm p1 v) (vect_perm p2 v).
Definition perm_mult {n} (p1 p2: perm n): perm n := List.app p1 p2.
Definition perm_inv {n} (p: perm n): perm n := List.rev p.

Instance transp_eq_Equiv n: Equivalence (transp_eq (n:=n)).
 split; unfold Reflexive, Symmetric, Transitive, transp_eq; intros;
 [ reflexivity | symmetry | rewrite H ]; auto.
Qed.
Instance perm_eq_Equiv n: Equivalence (perm_eq (n:=n)).
 split; unfold Reflexive, Symmetric, Transitive, perm_eq; intros;
 [ reflexivity | symmetry | rewrite H ]; auto.
Qed.

Instance vect_transp_Proper A n: Proper (vect_eq ==> transp_eq ==> vect_eq) (vect_transp (A:=A) (n:=n)).
 unfold Proper, respectful, transp_eq, vect_transp; intros; rewrite H; auto.
Qed.

Theorem transp_involutive {n} (t: transp n): perm_eq (t :: t :: nil) nil.
 intros A v; apply vect_swap_involutive. Qed.
Theorem transp_mult_left {n} (t: transp n) (p: perm n): t :: p = perm_mult (t :: nil) p.
 reflexivity. Qed.
Theorem transp_mult_rigth {n} (t: transp n) (p: perm n): p ++ t :: nil = perm_mult p (t :: nil).
 reflexivity. Qed.

Instance vect_perm_Proper A n: Proper (perm_eq ==> vect_eq ==> vect_eq) (vect_perm (A:=A) (n:=n)).
 pose proof vect_swap_Proper; unfold Proper, respectful in *; intros.
 assert (forall p v1 v2, vect_eq v1 v2 -> vect_eq (vect_perm (A:=A) (n:=n) p v1) (vect_perm p v2)) by
  (induction p; intros; simpl; unfold vect_transp; auto).
 etransitivity; auto.
Qed.

Theorem perm_mult_app {A n} (v: vect A n) (p1 p2: perm n): vect_perm (perm_mult p1 p2) v = vect_perm p2 (vect_perm p1 v).
 apply fold_left_app. Qed.
Theorem perm_mult_assoc {n} (p1 p2 p3: perm n): perm_mult (perm_mult p1 p2) p3 = perm_mult p1 (perm_mult p2 p3).
 unfold perm_eq, vect_eq, perm_mult; rewrite List.app_assoc; auto.
Qed.
Instance perm_mult_Proper n: Proper (perm_eq ==> perm_eq ==> perm_eq) (perm_mult (n:=n)).
 unfold Proper, respectful, perm_eq; intros.
 repeat rewrite perm_mult_app; rewrite H, H0; reflexivity.
Qed.

Theorem transp_involutive_left {n} (t: transp n) (p: perm n): perm_eq (t :: t :: p) p.
 assert (t :: t :: p = perm_mult (t :: t :: nil) p) by auto.
 rewrite H, transp_involutive; reflexivity.
Qed.
Theorem transp_involutive_right {n} (t: transp n) (p: perm n): perm_eq (perm_mult p (t :: t :: nil)) p.
 unfold perm_mult; rewrite transp_involutive, app_nil_r; reflexivity.
Qed.

Theorem perm_mult_nil_left {n} (p: perm n): perm_mult nil p = p.
 reflexivity. Qed.
Theorem perm_mult_nil_right {n} (p: perm n): perm_mult p nil = p.
 apply app_nil_r. Qed.

Theorem perm_mult_inv {n} (p1 p2: perm n): perm_inv (perm_mult p1 p2) = perm_mult (perm_inv p2) (perm_inv p1).
 apply rev_app_distr. Qed.
Theorem perm_inv_mult_left {n} (p: perm n): perm_eq (perm_mult (perm_inv p) p) nil.
 induction p.
  reflexivity.
  rewrite (transp_mult_left a p), perm_mult_inv, perm_mult_assoc; simpl; rewrite transp_involutive_left; auto.
Qed.
Theorem perm_inv_mult_right {n} (p: perm n): perm_eq (perm_mult p (perm_inv p)) nil.
 induction p.
  reflexivity.
  rewrite (transp_mult_left a p), perm_mult_inv, perm_mult_assoc, <- (perm_mult_assoc p), IHp; apply transp_involutive_left.
Qed.

Theorem perm_inv_involutive {n} (p: perm n): perm_eq (perm_inv (perm_inv p)) p.
 unfold perm_inv; rewrite rev_involutive; reflexivity.
Qed.

(*
Definition T1 {A n} (v1 v2: vect A n) (t: transp n): vect_eq (vect_transp v1 t) (vect_transp v2 t) -> vect_eq v1 v2.
 intro. unfold vect_transp in *. rewrite <- (twice_transp_is_id t). rewrite <- (twice_transp_is_id t A v2).
 rewrite H. reflexivity.
Qed.

Definition T2 {A n} (v1 v2: vect A n) (p: perm n): vect_eq (vect_perm p v1) (vect_perm p v2) -> vect_eq v1 v2.
 revert v1 v2. induction p.
  simpl in *. auto.
  simpl in *. intros. apply IHp in H. apply T1 with (t:=a). auto.
Qed.
*)

Theorem T0 {n} (p p1 p2: perm n): perm_eq p1 p2 -> perm_eq (perm_mult p p1) (perm_mult p p2).
 intro; rewrite H; reflexivity.
Qed.

Theorem T1 {n} (p: perm n): perm_eq nil p -> perm_eq (perm_inv p) nil.
 intro; apply (T0 (perm_inv p)) in H; rewrite perm_inv_mult_left, perm_mult_nil_right in H; auto.
Qed.

Instance perm_inv_Proper n: Proper (perm_eq ==> perm_eq) (perm_inv (n:=n)).
 unfold Proper, respectful.
 induction x; intros.
  symmetry; exact (T1 y H).
  intros.
   apply (T0 (a :: nil)) in H; simpl in H; rewrite transp_involutive_left in H; apply IHx in H.
   rewrite transp_mult_left, perm_mult_inv, H; simpl (perm_inv (a :: nil)).
   rewrite transp_mult_left, perm_mult_inv, perm_mult_assoc; simpl; rewrite transp_involutive_right; reflexivity.
Qed.

Inductive parity := even | odd.
Definition change_parity p := match p with even => odd | odd => even end.
Definition transp_is_id {n} (p: transp n) := eq_dec (fst p).1 (snd p).1.
Definition perm_parity {n} (p: perm n) :=
 List.fold_left (fun p t => if transp_is_id t then p else change_parity p) p even.


(***********************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
(*   \VV/  *************************************************************)
(*    //   *      This file is distributed under the terms of the      *)
(*         *       GNU Lesser General Public License Version 2.1       *)
(***********************************************************************)

(** * Finite sets library *)

(** This functor derives additional facts from [FSetInterface.S]. These
  facts are mainly the specifications of [FSetInterface.S] written using
  different styles: equivalence and boolean equalities.
  Moreover, we prove that [E.Eq] and [Equal] are setoid equalities.
*)

Require Import DecidableTypeEx.
Require Export FSetInterface.
Set Implicit Arguments.
Unset Strict Implicit.

(** First, a functor for Weak Sets in functorial version. *)

Module WFacts_fun (Import E : DecidableType)(Import M : WSfun E).

Notation eq_dec := E.eq_dec.
Definition eqb x y := if eq_dec x y then true else false.

(** * Specifications written using equivalences *)

Section IffSpec.
Variable s s' s'' : t.
Variable x y z : elt.

Lemma In_eq_iff : E.eq x y -> (In x s <-> In y s).
Proof.
split; apply In_1; auto.
Qed.

Lemma mem_iff : In x s <-> mem x s = true.
Proof.
split; [apply mem_1|apply mem_2].
Qed.

Lemma not_mem_iff : ~In x s <-> mem x s = false.
Proof.
rewrite mem_iff; destruct (mem x s); intuition.
Qed.

Lemma equal_iff : s[=]s' <-> equal s s' = true.
Proof.
split; [apply equal_1|apply equal_2].
Qed.

Lemma subset_iff : s[<=]s' <-> subset s s' = true.
Proof.
split; [apply subset_1|apply subset_2].
Qed.

Lemma empty_iff : In x empty <-> False.
Proof.
intuition; apply (empty_1 H).
Qed.

Lemma is_empty_iff : Empty s <-> is_empty s = true.
Proof.
split; [apply is_empty_1|apply is_empty_2].
Qed.

Lemma singleton_iff : In y (singleton x) <-> E.eq x y.
Proof.
split; [apply singleton_1|apply singleton_2].
Qed.

Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s.
Proof.
split; [ | destruct 1; [apply add_1|apply add_2]]; auto.
destruct (eq_dec x y) as [E|E]; auto.
intro H; right; exact (add_3 E H).
Qed.

Lemma add_neq_iff : ~ E.eq x y -> (In y (add x s)  <-> In y s).
Proof.
split; [apply add_3|apply add_2]; auto.
Qed.

Lemma remove_iff : In y (remove x s) <-> In y s /\ ~E.eq x y.
Proof.
split; [split; [apply remove_3 with x |] | destruct 1; apply remove_2]; auto.
intro.
apply (remove_1 H0 H).
Qed.

Lemma remove_neq_iff : ~ E.eq x y -> (In y (remove x s) <-> In y s).
Proof.
split; [apply remove_3|apply remove_2]; auto.
Qed.

Lemma union_iff : In x (union s s') <-> In x s \/ In x s'.
Proof.
split; [apply union_1 | destruct 1; [apply union_2|apply union_3]]; auto.
Qed.

Lemma inter_iff : In x (inter s s') <-> In x s /\ In x s'.
Proof.
split; [split; [apply inter_1 with s' | apply inter_2 with s] | destruct 1; apply inter_3]; auto.
Qed.

Lemma diff_iff : In x (diff s s') <-> In x s /\ ~ In x s'.
Proof.
split; [split; [apply diff_1 with s' | apply diff_2 with s] | destruct 1; apply diff_3]; auto.
Qed.

Variable f : elt->bool.

Lemma filter_iff :  compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true).
Proof.
split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto.
Qed.

Lemma for_all_iff : compat_bool E.eq f ->
  (For_all (fun x => f x = true) s <-> for_all f s = true).
Proof.
split; [apply for_all_1 | apply for_all_2]; auto.
Qed.

Lemma exists_iff : compat_bool E.eq f ->
  (Exists (fun x => f x = true) s <-> exists_ f s = true).
Proof.
split; [apply exists_1 | apply exists_2]; auto.
Qed.

Lemma elements_iff : In x s <-> InA E.eq x (elements s).
Proof.
split; [apply elements_1 | apply elements_2].
Qed.

End IffSpec.

(** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *)

Ltac set_iff :=
 repeat (progress (
  rewrite add_iff || rewrite remove_iff || rewrite singleton_iff
  || rewrite union_iff || rewrite inter_iff || rewrite diff_iff
  || rewrite empty_iff)).

(**  * Specifications written using boolean predicates *)

Section BoolSpec.
Variable s s' s'' : t.
Variable x y z : elt.

Lemma mem_b : E.eq x y -> mem x s = mem y s.
Proof.
intros.
generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H).
destruct (mem x s); destruct (mem y s); intuition.
Qed.

Lemma empty_b : mem y empty = false.
Proof.
generalize (empty_iff y)(mem_iff empty y).
destruct (mem y empty); intuition.
Qed.

Lemma add_b : mem y (add x s) = eqb x y || mem y s.
Proof.
generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb.
destruct (eq_dec x y); destruct (mem y s); destruct (mem y (add x s)); intuition.
Qed.

Lemma add_neq_b : ~ E.eq x y -> mem y (add x s) = mem y s.
Proof.
intros; generalize (mem_iff (add x s) y)(mem_iff s y)(add_neq_iff s H).
destruct (mem y s); destruct (mem y (add x s)); intuition.
Qed.

Lemma remove_b : mem y (remove x s) = mem y s && negb (eqb x y).
Proof.
generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_iff s x y); unfold eqb.
destruct (eq_dec x y); destruct (mem y s); destruct (mem y (remove x s)); simpl; intuition.
Qed.

Lemma remove_neq_b : ~ E.eq x y -> mem y (remove x s) = mem y s.
Proof.
intros; generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_neq_iff s H).
destruct (mem y s); destruct (mem y (remove x s)); intuition.
Qed.

Lemma singleton_b : mem y (singleton x) = eqb x y.
Proof.
generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb.
destruct (eq_dec x y); destruct (mem y (singleton x)); intuition.
Qed.

Lemma union_b : mem x (union s s') = mem x s || mem x s'.
Proof.
generalize (mem_iff (union s s') x)(mem_iff s x)(mem_iff s' x)(union_iff s s' x).
destruct (mem x s); destruct (mem x s'); destruct (mem x (union s s')); intuition.
Qed.

Lemma inter_b : mem x (inter s s') = mem x s && mem x s'.
Proof.
generalize (mem_iff (inter s s') x)(mem_iff s x)(mem_iff s' x)(inter_iff s s' x).
destruct (mem x s); destruct (mem x s'); destruct (mem x (inter s s')); intuition.
Qed.

Lemma diff_b : mem x (diff s s') = mem x s && negb (mem x s').
Proof.
generalize (mem_iff (diff s s') x)(mem_iff s x)(mem_iff s' x)(diff_iff s s' x).
destruct (mem x s); destruct (mem x s'); destruct (mem x (diff s s')); simpl; intuition.
Qed.

Lemma elements_b : mem x s = existsb (eqb x) (elements s).
Proof.
generalize (mem_iff s x)(elements_iff s x)(existsb_exists (eqb x) (elements s)).
rewrite InA_alt.
destruct (mem x s); destruct (existsb (eqb x) (elements s)); auto; intros.
symmetry.
rewrite H1.
destruct H0 as (H0,_).
destruct H0 as (a,(Ha1,Ha2)); [ intuition |].
exists a; intuition.
unfold eqb; destruct (eq_dec x a); auto.
rewrite <- H.
rewrite H0.
destruct H1 as (H1,_).
destruct H1 as (a,(Ha1,Ha2)); [intuition|].
exists a; intuition.
unfold eqb in *; destruct (eq_dec x a); auto; discriminate.
Qed.

Variable f : elt->bool.

Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x.
Proof.
intros.
generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H).
destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition.
Qed.

Lemma for_all_b : compat_bool E.eq f ->
  for_all f s = forallb f (elements s).
Proof.
intros.
generalize (forallb_forall f (elements s))(for_all_iff s H)(elements_iff s).
unfold For_all.
destruct (forallb f (elements s)); destruct (for_all f s); auto; intros.
rewrite <- H1; intros.
destruct H0 as (H0,_).
rewrite (H2 x0) in H3.
rewrite (InA_alt E.eq x0 (elements s)) in H3.
destruct H3 as (a,(Ha1,Ha2)).
rewrite (H _ _ Ha1).
apply H0; auto.
symmetry.
rewrite H0; intros.
destruct H1 as (_,H1).
apply H1; auto.
rewrite H2.
rewrite InA_alt; eauto.
Qed.

Lemma exists_b : compat_bool E.eq f ->
  exists_ f s = existsb f (elements s).
Proof.
intros.
generalize (existsb_exists f (elements s))(exists_iff s H)(elements_iff s).
unfold Exists.
destruct (existsb f (elements s)); destruct (exists_ f s); auto; intros.
rewrite <- H1; intros.
destruct H0 as (H0,_).
destruct H0 as (a,(Ha1,Ha2)); auto.
exists a; split; auto.
rewrite H2; rewrite InA_alt; eauto.
symmetry.
rewrite H0.
destruct H1 as (_,H1).
destruct H1 as (a,(Ha1,Ha2)); auto.
rewrite (H2 a) in Ha1.
rewrite (InA_alt E.eq a (elements s)) in Ha1.
destruct Ha1 as (b,(Hb1,Hb2)).
exists b; auto.
rewrite <- (H _ _ Hb1); auto.
Qed.

End BoolSpec.

(** * [E.eq] and [Equal] are setoid equalities *)

Instance E_ST : Equivalence E.eq.
Proof.
constructor ; red; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans].
Qed.

Instance Equal_ST : Equivalence Equal.
Proof.
constructor ; red; [apply eq_refl | apply eq_sym | apply eq_trans].
Qed.

Instance In_m : Proper (E.eq ==> Equal ==> iff) In.
Proof.
unfold Equal; intros x y H s s' H0.
rewrite (In_eq_iff s H); auto.
Qed.

Instance is_empty_m : Proper (Equal==> Logic.eq) is_empty.
Proof.
unfold Equal; intros s s' H.
generalize (is_empty_iff s)(is_empty_iff s').
destruct (is_empty s); destruct (is_empty s');
 unfold Empty; auto; intros.
symmetry.
rewrite <- H1; intros a Ha.
rewrite <- (H a) in Ha.
destruct H0 as (_,H0).
exact (H0 (refl_equal true) _ Ha).
rewrite <- H0; intros a Ha.
rewrite (H a) in Ha.
destruct H1 as (_,H1).
exact (H1 (refl_equal true) _ Ha).
Qed.

Instance Empty_m : Proper (Equal ==> iff) Empty.
Proof.
repeat red; intros; do 2 rewrite is_empty_iff; rewrite H; intuition.
Qed.

Instance mem_m : Proper (E.eq ==> Equal ==> Logic.eq) mem.
Proof.
unfold Equal; intros x y H s s' H0.
generalize (H0 x); clear H0; rewrite (In_eq_iff s' H).
generalize (mem_iff s x)(mem_iff s' y).
destruct (mem x s); destruct (mem y s'); intuition.
Qed.

Instance singleton_m : Proper (E.eq ==> Equal) singleton.
Proof.
unfold Equal; intros x y H a.
do 2 rewrite singleton_iff; split; intros.
apply E.eq_trans with x; auto.
apply E.eq_trans with y; auto.
Qed.

Instance add_m : Proper (E.eq==>Equal==>Equal) add.
Proof.
unfold Equal; intros x y H s s' H0 a.
do 2 rewrite add_iff; rewrite H; rewrite H0; intuition.
Qed.

Instance remove_m : Proper (E.eq==>Equal==>Equal) remove.
Proof.
unfold Equal; intros x y H s s' H0 a.
do 2 rewrite remove_iff; rewrite H; rewrite H0; intuition.
Qed.

Instance union_m : Proper (Equal==>Equal==>Equal) union.
Proof.
unfold Equal; intros s s' H s'' s''' H0 a.
do 2 rewrite union_iff; rewrite H; rewrite H0; intuition.
Qed.

Instance inter_m : Proper (Equal==>Equal==>Equal) inter.
Proof.
unfold Equal; intros s s' H s'' s''' H0 a.
do 2 rewrite inter_iff; rewrite H; rewrite H0; intuition.
Qed.

Instance diff_m : Proper (Equal==>Equal==>Equal) diff.
Proof.
unfold Equal; intros s s' H s'' s''' H0 a.
do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition.
Qed.

Instance Subset_m : Proper (Equal==>Equal==>iff) Subset.
Proof.
unfold Equal, Subset; firstorder.
Qed.

Instance subset_m : Proper (Equal ==> Equal ==> Logic.eq) subset.
Proof.
intros s s' H s'' s''' H0.
generalize (subset_iff s s'') (subset_iff s' s''').
destruct (subset s s''); destruct (subset s' s'''); auto; intros.
rewrite H in H1; rewrite H0 in H1; intuition.
rewrite H in H1; rewrite H0 in H1; intuition.
Qed.

Instance equal_m : Proper (Equal ==> Equal ==> Logic.eq) equal.
Proof.
intros s s' H s'' s''' H0.
generalize (equal_iff s s'') (equal_iff s' s''').
destruct (equal s s''); destruct (equal s' s'''); auto; intros.
rewrite H in H1; rewrite H0 in H1; intuition.
rewrite H in H1; rewrite H0 in H1; intuition.
Qed.

(* [Subset] is a setoid order *)

Lemma Subset_refl : forall s, s[<=]s.
Proof. red; auto. Qed.

Lemma Subset_trans : forall s s' s'', s[<=]s'->s'[<=]s''->s[<=]s''.
Proof. unfold Subset; eauto. Qed.

Add Relation t Subset
 reflexivity proved by Subset_refl
 transitivity proved by Subset_trans
 as SubsetSetoid.

Instance In_s_m : Morphisms.Proper (E.eq ==> Subset ++> Basics.impl) In | 1.
Proof.
  simpl_relation. eauto with set.
Qed.

Add Morphism Empty with signature Subset --> Basics.impl as Empty_s_m.
Proof.
unfold Subset, Empty, Basics.impl; firstorder.
Qed.

Add Morphism add with signature E.eq ==> Subset ++> Subset as add_s_m.
Proof.
unfold Subset; intros x y H s s' H0 a.
do 2 rewrite add_iff; rewrite H; intuition.
Qed.

Add Morphism remove with signature E.eq ==> Subset ++> Subset as remove_s_m.
Proof.
unfold Subset; intros x y H s s' H0 a.
do 2 rewrite remove_iff; rewrite H; intuition.
Qed.

Add Morphism union with signature Subset ++> Subset ++> Subset as union_s_m.
Proof.
unfold Equal; intros s s' H s'' s''' H0 a.
do 2 rewrite union_iff; intuition.
Qed.

Add Morphism inter with signature Subset ++> Subset ++> Subset as inter_s_m.
Proof.
unfold Equal; intros s s' H s'' s''' H0 a.
do 2 rewrite inter_iff; intuition.
Qed.

Add Morphism diff with signature Subset ++> Subset --> Subset as diff_s_m.
Proof.
unfold Subset; intros s s' H s'' s''' H0 a.
do 2 rewrite diff_iff; intuition.
Qed.

(* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism
   without additional hypothesis on [f]. For instance: *)

Lemma filter_equal : forall f, compat_bool E.eq f ->
  forall s s', s[=]s' -> filter f s [=] filter f s'.
Proof.
unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto.
Qed.

Lemma filter_ext : forall f f', compat_bool E.eq f -> (forall x, f x = f' x) ->
 forall s s', s[=]s' -> filter f s [=] filter f' s'.
Proof.
intros f f' Hf Hff' s s' Hss' x. do 2 (rewrite filter_iff; auto).
rewrite Hff', Hss'; intuition.
repeat red; intros; rewrite <- 2 Hff'; auto.
Qed.

Lemma filter_subset : forall f, compat_bool E.eq f ->
  forall s s', s[<=]s' -> filter f s [<=] filter f s'.
Proof.
unfold Subset; intros; rewrite filter_iff in *; intuition.
Qed.

(* For [elements], [min_elt], [max_elt] and [choose], we would need setoid
   structures on [list elt] and [option elt]. *)

(* Later:
Add Morphism cardinal ; cardinal_m.
*)

End WFacts_fun.

(** Now comes variants for self-contained weak sets and for full sets.
    For these variants, only one argument is necessary. Thanks to
    the subtyping [WS<=S], the [Facts] functor which is meant to be
    used on modules [(M:S)] can simply be an alias of [WFacts]. *)

Module WFacts (M:WS) := WFacts_fun M.E M.
Module Facts := WFacts.


(** * 6.887 Formal Reasoning About Programs, Spring 2016 - Pset 1 *)

Require Import Frap Pset1Sig.

(* Authors: Peng Wang (wangpeng@csail.mit.edu), Adam Chlipala (adamc@csail.mit.edu) *)

(** * MapReduce *)

Lemma add_positive : forall n m,
  n > 0
  -> m > 0
  -> n + m > 0.
Proof.
  linear_arithmetic.
Qed.

Theorem allPositive_ok : forall m x,
  allPositive m
  -> x > 0
  -> interp_map m x > 0.
Proof.
  induct m; simplify; propositional.

  apply add_positive.
  apply IHm1.
  trivial.
  trivial.
  apply IHm2.
  trivial.
  trivial.

  apply IHm1.
  trivial.
  apply IHm2.
  trivial.
  trivial.
Qed.

Lemma fold_left_swap' : forall A (f : A -> A -> A),
  (forall x y : A, f x y = f y x)
  (* Operator is commutative. *)
  -> (forall x y z : A, f (f x y) z = f x (f y z))
  (* Operator is associative. *)
  -> forall ls a b,
      fold_left f ls (f a b) = f (fold_left f ls a) b.
Proof.
  induct ls; simplify; try equality.
Qed.

Lemma fold_left_swap : forall A (f : A -> A -> A),
  (forall x y : A, f x y = f y x)
  (* Operator is commutative. *)
  -> (forall x y z : A, f (f x y) z = f x (f y z))
  (* Operator is associative. *)
  -> forall ls1 ls2 init,
      fold_left f (ls1 ++ ls2) init = fold_left f (ls2 ++ ls1) init.
Proof.
  induct ls1; simplify.
  {
    rewrite app_nil_r.
    equality.
  }
  {
    rewrite IHls1.
    rewrite fold_left_app.
    rewrite fold_left_app.
    simplify.
    f_equal.
    apply fold_left_swap'; trivial.
  }
Qed.

Lemma reduce_swap : forall e ls1 ls2,
  interp_reduce e (ls1 ++ ls2) = interp_reduce e (ls2 ++ ls1).
Proof.
  unfold interp_reduce; simplify.
  cases e; apply fold_left_swap; simplify; linear_arithmetic.
Qed.

Lemma interp_swap : forall e ls1 ls2, interp_mr e (ls1 ++ ls2) = interp_mr e (ls2 ++ ls1).
Proof.
  induct e; simplify.
  unfold interp_mr; simplify.
  rewrite map_app.
  rewrite map_app.
  apply reduce_swap.
Qed.

Lemma fold_left_par' : forall A (f : A -> A -> A) (rzero : A),
    (forall x y z : A, f (f x y) z = f x (f y z))
    (* Operator is associative. *)
    -> (forall x, f x rzero = x)
    (* [rzero] is a right zero for operator. *)
    -> forall ls init, fold_left f ls init = f init (fold_left f ls rzero).
Proof.
  induct ls; simplify; equality.
Qed.

Lemma fold_left_par : forall A (f : A -> A -> A) (rzero : A),
    (forall x y z : A, f (f x y) z = f x (f y z))
    (* Operator is associative. *)
    -> (forall x, f x rzero = x)
    (* [rzero] is a right zero for operator. *)
    -> forall ls1 ls2 init,
        fold_left f (ls1 ++ ls2) init = f (fold_left f ls1 init) (fold_left f ls2 rzero).
Proof.
  induct ls1; simplify; try equality.
  apply fold_left_par'.
  trivial.
  trivial.
Qed.

Lemma mapReduce_partition_two : forall m r ls1 ls2,
    interp_mr (m, r) (ls1 ++ ls2) = interp_reduce r [interp_mr (m, r) ls1; interp_mr (m, r) ls2].
Proof.
  unfold interp_mr; simplify.
  cases r; simplify; rewrite map_app; apply fold_left_par; linear_arithmetic.
Qed.

Arguments app {_} _ _ .

Lemma mapReduce_partition' : forall m r lsls init,
    interp_mr (m, r) (fold_left app lsls init)
    = interp_reduce r (interp_mr (m, r) init :: map (interp_mr (m, r)) lsls).
Proof.
  induct lsls; simplify.
  {
    unfold interp_reduce; simplify.
    cases r; linear_arithmetic.
  }
  {
    rewrite IHlsls.
    rewrite mapReduce_partition_two.
    cases r; simplify; linear_arithmetic.
  }
Qed.

Lemma mapReduce_partition : forall m r lsls,
    interp_mr (m, r) (fold_left app lsls []) = interp_reduce r (map (interp_mr (m, r)) lsls).
Proof.
  induct lsls; simplify; try equality.
  apply mapReduce_partition'.
Qed.

(** * Constant propagation *)

Theorem constPropArith_ok : forall v1 v2 e,
  (forall x n, v1 $? x = Some n -> v2 $? x = Some n)
  -> interp (constPropArith e v1) v2 = interp e v2.
Proof.
  induct e; simplify; propositional.

  cases (v1 $? x); simplify; try equality.
  rewrite (H x n); simplify; equality.

  cases (constPropArith e1 v1); simplify; try equality.
  cases (constPropArith e2 v1); simplify; equality.

  cases (constPropArith e1 v1); simplify; try equality.
  cases (constPropArith e2 v1); simplify; equality.

  cases (constPropArith e1 v1); simplify; try equality.
  cases (constPropArith e2 v1); simplify; equality.
Qed.

Theorem effectOf_ok : forall c v1 v2,
  (forall x n, v1 $? x = Some n -> v2 $? x = Some n)
  -> (forall x n, effectOf c v1 $? x = Some n
                  -> exec c v2 $? x = Some n).
Proof.
  induct c; simplify; try equality.

  apply H.
  trivial.

  cases (constPropArith e v1).
  rewrite <- (constPropArith_ok v1).
  cases (x ==v x0); simplify; try equality.
  rewrite Heq.
  simplify.
  trivial.
  apply H.
  trivial.
  trivial.

  cases (x ==v x0); simplify; try equality.
  apply H.
  trivial.

  cases (x ==v x0); simplify; try equality.
  apply H.
  trivial.

  cases (x ==v x0); simplify; try equality.
  apply H.
  trivial.

  cases (x ==v x0); simplify; try equality.
  apply H.
  trivial.

  apply (IHc2 (effectOf c1 v1)).
  apply IHc1.
  trivial.
  trivial.
Qed.

Theorem constProp_ok : forall c v1 v2,
  (forall x n, v1 $? x = Some n -> v2 $? x = Some n)
  -> exec (constProp c v1) v2 = exec c v2.
Proof.
  induct c; simplify; propositional.

  rewrite constPropArith_ok.
  trivial.
  trivial.

  rewrite IHc1.
  rewrite IHc2.
  trivial.
  trivial.
  apply effectOf_ok.
  trivial.
  trivial.

  rewrite constPropArith_ok.
  apply selfCompose_extensional.
  simplify.
  apply IHc.
  simplify.
  equality.
  trivial.
Qed.

Theorem constProp_ok0 : forall c v,
  exec (constProp c $0) v = exec c v.
Proof.
  simplify.
  apply constProp_ok.
  simplify.
  equality.
Qed.


Require Import List Bool.

Import ListNotations.

Structure dfa (A B : Type) := {
  t : A -> B -> A;
  s : A;

  F : A -> bool;
}.

Arguments t {A} {B}.
Arguments s {A} {B}.
Arguments F {A} {B}.

Fixpoint tStar {A B : Type} (M : dfa A B) (q : A) (str : list B) : A :=
  match str with
  | []      => q
  | x :: xs => tStar M (t M q x) xs
  end.

Definition accepted {A B : Type} (M : dfa A B) (str : list B) : bool :=
  F M (tStar M (s M) str).

Lemma tStar_step :
  forall {A B : Type} (M : dfa A B) (str : list B) (q : A) (x : B),
    tStar M q (str ++ [x]) = t M (tStar M q str) x.
Proof.
intros A B M str.

induction str.
intuition.

intuition.
simpl.
exact (IHstr (t M q a) x).
Qed.

Definition not_dfa_f {A B : Type} (M : dfa A B) (q : A) : bool := negb (F M q).

Definition not_dfa {A B : Type} (M : dfa A B) : dfa A B :=
  Build_dfa A B (t M) (s M) (not_dfa_f M).

Lemma not_dfa_mirror {A B : Type} (M : dfa A B) :
  forall (str : list B), tStar M (s M) str = tStar (not_dfa M) (s M) str.
Proof.
apply rev_ind.

intuition.

intuition.
rewrite tStar_step, tStar_step.
simpl.
rewrite H.
reflexivity.
Qed.

Theorem not_dfa_correct :
  forall {A B : Type} (M : dfa A B) (str : list B),
   accepted M str = true <-> accepted (not_dfa M) str = false.
Proof.
intros.
unfold accepted.
simpl.
rewrite not_dfa_mirror.
unfold not_dfa_f.
intuition.
rewrite H.
intuition.
induction (F M (tStar (not_dfa M) (s M) str)).
intuition.
intuition.
Qed.

Definition and_dfa_trans
  {A B C : Type} (M : dfa A B) (N : dfa C B) (q : A * C) (s : B) : A * C :=
  match q with
  | (qm, qn) => (t M qm s, t N qn s)
  end.

Definition and_dfa_f {A B C : Type} (M : dfa A B) (N : dfa C B) (q : A * C) : bool :=
  match q with
  | (a,c) => F M a && F N c
  end.

Definition and_dfa {A B C : Type} (M : dfa A B) (N : dfa C B) : dfa (A * C) B :=
  Build_dfa (A * C) B
            (and_dfa_trans M N) (s M, s N) (and_dfa_f M N).

Lemma and_dfa_mirror_m
  {A B C : Type} (M : dfa A B) (N : dfa C B) :
    forall (str : list B), tStar M (s M) str = fst (tStar (and_dfa M N) (s (and_dfa M N)) str).
Proof.
apply rev_ind.

intuition.

intros.

rewrite tStar_step, tStar_step.
destruct (tStar (and_dfa M N) (s (and_dfa M N)) l).
unfold and_dfa.
simpl.
rewrite H.
intuition.
Qed.

Lemma and_dfa_mirror_n
  {A B C : Type} (M : dfa A B) (N : dfa C B) :
    forall (str : list B), tStar N (s N) str = snd (tStar (and_dfa M N) (s (and_dfa M N)) str).
Proof.
apply rev_ind.

intuition.

intros.

rewrite tStar_step.
rewrite tStar_step.
destruct (tStar (and_dfa M N) (s (and_dfa M N)) l).
unfold and_dfa.
simpl.
rewrite H.
intuition.
Qed.

Theorem and_dfa_correct :
  forall {A B C : Type} (M : dfa A B) (N : dfa C B) (str : list B),
    accepted (and_dfa M N) str = true <-> accepted M str && accepted N str = true.
Proof.
intros.
unfold accepted.
rewrite (and_dfa_mirror_m M N str).
rewrite (and_dfa_mirror_n M N str).
destruct (tStar (and_dfa M N) (s (and_dfa M N)) str).
simpl.

intuition.
Qed.


Require Import Arith.
Require Import List.
Require Import Relations.
Require Import Wellfounded.
Require Import list_util.
Require Import FSA.

Set Implicit Arguments.

Hint Resolve le_plus_r le_plus_l le_n_S le_S_n.

Section CharType.

Variable C: Set.
Variable C_eq_dec: forall x y:C, {x=y}+{x<>y}.

Inductive RegExp: Set:=
| Rnil: RegExp
| Rchar: C -> RegExp
| Rcons: RegExp -> RegExp -> RegExp
| Ror: RegExp -> RegExp -> RegExp
| Rstar: RegExp -> RegExp
.

Inductive Racc: RegExp -> list C -> Prop:=
|RAchar : forall c, Racc (Rchar c) (c::nil)
|RAcons : forall l m r s, Racc r l -> Racc s m -> Racc (Rcons r s) (l++m)
|RAor1  : forall l r s, Racc r l -> Racc (Ror r s) l
|RAor2  : forall l r s, Racc s l -> Racc (Ror r s) l
|RAstar1: forall r, Racc (Rstar r) nil
|RAstar2: forall r l m, Racc r l -> Racc (Rstar r) m -> Racc (Rstar r) (l++m)
.
Hint Constructors Racc.

Definition Remp:=Rstar Rnil.
Theorem Remp_spec: forall w, Racc Remp w<-> w=nil. Proof. unfold Remp. intros; split; intros; [|subst w]; auto. inversion H; auto. inversion H1. Qed.
Theorem Rnil_spec: forall w, ~Racc Rnil w. Proof. intros w D. inversion D. Qed.
Theorem Rchar_spec: forall w c, Racc (Rchar c) w <-> w=c::nil. Proof. intros; split; intros. inversion H; auto. subst w; auto. Qed.
Definition Rword w:=fold_right (fun c r=>Rcons (Rchar c) r) Remp w.
Theorem Rword_spec: forall w s, Racc (Rword w) s <-> s=w. Proof. induction w; intros; simpl; split; intros. apply Remp_spec; auto. apply Remp_spec; auto. inversion H. inversion H2. simpl. f_equal. apply IHw; auto. subst s. replace (a::w) with ((a::nil)++w); auto. apply RAcons; auto. apply IHw; auto. Qed.
Hint Resolve Remp_spec Rnil_spec Rchar_spec Rword_spec.

Definition Rincl: relation RegExp:= fun r s=>forall w, Racc r w -> Racc s w.
Definition Req: relation RegExp:= fun r s=> Rincl r s /\ Rincl s r.

Theorem Rstar_app: forall r l m, Racc (Rstar r) l -> Racc (Rstar r) m -> Racc (Rstar r) (l++m). Proof. intros r l m H H0. revert H0. revert m. remember (Rstar r) as r1. revert Heqr1. induction H; intros; try discriminate Heqr1; simpl; auto. rewrite <- app_assoc. apply RAstar2; auto. Qed.
Theorem Rstar_one: forall r w, Racc r w -> Racc (Rstar r) w. Proof. intros. destruct w; auto. rewrite <- app_nil_r; apply RAstar2; auto. Qed.
Theorem Rstar_incl: forall r s, Rincl r s -> Rincl (Rstar r) (Rstar s). Proof. intros. intros w H0. remember (Rstar r) as r1. revert Heqr1. induction H0; intros; try discriminate Heqr1; auto. inversion Heqr1. subst r0. auto. Qed.
Theorem Rstar_rev': forall r w, Racc (Rstar r) w -> w<>nil -> exists l m, Racc r l /\ Racc (Rstar r) m /\ l<>nil /\ w=l++m. intros r w H. remember (Rstar r) as s. revert Heqs. revert r.  induction H; intros; try discriminate Heqs. contradict H; auto. inversion Heqs. subst r0. clear IHRacc1. destruct (list_eq_dec C_eq_dec m nil). subst m. exists l. exists nil. rewrite app_nil_r in H1. auto. destruct IHRacc2 with (r0:=r) as [l' [m' [H2 [H3 [H4 H5]]]]]; auto. subst m. destruct (list_eq_dec C_eq_dec l nil). subst l. exists l'. exists m'; auto. exists l. exists (l'++m'); auto. Qed.
Hint Resolve Rstar_app Rstar_one Rstar_incl Rstar_rev'.

Definition Racc_dec: forall r w,{Racc r w}+{~Racc r w}. induction r; intros. right. intros H; inversion H. destruct (list_eq_dec C_eq_dec w (c::nil)); [subst w; left|right]; auto. contradict n; inversion n; auto. destruct (splits w) as [l H _]. destruct (findP (fun p=>Racc r1 (fst p)/\Racc r2 (snd p)) l) as [[[w1 w2] H0 [H1 H2]]|H0]; [|left|right]. intros p _. destruct (IHr1 (fst p)); [destruct (IHr2 (snd p)); [left|right]|right]; auto; contradict n; destruct n; auto. apply H in H0. subst w; auto. intros D; inversion D. subst r s w. absurd (Racc r1 (fst (l0,m))/\Racc r2 (snd (l0,m))); auto. apply H0. apply H; auto. destruct (IHr1 w); [left| destruct (IHr2 w);[left|right]]; auto. intros D; inversion D; auto.
  apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun w=>{Racc (Rstar r) w}+{~Racc (Rstar r) w}). clear w. intros w IH. destruct w. left; auto. destruct (splits w) as [l H _]. destruct (findP (fun p=>Racc r (c::fst p)/\Racc (Rstar r) (snd p)) l) as [[[w1 w2] H0 [H1 H2]]|H0]; [|left|right]. intros p H0. destruct (IHr (c::fst p)). destruct (IH (snd p)); [|left|right]; auto. unfold ltof. simpl. apply le_n_S. apply H in H0. subst w. rewrite app_length; auto. contradict n; destruct n; auto. right; contradict n; destruct n; auto. apply H in H0. subst w. simpl. replace (c::w1++w2) with ((c::w1)++w2); auto. intros D. destruct (Rstar_rev' D) as [w1 [w2 [H1 [H2 [H3 H4]]]]]. discriminate. destruct w1. contradict H3; auto. inversion H4. subst c0 w. absurd (Racc r (c::fst (w1,w2))/\Racc (Rstar r) (snd (w1,w2))); auto. apply H0. apply H; auto. Defined.
Definition Rshortest: forall r, {w| Racc r w & forall s, Racc r s -> length w <= length s}+{forall w, ~Racc r w}. induction r. right; auto. left; exists (c::nil); auto. intros. apply Rchar_spec in H. subst s; auto. destruct IHr1 as [[w H1 H2]|H1]; [destruct IHr2 as [[s H3 H4]|H3]; [left|right]|right]. exists (w++s); auto. intros. inversion H. subst r s1 s0. repeat rewrite app_length. apply le_trans with (length w+length m). apply plus_le_compat_l; auto. apply plus_le_compat_r; auto. intros t D. inversion D. contradict H6; auto. intros t D. inversion D. contradict H2; auto. destruct IHr1 as [[w H1 H2]|H1]; destruct IHr2 as [[s H3 H4]|H3]. left. destruct (le_lt_dec (length w) (length s)). exists w; auto. intros. inversion H; auto. apply le_trans with (length s); auto.
  exists s; auto. intros. inversion H; auto. apply le_trans with (length w); auto. left; exists w; auto. intros. inversion H; auto. contradict H6; auto. left; exists s; auto. intros. inversion H; auto. contradict H6; auto. right. intros w D. inversion D; contradict H4; auto. left; exists nil; auto. Defined.
Definition Rlang': forall r, {l|forall w, Racc r w <-> In w l}+{forall n, exists w, n<=length w /\ Racc r w}. induction r. left. exists nil. intros; split; intros; inversion H. left; exists ((c::nil)::nil). intros; split; intros. left. inversion H; auto. destruct H. subst w; auto. destruct H. destruct IHr1 as [[l1 H1]|H1]; destruct IHr2 as [[l2 H2]|H2]. left. exists (all_pair (app (A:=C)) l1 l2). intros; split; intros. inversion H. apply all_pair_spec1; auto. apply H1; auto. apply H2; auto. apply all_pair_spec2 in H. destruct H as [x [y [H3 [H4 H5]]]]. subst w. apply RAcons. apply H1; auto. apply H2; auto. destruct l1 as [|a l1]. left; exists nil. intros; split; intros; inversion H. apply H1 in H4. inversion H4. right. intros. destruct (H2 n) as [w [H3 H4]]. exists (a++w). split; auto. rewrite app_length. apply le_trans with (m:=length w); auto. apply RAcons; auto. apply H1; auto.
  destruct l2 as [|a l2]. left. exists nil. intros; split; intros; inversion H. apply H2 in H6; inversion H6. right. intros. destruct (H1 n) as [w [H3 H4]]. exists (w++a). split. rewrite app_length. apply le_trans with (length w); auto. apply RAcons; auto. apply H2; auto. right. intros. destruct (H1 n) as [w1 [H3 H4]]. destruct (H2 n) as [w2 [H5 H6]]. exists (w1++w2). split. rewrite app_length. apply le_trans with (length w1); auto. auto. destruct IHr1 as [[l1 H1]|H1]; [destruct IHr2 as [[l2 H2]|H2]|]. left; exists (l1++l2). intros; split; intros. apply in_or_app. inversion H; [left; apply H1|right; apply H2]; auto. apply in_app_or in H. destruct H; [apply H1 in H|apply H2 in H]; auto. right. intros. destruct (H2 n) as [w [H3 H4]]. exists w; auto. right. intros. destruct (H1 n) as [w [H3 H4]]. exists w; auto.
  destruct IHr as [[l H1]|H1]. destruct (maxf (length (A:=C)) l) as [[x H2 H3]|H2]. destruct x. left. exists (nil::nil). intros; split; intros. cut (w=nil). intros; subst w; auto. remember (Rstar r) as r1. revert Heqr1. induction H; intros; try discriminate Heqr1; auto. inversion Heqr1; subst r0. apply H1 in H. apply H3 in H. destruct l0. auto. inversion H. destruct H. subst w; auto. destruct H. right. intros. apply H1 in H2. clear -H2. induction n. exists (c::x). split; auto. destruct IHn as [w [H3 H4]]. exists ((c::x)++w). split; auto. simpl. apply le_n_S. rewrite app_length. apply le_trans with (length w); auto. subst l. left; exists (nil::nil). intros; split; intros. inversion H. left; auto. apply H1 in H2. inversion H2. destruct H. subst w; auto. destruct H. right. intros. destruct (H1 n) as [w [H3 H4]]. exists w; auto. Defined.
Definition Rlang: forall r, {l|forall w, Racc r w <-> In w l}+{forall l, exists w, Racc r w /\ ~In w l}. intros. destruct (Rlang' r) as [[l H1]|H1]; [left|right]. exists l; auto. intros. destruct (maxf (length (A:=C)) l) as [[x H3 H4]|H3]. destruct (H1 (S (length x))) as [w [H5 H6]]. exists w. split; auto. intros D. apply H4 in D. contradict H5. apply le_not_lt; auto. subst l. destruct (H1 0) as [w [H3 H4]]. exists w. split; auto. Defined.
Definition Rlongest: forall r, {w| Racc r w & forall s, Racc r s -> length s <= length w}+{forall n, exists s, Racc r s /\ n <= length s}+{forall w, ~Racc r w}. intros. destruct (Rlang' r) as [[l H1]|H1]. destruct (maxf (length (A:=C)) l) as [[w H2 H3]|H2]. left; left; exists w; auto. apply H1; auto. intros. apply H3. apply H1; auto. subst l. right. intros. intros D. apply H1 in D. destruct D. left; right. intros. destruct (H1 n) as [w [H2 H3]]. exists w; auto. Defined.
Definition sum_is_n: forall n, {pl|forall p, In p pl <-> fst p+snd p =n}. induction n. exists ((0,0)::nil). intros; split; intros. destruct H. subst p; auto. destruct H. destruct p. destruct n. destruct n0; auto. simpl in H. inversion H. simpl in H. inversion H. destruct IHn as [pl H]. exists ((0,S n)::map (fun p=>(S(fst p),snd p)) pl). intros. split; intros. destruct H0. subst p; auto. apply in_map_iff in H0. destruct H0 as [q [H1 H2]]. subst p. simpl. f_equal; apply H; auto. destruct p as [x y]. simpl in H0. destruct x. left; auto. right. inversion H0. apply in_map_iff. exists (x, y). split; simpl; auto. apply H. auto. Defined.
Definition Rlang_length: forall r n, {l|forall w, Racc r w/\length w=n <-> In w l}. intros. revert r. apply (Fix lt_wf) with (P:=fun n=>forall r,{l|forall w, Racc r w/\length w=n<->In w l}). clear n. intros n IH r. induction r. exists nil. intros; split; intros. destruct H; inversion H. inversion H. destruct (nat_eq_dec n 1). subst n. exists ((c::nil)::nil). intros; split; intros. destruct H. inversion H; auto. destruct H. subst w; auto. destruct H. exists nil. intros; split; intros. destruct H. contradict n0. inversion H. subst w n; auto. destruct H. destruct IHr1 as [l1 H1]. destruct IHr2 as [l2 H2]. remember (fun m=>match lt_dec m n with left _ H => match IH m H r1 with exist _ l _ => l end| right _ _ => l1 end) as f1. remember (fun m=>match lt_dec m n with left _ H => match IH m H r2 with exist _ l _ => l end| right _ _ => l2 end) as f2. destruct (sum_is_n n) as [sl H3].
  exists (flat_map (fun p=>all_pair (app (A:=C)) (f1 (fst p)) (f2 (snd p))) sl). intros; split; intros. destruct H. inversion H. subst r s w. apply in_flat_map. exists (length l, length m). split. apply H3. subst n; rewrite app_length; auto. apply all_pair_spec1; simpl. subst f1. destruct (lt_dec (length l) n). destruct (IH (length l) l0 r1). apply i; auto. apply H1. split; auto. destruct m. subst n; rewrite app_nil_r; auto. contradict n0; subst n. rewrite app_length. simpl. rewrite <- plus_n_Sm. auto. subst f2. destruct (lt_dec (length m) n). destruct (IH (length m) l0 r2). apply i; auto. apply H2. split; auto. destruct l; subst n; auto. contradict n0. simpl; rewrite app_length; auto. apply in_flat_map in H. destruct H as [[x y] [H5 H4]]. apply H3 in H5. simpl in H5. subst n. apply all_pair_spec2 in H4. simpl in H4. destruct H4 as [s [t [H6 [H7 H8]]]]. subst w. subst f1. destruct (lt_dec x (x+y)). destruct (IH x l r1). apply i in H6. destruct H6. subst x.
  subst f2. destruct (lt_dec y (length s+y)). destruct (IH y l0 r2). apply i0 in H7. destruct H7. subst y. split; auto. rewrite app_length; auto. apply H2 in H7. destruct H7. split; auto. rewrite app_length. rewrite <- H4. replace (length s) with 0; auto. destruct (length s); auto. contradict n. simpl. apply le_n_S. auto. assert (y=0). destruct y; auto. contradict n. rewrite <- plus_n_Sm; auto. subst y. apply H1 in H6. destruct H6. subst f2. destruct (lt_dec 0 (x+0)). destruct (IH 0 l r2). apply i in H7. destruct H7. destruct t. split; auto. rewrite app_nil_r. auto. inversion H5. apply H2 in H7. destruct H7. split; auto. rewrite app_length. rewrite H0. rewrite H5. replace x with 0; auto. destruct x; auto. contradict n0. simpl. apply le_n_S; auto. destruct IHr1 as [l1 H1]. destruct IHr2 as [l2 H2]. exists (l1++l2). intros; split; intros. destruct H. apply in_or_app. inversion H; [left; apply H1|right; apply H2]; auto. apply in_app_or in H. destruct H;[apply H1 in H|apply H2 in H]; destruct H; auto.
  destruct n. exists (nil::nil). intros; split; intros. destruct H. destruct w; auto. inversion H0. destruct H. subst w; auto. destruct H. destruct IHr as [l1 H1]. destruct (sum_is_n (S n)) as [sl H2]. remember (fun m=>match lt_dec m (S n) with left _ H  => match IH m H r with exist _ l _ => l end | right _ _ => l1 end) as f1. remember (fun m=>match lt_dec m (S n) with |left _ H => match IH m H (Rstar r) with exist _ l _ => l end | right _ _ => nil end) as f2. exists (flat_map (fun p=> all_pair (app (A:=C)) (f1 (fst p)) (f2 (snd p))) sl). intros; split; intros. destruct H. destruct (Rstar_rev' H) as [w1 [w2 [H3 [H4 [H5 H6]]]]]; auto. destruct w. inversion H0. discriminate. subst w. apply in_flat_map. exists (length w1, length w2). split. apply H2. rewrite <- H0. rewrite app_length; auto.  simpl. apply all_pair_spec1; simpl. subst f1. destruct (lt_dec (length w1) (S n)). destruct (IH (length w1) l r). apply i; auto. apply H1. split; auto. destruct w2. rewrite <- H0. rewrite app_nil_r; auto. contradict n0. rewrite <- H0. rewrite app_length. simpl. rewrite <- plus_n_Sm. apply le_n_S; apply le_plus_l; auto.
  subst f2. destruct (lt_dec (length w2) (S n)). destruct (IH (length w2) l (Rstar r)); auto. apply i; auto. contradict n0. rewrite <- H0. rewrite app_length. destruct w1. contradict H5; auto. simpl. apply le_n_S; apply le_plus_r. apply in_flat_map in H. destruct H as [[x y] [H3 H4]]. apply H2 in H3. simpl in H3. apply all_pair_spec2 in H4. destruct H4 as [w1 [w2 [H5 [H6 H7]]]]. subst w. subst f1. simpl in H5. destruct (lt_dec x (S n)). destruct (IH x l r). apply i in H5. destruct H5. subst f2. simpl in H6. destruct (lt_dec y (S n)). destruct (IH y l0 (Rstar r)). apply i0 in H6. destruct H6. split. auto. rewrite app_length. subst x y; auto. destruct H6. subst f2. simpl in H6. destruct (lt_dec y (S n)). destruct (IH y l). apply i in H6. destruct H6. apply H1 in H5. destruct H5. destruct y.  destruct w2. rewrite app_nil_r. auto. inversion H0. contradict n0. rewrite <- H3. rewrite <- plus_n_Sm. apply le_n_S; apply le_plus_l. destruct H6. Defined.
Definition Rlang_bound: forall r n, {l|forall w, Racc r w/\length w <=n <-> In w l}. intros. induction n. destruct (Rlang_length r 0) as [l H]. exists l. intros; split; intros. apply H. destruct H0. split; auto. destruct (length w); auto. inversion H1. apply H in H0. destruct H0. split; auto. rewrite <- H1; auto. destruct IHn as [l H1]. destruct (Rlang_length r (S n)) as [m H2]. exists (m++l). intros; split; intros. destruct H. apply in_or_app. inversion H0; [left|right]. apply H2; auto. apply H1; auto. apply in_app_or in H. destruct H. apply H2 in H. destruct H; split; auto. rewrite H0; auto. apply H1 in H. destruct H. split; auto. Defined.

Theorem Rstar_rev: forall r w, Racc (Rstar r) w -> {w1:list C & {w2|w=w1++w2 /\ w1<>nil /\ Racc r w1 /\Racc (Rstar r) w2}}+{w=nil}. intros. destruct (list_eq_dec C_eq_dec w nil). right; auto. left. destruct (splits w) as [wl H1 _]. destruct (findP (fun p=>fst p<>nil/\Racc r (fst p)/\Racc (Rstar r) (snd p)) wl) as [[[w1 w2] H2]|H2]. intros p H0. destruct (list_eq_dec C_eq_dec (fst p) nil); [right|]. contradict e. destruct e; auto. destruct (Racc_dec r (fst p)); [|right]. destruct (Racc_dec (Rstar r) (snd p)); [left|right]; auto. contradict n1. destruct n1; destruct H3; auto. contradict n1. destruct n1; destruct H3; auto. destruct a. destruct H3. exists w1. exists w2. split; auto. apply H1 in H2. subst w; auto. exfalso. destruct (Rstar_rev' H) as [l [m [H3 [H4 [H5 H6]]]]]; auto. subst w. cut (In (l,m) wl). intros. apply H2 in H0. contradict H0. simpl; auto. apply H1. auto. Defined.
Theorem Rstar_dual: forall r, Req (Rstar r) (Rstar (Rstar r)). Proof. intros. split; intros w H. auto. revert H. apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun w=>Racc(Rstar(Rstar r)) w->Racc(Rstar r) w). clear w. intros w IH H. destruct (Rstar_rev H) as [[w1 [w2 [H1 [H2 [H3 H4]]]]]|H1]; auto. subst w. apply Rstar_app; auto. apply IH; auto. unfold ltof. destruct w1. contradict H3; auto. rewrite app_length. apply le_n_S; apply le_plus_r. subst w; auto. Qed.
Theorem Rstar_dual2: forall r, Req (Rstar r) (Rcons (Rstar r) (Rstar r)). Proof. intros; split; intros w H. rewrite <- app_nil_r; auto. inversion H. apply Rstar_app; auto. Qed.
Theorem Rstar_or: forall r s, Req (Rstar (Ror r s)) (Rstar (Rcons (Rstar r) (Rstar s))). Proof. intros. split; intros w H; revert H. apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun w=>Racc (Rstar (Ror r s)) w -> Racc (Rstar (Rcons (Rstar r) (Rstar s))) w). clear w. intros w IH H. destruct (Rstar_rev H) as [[w1 [w2 [H1 [H2 [H3 H4]]]]]|H1]. subst w. apply RAstar2; auto. inversion H3. rewrite <- app_nil_r; auto. rewrite <- app_nil_l; auto. apply IH; auto. unfold ltof. rewrite app_length. destruct w1. contradict H2; auto. simpl; auto. subst w; auto.
  apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun w=>Racc (Rstar (Rcons (Rstar r) (Rstar s))) w->Racc (Rstar (Ror r s)) w). clear w. intros w IH H. destruct (Rstar_rev H) as [[w1 [w2 [H1 [H2 [H3 H4]]]]]|H1]; subst w; auto. inversion H3; auto. subst w1 r0 s0. apply Rstar_app. apply Rstar_app. revert H5. apply Rstar_incl. intros w Hw. auto. revert H7. apply Rstar_incl. intros w Hw. auto. apply IH; auto. unfold ltof. remember (l++m) as w1. destruct w1. contradict H2; auto. rewrite app_length. simpl. auto. Qed.

Definition Rnil_DFA: {d|forall w, Racc Rnil w <-> DFAacc d w}. assert (Ha:forall (c:C) s, In s (0::nil) -> In 0 (0::nil)). intros. left; auto. assert (Hb:In 0 (0::nil)). left; auto. assert (Hc: incl nil (0::nil)). intros x Hx; inversion Hx. exists (mkDFA (fun _ _=>0) 0 Ha Hb Hc). intros; split; intros. inversion H. inversion H. Defined.
Definition Rnil_EFA: {e|forall w, Racc Rnil w <-> EFAacc e w}. refine (exist _ (mkEFA (EFAstates:=nil) (fun _ _=>nil) (fun _=>nil) (fun _ _ _=>incl_refl nil) (fun _ _=>incl_refl nil) (incl_refl nil) (incl_refl nil)) _). intros; split; intros. inversion H. inversion H. simpl in H0. inversion H0. Defined.
Definition Rchar_DFA: forall c, {d|forall w, Racc (Rchar c) w <-> DFAacc d w}. intros. remember (fun s c'=>if C_eq_dec c' c then if nat_eq_dec s 0 then 1 else 2 else 2) as tr. assert (Ha:forall c s, In s (0::1::2::nil) -> In (tr s c) (0::1::2::nil)). intros c' s H. subst tr. destruct (C_eq_dec c' c). destruct (nat_eq_dec s 0); auto. auto. assert (Hb:In 0 (0::1::2::nil)); auto. assert (Hc:incl (1::nil) (0::1::2::nil)). intros x Hx. destruct Hx. subst x; auto. destruct H. exists (mkDFA tr 0 Ha Hb Hc). intros; split; intros. inversion H. subst c0 w. unfold DFAacc. simpl. left. subst tr. destruct (C_eq_dec c c). destruct (nat_eq_dec 0 0); auto. contradict n; auto. contradict n; auto. unfold DFAacc in H. simpl in H. destruct H; [|destruct H]. destruct w as [|c' w]; simpl in H. inversion H. subst tr. destruct (C_eq_dec c' c). subst c'. destruct (nat_eq_dec 0 0). destruct w; auto. simpl in H. absurd (1=2); auto. rewrite H at 1. clear -w. destruct (C_eq_dec c0 c). induction w; simpl; auto. destruct (C_eq_dec a c); auto. induction w; simpl; auto. destruct (C_eq_dec a c); auto. contradict n; auto. absurd (1=2); auto. rewrite H at 1. clear -n. induction w; simpl; auto. destruct (C_eq_dec a c); auto. Defined.
Definition Rchar_EFA: forall c, {e|forall w, Racc (Rchar c) w <-> EFAacc e w}. intros. remember (fun s c'=>if nat_eq_dec s 0 then if C_eq_dec c' c then 1::nil else nil else nil) as tr. remember (fun _:nat=>(nil (A:=nat))) as emp. assert (Htr: forall c s, In s (0::1::nil) -> incl (tr s c) (0::1::nil)). intros d s H x Hx. subst tr. destruct (nat_eq_dec s 0). destruct (C_eq_dec d c). destruct Hx; [subst x|]; auto. destruct Hx. destruct Hx. assert (Hemp: forall s, In s (0::1::nil) -> incl (emp s) (0::1::nil)). intros s H x Hx. subst emp. destruct Hx. assert (Hi: incl (0::nil) (0::1::nil)). intros x Hx. destruct Hx; [subst x|]; auto. assert (He:incl (1::nil) (0::1::nil)). intros x Hx. destruct Hx; [subst x|]; auto. exists (mkEFA tr emp Htr Hemp Hi He). intros w; split; intros. apply Rchar_spec in H. subst w. apply EFAacc_intro with 0 1 (0::1::nil); simpl; auto. apply EFAsteps_cons; auto. subst tr. destruct (nat_eq_dec 0 0). destruct (C_eq_dec c c); auto. contradict n; auto. contradict n; auto. apply Rchar_spec. inversion H; simpl in H0; simpl in H1; simpl in H2. clear H. destruct H0; [subst es|destruct H]. destruct H1; [subst is|destruct H]. inversion H3. subst a l. inversion H4. subst a b l0. destruct l. inversion H1. inversion H1. subst a n l. inversion H2. subst emp. inversion H8. inversion H6. f_equal. subst tr. clear -H8. destruct (nat_eq_dec 0 0). destruct (C_eq_dec c0 c); auto. destruct H8. destruct l. inversion H5. subst a n l0. clear H1 H3 H4 Hi He H5. inversion H2. subst emp; inversion H5. cut (b=1); intros. subst b t. inversion H3. subst emp; inversion H10. subst tr. destruct (nat_eq_dec 1 0). inversion e. inversion H10. subst tr; clear -H5. destruct (nat_eq_dec 0 0). destruct (C_eq_dec c0 c). apply In_one in H5; auto. destruct H5. destruct H5. Defined.
Definition EFA_or: forall e1 e2:EFA C, {eo|forall w, EFAacc eo w <-> EFAacc e1 w \/ EFAacc e2 w}. intros. destruct e1 as [st1 tr1 emp1 ini1 acc1 Htr1 Hemp1 Hini1 Hacc1]. destruct (EFA_map e2 (plus (ubound st1))) as [e3 H0 H1]. intros. apply plus_reg_l with (ubound st1); auto. destruct e3 as [st3 tr3 emp3 ini3 acc3 Htr3 Hemp3 Hini3 Hacc3]. simpl in H0. assert (H2: Disjoint st1 st3). subst st3; auto. remember (fun s c=>if in_dec nat_eq_dec s st1 then tr1 s c else tr3 s c) as tr. assert (Htr: forall c s, In s (st1++st3) -> incl (tr s c) (st1++st3)). subst tr. intros s c H x Hx. apply in_app_or in H. apply in_or_app. destruct (in_dec nat_eq_dec c st1). left. apply Htr1 in Hx; auto. apply Htr3 in Hx; auto. destruct H; auto; contradiction. remember (fun s=>if in_dec nat_eq_dec s st1 then emp1 s else emp3 s) as emp. assert (Hemp: forall s, In s (st1++st3) -> incl (emp s) (st1++st3)). intros s H x Hx. subst emp. apply in_app_or in H. apply in_or_app. destruct (in_dec nat_eq_dec s st1). apply Hemp1 in Hx; auto. apply Hemp3 in Hx; auto. destruct H; auto; contradiction. assert (Hini: incl (ini1++ini3) (st1++st3)). intros x Hx. apply in_or_app. apply in_app_or in Hx. destruct Hx; auto.  assert (Hacc: incl (acc1++acc3) (st1++st3)). intros x Hx. apply in_or_app. apply in_app_or in Hx. destruct Hx; auto. exists (mkEFA tr emp Htr Hemp Hini Hacc). intros; split; intros.
  inversion H. simpl in H3. simpl in H4. clear H. apply in_app_or in H4. destruct H4; [left|right]. assert (incl l st1). subst tr emp. apply Hini1 in H. inversion H6. subst a l. clear -H5 H Hemp1 Htr1. revert H5 H. revert w is. induction l0; intros. inversion H5. intros x Hx. destruct Hx. subst x s; auto. destruct H1. intros x Hx. destruct Hx. subst x; auto. inversion H5. subst w0 s t l0. simpl in H7. destruct (in_dec nat_eq_dec is st1); [|contradiction]. apply Hemp1 in H7; auto. destruct H0. subst x; auto. apply IHl0 in H4; auto. subst w s t l0. simpl in H7. destruct (in_dec nat_eq_dec is st1); [|contradiction]. apply Htr1 in H7. destruct H0. subst x; auto. apply IHl0 in H4; auto. auto. apply EFAacc_intro with is es l; simpl; intros; auto. apply in_app_or in H3. destruct H3; auto. apply Hacc3 in H3. contradict H3. apply Disjoint_In1 with st1; auto. simpl in H5. apply EFAsteps_incl with (st:=st1) (tr1:=tr) (emp1:=emp); simpl; intros; auto. subst emp. destruct (in_dec nat_eq_dec s st1); auto; contradiction. subst tr. destruct (in_dec nat_eq_dec s st1); auto; contradiction. apply H1. assert (incl l st3). apply Hini3 in H. inversion H6. subst a l emp tr. clear -H H5 Hemp3 Htr3 H2. revert H5 H. revert w is. induction l0; intros. intros x Hx. destruct Hx. subst x; auto. destruct H0. inversion H5. simpl in H7. subst w0 s t l0. destruct (in_dec nat_eq_dec is st1). contradict H. apply Disjoint_In1 with st1; auto. apply Hemp3 in H7. intros x Hx. destruct Hx. subst x; auto. destruct H0. subst x; auto. apply IHl0 in H4; auto. auto.
  subst w s t l0. simpl in H7. destruct (in_dec nat_eq_dec is st1). contradict H. apply Disjoint_In1 with st1; auto. apply Htr3 in H7. intros x Hx. destruct Hx. subst x; auto. destruct H0. subst x; auto. apply IHl0 in H4; auto. auto. apply EFAacc_intro with is es l; simpl; intros; auto. apply in_app_or in H3. destruct H3; auto. apply Hacc1 in H3. contradict H3. apply Disjoint_In1 with st3; auto. apply EFAsteps_incl with (st:=st3) (tr1:=tr) (emp1:=emp); simpl; intros; auto. subst emp. destruct (in_dec nat_eq_dec s st1); auto. contradict H8; apply Disjoint_In1 with st1; auto. subst tr. destruct (in_dec nat_eq_dec s st1); auto. contradict H8; apply Disjoint_In1 with st1; auto.
  destruct H. inversion H. apply EFAacc_intro with is es l; simpl; auto. apply in_or_app; auto. apply in_or_app; auto. apply EFAsteps_incl with (tr1:=tr1) (emp1:=emp1) (st:=st1); simpl; intros; auto. apply EFAsteps_const with (s:=is) (st:=st1) in H5; auto. simpl in H3. simpl in H4. simpl in H5. subst emp. destruct (in_dec nat_eq_dec s st1); auto; contradiction. subst tr. destruct (in_dec nat_eq_dec s st1); auto; contradiction. apply H1 in H. inversion H. apply EFAacc_intro with is es l; simpl; auto. apply in_or_app; auto. apply in_or_app; auto. apply EFAsteps_incl with (st:=st3) (tr1:=tr3) (emp1:=emp3); simpl; intros; auto. apply EFAsteps_const with (s:=is) (st:=st3) in H5; auto. subst emp. destruct (in_dec nat_eq_dec s st1); auto. contradict H8. eapply Disjoint_In1; eauto. subst tr. destruct (in_dec nat_eq_dec s st1); auto. contradict H8. eapply Disjoint_In1; eauto. Defined.
Definition EFA_cons: forall e1 e2: EFA C, {eo|forall w, EFAacc eo w <-> exists w1 w2, w=w1++w2 /\ EFAacc e1 w1 /\ EFAacc e2 w2}. intros. destruct e1 as [st1 tr1 emp1 ini1 acc1 Htr1 Hemp1 Hini1 Hacc1]. destruct (EFA_map e2 (plus (ubound st1))) as [e3 H H0]. intros. eapply plus_reg_l; eauto. destruct e3 as [st3 tr3 emp3 ini3 acc3 Htr3 Hemp3 Hini3 Hacc3]. simpl in H. assert (Disjoint st1 st3). subst st3; auto. remember (fun s c=>if in_dec nat_eq_dec s st1 then tr1 s c else tr3 s c) as tr. remember (fun s=>if in_dec nat_eq_dec s st3 then emp3 s else if in_dec nat_eq_dec s acc1 then emp1 s++ini3 else emp1 s) as emp. assert (Htr: forall c s, In s (st1++st3) -> incl (tr s c) (st1++st3)). intros. intros x Hx. apply in_app_or in H2. subst tr. apply in_or_app. destruct (in_dec nat_eq_dec s st1). apply Htr1 in Hx; auto. apply Htr3 in Hx; auto. destruct H2; auto; contradiction. assert (Hemp: forall s, In s (st1++st3) -> incl (emp s) (st1++st3)). intros. intros x Hx. apply in_or_app. apply in_app_or in H2. subst emp. destruct (in_dec nat_eq_dec s st3). apply Hemp3 in Hx; auto. destruct H2; [|contradiction]. destruct (in_dec nat_eq_dec s acc1). apply in_app_or in Hx. destruct Hx. apply Hemp1 in H3; auto. apply Hini3 in H3; auto. apply Hemp1 in Hx; auto. assert (Hini: incl ini1 (st1++st3)). intros x Hx. apply in_or_app. apply Hini1 in Hx; auto. assert (Hacc: incl acc3 (st1++st3)). intros x Hx. apply in_or_app. apply Hacc3 in Hx; auto. clear H. exists (mkEFA tr emp Htr Hemp Hini Hacc). intros; split; intros.
  inversion H. simpl in H2. simpl in H3. clear H. assert (incl l (st1++st3)). apply EFAsteps_const with (s:=is) (st:=st1++st3) in H4; auto. destruct (split_until (fun s=>In s st3) l) as [[l1 [is3 [l3 [H7 H8] H9]]]|H7]. intros. apply in_dec. apply nat_eq_dec. subst l. destruct (Tail_dec' l1) as [[es1 H8 _]|H8]. apply EFAsteps_app_s_rev with (s:=es1) in H4; auto. destruct H4 as [w1 [w2 [Ha [Hb Hc]]]]. subst w. exists w1. exists w2. split; auto. inversion Hc. subst w s t l. simpl in H14. clear Hc. assert (In es1 acc1 /\ In is3 ini3). subst emp. destruct (in_dec nat_eq_dec es1 st3). contradict i. apply Forall_forall with (x:=es1) in H9; auto. destruct (in_dec nat_eq_dec es1 acc1) as [Hi|Hi]. split; auto. apply in_app_or in H14. destruct H14; auto. contradict H7. apply Disjoint_In1 with st1; auto. apply Hemp1 in H4; auto. apply Hemp1 in H14. contradict H7. apply Disjoint_In1 with st1; auto. assert (In es1 (st1++st3)). apply H. apply in_or_app; auto. apply in_app_or in H4. destruct H4; auto; contradiction. destruct H4. clear H14. split; [|apply H0]; clear H0. apply EFAacc_intro with is es1 l1; simpl; auto. apply EFAsteps_incl with (st:=st1) (tr1:=tr) (emp1:=emp); simpl; intros; auto. intros x Hx. assert (In x (st1++st3)). apply H. apply in_or_app; auto. apply in_app_or in H0. destruct H0; auto. contradict H0. apply Forall_forall with (x:=x) in H9; auto. subst emp. destruct (in_dec nat_eq_dec s st3). contradict i. apply Disjoint_In1 with st1; auto. destruct (in_dec nat_eq_dec s acc1); auto. apply in_app_or in H11. destruct H11; auto. apply Hini3 in H11. contradict H11. apply Disjoint_In1 with st1; auto. subst tr. destruct (in_dec nat_eq_dec s st1); auto; contradiction.
  destruct l1. inversion H5. subst is3. contradict H7. apply Disjoint_In1 with st1; auto. inversion H5; auto. apply EFAacc_intro with is3 es (is3::l3); auto. apply EFAsteps_incl with (st:=st3) (tr1:=tr) (emp1:=emp); simpl; intros; auto. intros x Hx. destruct Hx. subst x; auto. apply Hini3 in H10. subst tr emp. clear -H0 H10 H12 H1 Hemp3 Htr3. revert H12 H10 H0. revert w2 is3 x. induction l3; intros. destruct H0. inversion H12. simpl in H6. subst w2 s t l. destruct (in_dec nat_eq_dec is3 st3); [|contradiction]. apply Hemp3 in H6; auto. destruct H0. subst x; auto. apply IHl3 with (x:=x) in H4; auto. subst w2 s t l. simpl in H6. destruct (in_dec nat_eq_dec is3 st1). contradict H10; apply Disjoint_In1 with st1; auto. apply Htr3 in H6; auto. destruct H0. subst x; auto. apply IHl3 with (x:=x) in H4; auto. subst emp. destruct (in_dec nat_eq_dec s st3); auto; contradiction. subst tr. destruct (in_dec nat_eq_dec s st1); auto. contradict H0. apply Disjoint_In1 with st1; auto. clear -H6. induction l1. auto. apply IHl1. inversion H6. destruct l1; inversion H2. auto. subst w2 s t l. simpl in H14. contradict H7. apply Disjoint_In1 with st1; auto. subst tr. destruct (in_dec nat_eq_dec es1 st1). apply Htr1 in H14; auto. assert (In es1 (st1++st3)). apply H. apply in_or_app; auto. apply in_app_or in H4. destruct H4. contradiction. contradict H4. apply Forall_forall with (x:=es1) in H9; auto. subst l1. inversion H5. subst a is3. contradict H7. apply Disjoint_In1 with st1; auto. apply Hacc3 in H2. contradict H2. apply Forall_forall with (x:=es) in H7; auto.
  destruct H as [w1 [w2 [Hw [H2 H3]]]]. subst w. apply H0 in H3. clear H0. inversion H2. clear H2. simpl in H0. simpl in H. inversion H3. clear H3. simpl in H2. simpl in H7. apply EFAacc_intro with is es0 (l++l0); simpl; auto. apply EFAsteps_app with es; auto. apply EFAsteps_incl with (st:=st1) (tr1:=tr1) (emp1:=emp1); simpl; intros; auto. apply EFAsteps_const with (s:=is) (st:=st1) in H4; auto. subst emp. destruct (in_dec nat_eq_dec s st3). contradict i. apply Disjoint_In1 with st1; auto. destruct (in_dec nat_eq_dec s acc1). apply in_or_app; auto. auto. subst tr. destruct (in_dec nat_eq_dec s st1); auto; contradiction. inversion H9. subst a l0. apply EFAsteps_empty; simpl; auto. apply EFAsteps_incl with (st:=st3) (tr1:= tr3) (emp1:= emp3); simpl; intros; auto. apply EFAsteps_const with (s:=is0) (st:=st3) in H8; auto. subst emp. destruct (in_dec nat_eq_dec s st3); auto; contradiction. subst tr. destruct (in_dec nat_eq_dec s st1); auto. contradict H3. apply Disjoint_In1 with st1; auto. subst emp. destruct (in_dec nat_eq_dec es st3). contradict i; apply Disjoint_In1 with st1; auto. destruct (in_dec nat_eq_dec es acc1); [|contradiction]. apply in_or_app; auto. inversion H5; simpl; auto. Defined.
Definition EFA_Rstar: forall r e, (forall w, Racc r w<-> EFAacc e w) -> {eo| forall w, Racc (Rstar r) w <-> EFAacc eo w}. intros. destruct e as [st tr emp ini acc Htr Hemp Hini Hacc]. remember (ubound st) as n. assert (~In n st). subst n. unfold ubound. destruct (ubound_sig st). intros D. apply l in D. contradict D. apply le_not_lt; auto. clear Heqn. remember (fun s c=>if nat_eq_dec s n then nil else tr s c) as tr'. remember (fun s=> if nat_eq_dec s n then ini else if in_dec nat_eq_dec s acc then n::emp s else emp s) as emp'. assert (Hini': incl (n::nil) (n::st)). intros x Hx. destruct Hx. subst x; auto. destruct H1. assert (Htr': forall c s, In s (n::st) -> incl (tr' s c) (n::st)). intros. intros x Hx. subst tr'. destruct (nat_eq_dec s n). subst s. destruct Hx. right. apply Htr in Hx; auto. destruct H1; auto. contradict n0; auto. assert (Hemp': forall s, In s (n::st) -> incl (emp' s) (n::st)). intros. intros x Hx. subst emp'. destruct (nat_eq_dec s n). subst n. right. apply Hini in Hx; auto. destruct (in_dec nat_eq_dec s acc). destruct Hx. subst x; auto. apply Hemp in H2; auto. apply Hemp in Hx; auto. destruct H1; auto. contradict n0; auto. exists (mkEFA tr' emp' Htr' Hemp' Hini' Hini'). intros; split; intros. revert H1. apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun w=>Racc (Rstar r) w->EFAacc (mkEFA tr' emp' Htr' Hemp' Hini' Hini') w). clear w. intros w IH H1. apply Rstar_rev in H1. destruct H1 as [[w1 [w2 [H3 [H4 [H5 H6]]]]]|H3]. subst w. apply H in H5. clear H. apply IH in H6. clear IH. inversion H5. inversion H6. simpl in H1. simpl in H2. simpl in H. simpl in H8. simpl in H9. clear H5 H6. destruct H8; [|destruct H5]. destruct H9; [|destruct H6]. subst es0 is0. apply EFAacc_intro with n n ((n::l)++l0). simpl; auto. simpl; auto. apply EFAsteps_app with es; auto. inversion H3. subst a l. apply EFAsteps_empty; auto.
  apply EFAsteps_incl with (st:=st) (tr1:=tr) (emp1:=emp); simpl; intros; auto. apply EFAsteps_const with (s:=is) (st:=st) in H2; auto. subst emp'. destruct (nat_eq_dec s n). subst s. contradiction. destruct (in_dec nat_eq_dec s acc); auto. subst tr'. destruct (nat_eq_dec s n); auto. subst s; contradiction. simpl. subst emp'. destruct (nat_eq_dec n n); auto. contradict n0; auto. inversion H11. subst a l0. apply EFAsteps_empty; auto. simpl. subst emp'. destruct (nat_eq_dec es n). subst es. apply Hacc in H. contradiction. destruct (in_dec nat_eq_dec es acc); auto. contradiction. simpl; auto. clear -H12. simpl. apply Tail_cons. induction l; simpl; auto. unfold ltof. rewrite app_length. destruct w1. contradict H4; auto. simpl. apply le_n_S. apply le_plus_r. subst w. apply EFAacc_intro with n n (n::nil); simpl; auto.
  inversion H1. simpl in H3. simpl in H2. clear H1. destruct H2; [|contradict H1]. destruct H3; [|contradict H2]. subst es is. revert H4 H5 H6. revert w. apply (Fix (well_founded_ltof (list nat) (length (A:=nat)))) with (P:=fun l=> forall w, EFAsteps tr' emp' w l->Head n l -> Tail n l->Racc (Rstar r) w). clear l. intros l IH w. intros. inversion H2. subst a l. clear H2. inversion H1. subst w s l0. auto. simpl in H7. subst w0 s l0. assert (In t ini). subst emp'. destruct (nat_eq_dec n n); auto. contradict n0; auto. clear H7. destruct (split_until (eq n) (t::l)). intros. apply nat_eq_dec. destruct s as [m1 [x [m2 [Ha Hb] Hc]]]. subst x. clear H1. destruct m1. inversion Hb. subst t. apply Hini in H2; contradiction. inversion Hb. subst n0 l. clear Hb. assert (Ht:incl (t::m1) st). intros x Hx. assert (In x (n::st)). apply EFAsteps_const with (s:=t) (st:=n::st) in H6; simpl; auto. simpl in H6. apply H6.  replace (t::m1++n::m2) with ((t::m1)++n::m2); auto. apply in_or_app; auto. destruct H1; auto. subst x. absurd (n=n); auto. apply Forall_forall with (x:=n) in Hc; auto. replace (t::m1++n::m2) with ((t::m1)++n::m2) in H6; auto. destruct (Tail_dec' (t::m1)) as [[es H4 _]|H4]. apply EFAsteps_app_s_rev with (s:=es) in H6; auto. destruct H6 as [w1 [w2 [Ha [Hb Hd]]]]. subst w. inversion Hd. subst w s t0 l. simpl in H9. clear Hd. assert (In es acc). subst emp'. destruct (nat_eq_dec es n). subst es. apply Hini in H9. contradiction. destruct (in_dec nat_eq_dec es acc); auto. apply Hemp in H9.  contradiction. apply Ht. auto.
  apply RAstar2; auto. apply H. apply EFAacc_intro with t es (t::m1); auto. apply EFAsteps_incl with (st:=st) (tr1:=tr') (emp1:=emp'); simpl; intros; auto. subst emp'. destruct (nat_eq_dec s n). subst s; contradiction. destruct (nat_eq_dec es n). subst es. contradict H0. apply Ht; auto. destruct (in_dec nat_eq_dec s acc); auto. destruct H6; auto. subst t0; contradiction. subst tr'. destruct (nat_eq_dec s n); auto. destruct H6. apply IH with (n::m2); auto. unfold ltof. simpl. repeat apply le_n_S. rewrite app_length. simpl. rewrite <- plus_n_Sm. auto. clear -H3. inversion H3. subst a b l. inversion H1. destruct m1; inversion H4. subst a b l. clear -H2. induction m1; auto. apply IHm1. inversion H2; auto. destruct m1; inversion H3. simpl in H9. subst tr'. destruct (nat_eq_dec es n). destruct H9. apply Htr in H9. contradiction. apply Ht. auto. inversion H4. clear -H3 f. absurd (n=n); auto. inversion H3. apply Forall_forall with (x:=n) in f; auto. simpl in H7. subst w s l0. subst tr'. clear -H7. destruct (nat_eq_dec n n). destruct H7. contradict n0; auto. Defined.

Definition RegExp2EFA: forall r, {e|forall w, Racc r w <-> EFAacc e w}. induction r. apply Rnil_EFA. apply (Rchar_EFA c). destruct IHr1 as [e1 H1]. destruct IHr2 as [e2 H2]. destruct (EFA_cons e1 e2) as [e H]. exists e. intros; split; intros. inversion H0. subst w r s. apply H. exists l. exists m. split; auto. split. apply H1; auto. apply H2; auto. apply H in H0. destruct H0 as [w1 [w2 [Ha [Hb Hc]]]]. subst w. apply H1 in Hb. apply H2 in Hc. auto.
  destruct IHr1 as [e1 H1]. destruct IHr2 as [e2 H2]. destruct (EFA_or e1 e2) as [e H]. exists e. intros; split; intros. apply H. inversion H0; [left; apply H1|right; apply H2]; auto. apply H in H0. destruct H0; [apply H1 in H0|apply H2 in H0]; auto. destruct IHr as [e H]. destruct (EFA_Rstar H) as [eo H0]. exists eo; auto. Defined.

(* RegExp Finite Automaton *)
Record RFA: Set:= mkRFA {
  RFAstates: list nat;
  RFAtrans: nat -> nat -> RegExp;
  RFAinit: list nat;
  RFAaccept: list nat;
  RFAtrans_const: forall s t w, Racc (RFAtrans s t) w -> In s RFAstates /\ In t RFAstates;
  RFAinit_const: incl RFAinit RFAstates;
  RFAacc_const: incl RFAaccept RFAstates;
}.

Inductive RFAsteps (tr:nat->nat->RegExp): list C -> list nat -> Prop:=
| RFAsteps_nil: forall s, RFAsteps tr nil (s::nil)
| RFAsteps_cons: forall s t l w1 w2, RFAsteps tr w2 (t::l) -> Racc (tr s t) w1 -> RFAsteps tr (w1++w2) (s::t::l)
.
Inductive RFAacc (e:RFA) (w:list C): Prop:= RFAacc_intro: forall l is es, RFAsteps (RFAtrans e) w l -> Head is l -> Tail es l -> In is (RFAinit e) -> In es (RFAaccept e) -> RFAacc e w.
Hint Constructors RFAsteps RFAacc.

Theorem RFAsteps_const: forall tr l w is st, (forall s t w, Racc (tr s t) w -> In s st /\ In t st) -> RFAsteps tr w l -> Head is l -> In is st -> incl l st. Proof. intros tr l w is st H H0. revert H is. induction H0; intros; intros x Hx. destruct Hx. subst x. inversion H0; subst a s; auto. destruct H2. inversion H2. subst a s l0. destruct Hx. subst x; auto. apply IHRFAsteps with (is:=t) in H4; auto. apply H1 in H. destruct H; auto. Qed.
Theorem RFAsteps_app: forall tr w1 l1 s w2 l2, RFAsteps tr w1 l1 -> Tail s l1 -> RFAsteps tr w2 (s::l2) -> RFAsteps tr (w1++w2) (l1++l2). Proof. intros tr w1 l1 s w2 l2 H. revert w2 l2 s. induction H; intros. inversion H; simpl. subst a s0; auto. inversion H3. inversion H1. subst a b l0. apply IHRFAsteps in H2; auto. rewrite <- app_assoc. simpl. auto. Qed.
Theorem RFAsteps_app_s_rev: forall tr w l1 s l2, RFAsteps tr w (l1++l2) -> Tail s l1 -> exists w1 w2, w=w1++w2 /\ RFAsteps tr w1 l1 /\ RFAsteps tr w2 (s::l2). Proof. intros tr w l1. revert w. induction l1; intros. inversion H0. inversion H0. subst a a0 l1. exists nil. exists w. simpl in H; auto. subst a0 b l1. clear H0. inversion H. destruct l. inversion H3. inversion H4. subst w s0. destruct l. inversion H3. inversion H1. subst n l0. clear H1. apply IHl1 with (s:=s) in H4; auto. destruct H4 as [wa [wb [Ha [Hb Hc]]]]. subst w2. exists (w1++wa). exists wb. split. rewrite app_assoc; auto. split; auto. Qed.

Definition EFA2RFA: forall e cset, (forall s c, In s (EFAstates e) -> EFAtrans e s c <> nil -> In c cset) -> {r| forall w, EFAacc e w <-> RFAacc r w}. intros. destruct e as [st tr emp ini acc Htr Hemp Hini Hacc]. simpl in H. assert (tr_chars: forall s t, In s st->In t st->{cs|forall c, In c cs <-> In t (tr s c)}). intros.  exists (filter (dec2b (fun x=>in_dec nat_eq_dec t (tr s x))) cset). intros; split; intros. apply filter_In in H2. destruct H2. apply dec2b_true in H3; auto. apply filter_In. split. apply H with s; auto. contradict H2. rewrite H2. auto. apply dec2b_true; auto.
  remember (fun s t=>match in_dec nat_eq_dec s st with left _ Hs => match in_dec nat_eq_dec t st with left _ Ht => let (cs,_):=tr_chars s t Hs Ht in let r:=fold_right (fun c r=>Ror (Rchar c) r) Rnil cs in if in_dec nat_eq_dec t (emp s) then Ror Remp r else r  |right _ _ => Rnil end |right _ _ => Rnil end) as tr'. assert (Htr': forall s t w, Racc (tr' s t) w->In s st/\In t st). intros. subst tr'. destruct (in_dec nat_eq_dec s st). destruct (in_dec nat_eq_dec t st); auto. inversion H0. inversion H0. exists (mkRFA tr' Htr' Hini Hacc). intros; split; intros. inversion H0. simpl in H1. simpl in H2. apply RFAacc_intro with l is es; auto. assert (incl l st). apply EFAsteps_const with (s:=is) (st:=st) in H3; auto. clear H0 H1 H2 H4 H5. subst tr'. induction H3; auto. replace w with (nil++w); auto. apply RFAsteps_cons. apply IHEFAsteps. intros x Hx. apply H6. right; auto. simpl. clear H3 IHEFAsteps Htr'. simpl in H0. destruct (in_dec nat_eq_dec s st). destruct (in_dec nat_eq_dec t st). destruct (tr_chars s t i i0) as [cs H7]. destruct (in_dec nat_eq_dec t (emp s)). apply RAor1. apply Remp_spec; auto. contradiction. contradict n. apply H6; auto. contradict n; auto. replace (c::w) with ((c::nil)++w); auto. apply RFAsteps_cons; auto. apply IHEFAsteps; auto. intros x Hx; apply H6; auto. simpl in H0. simpl. clear H3 IHEFAsteps Htr'. destruct (in_dec nat_eq_dec s st). destruct (in_dec nat_eq_dec t st). destruct (tr_chars s t i i0) as [cs H7]. destruct (in_dec nat_eq_dec t (emp s)). apply RAor2. apply H7 in H0. clear -H0. induction cs. destruct H0. inversion H0. subst a. simpl. apply RAor1. auto. simpl.  apply RAor2. apply IHcs. auto. apply H7 in H0.  clear -H0. induction cs. destruct H0. inversion H0. subst a. simpl. auto. simpl; auto. contradict n; apply H6; auto. contradict n; apply H6; auto.
  inversion H0. apply EFAacc_intro with is es l; auto. assert (incl l st). apply RFAsteps_const with (is:=is) (st:=st) in H1; auto. clear H0 H2 H3 H4 H5. induction H1; auto. simpl in H0. subst tr'. destruct (in_dec nat_eq_dec s st). destruct (in_dec nat_eq_dec t st). destruct (tr_chars s t i i0) as [cs H2]. simpl in H0. destruct (in_dec nat_eq_dec t (emp s)). inversion H0. apply Remp_spec in H7. subst w1. simpl. apply EFAsteps_empty; simpl; auto. apply IHRFAsteps; auto. intros x Hx. apply H6; auto. subst r s0 l0. cut (exists c, In c cs/\w1=c::nil). intros. destruct H3 as [c [H3 H4]]. subst w1. simpl. apply EFAsteps_cons; auto. apply IHRFAsteps. intros x Hx. apply H6; auto. simpl. apply H2; auto. clear -H7. induction cs; simpl in H7. inversion H7. inversion H7. inversion H2. exists a; auto. apply IHcs in H2. destruct H2 as [c [H3 H4]]. exists c; auto. clear H1 Htr'. cut (exists c, In c cs /\ w1=c::nil); intros. destruct H1 as [c [H4 H3]]. subst w1. apply EFAsteps_cons; auto. apply IHRFAsteps. intros x Hx; apply H6; auto. simpl. apply H2; auto. clear -H0. induction cs; simpl in H0. inversion H0. inversion H0. exists a; auto. inversion H3; auto. apply IHcs in H3. destruct H3 as [c [H3 H4]]. exists c; auto. contradict n. apply H6; auto. contradict n. apply H6; auto. Defined.

Definition RFA2single_edge: forall r, {i:nat &{e:nat &{st:list nat &{r'|forall w, RFAacc r w<-> RFAacc r' w & RFAstates r' = i::e::st /\ RFAinit r' = i::nil /\ RFAaccept r' = e::nil/\ NoDup (i::e::st)/\ (forall w s,~Racc (RFAtrans r' s i) w) /\ (forall w t,~Racc (RFAtrans r' e t) w)}}}}. intros. destruct r as [st tr ini acc Htr Hini Hacc]. remember (nodup nat_eq_dec st) as st'. assert (NoDup st'). subst st'. apply NoDup_nodup. assert (forall s, In s st' <-> In s st). intros. subst st'. apply nodup_In. clear Heqst'. remember (ubound st') as e. assert (~In e st'). subst e. unfold ubound. destruct (ubound_sig st'). intros D. apply l in D. contradict D; apply le_not_lt; auto. remember (S e) as i. assert (~In i (e::st')). intros D. destruct D. subst i. contradict H2. clear -e. induction e; auto. subst i e. unfold ubound in H2. destruct (ubound_sig st'). apply l in H2. contradict H2. apply le_not_lt; auto. clear Heqe Heqi. exists i. exists e. exists st'. remember (fun s t=> if nat_eq_dec s i then if in_dec nat_eq_dec t ini then Remp else Rnil else if nat_eq_dec t e then if in_dec nat_eq_dec s acc then Remp else Rnil else tr s t) as tr'. assert (Htr': forall s t w, Racc (tr' s t) w -> In s (i::e::st')/\In t (i::e::st')). intros. subst tr'. destruct (nat_eq_dec s i). subst s. destruct (in_dec nat_eq_dec t ini). split; auto. apply Hini in i0; auto. apply H0 in i0; auto. inversion H3. destruct (nat_eq_dec t e). subst t. split; auto. destruct (in_dec nat_eq_dec s acc). apply Hacc in i0. apply H0 in i0; auto. inversion H3. apply Htr in H3. destruct H3. apply H0 in H3. apply H0 in H4; auto. assert (Hini':incl (i::nil) (i::e::st')). intros x Hx. destruct Hx. subst x; auto. destruct H3. assert (Hacc': incl (e::nil) (i::e::st')). intros x Hx. destruct Hx. subst x; auto. destruct H3.
  assert (Hi:forall w s, ~Racc (tr' s i) w). intros w s D. subst tr'. destruct (nat_eq_dec s i). subst s. destruct (in_dec nat_eq_dec i ini). contradict H2. right. apply H0; auto. inversion D. destruct (nat_eq_dec i e). subst e; contradict H2; auto. apply Htr in D. destruct D. contradict H2; right; apply H0; auto. assert (He:forall w s, ~Racc (tr' e s ) w). simpl. intros w s D. subst tr'. destruct (nat_eq_dec e i). subst e; contradict H2; auto. destruct (nat_eq_dec s e). subst s. destruct (in_dec nat_eq_dec e acc). contradict H1; apply H0; auto. inversion D. apply Htr in D. destruct D. contradict H1; apply H0; auto. exists (mkRFA tr' Htr' Hini' Hacc'). intros; split; intros.
  inversion H3. clear H3. simpl in H7. simpl in H8. apply RFAacc_intro with (i::l++e::nil) i e; simpl; auto. assert (incl l st). apply RFAsteps_const with (is:=is) (st:=st) in H4; auto. inversion H5. subst a l.  simpl. replace w with (nil++w); auto. apply RFAsteps_cons; auto. replace w with (w++nil). replace (is::l0++e::nil) with ((is::l0)++e::nil); auto. apply RFAsteps_app with (s:=es); auto. revert H4. revert H3. generalize (is::l0). intros l Hl Hj. induction Hj; auto. apply RFAsteps_cons. apply IHHj. intros x Hx; apply Hl; auto. simpl. subst tr'. destruct (nat_eq_dec s i). subst s. contradict H2. right. apply H0. apply Hl; auto. destruct (nat_eq_dec t e). subst t. contradict H1. apply H0. apply Hl; auto. simpl in H3; auto. replace nil with (nil (A:=C)++nil) at 1; auto. apply RFAsteps_cons; auto. simpl. subst tr'. destruct (nat_eq_dec es i). subst es. contradict H2. right. apply H0; auto. destruct (nat_eq_dec e e). destruct (in_dec nat_eq_dec es acc). apply Remp_spec; auto. contradiction. contradict n0; auto. rewrite app_nil_r; auto. simpl. subst tr'. destruct (nat_eq_dec i i). destruct (in_dec nat_eq_dec is ini). apply Remp_spec; auto. contradiction. contradict n; auto.
  assert (Hs:forall l s w, RFAsteps tr' w (s::l) -> ~In i l). clear -Hi. induction l; intros; auto. intros D. destruct D. subst a. inversion H. simpl in H5. contradict H5; auto. contradict H0. inversion H. apply IHl with a w2; auto. assert (Ht:forall l s w, RFAsteps tr' w (l++s::nil) -> ~In e l). clear -He. induction l; intros; auto. intros D. destruct D. subst a. inversion H. destruct l; inversion H3. simpl in H4. contradict H4; auto. contradict H0. inversion H. destruct l; inversion H3. rewrite H1 in H3. apply IHl with s w2; auto.  inversion H3. clear H3. simpl in H7. destruct H7; [subst is|inversion H3]. destruct H8; [subst es|inversion H3]. inversion H5. subst a l. apply Tail_rev in H6. destruct H6 as [l H6]. destruct l. inversion H6. subst e. contradict H2; auto. inversion H6. subst n l0. clear H5 H6. assert (incl l st). intros x Hx. apply H0. assert (In x (i::e::st')). apply RFAsteps_const with (is:=i) (st:=i::e::st') in H4; auto. apply H4. right. apply in_or_app; auto. destruct H3. subst x. absurd (In i (l++e::nil)). apply Hs in H4; auto. apply in_or_app; auto. destruct H3; auto. subst x. absurd (In e (i::l)); auto. replace (i::l++e::nil) with ((i::l)++e::nil) in H4; auto. apply Ht in H4; auto. clear Hs Ht. inversion H4. destruct l; inversion H8. subst w s. simpl in H9. assert (In t ini/\w1=nil). subst tr'. clear -H9. destruct (nat_eq_dec i i); [|contradict n; auto]. destruct (in_dec nat_eq_dec t ini). apply Remp_spec in H9; auto. inversion H9. destruct H5. subst w1. destruct l as [|is l]. inversion H6. subst t. contradict H1. apply H0; auto. inversion H6. subst t l0. clear H6 H9 H4. destruct (Tail_dec' (is::l)) as [[es H4 _]|H4]; [|inversion H4]. replace (is::l++e::nil) with ((is::l)++e::nil) in H8; auto. apply RFAsteps_app_s_rev with (s:=es) in H8; auto. destruct H8 as [wa [wb [Ha [Hb Hc]]]]. subst w2.
  assert (In es acc/\wb=nil). inversion Hc. subst wb s t l0. simpl in H11. clear Hc. subst tr'. destruct (nat_eq_dec es i). subst es. absurd (In i st'). contradict H2; auto. apply H0. apply H3. auto. destruct (nat_eq_dec e e); [|contradict n0; auto]. destruct (in_dec nat_eq_dec es acc). split; auto. apply Remp_spec in H11. subst w1. inversion H9; auto. inversion H11. destruct H6. subst wb. simpl. rewrite app_nil_r. apply RFAacc_intro with (is::l) is es; auto. clear -Hb H3 H0 H1 H2 Heqtr'. revert H3 Hb. revert wa. generalize (is::l). clear l. induction l; intros. inversion Hb. inversion Hb. auto. subst wa a l. apply RFAsteps_cons; auto. apply IHl; auto. intros x Hx. apply H3; auto. simpl. simpl in H7. clear IHl Hb H6. subst tr'. destruct (nat_eq_dec s i).  subst s. absurd (In i st). contradict H2. right. apply H0; auto. apply H3; auto. destruct (nat_eq_dec t e). subst t. absurd (In e st). contradict H1. apply H0; auto. apply H3; auto. auto.
  split; auto. split; auto. Defined.

Definition RFAsingle2RegExp: forall st i e r, RFAstates r = i::e::st -> RFAinit r = i::nil -> RFAaccept r = e::nil -> NoDup (i::e::st) -> (forall w s, ~Racc (RFAtrans r s i) w) -> (forall w s, ~Racc (RFAtrans r e s) w) -> {e| forall w, Racc e w <-> RFAacc r w}. induction st as [|p st]; intros. destruct r as [st tr ini acc Htr Hini Hacc]. simpl in H0. subst ini. simpl in H. subst st. simpl in H1. subst acc. simpl in H4. simpl in H3. exists (tr i e). intros; split; intros. apply RFAacc_intro with (i::e::nil) i e; simpl; auto. replace w with (w++nil). apply RFAsteps_cons; auto. rewrite app_nil_r; auto. inversion H. simpl in H6. destruct H6; [subst is|inversion H6]. simpl in H7. destruct H7; [subst es|inversion H6]. clear H. inversion H1. subst a l. inversion H0. subst w l0 s. inversion H5. subst e a. inversion H2. contradict H7; auto. inversion H7. subst w s l0. clear H0. simpl in H9. assert (In t (i::e::nil)). apply Htr in H9. destruct H9; auto. destruct H. subst t. contradict H9; auto. destruct H. subst t. destruct l. inversion H8. rewrite app_nil_r; auto. inversion H8. simpl in H11. contradict H11; auto. destruct H.
  destruct r as [st' tr ini acc Htr Hini Hacc]. simpl in H. subst st'. simpl in H1. subst acc. simpl in H0. subst ini. simpl in H4. simpl in H3. remember (fun s t=>if nat_eq_dec s p then Rnil else if nat_eq_dec t p then Rnil else Ror (tr s t) (Rcons (tr s p) (Rcons (Rstar (tr p p)) (tr p t))) ) as tr'. assert (Htr': forall s t w, Racc (tr' s t) w -> In s (i::e::st) /\ In t (i::e::st)). intros. subst tr'. destruct (nat_eq_dec s p). inversion H. destruct (nat_eq_dec t p). inversion H. inversion H. apply Htr in H6. destruct H6. split. destruct H6. subst s; auto. destruct H6. subst e; auto. destruct H6; auto. contradict n; auto. destruct H7. subst t; auto. destruct H7. subst e; auto. destruct H7; auto. contradict n0; auto. subst r s0 l. inversion H6. subst r s0 w. apply Htr in H5. destruct H5. inversion H8. subst r s0 m. apply Htr in H11. destruct H11. clear -H0 H7 n n0. split. destruct H0. subst s; auto. destruct H. subst e; auto. destruct H; auto. contradict n; auto. destruct H7. subst i; auto. destruct H. subst e; auto. destruct H; auto. contradict n0; auto. assert (Hini': incl (i::nil) (i::e::st)). intros x Hx.  destruct Hx. subst x; auto. destruct H. assert (Hacc':incl (e::nil) (i::e::st)). intros x Hx. destruct Hx. subst x; auto. destruct H. destruct (IHst i e (mkRFA tr' Htr' Hini' Hacc')) as [r' H]; simpl; auto. inversion H2. inversion H5. inversion H9. apply NoDup_cons. contradict H1. destruct H1. subst e i x; auto. auto. apply NoDup_cons; auto. intros w s D. subst tr'. destruct (nat_eq_dec s p). inversion D. destruct (nat_eq_dec i p). inversion D. inversion D. contradict H5; auto. inversion H5. inversion H10. contradict H15; auto. intros w s D. subst tr'. destruct (nat_eq_dec e p). inversion D. destruct (nat_eq_dec s p). inversion D. inversion D. contradict H5; auto. inversion H5. contradict H8; auto.
  exists r'. intros; split; intros. apply H in H0. clear H. inversion H0. clear H0. simpl in H6. destruct H6; [subst is|inversion H0]. simpl in H7. destruct H7; [subst es|inversion H0]. assert (forall l is es w, incl l (i::e::st) -> Head is l->Tail es l->RFAsteps tr' w l -> exists m, Head is m /\ Tail es m /\ RFAsteps tr w m). clear H H1 H5 l w. induction l; intros. inversion H0. inversion H5. subst w s l. inversion H0. subst a a0 l. inversion H1. subst a es. exists (is::nil); auto. inversion H8. subst w s l. apply IHl with t es w2 in H9; auto. simpl in H10. destruct H9 as [m [Ha [Hb Hc]]]. clear IHl IHst H5. subst tr'. assert (~In p (i::e::st)). inversion H2. intros D. destruct D. contradict H7; subst x i; auto. inversion H8. destruct H9. subst p. contradict H13; auto. inversion H14; contradiction. destruct (nat_eq_dec a p). subst a. contradict H5. apply H; auto. destruct (nat_eq_dec t p). subst p. contradict H5; apply H; auto. inversion H10. inversion H0. subst a a0 l1. exists (is::m). split; auto. split; auto. subst s r l. inversion Ha. subst a m. apply RFAsteps_cons; auto. subst r s l. inversion H9. subst w1 r s. inversion H12. subst r s m0. clear H9 H12 H10. inversion H0. subst a0 a l2. assert (exists sl, Head p sl /\ Tail p sl /\ RFAsteps tr l1 sl). revert H11. apply (Fix (well_founded_ltof (list C) (length (A:=C)))) with (P:=fun l1=>Racc (Rstar (tr p p)) l1->exists sl, Head p sl /\ Tail p sl/\ RFAsteps tr l1 sl). clear l1. intros l1 IH H7. apply Rstar_rev in H7. destruct H7 as [[w0 [w1 [Hd [He [Hf Hg]]]]]|Hd]. subst l1. destruct (IH w1) as [sl [Hh [Hi Hj]]]; auto. unfold ltof. destruct w0. contradict He; auto. simpl. apply le_n_S. rewrite app_length; auto. exists (p::sl). split; auto. split; auto. inversion Hh. subst a sl. apply RFAsteps_cons; auto. subst l1. exists (p::nil); auto.
  destruct H6 as [sl [H9 [H10 H12]]]. exists (is::sl++m). split; auto. split. apply Tail_cons. clear -Hb. induction sl; simpl; auto. rewrite <- app_assoc. inversion H9.  subst a sl. simpl. apply RFAsteps_cons; auto. rewrite <- app_assoc. replace (p::l2++m) with ((p::l2)++m); auto. apply RFAsteps_app with p; auto. inversion Ha. subst a m. apply RFAsteps_cons; auto.  intros x Hx. destruct Hx. subst x. apply H; auto. apply H; auto. inversion H1; auto.  apply H0 with (is:=i) (es:=e) in H; auto. destruct H as [m [Ha [Hb Hc]]]. apply RFAacc_intro with m i e; simpl; auto. apply RFAsteps_const with (is:=i) (st:=i::e::st) in H; auto.
  apply H. clear H. inversion H0. clear H0. simpl in H6. destruct H6; [subst is|inversion H0]. simpl in H7. destruct H7; [subst es|inversion H0]. assert (forall l is es w, incl l (i::e::p::st) -> Head is l->Tail es l->is<>p->es<>p->RFAsteps tr w l -> RFAsteps tr' w (remove nat_eq_dec p l)). clear H H1 H5 w l r' IHst. intros l. apply (Fix (well_founded_ltof (list nat) (length (A:=nat)))) with (P:=fun l=>forall is es w, incl l (i::e::p::st)->Head is l->Tail es l->is<>p->es<>p->RFAsteps tr w l ->RFAsteps tr' w (remove nat_eq_dec p l)). clear l. intros l IH. intros. inversion H0. subst a l. clear H0. inversion H7. subst w s l0. simpl. destruct (nat_eq_dec p is); auto. contradict H5; auto. subst w s l0. clear H7. simpl in H11. destruct (repeat_head nat_eq_dec p (t::l)) as [[n [u [l' Ha Hb]]]| [n Ha]]. destruct (nat_eq_dec n 0). subst n. simpl in Ha. inversion Ha. subst u l'. apply IH  with (is:=t) (es:=es) in H10; auto. simpl in H10. simpl. destruct (nat_eq_dec p is). contradict H5; auto. destruct (nat_eq_dec p t). contradict Hb; auto. apply RFAsteps_cons; simpl; auto. subst tr'. destruct (nat_eq_dec is p). contradict n; auto. destruct (nat_eq_dec t p). contradict Hb; auto. auto.  unfold ltof. auto. intros x Hx. apply H. auto. inversion H1; auto. rewrite Ha in H10. replace (repeat p n++u::l') with ((repeat p n++u::nil)++l') in H10. apply RFAsteps_app_s_rev with (s:=u) in H10. destruct H10 as [wa [wb [Hd [He Hf]]]]. subst w2. assert (t=p). destruct n. contradict n0; auto. simpl in Ha. inversion Ha; auto. rewrite Ha. subst t. rewrite app_assoc. replace (remove nat_eq_dec p (is::repeat p n++u::l')) with (is::u::remove nat_eq_dec p l'). apply RFAsteps_cons. apply IH with (is:=u) (es:=es) in Hf; auto. simpl in Hf. destruct (nat_eq_dec p u); auto. contradict Hb; auto. unfold ltof. rewrite Ha. simpl; repeat apply le_n_S. rewrite app_length. rewrite plus_comm; auto.
  intros x Hx. apply H. rewrite Ha. right. apply in_or_app; auto. inversion H1. rewrite Ha in H8. clear -H8. induction n; simpl in H8; auto. apply IHn. inversion H8; auto. destruct n; inversion H2. simpl. clear IH. subst tr'. destruct (nat_eq_dec is p). contradict H5; auto. destruct (nat_eq_dec u p). contradict Hb; auto. apply RAor2. apply RAcons; auto. apply RFAsteps_app_s_rev with (s:=p) in He; auto. destruct He as [w3 [w2 [H7 [H8 H9]]]]. subst wa. apply RAcons; auto. destruct n. contradict n0; auto. clear -H8. simpl in H8. revert H8. revert w3. induction n; intros. simpl in H8. inversion H8. auto. simpl in H8. inversion H8. subst w3 s t l. apply IHn in H2; auto. inversion H9; auto. subst w2 s t l0. inversion H12. subst w4 s. simpl in H14. rewrite app_nil_r; auto. clear -n0. induction n. contradict n0; auto. destruct n; simpl. auto. simpl in IHn. apply Tail_cons; auto. clear -H5 Hb. simpl. destruct (nat_eq_dec p is). contradict H5; auto. f_equal. induction n. simpl. destruct (nat_eq_dec p u). contradict Hb; auto. auto. simpl. destruct (nat_eq_dec p p); auto. contradict n1; auto. clear -n. induction n; simpl; auto. rewrite <- app_assoc. simpl; auto. destruct n. inversion Ha. simpl in Ha. inversion Ha. subst t l. contradict H6. clear -H1. inversion H1. subst a b l. clear H1. induction n; simpl in H2. inversion H2. auto. inversion H1. apply IHn. inversion H2; auto. apply RFAacc_intro with (remove nat_eq_dec p l) i e; simpl; auto. apply H0 with i e; auto. apply RFAsteps_const with (is:=i) (st:=i::e::p::st) in H; auto. inversion H2. contradict H8; subst p; auto. inversion H2. inversion H9. contradict H12; subst p; auto. inversion H1. simpl. destruct (nat_eq_dec p i); auto. inversion H2. contradict H10; subst x p; auto. assert (e<>p). inversion H2. inversion H9. contradict H12; subst p; auto. clear -H5 H6. induction H5. simpl. destruct (nat_eq_dec p a); auto. contradict H6; auto. simpl. destruct (nat_eq_dec p b); auto. Defined.

Definition EFA2RegExp: forall e cset, (forall s c, In s (EFAstates e) -> EFAtrans e s c<>nil -> In c cset) -> {r| forall w, EFAacc e w <-> Racc r w}. intros. destruct (EFA2RFA e cset H) as [r H0]. destruct (RFA2single_edge r) as [is [es [st [r' H1 [H2 [H3 [H4 [H5 [H6 H7]]]]]]]]]. destruct (RFAsingle2RegExp (st:=st) (i:=is) (e:=es) r') as [ro H8]; auto. intros. exists ro. intros; split; intros. apply H8. apply H1. apply H0; auto. apply H0. apply H1. apply H8; auto. Defined.

Fixpoint repeatl {T:Type} n (l:list T) := match n with 0=>nil | S n'=>l++repeatl n' l end.
Lemma pumping: forall r, {n:nat | forall w, Racc r w -> n<=length w ->exists w1 w2 w3, w=w1++w2++w3 /\ w2<>nil /\ length w1+length w2<=n /\ forall i, Racc r (w1++repeatl i w2++w3)}. intros. destruct (RegExp2EFA r) as [e H]. destruct (EFA2NFA e) as [n H0]. exists (length (NFAstates n)). intros. apply H in H1. apply H0 in H1. inversion H1. assert (length l=S(length w)). apply NFAsteps_length in H5; auto. destruct (head_n_split (S (length (NFAstates n))) l) as [l1 [l2 H9 H10]]. subst l. apply le_n_S in H2. rewrite <- H8 in H2. apply H10 in H2. clear H10. assert (incl (l1++l2) (NFAstates n)). inversion H6. rewrite <- H11 in H5. apply NFAsteps_const with (s:=is) (st:=NFAstates n) in H5; auto. apply NFAtrans_const. apply NFAinit_const in H4; auto. assert (incl l1 (NFAstates n)). intros x Hx. apply H9. apply in_or_app; auto. destruct (pegeon_hole nat_eq_dec H10) as [s [l3 [l4 [l5 H11]]]]. rewrite H2; auto. subst l1. rewrite <- app_assoc in H5. simpl in H5. rewrite <- app_assoc in H5. simpl in H5. replace (l3++s::l4++s::l5++l2) with ((l3++s::nil)++l4++s::l5++l2) in H5. apply NFAsteps_app_s_rev with (s:=s) in H5. destruct H5 as [w1 [wa [Ha [Hb Hc]]]]. subst w. exists w1. replace (s::l4++s::l5++l2) with ((s::l4++s::nil)++(l5++l2)) in Hc. apply NFAsteps_app_s_rev with (s:=s) in Hc. destruct Hc as [w2 [w3 [Ha [Hd He]]]]. subst wa. exists w2. exists w3. split; auto. split. apply NFAsteps_length in Hd. simpl in Hd. rewrite app_length in Hd. rewrite plus_comm in Hd. simpl in Hd. inversion Hd. intros D. subst w2. simpl in Hd. inversion H11. split. apply NFAsteps_length in Hb. apply NFAsteps_length in Hd. rewrite app_length in Hb. simpl in Hd. rewrite app_length in Hd. simpl in Hb. simpl in Hd. rewrite plus_comm in Hb. rewrite plus_comm in Hd. inversion Hb. inversion Hd. rewrite app_length in H2. simpl in H2. rewrite app_length in H2. rewrite <- plus_n_Sm in H2. inversion H2. apply plus_le_compat_l. rewrite <- plus_n_Sm. apply le_n_S. apply le_plus_l.
  intros. apply H. apply H0. apply NFAacc_intro with is es ((l3++s::nil)++repeatl i (l4++s::nil)++l5++l2); auto. apply NFAsteps_app with (s:=s); auto. replace (s::repeatl i (l4++s::nil)++l5++l2) with ((s::repeatl i (l4++s::nil))++l5++l2). apply NFAsteps_app with (s:=s); auto. clear -Hd. induction i; simpl; auto. replace (s::(l4++s::nil)++repeatl i (l4++s::nil)) with ((s::l4++s::nil)++repeatl i (l4++s::nil)). apply NFAsteps_app with (s:=s); auto. simpl; auto. clear -i. induction i; simpl; auto. inversion IHi. rewrite app_nil_r. auto. auto. simpl; auto.  destruct l3. simpl in H6. inversion H6. subst s. simpl. auto. simpl in H6. inversion H6. subst n0. simpl; auto. clear -H7. destruct l2. rewrite app_nil_r in H7. rewrite app_nil_r. destruct l5. rewrite app_nil_r. apply Tail_app_rev in H7. inversion H7. destruct l4; inversion H2. apply Tail_app_rev in H1. inversion H1. subst a b s a0. induction i. simpl. rewrite app_nil_r. auto. simpl. destruct i. rewrite app_nil_r. auto. apply Tail_app_rev in IHi. auto. simpl. destruct l4; discriminate. inversion H5. discriminate. discriminate. apply Tail_app_rev in H7. inversion H7. destruct l4; inversion H2. apply Tail_app_rev in H1. inversion H1; auto. discriminate. discriminate. apply Tail_app_rev in H7; auto. discriminate. auto. simpl. f_equal. rewrite <- app_assoc. f_equal; auto. auto. rewrite <- app_assoc; auto. Defined.

Theorem no_eq_RegEx: forall r a b, a <> b -> ~(forall w, Racc r w <-> exists n, w=repeat a n++repeat b n). Proof. intros. destruct (pumping r) as [s H1]. intros D. assert (Racc r (repeat a (S s)++repeat b (S s))). apply D. exists (S s); auto. apply H1 in H0. destruct H0 as [w1 [w2 [w3 [H2 [H3 [H4 H5]]]]]]. clear H1. rewrite app_assoc in H2. rewrite <- app_length in H4. apply app_rev in H2; auto. destruct H2 as [[[l [Ha Hb] Hc]|[l [Ha Hb] Hc]]|[Ha Hb]]. apply repeat_app in Ha. destruct Ha as [x [y [Hd He] Hf]]. subst w3 l. symmetry in Hd. apply repeat_app in Hd. destruct Hd as [z [v [Hg Hh] Hi]]. subst x w1 w2. assert (Racc r (repeat a z++repeatl 0 (repeat a v)++repeat a y ++ repeat b (S s))); auto. simpl in H0. rewrite app_assoc in H0. rewrite <- repeat_plus in H0. apply D in H0. destruct H0 as [n H0]. apply app_rev in H0; auto. destruct H0 as [[[m [Hd He] Hg]|[m [Hd He] Hg]]|[Hd He]]. destruct m. contradict Hg; auto. destruct n; inversion He. subst c. apply repeat_app in Hd. destruct Hd as [x [u [H7 H8] H9]]. destruct u; inversion H8. contradict H; auto. destruct m. contradict Hg; auto. inversion He. subst c. apply repeat_app in Hd. destruct Hd as [x [u [H7 H8] H9]]. destruct u; inversion H8. contradict H; auto. apply repeat_eq_rev in Hd. subst n. replace (b::repeat b s) with (repeat b (S s)) in He; auto. apply repeat_eq_rev in He. rewrite Hf in He. rewrite <- plus_assoc in He. apply plus_reg_l in He. destruct v. contradict H3; auto. simpl in He. absurd (y<=v+y); auto. apply lt_not_le. rewrite <- He at 2. auto. rewrite Ha in H4. rewrite app_length in H4. rewrite repeat_length in H4. contradict H4. simpl. apply le_not_lt; auto. rewrite <- Ha in H4. contradict H4. rewrite repeat_length. apply le_not_lt; auto. rewrite app_length. rewrite repeat_length. simpl. auto. Qed.

End CharType.