]> matita.cs.unibo.it Git - helm.git/commitdiff
- first piece of the mutual induction for preservation finally closed!
authorFerruccio Guidi <ferruccio.guidi@unibo.it>
Wed, 13 Feb 2013 15:41:00 +0000 (15:41 +0000)
committerFerruccio Guidi <ferruccio.guidi@unibo.it>
Wed, 13 Feb 2013 15:41:00 +0000 (15:41 +0000)
- a conjecture closed

matita/matita/contribs/lambdadelta/basic_2/computation/fprs_cprs.ma
matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma
matita/matita/contribs/lambdadelta/basic_2/equivalence/fpcs_cpcs.ma
matita/matita/contribs/lambdadelta/basic_2/equivalence/lsubse_ssta.ma
matita/matita/contribs/lambdadelta/basic_2/reducibility/fpr_cpr.ma

index ef2915ceaccec734d46552a67ed8cd7de190ec9f..b65cd73f5dd237e261689d8aae9f4abd6b7782de 100644 (file)
@@ -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.
index aa6795a12a7826e31f8db1f9a95cdaff67f78e48..cb7e54413edd65f564e986b621be709fa3a5ed92 100644 (file)
@@ -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] →
index 75e69cf083a8ee38f1d141529b9c1d3ef742170a..2d65731b572d0f5fefb928b057a61215a66b1552 100644 (file)
@@ -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
index b5dc3f5ac2431f242546d94f19af7ca42f511d9f..733eab050928b90fc38299bad4d7c755603f9b70 100644 (file)
 (*                                                                        *)
 (**************************************************************************)
 
-(*
-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.
index a6f57bbf9f673dc2ba0135fb66eaaa9197d803ba..007681d0bc410f76fea0d57c3ea7020ebbc939dc 100644 (file)
@@ -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