Section Confluence_Beta_Delta.
Inductive bd_par_red1 : env -> term -> term -> Prop :=
| par_betad :
forall (e : env) (M M' T : term),
bd_par_red1 (Ax T :: e) M M' ->
forall N N' : term,
bd_par_red1 e N N' -> bd_par_red1 e (App (Abs T M) N) (subst N' M')
| par_delta :
forall (e : env) (d T N : term) (n : nat),
bd_par_red1 e (lift (S n) d) N ->
item (Def d T) e n -> bd_par_red1 e (Ref n) N
| sort_par_red :
forall (e : env) (s : sort), bd_par_red1 e (Srt s) (Srt s)
| ref_par_red : forall (e : env) (n : nat), bd_par_red1 e (Ref n) (Ref n)
| abs_par_red :
forall (e : env) (M M' T T' : term),
bd_par_red1 (Ax T' :: e) M M' ->
bd_par_red1 e T T' -> bd_par_red1 e (Abs T M) (Abs T' M')
| app_par_red :
forall (e : env) (M M' : term),
bd_par_red1 e M M' ->
forall N N' : term,
bd_par_red1 e N N' -> bd_par_red1 e (App M N) (App M' N')
| prod_par_red :
forall (e : env) (M M' : term),
bd_par_red1 e M M' ->
forall N N' : term,
bd_par_red1 (Ax M' :: e) N N' ->
bd_par_red1 e (Prod M N) (Prod M' N').
Hint Resolve par_betad sort_par_red ref_par_red abs_par_red app_par_red
prod_par_red: pts.
simple induction M; auto with arith pts.
Qed.
Hint Resolve refl_bd_par_red1: pts.
simple induction 1; auto with arith pts; intros.
elim H0; intros; auto with arith pts.
elim H1; auto with arith pts.
elim H1; intros.
apply par_delta with d T; auto with arith pts.
Qed.
simple induction 1; intros; auto with arith pts.
apply red_trans with (App (Abs T M') N'); auto 10 with arith pts.
red in |- *; red in |- *.
apply rt_step.
apply ctx_rule.
left; auto with arith pts.
apply red_trans with (lift (S n) d); auto with arith pts.
red in |- *; red in |- *.
apply rt_step.
apply ctx_rule.
right.
apply delta_intro with T; auto with arith pts.
Qed.
red in |- *.
simple induction 1; intros; auto with arith pts.
elim red_item with R' n (Def d T) e0 f; intros; auto with arith pts.
apply par_delta with d T; auto with arith pts.
elim item_trunc with decl n e0 (Def d T); intros; auto with arith pts.
elim H4 with x0; intros; auto with arith pts.
inversion_clear H6.
generalize H9.
inversion_clear H8; intros.
apply par_delta with d U; auto with arith pts.
Qed.
red in |- *.
simple induction 1; simpl in |- *; intros; auto with arith pts.
rewrite distr_lift_subst; auto with arith pts.
apply par_betad; auto with arith pts.
replace (Ax (lift_rec 1 T k)) with (lift_decl 1 (Ax T) k);
auto with arith pts.
elim (le_gt_dec k n); intros.
apply par_delta with d T; auto with arith pts.
unfold lift in |- *.
replace (S (S n)) with (1 + S n); auto with arith pts.
elim simpl_lift_rec with d (S n) 0 1 k; auto with arith pts.
simpl in |- *; auto with arith pts.
apply ins_item_ge with (1 := H3); auto with arith pts.
apply par_delta with (lift_rec 1 d (k - S n)) (lift_rec 1 T (k - S n));
auto with arith pts.
unfold lift in |- *.
rewrite permute_lift_rec; auto with arith pts.
replace (S n + (k - S n)) with k; auto with arith pts.
change (item (lift_decl 1 (Def d T) (k - S n)) f n) in |- *.
apply ins_item_lt with (1 := H3); auto with arith pts.
apply abs_par_red; auto with arith pts.
replace (Ax (lift_rec 1 T' k)) with (lift_decl 1 (Ax T') k);
auto with arith pts.
apply prod_par_red; auto with arith pts.
replace (Ax (lift_rec 1 M' k)) with (lift_decl 1 (Ax M') k);
auto with arith pts.
Qed.
Hint Resolve bd_par_red1_lift: pts.
simple induction v; simpl in |- *; intros; auto with arith pts.
elim (lt_eq_lt_dec n0 n); intros; auto with arith pts.
elim a; intros; auto with arith pts.
apply iter_R_lift with g; auto with arith pts.
Qed.
simple induction 2; simpl in |- *; intros; auto with arith pts.
rewrite distr_subst; auto with arith pts.
apply par_betad; auto with arith pts.
replace (Ax (subst_rec x T n)) with (subst_decl x (Ax T) n);
auto with arith pts.
elim (lt_eq_lt_dec n0 n); intros.
elim a.
generalize H1 H2 H3.
clear H1 H2 H3.
case n; intros.
inversion a0.
apply par_delta with d0 T; auto with arith pts.
simpl in |- *.
elim simpl_subst with x d0 (S n1) n0; auto with arith pts.
simpl in |- *.
apply nth_sub_sup with (1 := H4); auto with arith pts.
intro.
rewrite b.
elim simpl_subst with x x n n; auto with arith pts.
pattern x at 2 in |- *.
replace x with d0.
apply H2; auto with arith pts.
elim b; auto with arith pts.
rewrite b in H4.
generalize H4.
rewrite nth_sub_eq with (1 := H4) (2 := H3).
intro.
elim sub_decl_eq_def with (1 := H5).
trivial with arith pts.
apply par_delta with (subst_rec x d0 (n0 - S n)) (subst_rec x T (n0 - S n));
auto with arith pts.
unfold lift in |- *.
rewrite commut_lift_subst_rec; auto with arith pts.
replace (S n + (n0 - S n)) with n0; auto with arith pts.
change (item (subst_decl x (Def d0 T) (n0 - S n)) f n) in |- *.
apply nth_sub_inf with (1 := H4); auto with arith pts.
elim (lt_eq_lt_dec n0 n); intros; auto with arith pts.
elim a; auto with arith pts.
intros.
apply iter_R_lift with g; auto with arith pts.
elim H1; auto with arith pts.
apply abs_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (subst_decl x (Ax T') n :: f));
auto with arith pts.
apply R_env_hd.
simpl in |- *.
apply rd_ax.
apply bd_par_red1_subst_l with g; auto with arith pts.
elim H5; auto with arith pts.
apply prod_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (subst_decl x (Ax M') n :: f));
auto with arith pts.
apply R_env_hd.
simpl in |- *.
apply rd_ax.
apply bd_par_red1_subst_l with g; auto with arith pts.
elim H5; auto with arith pts.
Qed.
intros.
unfold subst in |- *.
apply bd_par_red1_subst_rec with (d := Ax T) (1 := H0) (2 := H);
auto with arith pts.
Qed.
unfold confluent, commut, transp in |- *.
simple induction 1; intros.
inversion_clear H4.
elim H1 with M'0; auto with arith pts; intros.
elim H3 with N'0; auto with arith pts; intros.
exists (subst x1 x0); apply bd_par_red1_subst with T; auto with arith pts.
inversion_clear H5.
elim H1 with M'1; auto with arith pts; intros.
elim H3 with N'0; auto with arith pts; intros.
exists (subst x1 x0).
apply bd_par_red1_subst with T; auto with arith pts.
apply par_betad; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax T :: e0)); auto with arith pts.
apply
(bd_par_red1_stable_env (fun (e : env) (x y : term) => bd_par_red1 e y x)
(Ax T' :: e0)); auto with arith pts.
inversion_clear H3.
apply H1.
cut (Def d T = Def d0 T0); intros.
injection H3.
intros.
rewrite H7; auto with arith pts.
apply fun_item with e0 n; auto with arith pts.
exists N; auto with arith pts.
apply par_delta with d T; auto with arith pts.
inversion_clear H0.
exists (Srt s); auto with arith pts.
inversion_clear H0.
exists z; auto with arith pts.
apply par_delta with d T; auto with arith pts.
exists (Ref n); auto with arith pts.
inversion_clear H4.
elim H1 with M'0; auto with arith pts; intros.
elim H3 with T'0; auto with arith pts; intros.
exists (Abs x1 x0); auto with arith pts.
apply abs_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax T' :: e0)); auto with arith pts.
apply abs_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax T' :: e0)); auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax T :: e0)); auto with arith pts.
apply
(bd_par_red1_stable_env (fun (e : env) (x y : term) => bd_par_red1 e y x)
(Ax T'0 :: e0)); auto with arith pts.
generalize H0 H1.
clear H0 H1.
inversion_clear H4.
intro.
inversion_clear H4.
intros.
elim H4 with (Abs T M'0); auto with arith pts; intros.
elim H3 with N'0; auto with arith pts; intros.
generalize H8.
inversion_clear H7.
clear H8; intro.
inversion_clear H8.
exists (subst x1 M'2); auto with arith pts.
apply par_betad; auto with arith pts.
apply
(bd_par_red1_stable_env (fun (e : env) (x y : term) => bd_par_red1 e y x)
(Ax T'0 :: e0)); auto with arith pts.
apply bd_par_red1_subst with T'0; auto with arith pts.
intros.
elim H5 with M'0; auto with arith pts; intros.
elim H3 with N'0; auto with arith pts; intros.
exists (App x0 x1); auto with arith pts.
intros.
inversion_clear H4.
elim H1 with M'0; auto with arith pts; intros.
elim H3 with N'0; auto with arith pts; intros.
exists (Prod x0 x1); auto with arith pts.
apply prod_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax M' :: e0)); auto with arith pts.
apply prod_par_red; auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax M' :: e0)); auto with arith pts.
apply
(bd_par_red1_stable_env (fun (e : env) (x y : term) => bd_par_red1 e y x)
(Ax x0 :: e0)); auto with arith pts.
apply (bd_par_red1_stable_env bd_par_red1 (Ax M'0 :: e0));
auto with arith pts.
Qed.

Theorem church_rosser_beta_delta : church_rosser (ctxt beta_delta).