From: Ferruccio Guidi Date: Sat, 20 Apr 2013 18:21:31 +0000 (+0000) Subject: - we are committing just the components before "reducibility" X-Git-Tag: make_still_working~1185 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=f16bbb93ecb40fa40f736e0b1158e1c7676a640a;p=helm.git - we are committing just the components before "reducibility" - first definition of "unfold" - notation bugfix - some refactoring --- diff --git a/matita/matita/contribs/lambdadelta/basic_2/grammar/lenv_px_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/grammar/lenv_px_sn.ma index e746586ae..d7cdcf595 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/grammar/lenv_px_sn.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/grammar/lenv_px_sn.ma @@ -26,7 +26,7 @@ inductive lpx_sn (R:lenv→relation term): relation lenv ≝ definition lpx_sn_confluent: relation (lenv→relation term) ≝ λR1,R2. ∀L0,T0,T1. R1 L0 T0 T1 → ∀T2. R2 L0 T0 T2 → ∀L1. lpx_sn R1 L0 L1 → ∀L2. lpx_sn R2 L0 L2 → - ∃∃T. R1 L1 T1 T & R2 L2 T2 T. + ∃∃T. R2 L1 T1 T & R1 L2 T2 T. definition lpx_sn_transitive: relation (lenv→relation term) ≝ λR1,R2. ∀L1,T1,T. R1 L1 T1 T → ∀L2. lpx_sn R1 L1 L2 → @@ -130,8 +130,9 @@ lemma lpx_sn_trans: ∀R. lpx_sn_transitive R R → Transitive … (lpx_sn R). elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL2 #HV2 #H destruct /3 width=5/ qed-. -lemma lpx_sn_conf: ∀R. lpx_sn_confluent R R → confluent … (lpx_sn R). -#R #HR #L0 @(f_ind … length … L0) -L0 #n #IH * +lemma lpx_sn_conf: ∀R1,R2. lpx_sn_confluent R1 R2 → + confluent2 … (lpx_sn R1) (lpx_sn R2). +#R1 #R2 #HR12 #L0 @(f_ind … length … L0) -L0 #n #IH * [ #_ #X1 #H1 #X2 #H2 -n >(lpx_sn_inv_atom1 … H1) -X1 >(lpx_sn_inv_atom1 … H2) -X2 /2 width=3/ @@ -139,6 +140,6 @@ lemma lpx_sn_conf: ∀R. lpx_sn_confluent R R → confluent … (lpx_sn R). elim (lpx_sn_inv_pair1 … H1) -H1 #L1 #V1 #HL01 #HV01 #H destruct elim (lpx_sn_inv_pair1 … H2) -H2 #L2 #V2 #HL02 #HV02 #H destruct elim (IH … HL01 … HL02) -IH normalize // #L #HL1 #HL2 - elim (HR … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5/ + elim (HR12 … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5/ ] qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/notation.ma b/matita/matita/contribs/lambdadelta/basic_2/notation.ma index 689d6edc2..6a5b14e62 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/notation.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/notation.ma @@ -48,7 +48,7 @@ notation "hvbox( ② { term 46 I } break term 55 T1 . break term 55 T )" non associative with precedence 55 for @{ 'SnItem2 $I $T1 $T }. -notation "hvbox( ⓑ { term 46 a , term 46 I } break term 55 T1 . break term 55 T )" +notation "hvbox( ⓑ { term 46 a , break term 46 I } break term 55 T1 . break term 55 T )" non associative with precedence 55 for @{ 'SnBind2 $a $I $T1 $T }. @@ -64,7 +64,7 @@ notation "hvbox( ⓕ { term 46 I } break term 55 T1 . break term 55 T )" non associative with precedence 55 for @{ 'SnFlat2 $I $T1 $T }. -notation "hvbox( ⓓ { term 46 a } term 55 T1 . break term 55 T2 )" +notation "hvbox( ⓓ { term 46 a } break term 55 T1 . break term 55 T2 )" non associative with precedence 55 for @{ 'SnAbbr $a $T1 $T2 }. @@ -76,7 +76,7 @@ notation "hvbox( - ⓓ term 55 T1 . break term 55 T2 )" non associative with precedence 55 for @{ 'SnAbbrNeg $T1 $T2 }. -notation "hvbox( ⓛ { term 46 a } term 55 T1 . break term 55 T2 )" +notation "hvbox( ⓛ { term 46 a } break term 55 T1 . break term 55 T2 )" non associative with precedence 55 for @{ 'SnAbst $a $T1 $T2 }. @@ -140,7 +140,7 @@ notation "hvbox( T1 ≃ break term 46 T2 )" non associative with precedence 45 for @{ 'Iso $T1 $T2 }. -(* Substitution *************************************************************) +(* Relocation ***************************************************************) notation "hvbox( ⇧ [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )" non associative with precedence 45 @@ -170,7 +170,7 @@ notation "hvbox( L ⊢ break ⌘ ⦃ term 46 T ⦄ ≡ break term 46 k )" non associative with precedence 45 for @{ 'ICM $L $T $k }. -(* Unfold *******************************************************************) +(* Substitution *************************************************************) notation "hvbox( @ ⦃ term 46 T1 , break term 46 f ⦄ ≡ break term 46 T2 )" non associative with precedence 45 @@ -204,22 +204,6 @@ notation "hvbox( T1 ⊢ ▶ * break term 46 T2 )" non associative with precedence 45 for @{ 'PSubstStarSn $T1 $T2 }. -notation "hvbox( ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )" - non associative with precedence 45 - for @{ 'TSubst $T1 $d $e $T2 }. - -notation "hvbox( L ⊢ break ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )" - non associative with precedence 45 - for @{ 'TSubst $L $T1 $d $e $T2 }. - -notation "hvbox( ▼ ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )" - non associative with precedence 45 - for @{ 'TSubstAlt $T1 $d $e $T2 }. - -notation "hvbox( L ⊢ break ▼ ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )" - non associative with precedence 45 - for @{ 'TSubstAlt $L $T1 $d $e $T2 }. - (* Static typing ************************************************************) notation "hvbox( L ⊢ break term 46 T ⁝ break term 46 A )" @@ -242,7 +226,7 @@ notation "hvbox( ⦃ term 46 h , break term 46 L ⦄ ⊢ break term 46 T1 • br non associative with precedence 45 for @{ 'StaticType $h $g $L $T1 $T2 $l }. -(* Unwind *******************************************************************) +(* Unfold *******************************************************************) notation "hvbox( ⦃ term 46 h , break term 46 L ⦄ ⊢ break term 46 T1 •* break [ term 46 g ] break term 46 T2 )" non associative with precedence 45 @@ -250,9 +234,7 @@ notation "hvbox( ⦃ term 46 h , break term 46 L ⦄ ⊢ break term 46 T1 •* b notation "hvbox( L1 ⊢ ⧫ * break term 46 T ≡ break term 46 L2 )" non associative with precedence 45 - for @{ 'Unwind $L1 $T $L2 }. - -(* Restricted ***************************************************************) + for @{ 'Unfold $L1 $T $L2 }. notation "hvbox( L ⊢ break term 46 T1 ➤ * break term 46 T2 )" non associative with precedence 45 @@ -262,7 +244,7 @@ notation "hvbox( T1 ⊢ ➤ * break term 46 T2 )" non associative with precedence 45 for @{ 'PRestStarSn $T1 $T2 }. -(* Reducibility *************************************************************) +(* Reduction ****************************************************************) notation "hvbox( L ⊢ break 𝐑 ⦃ term 46 T ⦄ )" non associative with precedence 45 @@ -314,47 +296,15 @@ notation "hvbox( L1 ⊢ ➡ break term 46 L2 )" non associative with precedence 45 for @{ 'PRedSn $L1 $L2 }. -notation "hvbox( L1 ⊢ ➡ ➡ break term 46 L2 )" - non associative with precedence 45 - for @{ 'PRedSnAlt $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1, break term 46 T1 ⦄ ➡ break ⦃ term 46 L2 , break term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRed $L1 $T1 $L2 $T2 }. - -notation "hvbox( L ⊢ break ⦃ term 46 L1, break term 46 T1 ⦄ ➡ break ⦃ term 46 L2 , break term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRed $L $L1 $T1 $L2 $T2 }. - (* Computation **************************************************************) -notation "hvbox( T1 ➡ * break term 46 T2 )" - non associative with precedence 45 - for @{ 'PRedStar $T1 $T2 }. - notation "hvbox( L ⊢ break term 46 T1 ➡ * break term 46 T2 )" non associative with precedence 45 for @{ 'PRedStar $L $T1 $T2 }. -notation "hvbox( T1 ➡ ➡ * break term 46 T2 )" +notation "hvbox( L1 ⊢ ➡* break term 46 L2 )" non associative with precedence 45 - for @{ 'PRedStarAlt $T1 $T2 }. - -notation "hvbox( ⦃ term 46 L1 ⦄ ➡ * break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRedStar $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , term 46 T1 ⦄ ➡ * break ⦃ term 46 L2 , term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRedStar $L1 $T1 $L2 $T2 }. - -notation "hvbox( ⦃ term 46 L1 ⦄ ➡ ➡ * break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRedStarAlt $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , term 46 T1 ⦄ ➡ ➡ * break ⦃ term 46 L2 , term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPRedStarAlt $L1 $T1 $L2 $T2 }. + for @{ 'PRedSnStar $L1 $L2 }. notation "hvbox( L ⊢ break term 46 T1 ➡ * break 𝐍 ⦃ term 46 T2 ⦄ )" non associative with precedence 45 @@ -394,21 +344,9 @@ notation "hvbox( L ⊢ break term 46 T1 ⬌ break term 46 T2 )" non associative with precedence 45 for @{ 'PConv $L $T1 $T2 }. -notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConv $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ break ⦃ term 46 L2 , break term 46 T2 ⦄ )" +notation "hvbox( L1 ⊢ ⬌ break term 46 L2 )" non associative with precedence 45 - for @{ 'FocalizedPConv $L1 $T1 $L2 $T2 }. - -notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ ⬌ break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConvAlt $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ ⬌ break ⦃ term 46 L2 , break term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConvAlt $L1 $T1 $L2 $T2 }. + for @{ 'PConvSn $L1 $L2 }. (* Equivalence **************************************************************) @@ -420,21 +358,9 @@ notation "hvbox( h ⊢ break term 46 L1 • ⊑ break [ term 46 g ] break term 4 non associative with precedence 45 for @{ 'CrSubEqS $h $g $L1 $L2 }. -notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ * break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConvStar $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ * break ⦃ term 46 L2 , break term 46 T2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConvStar $L1 $T1 $L2 $T2 }. - -notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ ⬌ * break ⦃ term 46 L2 ⦄ )" - non associative with precedence 45 - for @{ 'FocalizedPConvStarAlt $L1 $L2 }. - -notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ ⬌ * break ⦃ term 46 L2 , break term 46 T2 ⦄ )" +notation "hvbox( L1 ⊢ ⬌* break term 46 L2 )" non associative with precedence 45 - for @{ 'FocalizedPConvStarAlt $L1 $T1 $L2 $T2 }. + for @{ 'PConvSnStar $L1 $L2 }. (* Dynamic typing ***********************************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/fsup.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/fsup.ma new file mode 100644 index 000000000..6b0ee2185 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/fsup.ma @@ -0,0 +1,70 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop.ma". + +(* SUPCLOSURE ***************************************************************) + +inductive fsup: bi_relation lenv term ≝ +| fsup_lref : ∀I,L,V. fsup (L.ⓑ{I}V) (#0) L V +| fsup_bind_sn: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) L V +| fsup_bind_dx: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) (L.ⓑ{I}V) T +| fsup_flat_sn: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L V +| fsup_flat_dx: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L T +| fsup_ldrop : ∀L1,K1,K2,T1,T2,U1,d,e. + ⇩[d, e] L1 ≡ K1 → ⇧[d, e] T1 ≡ U1 → + fsup K1 T1 K2 T2 → fsup L1 U1 K2 T2 +. + +interpretation + "structural successor (closure)" + 'SupTerm L1 T1 L2 T2 = (fsup L1 T1 L2 T2). + +(* Basic properties *********************************************************) + +lemma fsup_lref_S_lt: ∀I,L,K,V,T,i. 0 < i → ⦃L, #(i-1)⦄ ⊃ ⦃K, T⦄ → ⦃L.ⓑ{I}V, #i⦄ ⊃ ⦃K, T⦄. +/3 width=7/ qed. + +lemma fsup_lref: ∀I,K,V,i,L. ⇩[0, i] L ≡ K.ⓑ{I}V → ⦃L, #i⦄ ⊃ ⦃K, V⦄. +#I #K #V #i @(nat_elim1 i) -i #i #IH #L #H +elim (ldrop_inv_O1_pair2 … H) -H * +[ #H1 #H2 destruct // +| #I1 #K1 #V1 #HK1 #H #Hi destruct + lapply (IH … HK1) /2 width=1/ +] +qed. + +(* Basic forward lemmas *****************************************************) + +lemma fsup_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ♯{L2, T2} < ♯{L1, T1}. +#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 // +#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 +lapply (ldrop_fwd_lw … HLK1) -HLK1 #HLK1 +lapply (lift_fwd_tw … HTU1) -HTU1 #HTU1 +@(lt_to_le_to_lt … IHT12) -IHT12 /2 width=1/ +qed-. + +fact fsup_fwd_length_lref1_aux: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀i. T1 = #i → |L2| < |L1|. +#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 +[ 6: #L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #i #H destruct + lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1 + elim (lift_inv_lref2 … HTU1) -HTU1 * #Hdei #H destruct + @(lt_to_le_to_lt … HLK1) /2 width=2/ +| normalize // |2,3: #a +] #I #L #V #T #j #H destruct +qed-. + +lemma fsup_fwd_length_lref1: ∀L1,L2,T2,i. ⦃L1, #i⦄ ⊃ ⦃L2, T2⦄ → |L2| < |L1|. +/2 width=5 by fsup_fwd_length_lref1_aux/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop.ma new file mode 100644 index 000000000..ba2be29cc --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop.ma @@ -0,0 +1,80 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/genv.ma". + +(* GLOBAL ENVIRONMENT SLICING ***********************************************) + +inductive gdrop (e:nat): relation genv ≝ +| gdrop_gt: ∀G. |G| ≤ e → gdrop e G (⋆) +| gdrop_eq: ∀G. |G| = e + 1 → gdrop e G G +| gdrop_lt: ∀I,G1,G2,V. e < |G1| → gdrop e G1 G2 → gdrop e (G1. ⓑ{I} V) G2 +. + +interpretation "global slicing" + 'RDrop e G1 G2 = (gdrop e G1 G2). + +(* basic inversion lemmas ***************************************************) + +lemma gdrop_inv_gt: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| ≤ e → G2 = ⋆. +#G1 #G2 #e * -G1 -G2 // +[ #G #H >H -H >commutative_plus #H + lapply (le_plus_to_le_r … 0 H) -H #H + lapply (le_n_O_to_eq … H) -H #H destruct +| #I #G1 #G2 #V #H1 #_ #H2 + lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 normalize in ⊢ (? % ? → ?); >commutative_plus #H + lapply (lt_plus_to_lt_l … 0 H) -H #H + elim (lt_zero_false … H) +] +qed-. + +lemma gdrop_inv_eq: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| = e + 1 → G1 = G2. +#G1 #G2 #e * -G1 -G2 // +[ #G #H1 #H2 >H2 in H1; -H2 >commutative_plus #H + lapply (le_plus_to_le_r … 0 H) -H #H + lapply (le_n_O_to_eq … H) -H #H destruct +| #I #G1 #G2 #V #H1 #_ normalize #H2 + <(injective_plus_l … H2) in H1; -H2 #H + elim (lt_refl_false … H) +] +qed-. + +fact gdrop_inv_lt_aux: ∀I,G,G1,G2,V,e. ⇩[e] G ≡ G2 → G = G1. ⓑ{I} V → + e < |G1| → ⇩[e] G1 ≡ G2. +#I #G #G1 #G2 #V #e * -G -G2 +[ #G #H1 #H destruct #H2 + lapply (le_to_lt_to_lt … H1 H2) -H1 -H2 normalize in ⊢ (? % ? → ?); >commutative_plus #H + lapply (lt_plus_to_lt_l … 0 H) -H #H + elim (lt_zero_false … H) +| #G #H1 #H2 destruct >(injective_plus_l … H1) -H1 #H + elim (lt_refl_false … H) +| #J #G #G2 #W #_ #HG2 #H destruct // +] +qed. + +lemma gdrop_inv_lt: ∀I,G1,G2,V,e. + ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2. +/2 width=5/ qed-. + +(* Basic properties *********************************************************) + +lemma gdrop_total: ∀e,G1. ∃G2. ⇩[e] G1 ≡ G2. +#e #G1 elim G1 -G1 /3 width=2/ +#I #V #G1 * #G2 #HG12 +elim (lt_or_eq_or_gt e (|G1|)) #He +[ /3 width=2/ +| destruct /3 width=2/ +| @ex_intro [2: @gdrop_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *) +] +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop_gdrop.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop_gdrop.ma new file mode 100644 index 000000000..a133e29c6 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/gdrop_gdrop.ma @@ -0,0 +1,40 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/gdrop.ma". + +(* GLOBAL ENVIRONMENT SLICING ***********************************************) + +(* Main properties **********************************************************) + +theorem gdrop_mono: ∀G,G1,e. ⇩[e] G ≡ G1 → ∀G2. ⇩[e] G ≡ G2 → G1 = G2. +#G #G1 #e #H elim H -G -G1 +[ #G #He #G2 #H + >(gdrop_inv_gt … H He) -H -He // +| #G #He #G2 #H + >(gdrop_inv_eq … H He) -H -He // +| #I #G #G1 #V #He #_ #IHG1 #G2 #H + lapply (gdrop_inv_lt … H He) -H -He /2 width=1/ +] +qed-. + +lemma gdrop_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2). +#G1 #G2 #e +elim (gdrop_total e G1) #G #HG1 +elim (genv_eq_dec G G2) #HG2 +[ destruct /2 width=1/ +| @or_intror #HG12 + lapply (gdrop_mono … HG1 … HG12) -HG1 -HG12 /2 width=1/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop.ma new file mode 100644 index 000000000..6d91d0aa0 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop.ma @@ -0,0 +1,330 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/cl_weight.ma". +include "basic_2/relocation/lift.ma". +include "basic_2/relocation/lsubr.ma". + +(* LOCAL ENVIRONMENT SLICING ************************************************) + +(* Basic_1: includes: drop_skip_bind *) +inductive ldrop: nat → nat → relation lenv ≝ +| ldrop_atom : ∀d,e. ldrop d e (⋆) (⋆) +| ldrop_pair : ∀L,I,V. ldrop 0 0 (L. ⓑ{I} V) (L. ⓑ{I} V) +| ldrop_ldrop: ∀L1,L2,I,V,e. ldrop 0 e L1 L2 → ldrop 0 (e + 1) (L1. ⓑ{I} V) L2 +| ldrop_skip : ∀L1,L2,I,V1,V2,d,e. + ldrop d e L1 L2 → ⇧[d,e] V2 ≡ V1 → + ldrop (d + 1) e (L1. ⓑ{I} V1) (L2. ⓑ{I} V2) +. + +interpretation "local slicing" 'RDrop d e L1 L2 = (ldrop d e L1 L2). + +definition l_liftable: (lenv → relation term) → Prop ≝ + λR. ∀K,T1,T2. R K T1 T2 → ∀L,d,e. ⇩[d, e] L ≡ K → + ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2. + +definition l_deliftable_sn: (lenv → relation term) → Prop ≝ + λR. ∀L,U1,U2. R L U1 U2 → ∀K,d,e. ⇩[d, e] L ≡ K → + ∀T1. ⇧[d, e] T1 ≡ U1 → + ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2. + +definition dropable_sn: relation lenv → Prop ≝ + λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀L2. R L1 L2 → + ∃∃K2. R K1 K2 & ⇩[d, e] L2 ≡ K2. + +definition dedropable_sn: relation lenv → Prop ≝ + λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀K2. R K1 K2 → + ∃∃L2. R L1 L2 & ⇩[d, e] L2 ≡ K2. + +definition dropable_dx: relation lenv → Prop ≝ + λR. ∀L1,L2. R L1 L2 → ∀K2,e. ⇩[0, e] L2 ≡ K2 → + ∃∃K1. ⇩[0, e] L1 ≡ K1 & R K1 K2. + +(* Basic inversion lemmas ***************************************************) + +fact ldrop_inv_refl_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → e = 0 → L1 = L2. +#d #e #L1 #L2 * -d -e -L1 -L2 +[ // +| // +| #L1 #L2 #I #V #e #_ #_ >commutative_plus normalize #H destruct +| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct +] +qed. + +(* Basic_1: was: drop_gen_refl *) +lemma ldrop_inv_refl: ∀L1,L2. ⇩[0, 0] L1 ≡ L2 → L1 = L2. +/2 width=5/ qed-. + +fact ldrop_inv_atom1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → L1 = ⋆ → + L2 = ⋆. +#d #e #L1 #L2 * -d -e -L1 -L2 +[ // +| #L #I #V #H destruct +| #L1 #L2 #I #V #e #_ #H destruct +| #L1 #L2 #I #V1 #V2 #d #e #_ #_ #H destruct +] +qed. + +(* Basic_1: was: drop_gen_sort *) +lemma ldrop_inv_atom1: ∀d,e,L2. ⇩[d, e] ⋆ ≡ L2 → L2 = ⋆. +/2 width=5/ qed-. + +fact ldrop_inv_O1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → + ∀K,I,V. L1 = K. ⓑ{I} V → + (e = 0 ∧ L2 = K. ⓑ{I} V) ∨ + (0 < e ∧ ⇩[d, e - 1] K ≡ L2). +#d #e #L1 #L2 * -d -e -L1 -L2 +[ #d #e #_ #K #I #V #H destruct +| #L #I #V #_ #K #J #W #HX destruct /3 width=1/ +| #L1 #L2 #I #V #e #HL12 #_ #K #J #W #H destruct /3 width=1/ +| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct +] +qed. + +lemma ldrop_inv_O1: ∀e,K,I,V,L2. ⇩[0, e] K. ⓑ{I} V ≡ L2 → + (e = 0 ∧ L2 = K. ⓑ{I} V) ∨ + (0 < e ∧ ⇩[0, e - 1] K ≡ L2). +/2 width=3/ qed-. + +lemma ldrop_inv_pair1: ∀K,I,V,L2. ⇩[0, 0] K. ⓑ{I} V ≡ L2 → L2 = K. ⓑ{I} V. +#K #I #V #L2 #H +elim (ldrop_inv_O1 … H) -H * // #H destruct +elim (lt_refl_false … H) +qed-. + +(* Basic_1: was: drop_gen_drop *) +lemma ldrop_inv_ldrop1: ∀e,K,I,V,L2. + ⇩[0, e] K. ⓑ{I} V ≡ L2 → 0 < e → ⇩[0, e - 1] K ≡ L2. +#e #K #I #V #L2 #H #He +elim (ldrop_inv_O1 … H) -H * // #H destruct +elim (lt_refl_false … He) +qed-. + +fact ldrop_inv_skip1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d → + ∀I,K1,V1. L1 = K1. ⓑ{I} V1 → + ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 & + ⇧[d - 1, e] V2 ≡ V1 & + L2 = K2. ⓑ{I} V2. +#d #e #L1 #L2 * -d -e -L1 -L2 +[ #d #e #_ #I #K #V #H destruct +| #L #I #V #H elim (lt_refl_false … H) +| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H) +| #X #L2 #Y #Z #V2 #d #e #HL12 #HV12 #_ #I #L1 #V1 #H destruct /2 width=5/ +] +qed. + +(* Basic_1: was: drop_gen_skip_l *) +lemma ldrop_inv_skip1: ∀d,e,I,K1,V1,L2. ⇩[d, e] K1. ⓑ{I} V1 ≡ L2 → 0 < d → + ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 & + ⇧[d - 1, e] V2 ≡ V1 & + L2 = K2. ⓑ{I} V2. +/2 width=3/ qed-. + +lemma ldrop_inv_O1_pair2: ∀I,K,V,e,L1. ⇩[0, e] L1 ≡ K. ⓑ{I} V → + (e = 0 ∧ L1 = K. ⓑ{I} V) ∨ + ∃∃I1,K1,V1. ⇩[0, e - 1] K1 ≡ K. ⓑ{I} V & L1 = K1.ⓑ{I1}V1 & 0 < e. +#I #K #V #e * +[ #H lapply (ldrop_inv_atom1 … H) -H #H destruct +| #L1 #I1 #V1 #H + elim (ldrop_inv_O1 … H) -H * + [ #H1 #H2 destruct /3 width=1/ + | /3 width=5/ + ] +] +qed-. + +fact ldrop_inv_skip2_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d → + ∀I,K2,V2. L2 = K2. ⓑ{I} V2 → + ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & + ⇧[d - 1, e] V2 ≡ V1 & + L1 = K1. ⓑ{I} V1. +#d #e #L1 #L2 * -d -e -L1 -L2 +[ #d #e #_ #I #K #V #H destruct +| #L #I #V #H elim (lt_refl_false … H) +| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H) +| #L1 #X #Y #V1 #Z #d #e #HL12 #HV12 #_ #I #L2 #V2 #H destruct /2 width=5/ +] +qed. + +(* Basic_1: was: drop_gen_skip_r *) +lemma ldrop_inv_skip2: ∀d,e,I,L1,K2,V2. ⇩[d, e] L1 ≡ K2. ⓑ{I} V2 → 0 < d → + ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & ⇧[d - 1, e] V2 ≡ V1 & + L1 = K1. ⓑ{I} V1. +/2 width=3/ qed-. + +(* Basic properties *********************************************************) + +(* Basic_1: was by definition: drop_refl *) +lemma ldrop_refl: ∀L. ⇩[0, 0] L ≡ L. +#L elim L -L // +qed. + +lemma ldrop_ldrop_lt: ∀L1,L2,I,V,e. + ⇩[0, e - 1] L1 ≡ L2 → 0 < e → ⇩[0, e] L1. ⓑ{I} V ≡ L2. +#L1 #L2 #I #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/ +qed. + +lemma ldrop_skip_lt: ∀L1,L2,I,V1,V2,d,e. + ⇩[d - 1, e] L1 ≡ L2 → ⇧[d - 1, e] V2 ≡ V1 → 0 < d → + ⇩[d, e] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2. +#L1 #L2 #I #V1 #V2 #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) // /2 width=1/ +qed. + +lemma ldrop_O1_le: ∀i,L. i ≤ |L| → ∃K. ⇩[0, i] L ≡ K. +#i @(nat_ind_plus … i) -i /2 width=2/ +#i #IHi * +[ #H lapply (le_n_O_to_eq … H) -H >commutative_plus normalize #H destruct +| #L #I #V normalize #H + elim (IHi L ?) -IHi /2 width=1/ -H /3 width=2/ +] +qed. + +lemma ldrop_O1_lt: ∀L,i. i < |L| → ∃∃I,K,V. ⇩[0, i] L ≡ K.ⓑ{I}V. +#L elim L -L +[ #i #H elim (lt_zero_false … H) +| #L #I #V #IHL #i @(nat_ind_plus … i) -i /2 width=4/ + #i #_ normalize #H + elim (IHL i ? ) -IHL /2 width=1/ -H /3 width=4/ +] +qed. + +lemma ldrop_lsubr_ldrop2_abbr: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + ∀K2,V,i. ⇩[0, i] L2 ≡ K2. ⓓV → + d ≤ i → i < d + e → + ∃∃K1. K1 ⊑ [0, d + e - i - 1] K2 & + ⇩[0, i] L1 ≡ K1. ⓓV. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e +[ #d #e #K1 #V #i #H + lapply (ldrop_inv_atom1 … H) -H #H destruct +| #L1 #L2 #K1 #V #i #_ #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #V #e #HL12 #IHL12 #K1 #W #i #H #_ #Hie + elim (ldrop_inv_O1 … H) -H * #Hi #HLK1 + [ -IHL12 -Hie destruct + minus_minus_comm >arith_b1 // /4 width=3/ + ] +| #L1 #L2 #I #V1 #V2 #e #_ #IHL12 #K1 #W #i #H #_ #Hie + elim (ldrop_inv_O1 … H) -H * #Hi #HLK1 + [ -IHL12 -Hie -Hi destruct + | elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /3 width=3/ + ] +| #L1 #L2 #I1 #I2 #V1 #V2 #d #e #_ #IHL12 #K1 #V #i #H #Hdi >plus_plus_comm_23 #Hide + elim (le_inv_plus_l … Hdi) #Hdim #Hi + lapply (ldrop_inv_ldrop1 … H ?) -H // #HLK1 + elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hdi -Hide >minus_minus_comm >arith_b1 // /3 width=3/ +] +qed. + +lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R). +#R #HR #L1 #K1 #d #e #HLK1 #L2 #H elim H -L2 +[ #L2 #HL12 + elim (HR … HLK1 … HL12) -HR -L1 /3 width=3/ +| #L #L2 #_ #HL2 * #K #HK1 #HLK + elim (HR … HLK … HL2) -HR -L /3 width=3/ +] +qed. + +lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R). +#R #HR #L1 #K1 #d #e #HLK1 #K2 #H elim H -K2 +[ #K2 #HK12 + elim (HR … HLK1 … HK12) -HR -K1 /3 width=3/ +| #K #K2 #_ #HK2 * #L #HL1 #HLK + elim (HR … HLK … HK2) -HR -K /3 width=3/ +] +qed. + +lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R). +#R #HR #L1 #L2 #H elim H -L2 +[ #L2 #HL12 #K2 #e #HLK2 + elim (HR … HL12 … HLK2) -HR -L2 /3 width=3/ +| #L #L2 #_ #HL2 #IHL1 #K2 #e #HLK2 + elim (HR … HL2 … HLK2) -HR -L2 #K #HLK #HK2 + elim (IHL1 … HLK) -L /3 width=5/ +] +qed. + +(* Basic forvard lemmas *****************************************************) + +(* Basic_1: was: drop_S *) +lemma ldrop_fwd_ldrop2: ∀L1,I2,K2,V2,e. ⇩[O, e] L1 ≡ K2. ⓑ{I2} V2 → + ⇩[O, e + 1] L1 ≡ K2. +#L1 elim L1 -L1 +[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct +| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H + elim (ldrop_inv_O1 … H) -H * #He #H + [ -IHL1 destruct /2 width=1/ + | @ldrop_ldrop >(plus_minus_m_m e 1) // /2 width=3/ + ] +] +qed-. + +lemma ldrop_fwd_length: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → |L2| ≤ |L1|. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize /2 width=1/ +qed-. + +lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ♯{L2} ≤ ♯{L1}. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize +[ /2 width=3/ +| #L1 #L2 #I #V1 #V2 #d #e #_ #HV21 #IHL12 + >(lift_fwd_tw … HV21) -HV21 /2 width=1/ +] +qed-. + +lemma ldrop_pair2_fwd_fw: ∀I,L,K,V,d,e. ⇩[d, e] L ≡ K. ⓑ{I} V → + ∀T. ♯{K, V} < ♯{L, T}. +#I #L #K #V #d #e #H #T +lapply (ldrop_fwd_lw … H) -H #H +@(le_to_lt_to_lt … H) -H /3 width=1/ +qed-. + +lemma ldrop_fwd_ldrop2_length: ∀L1,I2,K2,V2,e. + ⇩[0, e] L1 ≡ K2. ⓑ{I2} V2 → e < |L1|. +#L1 elim L1 -L1 +[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct +| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H + elim (ldrop_inv_O1 … H) -H * #He #H + [ -IHL1 destruct // + | lapply (IHL1 … H) -IHL1 -H #HeK1 whd in ⊢ (? ? %); /2 width=1/ + ] +] +qed-. + +lemma ldrop_fwd_O1_length: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → |L2| = |L1| - e. +#L1 elim L1 -L1 +[ #L2 #e #H >(ldrop_inv_atom1 … H) -H // +| #K1 #I1 #V1 #IHL1 #L2 #e #H + elim (ldrop_inv_O1 … H) -H * #He #H + [ -IHL1 destruct // + | lapply (IHL1 … H) -IHL1 -H #H >H -H normalize + >minus_le_minus_minus_comm // + ] +] +qed-. + +(* Basic_1: removed theorems 50: + drop_ctail drop_skip_flat + cimp_flat_sx cimp_flat_dx cimp_bind cimp_getl_conf + drop_clear drop_clear_O drop_clear_S + clear_gen_sort clear_gen_bind clear_gen_flat clear_gen_flat_r + clear_gen_all clear_clear clear_mono clear_trans clear_ctail clear_cle + getl_ctail_clen getl_gen_tail clear_getl_trans getl_clear_trans + getl_clear_bind getl_clear_conf getl_dec getl_drop getl_drop_conf_lt + getl_drop_conf_ge getl_conf_ge_drop getl_drop_conf_rev + drop_getl_trans_lt drop_getl_trans_le drop_getl_trans_ge + getl_drop_trans getl_flt getl_gen_all getl_gen_sort getl_gen_O + getl_gen_S getl_gen_2 getl_gen_flat getl_gen_bind getl_conf_le + getl_trans getl_refl getl_head getl_flat getl_ctail getl_mono +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_append.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_append.ma new file mode 100644 index 000000000..762911576 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_append.ma @@ -0,0 +1,64 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop.ma". + +(* DROPPING *****************************************************************) + +(* Properties on append for local environments ******************************) + +fact ldrop_O1_append_sn_le_aux: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → + d = 0 → e ≤ |L1| → + ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize // /4 width=1/ +#d #e #_ #H #L -d +lapply (le_n_O_to_eq … H) -H // +qed-. + +lemma ldrop_O1_append_sn_le: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → e ≤ |L1| → + ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2. +/2 width=3 by ldrop_O1_append_sn_le_aux/ qed. + +(* Inversion lemmas on append for local environments ************************) + +lemma ldrop_O1_inv_append1_ge: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → + |L2| ≤ e → ⇩[0, e - |L2|] L1 ≡ K. +#K #L1 #L2 elim L2 -L2 normalize // +#L2 #I #V #IHL2 #e #H #H1e +elim (ldrop_inv_O1 … H) -H * #H2e #HL12 destruct +[ lapply (le_n_O_to_eq … H1e) -H1e -IHL2 + >commutative_plus normalize #H destruct +| minus_minus_comm /3 width=1/ +] +qed-. + +lemma ldrop_O1_inv_append1_le: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → e ≤ |L2| → + ∀K2. ⇩[0, e] L2 ≡ K2 → K = L1 @@ K2. +#K #L1 #L2 elim L2 -L2 normalize +[ #e #H1 #H2 #K2 #H3 + lapply (le_n_O_to_eq … H2) -H2 #H2 + lapply (ldrop_inv_atom1 … H3) -H3 #H3 destruct + >(ldrop_inv_refl … H1) -H1 // +| #L2 #I #V #IHL2 #e @(nat_ind_plus … e) -e [ -IHL2 ] + [ #H1 #_ #K2 #H2 + lapply (ldrop_inv_refl … H1) -H1 #H1 + lapply (ldrop_inv_refl … H2) -H2 #H2 destruct // + | #e #_ #H1 #H #K2 #H2 + lapply (le_plus_to_le_r … H) -H + lapply (ldrop_inv_ldrop1 … H1 ?) -H1 // + lapply (ldrop_inv_ldrop1 … H2 ?) -H2 // + (H0 I L V 0 ? ? ?) // + /5 width=6 by lbotr_abbr, ldrop_ldrop, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *) +| #d #_ #e #H0 + /5 width=6 by lbotr_skip, ldrop_ldrop, le_S_S, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *) +] +qed. + +lemma lbotr_ldrop_trans_le: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 → + dd + ee ≤ d → ⊒[dd, ee] L2. +#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee +@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2 +lapply (lt_to_le_to_lt … Hiddee Hddee) -Hddee #Hid +elim (ldrop_trans_le … HL12 … HLK2 ?) -L2 /2 width=2/ #X #HLK1 #H +elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K1 #V1 #HK12 #HV21 #H destruct +@(lbotr_inv_ldrop … HLK1 … HL1) -L1 -K1 -V1 // +qed. + +lemma lbotr_ldrop_trans_be_up: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → + ∀dd,ee. ⊒[dd, ee] L1 → + dd ≤ d + e → d + e ≤ dd + ee → + ⊒[d, dd + ee - d - e] L2. +#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hdde #Hddee +@lbotr_ldrop #I #K2 #V2 #i #Hdi #Hiddee #HLK2 +lapply (transitive_le ? ? (i+e)… Hdde ?) -Hdde /2 width=1/ #Hddie +>commutative_plus in Hiddee; >minus_minus_comm commutative_plus // -Hddie /2 width=1/ +qed. + +lemma lbotr_ldrop_trans_ge: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 → + d + e ≤ dd → ⊒[dd - e, ee] L2. +#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee +@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2 +elim (le_inv_plus_l … Hddee) -Hddee #Hdde #Hedd +>plus_minus in Hiddee; // #Hiddee +lapply (transitive_le … Hdde Hddi) -Hdde #Hid +lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hid #HL1K2 +@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus /2 width=1/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_ldrop.ma new file mode 100644 index 000000000..88f37fcfb --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_ldrop.ma @@ -0,0 +1,176 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift_lift.ma". +include "basic_2/relocation/ldrop.ma". + +(* DROPPING *****************************************************************) + +(* Main properties **********************************************************) + +(* Basic_1: was: drop_mono *) +theorem ldrop_mono: ∀d,e,L,L1. ⇩[d, e] L ≡ L1 → + ∀L2. ⇩[d, e] L ≡ L2 → L1 = L2. +#d #e #L #L1 #H elim H -d -e -L -L1 +[ #d #e #L2 #H + >(ldrop_inv_atom1 … H) -L2 // +| #K #I #V #L2 #HL12 + <(ldrop_inv_refl … HL12) -L2 // +| #L #K #I #V #e #_ #IHLK #L2 #H + lapply (ldrop_inv_ldrop1 … H ?) -H // /2 width=1/ +| #L #K1 #I #T #V1 #d #e #_ #HVT1 #IHLK1 #X #H + elim (ldrop_inv_skip1 … H ?) -H // (lift_inj … HVT1 … HVT2) -HVT1 -HVT2 + >(IHLK1 … HLK2) -IHLK1 -HLK2 // +] +qed-. + +(* Basic_1: was: drop_conf_ge *) +theorem ldrop_conf_ge: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 → + ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 + e1 ≤ e2 → + ⇩[0, e2 - e1] L1 ≡ L2. +#d1 #e1 #L #L1 #H elim H -d1 -e1 -L -L1 +[ #d #e #e2 #L2 #H + >(ldrop_inv_atom1 … H) -L2 // +| // +| #L #K #I #V #e #_ #IHLK #e2 #L2 #H #He2 + lapply (ldrop_inv_ldrop1 … H ?) -H /2 width=2/ #HL2 + minus_minus_comm /3 width=1/ +| #L #K #I #V1 #V2 #d #e #_ #_ #IHLK #e2 #L2 #H #Hdee2 + lapply (transitive_le 1 … Hdee2) // #He2 + lapply (ldrop_inv_ldrop1 … H ?) -H // -He2 #HL2 + lapply (transitive_le (1 + e) … Hdee2) // #Hee2 + @ldrop_ldrop_lt >minus_minus_comm /3 width=1/ (**) (* explicit constructor *) +] +qed. + +(* Note: apparently this was missing in basic_1 *) +theorem ldrop_conf_be: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 → + ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 → + ∃∃L. ⇩[0, d1 + e1 - e2] L2 ≡ L & ⇩[0, d1] L1 ≡ L. +#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1 +[ #d1 #e1 #L2 #e2 #H >(ldrop_inv_atom1 … H) -H /2 width=3/ +| normalize #L #I #V #L2 #e2 #HL2 #_ #He2 + lapply (le_n_O_to_eq … He2) -He2 #H destruct + lapply (ldrop_inv_refl … HL2) -HL2 #H destruct /2 width=3/ +| normalize #L0 #K0 #I #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21 + lapply (ldrop_inv_O1 … H) -H * * #He2 #HL20 + [ -IHLK0 -He21 destruct plus_plus_comm_23 #_ #_ #IHLK0 #L2 #e2 #H #Hd1e2 #He2de1 + elim (le_inv_plus_l … Hd1e2) #_ #He2 + minus_le_minus_minus_comm // /3 width=3/ + ] +] +qed. + +(* Basic_1: was: drop_trans_ge *) +theorem ldrop_trans_ge: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L → + ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → ⇩[0, e1 + e2] L1 ≡ L2. +#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L +[ #d #e #e2 #L2 #H + >(ldrop_inv_atom1 … H) -H -L2 // +| // +| /3 width=1/ +| #L1 #L2 #I #V1 #V2 #d #e #H_ #_ #IHL12 #e2 #L #H #Hde2 + lapply (lt_to_le_to_lt 0 … Hde2) // #He2 + lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2 + lapply (ldrop_inv_ldrop1 … H ?) -H // #HL2 + @ldrop_ldrop_lt // >le_plus_minus // @IHL12 /2 width=1/ (**) (* explicit constructor *) +] +qed. + +(* Basic_1: was: drop_trans_le *) +theorem ldrop_trans_le: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L → + ∀e2,L2. ⇩[0, e2] L ≡ L2 → e2 ≤ d1 → + ∃∃L0. ⇩[0, e2] L1 ≡ L0 & ⇩[d1 - e2, e1] L0 ≡ L2. +#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L +[ #d #e #e2 #L2 #H + >(ldrop_inv_atom1 … H) -L2 /2 width=3/ +| #K #I #V #e2 #L2 #HL2 #H + lapply (le_n_O_to_eq … H) -H #H destruct /2 width=3/ +| #L1 #L2 #I #V #e #_ #IHL12 #e2 #L #HL2 #H + lapply (le_n_O_to_eq … H) -H #H destruct + elim (IHL12 … HL2 ?) -IHL12 -HL2 // #L0 #H #HL0 + lapply (ldrop_inv_refl … H) -H #H destruct /3 width=5/ +| #L1 #L2 #I #V1 #V2 #d #e #HL12 #HV12 #IHL12 #e2 #L #H #He2d + elim (ldrop_inv_O1 … H) -H * + [ -He2d -IHL12 #H1 #H2 destruct /3 width=5/ + | -HL12 -HV12 #He2 #HL2 + elim (IHL12 … HL2 ?) -L2 [ >minus_le_minus_minus_comm // /3 width=3/ | /2 width=1/ ] + ] +] +qed. + +(* Basic_1: was: drop_conf_rev *) +axiom ldrop_div: ∀e1,L1,L. ⇩[0, e1] L1 ≡ L → ∀e2,L2. ⇩[0, e2] L2 ≡ L → + ∃∃L0. ⇩[0, e1] L0 ≡ L2 & ⇩[e1, e2] L0 ≡ L1. + +(* Basic_1: was: drop_conf_lt *) +lemma ldrop_conf_lt: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 → + ∀e2,K2,I,V2. ⇩[0, e2] L ≡ K2. ⓑ{I} V2 → + e2 < d1 → let d ≝ d1 - e2 - 1 in + ∃∃K1,V1. ⇩[0, e2] L1 ≡ K1. ⓑ{I} V1 & + ⇩[d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2. +#d1 #e1 #L #L1 #H1 #e2 #K2 #I #V2 #H2 #He2d1 +elim (ldrop_conf_le … H1 … H2 ?) -L [2: /2 width=2/] #K #HL1K #HK2 +elim (ldrop_inv_skip1 … HK2 ?) -HK2 [2: /2 width=1/] #K1 #V1 #HK21 #HV12 #H destruct /2 width=5/ +qed. + +lemma ldrop_trans_ge_comm: ∀d1,e1,e2,L1,L2,L. + ⇩[d1, e1] L1 ≡ L → ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → + ⇩[0, e2 + e1] L1 ≡ L2. +#e1 #e1 #e2 >commutative_plus /2 width=5/ +qed. + +lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[0, e1] L ≡ K. ⓑ{I1} V1 → + ∀I2,V2,e2. ⇩[0, e2] L ≡ K. ⓑ{I2} V2 → + ∧∧ e1 = e2 & I1 = I2 & V1 = V2. +#I1 #L #K #V1 #e1 #HLK1 #I2 #V2 #e2 #HLK2 +elim (le_or_ge e1 e2) #He +[ lapply (ldrop_conf_ge … HLK1 … HLK2 ?) +| lapply (ldrop_conf_ge … HLK2 … HLK1 ?) +] -HLK1 -HLK2 // #HK +lapply (ldrop_fwd_O1_length … HK) #H +elim (discr_minus_x_xy … H) -H +[1,3: normalize H in HK; #HK +lapply (ldrop_inv_refl … HK) -HK #H destruct +lapply (inv_eq_minus_O … H) -H /3 width=1/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx.ma new file mode 100644 index 000000000..d23ed28e5 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx.ma @@ -0,0 +1,68 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/lenv_px.ma". +include "basic_2/relocation/ldrop.ma". + +(* DROPPING *****************************************************************) + +(* Properties on pointwise extension ****************************************) + +lemma lpx_deliftable_dropable: ∀R. t_deliftable_sn R → dropable_sn (lpx R). +#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e +[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/ +| #K1 #I #V1 #X #H + elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/ +| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H + elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct + elim (IHLK1 … HL12) -L1 /3 width=3/ +| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H + elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct + elim (HR … HV12 … HWV1) -V1 + elim (IHLK1 … HL12) -L1 /3 width=5/ +] +qed. + +lemma lpx_liftable_dedropable: ∀R. reflexive ? R → + t_liftable R → dedropable_sn (lpx R). +#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e +[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/ +| #K1 #I #V1 #X #H + elim (lpx_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/ +| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12 + elim (IHLK1 … HK12) -K1 /3 width=5/ +| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H + elim (lpx_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct + elim (lift_total W2 d e) #V2 #HWV2 + lapply (H2R … HW12 … HWV1 … HWV2) -W1 + elim (IHLK1 … HK12) -K1 /3 width=5/ +] +qed. + +fact lpx_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx R L1 L2 → + d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx R K1 K2. +#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e +[ #d #e #X #H >(lpx_inv_atom2 … H) -H /2 width=3/ +| #K2 #I #V2 #X #H + elim (lpx_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/ +| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_ + elim (lpx_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct + elim (IHLK2 … HL12 ?) -L2 // /3 width=3/ +| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_ + >commutative_plus normalize #H destruct +] +qed-. + +lemma lpx_dropable: ∀R. dropable_dx (lpx R). +/2 width=5 by lpx_dropable_aux/ qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx_sn.ma new file mode 100644 index 000000000..98a7c7157 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_lpx_sn.ma @@ -0,0 +1,68 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/lenv_px_sn.ma". +include "basic_2/relocation/ldrop.ma". + +(* DROPPING *****************************************************************) + +(* Properties on sn pointwise extension *************************************) + +lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R). +#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e +[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/ +| #K1 #I #V1 #X #H + elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/ +| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H + elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct + elim (IHLK1 … HL12) -L1 /3 width=3/ +| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H + elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct + elim (HR … HV12 … HLK1 … HWV1) -V1 + elim (IHLK1 … HL12) -L1 /3 width=5/ +] +qed-. + +lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) → + l_liftable R → dedropable_sn (lpx_sn R). +#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e +[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/ +| #K1 #I #V1 #X #H + elim (lpx_sn_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/ +| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12 + elim (IHLK1 … HK12) -K1 /3 width=5/ +| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H + elim (lpx_sn_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct + elim (lift_total W2 d e) #V2 #HWV2 + lapply (H2R … HW12 … HLK1 … HWV1 … HWV2) -W1 + elim (IHLK1 … HK12) -K1 /3 width=5/ +] +qed-. + +fact lpx_sn_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 → + d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx_sn R K1 K2. +#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e +[ #d #e #X #H >(lpx_sn_inv_atom2 … H) -H /2 width=3/ +| #K2 #I #V2 #X #H + elim (lpx_sn_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/ +| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_ + elim (lpx_sn_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct + elim (IHLK2 … HL12 ?) -L2 // /3 width=3/ +| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_ + >commutative_plus normalize #H destruct +] +qed-. + +lemma lpx_sn_dropable: ∀R. dropable_dx (lpx_sn R). +/2 width=5 by lpx_sn_dropable_aux/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lift.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift.ma new file mode 100644 index 000000000..7e7961eab --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift.ma @@ -0,0 +1,403 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/term_weight.ma". +include "basic_2/grammar/term_simple.ma". + +(* BASIC TERM RELOCATION ****************************************************) + +(* Basic_1: includes: + lift_sort lift_lref_lt lift_lref_ge lift_bind lift_flat +*) +inductive lift: nat → nat → relation term ≝ +| lift_sort : ∀k,d,e. lift d e (⋆k) (⋆k) +| lift_lref_lt: ∀i,d,e. i < d → lift d e (#i) (#i) +| lift_lref_ge: ∀i,d,e. d ≤ i → lift d e (#i) (#(i + e)) +| lift_gref : ∀p,d,e. lift d e (§p) (§p) +| lift_bind : ∀a,I,V1,V2,T1,T2,d,e. + lift d e V1 V2 → lift (d + 1) e T1 T2 → + lift d e (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2) +| lift_flat : ∀I,V1,V2,T1,T2,d,e. + lift d e V1 V2 → lift d e T1 T2 → + lift d e (ⓕ{I} V1. T1) (ⓕ{I} V2. T2) +. + +interpretation "relocation" 'RLift d e T1 T2 = (lift d e T1 T2). + +definition t_liftable: relation term → Prop ≝ + λR. ∀T1,T2. R T1 T2 → ∀U1,d,e. ⇧[d, e] T1 ≡ U1 → + ∀U2. ⇧[d, e] T2 ≡ U2 → R U1 U2. + +definition t_deliftable_sn: relation term → Prop ≝ + λR. ∀U1,U2. R U1 U2 → ∀T1,d,e. ⇧[d, e] T1 ≡ U1 → + ∃∃T2. ⇧[d, e] T2 ≡ U2 & R T1 T2. + +(* Basic inversion lemmas ***************************************************) + +fact lift_inv_refl_O2_aux: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → e = 0 → T1 = T2. +#d #e #T1 #T2 #H elim H -d -e -T1 -T2 // /3 width=1/ +qed. + +lemma lift_inv_refl_O2: ∀d,T1,T2. ⇧[d, 0] T1 ≡ T2 → T1 = T2. +/2 width=4/ qed-. + +fact lift_inv_sort1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T1 = ⋆k → T2 = ⋆k. +#d #e #T1 #T2 * -d -e -T1 -T2 // +[ #i #d #e #_ #k #H destruct +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +] +qed. + +lemma lift_inv_sort1: ∀d,e,T2,k. ⇧[d,e] ⋆k ≡ T2 → T2 = ⋆k. +/2 width=5/ qed-. + +fact lift_inv_lref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T1 = #i → + (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)). +#d #e #T1 #T2 * -d -e -T1 -T2 +[ #k #d #e #i #H destruct +| #j #d #e #Hj #i #Hi destruct /3 width=1/ +| #j #d #e #Hj #i #Hi destruct /3 width=1/ +| #p #d #e #i #H destruct +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct +] +qed. + +lemma lift_inv_lref1: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → + (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)). +/2 width=3/ qed-. + +lemma lift_inv_lref1_lt: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → i < d → T2 = #i. +#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * // +#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd +elim (lt_refl_false … Hdd) +qed-. + +lemma lift_inv_lref1_ge: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → d ≤ i → T2 = #(i + e). +#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * // +#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd +elim (lt_refl_false … Hdd) +qed-. + +fact lift_inv_gref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T1 = §p → T2 = §p. +#d #e #T1 #T2 * -d -e -T1 -T2 // +[ #i #d #e #_ #k #H destruct +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +] +qed. + +lemma lift_inv_gref1: ∀d,e,T2,p. ⇧[d,e] §p ≡ T2 → T2 = §p. +/2 width=5/ qed-. + +fact lift_inv_bind1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → + ∀a,I,V1,U1. T1 = ⓑ{a,I} V1.U1 → + ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 & + T2 = ⓑ{a,I} V2. U2. +#d #e #T1 #T2 * -d -e -T1 -T2 +[ #k #d #e #a #I #V1 #U1 #H destruct +| #i #d #e #_ #a #I #V1 #U1 #H destruct +| #i #d #e #_ #a #I #V1 #U1 #H destruct +| #p #d #e #a #I #V1 #U1 #H destruct +| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V1 #U1 #H destruct /2 width=5/ +| #J #W1 #W2 #T1 #T2 #d #e #_ #HT #a #I #V1 #U1 #H destruct +] +qed. + +lemma lift_inv_bind1: ∀d,e,T2,a,I,V1,U1. ⇧[d,e] ⓑ{a,I} V1. U1 ≡ T2 → + ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 & + T2 = ⓑ{a,I} V2. U2. +/2 width=3/ qed-. + +fact lift_inv_flat1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → + ∀I,V1,U1. T1 = ⓕ{I} V1.U1 → + ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 & + T2 = ⓕ{I} V2. U2. +#d #e #T1 #T2 * -d -e -T1 -T2 +[ #k #d #e #I #V1 #U1 #H destruct +| #i #d #e #_ #I #V1 #U1 #H destruct +| #i #d #e #_ #I #V1 #U1 #H destruct +| #p #d #e #I #V1 #U1 #H destruct +| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V1 #U1 #H destruct +| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V1 #U1 #H destruct /2 width=5/ +] +qed. + +lemma lift_inv_flat1: ∀d,e,T2,I,V1,U1. ⇧[d,e] ⓕ{I} V1. U1 ≡ T2 → + ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 & + T2 = ⓕ{I} V2. U2. +/2 width=3/ qed-. + +fact lift_inv_sort2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T2 = ⋆k → T1 = ⋆k. +#d #e #T1 #T2 * -d -e -T1 -T2 // +[ #i #d #e #_ #k #H destruct +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct +] +qed. + +(* Basic_1: was: lift_gen_sort *) +lemma lift_inv_sort2: ∀d,e,T1,k. ⇧[d,e] T1 ≡ ⋆k → T1 = ⋆k. +/2 width=5/ qed-. + +fact lift_inv_lref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T2 = #i → + (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)). +#d #e #T1 #T2 * -d -e -T1 -T2 +[ #k #d #e #i #H destruct +| #j #d #e #Hj #i #Hi destruct /3 width=1/ +| #j #d #e #Hj #i #Hi destruct (plus_minus_m_m i e) in ⊢ (? ? ? ? %); /2 width=2/ /3 width=2/ +qed. + +lemma lift_lref_ge_minus_eq: ∀d,e,i,j. d + e ≤ i → j = i - e → ⇧[d, e] #j ≡ #i. +/2 width=1/ qed-. + +(* Basic_1: was: lift_r *) +lemma lift_refl: ∀T,d. ⇧[d, 0] T ≡ T. +#T elim T -T +[ * #i // #d elim (lt_or_ge i d) /2 width=1/ +| * /2 width=1/ +] +qed. + +lemma lift_total: ∀T1,d,e. ∃T2. ⇧[d,e] T1 ≡ T2. +#T1 elim T1 -T1 +[ * #i /2 width=2/ #d #e elim (lt_or_ge i d) /3 width=2/ +| * [ #a ] #I #V1 #T1 #IHV1 #IHT1 #d #e + elim (IHV1 d e) -IHV1 #V2 #HV12 + [ elim (IHT1 (d+1) e) -IHT1 /3 width=2/ + | elim (IHT1 d e) -IHT1 /3 width=2/ + ] +] +qed. + +(* Basic_1: was: lift_free (right to left) *) +lemma lift_split: ∀d1,e2,T1,T2. ⇧[d1, e2] T1 ≡ T2 → + ∀d2,e1. d1 ≤ d2 → d2 ≤ d1 + e1 → e1 ≤ e2 → + ∃∃T. ⇧[d1, e1] T1 ≡ T & ⇧[d2, e2 - e1] T ≡ T2. +#d1 #e2 #T1 #T2 #H elim H -d1 -e2 -T1 -T2 +[ /3 width=3/ +| #i #d1 #e2 #Hid1 #d2 #e1 #Hd12 #_ #_ + lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 /4 width=3/ +| #i #d1 #e2 #Hid1 #d2 #e1 #_ #Hd21 #He12 + lapply (transitive_le … (i+e1) Hd21 ?) /2 width=1/ -Hd21 #Hd21 + >(plus_minus_m_m e2 e1 ?) // /3 width=3/ +| /3 width=3/ +| #a #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12 + elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b + elim (IHT (d2+1) … ? ? He12) /2 width=1/ /3 width=5/ +| #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12 + elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b + elim (IHT d2 … ? ? He12) // /3 width=5/ +] +qed. + +(* Basic_1: was only: dnf_dec2 dnf_dec *) +lemma is_lift_dec: ∀T2,d,e. Decidable (∃T1. ⇧[d,e] T1 ≡ T2). +#T1 elim T1 -T1 +[ * [1,3: /3 width=2/ ] #i #d #e + elim (lt_dec i d) #Hid + [ /4 width=2/ + | lapply (false_lt_to_le … Hid) -Hid #Hid + elim (lt_dec i (d + e)) #Hide + [ @or_intror * #T1 #H + elim (lift_inv_lref2_be … H Hid Hide) + | lapply (false_lt_to_le … Hide) -Hide /4 width=2/ + ] + ] +| * [ #a ] #I #V2 #T2 #IHV2 #IHT2 #d #e + [ elim (IHV2 d e) -IHV2 + [ * #V1 #HV12 elim (IHT2 (d+1) e) -IHT2 + [ * #T1 #HT12 @or_introl /3 width=2/ + | -V1 #HT2 @or_intror * #X #H + elim (lift_inv_bind2 … H) -H /3 width=2/ + ] + | -IHT2 #HV2 @or_intror * #X #H + elim (lift_inv_bind2 … H) -H /3 width=2/ + ] + | elim (IHV2 d e) -IHV2 + [ * #V1 #HV12 elim (IHT2 d e) -IHT2 + [ * #T1 #HT12 /4 width=2/ + | -V1 #HT2 @or_intror * #X #H + elim (lift_inv_flat2 … H) -H /3 width=2/ + ] + | -IHT2 #HV2 @or_intror * #X #H + elim (lift_inv_flat2 … H) -H /3 width=2/ + ] + ] +] +qed. + +lemma t_liftable_TC: ∀R. t_liftable R → t_liftable (TC … R). +#R #HR #T1 #T2 #H elim H -T2 +[ /3 width=7/ +| #T #T2 #_ #HT2 #IHT1 #U1 #d #e #HTU1 #U2 #HTU2 + elim (lift_total T d e) /3 width=9/ +] +qed. + +lemma t_deliftable_sn_TC: ∀R. t_deliftable_sn R → t_deliftable_sn (TC … R). +#R #HR #U1 #U2 #H elim H -U2 +[ #U2 #HU12 #T1 #d #e #HTU1 + elim (HR … HU12 … HTU1) -U1 /3 width=3/ +| #U #U2 #_ #HU2 #IHU1 #T1 #d #e #HTU1 + elim (IHU1 … HTU1) -U1 #T #HTU #HT1 + elim (HR … HU2 … HTU) -U /3 width=5/ +] +qed-. + +(* Basic_1: removed theorems 7: + lift_head lift_gen_head + lift_weight_map lift_weight lift_weight_add lift_weight_add_O + lift_tlt_dx +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift.ma new file mode 100644 index 000000000..c0805dd87 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift.ma @@ -0,0 +1,217 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift.ma". + +(* BASIC TERM RELOCATION ****************************************************) + +(* Main properies ***********************************************************) + +(* Basic_1: was: lift_inj *) +theorem lift_inj: ∀d,e,T1,U. ⇧[d,e] T1 ≡ U → ∀T2. ⇧[d,e] T2 ≡ U → T1 = T2. +#d #e #T1 #U #H elim H -d -e -T1 -U +[ #k #d #e #X #HX + lapply (lift_inv_sort2 … HX) -HX // +| #i #d #e #Hid #X #HX + lapply (lift_inv_lref2_lt … HX ?) -HX // +| #i #d #e #Hdi #X #HX + lapply (lift_inv_lref2_ge … HX ?) -HX // /2 width=1/ +| #p #d #e #X #HX + lapply (lift_inv_gref2 … HX) -HX // +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX + elim (lift_inv_bind2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX + elim (lift_inv_flat2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ +] +qed-. + +(* Basic_1: was: lift_gen_lift *) +theorem lift_div_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → + ∀d2,e2,T2. ⇧[d2 + e1, e2] T2 ≡ T → + d1 ≤ d2 → + ∃∃T0. ⇧[d1, e1] T0 ≡ T2 & ⇧[d2, e2] T0 ≡ T1. +#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T +[ #k #d1 #e1 #d2 #e2 #T2 #Hk #Hd12 + lapply (lift_inv_sort2 … Hk) -Hk #Hk destruct /3 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12 + lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 + lapply (lift_inv_lref2_lt … Hi ?) -Hi /2 width=3/ /3 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12 + elim (lift_inv_lref2 … Hi) -Hi * #Hid2 #H destruct + [ -Hd12 lapply (lt_plus_to_lt_l … Hid2) -Hid2 #Hid2 /3 width=3/ + | -Hid1 >plus_plus_comm_23 in Hid2; #H lapply (le_plus_to_le_r … H) -H #H + elim (le_inv_plus_l … H) -H #Hide2 #He2i + lapply (transitive_le … Hd12 Hide2) -Hd12 #Hd12 + >le_plus_minus_comm // >(plus_minus_m_m i e2) in ⊢ (? ? ? %); // -He2i + /4 width=3/ + ] +| #p #d1 #e1 #d2 #e2 #T2 #Hk #Hd12 + lapply (lift_inv_gref2 … Hk) -Hk #Hk destruct /3 width=3/ +| #a #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12 + lapply (lift_inv_bind2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct + elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1 + >plus_plus_comm_23 in HU2; #HU2 elim (IHU … HU2 ?) /2 width=1/ /3 width=5/ +| #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12 + lapply (lift_inv_flat2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct + elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1 + elim (IHU … HU2 ?) // /3 width=5/ +] +qed. + +(* Note: apparently this was missing in basic_1 *) +theorem lift_div_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → + ∀e,e2,T2. ⇧[d1 + e, e2] T2 ≡ T → + e ≤ e1 → e1 ≤ e + e2 → + ∃∃T0. ⇧[d1, e] T0 ≡ T2 & ⇧[d1, e + e2 - e1] T0 ≡ T1. +#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T +[ #k #d1 #e1 #e #e2 #T2 #H >(lift_inv_sort2 … H) -H /2 width=3/ +| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2 + >(lift_inv_lref2_lt … H) -H [ /3 width=3/ | /2 width=3/ ] +| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2 + elim (lt_or_ge (i+e1) (d1+e+e2)) #Hie1d1e2 + [ elim (lift_inv_lref2_be … H ? ?) -H // /2 width=1/ + | >(lift_inv_lref2_ge … H ?) -H // + lapply (le_plus_to_minus … Hie1d1e2) #Hd1e21i + elim (le_inv_plus_l … Hie1d1e2) -Hie1d1e2 #Hd1e12 #He2ie1 + @ex2_intro [2: /2 width=1/ | skip ] -Hd1e12 + @lift_lref_ge_minus_eq [ >plus_minus_commutative // | /2 width=1/ ] + ] +| #p #d1 #e1 #e #e2 #T2 #H >(lift_inv_gref2 … H) -H /2 width=3/ +| #a #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2 + elim (lift_inv_bind2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct + elim (IHV1 … HV2 ? ?) -V // >plus_plus_comm_23 in HT2; #HT2 + elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/ +| #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2 + elim (lift_inv_flat2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct + elim (IHV1 … HV2 ? ?) -V // + elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/ +] +qed. + +theorem lift_mono: ∀d,e,T,U1. ⇧[d,e] T ≡ U1 → ∀U2. ⇧[d,e] T ≡ U2 → U1 = U2. +#d #e #T #U1 #H elim H -d -e -T -U1 +[ #k #d #e #X #HX + lapply (lift_inv_sort1 … HX) -HX // +| #i #d #e #Hid #X #HX + lapply (lift_inv_lref1_lt … HX ?) -HX // +| #i #d #e #Hdi #X #HX + lapply (lift_inv_lref1_ge … HX ?) -HX // +| #p #d #e #X #HX + lapply (lift_inv_gref1 … HX) -HX // +| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX + elim (lift_inv_bind1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ +| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX + elim (lift_inv_flat1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ +] +qed-. + +(* Basic_1: was: lift_free (left to right) *) +theorem lift_trans_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → + ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → + d1 ≤ d2 → d2 ≤ d1 + e1 → ⇧[d1, e1 + e2] T1 ≡ T2. +#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T +[ #k #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_ + >(lift_inv_sort1 … HT2) -HT2 // +| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #Hd12 #_ + lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 + lapply (lift_inv_lref1_lt … HT2 Hid2) /2 width=1/ +| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #_ #Hd21 + lapply (lift_inv_lref1_ge … HT2 ?) -HT2 + [ @(transitive_le … Hd21 ?) -Hd21 /2 width=1/ + | -Hd21 /2 width=1/ + ] +| #p #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_ + >(lift_inv_gref1 … HT2) -HT2 // +| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21 + elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct + lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10 + lapply (IHT12 … HT20 ? ?) /2 width=1/ +| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21 + elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct + lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10 + lapply (IHT12 … HT20 ? ?) // /2 width=1/ +] +qed. + +(* Basic_1: was: lift_d (right to left) *) +theorem lift_trans_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → + ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d2 ≤ d1 → + ∃∃T0. ⇧[d2, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T0 ≡ T2. +#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T +[ #k #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_sort1 … HX) -HX /2 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_ + lapply (lt_to_le_to_lt … (d1+e2) Hid1 ?) // #Hie2 + elim (lift_inv_lref1 … HX) -HX * #Hid2 #HX destruct /3 width=3/ /4 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hd21 + lapply (transitive_le … Hd21 Hid1) -Hd21 #Hid2 + lapply (lift_inv_lref1_ge … HX ?) -HX /2 width=3/ #HX destruct + >plus_plus_comm_23 /4 width=3/ +| #p #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_gref1 … HX) -HX /2 width=3/ +| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21 + elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct + elim (IHV12 … HV20 ?) -IHV12 -HV20 // + elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ /3 width=5/ +| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21 + elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct + elim (IHV12 … HV20 ?) -IHV12 -HV20 // + elim (IHT12 … HT20 ?) -IHT12 -HT20 // /3 width=5/ +] +qed. + +(* Basic_1: was: lift_d (left to right) *) +theorem lift_trans_ge: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → + ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d1 + e1 ≤ d2 → + ∃∃T0. ⇧[d2 - e1, e2] T1 ≡ T0 & ⇧[d1, e1] T0 ≡ T2. +#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T +[ #k #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_sort1 … HX) -HX /2 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hded + lapply (lt_to_le_to_lt … (d1+e1) Hid1 ?) // #Hid1e + lapply (lt_to_le_to_lt … (d2-e1) Hid1 ?) /2 width=1/ #Hid2e + lapply (lt_to_le_to_lt … Hid1e Hded) -Hid1e -Hded #Hid2 + lapply (lift_inv_lref1_lt … HX ?) -HX // #HX destruct /3 width=3/ +| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_ + elim (lift_inv_lref1 … HX) -HX * #Hied #HX destruct /4 width=3/ +| #p #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_gref1 … HX) -HX /2 width=3/ +| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded + elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct + elim (IHV12 … HV20 ?) -IHV12 -HV20 // + elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ #T + (lift_mono … H … HT1) -T // +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift_vector.ma new file mode 100644 index 000000000..f3ff80d11 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_lift_vector.ma @@ -0,0 +1,30 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift_lift.ma". +include "basic_2/relocation/lift_vector.ma". + +(* BASIC TERM VECTOR RELOCATION *********************************************) + +(* Main properies ***********************************************************) + +theorem liftv_mono: ∀Ts,U1s,d,e. ⇧[d,e] Ts ≡ U1s → + ∀U2s:list term. ⇧[d,e] Ts ≡ U2s → U1s = U2s. +#Ts #U1s #d #e #H elim H -Ts -U1s +[ #U2s #H >(liftv_inv_nil1 … H) -H // +| #Ts #U1s #T #U1 #HTU1 #_ #IHTU1s #X #H destruct + elim (liftv_inv_cons1 … H) -H #U2 #U2s #HTU2 #HTU2s #H destruct + >(lift_mono … HTU1 … HTU2) -T /3 width=1/ +] +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_vector.ma new file mode 100644 index 000000000..482eea166 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_vector.ma @@ -0,0 +1,62 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/term_vector.ma". +include "basic_2/relocation/lift.ma". + +(* BASIC TERM VECTOR RELOCATION *********************************************) + +inductive liftv (d,e:nat) : relation (list term) ≝ +| liftv_nil : liftv d e ◊ ◊ +| liftv_cons: ∀T1s,T2s,T1,T2. + ⇧[d, e] T1 ≡ T2 → liftv d e T1s T2s → + liftv d e (T1 @ T1s) (T2 @ T2s) +. + +interpretation "relocation (vector)" 'RLift d e T1s T2s = (liftv d e T1s T2s). + +(* Basic inversion lemmas ***************************************************) + +fact liftv_inv_nil1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → T1s = ◊ → T2s = ◊. +#T1s #T2s #d #e * -T1s -T2s // +#T1s #T2s #T1 #T2 #_ #_ #H destruct +qed. + +lemma liftv_inv_nil1: ∀T2s,d,e. ⇧[d, e] ◊ ≡ T2s → T2s = ◊. +/2 width=5/ qed-. + +fact liftv_inv_cons1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → + ∀U1,U1s. T1s = U1 @ U1s → + ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s & + T2s = U2 @ U2s. +#T1s #T2s #d #e * -T1s -T2s +[ #U1 #U1s #H destruct +| #T1s #T2s #T1 #T2 #HT12 #HT12s #U1 #U1s #H destruct /2 width=5/ +] +qed. + +lemma liftv_inv_cons1: ∀U1,U1s,T2s,d,e. ⇧[d, e] U1 @ U1s ≡ T2s → + ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s & + T2s = U2 @ U2s. +/2 width=3/ qed-. + +(* Basic properties *********************************************************) + +lemma liftv_total: ∀d,e. ∀T1s:list term. ∃T2s. ⇧[d, e] T1s ≡ T2s. +#d #e #T1s elim T1s -T1s +[ /2 width=2/ +| #T1 #T1s * #T2s #HT12s + elim (lift_total T1 d e) /3 width=2/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr.ma new file mode 100644 index 000000000..89359533a --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr.ma @@ -0,0 +1,194 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/lenv_length.ma". + +(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************) + +inductive lsubr: nat → nat → relation lenv ≝ +| lsubr_sort: ∀d,e. lsubr d e (⋆) (⋆) +| lsubr_OO: ∀L1,L2. lsubr 0 0 L1 L2 +| lsubr_abbr: ∀L1,L2,V,e. lsubr 0 e L1 L2 → + lsubr 0 (e + 1) (L1. ⓓV) (L2.ⓓV) +| lsubr_abst: ∀L1,L2,I,V1,V2,e. lsubr 0 e L1 L2 → + lsubr 0 (e + 1) (L1. ⓑ{I}V1) (L2. ⓛV2) +| lsubr_skip: ∀L1,L2,I1,I2,V1,V2,d,e. + lsubr d e L1 L2 → lsubr (d + 1) e (L1. ⓑ{I1} V1) (L2. ⓑ{I2} V2) +. + +interpretation + "local environment refinement (substitution)" + 'SubEq L1 d e L2 = (lsubr d e L1 L2). + +definition lsubr_trans: ∀S. (lenv → relation S) → Prop ≝ λS,R. + ∀L2,s1,s2. R L2 s1 s2 → + ∀L1,d,e. L1 ⊑ [d, e] L2 → R L1 s1 s2. + +(* Basic properties *********************************************************) + +lemma lsubr_bind_eq: ∀L1,L2,e. L1 ⊑ [0, e] L2 → ∀I,V. + L1. ⓑ{I} V ⊑ [0, e + 1] L2.ⓑ{I} V. +#L1 #L2 #e #HL12 #I #V elim I -I /2 width=1/ +qed. + +lemma lsubr_abbr_lt: ∀L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e → + L1. ⓓV ⊑ [0, e] L2.ⓓV. +#L1 #L2 #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/ +qed. + +lemma lsubr_abst_lt: ∀L1,L2,I,V1,V2,e. L1 ⊑ [0, e - 1] L2 → 0 < e → + L1. ⓑ{I}V1 ⊑ [0, e] L2. ⓛV2. +#L1 #L2 #I #V1 #V2 #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/ +qed. + +lemma lsubr_skip_lt: ∀L1,L2,d,e. L1 ⊑ [d - 1, e] L2 → 0 < d → + ∀I1,I2,V1,V2. L1. ⓑ{I1} V1 ⊑ [d, e] L2. ⓑ{I2} V2. +#L1 #L2 #d #e #HL12 #Hd >(plus_minus_m_m d 1) // /2 width=1/ +qed. + +lemma lsubr_bind_lt: ∀I,L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e → + L1. ⓓV ⊑ [0, e] L2. ⓑ{I}V. +* /2 width=1/ qed. + +lemma lsubr_refl: ∀d,e,L. L ⊑ [d, e] L. +#d elim d -d +[ #e elim e -e // #e #IHe #L elim L -L // /2 width=1/ +| #d #IHd #e #L elim L -L // /2 width=1/ +] +qed. + +lemma TC_lsubr_trans: ∀S,R. lsubr_trans S R → lsubr_trans S (λL. (TC … (R L))). +#S #R #HR #L1 #s1 #s2 #H elim H -s2 +[ /3 width=5/ +| #s #s2 #_ #Hs2 #IHs1 #L2 #d #e #HL12 + lapply (HR … Hs2 … HL12) -HR -Hs2 -HL12 /3 width=3/ +] +qed. + +(* Basic inversion lemmas ***************************************************) + +fact lsubr_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L1 = ⋆ → + L2 = ⋆ ∨ (d = 0 ∧ e = 0). +#L1 #L2 #d #e * -L1 -L2 -d -e +[ /2 width=1/ +| /3 width=1/ +| #L1 #L2 #W #e #_ #H destruct +| #L1 #L2 #I #W1 #W2 #e #_ #H destruct +| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct +] +qed. + +lemma lsubr_inv_atom1: ∀L2,d,e. ⋆ ⊑ [d, e] L2 → + L2 = ⋆ ∨ (d = 0 ∧ e = 0). +/2 width=3/ qed-. + +fact lsubr_inv_skip1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + ∀I1,K1,V1. L1 = K1.ⓑ{I1}V1 → 0 < d → + ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #d #e #I1 #K1 #V1 #H destruct +| #L1 #L2 #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/ +] +qed. + +lemma lsubr_inv_skip1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊑ [d, e] L2 → 0 < d → + ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2. +/2 width=5/ qed-. + +fact lsubr_inv_atom2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L2 = ⋆ → + L1 = ⋆ ∨ (d = 0 ∧ e = 0). +#L1 #L2 #d #e * -L1 -L2 -d -e +[ /2 width=1/ +| /3 width=1/ +| #L1 #L2 #W #e #_ #H destruct +| #L1 #L2 #I #W1 #W2 #e #_ #H destruct +| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct +] +qed. + +lemma lsubr_inv_atom2: ∀L1,d,e. L1 ⊑ [d, e] ⋆ → + L1 = ⋆ ∨ (d = 0 ∧ e = 0). +/2 width=3/ qed-. + +fact lsubr_inv_abbr2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + ∀K2,V. L2 = K2.ⓓV → d = 0 → 0 < e → + ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #d #e #K1 #V #H destruct +| #L1 #L2 #K1 #V #_ #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #W #e #HL12 #K1 #V #H #_ #_ destruct /2 width=3/ +| #L1 #L2 #I #W1 #W2 #e #_ #K1 #V #H destruct +| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #K1 #V #_ >commutative_plus normalize #H destruct +] +qed. + +lemma lsubr_inv_abbr2: ∀L1,K2,V,e. L1 ⊑ [0, e] K2.ⓓV → 0 < e → + ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV. +/2 width=5/ qed-. + +fact lsubr_inv_skip2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + ∀I2,K2,V2. L2 = K2.ⓑ{I2}V2 → 0 < d → + ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #d #e #I1 #K1 #V1 #H destruct +| #L1 #L2 #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H + elim (lt_zero_false … H) +| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/ +] +qed. + +lemma lsubr_inv_skip2: ∀I2,L1,K2,V2,d,e. L1 ⊑ [d, e] K2.ⓑ{I2}V2 → 0 < d → + ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1. +/2 width=5/ qed-. + +(* Basic forward lemmas *****************************************************) + +fact lsubr_fwd_length_full1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + d = 0 → e = |L1| → |L1| ≤ |L2|. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize +[ // +| /2 width=1/ +| /3 width=1/ +| /3 width=1/ +| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct +] +qed. + +lemma lsubr_fwd_length_full1: ∀L1,L2. L1 ⊑ [0, |L1|] L2 → |L1| ≤ |L2|. +/2 width=5/ qed-. + +fact lsubr_fwd_length_full2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → + d = 0 → e = |L2| → |L2| ≤ |L1|. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize +[ // +| /2 width=1/ +| /3 width=1/ +| /3 width=1/ +| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct +] +qed. + +lemma lsubr_fwd_length_full2: ∀L1,L2. L1 ⊑ [0, |L2|] L2 → |L2| ≤ |L1|. +/2 width=5/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr_lbotr.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr_lbotr.ma new file mode 100644 index 000000000..26a9530d0 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsubr_lbotr.ma @@ -0,0 +1,73 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lsubr.ma". + +(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************) + +(* bottom element of the refinement *) +definition lbotr: nat → nat → predicate lenv ≝ + λd,e. NF_sn … (lsubr d e) (lsubr d e …). + +interpretation + "local environment full refinement (substitution)" + 'SubEqBottom d e L = (lbotr d e L). + +(* Basic properties *********************************************************) + +lemma lbotr_atom: ∀d,e. ⊒[d, e] ⋆. +#d #e #L #H +elim (lsubr_inv_atom2 … H) -H +[ #H destruct // +| * #H1 #H2 destruct // +] +qed. + +lemma lbotr_OO: ∀L. ⊒[0, 0] L. +// qed. + +lemma lbotr_abbr: ∀L,V,e. ⊒[0, e] L → ⊒[0, e + 1] L.ⓓV. +#L #V #e #HL #K #H +elim (lsubr_inv_abbr2 … H ?) -H // shift_append_assoc normalize #H + elim (cpss_inv_bind1 … H) -H + #V0 #T0 #_ #HT10 #H destruct + elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct + >append_length >HL12 -HL12 + @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *) +] +qed-. + +(* Basic_1: removed theorems 27: + subst0_gen_sort subst0_gen_lref subst0_gen_head subst0_gen_lift_lt + subst0_gen_lift_false subst0_gen_lift_ge subst0_refl subst0_trans + subst0_lift_lt subst0_lift_ge subst0_lift_ge_S subst0_lift_ge_s + subst0_subst0 subst0_subst0_back subst0_weight_le subst0_weight_lt + subst0_confluence_neq subst0_confluence_eq subst0_tlt_head + subst0_confluence_lift subst0_tlt + subst1_head subst1_gen_head subst1_lift_S subst1_confluence_lift + subst1_gen_lift_eq subst1_confluence_neq +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpss_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpss_lift.ma new file mode 100644 index 000000000..9745b6cde --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpss_lift.ma @@ -0,0 +1,71 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/cpss.ma". + +(* CONTEXT-SENSITIVE PARALLEL SUBSTITUTION FOR TERMS ************************) + +(* Relocation properties ****************************************************) + +(* Basic_1: was only: subst1_lift_lt subst1_lift_ge *) +lemma cpss_lift: l_liftable cpss. +#K #T1 #T2 #H elim H -K -T1 -T2 +[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2 + >(lift_mono … H1 … H2) -H1 -H2 // +| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2 + elim (lift_inv_lref1 … H) * #Hid #H destruct + [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // plus_plus_comm_23 #HVU2 + lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/ + ] +| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 + elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct + elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/ +| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 + elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct + elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/ +] +qed. + +(* Basic_1: was only: subst1_gen_lift_lt subst1_gen_lift_ge *) +lemma cpss_inv_lift1: l_deliftable_sn cpss. +#L #U1 #U2 #H elim H -L -U1 -U2 +[ * #L #i #K #d #e #_ #T1 #H + [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/ + | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/ + | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/ + ] +| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H + elim (lift_inv_lref2 … H) -H * #Hid #H destruct + [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV + elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2 + elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus plus_minus // H -H >commutative_plus #H - lapply (le_plus_to_le_r … 0 H) -H #H - lapply (le_n_O_to_eq … H) -H #H destruct -| #I #G1 #G2 #V #H1 #_ #H2 - lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 normalize in ⊢ (? % ? → ?); >commutative_plus #H - lapply (lt_plus_to_lt_l … 0 H) -H #H - elim (lt_zero_false … H) -] -qed-. - -lemma gdrop_inv_eq: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| = e + 1 → G1 = G2. -#G1 #G2 #e * -G1 -G2 // -[ #G #H1 #H2 >H2 in H1; -H2 >commutative_plus #H - lapply (le_plus_to_le_r … 0 H) -H #H - lapply (le_n_O_to_eq … H) -H #H destruct -| #I #G1 #G2 #V #H1 #_ normalize #H2 - <(injective_plus_l … H2) in H1; -H2 #H - elim (lt_refl_false … H) -] -qed-. - -fact gdrop_inv_lt_aux: ∀I,G,G1,G2,V,e. ⇩[e] G ≡ G2 → G = G1. ⓑ{I} V → - e < |G1| → ⇩[e] G1 ≡ G2. -#I #G #G1 #G2 #V #e * -G -G2 -[ #G #H1 #H destruct #H2 - lapply (le_to_lt_to_lt … H1 H2) -H1 -H2 normalize in ⊢ (? % ? → ?); >commutative_plus #H - lapply (lt_plus_to_lt_l … 0 H) -H #H - elim (lt_zero_false … H) -| #G #H1 #H2 destruct >(injective_plus_l … H1) -H1 #H - elim (lt_refl_false … H) -| #J #G #G2 #W #_ #HG2 #H destruct // -] -qed. - -lemma gdrop_inv_lt: ∀I,G1,G2,V,e. - ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2. -/2 width=5/ qed-. - -(* Basic properties *********************************************************) - -lemma gdrop_total: ∀e,G1. ∃G2. ⇩[e] G1 ≡ G2. -#e #G1 elim G1 -G1 /3 width=2/ -#I #V #G1 * #G2 #HG12 -elim (lt_or_eq_or_gt e (|G1|)) #He -[ /3 width=2/ -| destruct /3 width=2/ -| @ex_intro [2: @gdrop_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *) -] -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gdrop_gdrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gdrop_gdrop.ma deleted file mode 100644 index 0bc1a40d5..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/gdrop_gdrop.ma +++ /dev/null @@ -1,40 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/gdrop.ma". - -(* GLOBAL ENVIRONMENT SLICING ***********************************************) - -(* Main properties **********************************************************) - -theorem gdrop_mono: ∀G,G1,e. ⇩[e] G ≡ G1 → ∀G2. ⇩[e] G ≡ G2 → G1 = G2. -#G #G1 #e #H elim H -G -G1 -[ #G #He #G2 #H - >(gdrop_inv_gt … H He) -H -He // -| #G #He #G2 #H - >(gdrop_inv_eq … H He) -H -He // -| #I #G #G1 #V #He #_ #IHG1 #G2 #H - lapply (gdrop_inv_lt … H He) -H -He /2 width=1/ -] -qed-. - -lemma gdrop_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2). -#G1 #G2 #e -elim (gdrop_total e G1) #G #HG1 -elim (genv_eq_dec G G2) #HG2 -[ destruct /2 width=1/ -| @or_intror #HG12 - lapply (gdrop_mono … HG1 … HG12) -HG1 -HG12 /2 width=1/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2.ma new file mode 100644 index 000000000..562b79530 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2.ma @@ -0,0 +1,73 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/term_vector.ma". + +(* GENERIC RELOCATION WITH PAIRS ********************************************) + +inductive at: list2 nat nat → relation nat ≝ +| at_nil: ∀i. at ⟠ i i +| at_lt : ∀des,d,e,i1,i2. i1 < d → + at des i1 i2 → at ({d, e} @ des) i1 i2 +| at_ge : ∀des,d,e,i1,i2. d ≤ i1 → + at des (i1 + e) i2 → at ({d, e} @ des) i1 i2 +. + +interpretation "application (generic relocation with pairs)" + 'RAt i1 des i2 = (at des i1 i2). + +(* Basic inversion lemmas ***************************************************) + +fact at_inv_nil_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 → des = ⟠ → i1 = i2. +#des #i1 #i2 * -des -i1 -i2 +[ // +| #des #d #e #i1 #i2 #_ #_ #H destruct +| #des #d #e #i1 #i2 #_ #_ #H destruct +] +qed. + +lemma at_inv_nil: ∀i1,i2. @⦃i1, ⟠⦄ ≡ i2 → i1 = i2. +/2 width=3/ qed-. + +fact at_inv_cons_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 → + ∀d,e,des0. des = {d, e} @ des0 → + i1 < d ∧ @⦃i1, des0⦄ ≡ i2 ∨ + d ≤ i1 ∧ @⦃i1 + e, des0⦄ ≡ i2. +#des #i1 #i2 * -des -i1 -i2 +[ #i #d #e #des #H destruct +| #des1 #d1 #e1 #i1 #i2 #Hid1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/ +| #des1 #d1 #e1 #i1 #i2 #Hdi1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/ +] +qed. + +lemma at_inv_cons: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 → + i1 < d ∧ @⦃i1, des⦄ ≡ i2 ∨ + d ≤ i1 ∧ @⦃i1 + e, des⦄ ≡ i2. +/2 width=3/ qed-. + +lemma at_inv_cons_lt: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 → + i1 < d → @⦃i1, des⦄ ≡ i2. +#des #d #e #i1 #e2 #H +elim (at_inv_cons … H) -H * // #Hdi1 #_ #Hi1d +lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd +elim (lt_refl_false … Hd) +qed-. + +lemma at_inv_cons_ge: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 → + d ≤ i1 → @⦃i1 + e, des⦄ ≡ i2. +#des #d #e #i1 #e2 #H +elim (at_inv_cons … H) -H * // #Hi1d #_ #Hdi1 +lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd +elim (lt_refl_false … Hd) +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_gr2.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_gr2.ma new file mode 100644 index 000000000..9e8ced3a8 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_gr2.ma @@ -0,0 +1,29 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/gr2.ma". + +(* GENERIC RELOCATION WITH PAIRS ********************************************) + +(* Main properties **********************************************************) + +theorem at_mono: ∀des,i,i1. @⦃i, des⦄ ≡ i1 → ∀i2. @⦃i, des⦄ ≡ i2 → i1 = i2. +#des #i #i1 #H elim H -des -i -i1 +[ #i #x #H <(at_inv_nil … H) -x // +| #des #d #e #i #i1 #Hid #_ #IHi1 #x #H + lapply (at_inv_cons_lt … H Hid) -H -Hid /2 width=1/ +| #des #d #e #i #i1 #Hdi #_ #IHi1 #x #H + lapply (at_inv_cons_ge … H Hdi) -H -Hdi /2 width=1/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_minus.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_minus.ma new file mode 100644 index 000000000..3a98ab728 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_minus.ma @@ -0,0 +1,76 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/gr2.ma". + +(* GENERIC RELOCATION WITH PAIRS ********************************************) + +inductive minuss: nat → relation (list2 nat nat) ≝ +| minuss_nil: ∀i. minuss i ⟠ ⟠ +| minuss_lt : ∀des1,des2,d,e,i. i < d → minuss i des1 des2 → + minuss i ({d, e} @ des1) ({d - i, e} @ des2) +| minuss_ge : ∀des1,des2,d,e,i. d ≤ i → minuss (e + i) des1 des2 → + minuss i ({d, e} @ des1) des2 +. + +interpretation "minus (generic relocation with pairs)" + 'RMinus des1 i des2 = (minuss i des1 des2). + +(* Basic inversion lemmas ***************************************************) + +fact minuss_inv_nil1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 → des1 = ⟠ → des2 = ⟠. +#des1 #des2 #i * -des1 -des2 -i +[ // +| #des1 #des2 #d #e #i #_ #_ #H destruct +| #des1 #des2 #d #e #i #_ #_ #H destruct +] +qed. + +lemma minuss_inv_nil1: ∀des2,i. ⟠ ▭ i ≡ des2 → des2 = ⟠. +/2 width=4/ qed-. + +fact minuss_inv_cons1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 → + ∀d,e,des. des1 = {d, e} @ des → + d ≤ i ∧ des ▭ e + i ≡ des2 ∨ + ∃∃des0. i < d & des ▭ i ≡ des0 & + des2 = {d - i, e} @ des0. +#des1 #des2 #i * -des1 -des2 -i +[ #i #d #e #des #H destruct +| #des1 #des #d1 #e1 #i1 #Hid1 #Hdes #d2 #e2 #des2 #H destruct /3 width=3/ +| #des1 #des #d1 #e1 #i1 #Hdi1 #Hdes #d2 #e2 #des2 #H destruct /3 width=1/ +] +qed. + +lemma minuss_inv_cons1: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 → + d ≤ i ∧ des1 ▭ e + i ≡ des2 ∨ + ∃∃des. i < d & des1 ▭ i ≡ des & + des2 = {d - i, e} @ des. +/2 width=3/ qed-. + +lemma minuss_inv_cons1_ge: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 → + d ≤ i → des1 ▭ e + i ≡ des2. +#des1 #des2 #d #e #i #H +elim (minuss_inv_cons1 … H) -H * // #des #Hid #_ #_ #Hdi +lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi +elim (lt_refl_false … Hi) +qed-. + +lemma minuss_inv_cons1_lt: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 → + i < d → + ∃∃des. des1 ▭ i ≡ des & des2 = {d - i, e} @ des. +#des1 #des2 #d #e #i #H +elim (minuss_inv_cons1 … H) -H * /2 width=3/ #Hdi #_ #Hid +lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi +elim (lt_refl_false … Hi) +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_plus.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_plus.ma new file mode 100644 index 000000000..fc1618572 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_plus.ma @@ -0,0 +1,40 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/gr2.ma". + +(* GENERIC RELOCATION WITH PAIRS ********************************************) + +let rec pluss (des:list2 nat nat) (i:nat) on des ≝ match des with +[ nil2 ⇒ ⟠ +| cons2 d e des ⇒ {d + i, e} @ pluss des i +]. + +interpretation "plus (generic relocation with pairs)" + 'plus x y = (pluss x y). + +(* Basic inversion lemmas ***************************************************) + +lemma pluss_inv_nil2: ∀i,des. des + i = ⟠ → des = ⟠. +#i * // normalize +#d #e #des #H destruct +qed. + +lemma pluss_inv_cons2: ∀i,d,e,des2,des. des + i = {d, e} @ des2 → + ∃∃des1. des1 + i = des2 & des = {d - i, e} @ des1. +#i #d #e #des2 * normalize +[ #H destruct +| #d1 #e1 #des1 #H destruct /2 width=3/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop.ma deleted file mode 100644 index 8782fa93d..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop.ma +++ /dev/null @@ -1,330 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/grammar/cl_weight.ma". -include "basic_2/substitution/lift.ma". -include "basic_2/substitution/lsubr.ma". - -(* LOCAL ENVIRONMENT SLICING ************************************************) - -(* Basic_1: includes: drop_skip_bind *) -inductive ldrop: nat → nat → relation lenv ≝ -| ldrop_atom : ∀d,e. ldrop d e (⋆) (⋆) -| ldrop_pair : ∀L,I,V. ldrop 0 0 (L. ⓑ{I} V) (L. ⓑ{I} V) -| ldrop_ldrop: ∀L1,L2,I,V,e. ldrop 0 e L1 L2 → ldrop 0 (e + 1) (L1. ⓑ{I} V) L2 -| ldrop_skip : ∀L1,L2,I,V1,V2,d,e. - ldrop d e L1 L2 → ⇧[d,e] V2 ≡ V1 → - ldrop (d + 1) e (L1. ⓑ{I} V1) (L2. ⓑ{I} V2) -. - -interpretation "local slicing" 'RDrop d e L1 L2 = (ldrop d e L1 L2). - -definition l_liftable: (lenv → relation term) → Prop ≝ - λR. ∀K,T1,T2. R K T1 T2 → ∀L,d,e. ⇩[d, e] L ≡ K → - ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2. - -definition l_deliftable_sn: (lenv → relation term) → Prop ≝ - λR. ∀L,U1,U2. R L U1 U2 → ∀K,d,e. ⇩[d, e] L ≡ K → - ∀T1. ⇧[d, e] T1 ≡ U1 → - ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2. - -definition dropable_sn: relation lenv → Prop ≝ - λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀L2. R L1 L2 → - ∃∃K2. R K1 K2 & ⇩[d, e] L2 ≡ K2. - -definition dedropable_sn: relation lenv → Prop ≝ - λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀K2. R K1 K2 → - ∃∃L2. R L1 L2 & ⇩[d, e] L2 ≡ K2. - -definition dropable_dx: relation lenv → Prop ≝ - λR. ∀L1,L2. R L1 L2 → ∀K2,e. ⇩[0, e] L2 ≡ K2 → - ∃∃K1. ⇩[0, e] L1 ≡ K1 & R K1 K2. - -(* Basic inversion lemmas ***************************************************) - -fact ldrop_inv_refl_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → e = 0 → L1 = L2. -#d #e #L1 #L2 * -d -e -L1 -L2 -[ // -| // -| #L1 #L2 #I #V #e #_ #_ >commutative_plus normalize #H destruct -| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct -] -qed. - -(* Basic_1: was: drop_gen_refl *) -lemma ldrop_inv_refl: ∀L1,L2. ⇩[0, 0] L1 ≡ L2 → L1 = L2. -/2 width=5/ qed-. - -fact ldrop_inv_atom1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → L1 = ⋆ → - L2 = ⋆. -#d #e #L1 #L2 * -d -e -L1 -L2 -[ // -| #L #I #V #H destruct -| #L1 #L2 #I #V #e #_ #H destruct -| #L1 #L2 #I #V1 #V2 #d #e #_ #_ #H destruct -] -qed. - -(* Basic_1: was: drop_gen_sort *) -lemma ldrop_inv_atom1: ∀d,e,L2. ⇩[d, e] ⋆ ≡ L2 → L2 = ⋆. -/2 width=5/ qed-. - -fact ldrop_inv_O1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → - ∀K,I,V. L1 = K. ⓑ{I} V → - (e = 0 ∧ L2 = K. ⓑ{I} V) ∨ - (0 < e ∧ ⇩[d, e - 1] K ≡ L2). -#d #e #L1 #L2 * -d -e -L1 -L2 -[ #d #e #_ #K #I #V #H destruct -| #L #I #V #_ #K #J #W #HX destruct /3 width=1/ -| #L1 #L2 #I #V #e #HL12 #_ #K #J #W #H destruct /3 width=1/ -| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct -] -qed. - -lemma ldrop_inv_O1: ∀e,K,I,V,L2. ⇩[0, e] K. ⓑ{I} V ≡ L2 → - (e = 0 ∧ L2 = K. ⓑ{I} V) ∨ - (0 < e ∧ ⇩[0, e - 1] K ≡ L2). -/2 width=3/ qed-. - -lemma ldrop_inv_pair1: ∀K,I,V,L2. ⇩[0, 0] K. ⓑ{I} V ≡ L2 → L2 = K. ⓑ{I} V. -#K #I #V #L2 #H -elim (ldrop_inv_O1 … H) -H * // #H destruct -elim (lt_refl_false … H) -qed-. - -(* Basic_1: was: drop_gen_drop *) -lemma ldrop_inv_ldrop1: ∀e,K,I,V,L2. - ⇩[0, e] K. ⓑ{I} V ≡ L2 → 0 < e → ⇩[0, e - 1] K ≡ L2. -#e #K #I #V #L2 #H #He -elim (ldrop_inv_O1 … H) -H * // #H destruct -elim (lt_refl_false … He) -qed-. - -fact ldrop_inv_skip1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d → - ∀I,K1,V1. L1 = K1. ⓑ{I} V1 → - ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 & - ⇧[d - 1, e] V2 ≡ V1 & - L2 = K2. ⓑ{I} V2. -#d #e #L1 #L2 * -d -e -L1 -L2 -[ #d #e #_ #I #K #V #H destruct -| #L #I #V #H elim (lt_refl_false … H) -| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H) -| #X #L2 #Y #Z #V2 #d #e #HL12 #HV12 #_ #I #L1 #V1 #H destruct /2 width=5/ -] -qed. - -(* Basic_1: was: drop_gen_skip_l *) -lemma ldrop_inv_skip1: ∀d,e,I,K1,V1,L2. ⇩[d, e] K1. ⓑ{I} V1 ≡ L2 → 0 < d → - ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 & - ⇧[d - 1, e] V2 ≡ V1 & - L2 = K2. ⓑ{I} V2. -/2 width=3/ qed-. - -lemma ldrop_inv_O1_pair2: ∀I,K,V,e,L1. ⇩[0, e] L1 ≡ K. ⓑ{I} V → - (e = 0 ∧ L1 = K. ⓑ{I} V) ∨ - ∃∃I1,K1,V1. ⇩[0, e - 1] K1 ≡ K. ⓑ{I} V & L1 = K1.ⓑ{I1}V1 & 0 < e. -#I #K #V #e * -[ #H lapply (ldrop_inv_atom1 … H) -H #H destruct -| #L1 #I1 #V1 #H - elim (ldrop_inv_O1 … H) -H * - [ #H1 #H2 destruct /3 width=1/ - | /3 width=5/ - ] -] -qed-. - -fact ldrop_inv_skip2_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d → - ∀I,K2,V2. L2 = K2. ⓑ{I} V2 → - ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & - ⇧[d - 1, e] V2 ≡ V1 & - L1 = K1. ⓑ{I} V1. -#d #e #L1 #L2 * -d -e -L1 -L2 -[ #d #e #_ #I #K #V #H destruct -| #L #I #V #H elim (lt_refl_false … H) -| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H) -| #L1 #X #Y #V1 #Z #d #e #HL12 #HV12 #_ #I #L2 #V2 #H destruct /2 width=5/ -] -qed. - -(* Basic_1: was: drop_gen_skip_r *) -lemma ldrop_inv_skip2: ∀d,e,I,L1,K2,V2. ⇩[d, e] L1 ≡ K2. ⓑ{I} V2 → 0 < d → - ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & ⇧[d - 1, e] V2 ≡ V1 & - L1 = K1. ⓑ{I} V1. -/2 width=3/ qed-. - -(* Basic properties *********************************************************) - -(* Basic_1: was by definition: drop_refl *) -lemma ldrop_refl: ∀L. ⇩[0, 0] L ≡ L. -#L elim L -L // -qed. - -lemma ldrop_ldrop_lt: ∀L1,L2,I,V,e. - ⇩[0, e - 1] L1 ≡ L2 → 0 < e → ⇩[0, e] L1. ⓑ{I} V ≡ L2. -#L1 #L2 #I #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/ -qed. - -lemma ldrop_skip_lt: ∀L1,L2,I,V1,V2,d,e. - ⇩[d - 1, e] L1 ≡ L2 → ⇧[d - 1, e] V2 ≡ V1 → 0 < d → - ⇩[d, e] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2. -#L1 #L2 #I #V1 #V2 #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) // /2 width=1/ -qed. - -lemma ldrop_O1_le: ∀i,L. i ≤ |L| → ∃K. ⇩[0, i] L ≡ K. -#i @(nat_ind_plus … i) -i /2 width=2/ -#i #IHi * -[ #H lapply (le_n_O_to_eq … H) -H >commutative_plus normalize #H destruct -| #L #I #V normalize #H - elim (IHi L ?) -IHi /2 width=1/ -H /3 width=2/ -] -qed. - -lemma ldrop_O1_lt: ∀L,i. i < |L| → ∃∃I,K,V. ⇩[0, i] L ≡ K.ⓑ{I}V. -#L elim L -L -[ #i #H elim (lt_zero_false … H) -| #L #I #V #IHL #i @(nat_ind_plus … i) -i /2 width=4/ - #i #_ normalize #H - elim (IHL i ? ) -IHL /2 width=1/ -H /3 width=4/ -] -qed. - -lemma ldrop_lsubr_ldrop2_abbr: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - ∀K2,V,i. ⇩[0, i] L2 ≡ K2. ⓓV → - d ≤ i → i < d + e → - ∃∃K1. K1 ⊑ [0, d + e - i - 1] K2 & - ⇩[0, i] L1 ≡ K1. ⓓV. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e -[ #d #e #K1 #V #i #H - lapply (ldrop_inv_atom1 … H) -H #H destruct -| #L1 #L2 #K1 #V #i #_ #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #V #e #HL12 #IHL12 #K1 #W #i #H #_ #Hie - elim (ldrop_inv_O1 … H) -H * #Hi #HLK1 - [ -IHL12 -Hie destruct - minus_minus_comm >arith_b1 // /4 width=3/ - ] -| #L1 #L2 #I #V1 #V2 #e #_ #IHL12 #K1 #W #i #H #_ #Hie - elim (ldrop_inv_O1 … H) -H * #Hi #HLK1 - [ -IHL12 -Hie -Hi destruct - | elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /3 width=3/ - ] -| #L1 #L2 #I1 #I2 #V1 #V2 #d #e #_ #IHL12 #K1 #V #i #H #Hdi >plus_plus_comm_23 #Hide - elim (le_inv_plus_l … Hdi) #Hdim #Hi - lapply (ldrop_inv_ldrop1 … H ?) -H // #HLK1 - elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hdi -Hide >minus_minus_comm >arith_b1 // /3 width=3/ -] -qed. - -lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R). -#R #HR #L1 #K1 #d #e #HLK1 #L2 #H elim H -L2 -[ #L2 #HL12 - elim (HR … HLK1 … HL12) -HR -L1 /3 width=3/ -| #L #L2 #_ #HL2 * #K #HK1 #HLK - elim (HR … HLK … HL2) -HR -L /3 width=3/ -] -qed. - -lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R). -#R #HR #L1 #K1 #d #e #HLK1 #K2 #H elim H -K2 -[ #K2 #HK12 - elim (HR … HLK1 … HK12) -HR -K1 /3 width=3/ -| #K #K2 #_ #HK2 * #L #HL1 #HLK - elim (HR … HLK … HK2) -HR -K /3 width=3/ -] -qed. - -lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R). -#R #HR #L1 #L2 #H elim H -L2 -[ #L2 #HL12 #K2 #e #HLK2 - elim (HR … HL12 … HLK2) -HR -L2 /3 width=3/ -| #L #L2 #_ #HL2 #IHL1 #K2 #e #HLK2 - elim (HR … HL2 … HLK2) -HR -L2 #K #HLK #HK2 - elim (IHL1 … HLK) -L /3 width=5/ -] -qed. - -(* Basic forvard lemmas *****************************************************) - -(* Basic_1: was: drop_S *) -lemma ldrop_fwd_ldrop2: ∀L1,I2,K2,V2,e. ⇩[O, e] L1 ≡ K2. ⓑ{I2} V2 → - ⇩[O, e + 1] L1 ≡ K2. -#L1 elim L1 -L1 -[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct -| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H - elim (ldrop_inv_O1 … H) -H * #He #H - [ -IHL1 destruct /2 width=1/ - | @ldrop_ldrop >(plus_minus_m_m e 1) // /2 width=3/ - ] -] -qed-. - -lemma ldrop_fwd_length: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → |L2| ≤ |L1|. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize /2 width=1/ -qed-. - -lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ♯{L2} ≤ ♯{L1}. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize -[ /2 width=3/ -| #L1 #L2 #I #V1 #V2 #d #e #_ #HV21 #IHL12 - >(lift_fwd_tw … HV21) -HV21 /2 width=1/ -] -qed-. - -lemma ldrop_pair2_fwd_fw: ∀I,L,K,V,d,e. ⇩[d, e] L ≡ K. ⓑ{I} V → - ∀T. ♯{K, V} < ♯{L, T}. -#I #L #K #V #d #e #H #T -lapply (ldrop_fwd_lw … H) -H #H -@(le_to_lt_to_lt … H) -H /3 width=1/ -qed-. - -lemma ldrop_fwd_ldrop2_length: ∀L1,I2,K2,V2,e. - ⇩[0, e] L1 ≡ K2. ⓑ{I2} V2 → e < |L1|. -#L1 elim L1 -L1 -[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct -| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H - elim (ldrop_inv_O1 … H) -H * #He #H - [ -IHL1 destruct // - | lapply (IHL1 … H) -IHL1 -H #HeK1 whd in ⊢ (? ? %); /2 width=1/ - ] -] -qed-. - -lemma ldrop_fwd_O1_length: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → |L2| = |L1| - e. -#L1 elim L1 -L1 -[ #L2 #e #H >(ldrop_inv_atom1 … H) -H // -| #K1 #I1 #V1 #IHL1 #L2 #e #H - elim (ldrop_inv_O1 … H) -H * #He #H - [ -IHL1 destruct // - | lapply (IHL1 … H) -IHL1 -H #H >H -H normalize - >minus_le_minus_minus_comm // - ] -] -qed-. - -(* Basic_1: removed theorems 50: - drop_ctail drop_skip_flat - cimp_flat_sx cimp_flat_dx cimp_bind cimp_getl_conf - drop_clear drop_clear_O drop_clear_S - clear_gen_sort clear_gen_bind clear_gen_flat clear_gen_flat_r - clear_gen_all clear_clear clear_mono clear_trans clear_ctail clear_cle - getl_ctail_clen getl_gen_tail clear_getl_trans getl_clear_trans - getl_clear_bind getl_clear_conf getl_dec getl_drop getl_drop_conf_lt - getl_drop_conf_ge getl_conf_ge_drop getl_drop_conf_rev - drop_getl_trans_lt drop_getl_trans_le drop_getl_trans_ge - getl_drop_trans getl_flt getl_gen_all getl_gen_sort getl_gen_O - getl_gen_S getl_gen_2 getl_gen_flat getl_gen_bind getl_conf_le - getl_trans getl_refl getl_head getl_flat getl_ctail getl_mono -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_append.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_append.ma deleted file mode 100644 index a122f9d45..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_append.ma +++ /dev/null @@ -1,64 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/ldrop.ma". - -(* DROPPING *****************************************************************) - -(* Properties on append for local environments ******************************) - -fact ldrop_O1_append_sn_le_aux: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → - d = 0 → e ≤ |L1| → - ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize // /4 width=1/ -#d #e #_ #H #L -d -lapply (le_n_O_to_eq … H) -H // -qed-. - -lemma ldrop_O1_append_sn_le: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → e ≤ |L1| → - ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2. -/2 width=3 by ldrop_O1_append_sn_le_aux/ qed. - -(* Inversion lemmas on append for local environments ************************) - -lemma ldrop_O1_inv_append1_ge: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → - |L2| ≤ e → ⇩[0, e - |L2|] L1 ≡ K. -#K #L1 #L2 elim L2 -L2 normalize // -#L2 #I #V #IHL2 #e #H #H1e -elim (ldrop_inv_O1 … H) -H * #H2e #HL12 destruct -[ lapply (le_n_O_to_eq … H1e) -H1e -IHL2 - >commutative_plus normalize #H destruct -| minus_minus_comm /3 width=1/ -] -qed-. - -lemma ldrop_O1_inv_append1_le: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → e ≤ |L2| → - ∀K2. ⇩[0, e] L2 ≡ K2 → K = L1 @@ K2. -#K #L1 #L2 elim L2 -L2 normalize -[ #e #H1 #H2 #K2 #H3 - lapply (le_n_O_to_eq … H2) -H2 #H2 - lapply (ldrop_inv_atom1 … H3) -H3 #H3 destruct - >(ldrop_inv_refl … H1) -H1 // -| #L2 #I #V #IHL2 #e @(nat_ind_plus … e) -e [ -IHL2 ] - [ #H1 #_ #K2 #H2 - lapply (ldrop_inv_refl … H1) -H1 #H1 - lapply (ldrop_inv_refl … H2) -H2 #H2 destruct // - | #e #_ #H1 #H #K2 #H2 - lapply (le_plus_to_le_r … H) -H - lapply (ldrop_inv_ldrop1 … H1 ?) -H1 // - lapply (ldrop_inv_ldrop1 … H2 ?) -H2 // - (H0 I L V 0 ? ? ?) // - /5 width=6 by lbotr_abbr, ldrop_ldrop, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *) -| #d #_ #e #H0 - /5 width=6 by lbotr_skip, ldrop_ldrop, le_S_S, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *) -] -qed. - -lemma lbotr_ldrop_trans_le: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 → - dd + ee ≤ d → ⊒[dd, ee] L2. -#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee -@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2 -lapply (lt_to_le_to_lt … Hiddee Hddee) -Hddee #Hid -elim (ldrop_trans_le … HL12 … HLK2 ?) -L2 /2 width=2/ #X #HLK1 #H -elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K1 #V1 #HK12 #HV21 #H destruct -@(lbotr_inv_ldrop … HLK1 … HL1) -L1 -K1 -V1 // -qed. - -lemma lbotr_ldrop_trans_be_up: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → - ∀dd,ee. ⊒[dd, ee] L1 → - dd ≤ d + e → d + e ≤ dd + ee → - ⊒[d, dd + ee - d - e] L2. -#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hdde #Hddee -@lbotr_ldrop #I #K2 #V2 #i #Hdi #Hiddee #HLK2 -lapply (transitive_le ? ? (i+e)… Hdde ?) -Hdde /2 width=1/ #Hddie ->commutative_plus in Hiddee; >minus_minus_comm commutative_plus // -Hddie /2 width=1/ -qed. - -lemma lbotr_ldrop_trans_ge: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 → - d + e ≤ dd → ⊒[dd - e, ee] L2. -#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee -@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2 -elim (le_inv_plus_l … Hddee) -Hddee #Hdde #Hedd ->plus_minus in Hiddee; // #Hiddee -lapply (transitive_le … Hdde Hddi) -Hdde #Hid -lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hid #HL1K2 -@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus /2 width=1/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_ldrop.ma deleted file mode 100644 index ccbf607ea..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_ldrop.ma +++ /dev/null @@ -1,176 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift_lift.ma". -include "basic_2/substitution/ldrop.ma". - -(* DROPPING *****************************************************************) - -(* Main properties **********************************************************) - -(* Basic_1: was: drop_mono *) -theorem ldrop_mono: ∀d,e,L,L1. ⇩[d, e] L ≡ L1 → - ∀L2. ⇩[d, e] L ≡ L2 → L1 = L2. -#d #e #L #L1 #H elim H -d -e -L -L1 -[ #d #e #L2 #H - >(ldrop_inv_atom1 … H) -L2 // -| #K #I #V #L2 #HL12 - <(ldrop_inv_refl … HL12) -L2 // -| #L #K #I #V #e #_ #IHLK #L2 #H - lapply (ldrop_inv_ldrop1 … H ?) -H // /2 width=1/ -| #L #K1 #I #T #V1 #d #e #_ #HVT1 #IHLK1 #X #H - elim (ldrop_inv_skip1 … H ?) -H // (lift_inj … HVT1 … HVT2) -HVT1 -HVT2 - >(IHLK1 … HLK2) -IHLK1 -HLK2 // -] -qed-. - -(* Basic_1: was: drop_conf_ge *) -theorem ldrop_conf_ge: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 → - ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 + e1 ≤ e2 → - ⇩[0, e2 - e1] L1 ≡ L2. -#d1 #e1 #L #L1 #H elim H -d1 -e1 -L -L1 -[ #d #e #e2 #L2 #H - >(ldrop_inv_atom1 … H) -L2 // -| // -| #L #K #I #V #e #_ #IHLK #e2 #L2 #H #He2 - lapply (ldrop_inv_ldrop1 … H ?) -H /2 width=2/ #HL2 - minus_minus_comm /3 width=1/ -| #L #K #I #V1 #V2 #d #e #_ #_ #IHLK #e2 #L2 #H #Hdee2 - lapply (transitive_le 1 … Hdee2) // #He2 - lapply (ldrop_inv_ldrop1 … H ?) -H // -He2 #HL2 - lapply (transitive_le (1 + e) … Hdee2) // #Hee2 - @ldrop_ldrop_lt >minus_minus_comm /3 width=1/ (**) (* explicit constructor *) -] -qed. - -(* Note: apparently this was missing in basic_1 *) -theorem ldrop_conf_be: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 → - ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 → - ∃∃L. ⇩[0, d1 + e1 - e2] L2 ≡ L & ⇩[0, d1] L1 ≡ L. -#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1 -[ #d1 #e1 #L2 #e2 #H >(ldrop_inv_atom1 … H) -H /2 width=3/ -| normalize #L #I #V #L2 #e2 #HL2 #_ #He2 - lapply (le_n_O_to_eq … He2) -He2 #H destruct - lapply (ldrop_inv_refl … HL2) -HL2 #H destruct /2 width=3/ -| normalize #L0 #K0 #I #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21 - lapply (ldrop_inv_O1 … H) -H * * #He2 #HL20 - [ -IHLK0 -He21 destruct plus_plus_comm_23 #_ #_ #IHLK0 #L2 #e2 #H #Hd1e2 #He2de1 - elim (le_inv_plus_l … Hd1e2) #_ #He2 - minus_le_minus_minus_comm // /3 width=3/ - ] -] -qed. - -(* Basic_1: was: drop_trans_ge *) -theorem ldrop_trans_ge: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L → - ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → ⇩[0, e1 + e2] L1 ≡ L2. -#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L -[ #d #e #e2 #L2 #H - >(ldrop_inv_atom1 … H) -H -L2 // -| // -| /3 width=1/ -| #L1 #L2 #I #V1 #V2 #d #e #H_ #_ #IHL12 #e2 #L #H #Hde2 - lapply (lt_to_le_to_lt 0 … Hde2) // #He2 - lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2 - lapply (ldrop_inv_ldrop1 … H ?) -H // #HL2 - @ldrop_ldrop_lt // >le_plus_minus // @IHL12 /2 width=1/ (**) (* explicit constructor *) -] -qed. - -(* Basic_1: was: drop_trans_le *) -theorem ldrop_trans_le: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L → - ∀e2,L2. ⇩[0, e2] L ≡ L2 → e2 ≤ d1 → - ∃∃L0. ⇩[0, e2] L1 ≡ L0 & ⇩[d1 - e2, e1] L0 ≡ L2. -#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L -[ #d #e #e2 #L2 #H - >(ldrop_inv_atom1 … H) -L2 /2 width=3/ -| #K #I #V #e2 #L2 #HL2 #H - lapply (le_n_O_to_eq … H) -H #H destruct /2 width=3/ -| #L1 #L2 #I #V #e #_ #IHL12 #e2 #L #HL2 #H - lapply (le_n_O_to_eq … H) -H #H destruct - elim (IHL12 … HL2 ?) -IHL12 -HL2 // #L0 #H #HL0 - lapply (ldrop_inv_refl … H) -H #H destruct /3 width=5/ -| #L1 #L2 #I #V1 #V2 #d #e #HL12 #HV12 #IHL12 #e2 #L #H #He2d - elim (ldrop_inv_O1 … H) -H * - [ -He2d -IHL12 #H1 #H2 destruct /3 width=5/ - | -HL12 -HV12 #He2 #HL2 - elim (IHL12 … HL2 ?) -L2 [ >minus_le_minus_minus_comm // /3 width=3/ | /2 width=1/ ] - ] -] -qed. - -(* Basic_1: was: drop_conf_rev *) -axiom ldrop_div: ∀e1,L1,L. ⇩[0, e1] L1 ≡ L → ∀e2,L2. ⇩[0, e2] L2 ≡ L → - ∃∃L0. ⇩[0, e1] L0 ≡ L2 & ⇩[e1, e2] L0 ≡ L1. - -(* Basic_1: was: drop_conf_lt *) -lemma ldrop_conf_lt: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 → - ∀e2,K2,I,V2. ⇩[0, e2] L ≡ K2. ⓑ{I} V2 → - e2 < d1 → let d ≝ d1 - e2 - 1 in - ∃∃K1,V1. ⇩[0, e2] L1 ≡ K1. ⓑ{I} V1 & - ⇩[d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2. -#d1 #e1 #L #L1 #H1 #e2 #K2 #I #V2 #H2 #He2d1 -elim (ldrop_conf_le … H1 … H2 ?) -L [2: /2 width=2/] #K #HL1K #HK2 -elim (ldrop_inv_skip1 … HK2 ?) -HK2 [2: /2 width=1/] #K1 #V1 #HK21 #HV12 #H destruct /2 width=5/ -qed. - -lemma ldrop_trans_ge_comm: ∀d1,e1,e2,L1,L2,L. - ⇩[d1, e1] L1 ≡ L → ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → - ⇩[0, e2 + e1] L1 ≡ L2. -#e1 #e1 #e2 >commutative_plus /2 width=5/ -qed. - -lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[0, e1] L ≡ K. ⓑ{I1} V1 → - ∀I2,V2,e2. ⇩[0, e2] L ≡ K. ⓑ{I2} V2 → - ∧∧ e1 = e2 & I1 = I2 & V1 = V2. -#I1 #L #K #V1 #e1 #HLK1 #I2 #V2 #e2 #HLK2 -elim (le_or_ge e1 e2) #He -[ lapply (ldrop_conf_ge … HLK1 … HLK2 ?) -| lapply (ldrop_conf_ge … HLK2 … HLK1 ?) -] -HLK1 -HLK2 // #HK -lapply (ldrop_fwd_O1_length … HK) #H -elim (discr_minus_x_xy … H) -H -[1,3: normalize H in HK; #HK -lapply (ldrop_inv_refl … HK) -HK #H destruct -lapply (inv_eq_minus_O … H) -H /3 width=1/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx.ma deleted file mode 100644 index adfbbc038..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx.ma +++ /dev/null @@ -1,68 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/grammar/lenv_px.ma". -include "basic_2/substitution/ldrop.ma". - -(* DROPPING *****************************************************************) - -(* Properties on pointwise extension ****************************************) - -lemma lpx_deliftable_dropable: ∀R. t_deliftable_sn R → dropable_sn (lpx R). -#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e -[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/ -| #K1 #I #V1 #X #H - elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/ -| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H - elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct - elim (IHLK1 … HL12) -L1 /3 width=3/ -| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H - elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct - elim (HR … HV12 … HWV1) -V1 - elim (IHLK1 … HL12) -L1 /3 width=5/ -] -qed. - -lemma lpx_liftable_dedropable: ∀R. reflexive ? R → - t_liftable R → dedropable_sn (lpx R). -#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e -[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/ -| #K1 #I #V1 #X #H - elim (lpx_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/ -| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12 - elim (IHLK1 … HK12) -K1 /3 width=5/ -| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H - elim (lpx_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct - elim (lift_total W2 d e) #V2 #HWV2 - lapply (H2R … HW12 … HWV1 … HWV2) -W1 - elim (IHLK1 … HK12) -K1 /3 width=5/ -] -qed. - -fact lpx_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx R L1 L2 → - d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx R K1 K2. -#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e -[ #d #e #X #H >(lpx_inv_atom2 … H) -H /2 width=3/ -| #K2 #I #V2 #X #H - elim (lpx_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/ -| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_ - elim (lpx_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct - elim (IHLK2 … HL12 ?) -L2 // /3 width=3/ -| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_ - >commutative_plus normalize #H destruct -] -qed-. - -lemma lpx_dropable: ∀R. dropable_dx (lpx R). -/2 width=5 by lpx_dropable_aux/ qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx_sn.ma deleted file mode 100644 index 33c1ba2e8..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_lpx_sn.ma +++ /dev/null @@ -1,68 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/grammar/lenv_px_sn.ma". -include "basic_2/substitution/ldrop.ma". - -(* DROPPING *****************************************************************) - -(* Properties on sn pointwise extension *************************************) - -lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R). -#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e -[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/ -| #K1 #I #V1 #X #H - elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/ -| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H - elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct - elim (IHLK1 … HL12) -L1 /3 width=3/ -| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H - elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct - elim (HR … HV12 … HLK1 … HWV1) -V1 - elim (IHLK1 … HL12) -L1 /3 width=5/ -] -qed-. - -lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) → - l_liftable R → dedropable_sn (lpx_sn R). -#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e -[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/ -| #K1 #I #V1 #X #H - elim (lpx_sn_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/ -| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12 - elim (IHLK1 … HK12) -K1 /3 width=5/ -| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H - elim (lpx_sn_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct - elim (lift_total W2 d e) #V2 #HWV2 - lapply (H2R … HW12 … HLK1 … HWV1 … HWV2) -W1 - elim (IHLK1 … HK12) -K1 /3 width=5/ -] -qed-. - -fact lpx_sn_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 → - d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx_sn R K1 K2. -#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e -[ #d #e #X #H >(lpx_sn_inv_atom2 … H) -H /2 width=3/ -| #K2 #I #V2 #X #H - elim (lpx_sn_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/ -| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_ - elim (lpx_sn_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct - elim (IHLK2 … HL12 ?) -L2 // /3 width=3/ -| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_ - >commutative_plus normalize #H destruct -] -qed-. - -lemma lpx_sn_dropable: ∀R. dropable_dx (lpx_sn R). -/2 width=5 by lpx_sn_dropable_aux/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops.ma new file mode 100644 index 000000000..328860016 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops.ma @@ -0,0 +1,89 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/gr2_minus.ma". +include "basic_2/substitution/lifts.ma". + +(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************) + +inductive ldrops: list2 nat nat → relation lenv ≝ +| ldrops_nil : ∀L. ldrops ⟠ L L +| ldrops_cons: ∀L1,L,L2,des,d,e. + ldrops des L1 L → ⇩[d,e] L ≡ L2 → ldrops ({d, e} @ des) L1 L2 +. + +interpretation "generic local environment slicing" + 'RDropStar des T1 T2 = (ldrops des T1 T2). + +(* Basic inversion lemmas ***************************************************) + +fact ldrops_inv_nil_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → des = ⟠ → L1 = L2. +#L1 #L2 #des * -L1 -L2 -des // +#L1 #L #L2 #d #e #des #_ #_ #H destruct +qed. + +(* Basic_1: was: drop1_gen_pnil *) +lemma ldrops_inv_nil: ∀L1,L2. ⇩*[⟠] L1 ≡ L2 → L1 = L2. +/2 width=3/ qed-. + +fact ldrops_inv_cons_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → + ∀d,e,tl. des = {d, e} @ tl → + ∃∃L. ⇩*[tl] L1 ≡ L & ⇩[d, e] L ≡ L2. +#L1 #L2 #des * -L1 -L2 -des +[ #L #d #e #tl #H destruct +| #L1 #L #L2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct + /2 width=3/ +qed. + +(* Basic_1: was: drop1_gen_pcons *) +lemma ldrops_inv_cons: ∀L1,L2,d,e,des. ⇩*[{d, e} @ des] L1 ≡ L2 → + ∃∃L. ⇩*[des] L1 ≡ L & ⇩[d, e] L ≡ L2. +/2 width=3/ qed-. + +lemma ldrops_inv_skip2: ∀I,des,i,des2. des ▭ i ≡ des2 → + ∀L1,K2,V2. ⇩*[des2] L1 ≡ K2. ⓑ{I} V2 → + ∃∃K1,V1,des1. des + 1 ▭ i + 1 ≡ des1 + 1 & + ⇩*[des1] K1 ≡ K2 & + ⇧*[des1] V2 ≡ V1 & + L1 = K1. ⓑ{I} V1. +#I #des #i #des2 #H elim H -des -i -des2 +[ #i #L1 #K2 #V2 #H + >(ldrops_inv_nil … H) -L1 /2 width=7/ +| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H + elim (ldrops_inv_cons … H) -H #L #HL1 #H + elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ #K #V >minus_plus #HK2 #HV2 #H destruct + elim (IHdes2 … HL1) -IHdes2 -HL1 #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct + @(ex4_3_intro … K1 V1 … ) // [3,4: /2 width=7/ | skip ] + normalize >plus_minus // @minuss_lt // /2 width=1/ (**) (* explicit constructors, /3 width=1/ is a bit slow *) +| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H + elim (IHdes2 … H) -IHdes2 -H #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct + /4 width=7/ +] +qed-. + +(* Basic properties *********************************************************) + +(* Basic_1: was: drop1_skip_bind *) +lemma ldrops_skip: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 → + ∀I. ⇩*[des + 1] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2. +#L1 #L2 #des #H elim H -L1 -L2 -des +[ #L #V1 #V2 #HV12 #I + >(lifts_inv_nil … HV12) -HV12 // +| #L1 #L #L2 #des #d #e #_ #HL2 #IHL #V1 #V2 #H #I + elim (lifts_inv_cons … H) -H /3 width=5/ +]. +qed. + +(* Basic_1: removed theorems 1: drop1_getl_trans *) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrop.ma new file mode 100644 index 000000000..9712e3277 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrop.ma @@ -0,0 +1,35 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrops.ma". + +(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************) + +(* Properties concerning basic local environment slicing ********************) + +lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[des] L1 ≡ L → ∀L2,i. ⇩[0, i] L ≡ L2 → + ∃∃L0,des0,i0. ⇩[0, i0] L1 ≡ L0 & ⇩*[des0] L0 ≡ L2 & + @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0. +#L1 #L #des #H elim H -L1 -L -des +[ /2 width=7/ +| #L1 #L3 #L #des3 #d #e #_ #HL3 #IHL13 #L2 #i #HL2 + elim (lt_or_ge i d) #Hid + [ elim (ldrop_trans_le … HL3 … HL2 ?) -L /2 width=2/ #L #HL3 #HL2 + elim (IHL13 … HL3) -L3 /3 width=7/ + | lapply (ldrop_trans_ge … HL3 … HL2 ?) -L // #HL32 + elim (IHL13 … HL32) -L3 /3 width=7/ + ] +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrops.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrops.ma new file mode 100644 index 000000000..a4dbfb02e --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrops.ma @@ -0,0 +1,25 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/ldrops_ldrop.ma". + +(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************) + +(* Main properties **********************************************************) + +(* Basic_1: was: drop1_trans *) +theorem ldrops_trans: ∀L,L2,des2. ⇩*[des2] L ≡ L2 → ∀L1,des1. ⇩*[des1] L1 ≡ L → + ⇩*[des2 @@ des1] L1 ≡ L2. +#L #L2 #des2 #H elim H -L -L2 -des2 // /3 width=3/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma deleted file mode 100644 index 7e7961eab..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma +++ /dev/null @@ -1,403 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/grammar/term_weight.ma". -include "basic_2/grammar/term_simple.ma". - -(* BASIC TERM RELOCATION ****************************************************) - -(* Basic_1: includes: - lift_sort lift_lref_lt lift_lref_ge lift_bind lift_flat -*) -inductive lift: nat → nat → relation term ≝ -| lift_sort : ∀k,d,e. lift d e (⋆k) (⋆k) -| lift_lref_lt: ∀i,d,e. i < d → lift d e (#i) (#i) -| lift_lref_ge: ∀i,d,e. d ≤ i → lift d e (#i) (#(i + e)) -| lift_gref : ∀p,d,e. lift d e (§p) (§p) -| lift_bind : ∀a,I,V1,V2,T1,T2,d,e. - lift d e V1 V2 → lift (d + 1) e T1 T2 → - lift d e (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2) -| lift_flat : ∀I,V1,V2,T1,T2,d,e. - lift d e V1 V2 → lift d e T1 T2 → - lift d e (ⓕ{I} V1. T1) (ⓕ{I} V2. T2) -. - -interpretation "relocation" 'RLift d e T1 T2 = (lift d e T1 T2). - -definition t_liftable: relation term → Prop ≝ - λR. ∀T1,T2. R T1 T2 → ∀U1,d,e. ⇧[d, e] T1 ≡ U1 → - ∀U2. ⇧[d, e] T2 ≡ U2 → R U1 U2. - -definition t_deliftable_sn: relation term → Prop ≝ - λR. ∀U1,U2. R U1 U2 → ∀T1,d,e. ⇧[d, e] T1 ≡ U1 → - ∃∃T2. ⇧[d, e] T2 ≡ U2 & R T1 T2. - -(* Basic inversion lemmas ***************************************************) - -fact lift_inv_refl_O2_aux: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → e = 0 → T1 = T2. -#d #e #T1 #T2 #H elim H -d -e -T1 -T2 // /3 width=1/ -qed. - -lemma lift_inv_refl_O2: ∀d,T1,T2. ⇧[d, 0] T1 ≡ T2 → T1 = T2. -/2 width=4/ qed-. - -fact lift_inv_sort1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T1 = ⋆k → T2 = ⋆k. -#d #e #T1 #T2 * -d -e -T1 -T2 // -[ #i #d #e #_ #k #H destruct -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -] -qed. - -lemma lift_inv_sort1: ∀d,e,T2,k. ⇧[d,e] ⋆k ≡ T2 → T2 = ⋆k. -/2 width=5/ qed-. - -fact lift_inv_lref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T1 = #i → - (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)). -#d #e #T1 #T2 * -d -e -T1 -T2 -[ #k #d #e #i #H destruct -| #j #d #e #Hj #i #Hi destruct /3 width=1/ -| #j #d #e #Hj #i #Hi destruct /3 width=1/ -| #p #d #e #i #H destruct -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct -] -qed. - -lemma lift_inv_lref1: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → - (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)). -/2 width=3/ qed-. - -lemma lift_inv_lref1_lt: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → i < d → T2 = #i. -#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * // -#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd -elim (lt_refl_false … Hdd) -qed-. - -lemma lift_inv_lref1_ge: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → d ≤ i → T2 = #(i + e). -#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * // -#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd -elim (lt_refl_false … Hdd) -qed-. - -fact lift_inv_gref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T1 = §p → T2 = §p. -#d #e #T1 #T2 * -d -e -T1 -T2 // -[ #i #d #e #_ #k #H destruct -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -] -qed. - -lemma lift_inv_gref1: ∀d,e,T2,p. ⇧[d,e] §p ≡ T2 → T2 = §p. -/2 width=5/ qed-. - -fact lift_inv_bind1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → - ∀a,I,V1,U1. T1 = ⓑ{a,I} V1.U1 → - ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 & - T2 = ⓑ{a,I} V2. U2. -#d #e #T1 #T2 * -d -e -T1 -T2 -[ #k #d #e #a #I #V1 #U1 #H destruct -| #i #d #e #_ #a #I #V1 #U1 #H destruct -| #i #d #e #_ #a #I #V1 #U1 #H destruct -| #p #d #e #a #I #V1 #U1 #H destruct -| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V1 #U1 #H destruct /2 width=5/ -| #J #W1 #W2 #T1 #T2 #d #e #_ #HT #a #I #V1 #U1 #H destruct -] -qed. - -lemma lift_inv_bind1: ∀d,e,T2,a,I,V1,U1. ⇧[d,e] ⓑ{a,I} V1. U1 ≡ T2 → - ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 & - T2 = ⓑ{a,I} V2. U2. -/2 width=3/ qed-. - -fact lift_inv_flat1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → - ∀I,V1,U1. T1 = ⓕ{I} V1.U1 → - ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 & - T2 = ⓕ{I} V2. U2. -#d #e #T1 #T2 * -d -e -T1 -T2 -[ #k #d #e #I #V1 #U1 #H destruct -| #i #d #e #_ #I #V1 #U1 #H destruct -| #i #d #e #_ #I #V1 #U1 #H destruct -| #p #d #e #I #V1 #U1 #H destruct -| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V1 #U1 #H destruct -| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V1 #U1 #H destruct /2 width=5/ -] -qed. - -lemma lift_inv_flat1: ∀d,e,T2,I,V1,U1. ⇧[d,e] ⓕ{I} V1. U1 ≡ T2 → - ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 & - T2 = ⓕ{I} V2. U2. -/2 width=3/ qed-. - -fact lift_inv_sort2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T2 = ⋆k → T1 = ⋆k. -#d #e #T1 #T2 * -d -e -T1 -T2 // -[ #i #d #e #_ #k #H destruct -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct -] -qed. - -(* Basic_1: was: lift_gen_sort *) -lemma lift_inv_sort2: ∀d,e,T1,k. ⇧[d,e] T1 ≡ ⋆k → T1 = ⋆k. -/2 width=5/ qed-. - -fact lift_inv_lref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T2 = #i → - (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)). -#d #e #T1 #T2 * -d -e -T1 -T2 -[ #k #d #e #i #H destruct -| #j #d #e #Hj #i #Hi destruct /3 width=1/ -| #j #d #e #Hj #i #Hi destruct (plus_minus_m_m i e) in ⊢ (? ? ? ? %); /2 width=2/ /3 width=2/ -qed. - -lemma lift_lref_ge_minus_eq: ∀d,e,i,j. d + e ≤ i → j = i - e → ⇧[d, e] #j ≡ #i. -/2 width=1/ qed-. - -(* Basic_1: was: lift_r *) -lemma lift_refl: ∀T,d. ⇧[d, 0] T ≡ T. -#T elim T -T -[ * #i // #d elim (lt_or_ge i d) /2 width=1/ -| * /2 width=1/ -] -qed. - -lemma lift_total: ∀T1,d,e. ∃T2. ⇧[d,e] T1 ≡ T2. -#T1 elim T1 -T1 -[ * #i /2 width=2/ #d #e elim (lt_or_ge i d) /3 width=2/ -| * [ #a ] #I #V1 #T1 #IHV1 #IHT1 #d #e - elim (IHV1 d e) -IHV1 #V2 #HV12 - [ elim (IHT1 (d+1) e) -IHT1 /3 width=2/ - | elim (IHT1 d e) -IHT1 /3 width=2/ - ] -] -qed. - -(* Basic_1: was: lift_free (right to left) *) -lemma lift_split: ∀d1,e2,T1,T2. ⇧[d1, e2] T1 ≡ T2 → - ∀d2,e1. d1 ≤ d2 → d2 ≤ d1 + e1 → e1 ≤ e2 → - ∃∃T. ⇧[d1, e1] T1 ≡ T & ⇧[d2, e2 - e1] T ≡ T2. -#d1 #e2 #T1 #T2 #H elim H -d1 -e2 -T1 -T2 -[ /3 width=3/ -| #i #d1 #e2 #Hid1 #d2 #e1 #Hd12 #_ #_ - lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 /4 width=3/ -| #i #d1 #e2 #Hid1 #d2 #e1 #_ #Hd21 #He12 - lapply (transitive_le … (i+e1) Hd21 ?) /2 width=1/ -Hd21 #Hd21 - >(plus_minus_m_m e2 e1 ?) // /3 width=3/ -| /3 width=3/ -| #a #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12 - elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b - elim (IHT (d2+1) … ? ? He12) /2 width=1/ /3 width=5/ -| #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12 - elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b - elim (IHT d2 … ? ? He12) // /3 width=5/ -] -qed. - -(* Basic_1: was only: dnf_dec2 dnf_dec *) -lemma is_lift_dec: ∀T2,d,e. Decidable (∃T1. ⇧[d,e] T1 ≡ T2). -#T1 elim T1 -T1 -[ * [1,3: /3 width=2/ ] #i #d #e - elim (lt_dec i d) #Hid - [ /4 width=2/ - | lapply (false_lt_to_le … Hid) -Hid #Hid - elim (lt_dec i (d + e)) #Hide - [ @or_intror * #T1 #H - elim (lift_inv_lref2_be … H Hid Hide) - | lapply (false_lt_to_le … Hide) -Hide /4 width=2/ - ] - ] -| * [ #a ] #I #V2 #T2 #IHV2 #IHT2 #d #e - [ elim (IHV2 d e) -IHV2 - [ * #V1 #HV12 elim (IHT2 (d+1) e) -IHT2 - [ * #T1 #HT12 @or_introl /3 width=2/ - | -V1 #HT2 @or_intror * #X #H - elim (lift_inv_bind2 … H) -H /3 width=2/ - ] - | -IHT2 #HV2 @or_intror * #X #H - elim (lift_inv_bind2 … H) -H /3 width=2/ - ] - | elim (IHV2 d e) -IHV2 - [ * #V1 #HV12 elim (IHT2 d e) -IHT2 - [ * #T1 #HT12 /4 width=2/ - | -V1 #HT2 @or_intror * #X #H - elim (lift_inv_flat2 … H) -H /3 width=2/ - ] - | -IHT2 #HV2 @or_intror * #X #H - elim (lift_inv_flat2 … H) -H /3 width=2/ - ] - ] -] -qed. - -lemma t_liftable_TC: ∀R. t_liftable R → t_liftable (TC … R). -#R #HR #T1 #T2 #H elim H -T2 -[ /3 width=7/ -| #T #T2 #_ #HT2 #IHT1 #U1 #d #e #HTU1 #U2 #HTU2 - elim (lift_total T d e) /3 width=9/ -] -qed. - -lemma t_deliftable_sn_TC: ∀R. t_deliftable_sn R → t_deliftable_sn (TC … R). -#R #HR #U1 #U2 #H elim H -U2 -[ #U2 #HU12 #T1 #d #e #HTU1 - elim (HR … HU12 … HTU1) -U1 /3 width=3/ -| #U #U2 #_ #HU2 #IHU1 #T1 #d #e #HTU1 - elim (IHU1 … HTU1) -U1 #T #HTU #HT1 - elim (HR … HU2 … HTU) -U /3 width=5/ -] -qed-. - -(* Basic_1: removed theorems 7: - lift_head lift_gen_head - lift_weight_map lift_weight lift_weight_add lift_weight_add_O - lift_tlt_dx -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift.ma deleted file mode 100644 index 804c903d1..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift.ma +++ /dev/null @@ -1,217 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift.ma". - -(* BASIC TERM RELOCATION ****************************************************) - -(* Main properies ***********************************************************) - -(* Basic_1: was: lift_inj *) -theorem lift_inj: ∀d,e,T1,U. ⇧[d,e] T1 ≡ U → ∀T2. ⇧[d,e] T2 ≡ U → T1 = T2. -#d #e #T1 #U #H elim H -d -e -T1 -U -[ #k #d #e #X #HX - lapply (lift_inv_sort2 … HX) -HX // -| #i #d #e #Hid #X #HX - lapply (lift_inv_lref2_lt … HX ?) -HX // -| #i #d #e #Hdi #X #HX - lapply (lift_inv_lref2_ge … HX ?) -HX // /2 width=1/ -| #p #d #e #X #HX - lapply (lift_inv_gref2 … HX) -HX // -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX - elim (lift_inv_bind2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX - elim (lift_inv_flat2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ -] -qed-. - -(* Basic_1: was: lift_gen_lift *) -theorem lift_div_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → - ∀d2,e2,T2. ⇧[d2 + e1, e2] T2 ≡ T → - d1 ≤ d2 → - ∃∃T0. ⇧[d1, e1] T0 ≡ T2 & ⇧[d2, e2] T0 ≡ T1. -#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T -[ #k #d1 #e1 #d2 #e2 #T2 #Hk #Hd12 - lapply (lift_inv_sort2 … Hk) -Hk #Hk destruct /3 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12 - lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 - lapply (lift_inv_lref2_lt … Hi ?) -Hi /2 width=3/ /3 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12 - elim (lift_inv_lref2 … Hi) -Hi * #Hid2 #H destruct - [ -Hd12 lapply (lt_plus_to_lt_l … Hid2) -Hid2 #Hid2 /3 width=3/ - | -Hid1 >plus_plus_comm_23 in Hid2; #H lapply (le_plus_to_le_r … H) -H #H - elim (le_inv_plus_l … H) -H #Hide2 #He2i - lapply (transitive_le … Hd12 Hide2) -Hd12 #Hd12 - >le_plus_minus_comm // >(plus_minus_m_m i e2) in ⊢ (? ? ? %); // -He2i - /4 width=3/ - ] -| #p #d1 #e1 #d2 #e2 #T2 #Hk #Hd12 - lapply (lift_inv_gref2 … Hk) -Hk #Hk destruct /3 width=3/ -| #a #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12 - lapply (lift_inv_bind2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct - elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1 - >plus_plus_comm_23 in HU2; #HU2 elim (IHU … HU2 ?) /2 width=1/ /3 width=5/ -| #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12 - lapply (lift_inv_flat2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct - elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1 - elim (IHU … HU2 ?) // /3 width=5/ -] -qed. - -(* Note: apparently this was missing in basic_1 *) -theorem lift_div_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → - ∀e,e2,T2. ⇧[d1 + e, e2] T2 ≡ T → - e ≤ e1 → e1 ≤ e + e2 → - ∃∃T0. ⇧[d1, e] T0 ≡ T2 & ⇧[d1, e + e2 - e1] T0 ≡ T1. -#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T -[ #k #d1 #e1 #e #e2 #T2 #H >(lift_inv_sort2 … H) -H /2 width=3/ -| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2 - >(lift_inv_lref2_lt … H) -H [ /3 width=3/ | /2 width=3/ ] -| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2 - elim (lt_or_ge (i+e1) (d1+e+e2)) #Hie1d1e2 - [ elim (lift_inv_lref2_be … H ? ?) -H // /2 width=1/ - | >(lift_inv_lref2_ge … H ?) -H // - lapply (le_plus_to_minus … Hie1d1e2) #Hd1e21i - elim (le_inv_plus_l … Hie1d1e2) -Hie1d1e2 #Hd1e12 #He2ie1 - @ex2_intro [2: /2 width=1/ | skip ] -Hd1e12 - @lift_lref_ge_minus_eq [ >plus_minus_commutative // | /2 width=1/ ] - ] -| #p #d1 #e1 #e #e2 #T2 #H >(lift_inv_gref2 … H) -H /2 width=3/ -| #a #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2 - elim (lift_inv_bind2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct - elim (IHV1 … HV2 ? ?) -V // >plus_plus_comm_23 in HT2; #HT2 - elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/ -| #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2 - elim (lift_inv_flat2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct - elim (IHV1 … HV2 ? ?) -V // - elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/ -] -qed. - -theorem lift_mono: ∀d,e,T,U1. ⇧[d,e] T ≡ U1 → ∀U2. ⇧[d,e] T ≡ U2 → U1 = U2. -#d #e #T #U1 #H elim H -d -e -T -U1 -[ #k #d #e #X #HX - lapply (lift_inv_sort1 … HX) -HX // -| #i #d #e #Hid #X #HX - lapply (lift_inv_lref1_lt … HX ?) -HX // -| #i #d #e #Hdi #X #HX - lapply (lift_inv_lref1_ge … HX ?) -HX // -| #p #d #e #X #HX - lapply (lift_inv_gref1 … HX) -HX // -| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX - elim (lift_inv_bind1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ -| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX - elim (lift_inv_flat1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/ -] -qed-. - -(* Basic_1: was: lift_free (left to right) *) -theorem lift_trans_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → - ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → - d1 ≤ d2 → d2 ≤ d1 + e1 → ⇧[d1, e1 + e2] T1 ≡ T2. -#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T -[ #k #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_ - >(lift_inv_sort1 … HT2) -HT2 // -| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #Hd12 #_ - lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 - lapply (lift_inv_lref1_lt … HT2 Hid2) /2 width=1/ -| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #_ #Hd21 - lapply (lift_inv_lref1_ge … HT2 ?) -HT2 - [ @(transitive_le … Hd21 ?) -Hd21 /2 width=1/ - | -Hd21 /2 width=1/ - ] -| #p #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_ - >(lift_inv_gref1 … HT2) -HT2 // -| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21 - elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct - lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10 - lapply (IHT12 … HT20 ? ?) /2 width=1/ -| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21 - elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct - lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10 - lapply (IHT12 … HT20 ? ?) // /2 width=1/ -] -qed. - -(* Basic_1: was: lift_d (right to left) *) -theorem lift_trans_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → - ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d2 ≤ d1 → - ∃∃T0. ⇧[d2, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T0 ≡ T2. -#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T -[ #k #d1 #e1 #d2 #e2 #X #HX #_ - >(lift_inv_sort1 … HX) -HX /2 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_ - lapply (lt_to_le_to_lt … (d1+e2) Hid1 ?) // #Hie2 - elim (lift_inv_lref1 … HX) -HX * #Hid2 #HX destruct /3 width=3/ /4 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hd21 - lapply (transitive_le … Hd21 Hid1) -Hd21 #Hid2 - lapply (lift_inv_lref1_ge … HX ?) -HX /2 width=3/ #HX destruct - >plus_plus_comm_23 /4 width=3/ -| #p #d1 #e1 #d2 #e2 #X #HX #_ - >(lift_inv_gref1 … HX) -HX /2 width=3/ -| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21 - elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct - elim (IHV12 … HV20 ?) -IHV12 -HV20 // - elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ /3 width=5/ -| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21 - elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct - elim (IHV12 … HV20 ?) -IHV12 -HV20 // - elim (IHT12 … HT20 ?) -IHT12 -HT20 // /3 width=5/ -] -qed. - -(* Basic_1: was: lift_d (left to right) *) -theorem lift_trans_ge: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T → - ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d1 + e1 ≤ d2 → - ∃∃T0. ⇧[d2 - e1, e2] T1 ≡ T0 & ⇧[d1, e1] T0 ≡ T2. -#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T -[ #k #d1 #e1 #d2 #e2 #X #HX #_ - >(lift_inv_sort1 … HX) -HX /2 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hded - lapply (lt_to_le_to_lt … (d1+e1) Hid1 ?) // #Hid1e - lapply (lt_to_le_to_lt … (d2-e1) Hid1 ?) /2 width=1/ #Hid2e - lapply (lt_to_le_to_lt … Hid1e Hded) -Hid1e -Hded #Hid2 - lapply (lift_inv_lref1_lt … HX ?) -HX // #HX destruct /3 width=3/ -| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_ - elim (lift_inv_lref1 … HX) -HX * #Hied #HX destruct /4 width=3/ -| #p #d1 #e1 #d2 #e2 #X #HX #_ - >(lift_inv_gref1 … HX) -HX /2 width=3/ -| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded - elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct - elim (IHV12 … HV20 ?) -IHV12 -HV20 // - elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ #T - (lift_mono … H … HT1) -T // -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift_vector.ma deleted file mode 100644 index cdc11129d..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_lift_vector.ma +++ /dev/null @@ -1,30 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift_lift.ma". -include "basic_2/substitution/lift_vector.ma". - -(* BASIC TERM VECTOR RELOCATION *********************************************) - -(* Main properies ***********************************************************) - -theorem liftv_mono: ∀Ts,U1s,d,e. ⇧[d,e] Ts ≡ U1s → - ∀U2s:list term. ⇧[d,e] Ts ≡ U2s → U1s = U2s. -#Ts #U1s #d #e #H elim H -Ts -U1s -[ #U2s #H >(liftv_inv_nil1 … H) -H // -| #Ts #U1s #T #U1 #HTU1 #_ #IHTU1s #X #H destruct - elim (liftv_inv_cons1 … H) -H #U2 #U2s #HTU2 #HTU2s #H destruct - >(lift_mono … HTU1 … HTU2) -T /3 width=1/ -] -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_vector.ma deleted file mode 100644 index 35ecb6535..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_vector.ma +++ /dev/null @@ -1,62 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/grammar/term_vector.ma". -include "basic_2/substitution/lift.ma". - -(* BASIC TERM VECTOR RELOCATION *********************************************) - -inductive liftv (d,e:nat) : relation (list term) ≝ -| liftv_nil : liftv d e ◊ ◊ -| liftv_cons: ∀T1s,T2s,T1,T2. - ⇧[d, e] T1 ≡ T2 → liftv d e T1s T2s → - liftv d e (T1 @ T1s) (T2 @ T2s) -. - -interpretation "relocation (vector)" 'RLift d e T1s T2s = (liftv d e T1s T2s). - -(* Basic inversion lemmas ***************************************************) - -fact liftv_inv_nil1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → T1s = ◊ → T2s = ◊. -#T1s #T2s #d #e * -T1s -T2s // -#T1s #T2s #T1 #T2 #_ #_ #H destruct -qed. - -lemma liftv_inv_nil1: ∀T2s,d,e. ⇧[d, e] ◊ ≡ T2s → T2s = ◊. -/2 width=5/ qed-. - -fact liftv_inv_cons1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → - ∀U1,U1s. T1s = U1 @ U1s → - ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s & - T2s = U2 @ U2s. -#T1s #T2s #d #e * -T1s -T2s -[ #U1 #U1s #H destruct -| #T1s #T2s #T1 #T2 #HT12 #HT12s #U1 #U1s #H destruct /2 width=5/ -] -qed. - -lemma liftv_inv_cons1: ∀U1,U1s,T2s,d,e. ⇧[d, e] U1 @ U1s ≡ T2s → - ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s & - T2s = U2 @ U2s. -/2 width=3/ qed-. - -(* Basic properties *********************************************************) - -lemma liftv_total: ∀d,e. ∀T1s:list term. ∃T2s. ⇧[d, e] T1s ≡ T2s. -#d #e #T1s elim T1s -T1s -[ /2 width=2/ -| #T1 #T1s * #T2s #HT12s - elim (lift_total T1 d e) /3 width=2/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts.ma new file mode 100644 index 000000000..8d1576005 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts.ma @@ -0,0 +1,150 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift.ma". +include "basic_2/substitution/gr2_plus.ma". + +(* GENERIC TERM RELOCATION **************************************************) + +inductive lifts: list2 nat nat → relation term ≝ +| lifts_nil : ∀T. lifts ⟠ T T +| lifts_cons: ∀T1,T,T2,des,d,e. + ⇧[d,e] T1 ≡ T → lifts des T T2 → lifts ({d, e} @ des) T1 T2 +. + +interpretation "generic relocation (term)" + 'RLiftStar des T1 T2 = (lifts des T1 T2). + +(* Basic inversion lemmas ***************************************************) + +fact lifts_inv_nil_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → des = ⟠ → T1 = T2. +#T1 #T2 #des * -T1 -T2 -des // +#T1 #T #T2 #d #e #des #_ #_ #H destruct +qed. + +lemma lifts_inv_nil: ∀T1,T2. ⇧*[⟠] T1 ≡ T2 → T1 = T2. +/2 width=3/ qed-. + +fact lifts_inv_cons_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → + ∀d,e,tl. des = {d, e} @ tl → + ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[tl] T ≡ T2. +#T1 #T2 #des * -T1 -T2 -des +[ #T #d #e #tl #H destruct +| #T1 #T #T2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct + /2 width=3/ +qed. + +lemma lifts_inv_cons: ∀T1,T2,d,e,des. ⇧*[{d, e} @ des] T1 ≡ T2 → + ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[des] T ≡ T2. +/2 width=3/ qed-. + +(* Basic_1: was: lift1_sort *) +lemma lifts_inv_sort1: ∀T2,k,des. ⇧*[des] ⋆k ≡ T2 → T2 = ⋆k. +#T2 #k #des elim des -des +[ #H <(lifts_inv_nil … H) -H // +| #d #e #des #IH #H + elim (lifts_inv_cons … H) -H #X #H + >(lift_inv_sort1 … H) -H /2 width=1/ +] +qed-. + +(* Basic_1: was: lift1_lref *) +lemma lifts_inv_lref1: ∀T2,des,i1. ⇧*[des] #i1 ≡ T2 → + ∃∃i2. @⦃i1, des⦄ ≡ i2 & T2 = #i2. +#T2 #des elim des -des +[ #i1 #H <(lifts_inv_nil … H) -H /2 width=3/ +| #d #e #des #IH #i1 #H + elim (lifts_inv_cons … H) -H #X #H1 #H2 + elim (lift_inv_lref1 … H1) -H1 * #Hdi1 #H destruct + elim (IH … H2) -IH -H2 /3 width=3/ +] +qed-. + +lemma lifts_inv_gref1: ∀T2,p,des. ⇧*[des] §p ≡ T2 → T2 = §p. +#T2 #p #des elim des -des +[ #H <(lifts_inv_nil … H) -H // +| #d #e #des #IH #H + elim (lifts_inv_cons … H) -H #X #H + >(lift_inv_gref1 … H) -H /2 width=1/ +] +qed-. + +(* Basic_1: was: lift1_bind *) +lemma lifts_inv_bind1: ∀a,I,T2,des,V1,U1. ⇧*[des] ⓑ{a,I} V1. U1 ≡ T2 → + ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des + 1] U1 ≡ U2 & + T2 = ⓑ{a,I} V2. U2. +#a #I #T2 #des elim des -des +[ #V1 #U1 #H + <(lifts_inv_nil … H) -H /2 width=5/ +| #d #e #des #IHdes #V1 #U1 #H + elim (lifts_inv_cons … H) -H #X #H #HT2 + elim (lift_inv_bind1 … H) -H #V #U #HV1 #HU1 #H destruct + elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct + /3 width=5/ +] +qed-. + +(* Basic_1: was: lift1_flat *) +lemma lifts_inv_flat1: ∀I,T2,des,V1,U1. ⇧*[des] ⓕ{I} V1. U1 ≡ T2 → + ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des] U1 ≡ U2 & + T2 = ⓕ{I} V2. U2. +#I #T2 #des elim des -des +[ #V1 #U1 #H + <(lifts_inv_nil … H) -H /2 width=5/ +| #d #e #des #IHdes #V1 #U1 #H + elim (lifts_inv_cons … H) -H #X #H #HT2 + elim (lift_inv_flat1 … H) -H #V #U #HV1 #HU1 #H destruct + elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct + /3 width=5/ +] +qed-. + +(* Basic forward lemmas *****************************************************) + +lemma lifts_simple_dx: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄. +#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_dx/ +qed-. + +lemma lifts_simple_sn: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄. +#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_sn/ +qed-. + +(* Basic properties *********************************************************) + +lemma lifts_bind: ∀a,I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 → + ∀T1. ⇧*[des + 1] T1 ≡ T2 → + ⇧*[des] ⓑ{a,I} V1. T1 ≡ ⓑ{a,I} V2. T2. +#a #I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des +[ #V #T1 #H >(lifts_inv_nil … H) -H // +| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H + elim (lifts_inv_cons … H) -H /3 width=3/ +] +qed. + +lemma lifts_flat: ∀I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 → + ∀T1. ⇧*[des] T1 ≡ T2 → + ⇧*[des] ⓕ{I} V1. T1 ≡ ⓕ{I} V2. T2. +#I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des +[ #V #T1 #H >(lifts_inv_nil … H) -H // +| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H + elim (lifts_inv_cons … H) -H /3 width=3/ +] +qed. + +lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2. +#des elim des -des /2 width=2/ +#d #e #des #IH #T1 +elim (lift_total T1 d e) #T #HT1 +elim (IH T) -IH /3 width=4/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lift.ma new file mode 100644 index 000000000..a9c70ba7a --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lift.ma @@ -0,0 +1,59 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift_lift.ma". +include "basic_2/substitution/gr2_minus.ma". +include "basic_2/substitution/lifts.ma". + +(* GENERIC TERM RELOCATION **************************************************) + +(* Properties concerning basic term relocation ******************************) + +(* Basic_1: was: lift1_xhg (right to left) *) +lemma lifts_lift_trans_le: ∀T1,T,des. ⇧*[des] T1 ≡ T → ∀T2. ⇧[0, 1] T ≡ T2 → + ∃∃T0. ⇧[0, 1] T1 ≡ T0 & ⇧*[des + 1] T0 ≡ T2. +#T1 #T #des #H elim H -T1 -T -des +[ /2 width=3/ +| #T1 #T3 #T #des #d #e #HT13 #_ #IHT13 #T2 #HT2 + elim (IHT13 … HT2) -T #T #HT3 #HT2 + elim (lift_trans_le … HT13 … HT3 ?) -T3 // /3 width=5/ +] +qed-. + +(* Basic_1: was: lift1_free (right to left) *) +lemma lifts_lift_trans: ∀des,i,i0. @⦃i, des⦄ ≡ i0 → + ∀des0. des + 1 ▭ i + 1 ≡ des0 + 1 → + ∀T1,T0. ⇧*[des0] T1 ≡ T0 → + ∀T2. ⇧[O, i0 + 1] T0 ≡ T2 → + ∃∃T. ⇧[0, i + 1] T1 ≡ T & ⇧*[des] T ≡ T2. +#des elim des -des normalize +[ #i #x #H1 #des0 #H2 #T1 #T0 #HT10 #T2 + <(at_inv_nil … H1) -x #HT02 + lapply (minuss_inv_nil1 … H2) -H2 #H + >(pluss_inv_nil2 … H) in HT10; -des0 #H + >(lifts_inv_nil … H) -T1 /2 width=3/ +| #d #e #des #IHdes #i #i0 #H1 #des0 #H2 #T1 #T0 #HT10 #T2 #HT02 + elim (at_inv_cons … H1) -H1 * #Hid #Hi0 + [ elim (minuss_inv_cons1_lt … H2 ?) -H2 [2: /2 width=1/ ] #des1 #Hdes1 minus_plus #HT1 #HT0 + elim (IHdes … Hi0 … Hdes1 … HT0 … HT02) -IHdes -Hi0 -Hdes1 -T0 #T0 #HT0 #HT02 + elim (lift_trans_le … HT1 … HT0 ?) -T /2 width=1/ #T #HT1 commutative_plus in Hi0; #Hi0 + lapply (minuss_inv_cons1_ge … H2 ?) -H2 [ /2 width=1/ ] (liftv_inv_nil1 … H) -T1s /2 width=3/ +| #T1s #Ts #T1 #T #HT1 #_ #IHT1s #X #H + elim (liftv_inv_cons1 … H) -H #T2 #T2s #HT2 #HT2s #H destruct + elim (IHT1s … HT2s) -Ts #Ts #HT1s #HT2s + elim (lifts_lift_trans_le … HT1 … HT2) -T /3 width=5/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lifts.ma new file mode 100644 index 000000000..bfe0d2529 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_lifts.ma @@ -0,0 +1,25 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/lifts_lift.ma". + +(* GENERIC RELOCATION *******************************************************) + +(* Main properties **********************************************************) + +(* Basic_1: was: lift1_lift1 (left to right) *) +theorem lifts_trans: ∀T1,T,des1. ⇧*[des1] T1 ≡ T → ∀T2:term. ∀des2. ⇧*[des2] T ≡ T2 → + ⇧*[des1 @@ des2] T1 ≡ T2. +#T1 #T #des1 #H elim H -T1 -T -des1 // /3 width=3/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_vector.ma new file mode 100644 index 000000000..7046c9d32 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts_vector.ma @@ -0,0 +1,53 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/lift_vector.ma". +include "basic_2/substitution/lifts.ma". + +(* GENERIC TERM VECTOR RELOCATION *******************************************) + +inductive liftsv (des:list2 nat nat) : relation (list term) ≝ +| liftsv_nil : liftsv des ◊ ◊ +| liftsv_cons: ∀T1s,T2s,T1,T2. + ⇧*[des] T1 ≡ T2 → liftsv des T1s T2s → + liftsv des (T1 @ T1s) (T2 @ T2s) +. + +interpretation "generic relocation (vector)" + 'RLiftStar des T1s T2s = (liftsv des T1s T2s). + +(* Basic inversion lemmas ***************************************************) + +(* Basic_1: was: lifts1_flat (left to right) *) +lemma lifts_inv_applv1: ∀V1s,U1,T2,des. ⇧*[des] Ⓐ V1s. U1 ≡ T2 → + ∃∃V2s,U2. ⇧*[des] V1s ≡ V2s & ⇧*[des] U1 ≡ U2 & + T2 = Ⓐ V2s. U2. +#V1s elim V1s -V1s normalize +[ #T1 #T2 #des #HT12 + @(ex3_2_intro) [3,4: // |1,2: skip | // ] (**) (* explicit constructor *) +| #V1 #V1s #IHV1s #T1 #X #des #H + elim (lifts_inv_flat1 … H) -H #V2 #Y #HV12 #HY #H destruct + elim (IHV1s … HY) -IHV1s -HY #V2s #T2 #HV12s #HT12 #H destruct + @(ex3_2_intro) [4: // |3: /2 width=2/ |1,2: skip | // ] (**) (* explicit constructor *) +] +qed-. + +(* Basic properties *********************************************************) + +(* Basic_1: was: lifts1_flat (right to left) *) +lemma lifts_applv: ∀V1s,V2s,des. ⇧*[des] V1s ≡ V2s → + ∀T1,T2. ⇧*[des] T1 ≡ T2 → + ⇧*[des] Ⓐ V1s. T1 ≡ Ⓐ V2s. T2. +#V1s #V2s #des #H elim H -V1s -V2s // /3 width=1/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss.ma new file mode 100644 index 000000000..d440960f1 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss.ma @@ -0,0 +1,77 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/grammar/lenv_px_sn.ma". +include "basic_2/substitution/cpss.ma". + +(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************) + +(* Basic_1: includes: csubst1_bind *) +definition lpss: relation lenv ≝ lpx_sn cpss. + +interpretation "parallel substitution (local environment, sn variant)" + 'PSubstStarSn L1 L2 = (lpss L1 L2). + +(* Basic inversion lemmas ***************************************************) + +lemma lpss_inv_atom1: ∀L2. ⋆ ⊢ ▶* L2 → L2 = ⋆. +/2 width=4 by lpx_sn_inv_atom1_aux/ qed-. + +lemma lpss_inv_pair1: ∀I,K1,V1,L2. K1. ⓑ{I} V1 ⊢ ▶* L2 → + ∃∃K2,V2. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L2 = K2. ⓑ{I} V2. +/2 width=3 by lpx_sn_inv_pair1_aux/ qed-. + +lemma lpss_inv_atom2: ∀L1. L1 ⊢ ▶* ⋆ → L1 = ⋆. +/2 width=4 by lpx_sn_inv_atom2_aux/ qed-. + +lemma lpss_inv_pair2: ∀I,L1,K2,V2. L1 ⊢ ▶* K2. ⓑ{I} V2 → + ∃∃K1,V1. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L1 = K1. ⓑ{I} V1. +/2 width=3 by lpx_sn_inv_pair2_aux/ qed-. + +(* Basic properties *********************************************************) + +(* Basic_1: was by definition: csubst1_refl *) +lemma lpss_refl: ∀L. L ⊢ ▶* L. +/2 width=1 by lpx_sn_refl/ qed. + +lemma lpss_append: ∀K1,K2. K1 ⊢ ▶* K2 → ∀L1,L2. L1 ⊢ ▶* L2 → + L1 @@ K1 ⊢ ▶* L2 @@ K2. +/3 width=1 by lpx_sn_append, cpss_append/ qed. + +(* Basic forward lemmas *****************************************************) + +lemma lpss_fwd_length: ∀L1,L2. L1 ⊢ ▶* L2 → |L1| = |L2|. +/2 width=2 by lpx_sn_fwd_length/ qed-. + +(* Advanced forward lemmas **************************************************) + +lemma lpss_fwd_append1: ∀K1,L1,L. K1 @@ L1 ⊢ ▶* L → + ∃∃K2,L2. K1 ⊢ ▶* K2 & L = K2 @@ L2. +/2 width=2 by lpx_sn_fwd_append1/ qed-. + +lemma lpss_fwd_append2: ∀L,K2,L2. L ⊢ ▶* K2 @@ L2 → + ∃∃K1,L1. K1 ⊢ ▶* K2 & L = K1 @@ L1. +/2 width=2 by lpx_sn_fwd_append2/ qed-. + +(* Basic_1: removed theorems 28: + csubst0_clear_O csubst0_drop_lt csubst0_drop_gt csubst0_drop_eq + csubst0_clear_O_back csubst0_clear_S csubst0_clear_trans + csubst0_drop_gt_back csubst0_drop_eq_back csubst0_drop_lt_back + csubst0_gen_sort csubst0_gen_head csubst0_getl_ge csubst0_getl_lt + csubst0_gen_S_bind_2 csubst0_getl_ge_back csubst0_getl_lt_back + csubst0_snd_bind csubst0_fst_bind csubst0_both_bind + csubst1_head csubst1_flat csubst1_gen_head + csubst1_getl_ge csubst1_getl_lt csubst1_getl_ge_back getl_csubst1 + fsubst0_gen_base +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_cpss.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_cpss.ma new file mode 100644 index 000000000..a67eaeb05 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_cpss.ma @@ -0,0 +1,202 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/fsup.ma". +include "basic_2/substitution/lpss_ldrop.ma". + +(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************) + +(* Main properties on context-sensitive parallel substitution for terms *****) + +fact cpss_conf_lpss_atom_atom: + ∀I,L1,L2. ∃∃T. L1 ⊢ ⓪{I} ▶* T & L2 ⊢ ⓪{I} ▶* T. +/2 width=3/ qed-. + +fact cpss_conf_lpss_atom_delta: + ∀L0,i. ( + ∀L,T.♯{L, T} < ♯{L0, #i} → + ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 → + ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 → + ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0 + ) → + ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 → + ∀V2. K0 ⊢ V0 ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 → + ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 → + ∃∃T. L1 ⊢ #i ▶* T & L2 ⊢ T2 ▶* T. +#L0 #i #IH #K0 #V0 #HLK0 #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02 +elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1 +elim (lpss_inv_pair1 … H1) -H1 #K1 #V1 #HK01 #HV01 #H destruct +elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2 +elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 +lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0 +elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2 +elim (lift_total V 0 (i+1)) #T #HVT +lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 /3 width=6/ +qed-. + +fact cpss_conf_lpss_delta_delta: + ∀L0,i. ( + ∀L,T.♯{L, T} < ♯{L0, #i} → + ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 → + ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 → + ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0 + ) → + ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 → + ∀V1. K0 ⊢ V0 ▶* V1 → ∀T1. ⇧[O, i + 1] V1 ≡ T1 → + ∀KX,VX. ⇩[O, i] L0 ≡ KX.ⓓVX → + ∀V2. KX ⊢ VX ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 → + ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 → + ∃∃T. L1 ⊢ T1 ▶* T & L2 ⊢ T2 ▶* T. +#L0 #i #IH #K0 #V0 #HLK0 #V1 #HV01 #T1 #HVT1 +#KX #VX #H #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02 +lapply (ldrop_mono … H … HLK0) -H #H destruct +elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1 +elim (lpss_inv_pair1 … H1) -H1 #K1 #W1 #HK01 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK1) -W1 #HLK1 +elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2 +elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 +lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0 +elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2 +elim (lift_total V 0 (i+1)) #T #HVT +lapply (cpss_lift … HV1 … HLK1 … HVT1 … HVT) -K1 -V1 +lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 -V /2 width=3/ +qed-. + +fact cpss_conf_lpss_bind_bind: + ∀a,I,L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓑ{a,I}V0.T0} → + ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 → + ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 → + ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0 + ) → + ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0.ⓑ{I}V0 ⊢ T0 ▶* T1 → + ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0.ⓑ{I}V0 ⊢ T0 ▶* T2 → + ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 → + ∃∃T. L1 ⊢ ⓑ{a,I}V1.T1 ▶* T & L2 ⊢ ⓑ{a,I}V2.T2 ▶* T. +#a #I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01 +#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HV01 … HV02 … HL01 … HL02) // +elim (IH … HT01 … HT02 (L1.ⓑ{I}V1) … (L2.ⓑ{I}V2)) -IH // /2 width=1/ /3 width=5/ +qed-. + +fact cpss_conf_lpss_flat_flat: + ∀I,L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓕ{I}V0.T0} → + ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 → + ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 → + ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0 + ) → + ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0 ⊢ T0 ▶* T1 → + ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0 ⊢ T0 ▶* T2 → + ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 → + ∃∃T. L1 ⊢ ⓕ{I}V1.T1 ▶* T & L2 ⊢ ⓕ{I}V2.T2 ▶* T. +#I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01 +#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HV01 … HV02 … HL01 … HL02) // +elim (IH … HT01 … HT02 … HL01 … HL02) // /3 width=5/ +qed-. + +theorem cpss_conf_lpss: lpx_sn_confluent cpss cpss. +#L0 #T0 @(f2_ind … fw … L0 T0) -L0 -T0 #n #IH #L0 * [|*] +[ #I0 #Hn #T1 #H1 #T2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpss_inv_atom1 … H1) -H1 + elim (cpss_inv_atom1 … H2) -H2 + [ #H2 #H1 destruct + /2 width=1 by cpss_conf_lpss_atom_atom/ + | * #K0 #V0 #V2 #i2 #HLK0 #HV02 #HVT2 #H2 #H1 destruct + /3 width=10 by cpss_conf_lpss_atom_delta/ + | #H2 * #K0 #V0 #V1 #i1 #HLK0 #HV01 #HVT1 #H1 destruct + /4 width=10 by ex2_commute, cpss_conf_lpss_atom_delta/ + | * #X #Y #V2 #z #H #HV02 #HVT2 #H2 + * #K0 #V0 #V1 #i #HLK0 #HV01 #HVT1 #H1 destruct + /3 width=17 by cpss_conf_lpss_delta_delta/ + ] +| #a #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpss_inv_bind1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct + elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct + /3 width=10 by cpss_conf_lpss_bind_bind/ +| #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpss_inv_flat1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct + elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct + /3 width=10 by cpss_conf_lpss_flat_flat/ +] +qed-. + +(* Basic_1: was only: subst1_confluence_eq *) +theorem cpss_conf: ∀L. confluent … (cpss L). +/2 width=6 by cpss_conf_lpss/ qed-. + +theorem cpss_trans_lpss: lpx_sn_transitive cpss cpss. +#L1 #T1 @(f2_ind … fw … L1 T1) -L1 -T1 #n #IH #L1 * [|*] +[ #I #Hn #T #H1 #L2 #HL12 #T2 #HT2 destruct + elim (cpss_inv_atom1 … H1) -H1 + [ #H destruct + elim (cpss_inv_atom1 … HT2) -HT2 + [ #H destruct // + | * #K2 #V #V2 #i #HLK2 #HV2 #HVT2 #H destruct + elim (lpss_ldrop_trans_O1 … HL12 … HLK2) -L2 #X #HLK1 #H + elim (lpss_inv_pair2 … H) -H #K1 #V1 #HK12 #HV1 #H destruct + lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/ + ] + | * #K1 #V1 #V #i #HLK1 #HV1 #HVT #H destruct + elim (lpss_ldrop_conf … HLK1 … HL12) -HL12 #X #H #HLK2 + elim (lpss_inv_pair1 … H) -H #K2 #W2 #HK12 #_ #H destruct + lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 + elim (cpss_inv_lift1 … HT2 … HLK2 … HVT) -L2 -T + lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/ + ] +| #a #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2 + elim (cpss_inv_bind1 … H1) -H1 #V #T #HV1 #HT1 #H destruct + elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /4 width=5/ +| #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2 + elim (cpss_inv_flat1 … H1) -H1 #V #T #HV1 #HT1 #H destruct + elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /3 width=5/ +] +qed-. + +(* Basic_1: was only: subst1_trans *) +theorem cpss_trans: ∀L. Transitive … (cpss L). +/2 width=5 by cpss_trans_lpss/ qed-. + +(* Properties on context-sensitive parallel substitution for terms **********) + +(* Basic_1: was only: subst1_subst1_back *) +lemma lpss_cpss_conf_dx: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 → + ∃∃T. L1 ⊢ T0 ▶* T & L1 ⊢ T1 ▶* T. +#L0 #T0 #T1 #HT01 #L1 #HL01 +elim (cpss_conf_lpss … HT01 T0 … HL01 … HL01) // -L0 /2 width=3/ +qed-. + +lemma lpss_cpss_conf_sn: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 → + ∃∃T. L1 ⊢ T0 ▶* T & L0 ⊢ T1 ▶* T. +#L0 #T0 #T1 #HT01 #L1 #HL01 +elim (cpss_conf_lpss … HT01 T0 … L0 … HL01) // -HT01 -HL01 /2 width=3/ +qed-. + +(* Basic_1: was only: subst1_subst1 *) +lemma lpss_cpss_trans: ∀L1,L2. L1 ⊢ ▶* L2 → + ∀T1,T2. L2 ⊢ T1 ▶* T2 → L1 ⊢ T1 ▶* T2. +/2 width=5 by cpss_trans_lpss/ qed-. + +lemma fsup_cpss_trans: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀U2. L2 ⊢ T2 ▶* U2 → + ∃∃L,U1. L1 ⊢ ▶* L & L ⊢ T1 ▶* U1 & ⦃L, U1⦄ ⊃ ⦃L2, U2⦄. +#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 [1,2,3,4,5: /3 width=5/ ] +#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #U2 #HTU2 +elim (IHT12 … HTU2) -IHT12 -HTU2 #K #T #HK1 #HT1 #HT2 +elim (lift_total T d e) #U #HTU +elim (ldrop_lpss_trans … HLK1 … HK1) -HLK1 -HK1 #L2 #HL12 #HL2K +lapply (cpss_lift … HT1 … HL2K … HTU1 … HTU) -HT1 -HTU1 /3 width=11/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_ldrop.ma new file mode 100644 index 000000000..044293b27 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_ldrop.ma @@ -0,0 +1,30 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop_lpx_sn.ma". +include "basic_2/substitution/cpss_lift.ma". +include "basic_2/substitution/lpss.ma". + +(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************) + +(* Properies on local environment slicing ***********************************) + +lemma lpss_ldrop_conf: dropable_sn lpss. +/3 width=5 by lpx_sn_deliftable_dropable, cpss_inv_lift1/ qed-. + +lemma ldrop_lpss_trans: dedropable_sn lpss. +/3 width=9 by lpx_sn_liftable_dedropable, cpss_lift/ qed-. + +lemma lpss_ldrop_trans_O1: dropable_dx lpss. +/2 width=3 by lpx_sn_dropable/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_lpss.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_lpss.ma new file mode 100644 index 000000000..06223fbee --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpss_lpss.ma @@ -0,0 +1,43 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/lpss_cpss.ma". + +(* SN PARALLEL SUBSTITUTION ON LOCAL ENVIRONMENTS ***************************) + +(* Main properties **********************************************************) + +theorem lpss_conf: confluent … lpss. +/3 width=6 by lpx_sn_conf, cpss_conf_lpss/ +qed-. + +theorem lpss_trans: Transitive … lpss. +/3 width=5 by lpx_sn_trans, cpss_trans_lpss/ +qed-. + +(* Advanced forward lemmas **************************************************) + +lemma cpss_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ▶* T → + ∃∃L2,T2. L @@ L1 ⊢ ▶* L @@ L2 & L @@ L1 ⊢ T1 ▶* T2 & + T = L2 @@ T2. +#L1 @(lenv_ind_dx … L1) -L1 +[ #L #T1 #T #HT1 + @ex3_2_intro [3: // |4,5: // |1,2: skip ] (**) (* /2 width=4/ does not work *) +| #I #L1 #V1 #IH #L #T1 #T >shift_append_assoc #H (plus_minus_m_m e 1) // /2 width=1/ -qed. - -lemma lsubr_abst_lt: ∀L1,L2,I,V1,V2,e. L1 ⊑ [0, e - 1] L2 → 0 < e → - L1. ⓑ{I}V1 ⊑ [0, e] L2. ⓛV2. -#L1 #L2 #I #V1 #V2 #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/ -qed. - -lemma lsubr_skip_lt: ∀L1,L2,d,e. L1 ⊑ [d - 1, e] L2 → 0 < d → - ∀I1,I2,V1,V2. L1. ⓑ{I1} V1 ⊑ [d, e] L2. ⓑ{I2} V2. -#L1 #L2 #d #e #HL12 #Hd >(plus_minus_m_m d 1) // /2 width=1/ -qed. - -lemma lsubr_bind_lt: ∀I,L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e → - L1. ⓓV ⊑ [0, e] L2. ⓑ{I}V. -* /2 width=1/ qed. - -lemma lsubr_refl: ∀d,e,L. L ⊑ [d, e] L. -#d elim d -d -[ #e elim e -e // #e #IHe #L elim L -L // /2 width=1/ -| #d #IHd #e #L elim L -L // /2 width=1/ -] -qed. - -lemma TC_lsubr_trans: ∀S,R. lsubr_trans S R → lsubr_trans S (λL. (TC … (R L))). -#S #R #HR #L1 #s1 #s2 #H elim H -s2 -[ /3 width=5/ -| #s #s2 #_ #Hs2 #IHs1 #L2 #d #e #HL12 - lapply (HR … Hs2 … HL12) -HR -Hs2 -HL12 /3 width=3/ -] -qed. - -(* Basic inversion lemmas ***************************************************) - -fact lsubr_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L1 = ⋆ → - L2 = ⋆ ∨ (d = 0 ∧ e = 0). -#L1 #L2 #d #e * -L1 -L2 -d -e -[ /2 width=1/ -| /3 width=1/ -| #L1 #L2 #W #e #_ #H destruct -| #L1 #L2 #I #W1 #W2 #e #_ #H destruct -| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct -] -qed. - -lemma lsubr_inv_atom1: ∀L2,d,e. ⋆ ⊑ [d, e] L2 → - L2 = ⋆ ∨ (d = 0 ∧ e = 0). -/2 width=3/ qed-. - -fact lsubr_inv_skip1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - ∀I1,K1,V1. L1 = K1.ⓑ{I1}V1 → 0 < d → - ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #d #e #I1 #K1 #V1 #H destruct -| #L1 #L2 #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/ -] -qed. - -lemma lsubr_inv_skip1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊑ [d, e] L2 → 0 < d → - ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2. -/2 width=5/ qed-. - -fact lsubr_inv_atom2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L2 = ⋆ → - L1 = ⋆ ∨ (d = 0 ∧ e = 0). -#L1 #L2 #d #e * -L1 -L2 -d -e -[ /2 width=1/ -| /3 width=1/ -| #L1 #L2 #W #e #_ #H destruct -| #L1 #L2 #I #W1 #W2 #e #_ #H destruct -| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct -] -qed. - -lemma lsubr_inv_atom2: ∀L1,d,e. L1 ⊑ [d, e] ⋆ → - L1 = ⋆ ∨ (d = 0 ∧ e = 0). -/2 width=3/ qed-. - -fact lsubr_inv_abbr2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - ∀K2,V. L2 = K2.ⓓV → d = 0 → 0 < e → - ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #d #e #K1 #V #H destruct -| #L1 #L2 #K1 #V #_ #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #W #e #HL12 #K1 #V #H #_ #_ destruct /2 width=3/ -| #L1 #L2 #I #W1 #W2 #e #_ #K1 #V #H destruct -| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #K1 #V #_ >commutative_plus normalize #H destruct -] -qed. - -lemma lsubr_inv_abbr2: ∀L1,K2,V,e. L1 ⊑ [0, e] K2.ⓓV → 0 < e → - ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV. -/2 width=5/ qed-. - -fact lsubr_inv_skip2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - ∀I2,K2,V2. L2 = K2.ⓑ{I2}V2 → 0 < d → - ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #d #e #I1 #K1 #V1 #H destruct -| #L1 #L2 #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H - elim (lt_zero_false … H) -| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/ -] -qed. - -lemma lsubr_inv_skip2: ∀I2,L1,K2,V2,d,e. L1 ⊑ [d, e] K2.ⓑ{I2}V2 → 0 < d → - ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1. -/2 width=5/ qed-. - -(* Basic forward lemmas *****************************************************) - -fact lsubr_fwd_length_full1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - d = 0 → e = |L1| → |L1| ≤ |L2|. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize -[ // -| /2 width=1/ -| /3 width=1/ -| /3 width=1/ -| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct -] -qed. - -lemma lsubr_fwd_length_full1: ∀L1,L2. L1 ⊑ [0, |L1|] L2 → |L1| ≤ |L2|. -/2 width=5/ qed-. - -fact lsubr_fwd_length_full2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → - d = 0 → e = |L2| → |L2| ≤ |L1|. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize -[ // -| /2 width=1/ -| /3 width=1/ -| /3 width=1/ -| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct -] -qed. - -lemma lsubr_fwd_length_full2: ∀L1,L2. L1 ⊑ [0, |L2|] L2 → |L2| ≤ |L1|. -/2 width=5/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lsubr_lbotr.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lsubr_lbotr.ma deleted file mode 100644 index 92593a2ad..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lsubr_lbotr.ma +++ /dev/null @@ -1,73 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lsubr.ma". - -(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************) - -(* bottom element of the refinement *) -definition lbotr: nat → nat → predicate lenv ≝ - λd,e. NF_sn … (lsubr d e) (lsubr d e …). - -interpretation - "local environment full refinement (substitution)" - 'SubEqBottom d e L = (lbotr d e L). - -(* Basic properties *********************************************************) - -lemma lbotr_atom: ∀d,e. ⊒[d, e] ⋆. -#d #e #L #H -elim (lsubr_inv_atom2 … H) -H -[ #H destruct // -| * #H1 #H2 destruct // -] -qed. - -lemma lbotr_OO: ∀L. ⊒[0, 0] L. -// qed. - -lemma lbotr_abbr: ∀L,V,e. ⊒[0, e] L → ⊒[0, e + 1] L.ⓓV. -#L #V #e #HL #K #H -elim (lsubr_inv_abbr2 … H ?) -H // shift_append_assoc normalize #H + elim (cpqs_inv_bind1 … H) -H * + [ #V0 #T0 #_ #HT10 #H destruct + elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct + >append_length >HL12 -HL12 + @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *) + | #T #_ #_ #H destruct + ] +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/cpqs_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/cpqs_lift.ma new file mode 100644 index 000000000..78529b6b1 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/cpqs_lift.ma @@ -0,0 +1,81 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/unfold/cpqs.ma". + +(* CONTEXT-SENSITIVE RESTRICTED PARALLEL COMPUTATION FOR TERMS **************) + +(* Relocation properties ****************************************************) + +lemma cpqs_lift: l_liftable cpqs. +#K #T1 #T2 #H elim H -K -T1 -T2 +[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2 + >(lift_mono … H1 … H2) -H1 -H2 // +| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2 + elim (lift_inv_lref1 … H) * #Hid #H destruct + [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // plus_plus_comm_23 #HVU2 + lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/ + ] +| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 + elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct + elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/ +| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 + elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct + elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/ +| #K #V #T1 #T #T2 #_ #HT2 #IHT1 #L #d #e #HLK #U1 #H #U2 #HTU2 + elim (lift_inv_bind1 … H) -H #VV1 #TT1 #HVV1 #HTT1 #H destruct + elim (lift_conf_O1 … HTU2 … HT2) -T2 /4 width=5/ +| #K #V #T1 #T2 #_ #IHT12 #L #d #e #HLK #U1 #H #U2 #HTU2 + elim (lift_inv_flat1 … H) -H #VV1 #TT1 #HVV1 #HTT1 #H destruct /3 width=5/ +] +qed. + +lemma cpqs_inv_lift1: l_deliftable_sn cpqs. +#L #U1 #U2 #H elim H -L -U1 -U2 +[ * #L #i #K #d #e #_ #T1 #H + [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/ + | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/ + | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/ + ] +| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H + elim (lift_inv_lref2 … H) -H * #Hid #H destruct + [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV + elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2 + elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus plus_minus // shift_append_assoc normalize #H - elim (cpss_inv_bind1 … H) -H - #V0 #T0 #_ #HT10 #H destruct - elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct - >append_length >HL12 -HL12 - @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *) -] -qed-. - -(* Basic_1: removed theorems 27: - subst0_gen_sort subst0_gen_lref subst0_gen_head subst0_gen_lift_lt - subst0_gen_lift_false subst0_gen_lift_ge subst0_refl subst0_trans - subst0_lift_lt subst0_lift_ge subst0_lift_ge_S subst0_lift_ge_s - subst0_subst0 subst0_subst0_back subst0_weight_le subst0_weight_lt - subst0_confluence_neq subst0_confluence_eq subst0_tlt_head - subst0_confluence_lift subst0_tlt - subst1_head subst1_gen_head subst1_lift_S subst1_confluence_lift - subst1_gen_lift_eq subst1_confluence_neq -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/cpss_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/cpss_lift.ma deleted file mode 100644 index d41e0ac18..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/cpss_lift.ma +++ /dev/null @@ -1,71 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/ldrop_ldrop.ma". -include "basic_2/unfold/cpss.ma". - -(* CONTEXT-SENSITIVE PARALLEL UNFOLD FOR TERMS ******************************) - -(* Relocation properties ****************************************************) - -(* Basic_1: was only: subst1_lift_lt subst1_lift_ge *) -lemma cpss_lift: l_liftable cpss. -#K #T1 #T2 #H elim H -K -T1 -T2 -[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2 - >(lift_mono … H1 … H2) -H1 -H2 // -| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2 - elim (lift_inv_lref1 … H) * #Hid #H destruct - [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // plus_plus_comm_23 #HVU2 - lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/ - ] -| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 - elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct - elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/ -| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2 - elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct - elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/ -] -qed. - -(* Basic_1: was only: subst1_gen_lift_lt subst1_gen_lift_ge *) -lemma cpss_inv_lift1: l_deliftable_sn cpss. -#L #U1 #U2 #H elim H -L -U1 -U2 -[ * #L #i #K #d #e #_ #T1 #H - [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/ - | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/ - | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/ - ] -| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H - elim (lift_inv_lref2 … H) -H * #Hid #H destruct - [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV - elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2 - elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus plus_minus // (ldrops_inv_nil … H) -L1 /2 width=7/ -| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H - elim (ldrops_inv_cons … H) -H #L #HL1 #H - elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ #K #V >minus_plus #HK2 #HV2 #H destruct - elim (IHdes2 … HL1) -IHdes2 -HL1 #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct - @(ex4_3_intro … K1 V1 … ) // [3,4: /2 width=7/ | skip ] - normalize >plus_minus // @minuss_lt // /2 width=1/ (**) (* explicit constructors, /3 width=1/ is a bit slow *) -| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H - elim (IHdes2 … H) -IHdes2 -H #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct - /4 width=7/ -] -qed-. - -(* Basic properties *********************************************************) - -(* Basic_1: was: drop1_skip_bind *) -lemma ldrops_skip: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 → - ∀I. ⇩*[des + 1] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2. -#L1 #L2 #des #H elim H -L1 -L2 -des -[ #L #V1 #V2 #HV12 #I - >(lifts_inv_nil … HV12) -HV12 // -| #L1 #L #L2 #des #d #e #_ #HL2 #IHL #V1 #V2 #H #I - elim (lifts_inv_cons … H) -H /3 width=5/ -]. -qed. - -(* Basic_1: removed theorems 1: drop1_getl_trans *) diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrop.ma deleted file mode 100644 index 6ca2f73df..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrop.ma +++ /dev/null @@ -1,35 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/ldrop_ldrop.ma". -include "basic_2/unfold/ldrops.ma". - -(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************) - -(* Properties concerning basic local environment slicing ********************) - -lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[des] L1 ≡ L → ∀L2,i. ⇩[0, i] L ≡ L2 → - ∃∃L0,des0,i0. ⇩[0, i0] L1 ≡ L0 & ⇩*[des0] L0 ≡ L2 & - @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0. -#L1 #L #des #H elim H -L1 -L -des -[ /2 width=7/ -| #L1 #L3 #L #des3 #d #e #_ #HL3 #IHL13 #L2 #i #HL2 - elim (lt_or_ge i d) #Hid - [ elim (ldrop_trans_le … HL3 … HL2 ?) -L /2 width=2/ #L #HL3 #HL2 - elim (IHL13 … HL3) -L3 /3 width=7/ - | lapply (ldrop_trans_ge … HL3 … HL2 ?) -L // #HL32 - elim (IHL13 … HL32) -L3 /3 width=7/ - ] -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrops.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrops.ma deleted file mode 100644 index 7709561a2..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/ldrops_ldrops.ma +++ /dev/null @@ -1,25 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/unfold/ldrops_ldrop.ma". - -(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************) - -(* Main properties **********************************************************) - -(* Basic_1: was: drop1_trans *) -theorem ldrops_trans: ∀L,L2,des2. ⇩*[des2] L ≡ L2 → ∀L1,des1. ⇩*[des1] L1 ≡ L → - ⇩*[des2 @@ des1] L1 ≡ L2. -#L #L2 #des2 #H elim H -L -L2 -des2 // /3 width=3/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts.ma deleted file mode 100644 index 40158acbe..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts.ma +++ /dev/null @@ -1,150 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift.ma". -include "basic_2/unfold/gr2_plus.ma". - -(* GENERIC TERM RELOCATION **************************************************) - -inductive lifts: list2 nat nat → relation term ≝ -| lifts_nil : ∀T. lifts ⟠ T T -| lifts_cons: ∀T1,T,T2,des,d,e. - ⇧[d,e] T1 ≡ T → lifts des T T2 → lifts ({d, e} @ des) T1 T2 -. - -interpretation "generic relocation (term)" - 'RLiftStar des T1 T2 = (lifts des T1 T2). - -(* Basic inversion lemmas ***************************************************) - -fact lifts_inv_nil_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → des = ⟠ → T1 = T2. -#T1 #T2 #des * -T1 -T2 -des // -#T1 #T #T2 #d #e #des #_ #_ #H destruct -qed. - -lemma lifts_inv_nil: ∀T1,T2. ⇧*[⟠] T1 ≡ T2 → T1 = T2. -/2 width=3/ qed-. - -fact lifts_inv_cons_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → - ∀d,e,tl. des = {d, e} @ tl → - ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[tl] T ≡ T2. -#T1 #T2 #des * -T1 -T2 -des -[ #T #d #e #tl #H destruct -| #T1 #T #T2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct - /2 width=3/ -qed. - -lemma lifts_inv_cons: ∀T1,T2,d,e,des. ⇧*[{d, e} @ des] T1 ≡ T2 → - ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[des] T ≡ T2. -/2 width=3/ qed-. - -(* Basic_1: was: lift1_sort *) -lemma lifts_inv_sort1: ∀T2,k,des. ⇧*[des] ⋆k ≡ T2 → T2 = ⋆k. -#T2 #k #des elim des -des -[ #H <(lifts_inv_nil … H) -H // -| #d #e #des #IH #H - elim (lifts_inv_cons … H) -H #X #H - >(lift_inv_sort1 … H) -H /2 width=1/ -] -qed-. - -(* Basic_1: was: lift1_lref *) -lemma lifts_inv_lref1: ∀T2,des,i1. ⇧*[des] #i1 ≡ T2 → - ∃∃i2. @⦃i1, des⦄ ≡ i2 & T2 = #i2. -#T2 #des elim des -des -[ #i1 #H <(lifts_inv_nil … H) -H /2 width=3/ -| #d #e #des #IH #i1 #H - elim (lifts_inv_cons … H) -H #X #H1 #H2 - elim (lift_inv_lref1 … H1) -H1 * #Hdi1 #H destruct - elim (IH … H2) -IH -H2 /3 width=3/ -] -qed-. - -lemma lifts_inv_gref1: ∀T2,p,des. ⇧*[des] §p ≡ T2 → T2 = §p. -#T2 #p #des elim des -des -[ #H <(lifts_inv_nil … H) -H // -| #d #e #des #IH #H - elim (lifts_inv_cons … H) -H #X #H - >(lift_inv_gref1 … H) -H /2 width=1/ -] -qed-. - -(* Basic_1: was: lift1_bind *) -lemma lifts_inv_bind1: ∀a,I,T2,des,V1,U1. ⇧*[des] ⓑ{a,I} V1. U1 ≡ T2 → - ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des + 1] U1 ≡ U2 & - T2 = ⓑ{a,I} V2. U2. -#a #I #T2 #des elim des -des -[ #V1 #U1 #H - <(lifts_inv_nil … H) -H /2 width=5/ -| #d #e #des #IHdes #V1 #U1 #H - elim (lifts_inv_cons … H) -H #X #H #HT2 - elim (lift_inv_bind1 … H) -H #V #U #HV1 #HU1 #H destruct - elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct - /3 width=5/ -] -qed-. - -(* Basic_1: was: lift1_flat *) -lemma lifts_inv_flat1: ∀I,T2,des,V1,U1. ⇧*[des] ⓕ{I} V1. U1 ≡ T2 → - ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des] U1 ≡ U2 & - T2 = ⓕ{I} V2. U2. -#I #T2 #des elim des -des -[ #V1 #U1 #H - <(lifts_inv_nil … H) -H /2 width=5/ -| #d #e #des #IHdes #V1 #U1 #H - elim (lifts_inv_cons … H) -H #X #H #HT2 - elim (lift_inv_flat1 … H) -H #V #U #HV1 #HU1 #H destruct - elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct - /3 width=5/ -] -qed-. - -(* Basic forward lemmas *****************************************************) - -lemma lifts_simple_dx: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄. -#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_dx/ -qed-. - -lemma lifts_simple_sn: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄. -#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_sn/ -qed-. - -(* Basic properties *********************************************************) - -lemma lifts_bind: ∀a,I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 → - ∀T1. ⇧*[des + 1] T1 ≡ T2 → - ⇧*[des] ⓑ{a,I} V1. T1 ≡ ⓑ{a,I} V2. T2. -#a #I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des -[ #V #T1 #H >(lifts_inv_nil … H) -H // -| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H - elim (lifts_inv_cons … H) -H /3 width=3/ -] -qed. - -lemma lifts_flat: ∀I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 → - ∀T1. ⇧*[des] T1 ≡ T2 → - ⇧*[des] ⓕ{I} V1. T1 ≡ ⓕ{I} V2. T2. -#I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des -[ #V #T1 #H >(lifts_inv_nil … H) -H // -| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H - elim (lifts_inv_cons … H) -H /3 width=3/ -] -qed. - -lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2. -#des elim des -des /2 width=2/ -#d #e #des #IH #T1 -elim (lift_total T1 d e) #T #HT1 -elim (IH T) -IH /3 width=4/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lift.ma deleted file mode 100644 index 0710f34ae..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lift.ma +++ /dev/null @@ -1,59 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift_lift.ma". -include "basic_2/unfold/gr2_minus.ma". -include "basic_2/unfold/lifts.ma". - -(* GENERIC TERM RELOCATION **************************************************) - -(* Properties concerning basic term relocation ******************************) - -(* Basic_1: was: lift1_xhg (right to left) *) -lemma lifts_lift_trans_le: ∀T1,T,des. ⇧*[des] T1 ≡ T → ∀T2. ⇧[0, 1] T ≡ T2 → - ∃∃T0. ⇧[0, 1] T1 ≡ T0 & ⇧*[des + 1] T0 ≡ T2. -#T1 #T #des #H elim H -T1 -T -des -[ /2 width=3/ -| #T1 #T3 #T #des #d #e #HT13 #_ #IHT13 #T2 #HT2 - elim (IHT13 … HT2) -T #T #HT3 #HT2 - elim (lift_trans_le … HT13 … HT3 ?) -T3 // /3 width=5/ -] -qed-. - -(* Basic_1: was: lift1_free (right to left) *) -lemma lifts_lift_trans: ∀des,i,i0. @⦃i, des⦄ ≡ i0 → - ∀des0. des + 1 ▭ i + 1 ≡ des0 + 1 → - ∀T1,T0. ⇧*[des0] T1 ≡ T0 → - ∀T2. ⇧[O, i0 + 1] T0 ≡ T2 → - ∃∃T. ⇧[0, i + 1] T1 ≡ T & ⇧*[des] T ≡ T2. -#des elim des -des normalize -[ #i #x #H1 #des0 #H2 #T1 #T0 #HT10 #T2 - <(at_inv_nil … H1) -x #HT02 - lapply (minuss_inv_nil1 … H2) -H2 #H - >(pluss_inv_nil2 … H) in HT10; -des0 #H - >(lifts_inv_nil … H) -T1 /2 width=3/ -| #d #e #des #IHdes #i #i0 #H1 #des0 #H2 #T1 #T0 #HT10 #T2 #HT02 - elim (at_inv_cons … H1) -H1 * #Hid #Hi0 - [ elim (minuss_inv_cons1_lt … H2 ?) -H2 [2: /2 width=1/ ] #des1 #Hdes1 minus_plus #HT1 #HT0 - elim (IHdes … Hi0 … Hdes1 … HT0 … HT02) -IHdes -Hi0 -Hdes1 -T0 #T0 #HT0 #HT02 - elim (lift_trans_le … HT1 … HT0 ?) -T /2 width=1/ #T #HT1 commutative_plus in Hi0; #Hi0 - lapply (minuss_inv_cons1_ge … H2 ?) -H2 [ /2 width=1/ ] (liftv_inv_nil1 … H) -T1s /2 width=3/ -| #T1s #Ts #T1 #T #HT1 #_ #IHT1s #X #H - elim (liftv_inv_cons1 … H) -H #T2 #T2s #HT2 #HT2s #H destruct - elim (IHT1s … HT2s) -Ts #Ts #HT1s #HT2s - elim (lifts_lift_trans_le … HT1 … HT2) -T /3 width=5/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lifts.ma deleted file mode 100644 index 72948f04b..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_lifts.ma +++ /dev/null @@ -1,25 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/unfold/lifts_lift.ma". - -(* GENERIC RELOCATION *******************************************************) - -(* Main properties **********************************************************) - -(* Basic_1: was: lift1_lift1 (left to right) *) -theorem lifts_trans: ∀T1,T,des1. ⇧*[des1] T1 ≡ T → ∀T2:term. ∀des2. ⇧*[des2] T ≡ T2 → - ⇧*[des1 @@ des2] T1 ≡ T2. -#T1 #T #des1 #H elim H -T1 -T -des1 // /3 width=3/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_vector.ma deleted file mode 100644 index 9ea173a56..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/lifts_vector.ma +++ /dev/null @@ -1,53 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basic_2/substitution/lift_vector.ma". -include "basic_2/unfold/lifts.ma". - -(* GENERIC TERM VECTOR RELOCATION *******************************************) - -inductive liftsv (des:list2 nat nat) : relation (list term) ≝ -| liftsv_nil : liftsv des ◊ ◊ -| liftsv_cons: ∀T1s,T2s,T1,T2. - ⇧*[des] T1 ≡ T2 → liftsv des T1s T2s → - liftsv des (T1 @ T1s) (T2 @ T2s) -. - -interpretation "generic relocation (vector)" - 'RLiftStar des T1s T2s = (liftsv des T1s T2s). - -(* Basic inversion lemmas ***************************************************) - -(* Basic_1: was: lifts1_flat (left to right) *) -lemma lifts_inv_applv1: ∀V1s,U1,T2,des. ⇧*[des] Ⓐ V1s. U1 ≡ T2 → - ∃∃V2s,U2. ⇧*[des] V1s ≡ V2s & ⇧*[des] U1 ≡ U2 & - T2 = Ⓐ V2s. U2. -#V1s elim V1s -V1s normalize -[ #T1 #T2 #des #HT12 - @(ex3_2_intro) [3,4: // |1,2: skip | // ] (**) (* explicit constructor *) -| #V1 #V1s #IHV1s #T1 #X #des #H - elim (lifts_inv_flat1 … H) -H #V2 #Y #HV12 #HY #H destruct - elim (IHV1s … HY) -IHV1s -HY #V2s #T2 #HV12s #HT12 #H destruct - @(ex3_2_intro) [4: // |3: /2 width=2/ |1,2: skip | // ] (**) (* explicit constructor *) -] -qed-. - -(* Basic properties *********************************************************) - -(* Basic_1: was: lifts1_flat (right to left) *) -lemma lifts_applv: ∀V1s,V2s,des. ⇧*[des] V1s ≡ V2s → - ∀T1,T2. ⇧*[des] T1 ≡ T2 → - ⇧*[des] Ⓐ V1s. T1 ≡ Ⓐ V2s. T2. -#V1s #V2s #des #H elim H -V1s -V2s // /3 width=1/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs.ma new file mode 100644 index 000000000..b3f6ee4d0 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs.ma @@ -0,0 +1,67 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/substitution/lpss.ma". +include "basic_2/unfold/cpqs.ma". + +(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************) + +definition lpqs: relation lenv ≝ lpx_sn cpqs. + +interpretation "restricted parallel computation (local environment, sn variant)" + 'PRestStarSn L1 L2 = (lpqs L1 L2). + +(* Basic inversion lemmas ***************************************************) + +lemma lpqs_inv_atom1: ∀L2. ⋆ ⊢ ➤* L2 → L2 = ⋆. +/2 width=4 by lpx_sn_inv_atom1_aux/ qed-. + +lemma lpqs_inv_pair1: ∀I,K1,V1,L2. K1. ⓑ{I} V1 ⊢ ➤* L2 → + ∃∃K2,V2. K1 ⊢ ➤* K2 & K1 ⊢ V1 ➤* V2 & L2 = K2. ⓑ{I} V2. +/2 width=3 by lpx_sn_inv_pair1_aux/ qed-. + +lemma lpqs_inv_atom2: ∀L1. L1 ⊢ ➤* ⋆ → L1 = ⋆. +/2 width=4 by lpx_sn_inv_atom2_aux/ qed-. + +lemma lpqs_inv_pair2: ∀I,L1,K2,V2. L1 ⊢ ➤* K2. ⓑ{I} V2 → + ∃∃K1,V1. K1 ⊢ ➤* K2 & K1 ⊢ V1 ➤* V2 & L1 = K1. ⓑ{I} V1. +/2 width=3 by lpx_sn_inv_pair2_aux/ qed-. + +(* Basic properties *********************************************************) + +lemma lpqs_refl: ∀L. L ⊢ ➤* L. +/2 width=1 by lpx_sn_refl/ qed. + +lemma lpqs_append: ∀K1,K2. K1 ⊢ ➤* K2 → ∀L1,L2. L1 ⊢ ➤* L2 → + L1 @@ K1 ⊢ ➤* L2 @@ K2. +/3 width=1 by lpx_sn_append, cpqs_append/ qed. + +lemma lpss_lpqs: ∀L1,L2. L1 ⊢ ▶* L2 → L1 ⊢ ➤* L2. +#L1 #L2 #H elim H -L1 -L2 // /3 width=1/ +qed. + +(* Basic forward lemmas *****************************************************) + +lemma lpqs_fwd_length: ∀L1,L2. L1 ⊢ ➤* L2 → |L1| = |L2|. +/2 width=2 by lpx_sn_fwd_length/ qed-. + +(* Advanced forward lemmas **************************************************) + +lemma lpqs_fwd_append1: ∀K1,L1,L. K1 @@ L1 ⊢ ➤* L → + ∃∃K2,L2. K1 ⊢ ➤* K2 & L = K2 @@ L2. +/2 width=2 by lpx_sn_fwd_append1/ qed-. + +lemma lpqs_fwd_append2: ∀L,K2,L2. L ⊢ ➤* K2 @@ L2 → + ∃∃K1,L1. K1 ⊢ ➤* K2 & L = K1 @@ L1. +/2 width=2 by lpx_sn_fwd_append2/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_cpqs.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_cpqs.ma new file mode 100644 index 000000000..47d3b7cdf --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_cpqs.ma @@ -0,0 +1,297 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/fsup.ma". +include "basic_2/unfold/lpqs_ldrop.ma". + +(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************) + +(* Main properties on context-sensitive rest parallel computation for terms *) + +fact cpqs_conf_lpqs_atom_atom: + ∀I,L1,L2. ∃∃T. L1 ⊢ ⓪{I} ➤* T & L2 ⊢ ⓪{I} ➤* T. +/2 width=3/ qed-. + +fact cpqs_conf_lpqs_atom_delta: + ∀L0,i. ( + ∀L,T.♯{L, T} < ♯{L0, #i} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 → + ∀V2. K0 ⊢ V0 ➤* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ #i ➤* T & L2 ⊢ T2 ➤* T. +#L0 #i #IH #K0 #V0 #HLK0 #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02 +elim (lpqs_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1 +elim (lpqs_inv_pair1 … H1) -H1 #K1 #V1 #HK01 #HV01 #H destruct +elim (lpqs_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2 +elim (lpqs_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 +lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0 +elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2 +elim (lift_total V 0 (i+1)) #T #HVT +lapply (cpqs_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 /3 width=6/ +qed-. + +fact cpqs_conf_lpqs_delta_delta: + ∀L0,i. ( + ∀L,T.♯{L, T} < ♯{L0, #i} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 → + ∀V1. K0 ⊢ V0 ➤* V1 → ∀T1. ⇧[O, i + 1] V1 ≡ T1 → + ∀KX,VX. ⇩[O, i] L0 ≡ KX.ⓓVX → + ∀V2. KX ⊢ VX ➤* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ T1 ➤* T & L2 ⊢ T2 ➤* T. +#L0 #i #IH #K0 #V0 #HLK0 #V1 #HV01 #T1 #HVT1 +#KX #VX #H #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02 +lapply (ldrop_mono … H … HLK0) -H #H destruct +elim (lpqs_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1 +elim (lpqs_inv_pair1 … H1) -H1 #K1 #W1 #HK01 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK1) -W1 #HLK1 +elim (lpqs_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2 +elim (lpqs_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct +lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 +lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0 +elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2 +elim (lift_total V 0 (i+1)) #T #HVT +lapply (cpqs_lift … HV1 … HLK1 … HVT1 … HVT) -K1 -V1 +lapply (cpqs_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 -V /2 width=3/ +qed-. + +fact cpqs_conf_lpqs_bind_bind: + ∀a,I,L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓑ{a,I}V0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0.ⓑ{I}V0 ⊢ T0 ➤* T1 → + ∀V2. L0 ⊢ V0 ➤* V2 → ∀T2. L0.ⓑ{I}V0 ⊢ T0 ➤* T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ ⓑ{a,I}V1.T1 ➤* T & L2 ⊢ ⓑ{a,I}V2.T2 ➤* T. +#a #I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01 +#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HV01 … HV02 … HL01 … HL02) // +elim (IH … HT01 … HT02 (L1.ⓑ{I}V1) … (L2.ⓑ{I}V2)) -IH // /2 width=1/ /3 width=5/ +qed-. + +fact cpqs_conf_lpqs_bind_zeta: + ∀L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,+ⓓV0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0.ⓓV0 ⊢ T0 ➤* T1 → + ∀T2. L0.ⓓV0 ⊢ T0 ➤* T2 → ∀X2. ⇧[O, 1] X2 ≡ T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ +ⓓV1.T1 ➤* T & L2 ⊢ X2 ➤* T. +#L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01 +#T2 #HT02 #X2 #HXT2 #L1 #HL01 #L2 #HL02 +elim (IH … HT01 … HT02 (L1.ⓓV1) … (L2.ⓓV1)) -IH -HT01 -HT02 // /2 width=1/ -L0 -V0 -T0 #T #HT1 #HT2 +elim (cpqs_inv_lift1 … HT2 L2 … HXT2) -T2 /2 width=1/ /3 width=3/ +qed-. + +fact cpqs_conf_lpqs_zeta_zeta: + ∀L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,+ⓓV0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀T1. L0.ⓓV0 ⊢ T0 ➤* T1 → ∀X1. ⇧[O, 1] X1 ≡ T1 → + ∀T2. L0.ⓓV0 ⊢ T0 ➤* T2 → ∀X2. ⇧[O, 1] X2 ≡ T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ X1 ➤* T & L2 ⊢ X2 ➤* T. +#L0 #V0 #T0 #IH #T1 #HT01 #X1 #HXT1 +#T2 #HT02 #X2 #HXT2 #L1 #HL01 #L2 #HL02 +elim (IH … HT01 … HT02 (L1.ⓓV0) … (L2.ⓓV0)) -IH -HT01 -HT02 // /2 width=1/ -L0 -T0 #T #HT1 #HT2 +elim (cpqs_inv_lift1 … HT1 L1 … HXT1) -T1 /2 width=1/ #T1 #HT1 #HXT1 +elim (cpqs_inv_lift1 … HT2 L2 … HXT2) -T2 /2 width=1/ #T2 #HT2 #HXT2 +lapply (lift_inj … HT2 … HT1) -T #H destruct /2 width=3/ +qed-. + +fact cpqs_conf_lpqs_flat_flat: + ∀I,L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓕ{I}V0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0 ⊢ T0 ➤* T1 → + ∀V2. L0 ⊢ V0 ➤* V2 → ∀T2. L0 ⊢ T0 ➤* T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ ⓕ{I}V1.T1 ➤* T & L2 ⊢ ⓕ{I}V2.T2 ➤* T. +#I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01 +#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HV01 … HV02 … HL01 … HL02) // +elim (IH … HT01 … HT02 … HL01 … HL02) // /3 width=5/ +qed-. + +fact cpqs_conf_lpqs_flat_tau: + ∀L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓝV0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀V1,T1. L0 ⊢ T0 ➤* T1 → ∀T2. L0 ⊢ T0 ➤* T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ ⓝV1.T1 ➤* T & L2 ⊢ T2 ➤* T. +#L0 #V0 #T0 #IH #V1 #T1 #HT01 +#T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HT01 … HT02 … HL01 … HL02) // -L0 -V0 -T0 /3 width=3/ +qed-. + +fact cpqs_conf_lpqs_tau_tau: + ∀L0,V0,T0. ( + ∀L,T.♯{L,T} < ♯{L0,ⓝV0.T0} → + ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 → + ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 → + ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0 + ) → + ∀T1. L0 ⊢ T0 ➤* T1 → ∀T2. L0 ⊢ T0 ➤* T2 → + ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 → + ∃∃T. L1 ⊢ T1 ➤* T & L2 ⊢ T2 ➤* T. +#L0 #V0 #T0 #IH #T1 #HT01 +#T2 #HT02 #L1 #HL01 #L2 #HL02 +elim (IH … HT01 … HT02 … HL01 … HL02) // -L0 -V0 -T0 /2 width=3/ +qed-. + +theorem cpqs_conf_lpqs: lpx_sn_confluent cpqs cpqs. +#L0 #T0 @(f2_ind … fw … L0 T0) -L0 -T0 #n #IH #L0 * [|*] +[ #I0 #Hn #T1 #H1 #T2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpqs_inv_atom1 … H1) -H1 + elim (cpqs_inv_atom1 … H2) -H2 + [ #H2 #H1 destruct + /2 width=1 by cpqs_conf_lpqs_atom_atom/ + | * #K0 #V0 #V2 #i2 #HLK0 #HV02 #HVT2 #H2 #H1 destruct + /3 width=10 by cpqs_conf_lpqs_atom_delta/ + | #H2 * #K0 #V0 #V1 #i1 #HLK0 #HV01 #HVT1 #H1 destruct + /4 width=10 by ex2_commute, cpqs_conf_lpqs_atom_delta/ + | * #X #Y #V2 #z #H #HV02 #HVT2 #H2 + * #K0 #V0 #V1 #i #HLK0 #HV01 #HVT1 #H1 destruct + /3 width=17 by cpqs_conf_lpqs_delta_delta/ + ] +| #a #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpqs_inv_bind1 … H1) -H1 * + [ #V1 #T1 #HV01 #HT01 #H1 + | #T1 #HT01 #HXT1 #H11 #H12 + ] + elim (cpqs_inv_bind1 … H2) -H2 * + [1,3: #V2 #T2 #HV02 #HT02 #H2 + |2,4: #T2 #HT02 #HXT2 #H21 #H22 + ] destruct + [ /3 width=10 by cpqs_conf_lpqs_bind_bind/ + | /4 width=11 by ex2_commute, cpqs_conf_lpqs_bind_zeta/ + | /3 width=11 by cpqs_conf_lpqs_bind_zeta/ + | /3 width=12 by cpqs_conf_lpqs_zeta_zeta/ + ] +| #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct + elim (cpqs_inv_flat1 … H1) -H1 * + [ #V1 #T1 #HV01 #HT01 #H1 + | #HX1 #H1 + ] + elim (cpqs_inv_flat1 … H2) -H2 * + [1,3: #V2 #T2 #HV02 #HT02 #H2 + |2,4: #HX2 #H2 + ] destruct + [ /3 width=10 by cpqs_conf_lpqs_flat_flat/ + | /4 width=8 by ex2_commute, cpqs_conf_lpqs_flat_tau/ + | /3 width=8 by cpqs_conf_lpqs_flat_tau/ + | /3 width=7 by cpqs_conf_lpqs_tau_tau/ + ] +] +qed-. + +theorem cpqs_conf: ∀L. confluent … (cpqs L). +/2 width=6 by cpqs_conf_lpqs/ qed-. + +theorem cpqs_trans_lpqs: lpx_sn_transitive cpqs cpqs. +#L1 #T1 @(f2_ind … fw … L1 T1) -L1 -T1 #n #IH #L1 * [|*] +[ #I #Hn #T #H1 #L2 #HL12 #T2 #HT2 destruct + elim (cpqs_inv_atom1 … H1) -H1 + [ #H destruct + elim (cpqs_inv_atom1 … HT2) -HT2 + [ #H destruct // + | * #K2 #V #V2 #i #HLK2 #HV2 #HVT2 #H destruct + elim (lpqs_ldrop_trans_O1 … HL12 … HLK2) -L2 #X #HLK1 #H + elim (lpqs_inv_pair2 … H) -H #K1 #V1 #HK12 #HV1 #H destruct + lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/ + ] + | * #K1 #V1 #V #i #HLK1 #HV1 #HVT #H destruct + elim (lpqs_ldrop_conf … HLK1 … HL12) -HL12 #X #H #HLK2 + elim (lpqs_inv_pair1 … H) -H #K2 #W2 #HK12 #_ #H destruct + lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2 + elim (cpqs_inv_lift1 … HT2 … HLK2 … HVT) -L2 -T + lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/ + ] +| #a #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2 + elim (cpqs_inv_bind1 … H1) -H1 * + [ #V #T #HV1 #HT1 #H destruct + elim (cpqs_inv_bind1 … H2) -H2 * + [ #V2 #T2 #HV2 #HT2 #H destruct /4 width=5/ + | #T2 #HT2 #HXT2 #H1 #H2 destruct /4 width=5/ + ] + | #Y1 #HTY1 #HXY1 #H11 #H12 destruct + elim (lift_total X2 0 1) #Y2 #HXY2 + lapply (cpqs_lift … H2 (L2.ⓓV1) … HXY1 … HXY2) /2 width=1/ -X1 /4 width=5/ + ] +| #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2 + elim (cpqs_inv_flat1 … H1) -H1 * + [ #V #T #HV1 #HT1 #H destruct + elim (cpqs_inv_flat1 … H2) -H2 * + [ #V2 #T2 #HV2 #HT2 #H destruct /3 width=5/ + | #HX2 #H destruct /3 width=5/ + ] + | #HX1 #H destruct /3 width=5/ +] +qed-. + +theorem cpqs_trans: ∀L. Transitive … (cpqs L). +/2 width=5 by cpqs_trans_lpqs/ qed-. + +(* Properties on context-sensitive rest. parallel computation for terms *****) + +lemma lpqs_cpqs_conf_dx: ∀L0,T0,T1. L0 ⊢ T0 ➤* T1 → ∀L1. L0 ⊢ ➤* L1 → + ∃∃T. L1 ⊢ T0 ➤* T & L1 ⊢ T1 ➤* T. +#L0 #T0 #T1 #HT01 #L1 #HL01 +elim (cpqs_conf_lpqs … HT01 T0 … HL01 … HL01) // -L0 /2 width=3/ +qed-. + +lemma lpqs_cpqs_conf_sn: ∀L0,T0,T1. L0 ⊢ T0 ➤* T1 → ∀L1. L0 ⊢ ➤* L1 → + ∃∃T. L1 ⊢ T0 ➤* T & L0 ⊢ T1 ➤* T. +#L0 #T0 #T1 #HT01 #L1 #HL01 +elim (cpqs_conf_lpqs … HT01 T0 … L0 … HL01) // -HT01 -HL01 /2 width=3/ +qed-. + +lemma lpqs_cpqs_trans: ∀L1,L2. L1 ⊢ ➤* L2 → + ∀T1,T2. L2 ⊢ T1 ➤* T2 → L1 ⊢ T1 ➤* T2. +/2 width=5 by cpqs_trans_lpqs/ qed-. + +lemma fsup_cpqs_trans: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀U2. L2 ⊢ T2 ➤* U2 → + ∃∃L,U1. L1 ⊢ ➤* L & L ⊢ T1 ➤* U1 & ⦃L, U1⦄ ⊃ ⦃L2, U2⦄. +#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 [1,2,3,4,5: /3 width=5/ ] +#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #U2 #HTU2 +elim (IHT12 … HTU2) -IHT12 -HTU2 #K #T #HK1 #HT1 #HT2 +elim (lift_total T d e) #U #HTU +elim (ldrop_lpqs_trans … HLK1 … HK1) -HLK1 -HK1 #L2 #HL12 #HL2K +lapply (cpqs_lift … HT1 … HL2K … HTU1 … HTU) -HT1 -HTU1 /3 width=11/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_ldrop.ma new file mode 100644 index 000000000..bea4a9134 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_ldrop.ma @@ -0,0 +1,30 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/relocation/ldrop_lpx_sn.ma". +include "basic_2/unfold/cpqs_lift.ma". +include "basic_2/unfold/lpqs.ma". + +(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************) + +(* Properies on local environment slicing ***********************************) + +lemma lpqs_ldrop_conf: dropable_sn lpqs. +/3 width=5 by lpx_sn_deliftable_dropable, cpqs_inv_lift1/ qed-. + +lemma ldrop_lpqs_trans: dedropable_sn lpqs. +/3 width=9 by lpx_sn_liftable_dedropable, cpqs_lift/ qed-. + +lemma lpqs_ldrop_trans_O1: dropable_dx lpqs. +/2 width=3 by lpx_sn_dropable/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_lpqs.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_lpqs.ma new file mode 100644 index 000000000..c134c8880 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/lpqs_lpqs.ma @@ -0,0 +1,46 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/unfold/lpqs_cpqs.ma". + +(* SN RESTRICTED PARALLEL COMPUTATION ON LOCAL ENVIRONMENTS *****************) + +(* Main properties **********************************************************) + +theorem lpqs_conf: confluent … lpqs. +/3 width=6 by lpx_sn_conf, cpqs_conf_lpqs/ +qed-. + +theorem lpqs_trans: Transitive … lpqs. +/3 width=5 by lpx_sn_trans, cpqs_trans_lpqs/ +qed-. + +(* Advanced forward lemmas **************************************************) + +lemma cpqs_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ➤* T → + ∃∃L2,T2. L @@ L1 ⊢ ➤* L @@ L2 & L @@ L1 ⊢ T1 ➤* T2 & + T = L2 @@ T2. +#L1 @(lenv_ind_dx … L1) -L1 +[ #L #T1 #T #HT1 + @ex3_2_intro [3: // |4,5: // |1,2: skip ] (**) (* /2 width=4/ does not work *) +| #I #L1 #V1 #IH #L #T1 #T >shift_append_assoc #H shift_append_assoc #H (lift_mono … HX … HU12) -X // +| #T0 #U0 #l0 #HTU0 #_ #IHU01 #L2 #d #e #HL21 #T2 #HT02 #U2 #HU12 + elim (lift_total U0 d e) /3 width=10/ +] +qed. + +(* Inversion lemmas on relocation *******************************************) + +lemma sstas_inv_lift1: ∀h,g,L2,T2,U2. ⦃h, L2⦄ ⊢ T2 •*[g] U2 → + ∀L1,d,e. ⇩[d, e] L2 ≡ L1 → ∀T1. ⇧[d, e] T1 ≡ T2 → + ∃∃U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 & ⇧[d, e] U1 ≡ U2. +#h #g #L2 #T2 #U2 #H @(sstas_ind_dx … H) -T2 /2 width=3/ +#T0 #U0 #l0 #HTU0 #_ #IHU01 #L1 #d #e #HL21 #U1 #HU12 +elim (ssta_inv_lift1 … HTU0 … HL21 … HU12) -HTU0 -HU12 #U #HU1 #HU0 +elim (IHU01 … HL21 … HU0) -IHU01 -HL21 -U0 /3 width=4/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_lpss.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_lpss.ma new file mode 100644 index 000000000..8f9eda109 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_lpss.ma @@ -0,0 +1,39 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/static/ssta_lpss.ma". +include "basic_2/unfold/sstas.ma". + +(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************) + +(* Properties about sn parallel substitution ********************************) + +lemma sstas_tpss_lpss_conf: ∀h,g,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 → + ∀T2. L1 ⊢ T1 ▶* T2 → ∀L2. L1 ⊢ ▶* L2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •*[g] U2 & L1 ⊢ U1 ▶* U2. +#h #g #L1 #T1 #U1 #H @(sstas_ind_dx … H) -T1 /2 width=3/ +#T0 #U0 #l0 #HTU0 #_ #IHU01 #T #HT0 #L2 #HL12 +elim (ssta_tpss_lpss_conf … HTU0 … HT0 … HL12) -HTU0 -HT0 #U #HTU #HU0 +elim (IHU01 … HU0 … HL12) -IHU01 -U0 -HL12 /3 width=4/ +qed-. + +lemma sstas_tpss_conf: ∀h,g,L,T1,U1. ⦃h, L⦄ ⊢ T1 •*[g] U1 → + ∀T2. L ⊢ T1 ▶* T2 → + ∃∃U2. ⦃h, L⦄ ⊢ T2 •*[g] U2 & L ⊢ U1 ▶* U2. +/2 width=3 by sstas_tpss_lpss_conf/ qed-. + +lemma sstas_lpss_conf: ∀h,g,L1,T,U1. ⦃h, L1⦄ ⊢ T •*[g] U1 → + ∀L2. L1 ⊢ ▶* L2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T •*[g] U2 & L1 ⊢ U1 ▶* U2. +/2 width=3 by sstas_tpss_lpss_conf/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_sstas.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_sstas.ma new file mode 100644 index 000000000..0b0dcca42 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/sstas_sstas.ma @@ -0,0 +1,54 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/static/ssta_ssta.ma". +include "basic_2/unfold/sstas.ma". + +(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************) + +(* Advanced inversion lemmas ************************************************) + +lemma sstas_inv_O: ∀h,g,L,T,U. ⦃h, L⦄ ⊢ T •*[g] U → + ∀T0. ⦃h, L⦄ ⊢ T •[g] ⦃0, T0⦄ → U = T. +#h #g #L #T #U #H @(sstas_ind_dx … H) -T // +#T0 #U0 #l0 #HTU0 #_ #_ #T1 #HT01 +elim (ssta_mono … HTU0 … HT01)