@@ -2684,22 +2684,14 @@ Section ConvRedConv.
26842684 Σ ;;; Γ ⊢ tCoFix mfix idx = tCoFix mfix' idx.
26852685 Proof using wfΣ. eapply (ws_cumul_pb_fix_or_cofix (b:=false)). Qed .
26862686
2687- Lemma ws_cumul_pb_eq_le_gen {pb Γ T U} :
2688- Σ ;;; Γ ⊢ T = U ->
2689- Σ ;;; Γ ⊢ T ≤[pb] U.
2690- Proof using Type .
2691- destruct pb => //.
2692- eapply ws_cumul_pb_eq_le.
2693- Qed .
2694-
26952687 Lemma ws_cumul_pb_Lambda_l {Γ na A b na' A' pb} :
26962688 eq_binder_annot na na' ->
26972689 is_open_term (Γ ,, vass na A) b ->
26982690 Σ ;;; Γ ⊢ A = A' ->
26992691 Σ ;;; Γ ⊢ tLambda na A b ≤[pb] tLambda na' A' b.
27002692 Proof using wfΣ.
27012693 intros hna hb h.
2702- eapply ws_cumul_pb_eq_le_gen .
2694+ eapply ws_cumul_eq_pb .
27032695 eapply into_ws_cumul_pb.
27042696 { clear -h hna; induction h.
27052697 - constructor; constructor; auto; reflexivity.
@@ -2710,7 +2702,7 @@ Section ConvRedConv.
27102702 Qed .
27112703
27122704 Lemma ws_cumul_pb_Lambda_r {pb Γ na A b b'} :
2713- Σ ;;; Γ,, vass na A ⊢ b ≤[pb ] b' ->
2705+ Σ ;;; Γ,, vass na A ⊢ b ≤[Conv ] b' ->
27142706 Σ ;;; Γ ⊢ tLambda na A b ≤[pb] tLambda na A b'.
27152707 Proof using wfΣ.
27162708 intros h.
@@ -2736,9 +2728,10 @@ Section ConvRedConv.
27362728 rewrite /on_free_vars_decl /test_decl => /andP[] /= onty ont onu onu'.
27372729 eapply into_ws_cumul_pb => //.
27382730 { clear -h. induction h.
2739- - destruct pb;
2740- eapply cumul_refl; constructor.
2741- all: try reflexivity; auto.
2731+ - eapply cumul_red_l; pcuic.
2732+ eapply cumul_red_r; [|pcuic].
2733+ eapply cumul_refl.
2734+ apply eq_term_upto_univ_subst; trea; tc.
27422735 - destruct pb;
27432736 eapply cumul_red_l; tea; pcuic.
27442737 - destruct pb;
@@ -2748,12 +2741,12 @@ Section ConvRedConv.
27482741 Qed .
27492742
27502743 Lemma ws_cumul_pb_it_mkLambda_or_LetIn_codom {Δ Γ u v pb} :
2751- Σ ;;; (Δ ,,, Γ) ⊢ u ≤[pb ] v ->
2744+ Σ ;;; (Δ ,,, Γ) ⊢ u ≤[Conv ] v ->
27522745 Σ ;;; Δ ⊢ it_mkLambda_or_LetIn Γ u ≤[pb] it_mkLambda_or_LetIn Γ v.
27532746 Proof using wfΣ.
27542747 intros h. revert Δ u v h.
27552748 induction Γ as [| [na [b|] A] Γ ih ] ; intros Δ u v h.
2756- - assumption .
2749+ - by apply ws_cumul_eq_pb .
27572750 - simpl. cbn. eapply ih.
27582751 eapply ws_cumul_pb_LetIn_bo. assumption.
27592752 - simpl. cbn. eapply ih.
@@ -2791,7 +2784,7 @@ Section ConvRedConv.
27912784 Lemma ws_cumul_pb_Lambda {pb Γ na1 na2 A1 A2 t1 t2} :
27922785 eq_binder_annot na1 na2 ->
27932786 Σ ;;; Γ ⊢ A1 = A2 ->
2794- Σ ;;; Γ ,, vass na1 A1 ⊢ t1 ≤[pb ] t2 ->
2787+ Σ ;;; Γ ,, vass na1 A1 ⊢ t1 ≤[Conv ] t2 ->
27952788 Σ ;;; Γ ⊢ tLambda na1 A1 t1 ≤[pb] tLambda na2 A2 t2.
27962789 Proof using wfΣ.
27972790 intros eqna X.
@@ -2805,7 +2798,7 @@ Section ConvRedConv.
28052798 Lemma conv_cum_Lambda leq Γ na1 na2 A1 A2 t1 t2 :
28062799 eq_binder_annot na1 na2 ->
28072800 Σ ;;; Γ ⊢ A1 = A2 ->
2808- sq_ws_cumul_pb leq Σ (Γ ,, vass na1 A1) t1 t2 ->
2801+ sq_ws_cumul_pb Conv Σ (Γ ,, vass na1 A1) t1 t2 ->
28092802 sq_ws_cumul_pb leq Σ Γ (tLambda na1 A1 t1) (tLambda na2 A2 t2).
28102803 Proof using wfΣ.
28112804 intros eqna X []; sq. now apply ws_cumul_pb_Lambda.
@@ -2857,7 +2850,7 @@ Section ConvRedConv.
28572850 intros hna ont ona onu.
28582851 etransitivity.
28592852 { eapply ws_cumul_pb_LetIn_bo; tea. }
2860- eapply ws_cumul_pb_eq_le_gen .
2853+ eapply ws_cumul_eq_pb .
28612854 etransitivity.
28622855 { eapply ws_cumul_pb_LetIn_ty; tea; eauto with fvs. }
28632856 eapply ws_cumul_pb_LetIn_tm; tea; eauto with fvs.
@@ -2866,12 +2859,13 @@ Section ConvRedConv.
28662859
28672860 Lemma ws_cumul_pb_it_mkLambda_or_LetIn {pb Γ Δ1 Δ2 t1 t2} :
28682861 Σ ⊢ Γ ,,, Δ1 = Γ ,,, Δ2 ->
2869- Σ ;;; Γ ,,, Δ1 ⊢ t1 ≤[pb] t2 ->
2862+ Σ ;;; Γ ,,, Δ1 ⊢ t1 = t2 ->
28702863 Σ ;;; Γ ⊢ it_mkLambda_or_LetIn Δ1 t1 ≤[pb] it_mkLambda_or_LetIn Δ2 t2.
28712864 Proof using wfΣ.
28722865 induction Δ1 in Δ2, t1, t2 |- *; intros X Y.
28732866 - apply All2_fold_length in X.
28742867 destruct Δ2; cbn in *; [trivial|].
2868+ 1: by apply ws_cumul_eq_pb.
28752869 rewrite length_app in X; lia.
28762870 - apply All2_fold_length in X as X'.
28772871 destruct Δ2 as [|c Δ2]; simpl in *; [rewrite length_app in X'; lia|].
@@ -2916,7 +2910,7 @@ Section ConvRedConv.
29162910 Lemma ws_cumul_pb_Lambda_inv :
29172911 forall pb Γ na1 na2 A1 A2 b1 b2,
29182912 Σ ;;; Γ ⊢ tLambda na1 A1 b1 ≤[pb] tLambda na2 A2 b2 ->
2919- [× eq_binder_annot na1 na2, Σ ;;; Γ ⊢ A1 = A2 & Σ ;;; Γ ,, vass na1 A1 ⊢ b1 ≤[pb] b2].
2913+ [× eq_binder_annot na1 na2, Σ ;;; Γ ⊢ A1 = A2 & Σ ;;; Γ ,, vass na1 A1 ⊢ b1 = b2].
29202914 Proof using wfΣ.
29212915 intros *.
29222916 move/ws_cumul_pb_red; intros (v & v' & [redv redv' eq]).
@@ -2951,7 +2945,7 @@ Section ConvRedConv.
29512945 Lemma Lambda_conv_cum_inv :
29522946 forall leq Γ na1 na2 A1 A2 b1 b2,
29532947 sq_ws_cumul_pb leq Σ Γ (tLambda na1 A1 b1) (tLambda na2 A2 b2) ->
2954- eq_binder_annot na1 na2 /\ ∥ Σ ;;; Γ ⊢ A1 = A2 ∥ /\ sq_ws_cumul_pb leq Σ (Γ ,, vass na1 A1) b1 b2.
2948+ eq_binder_annot na1 na2 /\ ∥ Σ ;;; Γ ⊢ A1 = A2 ∥ /\ sq_ws_cumul_pb Conv Σ (Γ ,, vass na1 A1) b1 b2.
29552949 Proof using wfΣ.
29562950 intros * []. eapply ws_cumul_pb_Lambda_inv in X as [].
29572951 intuition auto. all:sq; auto.
@@ -3257,7 +3251,7 @@ Section ConvSubst.
32573251 move: clctx. rewrite on_free_vars_ctx_app !app_context_length H => /andP[] //. }
32583252 etransitivity.
32593253 * eapply untyped_substitution_ws_cumul_pb; tea. fvs.
3260- * eapply ws_cumul_pb_eq_le_gen .
3254+ * eapply ws_cumul_eq_pb .
32613255 eapply (untyped_substitution_ws_cumul_pb_subst_conv (Δ := Γ0) (Δ' := Γ1)); tea; eauto.
32623256 Qed .
32633257
@@ -3557,7 +3551,7 @@ Qed.
35573551
35583552Lemma ws_cumul_pb_rel_it_mkLambda_or_LetIn {cf pb Σ} {wfΣ : wf Σ} (Δ Γ Γ' : context) (B B' : term) :
35593553 ws_cumul_ctx_pb_rel Conv Σ Δ Γ Γ' ->
3560- Σ ;;; Δ ,,, Γ ⊢ B ≤[pb] B' ->
3554+ Σ ;;; Δ ,,, Γ ⊢ B = B' ->
35613555 Σ ;;; Δ ⊢ it_mkLambda_or_LetIn Γ B ≤[pb] it_mkLambda_or_LetIn Γ' B'.
35623556Proof .
35633557 move/ws_cumul_ctx_pb_rel_app => hc hb.
@@ -3687,7 +3681,7 @@ Section CumulSubst.
36873681 Σ ;;; Γ ,,, subst_context s 0 Γ' ⊢ subst s #|Γ'| b ≤[pb] subst s' #|Γ'| b.
36883682 Proof using wfΣ.
36893683 move=> cl cl' clb eqsub subs subs'.
3690- eapply ws_cumul_pb_eq_le_gen .
3684+ eapply ws_cumul_eq_pb .
36913685 eapply substitution_ws_cumul_pb_subst_conv; tea; eauto with pcuic.
36923686 Qed .
36933687
@@ -3957,7 +3951,7 @@ Proof.
39573951 eapply (ws_cumul_pb_refl' (exist Γ _) (exist t _)) end.
39583952 all: intros Γ pb; revert Γ.
39593953 - intros; etransitivity; eauto.
3960- - intros. apply ws_cumul_pb_eq_le_gen . apply symmetry.
3954+ - intros. apply ws_cumul_eq_pb . apply symmetry.
39613955 eauto.
39623956 - intros Γ t; intros. unshelve eapply (ws_cumul_pb_refl' (exist Γ _) (exist t _)); eauto.
39633957 - intros Γ ev args args' Hargsargs' Hargsargs'_dep HΓ Hargs Hargs'. cbn in *. eapply ws_cumul_pb_Evar; eauto.
@@ -3979,7 +3973,7 @@ Proof.
39793973 - intros Γ na na' t t' ty ty' u u' Hna _ Heqtt' _ Heqtyty' _ Hequu' HΓ HM HN.
39803974 cbn in *. apply andb_andI in HM; apply andb_andI in HN; destruct HM as [Ht Htyu]; destruct HN as [Ht' Htyu'].
39813975 apply andb_andI in Htyu; apply andb_andI in Htyu'; destruct Htyu as [Hty Hu]; destruct Htyu' as [Hty' Hu'].
3982- eapply ws_cumul_pb_LetIn; eauto. eapply Hequu'; eauto.
3976+ eapply ws_cumul_pb_LetIn; eauto. apply ws_cumul_eq_pb. eapply Hequu'; eauto.
39833977 * change (is_closed_context (Γ,, vdef na t ty)). rewrite on_free_vars_ctx_snoc. apply andb_and. split; eauto.
39843978 rewrite /on_free_vars_decl /test_decl. apply andb_and. split; eauto.
39853979 * rewrite shiftnP_S; eauto.
@@ -3989,7 +3983,7 @@ Proof.
39893983 apply andb_andI in H; apply andb_andI in H'; destruct H as [Hreturn H]; destruct H' as [Hreturn' H'].
39903984 apply andb_andI in H; apply andb_andI in H'; destruct H as [Hcontext H]; destruct H' as [Hcontext' H'].
39913985 apply andb_andI in H; apply andb_andI in H'; destruct H as [Hc Hbrs]; destruct H' as [Hc' Hbrs'].
3992- eapply ws_cumul_pb_eq_le_gen . eapply ws_cumul_pb_Case; eauto.
3986+ eapply ws_cumul_eq_pb . eapply ws_cumul_pb_Case; eauto.
39933987 * rewrite is_open_case_split. repeat (apply andb_and; split); eauto.
39943988 * rewrite is_open_case_split. repeat (apply andb_and; split); eauto.
39953989 * unfold cumul_predicate in Hpp'. unfold ws_cumul_pb_predicate. destruct Hpp' as [Hpp' [Hinst [Hpcon Hpret]]].
@@ -4018,7 +4012,7 @@ Proof.
40184012 rewrite <- length_app in *. tea.
40194013 - intros; eapply ws_cumul_pb_Proj_c; eauto.
40204014 - intros Γ mfix mfix' idx Hmfixmfix' Hmfixmfix'_dep HΓ H H'. cbn in *.
4021- eapply ws_cumul_pb_eq_le_gen . eapply ws_cumul_pb_Fix; eauto. repeat toAll.
4015+ eapply ws_cumul_eq_pb . eapply ws_cumul_pb_Fix; eauto. repeat toAll.
40224016 eapply All2_impl. 1: tea. cbn; intros; destruct_head'_prod.
40234017 pose proof (Hfix := All2_length ltac:(eassumption)).
40244018 unfold test_def in *; repeat toProp; destruct_head'_and.
@@ -4028,7 +4022,7 @@ Proof.
40284022 * rewrite -> shiftnP_add, <- fix_context_length, <- length_app in *; tea.
40294023 * rewrite -> shiftnP_add, <- Hfix, <- fix_context_length, <- length_app in *; tea.
40304024 - intros Γ mfix mfix' idx Hmfixmfix' Hmfixmfix'_dep HΓ H H'. cbn in *.
4031- eapply ws_cumul_pb_eq_le_gen . eapply ws_cumul_pb_CoFix; eauto. repeat toAll.
4025+ eapply ws_cumul_eq_pb . eapply ws_cumul_pb_CoFix; eauto. repeat toAll.
40324026 eapply All2_impl. 1: tea. pose proof (Hfix := All2_length ltac:(eassumption)); cbn; intros. destruct_head'_prod.
40334027 unfold test_def in *.
40344028 repeat toProp; destruct_head'_and.
0 commit comments