(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)


(* Contribution to the Coq Library   V6.3 (July 1999)                    *)

(****************************************************************************)
(*                 The Calculus of Inductive Constructions                  *)
(*                                                                          *)
(*                                Projet Coq                                *)
(*                                                                          *)
(*                     INRIA                        ENS-CNRS                *)
(*              Rocquencourt                        Lyon                    *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              Nov 25th 1994                               *)
(*                                                                          *)
(****************************************************************************)
(*                                gram_aut.v                                *)
(****************************************************************************)
(*              Formal Language Theory                                      *)
(*                                                                          *)
(*              Judicael Courant - Jean-Christophe Filliatre                *)
(*                                                                          *)
(*              Developped in V5.8  June-July 1993                          *)
(*              Ported     to V5.10 October 1994                            *)
(****************************************************************************)
    
Require Import Ensf.
Require Import Words.
Require Import more_words.
Require Import need.
Require Import Relations.

Require Import gram.
Require Import gram_g.
Require Import PushdownAutomata.


Section APD.

Variable X V R : Ensf.
Variable S' : Elt.

Hypothesis Gram : isGram X V R S'.

Lemma Regles_X_V_R : Regles X V R.
(* Goal: Regles X V R *)
(* Goal: dans (couple A (word u)) R *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply isGram4 with S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
Qed.

Let P := union X V.

Let f_R_d (a : Elt) :=
  couple (word (cons (first a) nil)) (couple (eps X) (second a)).

Let f_X_d (x : Elt) := couple (word (cons x nil)) (couple x (word nil)).

Let d := union (map f_R_d R) (map f_X_d X).

Let wd := cons S' nil.

Let wa := nil.

Lemma Trans : Transition X P d.
(* Goal: l_egal (LA X wd wa d) (LG X V R S') *)
red in |- *.
(* Goal: forall (x : Elt) (_ : dans x d), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
intros x dans_x_d.
(* Goal: @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
elimtype (dans x (map f_R_d R) \/ dans x (map f_X_d X)).
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros dans_x.

(* Goal: @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
elimtype (exists y : Elt, dans y R /\ x = f_R_d y).
(* Goal: forall (x0 : Elt) (_ : and (dans x0 X) (@eq Elt x (f_X_d x0))), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros y temp; elim temp; clear temp.
(* Goal: forall _ : @eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold f_R_d in |- *.
(* Goal: forall (_ : dans y R) (_ : @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (second y)))), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros dans_y_R eg_x_f_y.
(* Goal: @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
exists (cons (first y) nil).
(* Goal: inmonoid P (cons S' nil) *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
apply inmonoid_cons.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
elim (Regles_X_V_R y dans_y_R).
(* Goal: forall (x0 : Elt) (_ : dans x0 V) (_ : @ex2 Word (fun B : Word => @eq Elt y (couple x0 (word B))) (fun B : Word => inmonoid (union X V) B)), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros f_y dans_f_y_V temp; elim temp; clear temp.
(* Goal: forall (x0 : Word) (_ : @eq Elt y (couple f_y (word x0))) (_ : inmonoid (union X V) x0), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros u eg_y inmono_u.
(* Goal: @eq Elt (word u) (second y) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
rewrite eg_y.
(* Goal: dans (first (couple f_y (word u))) P *)
(* Goal: @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y0 : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word (cons (first y) nil)) (couple y0 (word w2))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
unfold first in |- *.
(* Goal: dans S' P *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
unfold P in |- *.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y0 : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word (cons (first y) nil)) (couple y0 (word w2))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
exists (eps X).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word w2)))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
exists (word_inv (second y)).
(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
elim (Regles_X_V_R y dans_y_R).
(* Goal: forall (x0 : Elt) (_ : dans x0 V) (_ : @ex2 Word (fun B : Word => @eq Elt y (couple x0 (word B))) (fun B : Word => inmonoid (union X V) B)), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros f_y dans_f_y_V temp; elim temp; clear temp.
(* Goal: forall (x0 : Word) (_ : @eq Elt y (couple f_y (word x0))) (_ : inmonoid (union X V) x0), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros u eg_y inmono_u.
(* Goal: @eq Elt (word u) (second y) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
rewrite eg_y.
(* Goal: inmonoid P (word_inv (second (couple f_y (word u)))) *)
(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
unfold second in |- *.
(* Goal: inmonoid P (word_inv (word u)) *)
(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
unfold word_inv in |- *.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
elim (Regles_X_V_R y dans_y_R).
(* Goal: forall (x0 : Elt) (_ : dans x0 V) (_ : @ex2 Word (fun B : Word => @eq Elt y (couple x0 (word B))) (fun B : Word => inmonoid (union X V) B)), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros f_y dans_f_y_V temp; elim temp; clear temp.
(* Goal: forall (x0 : Word) (_ : @eq Elt y (couple f_y (word x0))) (_ : inmonoid (union X V) x0), @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros u eg_y inmono_u.

(* Goal: @eq Elt x (couple (word (cons (first y) nil)) (couple (eps X) (word (word_inv (second y))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
replace (word (word_inv (second y))) with (second y).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt (second y) (word (word_inv (second y))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
replace (second y) with (word u).
(* Goal: @eq Word (cons x w) (cons x w) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
apply refl_equal.
(* Goal: @eq Elt (word u) (second y) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y R) (@eq Elt x (f_R_d y))) *)
(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
rewrite eg_y.
(* Goal: @eq Word (cons x w) (cons x w) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
apply refl_equal.

(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: forall _ : dans x (map f_X_d X), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros dans_x.
(* Goal: @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
elimtype (exists y : Elt, dans y X /\ x = f_X_d y).
(* Goal: forall (x0 : Elt) (_ : and (dans x0 X) (@eq Elt x (f_X_d x0))), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros y temp; elim temp; clear temp.
(* Goal: forall (_ : dans y X) (_ : @eq Elt x (f_X_d y)), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
unfold f_X_d in |- *.
(* Goal: forall (_ : dans y X) (_ : @eq Elt x (couple (word (cons y nil)) (couple y (word nil)))), @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
intros dans_y_X eg_x_f_y.
(* Goal: @ex2 Word (fun w1 : Word => inmonoid P w1) (fun w1 : Word => @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word w1) (couple y (word w2)))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
exists (cons y nil).
(* Goal: inmonoid P (cons S' nil) *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
apply inmonoid_cons.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: dans S' P *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
unfold P in |- *.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: @ex2 Elt (fun y : Elt => dans y (add (eps X) X)) (fun y0 : Elt => @ex2 Word (fun w2 : Word => inmonoid P w2) (fun w2 : Word => @eq Elt x (couple (word (cons y nil)) (couple y0 (word w2))))) *)
(* Goal: @ex Elt (fun y : Elt => and (dans y X) (@eq Elt x (f_X_d y))) *)
(* Goal: or (dans x (map f_R_d R)) (dans x (map f_X_d X)) *)
exists y.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists nil.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.


Lemma X_P_wd_wa_d : P_automata X P wd wa d.
(* Goal: l_egal (LA X wd wa d) (LG X V R S') *)
red in |- *.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: inmonoid P wd *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
unfold wd in |- *.
(* Goal: inmonoid P (cons S' nil) *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
apply inmonoid_cons.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: dans S' P *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
unfold P in |- *.
(* Goal: dans (couple (word (cons x0 nil)) (couple x0 (word nil))) (union (map f_R_d R) (map f_X_d X)) *)
(* Goal: @eq Word (Append nil w) w *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
apply union_d.
(* Goal: dans S' V *)
(* Goal: and (inmonoid P wa) (Transition X P d) *)
apply isGram3 with X R.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: inmonoid P wa *)
(* Goal: Transition X P d *)
apply inmonoid_nil.
(* Goal: Transition X P d *)
exact Trans.
Qed.

Lemma cut_spec :
 forall u : Word,
 {a : Word & 
 {b : Word |
 inmonoid X a /\
 Append a b = u /\
 (b = nil \/
  ex2 (fun x : Elt => ~ dans x X)
    (fun x : Elt => exists w : Word, b = cons x w))}}.
(* Goal: forall u : Word, @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) u) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
intro u.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) u) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
pattern u in |- *.
(* Goal: (fun w : Word => @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w0 : Word => @eq Word b (cons x w0))))))))) u *)
apply Word_rec.

(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists nil.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists nil.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w0 : Word => @eq Word b (cons x w0))))))))), @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons e w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w0 : Word => @eq Word b (cons x w0)))))))) *)
intros x w Hyp.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
elim Hyp.
(* Goal: forall (x0 : Word) (_ : @sig Word (fun b : Word => and (inmonoid X x0) (and (@eq Word (Append x0 b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))), @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
intros a' spec; elim spec.
(* Goal: forall (x0 : Word) (_ : and (inmonoid X x') (and (@eq Word (Append x' x0) (cons a w)) (or (@eq Word x0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word x0 (cons x w))))))) (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (@pair Word Word x' x0)) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros b' temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X a') (_ : and (@eq Word (Append a' b') w) (or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w)))))), @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
intros inmonoid_a' temp; elim temp; clear temp.
(* Goal: forall (_ : @eq Word (Append a' b') w) (_ : or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))))), @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
intros spec_App spec_or.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
elimtype ({dans x X} + {~ dans x X}).
(* Goal: forall _ : dans x X, @sigT Word (fun a0 : Word => @sig Word (fun b : Word => and (inmonoid X a0) (and (@eq Word (Append a0 b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: forall _ : not (dans x X), @sigT Word (fun a : Word => @sig Word (fun b0 : Word => and (inmonoid X a) (and (@eq Word (Append a b0) (cons x w)) (or (@eq Word b0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b0 (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
intro dans_x_X.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: forall _ : not (dans x X), @sigT Word (fun a : Word => @sig Word (fun b0 : Word => and (inmonoid X a) (and (@eq Word (Append a b0) (cons x w)) (or (@eq Word b0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b0 (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists (cons x a').
(* Goal: @sig Word (fun b : Word => and (inmonoid X (cons x a')) (and (@eq Word (Append (cons x a') b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))))) *)
(* Goal: forall _ : not (dans x X), @sigT Word (fun a : Word => @sig Word (fun b0 : Word => and (inmonoid X a) (and (@eq Word (Append a b0) (cons x w)) (or (@eq Word b0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b0 (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists b'.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons; assumption.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: @eq Word (Append (cons x0 (cut1 u)) w) (cons x0 v) *)
(* Goal: @eq Word (cons x0 (cut1 u)) (cut1 (cons x0 u)) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
unfold Append in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
elim spec_or; intro; assumption.
(* Goal: forall _ : not (dans x X), @sigT Word (fun a : Word => @sig Word (fun b0 : Word => and (inmonoid X a) (and (@eq Word (Append a b0) (cons x w)) (or (@eq Word b0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b0 (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
intro N_dans_x_X.
(* Goal: @sigT Word (fun a : Word => @sig Word (fun b : Word => and (inmonoid X a) (and (@eq Word (Append a b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists nil.
(* Goal: @sig Word (fun b : Word => and (inmonoid X nil) (and (@eq Word (Append nil b) (cons x w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists (cons x w).
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x0 w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x0 w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
apply or_intror.
(* Goal: @ex2 Elt (fun x : Elt => not (dans x X)) (fun x0 : Elt => @ex Word (fun w0 : Word => @eq Word (cons x w) (cons x0 w0))) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exists x.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (cons x0 w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))) *)
exists w.
(* Goal: @eq Word (cons x w) (cons x w) *)
(* Goal: sumbool (dans x X) (not (dans x X)) *)
apply refl_equal.
(* Goal: sumbool (dans x X) (not (dans x X)) *)
exact (Dans_spec x X).
Qed.

Definition cut (u : Word) :=
  let (a, s) := cut_spec u in (a, let (b, s2) := s in b).




Definition cut1 (u : Word) := fst (cut u).
Definition cut2 (u : Word) := snd (cut u).

Lemma cut_unicite :
 forall u a b a' b' : Word,
 inmonoid X a /\
 Append a b = u /\
 (b = nil \/
  ex2 (fun x : Elt => ~ dans x X)
    (fun x : Elt => exists w : Word, b = cons x w)) ->
 inmonoid X a' /\
 Append a' b' = u /\
 (b' = nil \/
  ex2 (fun x : Elt => ~ dans x X)
    (fun x : Elt => exists w : Word, b' = cons x w)) -> 
 a = a'.
intros u a b a' b' temp1 temp2; elim temp1; elim temp2; clear temp1;
 clear temp2.
intros inmon temp inmon' temp'; elim temp; elim temp'; clear temp;
 clear temp'.
(* Goal: forall (_ : @eq Word (Append a b) u) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))) (_ : @eq Word (Append a' b') u) (_ : or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))))), @eq Word a a' *)
intros App spec_or App' spec_or'.
elimtype
 (exists w : Word,
    a = Append a' w /\ b' = Append w b \/ a' = Append a w /\ b = Append w b').
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) w) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (@pair Word Word x (let (b, _) := p in b)))) *)
intros x temp; elim temp; clear temp.
(* Goal: forall _ : and (@eq Word a (Append a' x)) (@eq Word b' (Append x b)), @eq Word a a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
pattern a' at 2 in |- *.
(* Goal: (fun w : Word => forall _ : and (@eq Word a (Append a' x)) (@eq Word b' (Append x b)), @eq Word a w) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
replace a' with (Append a' nil).
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
generalize x; clear x; simple induction x.

(* Goal: forall _ : and (@eq Word a' (Append a nil)) (@eq Word b (Append nil b')), @eq Word (Append a nil) a' *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : and (@eq Word a' (Append a w)) (@eq Word b (Append w b')), @eq Word (Append a nil) a') (_ : and (@eq Word a' (Append a (cons e w))) (@eq Word b (Append (cons e w) b'))), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intro temp; elim temp.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : and (@eq Word a' (Append a w)) (@eq Word b (Append w b')), @eq Word (Append a nil) a') (_ : and (@eq Word a' (Append a (cons e w))) (@eq Word b (Append (cons e w) b'))), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros x0 w Hyp temp; elim temp; clear temp.
(* Goal: forall (_ : @eq Word a (Append a' (cons x0 w))) (_ : @eq Word b' (Append (cons x0 w) b)), @eq Word a (Append a' nil) *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros a_eg b'_eg.
(* Goal: @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
absurd (dans x0 X).
(* Goal: not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
elim spec_or'.
(* Goal: forall _ : @eq Word b' nil, not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite b'_eg.
(* Goal: forall _ : @eq Word (Append (cons x0 w) b') nil, not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intro cons_nil.
(* Goal: not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
absurd (cons x0 (Append w b) = nil).
(* Goal: not (@eq Word (cons x0 (Append w v)) nil) *)
(* Goal: @eq Word (cons x0 (Append w v)) nil *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
discriminate.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : not (dans x X)) (_ : @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros x1 N_dans_x1 temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : @eq Word b' (cons x1 x)), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros w' b'_eg_2.
(* Goal: dans x0 X *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace x0 with x1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt x1 x0 *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply cons_cons_inv1 with w' (Append w b).
(* Goal: @eq Word (cons x1 w') (cons x0 (Append w b)) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite <- b'_eg_2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply inmonoid_cons_inv2 with w.
(* Goal: inmonoid X (cons x0 w) *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply inmonoid_Append_inv2 with a'.
(* Goal: inmonoid X (Append a' (cons x0 w)) *)
(* Goal: @eq Word (Append a' nil) a' *)
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite <- a_eg.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply Append_w_nil.

(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word a a' *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
pattern a at 2 in |- *.
(* Goal: (fun w : Word => forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word w a') a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
replace a with (Append a nil).
(* Goal: forall _ : and (@eq Word a' (Append a x)) (@eq Word b (Append x b')), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
generalize x; clear x; simple induction x.

(* Goal: forall _ : and (@eq Word a' (Append a nil)) (@eq Word b (Append nil b')), @eq Word (Append a nil) a' *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : and (@eq Word a' (Append a w)) (@eq Word b (Append w b')), @eq Word (Append a nil) a') (_ : and (@eq Word a' (Append a (cons e w))) (@eq Word b (Append (cons e w) b'))), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intro temp; elim temp.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : and (@eq Word a' (Append a w)) (@eq Word b (Append w b')), @eq Word (Append a nil) a') (_ : and (@eq Word a' (Append a (cons e w))) (@eq Word b (Append (cons e w) b'))), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros x0 w Hyp temp; elim temp; clear temp.
(* Goal: forall (_ : @eq Word a' (Append a (cons x0 w))) (_ : @eq Word b (Append (cons x0 w) b')), @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros a'_eg b_eg.
(* Goal: @eq Word (Append a nil) a' *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
absurd (dans x0 X).
(* Goal: not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
elim spec_or.
(* Goal: forall _ : @eq Word b nil, not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite b_eg.
(* Goal: forall _ : @eq Word (Append (cons x0 w) b') nil, not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intro cons_nil.
(* Goal: not (dans x0 X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
absurd (cons x0 (Append w b') = nil).
(* Goal: not (@eq Word (cons x0 (Append w v)) nil) *)
(* Goal: @eq Word (cons x0 (Append w v)) nil *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
discriminate.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : not (dans x X)) (_ : @ex Word (fun w : Word => @eq Word b (cons x w))), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros x1 N_dans_x1 temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : @eq Word b (cons x1 x)), not (dans x0 X) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
intros w' b_eg_2.
(* Goal: dans x0 X *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace x0 with x1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt x1 x0 *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply cons_cons_inv1 with w' (Append w b').
(* Goal: @eq Word (cons x1 w') (cons x0 (Append w b')) *)
(* Goal: dans x0 X *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite <- b_eg_2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply inmonoid_cons_inv2 with w.
(* Goal: inmonoid X (cons x0 w) *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply inmonoid_Append_inv2 with a.
(* Goal: inmonoid X (Append a (cons x0 w)) *)
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
rewrite <- a'_eg.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append a nil) a *)
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply Append_w_nil.
(* Goal: @ex Word (fun w : Word => or (and (@eq Word a (Append a' w)) (@eq Word b' (Append w b))) (and (@eq Word a' (Append a w)) (@eq Word b (Append w b')))) *)
apply Append_Append.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
rewrite App'; assumption.
Qed.


Lemma inmonoid_cut1 : forall w : Word, inmonoid X (cut1 w).
(* Goal: forall w : Word, @eq Word w (Append (cut1 w) (cut2 w)) *)
intro w.
(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
unfold cut1, cut in |- *.
(* Goal: @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (let (a, s) := cut_spec w in @pair Word Word a (let (b, _) := s in b)))) *)
elim (cut_spec w).
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word (@snd Word Word (@pair Word Word x (let (b, _) := p in b))) (cons A v) *)
intros a temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : and (inmonoid X a) (and (@eq Word (Append a x) (cons A v)) (or (@eq Word x nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word x (cons x0 w))))))), @eq Word nil (@fst Word Word (@pair Word Word a x)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros b temp; elim temp; clear temp.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
simpl in |- *; auto.
Qed.

Lemma cut_Append : forall w : Word, w = Append (cut1 w) (cut2 w).
(* Goal: forall w : Word, @eq Word w (Append (cut1 w) (cut2 w)) *)
intro w.
(* Goal: @eq Word w (Append (cut1 w) (cut2 w)) *)
unfold cut1, cut2, cut in |- *.
(* Goal: @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (let (a, s) := cut_spec w in @pair Word Word a (let (b, _) := s in b)))) *)
elim (cut_spec w).
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word (@snd Word Word (@pair Word Word x (let (b, _) := p in b))) (cons A v) *)
intros a temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : and (inmonoid X a) (and (@eq Word (Append a x) (cons A v)) (or (@eq Word x nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word x (cons x0 w))))))), @eq Word nil (@fst Word Word (@pair Word Word a x)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros b temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X a) (_ : and (@eq Word (Append a b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))), @eq Word w (Append (@fst Word Word (@pair Word Word a b)) (@snd Word Word (@pair Word Word a b))) *)
intros inm temp; elim temp.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
simpl in |- *; auto.
Qed.

Lemma cut1_cons :
 forall (a : Elt) (w : Word), dans a X -> cut1 (cons a w) = cons a (cut1 w).
(* Goal: forall (a : Elt) (w : Word) (_ : dans a X), @eq Word (cut1 (cons a w)) (cons a (cut1 w)) *)
intros a w dans_a_X.
(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
unfold cut1, cut in |- *.
(* Goal: @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (let (a, s) := cut_spec w in @pair Word Word a (let (b, _) := s in b)))) *)
elim (cut_spec w).
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) w) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (@pair Word Word x (let (b, _) := p in b)))) *)
intros x temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : and (inmonoid X a) (and (@eq Word (Append a x) (cons A v)) (or (@eq Word x nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word x (cons x0 w))))))), @eq Word nil (@fst Word Word (@pair Word Word a x)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros b temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X x) (_ : and (@eq Word (Append x b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))), @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros inmon_X_x temp; elim temp; clear temp.

(* Goal: forall (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (let (a0, s) := cut_spec (cons a w) in @pair Word Word a0 (let (b, _) := s in b))) (cons a (@fst Word Word (@pair Word Word x b))) *)
elim (cut_spec (cons a w)).
(* Goal: forall (x0 : Word) (p : @sig Word (fun b : Word => and (inmonoid X x0) (and (@eq Word (Append x0 b) (cons a w)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))))) (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (@pair Word Word x0 (let (b, _) := p in b))) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros x' temp; elim temp; clear temp.
(* Goal: forall (x0 : Word) (_ : and (inmonoid X x') (and (@eq Word (Append x' x0) (cons a w)) (or (@eq Word x0 nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word x0 (cons x w))))))) (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (@pair Word Word x' x0)) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros b' temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X x') (_ : and (@eq Word (Append x' b') (cons a w)) (or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w)))))) (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (@pair Word Word x' b')) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros inmon_X_x' temp; elim temp; clear temp.

(* Goal: forall (_ : @eq Word (Append x' b') (cons a w)) (_ : or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))))) (_ : @eq Word (Append x b) w) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word (@fst Word Word (@pair Word Word x' b')) (cons a (@fst Word Word (@pair Word Word x b))) *)
intros App_eg' spec' App_eg spec.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.

(* Goal: @eq Word x' (cons a x) *)
cut (inmonoid X x').
(* Goal: forall _ : inmonoid X x', @eq Word x' (cons a x) *)
(* Goal: inmonoid X x' *)
cut (Append x' b' = cons a w).

(* Goal: forall (_ : @eq Word (Append x' b') (cons a w)) (_ : inmonoid X x'), @eq Word x' (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
clear inmon_X_x' App_eg'.
(* Goal: forall (_ : @eq Word (Append x' b') (cons a w)) (_ : inmonoid X x'), @eq Word x' (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
generalize x'; clear x'; simple induction x'.

(* Goal: forall (_ : @eq Word (Append nil b') (cons a w)) (_ : inmonoid X nil), @eq Word nil (cons a x) *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
intro App_nil_b'_eg_cons_a_w.
(* Goal: forall _ : inmonoid X nil, @eq Word nil (cons a x) *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
absurd (dans a X).
(* Goal: not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
elim spec'.
(* Goal: forall _ : @eq Word b' nil, not (dans a X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
intro b'_nil.
(* Goal: not (dans a X) *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
absurd (cons a w = nil).
(* Goal: not (@eq Word (cons x0 (Append w v)) nil) *)
(* Goal: @eq Word (cons x0 (Append w v)) nil *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
discriminate.
(* Goal: @eq Word (cons a w) nil *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
rewrite <- b'_nil.
(* Goal: @eq Word (cons a w) b' *)
(* Goal: forall _ : @ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
rewrite <- App_nil_b'_eg_cons_a_w.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : not (dans x X)) (_ : @ex Word (fun w : Word => @eq Word b' (cons x w))), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
intros x0 N_dans_x0_X temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : @eq Word b' (cons x0 x)), not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
intros w1 eg_b'_cons.
(* Goal: not (dans a X) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
replace a with x0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt x0 a *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
apply cons_cons_inv1 with w1 w.
(* Goal: @eq Word (cons x0 w1) (cons a w) *)
(* Goal: dans a X *)
(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
rewrite <- eg_b'_cons.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: forall (e : Elt) (w0 : Word) (_ : forall (_ : @eq Word (Append w0 b') (cons a w)) (_ : inmonoid X w0), @eq Word w0 (cons a x)) (_ : @eq Word (Append (cons e w0) b') (cons a w)) (_ : inmonoid X (cons e w0)), @eq Word (cons e w0) (cons a x) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
intros x0 w0 Hyp App_eg_cons inmon_cons.
(* Goal: @eq Word (cons x1 (Append w1 we)) (cons x0 v2) *)
(* Goal: @eq Word (cons x1 (Append w1 we)) (Append (cons x1 w1) we) *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons.
(* Goal: @eq Elt x0 a *)
(* Goal: @eq Word w0 x *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
apply cons_cons_inv1 with (Append w0 b') w.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word w0 x *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
apply cut_unicite with w b' b.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv with x0; assumption.

(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: @eq Word (Append w0 b') w *)
(* Goal: or (@eq Word b' nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b' (cons x w)))) *)
(* Goal: and (inmonoid X x) (and (@eq Word (Append x b) w) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))) *)
(* Goal: @eq Word (Append x' b') (cons a w) *)
(* Goal: inmonoid X x' *)
apply cons_cons_inv2 with x0 a.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
split; auto.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.


Lemma cut1_Append :
 forall u v : Word, inmonoid X u -> cut1 (Append u v) = Append u (cut1 v).
(* Goal: forall (u v : Word) (_ : inmonoid X u), @eq Word (cut1 (Append u v)) (Append u (cut1 v)) *)
intros u v.
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
generalize u; clear u; simple induction u.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : inmonoid X w, @eq Word (cut1 (Append w v)) (Append w (cut1 v))) (_ : inmonoid X (cons e w)), @eq Word (cut1 (Append (cons e w) v)) (Append (cons e w) (cut1 v)) *)
intros x w Hyp inmon_x_w.
(* Goal: @eq Word (cut1 (Append (cons x w) v)) (Append (cons x w) (cut1 v)) *)
replace (cut1 (Append (cons x w) v)) with (cons x (cut1 (Append w v))).
(* Goal: @eq Word (cons x (cut1 (Append w v))) (Append (cons x w) (cut1 v)) *)
(* Goal: @eq Word (cons x (cut1 (Append w v))) (cut1 (Append (cons x w) v)) *)
replace (Append (cons x w) (cut1 v)) with (cons x (Append w (cut1 v))).
(* Goal: @eq Word (cons x1 (Append w1 we)) (cons x0 v2) *)
(* Goal: @eq Word (cons x1 (Append w1 we)) (Append (cons x1 w1) we) *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv with x; assumption.

(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: @eq Word (Append s2 nil) (Append nil y) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply sym_equal.
(* Goal: @eq Word (Append (cons x0 (cut1 u)) w) (cons x0 v) *)
(* Goal: @eq Word (cons x0 (cut1 u)) (cut1 (cons x0 u)) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
unfold Append in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: @eq Word (cut1 (cons x0 u)) (cons x0 (cut1 u)) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
apply cut1_cons.
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply inmonoid_cons_inv2 with w.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
Qed.


Axiom
  cut2_cons :
    forall (A : Elt) (v : Word), dans A X -> cut2 (cons A v) = cut2 v.


Lemma cut2_cons_N :
 forall (A : Elt) (v : Word), ~ dans A X -> cut2 (cons A v) = cons A v.
(* Goal: forall (A : Elt) (v : Word) (_ : not (dans A X)), @eq Word (cut2 (cons A v)) (cons A v) *)
intros A v N_dans_A_X.
(* Goal: @eq Word (cut2 (cons A v)) (cons A v) *)
unfold cut2, cut in |- *.
(* Goal: @eq Word nil (@fst Word Word (let (a, s) := cut_spec (cons A v) in @pair Word Word a (let (b, _) := s in b))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
elim (cut_spec (cons A v)).
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word (@snd Word Word (@pair Word Word x (let (b, _) := p in b))) (cons A v) *)
intros a temp; elim temp; clear temp.
(* Goal: forall (x : Word) (_ : and (inmonoid X a) (and (@eq Word (Append a x) (cons A v)) (or (@eq Word x nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word x (cons x0 w))))))), @eq Word nil (@fst Word Word (@pair Word Word a x)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros b temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X a) (_ : and (@eq Word (Append a b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros inmon_a temp; elim temp; clear temp.
(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros App_eg spec_or.
(* Goal: @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
cut (inmonoid X a).
(* Goal: forall _ : inmonoid X a, @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
cut (Append a b = cons A v).
(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : inmonoid X a), @eq Word (@snd Word Word (@pair Word Word a b)) (cons A v) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
clear App_eg inmon_a.
(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : inmonoid X a), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
generalize a; clear a; simple induction a.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
	auto.

(* Goal: forall (e : Elt) (w : Word) (_ : forall (_ : @eq Word (Append w b) (cons A v)) (_ : inmonoid X w), @eq Word (@snd Word Word (@pair Word Word w b)) (cons A v)) (_ : @eq Word (Append (cons e w) b) (cons A v)) (_ : inmonoid X (cons e w)), @eq Word (@snd Word Word (@pair Word Word (cons e w) b)) (cons A v) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
	intros x w Hyp App_eg_x_w inmon.
(* Goal: @eq Word nil (@fst Word Word (@pair Word Word (cons x0 w) b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
	absurd (dans A X).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
		assumption.

(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
		replace A with x.
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
		apply inmonoid_cons_inv2 with w.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
		assumption.
(* Goal: @eq Elt x0 A *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
		apply cons_cons_inv1 with (Append w b) v.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
		assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.

Lemma Deriveg_imp_Deriveg_cut :
 forall x y : Word,
 Deriveg X R x y ->
 ex2 (fun w : Word => Append (cut1 x) w = y)
   (fun w : Word => Deriveg X R (cut2 x) w).
(* Goal: forall (x y : prod Word Word) (_ : Derive_P_A X (union (map f_R_d R) (map f_X_d X)) x y), Derive_P_A_2 x y *)
intros x y Der.
(* Goal: Derive_P_A_2 x y *)
elim Der.
(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons A v)) w) (Append u v)) (fun w : Word => Deriveg X R (cut2 (cons A v)) w) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
replace (cut1 (cons A v)) with nil.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append nil w) (Append u v)) (fun w : Word => Deriveg X R (cut2 (cons A v)) w) *)
(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
exists (Append u v).
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: Deriveg X R (cut2 (cons A v)) (Append u v) *)
(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
replace (cut2 (cons A v)) with (cons A v).
(* Goal: Deriveg X R (cons x0 w) (Append u w) *)
(* Goal: Rstar Word (Deriveg X R) (Append s0 (Append u w)) (Append s0 (Append u w)) *)
apply Deriveg1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append s2 nil) (Append nil y) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply sym_equal.
(* Goal: @eq Word (cut2 (cons A v)) (cons A v) *)
(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply cut2_cons_N.
(* Goal: not (dans A X) *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply inter_dans with V.
(* Goal: inter V X empty *)
(* Goal: dans A V *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply sym_inter.
(* Goal: inter X V empty *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply isGram2 with R S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
(* Goal: dans A V *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply Regles_inv1 with X R (word u).
(* Goal: Regles X V R *)
(* Goal: dans (couple A (word u)) R *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply isGram4 with S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: @eq Word nil (cut1 (cons A v)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
unfold cut1, cut in |- *.
(* Goal: @eq Word nil (@fst Word Word (let (a, s) := cut_spec (cons A v) in @pair Word Word a (let (b, _) := s in b))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
elim (cut_spec (cons A v)).
(* Goal: forall (x : Word) (p : @sig Word (fun b : Word => and (inmonoid X x) (and (@eq Word (Append x b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word b (cons x0 w)))))))), @eq Word nil (@fst Word Word (@pair Word Word x (let (b, _) := p in b))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros a p.
(* Goal: @eq Word nil (@fst Word Word (@pair Word Word a (let (b, _) := p in b))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
elim p.
(* Goal: forall (x : Word) (_ : and (inmonoid X a) (and (@eq Word (Append a x) (cons A v)) (or (@eq Word x nil) (@ex2 Elt (fun x0 : Elt => not (dans x0 X)) (fun x0 : Elt => @ex Word (fun w : Word => @eq Word x (cons x0 w))))))), @eq Word nil (@fst Word Word (@pair Word Word a x)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros b temp; elim temp; clear temp.
(* Goal: forall (_ : inmonoid X a) (_ : and (@eq Word (Append a b) (cons A v)) (or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w)))))), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros inmon_a temp; elim temp; clear temp.

(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : or (@eq Word b nil) (@ex2 Elt (fun x : Elt => not (dans x X)) (fun x : Elt => @ex Word (fun w : Word => @eq Word b (cons x w))))), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros App_eg spec_or.

(* Goal: @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
cut (inmonoid X a). (**)(*pour l'induction*)
(* Goal: forall _ : inmonoid X a, @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
cut (Append a b = cons A v). (***)(*pour l'induction*)
(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : inmonoid X a), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
clear App_eg inmon_a p.
(* Goal: forall (_ : @eq Word (Append a b) (cons A v)) (_ : inmonoid X a), @eq Word nil (@fst Word Word (@pair Word Word a b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
generalize a; clear a; simple induction a.

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : forall (_ : @eq Word (Append w b) (cons A v)) (_ : inmonoid X w), @eq Word nil (@fst Word Word (@pair Word Word w b))) (_ : @eq Word (Append (cons e w) b) (cons A v)) (_ : inmonoid X (cons e w)), @eq Word nil (@fst Word Word (@pair Word Word (cons e w) b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros x0 w Hyp App inmon.
(* Goal: @eq Word nil (@fst Word Word (@pair Word Word (cons x0 w) b)) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
absurd (dans A X).

(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: not (dans A X) *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply inter_dans with V.
(* Goal: inter V X empty *)
(* Goal: dans A V *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply sym_inter.
(* Goal: inter X V empty *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply isGram2 with R S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.

(* Goal: dans A V *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply Regles_inv1 with X R (word u).
(* Goal: Regles X V R *)
(* Goal: dans (couple A (word u)) R *)
(* Goal: dans A X *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply isGram4 with S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply inmonoid_cons_inv2 with w.
(* Goal: inmonoid X (cons A w) *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
replace A with x0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt x0 A *)
(* Goal: @eq Word (Append a b) (cons A v) *)
(* Goal: inmonoid X a *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
apply cons_cons_inv1 with (Append w b) v.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption. (**)
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption. (***)


(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : @ex2 Word (fun w : Word => @eq Word (Append (cut1 u) w) v) (fun w : Word => Deriveg X R (cut2 u) w)), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x u)) w) (cons x v)) (fun w : Word => Deriveg X R (cut2 (cons x u)) w) *)
intros u v x0 dans_x0_X Deriveg_X_R_u_v temp.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
elim temp; clear temp.
(* Goal: forall (x : Word) (_ : @eq Word (Append (cut1 u) x) v) (_ : Deriveg X R (cut2 u) x), @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intros w eg_App_cut Der_g_cut2.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (cons x0 w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))) *)
exists w.
(* Goal: @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
replace (cut1 (cons x0 u)) with (cons x0 (cut1 u)).
(* Goal: @eq Word (Append (cons x0 (cut1 u)) w) (cons x0 v) *)
(* Goal: @eq Word (cons x0 (cut1 u)) (cut1 (cons x0 u)) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
unfold Append in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply cons_cons; trivial.

(* Goal: @eq Word (Append s2 nil) (Append nil y) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply sym_equal.
(* Goal: @eq Word (cut1 (cons x0 u)) (cons x0 (cut1 u)) *)
(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
apply cut1_cons.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: Deriveg X R (cut2 (cons x0 u)) w *)
replace (cut2 (cons x0 u)) with (cut2 u).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append s2 nil) (Append nil y) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply sym_equal.
(* Goal: @eq Word (cut2 (cons x0 u)) (cut2 u) *)
apply cut2_cons.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.

Lemma Deriveg_imp_Deriveg_App :
 forall x y : Word,
 Deriveg X R x y ->
 forall u v : Word,
 Append u v = x ->
 inmonoid X u ->
 ex2 (fun w : Word => Append u w = y) (fun w : Word => Deriveg X R v w).
(* Goal: forall (x y : Word) (_ : Deriveg X R x y) (u v : Word) (_ : @eq Word (Append u v) x) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Deriveg X R v w) *)
intros x y Derg.
(* Goal: forall (u v : Word) (_ : @eq Word (Append u v) x) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Deriveg X R v w) *)
elim Derg.

(* Goal: forall (u v : Word) (A : Elt) (_ : dans (couple A (word u)) R) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons A v)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (Append u v)) (fun w : Word => Deriveg X R v0 w) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
intros u0 v0 A dans_A_u0_R u v eg_App.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
elimtype (u = nil \/ (exists w : Word, (exists x : Elt, u = cons x w))).
(* Goal: forall _ : @eq Word u nil, @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros u_eg.
(* Goal: forall _ : inmonoid X u, @ex2 Word (fun w : Word => @eq Word (Append u w) (Append u0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (Append u0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exists (Append u0 v0).
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: Deriveg X R v (Append u0 v0) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (Append u0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
replace v with (cons A v0).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Deriveg1; assumption.
(* Goal: @eq Word (cons x0 w) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace v with (Append u v).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intros w temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : @eq Word u (cons x w)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (Append u0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
intros x0 u_eg inmon_u.
(* Goal: forall _ : @eq Word (Append u0 w) (@fst Word Word z), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
absurd (dans x0 V).
(* Goal: not (dans x0 V) *)
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply inter_dans with X.
(* Goal: inter X V empty *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply isGram2 with R S'.
(* Goal: isGram X V R S' *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
exact Gram.
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply inmonoid_cons_inv2 with w.
(* Goal: @eq Word (cons A v0) (Append (cons x0 w) v) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
rewrite <- u_eg.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: dans x0 V *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
replace x0 with A.
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply Regles_inv1 with X R (word u0).
(* Goal: Regles X V R *)
(* Goal: dans (couple x0 (word u0)) R *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
exact Regles_X_V_R.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt A x0 *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
apply cons_cons_inv1 with v0 (Append w v).
(* Goal: @eq Word (cons A v0) (cons x0 (Append w v)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
change (cons A v0 = Append (cons x0 w) v) in |- *.
(* Goal: @eq Word (cons A v0) (Append (cons x0 w) v) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
rewrite <- u_eg.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
clear eg_App.
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
generalize u; clear u; simple induction u.

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : or (@eq Word w nil) (@ex Word (fun w0 : Word => @ex Elt (fun x : Elt => @eq Word w (cons x w0))))), or (@eq Word (cons e w) nil) (@ex Word (fun w0 : Word => @ex Elt (fun x : Elt => @eq Word (cons e w) (cons x w0)))) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
intros x0 w hyp.
(* Goal: or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x0 w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x0 w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
apply or_intror.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (cons x0 w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))) *)
exists w.
(* Goal: @ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v))))) *)
exists x0.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) v) (fun w : Word => Deriveg X R v0 w)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) (cons x u)) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) (cons x v)) (fun w : Word => Deriveg X R v0 w) *)
intros u0 v0 x0 dans_x0_X Derg_u_v Hyp u v.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
elimtype (u = nil \/ (exists w : Word, (exists x : Elt, u = cons x w))).
(* Goal: forall (_ : @eq Word u nil) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro eg_u. 
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
(* Goal: forall (_ : @eq Word (Append nil v) nil) (_ : inmonoid X nil), @ex2 Word (fun w : Word => @eq Word (Append nil w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) nil) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros App_eg inmon_nil.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append nil w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
exists (cons x0 v0).
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: Deriveg X R v (cons x0 v0) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace v with (cons x0 u0).
(* Goal: Deriveg X R (cons x0 (Append w x)) (cons x0 (Append w y)) *)
apply Deriveg2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intros w temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : @eq Word u (cons x w)) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros x1 u_eg.
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: forall (_ : @eq Word (Append (cons x1 w) v) (cons x0 u0)) (_ : inmonoid X (cons x1 w)), @ex2 Word (fun w0 : Word => @eq Word (Append (cons x1 w) w0) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros App_cons_eg inmonoid_X_cons_x1_w.
elimtype
 (ex2 (fun w1 : Word => Append w w1 = v0) (fun w1 : Word => Deriveg X R v w1)).
(* Goal: forall (x : Word) (_ : @eq Word (Append w x) v0) (_ : Deriveg X R v x), @ex2 Word (fun w0 : Word => @eq Word (Append (cons x1 w) w0) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append w w1) v0) (fun w1 : Word => Deriveg X R v w1) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros w0 App_eg Der_v_w0.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (Append (cons x1 w) w0) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append w w1) v0) (fun w1 : Word => Deriveg X R v w1) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
exists w0.
(* Goal: @eq Word (Append (cons x1 w) w0) (cons x0 v0) *)
(* Goal: Deriveg X R v w0 *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append w w1) v0) (fun w1 : Word => Deriveg X R v w1) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
change (cons x1 (Append w w0) = cons x0 v0) in |- *.
(* Goal: @eq Word (cons x1 (Append w1 we)) (cons x0 v2) *)
(* Goal: @eq Word (cons x1 (Append w1 we)) (Append (cons x1 w1) we) *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons.
(* Goal: @eq Elt x1 x0 *)
(* Goal: @eq Word (Append w w0) v0 *)
(* Goal: Deriveg X R v w0 *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append w w1) v0) (fun w1 : Word => Deriveg X R v w1) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons_inv1 with (Append w v) u0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: @eq Word (Append w1 v) w *)
(* Goal: inmonoid X w1 *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons_inv2 with x1 x0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: inmonoid X w1 *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply inmonoid_cons_inv with x1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
generalize u; clear u; simple induction u.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: forall (e : Elt) (w : Word) (_ : or (@eq Word w nil) (@ex Word (fun w0 : Word => @ex Elt (fun x : Elt => @eq Word w (cons x w0))))), or (@eq Word (cons e w) nil) (@ex Word (fun w0 : Word => @ex Elt (fun x : Elt => @eq Word (cons e w) (cons x w0)))) *)
intros x2 w hyp.
(* Goal: or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x0 w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x0 w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
apply or_intror.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (cons x0 w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))) *)
exists w.
(* Goal: @ex Elt (fun x : Elt => @eq Word (cons x2 w) (cons x w)) *)
exists x2.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

Qed.


Lemma Derivegstar_imp_Der_inmon :
 forall x y : Word,
 Derivegstar X R x y ->
 forall u v : Word,
 Append u v = x ->
 inmonoid X u ->
 ex2 (fun w : Word => Append u w = y) (fun w : Word => Derivegstar X R v w).
(* Goal: (fun a a' : prod Word Conf => forall _ : inmonoid X (@fst Word Conf a), Derivegstar X R (Append (@fst Word Conf a) (@fst Word Word (@snd Word Conf a))) (Append (@fst Word Conf a') (@fst Word Word (@snd Word Conf a')))) (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y')) *)
unfold Derivegstar in |- *.
(* Goal: forall (x y : Conf) (_ : forall (P : forall (_ : Conf) (_ : Conf), Prop) (_ : forall u : Conf, P u u) (_ : forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : P v w), P u w), P x y) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
intros x y Der_star.
(* Goal: forall (u v : Word) (_ : @eq Word (Append u v) x) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Word (Deriveg X R) v w) *)
unfold Rstar in Der_star.
(* Goal: forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
pattern x, y in |- *.
(* Goal: (fun c c0 : Conf => forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s c) (@pair Word Conf s2 c0))) x y *)
apply Der_star.

(* Goal: forall (u u0 v : Word) (_ : @eq Word (Append u0 v) u) (_ : inmonoid X u0), @ex2 Word (fun w : Word => @eq Word (Append u0 w) u) (fun w : Word => Rstar Word (Deriveg X R) v w) *)
(* Goal: forall (u v w : Word) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) v) (_ : inmonoid X u0), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w0 : Word => Rstar Word (Deriveg X R) v0 w0)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w0 : Word => Rstar Word (Deriveg X R) v0 w0) *)
intros; exists v.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.


(* Goal: forall (u v w : Word) (_ : Deriveg X R u v) (_ : forall (u0 v0 : Word) (_ : @eq Word (Append u0 v0) v) (_ : inmonoid X u0), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w0 : Word => Rstar Word (Deriveg X R) v0 w0)) (u0 v0 : Word) (_ : @eq Word (Append u0 v0) u) (_ : inmonoid X u0), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w0 : Word => Rstar Word (Deriveg X R) v0 w0) *)
intros u v w Der_u_v Hyp u0 v0 App_eg inmon_u0.
elimtype
 (ex2 (fun w1 : Word => Append u0 w1 = v)
    (fun w1 : Word => Deriveg X R v0 w1)).
(* Goal: forall (x : Word) (_ : @eq Word (Append u0 x) v) (_ : Deriveg X R v0 x), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w : Word => Rstar Word (Deriveg X R) v0 w) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) v) (fun w1 : Word => Deriveg X R v0 w1) *)
intros w0 App_eg_u0_w0 Deriveg_v0_x0.
elimtype
 (ex2 (fun w1 : Word => Append u0 w1 = w)
    (fun w1 : Word => Rstar Word (Deriveg X R) w0 w1)).
(* Goal: forall (x : Word) (_ : @eq Word (Append u0 x) w) (_ : Rstar Word (Deriveg X R) w0 x), @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w : Word => Rstar Word (Deriveg X R) v0 w) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) w) (fun w1 : Word => Rstar Word (Deriveg X R) w0 w1) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) v) (fun w1 : Word => Deriveg X R v0 w1) *)
intros w1 App_eg_u0_w1_w Rstar_Der.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (Append u0 w0) w) (fun w : Word => Rstar Word (Deriveg X R) v0 w) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) w) (fun w1 : Word => Rstar Word (Deriveg X R) w0 w1) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) v) (fun w1 : Word => Deriveg X R v0 w1) *)
exists w1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Word (Deriveg X R) v0 w1 *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) w) (fun w1 : Word => Rstar Word (Deriveg X R) w0 w1) *)
(* Goal: @ex2 Word (fun w1 : Word => @eq Word (Append u0 w1) v) (fun w1 : Word => Deriveg X R v0 w1) *)
apply Rstar_R with w0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Hyp; assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Deriveg_imp_Deriveg_App with u; assumption.
Qed.



Inductive Derive_P_A_2 : Conf -> Conf -> Prop :=
  | Derive_X :
      forall (w u : Word) (x : Elt),
      dans x X -> Derive_P_A_2 (cons x w, cons x u) (w, u)
  | Derive_V :
      forall (v w u : Word) (x : Elt),
      dans (couple x (word u)) R ->
      Derive_P_A_2 (cons x w, v) (Append u w, v).



Definition Derive_P_A_2_nind (x y : Conf) :=
  ex2 (fun a : Elt => dans a X)
    (fun a : Elt => fst x = cons a (fst y) /\ snd x = cons a (snd y)) \/
  (exists a : Elt,
     ex2 (fun w : Word => cons a w = fst x)
       (fun w : Word =>
        ex2 (fun u : Word => dans (couple a (word u)) R)
          (fun u : Word => Append u w = fst y))).


Lemma Derive_P_A_2_inv :
 forall x y : Conf, Derive_P_A_2 x y -> Derive_P_A_2_nind x y.
(* Goal: forall (x y : prod Word Word) (_ : Derive_P_A X (union (map f_R_d R) (map f_X_d X)) x y), Derive_P_A_2 x y *)
intros x y Der.
(* Goal: forall _ : Derive_P_A_2_nind (@pair Word Word (cons x u) v) z, @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
unfold Derive_P_A_2_nind in |- *.
(* Goal: Derive_P_A_2 x y *)
elim Der.
(* Goal: forall (w u : Word) (x : Elt) (_ : dans x X), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) (cons x u))) (@pair Word Conf s2 (@pair Word Word w u))) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
intros w u x0 dans_x0_X.
(* Goal: or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x0 w) (cons x0 u))) (cons a (@fst Word Word (@pair Word Word w u)))) (@eq Word (@snd Word Word (@pair Word Word (cons x0 w) (cons x0 u))) (cons a (@snd Word Word (@pair Word Word w u)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) (cons x0 u)))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word w u)))))) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x w) v))) (fun w0 : Word => @ex2 Word (fun u0 : Word => dans (couple a (word u0)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
apply or_introl.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
exists x0; auto.

(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x w) v))) (fun w0 : Word => @ex2 Word (fun u0 : Word => dans (couple a (word u0)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
intros v w u x0 dans_couple_Der.
(* Goal: or (@ex2 Elt (fun a : Elt => dans a X) (fun a : Elt => and (@eq Word (@fst Word Word (@pair Word Word (cons x0 w) v)) (cons a (@fst Word Word (@pair Word Word (Append u w) v)))) (@eq Word (@snd Word Word (@pair Word Word (cons x0 w) v)) (cons a (@snd Word Word (@pair Word Word (Append u w) v)))))) (@ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))))) *)
apply or_intror.
(* Goal: @ex Elt (fun a : Elt => @ex2 Word (fun w0 : Word => @eq Word (cons a w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple a (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v))))) *)
exists x0.
(* Goal: @ex2 Word (fun w0 : Word => @eq Word (cons x0 w0) (@fst Word Word (@pair Word Word (cons x0 w) v))) (fun w0 : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u0 : Word => @eq Word (Append u0 w0) (@fst Word Word (@pair Word Word (Append u w) v)))) *)
exists w.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
exists u; auto.
Qed.


Definition Derivestar_P_A_2 := Rstar Conf Derive_P_A_2.

Lemma Der_cons_inv :
 forall (x : Elt) (u v : Word),
 dans x X ->
 Derivestar_P_A_2 (cons x u, v) (nil, nil) ->
 ex2 (fun v2 : Word => v = cons x v2)
   (fun v2 : Word => Derivestar_P_A_2 (u, v2) (nil, nil)).
(* Goal: forall (x : Elt) (u v : Word) (_ : dans x X) (_ : Derivestar_P_A_2 (@pair Word Word (cons x u) v) (@pair Word Word nil nil)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
intros x u v dans_x_X Der_star.
elimtype
 ((cons x u, v) = (nil, nil) \/
  ex2 (fun z : Conf => Derive_P_A_2 (cons x u, v) z)
    (fun z : Conf => Rstar (Word * Word) Derive_P_A_2 z (nil, nil))).
(* Goal: forall _ : @eq Elt (couple (word w1) (couple x0 (word w2))) (couple (word (cons (first r) nil)) (couple (eps X) (second r))), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
intro eg.
(* Goal: @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
absurd (cons x u = nil).
(* Goal: not (@eq Word (cons x0 (Append w v)) nil) *)
(* Goal: @eq Word (cons x0 (Append w v)) nil *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
discriminate.

(* Goal: @eq Word (cons x u) nil *)
(* Goal: forall _ : @ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
change (fst (cons x u, v) = fst (nil, nil)) in |- *.
(* Goal: @eq Word (@fst Word Word (@pair Word Word (cons x u) v)) (@fst Word Word (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply (f_equal (fst (A:=Word) (B:=Word))).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall _ : @ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
intro temp; elim temp; clear temp; intros z Der Der_star_2.
(* Goal: @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
cut (Derive_P_A_2_nind (cons x u, v) z).
(* Goal: forall _ : Derive_P_A_2_nind (@pair Word Word (cons x u) v) z, @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
unfold Derive_P_A_2_nind in |- *.
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) (cons x0 u0)) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) (cons x0 v0)) (fun w : Word => Deriveg X R v w) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intro temp; elim temp; clear temp; intro temp; elim temp; clear temp.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intros x0 dans_x0_X temp; elim temp; clear temp.
(* Goal: forall (_ : @eq Word (cons x u) (cons x0 (@fst Word Word z))) (_ : @eq Word v (cons x0 (@snd Word Word z))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
intros eg_cons_x_x0 eg_v_cons.
(* Goal: @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
exists (snd z).
(* Goal: @eq Word v (cons x (@snd Word Word z)) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word u (@snd Word Word z)) (@pair Word Word nil nil) *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
replace x with x0.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Elt x0 x *)
(* Goal: Derivestar_P_A_2 (@pair Word Word u (@snd Word Word z)) (@pair Word Word nil nil) *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply cons_cons_inv1 with (fst z) u.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
unfold Derivestar_P_A_2 in |- *.
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word u (@snd Word Word z)) (@pair Word Word nil nil) *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
replace u with (fst z).
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word (@fst Word Word z) (@snd Word Word z)) (@pair Word Word nil nil) *)
(* Goal: @eq Word (@fst Word Word z) u *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
cut (Rstar (Word * Word) Derive_P_A_2 z (nil, nil)).
(* Goal: forall _ : Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil), Rstar Conf Derive_P_A_2 (@pair Word Word (@fst Word Word z) (@snd Word Word z)) (@pair Word Word nil nil) *)
(* Goal: Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil) *)
(* Goal: @eq Word (@fst Word Word z) u *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
elim z.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (@fst Word Word z) u *)
(* Goal: forall (x0 : Elt) (_ : @ex2 Word (fun w : Word => @eq Word (cons x0 w) (@fst Word Word (@pair Word Word (cons x u) v))) (fun w : Word => @ex2 Word (fun u : Word => dans (couple x0 (word u)) R) (fun u : Word => @eq Word (Append u w) (@fst Word Word z)))), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply cons_cons_inv2 with x0 x.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
intros x0 temp; elim temp; clear temp; intros w eg temp; elim temp;
 clear temp.
(* Goal: forall (x1 : Word) (_ : dans (couple x0 (word x1)) R) (_ : @eq Word (Append x1 w) (@fst Word Word z)), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
intros u0 dans_couple.
(* Goal: forall _ : @eq Word (Append u0 w) (@fst Word Word z), @ex2 Word (fun v2 : Word => @eq Word v (cons x v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word u v2) (@pair Word Word nil nil)) *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
absurd (dans x0 V).
(* Goal: not (dans x0 V) *)
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply inter_dans with X.
(* Goal: inter X V empty *)
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
exact (isGram2 X V R S' Gram).
(* Goal: dans x0 X *)
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
replace x0 with x.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Elt x x0 *)
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply cons_cons_inv1 with u w.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: dans x0 V *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply Regles_inv1 with X R (word u0).
(* Goal: Regles X V R *)
(* Goal: dans (couple x0 (word u0)) R *)
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
exact Regles_X_V_R.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derive_P_A_2_nind (@pair Word Word (cons x u) v) z *)
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply Derive_P_A_2_inv.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: or (@eq (prod Word Word) (@pair Word Word (cons x u) v) (@pair Word Word nil nil)) (@ex2 Conf (fun z : Conf => Derive_P_A_2 (@pair Word Word (cons x u) v) z) (fun z : Conf => Rstar (prod Word Word) Derive_P_A_2 z (@pair Word Word nil nil))) *)
apply Rstar_inv.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.


Lemma Derive_P_A_2_imp_Der_P_A_2_App :
 forall x y : Word,
 Derivestar_P_A_2 (x, y) (nil, nil) ->
 forall u v : Word,
 Append u v = x ->
 inmonoid X u ->
 ex2 (fun w : Word => Append u w = y)
   (fun w : Word => Derivestar_P_A_2 (v, w) (nil, nil)).
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
unfold Derivestar_P_A_2 in |- *.
(* Goal: forall (x : Word) (_ : inmonoid X x), Rstar Conf Derive_P_A_2 (@pair Word Word x x) (@pair Word Word nil nil) *)
simple induction x.
(* Goal: forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word nil y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) nil) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros y Der_P_A_2 u v.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
elimtype (u = nil \/ (exists w : Word, (exists x : Elt, u = cons x w))).
(* Goal: forall _ : @eq Word u nil, @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros u_eg.
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: forall (_ : @eq Word (Append nil v) nil) (_ : inmonoid X nil), @ex2 Word (fun w : Word => @eq Word (Append nil w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall (_ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) (_ : @eq Word (Append u v) nil) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros App_eg inmon_nil.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
exists y; auto.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
replace v with nil; trivial.

(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intro temp; elim temp; clear temp; intros w temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : @eq Word u (cons x w)) (_ : @eq Word (Append u v) nil) (_ : inmonoid X u), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros x0 eg_u.
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
(* Goal: forall (_ : @eq Word (Append (cons x0 w) v) nil) (_ : inmonoid X (cons x0 w)), @ex2 Word (fun w0 : Word => @eq Word (Append (cons x0 w) w0) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros cons_eg_nil.
(* Goal: forall _ : inmonoid X (cons x0 w), @ex2 Word (fun w0 : Word => @eq Word (Append (cons x0 w) w0) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
absurd (cons x0 (Append w v) = nil).
(* Goal: not (@eq Word (cons x0 (Append w v)) nil) *)
(* Goal: @eq Word (cons x0 (Append w v)) nil *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
discriminate.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
generalize u; clear u; simple induction u.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
intros x1 w1 Hyp; apply or_intror; exists w1; exists x1; trivial.

(* Goal: forall (e : Elt) (w : Word) (_ : forall (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word w y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) w) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil))) (y : Word) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) y) (@pair Word Word nil nil)) (u v : Word) (_ : @eq Word (Append u v) (cons e w)) (_ : inmonoid X u), @ex2 Word (fun w0 : Word => @eq Word (Append u w0) y) (fun w0 : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w0) (@pair Word Word nil nil)) *)
intros x0 w Hyp y Der_star_cons u v App_eg inmon_X.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
elimtype (u = nil \/ (exists w : Word, (exists x : Elt, u = cons x w))).
(* Goal: forall _ : @eq Word u nil, @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros u_eg.
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append nil w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace v with (cons x0 w).
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
exists y; trivial.
(* Goal: @eq Word (cons x0 w) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace v with (Append u v).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (Append u v) v *)
(* Goal: forall _ : @ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w))), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite u_eg.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cut1 (cons x0 u)) w) (cons x0 v)) (fun w : Word => Deriveg X R (cut2 (cons x0 u)) w) *)
intro temp; elim temp; clear temp; intros w1 temp; elim temp; clear temp.
(* Goal: forall (x : Elt) (_ : @eq Word u (cons x w1)), @ex2 Word (fun w : Word => @eq Word (Append u w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros x1 eg_u.
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
elimtype
 (ex2 (fun v2 : Word => y = cons x0 v2)
    (fun v2 : Word => Derivestar_P_A_2 (w, v2) (nil, nil))).
(* Goal: forall (x : Word) (_ : @eq Word y (cons x0 x)) (_ : Derivestar_P_A_2 (@pair Word Word w x) (@pair Word Word nil nil)), @ex2 Word (fun w : Word => @eq Word (Append (cons x1 w1) w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros v2 y_eg Der_w_v2.
elimtype
 (ex2 (fun w : Word => Append w1 w = v2)
    (fun w : Word => Rstar Conf Derive_P_A_2 (v, w) (nil, nil))).
(* Goal: forall (x : Word) (_ : @eq Word (Append w1 x) v2) (_ : Rstar Conf Derive_P_A_2 (@pair Word Word v x) (@pair Word Word nil nil)), @ex2 Word (fun w : Word => @eq Word (Append (cons x1 w1) w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
intros we App_w1_we_eg_v2 Rstar_Der.
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cons x1 w1) w) y) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
exists we.
(* Goal: @eq Word (Append (cons x1 w1) we) y *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite y_eg.
(* Goal: @eq Word (Append (cons x1 w1) we) (cons x0 v2) *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace (Append (cons x1 w1) we) with (cons x1 (Append w1 we)).
(* Goal: @eq Word (cons x1 (Append w1 we)) (cons x0 v2) *)
(* Goal: @eq Word (cons x1 (Append w1 we)) (Append (cons x1 w1) we) *)
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word v we) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append w1 w) v2) (fun w : Word => Rstar Conf Derive_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons.
(* Goal: @eq Elt x1 x0 *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons_inv1 with (Append w1 v) w.
(* Goal: @eq Word (cons x1 (Append w1 v)) (cons x0 w) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite <- App_eg.
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append w1 v) w *)
(* Goal: inmonoid X w1 *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons_inv2 with x1 x0.
(* Goal: @eq Word (cons x1 (Append w1 v)) (cons x0 w) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite <- App_eg.
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: inmonoid X w1 *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word y (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word w v2) (@pair Word Word nil nil)) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply inmonoid_cons_inv with x1.
(* Goal: inmonoid X (cons x1 w1) *)
(* Goal: @eq Elt x1 x0 *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite <- eg_u.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
apply Der_cons_inv.
(* Goal: dans x0 X *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
replace x0 with x1.
(* Goal: dans x1 X *)
(* Goal: @eq Elt x1 x0 *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply inmonoid_cons_inv2 with w1.
(* Goal: inmonoid X (cons x1 w1) *)
(* Goal: @eq Elt x1 x0 *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite <- eg_u.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Elt x1 x0 *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
apply cons_cons_inv1 with (Append w1 v) w.
(* Goal: @eq Word (cons x1 (Append w1 v)) (cons x0 w) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite <- App_eg.
(* Goal: @eq Word (cons x1 (Append w1 v)) (Append u v) *)
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 w) y) (@pair Word Word nil nil) *)
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
rewrite eg_u.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
clear inmon_X App_eg.
(* Goal: or (@eq Word u nil) (@ex Word (fun w : Word => @ex Elt (fun x : Elt => @eq Word u (cons x w)))) *)
generalize u; clear u; simple induction u.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
intros x1 w1 tmp; apply or_intror; exists w1; exists x1; trivial.

Qed.


Lemma Derive_P_A_2_imp_Der_P_A_2_cons :
 forall (u : Elt) (x y : Word),
 Derivestar_P_A_2 (cons u x, y) (nil, nil) ->
 dans u X ->
 ex2 (fun w : Word => cons u w = y)
   (fun w : Word => Derivestar_P_A_2 (x, w) (nil, nil)).
(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
elimtype
 (ex2 (fun w : Word => Append (cons u nil) w = y)
    (fun w : Word => Derivestar_P_A_2 (x, w) (nil, nil))).
(* Goal: forall (x0 : Word) (_ : @eq Word (Append (cons u nil) x0) y) (_ : Derivestar_P_A_2 (@pair Word Word x x0) (@pair Word Word nil nil)), @ex2 Word (fun w : Word => @eq Word (cons u w) y) (fun w : Word => Derivestar_P_A_2 (@pair Word Word x w) (@pair Word Word nil nil)) *)
(* Goal: @ex2 Word (fun w : Word => @eq Word (Append (cons u nil) w) y) (fun w : Word => Derivestar_P_A_2 (@pair Word Word x w) (@pair Word Word nil nil)) *)
intros w eg_App Der.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
exists w; trivial.

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
apply Derive_P_A_2_imp_Der_P_A_2_App with (cons u x); auto.
Qed.


Lemma Derivestar_P_A_2_x :
 forall x : Word, inmonoid X x -> Derivestar_P_A_2 (x, x) (nil, nil).
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
unfold Derivestar_P_A_2 in |- *.
(* Goal: forall (x : Word) (_ : inmonoid X x), Rstar Conf Derive_P_A_2 (@pair Word Word x x) (@pair Word Word nil nil) *)
simple induction x.
(* Goal: forall _ : inmonoid X nil, Rstar Conf Derive_P_A_2 (@pair Word Word nil nil) (@pair Word Word nil nil) *)
(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : inmonoid X w, Rstar Conf Derive_P_A_2 (@pair Word Word w w) (@pair Word Word nil nil)) (_ : inmonoid X (cons e w)), Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) (cons e w)) (@pair Word Word nil nil) *)
intro.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.
(* Goal: forall (e : Elt) (w : Word) (_ : forall _ : inmonoid X w, Rstar Conf Derive_P_A_2 (@pair Word Word w w) (@pair Word Word nil nil)) (_ : inmonoid X (cons e w)), Rstar Conf Derive_P_A_2 (@pair Word Word (cons e w) (cons e w)) (@pair Word Word nil nil) *)
intros x0 w Hyp inmon.
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 w)) (@pair Word Word nil nil) *)
apply Rstar_R with (w, w).
(* Goal: Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word (cons x0 w) (Append (cons x0 nil) w) *)
(* Goal: @eq Word w (Append nil w) *)
(* Goal: @eq Word nil w2 *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply Derive_X.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv2 with w; assumption.

(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv with x0; assumption.
Qed.
Hint Resolve Derivestar_P_A_2_x.


Lemma Derivegstar_imp_Derivestar_P_A_2 :
 forall x y : Word,
 Derivegstar X R x y -> inmonoid X y -> Derivestar_P_A_2 (x, y) (nil, nil).
(* Goal: forall (x y : Word) (_ : Derivegstar X R x y) (_ : inmonoid X y), Derivestar_P_A_2 (@pair Word Word x y) (@pair Word Word nil nil) *)
unfold Derivegstar, Rstar in |- *.
(* Goal: forall (x y : Conf) (_ : forall (P : forall (_ : Conf) (_ : Conf), Prop) (_ : forall u : Conf, P u u) (_ : forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : P v w), P u w), P x y) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
intros x y Der_star.
(* Goal: forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
pattern x, y in |- *.
(* Goal: (fun c c0 : Conf => forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s c) (@pair Word Conf s2 c0))) x y *)
apply Der_star.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (u v w : Word) (_ : Deriveg X R u v) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil) *)
intros u v w Derg_u_v.
(* Goal: forall (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil) *)
generalize w.
(* Goal: forall (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil) *)
elim Derg_u_v.
(* Goal: forall (u v : Word) (A : Elt) (_ : dans (couple A (word u)) R) (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word (Append u v) w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word (cons A v) w) (@pair Word Word nil nil) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil)) (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word (cons x v) w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word (cons x u) w) (@pair Word Word nil nil) *)
intros u0 v0 A dans_couple w0 Hyp inmon_w0.
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
unfold Derivestar_P_A_2 in |- *.
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word (cons A v0) w0) (@pair Word Word nil nil) *)
(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil)) (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word (cons x v) w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word (cons x u) w) (@pair Word Word nil nil) *)
apply Rstar_R with (Append u0 v0, w0).
(* Goal: Derive_P_A_2 (@pair Word Word (cons (first r) w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply Derive_V.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Hyp; assumption.

(* Goal: forall (u v : Word) (x : Elt) (_ : dans x X) (_ : Deriveg X R u v) (_ : forall (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word v w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word u w) (@pair Word Word nil nil)) (w : Word) (_ : forall _ : inmonoid X w, Derivestar_P_A_2 (@pair Word Word (cons x v) w) (@pair Word Word nil nil)) (_ : inmonoid X w), Derivestar_P_A_2 (@pair Word Word (cons x u) w) (@pair Word Word nil nil) *)
intros u0 v0 x0 dans_x0_v0 Der_u0_v0 Hyp1 w0 Hyp2 inmon_w0.

elimtype
 (ex2 (fun v2 : Word => w0 = cons x0 v2)
    (fun v2 : Word => Derivestar_P_A_2 (v0, v2) (nil, nil))).
(* Goal: forall (x : Word) (_ : @eq Word w0 (cons x0 x)) (_ : Derivestar_P_A_2 (@pair Word Word v0 x) (@pair Word Word nil nil)), Derivestar_P_A_2 (@pair Word Word (cons x0 u0) w0) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
intros x1 w0_eg_cons Derivestar_v0_x1.
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) w0) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
rewrite w0_eg_cons.
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
unfold Derivestar_P_A_2 in |- *.
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word (cons x0 u0) (cons x0 x1)) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
apply Rstar_R with (u0, x1).
(* Goal: Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word (cons x0 w) (Append (cons x0 nil) w) *)
(* Goal: @eq Word w (Append nil w) *)
(* Goal: @eq Word nil w2 *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply Derive_X.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Conf Derive_P_A_2 (@pair Word Word u0 x1) (@pair Word Word nil nil) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
apply Hyp1.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: inmonoid X x1 *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
apply inmonoid_cons_inv with x0.
(* Goal: inmonoid X (cons x0 x1) *)
(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
rewrite <- w0_eg_cons.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: @ex2 Word (fun v2 : Word => @eq Word w0 (cons x0 v2)) (fun v2 : Word => Derivestar_P_A_2 (@pair Word Word v0 v2) (@pair Word Word nil nil)) *)
apply Der_cons_inv.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_2 (@pair Word Word (cons x0 v0) w0) (@pair Word Word nil nil) *)
exact (Hyp2 inmon_w0).
Qed.
Hint Resolve Derivegstar_imp_Derivestar_P_A_2.


(*equivalence de Derive_P_A_2 et Derive_P_A*)
(*premiere implication*)

Lemma Derive_P_A_2_imp_Derive_P_A :
 forall x y : Word * Word, Derive_P_A_2 x y -> Derive_P_A X d x y.
(* Goal: forall (x y : prod Word Word) (_ : Derive_P_A X (union (map f_R_d R) (map f_X_d X)) x y), Derive_P_A_2 x y *)
intros x y Der.
(* Goal: Derive_P_A_2 x y *)
elim Der.
(* Goal: forall (w u : Word) (x : Elt) (_ : dans x X), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) (cons x u))) (@pair Word Conf s2 (@pair Word Word w u))) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
intros w u x0 dans_x0_X.
(* Goal: Derive_P_A X d (@pair Word Word (cons x0 w) v) (@pair Word Word (Append u w) v) *)
replace (cons x0 w) with (Append (cons x0 nil) w).
(* Goal: Derive_P_A X d (@pair Word Word (Append (cons x0 nil) w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
pattern w at 2 in |- *.
(* Goal: (fun w0 : Word => Derive_P_A X d (@pair Word Word (Append (cons x0 nil) w) (cons x0 u)) (@pair Word Word w0 u)) w *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
replace w with (Append nil w).
(* Goal: Derive_P_A X d (@pair Word Word (Append (cons x0 nil) w) (cons x0 u)) (@pair Word Word (Append nil w) u) *)
(* Goal: @eq Word (Append nil w) w *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
apply Derive_cons.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold d in |- *.
(* Goal: dans (couple (word (cons x0 nil)) (couple x0 (word nil))) (union (map f_R_d R) (map f_X_d X)) *)
(* Goal: @eq Word (Append nil w) w *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
apply union_d.
(* Goal: dans (couple (word (cons x0 nil)) (couple x0 (word nil))) (map f_X_d X) *)
(* Goal: @eq Word (Append nil w) w *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), Derive_P_A X d (@pair Word Word (cons x w) v) (@pair Word Word (Append u w) v) *)
change (dans (f_X_d x0) (map f_X_d X)) in |- *.
(* Goal: dans (f_R_d (couple x0 (word u))) (map f_R_d R) *)
(* Goal: @eq Elt (f_R_d (couple x0 (word u))) (couple (word (cons x0 nil)) (couple (eps X) (word u))) *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
apply dans_map_inv.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
intros v w u x0 dans_couple.
(* Goal: Derive_P_A X d (@pair Word Word (cons x0 w) v) (@pair Word Word (Append u w) v) *)
replace (cons x0 w) with (Append (cons x0 nil) w).
(* Goal: Derive_P_A X d (@pair Word Word (Append (cons x0 nil) w) v) (@pair Word Word (Append u w) v) *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
apply Derive_eps.
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold d in |- *.
(* Goal: dans (couple (word (cons x0 nil)) (couple (eps X) (word u))) (union (map f_R_d R) (map f_X_d X)) *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
apply union_g.
replace (couple (word (cons x0 nil)) (couple (eps X) (word u))) with
 (f_R_d (couple x0 (word u))).
(* Goal: dans (f_R_d (couple x0 (word u))) (map f_R_d R) *)
(* Goal: @eq Elt (f_R_d (couple x0 (word u))) (couple (word (cons x0 nil)) (couple (eps X) (word u))) *)
(* Goal: @eq Word (Append (cons x0 nil) w) (cons x0 w) *)
apply dans_map_inv.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: forall _ : @eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold f_R_d in |- *.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
Qed.
Hint Resolve Derive_P_A_2_imp_Derive_P_A.

Lemma Derivestar_P_A_2_imp_Derivestar_P_A :
 forall x y : Word * Word, Derivestar_P_A_2 x y -> Derivestar_P_A X d x y.
(* Goal: forall (x y : prod Word Word) (_ : Derivestar_P_A_2 x y), Derivestar_P_A X d x y *)
unfold Derivestar_P_A_2, Rstar, Derivestar_P_A in |- *.
(* Goal: forall (x y : prod Word Word) (_ : forall (P : forall (_ : Conf) (_ : Conf), Prop) (_ : forall u : Conf, P u u) (_ : forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : P v w), P u w), P x y), Rstar Conf (Derive_P_A X d) x y *)
intros x y Rstar_Der.
(* Goal: forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
pattern x, y in |- *.
(* Goal: (fun p p0 : prod Word Word => Rstar Conf (Derive_P_A X d) p p0) x y *)
apply Rstar_Der.
(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.
(* Goal: forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : Rstar Conf (Derive_P_A X d) v w), Rstar Conf (Derive_P_A X d) u w *)
intros u v w Hyp1 Hyp2.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
apply Rstar_R with v; auto.
Qed.
Hint Resolve Derivestar_P_A_2_imp_Derivestar_P_A.


(*seconde implication*)

Lemma Derive_P_A_imp_Derive_P_A_2 :
 forall x y : Word * Word, Derive_P_A X d x y -> Derive_P_A_2 x y.
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold d in |- *.
(* Goal: forall (x y : prod Word Word) (_ : Derive_P_A X (union (map f_R_d R) (map f_X_d X)) x y), Derive_P_A_2 x y *)
intros x y Der.
(* Goal: Derive_P_A_2 x y *)
elim Der.
(* Goal: forall (w w1 w2 u : Word) (x : Elt) (_ : dans x X) (_ : dans (couple (word w1) (couple x (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
intros w w1 w2 u x0 dans_x0_X dans_couple_d.
elimtype
 (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R) \/
  dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)).
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros dans_couple.
(* Goal: Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
absurd (dans (eps X) X).
(* Goal: not (dans (eps X) X) *)
(* Goal: dans (eps X) X *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply not_dans_X_eps.
(* Goal: dans (eps X) X *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace (eps X) with x0.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
elimtype
 (exists r : Elt,
    dans r R /\ couple (word w1) (couple x0 (word w2)) = f_R_d r).
(* Goal: forall (x : Elt) (_ : and (dans x R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d x))), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
intros r temp; elim temp; clear temp; intros dans_r_R.
(* Goal: forall _ : @eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold f_R_d in |- *.
(* Goal: forall _ : @eq Elt (couple (word w1) (couple x0 (word w2))) (couple (word (cons (first r) nil)) (couple (eps X) (second r))), @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
intro eg.
(* Goal: @eq Elt x0 (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply couple_couple_inv1 with (word w2) (second r).
(* Goal: @eq Elt (couple x0 (word w2)) (couple (eps X) (second r)) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply couple_couple_inv2 with (word w1) (word (cons (first r) nil)).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros dans_couple.
elimtype
 (exists r : Elt,
    dans r X /\ couple (word w1) (couple x0 (word w2)) = f_X_d r).
(* Goal: forall (x : Elt) (_ : and (dans x X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d x))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros r temp; elim temp; clear temp; intros dans_r_X eg.

(* Goal: Derive_P_A_2 (@pair Word Word (Append w1 w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace w1 with (cons x0 nil).
(* Goal: Derive_P_A_2 (@pair Word Word (Append (cons x0 nil) w) (cons x0 u)) (@pair Word Word (Append w2 w) u) *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace w2 with nil.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word nil w2 *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace (Append nil w) with w.
(* Goal: Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word w (Append nil w) *)
(* Goal: @eq Word nil w2 *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace (Append (cons x0 nil) w) with (cons x0 w).
(* Goal: Derive_P_A_2 (@pair Word Word (cons x0 w) (cons x0 u)) (@pair Word Word w u) *)
(* Goal: @eq Word (cons x0 w) (Append (cons x0 nil) w) *)
(* Goal: @eq Word w (Append nil w) *)
(* Goal: @eq Word nil w2 *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply Derive_X.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply word_word_inv.
(* Goal: @eq Elt (word nil) (word w2) *)
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply couple_couple_inv2 with r x0.
(* Goal: @eq Elt (couple r (word nil)) (couple (eps X) (word w2)) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv2 with (word (cons r nil)) (word w1).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (cons x0 nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
replace x0 with r.
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply word_word_inv.
(* Goal: @eq Elt (word (cons r nil)) (word w1) *)
(* Goal: @eq Elt r x0 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple x0 (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple x0 (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple x0 (word w2))) (map f_X_d X)) *)
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
apply couple_couple_inv1 with (couple r (word nil)) (couple x0 (word w2)).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Elt r (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv1 with (word nil) (word w2).
(* Goal: @eq Elt (couple r (word nil)) (couple (eps X) (word w2)) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv2 with (word (cons r nil)) (word w1).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
unfold d in |- *.
(* Goal: forall (w w1 w2 u : Word) (_ : dans (couple (word w1) (couple (eps X) (word w2))) (union (map f_R_d R) (map f_X_d X))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
intros w w1 w2 u dans_couple_d.
elimtype
 (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R) \/
  dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)).
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros dans_couple.
(*   Apply Derive_V.*)
elimtype
 (exists r : Elt,
    dans r R /\ couple (word w1) (couple (eps X) (word w2)) = f_R_d r).
(* Goal: forall (x : Elt) (_ : and (dans x R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d x))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros r temp; elim temp; clear temp; intros dans_r_R eg.
(* Goal: Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace w1 with (cons (first r) nil).
(* Goal: Derive_P_A_2 (@pair Word Word (Append (cons (first r) nil) w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace (Append (cons (first r) nil) w) with (cons (first r) w).
(* Goal: Derive_P_A_2 (@pair Word Word (cons (first r) w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply Derive_V.
(* Goal: dans (couple (first r) (word w2)) R *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace (word w2) with (second r).
elimtype
 (ex2 (fun A : Elt => dans A V)
    (fun A : Elt =>
     ex2 (fun B : Word => r = couple A (word B))
       (fun B : Word => inmonoid (union X V) B))).
(* Goal: forall (x : Elt) (_ : dans x V) (_ : @ex2 Word (fun B : Word => @eq Elt r (couple x (word B))) (fun B : Word => inmonoid (union X V) B)), dans (couple (first r) (second r)) R *)
(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros A dans_A_V temp; elim temp; clear temp; intros B eg_r inmon_B.
(* Goal: dans (couple (first r) (second r)) R *)
(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
rewrite eg_r.
(* Goal: dans (couple (first (couple A (word B))) (second (couple A (word B)))) R *)
(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace (first (couple A (word B))) with A.
(* Goal: dans (couple A (second (couple A (word B)))) R *)
(* Goal: @eq Elt A (first (couple A (word B))) *)
(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace (second (couple A (word B))) with (word B).
(* Goal: dans (couple A (word B)) R *)
(* Goal: @eq Elt (word B) (second (couple A (word B))) *)
(* Goal: @eq Elt A (first (couple A (word B))) *)
(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
rewrite <- eg_r.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: @ex2 Elt (fun A : Elt => dans A V) (fun A : Elt => @ex2 Word (fun B : Word => @eq Elt r (couple A (word B))) (fun B : Word => inmonoid (union X V) B)) *)
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply Regles_X_V_R.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt (second r) (word w2) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv2 with (eps X) (eps X).
(* Goal: @eq Elt (couple (eps X) (second r)) (couple (eps X) (word w2)) *)
(* Goal: @eq Word (cons (first r) w) (Append (cons (first r) nil) w) *)
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv2 with (word (cons (first r) nil)) (word w1).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (cons (first r) nil) w1 *)
(* Goal: @ex Elt (fun r : Elt => and (dans r R) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_R_d r))) *)
(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply word_word_inv.
apply
 couple_couple_inv1
  with (couple (eps X) (second r)) (couple (eps X) (word w2)).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.

(* Goal: forall _ : dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intro dans_couple.
elimtype
 (exists r : Elt,
    dans r X /\ couple (word w1) (couple (eps X) (word w2)) = f_X_d r).
(* Goal: forall (x : Elt) (_ : and (dans x X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d x))), Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
intros r temp; elim temp; clear temp; intros dans_r_X eg.
(* Goal: Derive_P_A_2 (@pair Word Word (Append w1 w) u) (@pair Word Word (Append w2 w) u) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
absurd (dans (eps X) X).
(* Goal: not (dans (eps X) X) *)
(* Goal: dans (eps X) X *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply not_dans_X_eps.
(* Goal: dans (eps X) X *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
replace (eps X) with r.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Elt r (eps X) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv1 with (word nil) (word w2).
(* Goal: @eq Elt (couple r (word nil)) (couple (eps X) (word w2)) *)
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply couple_couple_inv2 with (word (cons r nil)) (word w1).
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: @ex Elt (fun r : Elt => and (dans r X) (@eq Elt (couple (word w1) (couple (eps X) (word w2))) (f_X_d r))) *)
(* Goal: or (dans (couple (word w1) (couple (eps X) (word w2))) (map f_R_d R)) (dans (couple (word w1) (couple (eps X) (word w2))) (map f_X_d X)) *)
apply dans_map.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.
Hint Resolve Derive_P_A_imp_Derive_P_A_2.


Lemma Derivestar_P_A_imp_Derivestar_P_A_2 :
 forall x y : Word * Word, Derivestar_P_A X d x y -> Derivestar_P_A_2 x y.
(* Goal: forall (x y : prod Word Word) (_ : Derivestar_P_A X d x y), Derivestar_P_A_2 x y *)
unfold Derivestar_P_A, Rstar, Derivestar_P_A_2 in |- *.
(* Goal: forall (x y : Conf) (_ : forall (P : forall (_ : Conf) (_ : Conf), Prop) (_ : forall u : Conf, P u u) (_ : forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : P v w), P u w), P x y) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
intros x y Der_star.
(* Goal: forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
pattern x, y in |- *.
(* Goal: (fun c c0 : Conf => forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s c) (@pair Word Conf s2 c0))) x y *)
apply Der_star.
(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.
(* Goal: forall (u v w : Conf) (_ : Derive_P_A X d u v) (_ : Rstar Conf Derive_P_A_2 v w), Rstar Conf Derive_P_A_2 u w *)
intros u v w Deri_u_v Rstar_v_w.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
apply Rstar_R with v; auto.
Qed.

Hint Resolve Derivestar_P_A_imp_Derivestar_P_A_2.



(**************************************************************)
(*Tout mot reconnu par la grammaire est reconnu par l'automate*)
(**************************************************************)

Theorem Derivestar_imp_Derivestar_P_A :
 forall x y : Word,
 Derivestar R x y -> inmonoid X y -> Derivestar_P_A X d (x, y) (nil, nil).

(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.
(**************************************************************)




Inductive Derive_P_A_3 : Word * Conf -> Word * Conf -> Prop :=
  | Derive3_X :
      forall (w u s : Word) (x : Elt),
      dans x X ->
      Derive_P_A_3 (s, (cons x w, cons x u)) (Append s (cons x nil), (w, u))
  | Derive3_V :
      forall (v w u s : Word) (x : Elt),
      dans (couple x (word u)) R ->
      Derive_P_A_3 (s, (cons x w, v)) (s, (Append u w, v)).


Definition Derivestar_P_A_3 := Rstar (Word * Conf) Derive_P_A_3.


Lemma Conserve_App_s_u :
 forall s1 s2 u1 u2 v1 v2 : Word,
 Derive_P_A_3 (s1, (u1, v1)) (s2, (u2, v2)) -> Append s1 v1 = Append s2 v2.
(* Goal: forall (s1 s2 u1 u2 v1 v2 : Word) (_ : Derive_P_A_3 (@pair Word (prod Word Word) s1 (@pair Word Word u1 v1)) (@pair Word (prod Word Word) s2 (@pair Word Word u2 v2))), @eq Word (Append s1 v1) (Append s2 v2) *)
intros s1 s2 u1 u2 v1 v2 Derive_P_A_3_s1_v1_s2_v2.
change
  ((fun a b : Word * Conf =>
    Append (fst a) (snd (snd a)) = Append (fst b) (snd (snd b)))
     (s1, (u1, v1)) (s2, (u2, v2))) in |- *.

(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim Derive_P_A_3_s1_v1_s2_v2; simpl in |- *.
(* Goal: forall (_ : Word) (u s : Word) (x : Elt) (_ : dans x X), @eq Word (Append s (cons x u)) (Append (Append s (cons x nil)) u) *)
(* Goal: forall (v _ : Word) (u s : Word) (x : Elt) (_ : dans (couple x (word u)) R), @eq Word (Append s v) (Append s v) *)
intros w u s x dans_x_X.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
replace (cons x u) with (Append (cons x nil) u); trivial.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.


Lemma Derisvestar_P_A_3_conserve :
 forall s1 s2 u1 u2 v1 v2 : Word,
 Derivestar_P_A_3 (s1, (u1, v1)) (s2, (u2, v2)) ->
 Append s1 v1 = Append s2 v2.
(* Goal: forall (x y x' y' s s' : Word) (_ : Derivestar_P_A_3 (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y'))) (_ : inmonoid X s), Derivegstar X R (Append s x) (Append s' x') *)
unfold Derivestar_P_A_3, Rstar in |- *.
(* Goal: forall (s1 s2 u1 u2 v1 v2 : Word) (_ : forall (P : forall (_ : prod Word Conf) (_ : prod Word Conf), Prop) (_ : forall u : prod Word Conf, P u u) (_ : forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : P v w), P u w), P (@pair Word (prod Word Word) s1 (@pair Word Word u1 v1)) (@pair Word (prod Word Word) s2 (@pair Word Word u2 v2))), @eq Word (Append s1 v1) (Append s2 v2) *)
intros s1 s2 u1 u2 v1 v2 Derivestar_P_A_3_s1_v1_s2_v2.
change
  ((fun a b : Word * Conf =>
    Append (fst a) (snd (snd a)) = Append (fst b) (snd (snd b)))
     (s1, (u1, v1)) (s2, (u2, v2))) in |- *.

(* Goal: (fun a b : prod Word Conf => @eq Word (Append (@fst Word Conf a) (@snd Word Word (@snd Word Conf a))) (Append (@fst Word Conf b) (@snd Word Word (@snd Word Conf b)))) (@pair Word (prod Word Word) s1 (@pair Word Word u1 v1)) (@pair Word (prod Word Word) s2 (@pair Word Word u2 v2)) *)
apply Derivestar_P_A_3_s1_v1_s2_v2.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros u v w.
(* Goal: forall (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim u. intros uu1 uuc. elim uuc. intros uu2 uu3.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim v. intros vv1 vvc. elim vvc. intros vv2 vv3.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf uu1 (@pair Word Word uu2 uu3)) (@pair Word Conf vv1 (@pair Word Word vv2 vv3))) (_ : @eq Word (Append vv1 vv3) (Append (@fst Word Conf w) (@snd Word Word (@snd Word Conf w)))), @eq Word (Append uu1 uu3) (Append (@fst Word Conf w) (@snd Word Word (@snd Word Conf w))) *)
intros Der eg1.
(* Goal: @eq Word (Append uu1 uu3) (Append (@fst Word Conf w) (@snd Word Word (@snd Word Conf w))) *)
rewrite <- eg1.
(* Goal: @eq Word (Append uu1 uu3) (Append vv1 vv3) *)
apply Conserve_App_s_u with uu2 vv2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.


Lemma Derive_P_A_2_imp_Derive_P_A_3 :
 forall (s : Word) (x y : Conf),
 Derive_P_A_2 x y -> exists s2 : Word, Derive_P_A_3 (s, x) (s2, y).
(* Goal: forall (s : Word) (x y : Conf) (_ : Derive_P_A_2 x y), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
intros s x y Derive_P_A_2_x_y.
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
elim Derive_P_A_2_x_y.
(* Goal: forall (w u : Word) (x : Elt) (_ : dans x X), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) (cons x u))) (@pair Word Conf s2 (@pair Word Word w u))) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
intros w u x0 dans_x0_X.
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x0 w) (cons x0 u))) (@pair Word Conf s2 (@pair Word Word w u))) *)
(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
exists (Append s (cons x0 nil)).
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derive3_X; assumption.

(* Goal: forall (v w u : Word) (x : Elt) (_ : dans (couple x (word u)) R), @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s (@pair Word Word (cons x w) v)) (@pair Word Conf s2 (@pair Word Word (Append u w) v))) *)
intros v w u x0 dans_couple.
(* Goal: forall (u : Conf) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 u)) *)
(* Goal: forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s v) (@pair Word Conf s2 w))) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
intros; exists s.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derive3_V; assumption.
Qed.


Lemma Derivestar_P_A_2_imp_Derivestar_P_A_3 :
 forall x y : Conf,
 Derivestar_P_A_2 x y ->
 forall s : Word, exists s2 : Word, Derivestar_P_A_3 (s, x) (s2, y).
(* Goal: forall (x y : Conf) (_ : Derivestar_P_A_2 x y) (s : Word), @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
unfold Derivestar_P_A_2, Rstar, Derivestar_P_A_3 in |- *.
(* Goal: forall (x y : Conf) (_ : forall (P : forall (_ : Conf) (_ : Conf), Prop) (_ : forall u : Conf, P u u) (_ : forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : P v w), P u w), P x y) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
intros x y Der_star.
(* Goal: forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s x) (@pair Word Conf s2 y)) *)
pattern x, y in |- *.
(* Goal: (fun c c0 : Conf => forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s c) (@pair Word Conf s2 c0))) x y *)
apply Der_star.
(* Goal: forall (u : Conf) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 u)) *)
(* Goal: forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s v) (@pair Word Conf s2 w))) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
intros; exists s.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.

(* Goal: forall (u v w : Conf) (_ : Derive_P_A_2 u v) (_ : forall s : Word, @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s v) (@pair Word Conf s2 w))) (s : Word), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
intros u v w Der_u_v Ex_v_w s.
(* Goal: @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
elimtype (exists s2 : Word, Derive_P_A_3 (s, u) (s2, v)).
(* Goal: forall (x : Word) (_ : Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf x v)), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 v)) *)
intros s1 Der_3_s_u_s1_v.
(* Goal: @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 v)) *)
elim (Ex_v_w s1).
(* Goal: forall (x : Word) (_ : Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s1 v) (@pair Word Conf x w)), @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 v)) *)
intros s2 Rstar_s1_v_s2_w.
(* Goal: @ex Word (fun s2 : Word => Rstar (prod Word Conf) Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 w)) *)
(* Goal: @ex Word (fun s2 : Word => Derive_P_A_3 (@pair Word Conf s u) (@pair Word Conf s2 v)) *)
exists s2.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Rstar_R with (s1, v); trivial.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derive_P_A_2_imp_Derive_P_A_3; assumption.
Qed.


Lemma Deriveg_imp_Deriveg_App_2 :
 forall x y a : Word,
 inmonoid X a -> Deriveg X R x y -> Deriveg X R (Append a x) (Append a y).
(* Goal: forall (x y a : Word) (_ : inmonoid X a) (_ : Deriveg X R x y), Deriveg X R (Append a x) (Append a y) *)
intros x y.
(* Goal: forall (a : Word) (_ : inmonoid X a) (_ : Deriveg X R x y), Deriveg X R (Append a x) (Append a y) *)
simple induction a.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (e : Elt) (w : Word) (_ : forall (_ : inmonoid X w) (_ : Deriveg X R x y), Deriveg X R (Append w x) (Append w y)) (_ : inmonoid X (cons e w)) (_ : Deriveg X R x y), Deriveg X R (Append (cons e w) x) (Append (cons e w) y) *)
intros x0 w Hyp inmonoid_X_cons_x0_w Der_x_y.
(* Goal: Deriveg X R (Append (cons x0 w) x) (Append (cons x0 w) y) *)
change (Deriveg X R (cons x0 (Append w x)) (cons x0 (Append w y))) in |- *.
(* Goal: Deriveg X R (cons x0 (Append w x)) (cons x0 (Append w y)) *)
apply Deriveg2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv2 with w; assumption.
(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply inmonoid_cons_inv with x0; assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.


Lemma Derive_P_A_3_imp_Derivegstar :
 forall x y x' y' s s' : Word,
 Derive_P_A_3 (s, (x, y)) (s', (x', y')) ->
 inmonoid X s -> Derivegstar X R (Append s x) (Append s' x').
(* Goal: forall (x y x' y' s s' : Word) (_ : Derive_P_A_3 (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y'))) (_ : inmonoid X s), inmonoid X s' *)
intros x y x' y' s s' Der.
change
  ((fun a a' : Word * Conf =>
    inmonoid X (fst a) ->
    Derivegstar X R (Append (fst a) (fst (snd a)))
      (Append (fst a') (fst (snd a')))) (s, (x, y)) 
     (s', (x', y'))) in |- *.

(* Goal: (fun a a' : prod Word Conf => forall _ : inmonoid X (@fst Word Conf a), Derivegstar X R (Append (@fst Word Conf a) (@fst Word Word (@snd Word Conf a))) (Append (@fst Word Conf a') (@fst Word Word (@snd Word Conf a')))) (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y')) *)
unfold Derivegstar in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim Der; simpl in |- *.
(* Goal: forall (w _ : Word) (s : Word) (x : Elt) (_ : dans x X) (_ : inmonoid X s), Rstar Word (Deriveg X R) (Append s (cons x w)) (Append (Append s (cons x nil)) w) *)
(* Goal: forall (_ : Word) (w u s : Word) (x : Elt) (_ : dans (couple x (word u)) R) (_ : inmonoid X s), Rstar Word (Deriveg X R) (Append s (cons x w)) (Append s (Append u w)) *)
intros w u s0 x0 dans_x0_X inmon_s.
replace (Append (Append s0 (cons x0 nil)) w) with
 (Append s0 (Append (cons x0 nil) w)).
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.

(* Goal: forall (_ : Word) (w u s : Word) (x : Elt) (_ : dans (couple x (word u)) R) (_ : inmonoid X s), Rstar Word (Deriveg X R) (Append s (cons x w)) (Append s (Append u w)) *)
intros v w u s0 x0 dans_couple_x0_u_R inmon_s.
(* Goal: Rstar Word (Deriveg X R) (Append s0 (cons x0 w)) (Append s0 (Append u w)) *)
apply Rstar_R with (Append s0 (Append u w)).
(* Goal: Deriveg X R (Append s0 (cons x0 w)) (Append s0 (Append u w)) *)
(* Goal: Rstar Word (Deriveg X R) (Append s0 (Append u w)) (Append s0 (Append u w)) *)
apply Deriveg_imp_Deriveg_App_2.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Deriveg X R (cons x0 w) (Append u w) *)
(* Goal: Rstar Word (Deriveg X R) (Append s0 (Append u w)) (Append s0 (Append u w)) *)
apply Deriveg1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.
Qed.


Lemma Derive_P_A_3_conserve_inmonoid_s :
 forall x y x' y' s s' : Word,
 Derive_P_A_3 (s, (x, y)) (s', (x', y')) -> inmonoid X s -> inmonoid X s'.
(* Goal: forall (x y x' y' s s' : Word) (_ : Derive_P_A_3 (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y'))) (_ : inmonoid X s), inmonoid X s' *)
intros x y x' y' s s' Der.
change
  ((fun a a' : Word * Conf => inmonoid X (fst a) -> inmonoid X (fst a'))
     (s, (x, y)) (s', (x', y'))) in |- *.

(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim Der; simpl in |- *.
(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
apply inmonoid_Append; auto.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.


Lemma Derivestar_P_A_3_imp_Derivegstar :
 forall x y x' y' s s' : Word,
 Derivestar_P_A_3 (s, (x, y)) (s', (x', y')) ->
 inmonoid X s -> Derivegstar X R (Append s x) (Append s' x').
(* Goal: forall (x y x' y' s s' : Word) (_ : Derivestar_P_A_3 (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y'))) (_ : inmonoid X s), Derivegstar X R (Append s x) (Append s' x') *)
unfold Derivestar_P_A_3, Rstar in |- *.
(* Goal: forall (x y x' y' s s' : Word) (_ : forall (P : forall (_ : prod Word Conf) (_ : prod Word Conf), Prop) (_ : forall u : prod Word Conf, P u u) (_ : forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : P v w), P u w), P (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y'))) (_ : inmonoid X s), Derivegstar X R (Append s x) (Append s' x') *)
intros x y x' y' s s' Der_star.
change
  ((fun a a' : Word * Conf =>
    inmonoid X (fst a) ->
    Derivegstar X R (Append (fst a) (fst (snd a)))
      (Append (fst a') (fst (snd a')))) (s, (x, y)) 
     (s', (x', y'))) in |- *.

(* Goal: (fun a a' : prod Word Conf => forall _ : inmonoid X (@fst Word Conf a), Derivegstar X R (Append (@fst Word Conf a) (@fst Word Word (@snd Word Conf a))) (Append (@fst Word Conf a') (@fst Word Word (@snd Word Conf a')))) (@pair Word (prod Word Word) s (@pair Word Word x y)) (@pair Word (prod Word Word) s' (@pair Word Word x' y')) *)
apply Der_star; unfold Derivegstar in |- *.

(* Goal: forall (u : prod Word Conf) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros.
(* Goal: Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) *)
(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_reflexive.

(* Goal: forall (u v w : prod Word Conf) (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros u v w.
(* Goal: forall (_ : Derive_P_A_3 u v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf u)), Rstar Word (Deriveg X R) (Append (@fst Word Conf u) (@fst Word Word (@snd Word Conf u))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim u. intros u1 uc. elim uc. intros u2 u3.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) v) (_ : forall _ : inmonoid X (@fst Word Conf v), Rstar Word (Deriveg X R) (Append (@fst Word Conf v) (@fst Word Word (@snd Word Conf v))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
elim v. intros v1 vc. elim vc. intros v2 v3.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))) (@fst Word Word (@snd Word Conf (@pair Word Conf v1 (@pair Word Word v2 v3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3)))), Rstar Word (Deriveg X R) (Append (@fst Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))) (@fst Word Word (@snd Word Conf (@pair Word Conf u1 (@pair Word Word u2 u3))))) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
simpl in |- *.
(* Goal: forall (_ : Derive_P_A_3 (@pair Word Conf u1 (@pair Word Word u2 u3)) (@pair Word Conf v1 (@pair Word Word v2 v3))) (_ : forall _ : inmonoid X v1, Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w)))) (_ : inmonoid X u1), Rstar Word (Deriveg X R) (Append u1 u2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
intros Der_3_u_v Hyp inmon_u1.
(* Goal: Rstar Word (Deriveg X R) (Append u1 u2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Rstar_transitive with (Append v1 v2). 
(* Goal: Rstar Word (Deriveg X R) (Append u1 u2) (Append v1 v2) *)
(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
change (Derivegstar X R (Append u1 u2) (Append v1 v2)) in |- *.
(* Goal: Derivegstar X R (Append u1 u2) (Append v1 v2) *)
(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Derive_P_A_3_imp_Derivegstar with u3 v3.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Rstar Word (Deriveg X R) (Append v1 v2) (Append (@fst Word Conf w) (@fst Word Word (@snd Word Conf w))) *)
apply Hyp.
(* Goal: inmonoid X v1 *)
apply Derive_P_A_3_conserve_inmonoid_s with u2 u3 v2 v3 u1.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
Qed.


(*Tout mot reconnu par l'automate est reconnu par la grammaire*)

Theorem Derivestar_P_A_imp_Derivestar :
 forall x y : Word, Derivestar_P_A X d (x, y) (nil, nil) -> Derivestar R x y.
(* Goal: forall (x y : Word) (_ : Derivestar_P_A X d (@pair Word Word x y) (@pair Word Word nil nil)), Derivestar R x y *)
intros x y Derivestar_P_A_x_y_nil_nil.
(* Goal: Derivestar R x y *)
elimtype (exists s2 : Word, Derivestar_P_A_3 (nil, (x, y)) (s2, (nil, nil))).
(* Goal: forall (x0 : Word) (_ : Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) x0 (@pair Word Word nil nil))), Derivestar R x y *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
intros s2 Derivestar_P_A_3_x_y.
(* Goal: Derivestar R x y *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derivegstar_Derivestar with X.
(* Goal: Derivegstar X R x y *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
replace x with (Append nil x).
(* Goal: Derivegstar X R (Append nil x) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
replace y with (Append s2 nil).
(* Goal: Derivegstar X R (Append nil x) (Append s2 nil) *)
(* Goal: @eq Word (Append s2 nil) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derivestar_P_A_3_imp_Derivegstar with y nil.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append s2 nil) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
replace y with (Append nil y).
(* Goal: @eq Word (Append s2 nil) (Append nil y) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply sym_equal.
(* Goal: @eq Word (Append nil y) (Append s2 nil) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derisvestar_P_A_3_conserve with x nil.
(* Goal: Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil)) *)
(* Goal: @eq Word (Append nil y) y *)
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
assumption.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.
(* Goal: @eq Word (Append nil x) x *)
(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
trivial.

(* Goal: @ex Word (fun s2 : Word => Derivestar_P_A_3 (@pair Word (prod Word Word) nil (@pair Word Word x y)) (@pair Word (prod Word Word) s2 (@pair Word Word nil nil))) *)
apply Derivestar_P_A_2_imp_Derivestar_P_A_3.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.

Hint Resolve Derivestar_P_A_imp_Derivestar.



(******************************************)
(*equivalence de G et de l'automate a pile*)
(******************************************)

Theorem equiv_APD_Gram : l_egal (LA X wd wa d) (LG X V R S').
(* Goal: l_egal (LA X wd wa d) (LG X V R S') *)
red in |- *.
(* Goal: and (l_inclus (LA X wd wa d) (LG X V R S')) (l_inclus (LG X V R S') (LA X wd wa d)) *)
unfold l_inclus, LA, LG in |- *.
(* Goal: and (forall (w : Word) (_ : and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)), and (Derivestar R (cons S' nil) w) (inmonoid X w)) (forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w)) *)
split.
(* Goal: forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
intros w temp; elim temp; intros Der inmon.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
(* Goal: forall (w : Word) (_ : and (Derivestar R (cons S' nil) w) (inmonoid X w)), and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
intros w temp; elim temp; intros Der inmon.
(* Goal: and (Derivestar_P_A X d (@pair Word Word wd w) (@pair Word Word wa nil)) (inmonoid X w) *)
auto.
Qed.


End APD.