unfold reconnait in |- *.
intros.
elim H; clear H.
intros H H2; elim H2; clear H2.
intros e12 H2; elim H2; clear H2.
intros e2 H2; elim H2; clear H2.
intros H2 H3.
split; auto.
exists e0.
exists e2.
split; auto.
elim H3; clear H3; intros H3 H4.
split; auto.
cut (e12 = e :>Elt); auto.
intro H5; rewrite <- H5.
apply
(chemin_cons e12 e2 (add e0 q) (add (couple e0 (couple a e12)) d) w e0 a);
auto.
apply extension_qd; auto.
Qed.
(*									*)
(*  Si un automate (q (singleton e) qa d) reconnait exactement {w0}	*)
(*  et si e0 n'est pas dans q alors l'automate ((add e0 q) 		*)
(*  (singleton e0) qa (add (e0,a,e) d)) reconnait exactement		*)
(*  {cons a w0}.							*)
(*									*)
Axiom
auto_cons :
forall (q qa d : Ensf) (e0 e a : Elt) (w0 : Word),
dans a alph ->
automate q (singleton e) qa d ->
eqwordset (reconnait q (singleton e) qa d) (lword w0) ->
~ dans e0 q ->
eqwordset
(reconnait (add e0 q) (singleton e0) qa
(add (couple e0 (couple a e)) d)) (lword (cons a w0)).
(*--- Cette preuve est correcte mais tres longue : on laisse l'axiome... PASSER CETTE PREUVE EN V5.10  Lemma auto_cons : (q,qa,d:Ensf)(e0,e,a:Elt)(w0:Word) (dans a alph) -> (automate q (singleton e) qa d) -> (eqwordset (reconnait q (singleton e) qa d) (lword w0) ) -> ~(dans e0 q) -> (eqwordset (reconnait (add e0 q) (singleton e0) qa (add (couple e0 (couple a e)) d) ) (lword (cons a w0)) ). Goal. Unfold eqwordset. Unfold lword. Intros q qa d e0 e a w0 dans_a_alph H H0 H1 w; Pattern w; Apply induction_word. Split. Intro. Elim H2; Clear H2. Intros H2 H3; Elim H3; Clear H3. Intros e1 H3; Elim H3; Clear H3. Intros e2 H3; Elim H3; Clear H3. Intros H3 H4; Elim H4; Clear H4. Intros. Cut <Elt>e1=e0; Auto. Intro. Elim H. Intros H7 H8. Cut <Elt>e1=e2. 2:Cut (Chemin e1 e2 (add e0 q) (add (couple e0 (couple a e)) d) nil); Auto. 2:Intro; Cut ( (dans e1 (add e0 q)) /\ (<Elt>e1=e2) ); Auto. 2:Intro H10; Elim H10; Auto. Intro H9. Cut (dans e2 q). 2:Apply (dans_trans e2 qa q); Auto. Intro H10. Absurd (dans e0 q); Auto. Rewrite <- H6. Rewrite H9. Assumption.  Intro. Cut False. Apply False_imp_P. Apply (diff_cons_nil a w0); Auto. Apply (diff_cons_nil a w0); Auto.  Intros. Split. Intro H3; Elim H3; Clear H3. Intros H3 H4; Elim H4; Clear H4. Intros e1 H4; Elim H4; Clear H4. Intros e2 H4; Elim H4; Clear H4. Intros H4 H5; Elim H5; Clear H5. Intros H5 H6.   Cut (Chemin e1 e2 (add e0 q) (add (couple e0 (couple a e)) d) (cons x w1)); Auto. Intro H7; Elim H7; Clear H7. Intros e12 H7; Elim H7; Clear H7. Intros H7 H8; Elim H8; Clear H8. Intros H8 H9; Elim H9; Clear H9. Intros H9 H10. Cut <Elt>e1=e0; Auto. Intro H11; Clear H4.  Cut (inclus d (prodcart q (prodcart alph q))). 2:Apply (automate_def1 q (singleton e) qa d); Auto. Intro H12. Cut (<Elt>(couple e0 (couple a e))=(couple e1 (couple x e12)) \/ (dans (couple e1 (couple x e12)) d)). 2:Apply dans_add; Auto. Intro H4; Elim H4; Clear H4.  Intro. Cut <Elt>a=x. Intro. 2:Cut <Elt>(couple a e)=(couple x e12). 2:Intro. 2:Replace a with (first (couple a e)); Auto. 2:Replace x with (first (couple x e12)); Auto. 2:Apply (f_equal Elt Elt); Auto. 2:Replace (couple a e) with (second (couple e0 (couple a e))); Auto. 2:Replace (couple x e12) with (second (couple e1 (couple x e12))); Auto. 2:Apply (f_equal Elt Elt); Auto.  Apply cons_cons; Auto.  2:Intro. 2:Absurd (dans e0 q); Auto. 2:Cut (dans (couple e1 (couple x e12)) (prodcart q (prodcart alph q))). 2:Intro. 3:Apply (dans_trans (couple e1 (couple x e12)) d); Auto. 2:Cut (dans e1 q). 2:Rewrite H11; Auto. 2:Cut ( (dans e1 q) /\ (dans (couple x e12) (prodcart alph q))); Auto. 2:Intro H14; Elim H14; Clear H14. 2:Auto. 2:Apply coupl2; Auto.  Cut <Elt>e12=e. 2:Replace e12 with (second (second (couple e1 (couple x e12)))); Auto. 2:Replace e with (second (second (couple e0 (couple a e)))); Auto. 2:Apply (f_equal Elt Elt). 2:Apply (f_equal Elt Elt); Auto. Intro.  Cut (chemin e e2 (add e0 q) (add (couple e0 (couple a e)) d) w1). 2:Cut (chemin e12 e2 (add e0 q) (add (couple e0 (couple a e)) d) w1); Auto. 2:Rewrite H14; Auto. Clear H7; Intro H7.  Cut (reconnait q (singleton e) qa d w1). Elim (H0 w1). Auto. Unfold reconnait. Split. Apply (inmonoid_cons_inv alph w1 x); Auto. Exists e. Exists e2. Split; Auto. Split; Auto.  Apply (restriction_aut w1 e0 e e2 e a q d ); Auto. Cut (inclus (singleton e) q). Intro; Apply inclus_singl; Auto. Apply (automate_def2 q (singleton e) qa d); Auto.  Intro H3. Cut ((<Elt>a=x)/\(<Word>w0=w1)). 2:Apply cons_cons_inv; Auto. Intro H4; Elim H4; Clear H4. Intros. Rewrite <- H4. Rewrite <- H5.  Apply extension_aut; Auto. Elim (H0 w0). Auto. Save. ----*)
(*									*)
(*  Un langage reduit a un seul mot est regulier. 			*)
(*  A partir d'un automate qui reconnait {w} on rajoute un nouvel etat	*)
(*  (en utilisant le lemme exist_other) et la relation adequate		*)
(*  pour construire un automate reconnaissant {cons a w}.		*)
(*									*)

Lemma lword_is_regS :
forall w : Word,
inmonoid alph w ->
exists q : Ensf,
(exists e : Elt,
(exists qa : Ensf,
(exists d : Ensf,
automate q (singleton e) qa d /\
eqwordset (reconnait q (singleton e) qa d) (lword w)))).