@@ -2684,22 +2684,14 @@ Section ConvRedConv.
2684
2684
Σ ;;; Γ ⊢ tCoFix mfix idx = tCoFix mfix' idx.
2685
2685
Proof using wfΣ. eapply (ws_cumul_pb_fix_or_cofix (b:=false)). Qed .
2686
2686
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
-
2695
2687
Lemma ws_cumul_pb_Lambda_l {Γ na A b na' A' pb} :
2696
2688
eq_binder_annot na na' ->
2697
2689
is_open_term (Γ ,, vass na A) b ->
2698
2690
Σ ;;; Γ ⊢ A = A' ->
2699
2691
Σ ;;; Γ ⊢ tLambda na A b ≤[pb] tLambda na' A' b.
2700
2692
Proof using wfΣ.
2701
2693
intros hna hb h.
2702
- eapply ws_cumul_pb_eq_le_gen .
2694
+ eapply ws_cumul_eq_pb .
2703
2695
eapply into_ws_cumul_pb.
2704
2696
{ clear -h hna; induction h.
2705
2697
- constructor; constructor; auto; reflexivity.
@@ -2710,7 +2702,7 @@ Section ConvRedConv.
2710
2702
Qed .
2711
2703
2712
2704
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' ->
2714
2706
Σ ;;; Γ ⊢ tLambda na A b ≤[pb] tLambda na A b'.
2715
2707
Proof using wfΣ.
2716
2708
intros h.
@@ -2736,9 +2728,10 @@ Section ConvRedConv.
2736
2728
rewrite /on_free_vars_decl /test_decl => /andP[] /= onty ont onu onu'.
2737
2729
eapply into_ws_cumul_pb => //.
2738
2730
{ 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.
2742
2735
- destruct pb;
2743
2736
eapply cumul_red_l; tea; pcuic.
2744
2737
- destruct pb;
@@ -2748,12 +2741,12 @@ Section ConvRedConv.
2748
2741
Qed .
2749
2742
2750
2743
Lemma ws_cumul_pb_it_mkLambda_or_LetIn_codom {Δ Γ u v pb} :
2751
- Σ ;;; (Δ ,,, Γ) ⊢ u ≤[pb ] v ->
2744
+ Σ ;;; (Δ ,,, Γ) ⊢ u ≤[Conv ] v ->
2752
2745
Σ ;;; Δ ⊢ it_mkLambda_or_LetIn Γ u ≤[pb] it_mkLambda_or_LetIn Γ v.
2753
2746
Proof using wfΣ.
2754
2747
intros h. revert Δ u v h.
2755
2748
induction Γ as [| [na [b|] A] Γ ih ] ; intros Δ u v h.
2756
- - assumption .
2749
+ - by apply ws_cumul_eq_pb .
2757
2750
- simpl. cbn. eapply ih.
2758
2751
eapply ws_cumul_pb_LetIn_bo. assumption.
2759
2752
- simpl. cbn. eapply ih.
@@ -2791,7 +2784,7 @@ Section ConvRedConv.
2791
2784
Lemma ws_cumul_pb_Lambda {pb Γ na1 na2 A1 A2 t1 t2} :
2792
2785
eq_binder_annot na1 na2 ->
2793
2786
Σ ;;; Γ ⊢ A1 = A2 ->
2794
- Σ ;;; Γ ,, vass na1 A1 ⊢ t1 ≤[pb ] t2 ->
2787
+ Σ ;;; Γ ,, vass na1 A1 ⊢ t1 ≤[Conv ] t2 ->
2795
2788
Σ ;;; Γ ⊢ tLambda na1 A1 t1 ≤[pb] tLambda na2 A2 t2.
2796
2789
Proof using wfΣ.
2797
2790
intros eqna X.
@@ -2805,7 +2798,7 @@ Section ConvRedConv.
2805
2798
Lemma conv_cum_Lambda leq Γ na1 na2 A1 A2 t1 t2 :
2806
2799
eq_binder_annot na1 na2 ->
2807
2800
Σ ;;; Γ ⊢ A1 = A2 ->
2808
- sq_ws_cumul_pb leq Σ (Γ ,, vass na1 A1) t1 t2 ->
2801
+ sq_ws_cumul_pb Conv Σ (Γ ,, vass na1 A1) t1 t2 ->
2809
2802
sq_ws_cumul_pb leq Σ Γ (tLambda na1 A1 t1) (tLambda na2 A2 t2).
2810
2803
Proof using wfΣ.
2811
2804
intros eqna X []; sq. now apply ws_cumul_pb_Lambda.
@@ -2857,7 +2850,7 @@ Section ConvRedConv.
2857
2850
intros hna ont ona onu.
2858
2851
etransitivity.
2859
2852
{ eapply ws_cumul_pb_LetIn_bo; tea. }
2860
- eapply ws_cumul_pb_eq_le_gen .
2853
+ eapply ws_cumul_eq_pb .
2861
2854
etransitivity.
2862
2855
{ eapply ws_cumul_pb_LetIn_ty; tea; eauto with fvs. }
2863
2856
eapply ws_cumul_pb_LetIn_tm; tea; eauto with fvs.
@@ -2866,12 +2859,13 @@ Section ConvRedConv.
2866
2859
2867
2860
Lemma ws_cumul_pb_it_mkLambda_or_LetIn {pb Γ Δ1 Δ2 t1 t2} :
2868
2861
Σ ⊢ Γ ,,, Δ1 = Γ ,,, Δ2 ->
2869
- Σ ;;; Γ ,,, Δ1 ⊢ t1 ≤[pb] t2 ->
2862
+ Σ ;;; Γ ,,, Δ1 ⊢ t1 = t2 ->
2870
2863
Σ ;;; Γ ⊢ it_mkLambda_or_LetIn Δ1 t1 ≤[pb] it_mkLambda_or_LetIn Δ2 t2.
2871
2864
Proof using wfΣ.
2872
2865
induction Δ1 in Δ2, t1, t2 |- *; intros X Y.
2873
2866
- apply All2_fold_length in X.
2874
2867
destruct Δ2; cbn in *; [trivial|].
2868
+ 1: by apply ws_cumul_eq_pb.
2875
2869
rewrite length_app in X; lia.
2876
2870
- apply All2_fold_length in X as X'.
2877
2871
destruct Δ2 as [|c Δ2]; simpl in *; [rewrite length_app in X'; lia|].
@@ -2916,7 +2910,7 @@ Section ConvRedConv.
2916
2910
Lemma ws_cumul_pb_Lambda_inv :
2917
2911
forall pb Γ na1 na2 A1 A2 b1 b2,
2918
2912
Σ ;;; Γ ⊢ 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].
2920
2914
Proof using wfΣ.
2921
2915
intros *.
2922
2916
move/ws_cumul_pb_red; intros (v & v' & [redv redv' eq]).
@@ -2951,7 +2945,7 @@ Section ConvRedConv.
2951
2945
Lemma Lambda_conv_cum_inv :
2952
2946
forall leq Γ na1 na2 A1 A2 b1 b2,
2953
2947
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.
2955
2949
Proof using wfΣ.
2956
2950
intros * []. eapply ws_cumul_pb_Lambda_inv in X as [].
2957
2951
intuition auto. all:sq; auto.
@@ -3257,7 +3251,7 @@ Section ConvSubst.
3257
3251
move: clctx. rewrite on_free_vars_ctx_app !app_context_length H => /andP[] //. }
3258
3252
etransitivity.
3259
3253
* eapply untyped_substitution_ws_cumul_pb; tea. fvs.
3260
- * eapply ws_cumul_pb_eq_le_gen .
3254
+ * eapply ws_cumul_eq_pb .
3261
3255
eapply (untyped_substitution_ws_cumul_pb_subst_conv (Δ := Γ0) (Δ' := Γ1)); tea; eauto.
3262
3256
Qed .
3263
3257
@@ -3557,7 +3551,7 @@ Qed.
3557
3551
3558
3552
Lemma ws_cumul_pb_rel_it_mkLambda_or_LetIn {cf pb Σ} {wfΣ : wf Σ} (Δ Γ Γ' : context) (B B' : term) :
3559
3553
ws_cumul_ctx_pb_rel Conv Σ Δ Γ Γ' ->
3560
- Σ ;;; Δ ,,, Γ ⊢ B ≤[pb] B' ->
3554
+ Σ ;;; Δ ,,, Γ ⊢ B = B' ->
3561
3555
Σ ;;; Δ ⊢ it_mkLambda_or_LetIn Γ B ≤[pb] it_mkLambda_or_LetIn Γ' B'.
3562
3556
Proof .
3563
3557
move/ws_cumul_ctx_pb_rel_app => hc hb.
@@ -3687,7 +3681,7 @@ Section CumulSubst.
3687
3681
Σ ;;; Γ ,,, subst_context s 0 Γ' ⊢ subst s #|Γ'| b ≤[pb] subst s' #|Γ'| b.
3688
3682
Proof using wfΣ.
3689
3683
move=> cl cl' clb eqsub subs subs'.
3690
- eapply ws_cumul_pb_eq_le_gen .
3684
+ eapply ws_cumul_eq_pb .
3691
3685
eapply substitution_ws_cumul_pb_subst_conv; tea; eauto with pcuic.
3692
3686
Qed .
3693
3687
@@ -3957,7 +3951,7 @@ Proof.
3957
3951
eapply (ws_cumul_pb_refl' (exist Γ _) (exist t _)) end.
3958
3952
all: intros Γ pb; revert Γ.
3959
3953
- intros; etransitivity; eauto.
3960
- - intros. apply ws_cumul_pb_eq_le_gen . apply symmetry.
3954
+ - intros. apply ws_cumul_eq_pb . apply symmetry.
3961
3955
eauto.
3962
3956
- intros Γ t; intros. unshelve eapply (ws_cumul_pb_refl' (exist Γ _) (exist t _)); eauto.
3963
3957
- intros Γ ev args args' Hargsargs' Hargsargs'_dep HΓ Hargs Hargs'. cbn in *. eapply ws_cumul_pb_Evar; eauto.
@@ -3979,7 +3973,7 @@ Proof.
3979
3973
- intros Γ na na' t t' ty ty' u u' Hna _ Heqtt' _ Heqtyty' _ Hequu' HΓ HM HN.
3980
3974
cbn in *. apply andb_andI in HM; apply andb_andI in HN; destruct HM as [Ht Htyu]; destruct HN as [Ht' Htyu'].
3981
3975
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.
3983
3977
* change (is_closed_context (Γ,, vdef na t ty)). rewrite on_free_vars_ctx_snoc. apply andb_and. split; eauto.
3984
3978
rewrite /on_free_vars_decl /test_decl. apply andb_and. split; eauto.
3985
3979
* rewrite shiftnP_S; eauto.
@@ -3989,7 +3983,7 @@ Proof.
3989
3983
apply andb_andI in H; apply andb_andI in H'; destruct H as [Hreturn H]; destruct H' as [Hreturn' H'].
3990
3984
apply andb_andI in H; apply andb_andI in H'; destruct H as [Hcontext H]; destruct H' as [Hcontext' H'].
3991
3985
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.
3993
3987
* rewrite is_open_case_split. repeat (apply andb_and; split); eauto.
3994
3988
* rewrite is_open_case_split. repeat (apply andb_and; split); eauto.
3995
3989
* unfold cumul_predicate in Hpp'. unfold ws_cumul_pb_predicate. destruct Hpp' as [Hpp' [Hinst [Hpcon Hpret]]].
@@ -4018,7 +4012,7 @@ Proof.
4018
4012
rewrite <- length_app in *. tea.
4019
4013
- intros; eapply ws_cumul_pb_Proj_c; eauto.
4020
4014
- 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.
4022
4016
eapply All2_impl. 1: tea. cbn; intros; destruct_head'_prod.
4023
4017
pose proof (Hfix := All2_length ltac:(eassumption)).
4024
4018
unfold test_def in *; repeat toProp; destruct_head'_and.
@@ -4028,7 +4022,7 @@ Proof.
4028
4022
* rewrite -> shiftnP_add, <- fix_context_length, <- length_app in *; tea.
4029
4023
* rewrite -> shiftnP_add, <- Hfix, <- fix_context_length, <- length_app in *; tea.
4030
4024
- 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.
4032
4026
eapply All2_impl. 1: tea. pose proof (Hfix := All2_length ltac:(eassumption)); cbn; intros. destruct_head'_prod.
4033
4027
unfold test_def in *.
4034
4028
repeat toProp; destruct_head'_and.
0 commit comments