Section gram5.
Variable X : Ensf.
Variable V1 R1 : Ensf.
Variable S1 : Elt.
Variable V2 R2 : Ensf.
Variable S2 : Elt.
Let S' := zero.
Let G1 := imageGram (injproducg V1) X V1 R1 S1.
Let G2 := imageGram (injproducd V2) X V2 R2 S2.
Let X1' := fst G1.
Let GG1 := snd G1.
Let V1' := fst GG1.
Let GGG1 := snd GG1.
Let R1' := fst GGG1.
Let S1' := snd GGG1.
Let X2' := fst G2.
Let GG2 := snd G2.
Let V2' := fst GG2.
Let GGG2 := snd GG2.
Let R2' := fst GGG2.
Let S2' := snd GGG2.
Let Gim := Gunion_disj_p V1' R1' S1' V2' R2' S2' S'.
Let Vu := fst Gim.
Let C' := snd Gim.
Let Ru := fst C'.
Let Su := snd C'.
Hypothesis Grammaire1 : isGram X V1 R1 S1.
Hypothesis Grammaire2 : isGram X V2 R2 S2.
Hint Resolve Grammaire1.
Hint Resolve Grammaire2.
apply isGram1 with V1 R1 S1.
auto.
Qed.
Hint Resolve Mots_X.
apply isGram2 with R1 S1.
auto.
Qed.
Hint Resolve int_X_V1_empty.
apply isGram2 with R2 S2.
auto.
Qed.
Hint Resolve int_X_V2_empty.
Definition Gunion_disj := Gim.
Let Vim := fst Gunion_disj.
Let GGim := snd Gunion_disj.
Let Rim := fst GGim.
Let Sim := snd GGim.
unfold Id, injproducg in |- *.
simpl in |- *.
intros x dans_x_X.
apply extension_out.
apply inter_dans with X; auto.
Qed.
Hint Resolve Id_injproducg1.
unfold Id, injproducd in |- *.
simpl in |- *.
intros x dans_x_X.
apply extension_out.
apply inter_dans with X; auto.
Qed.
Hint Resolve Id_injproducd2.
red in |- *.
intro dans_S_X.
elimtype (exists w : Word, word w = S').
intro x.
change (word x <> natural 0) in |- *.
discriminate.
apply Mots_X; assumption.
Qed.
Hint Resolve N_dans_S_X.
intros x dans_x_V1.
unfold injproducg, extension in |- *.
elim (extension_spec V1 injgauche x).
intros x0 temp; elim temp; clear temp; intro temp; elim temp; clear temp.
auto.
intros.
absurd (dans x V1); assumption.
Qed.
Hint Resolve injproducg_V1.
apply map_egal.
auto.
Qed.
Hint Resolve map_injproducg_V1.
intros x dans_x_V2.
unfold injproducd, extension in |- *.
elim (extension_spec V2 injdroite x).
intros x0 temp; elim temp; clear temp; intro temp; elim temp; clear temp.
auto.
intros.
absurd (dans x V2); assumption.
Qed.
Hint Resolve injproducd_V2.
apply map_egal.
auto.
Qed.
Hint Resolve map_injproducd_V2.
red in |- *.
replace V1' with (map injgauche V1).
intros.
elimtype (exists y : Elt, dans y V1 /\ S' = (fun e : Elt => couple e zero) y).
intros x temp; elim temp; clear temp.
intros dans_x_V1 S_egal.
absurd (S' = couple x zero).
unfold S', zero in |- *.
discriminate.
auto.
apply (dans_map (fun e : Elt => couple e zero)).
assumption.
unfold V1' in |- *.
simpl in |- *.
auto.
Qed.
Hint Resolve N_dans_S_V1'.
red in |- *.
replace V2' with (map injdroite V2).
unfold injdroite in |- *.
intros.
elimtype (exists y : Elt, dans y V2 /\ S' = (fun e : Elt => couple e un) y).
intros x temp; elim temp; clear temp.
intros dans_x_V2 S_egal.
absurd (S' = couple x un).
unfold S', zero in |- *.
discriminate.
auto.
apply (dans_map (fun e : Elt => couple e un)).
assumption.
unfold V2' in |- *.
simpl in |- *.
auto.
Qed.
Hint Resolve N_dans_S_V2'.
unfold is_mono in |- *.
intros x y dans_x_u dans_y_u.
elimtype (dans x X \/ dans x V1).
intro dans_x.
replace (injproducg V1 x) with x.
elimtype (dans y X \/ dans y V1).
intros dans_y.
replace (injproducg V1 y) with y.
auto.
apply sym_equal; auto.
intros dans_y.
replace (injproducg V1 y) with (injgauche y).
unfold injgauche in |- *.
elim (Mots_X x dans_x).
intros x0 egal_x egal2_x.
absurd (word x0 = couple y zero).
discriminate.
rewrite egal_x; assumption.
apply sym_equal; auto.
auto.
apply sym_equal; auto.
intro dans_x.
replace (injproducg V1 x) with (injgauche x).
elimtype (dans y X \/ dans y V1).
intros dans_y.
replace (injproducg V1 y) with y.
unfold injgauche in |- *.
elim (Mots_X y dans_y).
intros x0 egal_y egal2_y.
absurd (word x0 = couple x zero).
discriminate.
rewrite egal2_y; assumption.
apply sym_equal; auto.
intro.
replace (injproducg V1 y) with (injgauche y).
unfold injgauche in |- *.
intros.
apply couple_couple_inv1 with zero zero; assumption.
apply sym_equal; auto.
auto.
apply sym_equal; auto.
auto.
Qed.
Hint Resolve is_mono_u_X_V1_injproducg_V1.
unfold is_mono in |- *.
intros x y dans_x_u dans_y_u.
elimtype (dans x X \/ dans x V2).
intro dans_x.
replace (injproducd V2 x) with x.
elimtype (dans y X \/ dans y V2).
intros dans_y.
replace (injproducd V2 y) with y.
auto.
apply sym_equal; auto.
intros dans_y.
replace (injproducd V2 y) with (injdroite y).
unfold injdroite in |- *.
elim (Mots_X x dans_x).
intros x0 egal_x egal2_x.
absurd (word x0 = couple y un).
discriminate.
rewrite egal_x; assumption.
apply sym_equal; auto.
auto.
apply sym_equal; auto.
intro dans_x.
replace (injproducd V2 x) with (injdroite x).
elimtype (dans y X \/ dans y V2).
intros dans_y.
replace (injproducd V2 y) with y.
unfold injdroite in |- *.
elim (Mots_X y dans_y).
intros x0 egal_y egal2_y.
absurd (word x0 = couple x un).
discriminate.
rewrite egal2_y; assumption.
apply sym_equal; auto.
intro.
replace (injproducd V2 y) with (injdroite y).
unfold injdroite in |- *.
intros.
apply couple_couple_inv1 with un un; assumption.
apply sym_equal; auto.
auto.
apply sym_equal; auto.
auto.
Qed.
Hint Resolve is_mono_u_X_V2_injproducd_V2.
pattern X at 2 in |- *.
replace X with X1'.
unfold X1', V1', R1', S1', GGG1, GG1, G1 in |- *.
apply egal_LG.
auto.
auto.
red in |- *; auto.
unfold X1' in |- *; simpl in |- *.
apply map_Id.
red in |- *.
auto.
Qed.
Hint Resolve egal_LG_1_1'.
pattern X at 2 in |- *.
replace X with X2'.
unfold X2', V2', R2', S2', GGG2, GG2, G2 in |- *.
apply egal_LG.
auto.
auto.
red in |- *; auto.
unfold X2' in |- *; simpl in |- *.
apply map_Id.
red in |- *.
auto.
Qed.
Hint Resolve egal_LG_2_2'.
unfold X1' in |- *. simpl in |- *.
apply map_Id.
red in |- *.
auto.
Qed.
unfold X2' in |- *. simpl in |- *.
apply map_Id.
red in |- *.
auto.
Qed.
rewrite <- egal_X_X1'.
unfold X1', V1', R1', S1', GGG1, GG1, G1 in |- *.
apply image_isGram.
auto.
change (Mots X1') in |- *.
rewrite egal_X_X1'.
auto.
apply inter_Xim_Vim_empty; auto.
Qed.
Hint Resolve Grammaire1'.
rewrite <- egal_X_X2'.
unfold X2', V2', R2', S2', GGG2, GG2, G2 in |- *.
apply image_isGram.
auto.
change (Mots X2') in |- *.
rewrite egal_X_X2'.
auto.
apply inter_Xim_Vim_empty; auto.
Qed.
Hint Resolve Grammaire2'.
unfold V1', V2' in |- *; simpl in |- *.
unfold inter in |- *.
split; [ auto | split ].
auto.
replace (map (injproducg V1) V1) with (map injgauche V1).
replace (map (injproducd V2) V2) with (map injdroite V2).
intros x dans_map_1 dans_map_2.
elimtype (exists y : Elt, dans y V1 /\ x = injgauche y).
elimtype (exists y : Elt, dans y V2 /\ x = injdroite y).
intros x2 temp; elim temp; clear temp; intros dans_x2_V2 egal_x2.
intros x1 temp; elim temp; clear temp; intros dans_x1_V1 egal_x1.
absurd (zero = un).
unfold zero, un in |- *.
red in |- *.
intro.
cut (0 = 1 :>nat).
change (0 <> 1 :>nat) in |- *.
auto.
change (natural_inv (natural 0) = natural_inv (natural 1) :>nat) in |- *.
apply (f_equal natural_inv); assumption.
apply couple_couple_inv2 with x1 x2.
replace (couple x1 zero) with x.
auto.
apply dans_map; assumption.
apply dans_map; assumption.
auto.
auto.
Qed.
Hint Resolve inter_V1'_V2'_empty.
unfold Ru, Vu, C', Gim in |- *.
apply Gunion_disj_LG.
auto.
auto.
auto.
auto.
auto.
auto.
Qed.
Hint Resolve egal_LG_u_1'_2'.

Theorem union_is_LCF :
l_egal (LG X Vu Ru S') (lunion (LG X V1 R1 S1) (LG X V2 R2 S2)).