From 1aa4f40c651096deefd640a2040a904722fee37f Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Wed, 13 Feb 2013 15:41:00 +0000 Subject: [PATCH] - first piece of the mutual induction for preservation finally closed! - a conjecture closed --- .../basic_2/computation/fprs_cprs.ma | 7 ++ .../lambdadelta/basic_2/dynamic/snv_ltpr.ma | 106 +++++------------- .../basic_2/equivalence/fpcs_cpcs.ma | 7 ++ .../basic_2/equivalence/lsubse_ssta.ma | 38 ++++++- .../basic_2/reducibility/fpr_cpr.ma | 8 +- 5 files changed, 81 insertions(+), 85 deletions(-) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fprs_cprs.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fprs_cprs.ma index ef2915cea..b65cd73f5 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fprs_cprs.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fprs_cprs.ma @@ -21,6 +21,13 @@ include "basic_2/computation/lfprs_fprs.ma". (* Advanced properties ******************************************************) +lemma fprs_flat_dx_tpr: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ➡* ⦃L2, T2⦄ → ∀V1,V2. V1 ➡ V2 → + ∀I. ⦃L1, ⓕ{I}V1.T1⦄ ➡* ⦃L2, ⓕ{I}V2.T2⦄. +#L1 #L2 #T1 #T2 #HT12 @(fprs_ind … HT12) -L2 -T2 /3 width=1/ +#L #L2 #T #T2 #_ #HT2 #IHT2 #V1 #V2 #HV12 #I +lapply (IHT2 … HV12 I) -IHT2 -HV12 /3 width=6/ +qed. + lemma fprs_bind2_minus: ∀I,L1,L2,V1,T1,U2. ⦃L1, -ⓑ{I}V1.T1⦄ ➡* ⦃L2, U2⦄ → ∃∃V2,T2. ⦃L1.ⓑ{I}V1, T1⦄ ➡* ⦃L2.ⓑ{I}V2, T2⦄ & U2 = -ⓑ{I}V2.T2. diff --git a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma index aa6795a12..cb7e54413 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma @@ -18,9 +18,7 @@ include "basic_2/equivalence/lsubse_ssta.ma". include "basic_2/equivalence/fpcs_cpcs.ma". include "basic_2/equivalence/lfpcs_fpcs.ma". include "basic_2/dynamic/snv_ssta.ma". -(* -anclude "basic_2/dynamic/snv_lift.ma". -*) + (* STRATIFIED NATIVE VALIDITY FOR TERMS *************************************) (* Properties on context-free parallel reduction for local environments *****) @@ -45,10 +43,10 @@ fact ssta_ltpr_tpr_aux: ∀h,g,n. ( ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → ⦃h, L1⦄ ⊩ T1 :[g] → ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & ⦃L1, U1⦄ ⬌* ⦃L2, U2⦄. #h #g #n #IH3 #IH2 #IH1 #L1 * * [|||| *] -[ #k #_ #Y #l #H1 #L2 #HL12 #X #H2 #_ -IH3 -IH1 +[ #k #_ #Y #l #H1 #L2 #HL12 #X #H2 #_ -IH3 -IH2 -IH1 elim (ssta_inv_sort1 … H1) -H1 #Hkl #H destruct >(tpr_inv_atom1 … H2) -X /4 width=6/ -| #i #Hn #U1 #l #H1 #L2 #HL12 #X #H2 #H3 destruct -IH3 +| #i #Hn #U1 #l #H1 #L2 #HL12 #X #H2 #H3 destruct -IH3 -IH2 elim (ssta_inv_lref1 … H1) -H1 * #K1 >(tpr_inv_atom1 … H2) -X elim (snv_inv_lref … H3) -H3 #I0 #K0 #V0 #H #HV1 @@ -73,19 +71,19 @@ fact ssta_ltpr_tpr_aux: ∀h,g,n. ( ] | #p #Hn #U1 #l #H1 -IH3 -IH1 elim (ssta_inv_gref1 … H1) -| #a #I #V1 #T1 #Hn #Y #l #H1 #L2 #HL12 #X #H2 #H3 destruct -IH3 +| #a #I #V1 #T1 #Hn #Y #l #H1 #L2 #HL12 #X #H2 #H3 destruct -IH3 -IH2 elim (ssta_inv_bind1 … H1) -H1 #U1 #HTU1 #H destruct elim (snv_inv_bind … H3) -H3 #_ #HT1 elim (tpr_inv_bind1 … H2) -H2 * [ #V2 #T0 #T2 #HV12 #HT10 #HT02 #H destruct - elim (IH1 … HTU1 (L2.ⓑ{I}V2) … HT10) -IH1 -HTU1 -HT10 // -T1 /3 width=1/ #U0 #HTU0 #HU10 + elim (IH1 … HTU1 (L2.ⓑ{I}V2) … HT10) -IH1 -HTU1 -HT10 // -T1 /3 width=1/ -HL12 #U0 #HTU0 #HU10 lapply (tps_lsubs_trans … HT02 (L2.ⓑ{I}V2) ?) -HT02 [ /2 width=1/ ] #HT02 elim (ssta_tps_conf … HTU0 … HT02) -T0 #U2 #HTU2 #HU02 lapply (cpr_intro … U0 … HU02) -HU02 // #HU02 lapply (fpcs_fpr_strap1 … HU10 (L2.ⓑ{I}V2) U2 ?) [ /2 width=1/ ] -U0 #HU12 lapply (fpcs_fwd_shift … HU12 a) -HU12 /3 width=3/ | #T2 #HT12 #HT2 #H1 #H2 destruct - elim (IH1 … HTU1 (L2.ⓓV1) … HT12) -IH1 -HTU1 -HT12 // -T1 [2: /3 width=1/ ] #U2 #HTU2 #HU12 + elim (IH1 … HTU1 (L2.ⓓV1) … HT12) -IH1 -HTU1 -HT12 // -T1 [2: /3 width=1/ ] -HL12 #U2 #HTU2 #HU12 lapply (fpcs_fwd_shift … HU12 true) -HU12 #HU12 elim (ssta_inv_lift1 … HTU2 … HT2) -T2 [3: /2 width=1/ |2: skip ] #U #HXU #HU2 lapply (fpcs_fpr_strap1 … HU12 L2 U ?) -HU12 [ /3 width=3/ ] -U2 /2 width=3/ @@ -94,7 +92,8 @@ fact ssta_ltpr_tpr_aux: ∀h,g,n. ( elim (ssta_inv_appl1 … H1) -H1 #U1 #HTU1 #H destruct elim (snv_inv_appl … H3) -H3 #a #W1 #W10 #U10 #l0 #HV1 #HT1 #HVW1 #HW10 #HTU10 elim (tpr_inv_appl1 … H2) -H2 * - [ + [ #V2 #T2 #HV12 #HT12 #H destruct -a -l0 -W1 -W10 -U10 -HV1 -IH3 -IH2 + elim (IH1 … HTU1 … HL12 … HT12 HT1) -IH1 -HTU1 -HL12 -HT12 -HT1 // /3 width=5/ | #b #V2 #W #T2 #T20 #HV12 #HT20 #H1 #H2 destruct elim (snv_inv_bind … HT1) -HT1 #HW #HT2 elim (ssta_inv_bind1 … HTU1) -HTU1 #U2 #HTU2 #H destruct @@ -115,78 +114,27 @@ fact ssta_ltpr_tpr_aux: ∀h,g,n. ( | -b -l -V -V1 -T2 -T20 -U0 -U2 -U20 /6 width=6 by lsubse_abbr, fpcs_inv_cpcs, fpcs_canc_sn, fpcs_fprs_strap1, cpcs_fpcs, bi_inj/ ] + | #b #V0 #V2 #W0 #W2 #T0 #T2 #HV10 #HW02 #HT02 #HV02 #H1 #H2 destruct -a -l0 -W1 -W10 -HV1 -IH3 -IH2 + elim (ssta_inv_bind1 … HTU1) -HTU1 #U0 #HTU0 #H destruct + elim (snv_inv_bind … HT1) -HT1 #_ #HT0 + elim (IH1 … HTU0 (L2.ⓓW2) … HT02 HT0) -IH1 -HTU0 -HT02 -HT0 // -T0 [2: /2 width=1/ ] -HL12 -HW02 #U2 #HTU2 #HU02 + lapply (fpcs_fwd_shift … HU02 b) -HU02 #HU02 + lapply (fpcs_flat_dx_tpr … HU02 … HV10 Appl) -HV10 -HU02 #HU02 + lapply (fpcs_fpr_strap1 … HU02 L2 (ⓓ{b}W2.ⓐV2.U2) ?) -HU02 [ @ltpr_tpr_fpr // /2 width=3/ ] -V0 /4 width=3/ ] -| -(* - -fact ssta_ltpr_tpr_aux: ∀h,g,L,T. ( - ∀L1,T1,U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → - ∀L2. L1 ⊢ ⬌* L2 → ∀T2. T1 ➡ T2 → ⦃h, L1⦄ ⊩ T1 :[g] → - #{L1, T1} < #{L ,T} → - ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & U1 ➡ U2 - ) → - ∀L1,T1,U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → - ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → ⦃h, L1⦄ ⊩ T1 :[g] → - L = L1 → T = T1 → - ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & U1 ➡ U2. -#h #g #L #T #IH #L1 #T1 #U1 #l * -L1 -T1 -U1 -l -[ #L1 #k #l #Hkl #L2 #_ #X #H #_ #H1 #H2 destruct -IH - >(tpr_inv_atom1 … H) -X /3 width=3/ -| #L1 #K1 #V1 #W1 #U1 #i #l #HLK1 #HVW1 #HWU1 #L2 #HL12 #X #H1 #H2 #H3 #H4 destruct - >(tpr_inv_atom1 … H1) -X - elim (snv_inv_lref … H2) -H2 #I0 #K0 #V0 #H #HV1 - lapply (ldrop_mono … H … HLK1) -H #H destruct - lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) #HKV1 - elim (ltpr_ldrop_conf … HLK1 … HL12) -HLK1 -HL12 #X #H #HLK2 - elim (ltpr_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct - elim (IH … HVW1 K2 … HV12 ? ?) -IH -HVW1 -HV12 // -L1 -V1 /2 width=1/ -K1 #W2 #HVW2 #HW12 - elim (lift_total W2 0 (i+1)) #U2 #HWU2 - lapply (tpr_lift … HW12 … HWU1 … HWU2) -W1 /3 width=6/ -| #L1 #K1 #V1 #W1 #U1 #i #l #HLK1 #HVW1 #HVU1 #L2 #HL12 #X #H1 #H2 #H3 #H4 destruct - >(tpr_inv_atom1 … H1) -X - elim (snv_inv_lref … H2) -H2 #I0 #K0 #V0 #H #HV1 - lapply (ldrop_mono … H … HLK1) -H #H destruct - lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) #HKV1 - elim (ltpr_ldrop_conf … HLK1 … HL12) -HLK1 -HL12 #X #H #HLK2 - elim (ltpr_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct - elim (IH … HVW1 K2 … HV12 ? ?) -IH -HVW1 // -L1 -HV1 /2 width=1/ -K1 #W2 #HVW2 #_ -W1 - elim (lift_total V2 0 (i+1)) #U2 #HVU2 - lapply (tpr_lift … HV12 … HVU1 … HVU2) -V1 /3 width=6/ -| #a #I #L1 #V1 #T1 #U1 #l #HTU1 #L2 #HL12 #X #H1 #H2 #H3 #H4 destruct - elim (snv_inv_bind … H2) -H2 #_ #HT1 - elim (tpr_inv_bind1 … H1) -H1 * - [ #V2 #T0 #T2 #HV12 #HT10 #HT02 #H destruct - elim (IH … HTU1 (L2.ⓑ{I}V2) … HT10 ? ?) -IH -HTU1 -HT10 // -T1 /3 width=1/ -L1 #U0 #HTU0 #HU10 - lapply (tps_lsubs_trans … HT02 (L2.ⓑ{I}V2) ?) -HT02 [ /2 width=1/ ] #HT02 - elim (ssta_tps_conf … HTU0 … HT02) -T0 #U2 #HTU2 #HU02 - lapply (tpss_inv_SO2 … HU02) -HU02 #HU02 - lapply (tps_lsubs_trans … HU02 (⋆.ⓑ{I}V2) ?) -HU02 - [ /2 width=1/ | /3 width=7/ ] - | #T2 #HT12 #HT2 #H1 #H2 destruct - elim (IH ? ? ? ? HTU1 (L2.ⓓV1) … HT12 ? ?) -IH -HTU1 -HT12 // -T1 [2: /3 width=1/ ] -L1 #U2 #HTU2 #HU12 - elim (ssta_inv_lift1 … HTU2 … HT2) -T2 /3 width=5/ +| #U0 #T1 #Hn #U1 #l #H1 #L2 #HL12 #X #H2 #H3 destruct -IH3 -IH2 + lapply (ssta_inv_cast1 … H1) -H1 #HTU1 + elim (snv_inv_cast … H3) -H3 #T0 #l0 #_ #HT1 #HT10 #_ + elim (ssta_mono … HT10 … HTU1) -HT10 #H1 #H2 destruct + elim (tpr_inv_cast1 … H2) -H2 + [ * #U2 #T2 #_ #HT12 #H destruct + elim (IH1 … HTU1 … HL12 … HT12 HT1) -IH1 -HTU1 -HL12 -HT12 -HT1 // -T1 -U0 /3 width=3/ + | #HT1X + elim (IH1 … HTU1 … HL12 … HT1X HT1) -IH1 -HTU1 -HL12 -HT1X -HT1 // -U0 -T1 /2 width=3/ ] -| #L1 #V1 #T1 #U1 #l #HTU1 #L2 #HL12 #X #H1 #H2 #H3 #H4 destruct - elim (snv_inv_appl … H2) -H2 #a #W1 #W10 #U10 #l0 #HV1 #HT1 #HVW1 #HW10 #HTU10 - elim (tpr_inv_appl1 … H1) -H1 * - [ #V2 #T2 #HV12 #HT12 #H destruct -HV1 -HVW1 -HW10 -HTU10 - elim (IH … HTU1 L2 … HT12 HT1 ?) -IH -HTU1 -HT12 -HT1 // [2: /2 width=1/ ] -HL12 /3 width=5/ - | #b #V2 #W #T2 #T20 #HV12 #HT20 #H1 #H2 destruct - elim (snv_inv_bind … HT1) -HT1 #HW #HT2 - elim (xprs_fwd_abst1 … HTU10) -HTU10 #W11 #U11 #HW11 #H destruct - elim (ssta_inv_bind1 … HTU1) -HTU1 #U2 #HTU2 #H destruct - elim (IH … HVW1 L2 … HV12 HV1 ?) -HVW1 -HV1 // [2: /2 width=1/ ] #W2 #HVW2 #HW12 - lapply (cprs_div … HW11 … HW10) -W11 #HW1 - lapply (cpcs_cpr_strap1 … HW1 W2 ?) [ /2 width=1/ ] -W1 #HW2 - elim (IH … HTU2 (L2.ⓛW2) … HT20 HT2 ?) -IH -HT2 -HT20 // - [ /5 width=7/ | /3 width=1/ ] - | #b #V2 #V0 #W0 #W2 #T0 #T2 #HV12 #W02 #HT02 #HV20 #H1 #H2 destruct - elim (snv_inv_bind … HT1) -HT1 #HW0 #HT0 - elim (ssta_inv_bind1 … HTU1) -HTU1 #U0 #HTU0 #H destruct - - - elim (xprs_fwd_abst1 … HTU10) -HTU10 #W11 #U11 #HW11 #H destruct - +] +qed-. +(* fact snv_ltpr_tpr_aux: ∀h,g,L,T. ( ∀L1,T1,U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → ⦃h, L1⦄ ⊩ T1 :[g] → diff --git a/matita/matita/contribs/lambdadelta/basic_2/equivalence/fpcs_cpcs.ma b/matita/matita/contribs/lambdadelta/basic_2/equivalence/fpcs_cpcs.ma index 75e69cf08..2d65731b5 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/equivalence/fpcs_cpcs.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/equivalence/fpcs_cpcs.ma @@ -20,6 +20,13 @@ include "basic_2/equivalence/fpcs_fpcs.ma". (* Advanced properties ******************************************************) +lemma fpcs_flat_dx_tpr: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⬌* ⦃L2, T2⦄ → ∀V1,V2. V1 ➡ V2 → + ∀I. ⦃L1, ⓕ{I}V1.T1⦄ ⬌* ⦃L2, ⓕ{I}V2.T2⦄. +#L1 #L2 #T1 #T2 #HT12 +elim (fpcs_inv_fprs … HT12) -HT12 +/3 width=6 by fprs_flat_dx_tpr, fprs_div/ (**) (* auto too slow without trace *) +qed. + lemma fpcs_shift: ∀I,L1,L2,V1,V2,T1,T2. ⦃L1, -ⓑ{I}V1.T1⦄ ⬌* ⦃L2, -ⓑ{I}V2.T2⦄ → ⦃L1.ⓑ{I}V1, T1⦄ ⬌* ⦃L2.ⓑ{I}V2, T2⦄. #I #L1 #L2 #V1 #V2 #T1 #T2 #H12 diff --git a/matita/matita/contribs/lambdadelta/basic_2/equivalence/lsubse_ssta.ma b/matita/matita/contribs/lambdadelta/basic_2/equivalence/lsubse_ssta.ma index b5dc3f5ac..733eab050 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/equivalence/lsubse_ssta.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/equivalence/lsubse_ssta.ma @@ -12,15 +12,43 @@ (* *) (**************************************************************************) -(* -include "basic_2/computation/xprs_lsubss.ma". -*) -include "basic_2/equivalence/lsubse.ma". +include "basic_2/static/ssta_ssta.ma". +include "basic_2/equivalence/cpcs_cpcs.ma". +include "basic_2/equivalence/lsubse_ldrop.ma". (* LOCAL ENVIRONMENT REFINEMENT FOR CONTEXT-SENSITIVE PARALLEL EQUIVALENCE **) (* Properties on stratified native type assignment **************************) -axiom lsubse_ssta_trans: ∀h,g,L2,T,U2,l. ⦃h, L2⦄ ⊢ T •[g,l] U2 → +lemma lsubse_ssta_trans: ∀h,g,L2,T,U2,l. ⦃h, L2⦄ ⊢ T •[g,l] U2 → ∀L1. h ⊢ L1 ⊢•⊑[g] L2 → ∃∃U1. ⦃h, L1⦄ ⊢ T •[g,l] U1 & L1 ⊢ U1 ⬌* U2. +#h #g #L2 #T #U #l #H elim H -L2 -T -U -l +[ /3 width=3/ +| #L2 #K2 #V2 #W2 #U2 #i #l #HLK2 #_ #HWU2 #IHVW2 #L1 #HL12 + elim (lsubse_ldrop_O1_trans … HL12 … HLK2) -L2 #X #H #HLK1 + elim (lsubse_inv_pair2 … H) -H * #K1 [ | -HWU2 -IHVW2 -HLK1 ] + [ #HK12 #H destruct + elim (IHVW2 … HK12) -K2 #T2 #HVT2 #HTW2 + lapply (ldrop_fwd_ldrop2 … HLK1) #H + elim (lift_total T2 0 (i+1)) /3 width=11/ + | #W1 #V1 #W2 #l0 #_ #_ #_ #_ #_ #H destruct + ] +| #L2 #K2 #W2 #V2 #U2 #i #l #HLK2 #HWV2 #HWU2 #IHWV2 #L1 #HL12 + elim (lsubse_ldrop_O1_trans … HL12 … HLK2) -L2 #X #H #HLK1 + elim (lsubse_inv_pair2 … H) -H * #K1 [ -HWV2 | -IHWV2 ] + [ #HK12 #H destruct + elim (IHWV2 … HK12) -K2 /3 width=6/ + | #W1 #V1 #T2 #l0 #HVW1 #HWT2 #HW12 #_ #H #_ destruct + elim (ssta_mono … HWV2 … HWT2) -HWV2 -HWT2 #H1 #H2 destruct + lapply (ldrop_fwd_ldrop2 … HLK1) #H + elim (lift_total W1 0 (i+1)) /3 width=11/ + ] +| #a #I #L2 #V2 #T2 #U2 #l #_ #IHTU2 #L1 #HL12 + elim (IHTU2 (L1.ⓑ{I}V2) …) [2: /2 width=1/ ] -L2 /3 width=3/ +| #L2 #V2 #T2 #U2 #l #_ #IHTU2 #L1 #HL12 + elim (IHTU2 … HL12) -L2 /3 width=5/ +| #L2 #W2 #T2 #U2 #l #_ #IHTU2 #L1 #HL12 + elim (IHTU2 … HL12) -L2 /3 width=3/ +] +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/reducibility/fpr_cpr.ma b/matita/matita/contribs/lambdadelta/basic_2/reducibility/fpr_cpr.ma index a6f57bbf9..007681d0b 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reducibility/fpr_cpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reducibility/fpr_cpr.ma @@ -36,11 +36,17 @@ elim (le_or_ge (|K|) d) #Hd [ elim (ldrop_ltpss_sn_trans_ge … HLK … HK2 …) | elim (ldrop_ltpss_sn_trans_be … HLK … HK2 …) ] // -Hd #L2 #HL2 #HLK2 -lapply (ltpss_sn_weak_all … HL2) -K /3 width=4/ +lapply (ltpss_sn_weak_all … HL2) -K /3 width=4/ qed-. (* Advanced properties ******************************************************) +lemma fpr_flat_dx: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ➡ ⦃L2, T2⦄ → ∀V1,V2. V1 ➡ V2 → + ∀I. ⦃L1, ⓕ{I}V1.T1⦄ ➡ ⦃L2, ⓕ{I}V2.T2⦄. +#L1 #L2 #T1 #T2 #HT12 +elim (fpr_inv_all … HT12) -HT12 /4 width=4/ +qed. + lemma fpr_bind_sn: ∀L1,L2,V1,V2. ⦃L1, V1⦄ ➡ ⦃L2, V2⦄ → ∀T1,T2. T1 ➡ T2 → ∀a,I. ⦃L1, ⓑ{a,I}V1.T1⦄ ➡ ⦃L2, ⓑ{a,I}V2.T2⦄. #L1 #L2 #V1 #V2 #H #T1 #T2 #HT12 #a #I -- 2.39.2