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 *****)
∀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
]
| #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/
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
| -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] →
(* *)
(**************************************************************************)
-(*
-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.