From: Ferruccio Guidi Date: Sun, 1 Jun 2014 21:49:56 +0000 (+0000) Subject: - some refactoring and minor additions X-Git-Tag: make_still_working~914 X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=commitdiff_plain;h=598a5c56535a8339f6533227ab580aff64e2d41c - some refactoring and minor additions --- diff --git a/matita/matita/contribs/lambdadelta/apps_2/functional/lift.ma b/matita/matita/contribs/lambdadelta/apps_2/functional/lift.ma index 634a7eb4a..4792a7ea5 100644 --- a/matita/matita/contribs/lambdadelta/apps_2/functional/lift.ma +++ b/matita/matita/contribs/lambdadelta/apps_2/functional/lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/lift.ma". +include "basic_2/substitution/lift.ma". include "apps_2/functional/notation.ma". (* FUNCTIONAL RELOCATION ****************************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/acp.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/acp.ma index 7830fa7c0..22efc2d11 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/acp.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/acp.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/grammar/genv.ma". -include "basic_2/substitution/ldrops.ma". +include "basic_2/multiple/ldrops.ma". (* ABSTRACT COMPUTATION PROPERTIES ******************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/acp_aaa.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/acp_aaa.ma index 13fbb93fe..7a232f0fa 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/acp_aaa.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/acp_aaa.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lifts_lifts.ma". -include "basic_2/substitution/ldrops_ldrops.ma". +include "basic_2/multiple/lifts_lifts.ma". +include "basic_2/multiple/ldrops_ldrops.ma". include "basic_2/static/aaa_lifts.ma". include "basic_2/static/aaa_aaa.ma". include "basic_2/computation/lsubc_ldrops.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/acp_cr.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/acp_cr.ma index 7c6464f21..8bf08dc6f 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/acp_cr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/acp_cr.ma @@ -14,9 +14,9 @@ include "basic_2/notation/relations/ineint_5.ma". include "basic_2/grammar/aarity.ma". -include "basic_2/substitution/gr2_gr2.ma". -include "basic_2/substitution/lifts_lift_vector.ma". -include "basic_2/substitution/ldrops_ldrop.ma". +include "basic_2/multiple/gr2_gr2.ma". +include "basic_2/multiple/lifts_lift_vector.ma". +include "basic_2/multiple/ldrops_ldrop.ma". include "basic_2/computation/acp.ma". (* ABSTRACT COMPUTATION PROPERTIES ******************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_lift.ma index 501bf323e..4a78a1b9b 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fqus_fqus.ma". +include "basic_2/multiple/fqus_fqus.ma". include "basic_2/unfold/lsstas_lift.ma". include "basic_2/reduction/cpx_lift.ma". include "basic_2/computation/cpxs.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_tstc_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_tstc_vector.ma index 41bd98df3..55ea0dff9 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_tstc_vector.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/cpxs_tstc_vector.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/grammar/tstc_vector.ma". -include "basic_2/relocation/lift_vector.ma". +include "basic_2/substitution/lift_vector.ma". include "basic_2/computation/cpxs_tstc.ma". (* CONTEXT-SENSITIVE EXTENDED PARALLEL COMPUTATION ON TERMS *****************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc.ma index 82ea6ec0f..f8797e72d 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/lazybtpredproper_8.ma". -include "basic_2/substitution/fleq.ma". +include "basic_2/multiple/fleq.ma". include "basic_2/computation/fpbu.ma". (* SINGLE-STEP "BIG TREE" PROPER PARALLEL COMPUTATION FOR CLOSURES **********) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc_fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc_fleq.ma index cf2ee2ffc..af496b60f 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc_fleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbc_fleq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fleq_fleq.ma". +include "basic_2/multiple/fleq_fleq.ma". include "basic_2/computation/fpbu_fleq.ma". include "basic_2/computation/fpbc.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs.ma index c9f0875e4..2daaa8145 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/btpredstar_8.ma". -include "basic_2/substitution/fqus.ma". +include "basic_2/multiple/fqus.ma". include "basic_2/reduction/fpb.ma". include "basic_2/computation/cpxs.ma". include "basic_2/computation/lpxs.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_alt.ma index 047fd164a..254708616 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_alt.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_alt.ma @@ -13,8 +13,8 @@ (**************************************************************************) include "basic_2/notation/relations/btpredstaralt_8.ma". -include "basic_2/substitution/lleq_fqus.ma". -include "basic_2/substitution/lleq_lleq.ma". +include "basic_2/multiple/lleq_fqus.ma". +include "basic_2/multiple/lleq_lleq.ma". include "basic_2/computation/cpxs_lleq.ma". include "basic_2/computation/lpxs_lleq.ma". include "basic_2/computation/fpbs.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_fleq.ma index 9f0c8d415..8987fcb57 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_fleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbs_fleq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fleq.ma". +include "basic_2/multiple/fleq.ma". include "basic_2/computation/fpbs.ma". (* "BIG TREE" PARALLEL COMPUTATION FOR CLOSURES *****************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_fleq.ma index c4e1813a9..8cf744d4a 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_fleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_fleq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fleq.ma". +include "basic_2/multiple/fleq.ma". include "basic_2/computation/fpbs_alt.ma". include "basic_2/computation/fpbu_lleq.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_lleq.ma index e39e9d79e..6a9cf9d45 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_lleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/fpbu_lleq.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_fqus.ma". -include "basic_2/substitution/lleq_lleq.ma". +include "basic_2/multiple/lleq_fqus.ma". +include "basic_2/multiple/lleq_lleq.ma". include "basic_2/computation/cpxs_lleq.ma". include "basic_2/computation/lpxs_lleq.ma". include "basic_2/computation/fpbu.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/lprs.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/lprs.ma index c3d7203df..ddf4e24ca 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/lprs.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/lprs.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/predsnstar_3.ma". -include "basic_2/relocation/lpx_sn_tc.ma". +include "basic_2/substitution/lpx_sn_tc.ma". include "basic_2/reduction/lpr.ma". (* SN PARALLEL COMPUTATION ON LOCAL ENVIRONMENTS ****************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx.ma index 0f47fe056..1abf9c523 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/sn_6.ma". -include "basic_2/substitution/lleq.ma". +include "basic_2/multiple/lleq.ma". include "basic_2/reduction/lpx.ma". (* SN EXTENDED STRONGLY NORMALIZING LOCAL ENVIRONMENTS **********************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_alt.ma index 50b41adb2..a68fed0c2 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_alt.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_alt.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/snalt_6.ma". -include "basic_2/substitution/lleq_lleq.ma". +include "basic_2/multiple/lleq_lleq.ma". include "basic_2/computation/lpxs_lleq.ma". include "basic_2/computation/lsx.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_ldrop.ma index a520ba376..476680a16 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_ldrop.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_ldrop.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_ldrop.ma". +include "basic_2/multiple/lleq_ldrop.ma". include "basic_2/reduction/lpx_ldrop.ma". include "basic_2/computation/lsx.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_lpx.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_lpx.ma index d191024b9..c4b2e04d5 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_lpx.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/lsx_lpx.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_lleq.ma". +include "basic_2/multiple/lleq_lleq.ma". include "basic_2/reduction/lpx_lleq.ma". include "basic_2/computation/lsx.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees.etc new file mode 100644 index 000000000..e1b9b06b2 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees.etc @@ -0,0 +1,130 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/cofreestar_4.ma". +include "basic_2/relocation/lift_neg.ma". +include "basic_2/substitution/cpys.ma". + +(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) + +definition cofrees: relation4 ynat nat lenv term ≝ + λd,i,L,U1. ∀U2. ⦃⋆, L⦄ ⊢ U1 ▶*[d, ∞] U2 → ∃T2. ⇧[i, 1] T2 ≡ U2. + +interpretation + "context-sensitive exclusion from free variables (term)" + 'CoFreeStar L i d T = (cofrees d i L T). + +(* Basic forward lemmas *****************************************************) + +lemma cofrees_fwd_lift: ∀L,U,d,i. L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ∃T. ⇧[i, 1] T ≡ U. +/2 width=1 by/ qed-. + +lemma cofrees_fwd_bind_sn: ∀a,I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄ → + L ⊢ i ~ϵ 𝐅*[d]⦃W⦄. +#a #I #L #W1 #U #i #d #H #W2 #HW12 elim (H (ⓑ{a,I}W2.U)) /2 width=1 by cpys_bind/ -W1 +#X #H elim (lift_inv_bind2 … H) -H /2 width=2 by ex_intro/ +qed-. + +lemma cofrees_fwd_bind_dx: ∀a,I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄ → + L.ⓑ{I}W ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃U⦄. +#a #I #L #W #U1 #i #d #H #U2 #HU12 elim (H (ⓑ{a,I}W.U2)) /2 width=1 by cpys_bind/ -U1 +#X #H elim (lift_inv_bind2 … H) -H /2 width=2 by ex_intro/ +qed-. + +lemma cofrees_fwd_flat_sn: ∀I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}W.U⦄ → + L ⊢ i ~ϵ 𝐅*[d]⦃W⦄. +#I #L #W1 #U #i #d #H #W2 #HW12 elim (H (ⓕ{I}W2.U)) /2 width=1 by cpys_flat/ -W1 +#X #H elim (lift_inv_flat2 … H) -H /2 width=2 by ex_intro/ +qed-. + +lemma cofrees_fwd_flat_dx: ∀I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}W.U⦄ → + L ⊢ i ~ϵ 𝐅*[d]⦃U⦄. +#I #L #W #U1 #i #d #H #U2 #HU12 elim (H (ⓕ{I}W.U2)) /2 width=1 by cpys_flat/ -U1 +#X #H elim (lift_inv_flat2 … H) -H /2 width=2 by ex_intro/ +qed-. + +(* Basic inversion lemmas ***************************************************) + +lemma cofrees_inv_gen: ∀L,U,U0,d,i. ⦃⋆, L⦄ ⊢ U ▶*[d, ∞] U0 → (∀T. ⇧[i, 1] T ≡ U0 → ⊥) → + L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥. +#L #U #U0 #d #i #HU0 #HnU0 #HU elim (HU … HU0) -L -U -d /2 width=2 by/ +qed-. + +lemma cofrees_inv_lref_eq: ∀L,d,i. L ⊢ i ~ϵ 𝐅*[d]⦃#i⦄ → ⊥. +#L #d #i #H elim (H (#i)) -H // +#X #H elim (lift_inv_lref2_be … H) -H // +qed-. + +lemma cofrees_inv_bind: ∀a,I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄ → + L ⊢ i ~ϵ 𝐅*[d]⦃W⦄ ∧ L.ⓑ{I}W ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃U⦄. +/3 width=8 by cofrees_fwd_bind_sn, cofrees_fwd_bind_dx, conj/ qed-. + +lemma cofrees_inv_flat: ∀I,L,W,U,i,d. L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}W.U⦄ → + L ⊢ i ~ϵ 𝐅*[d]⦃W⦄ ∧ L ⊢ i ~ϵ 𝐅*[d]⦃U⦄. +/3 width=7 by cofrees_fwd_flat_sn, cofrees_fwd_flat_dx, conj/ qed-. + +(* Basic Properties *********************************************************) + +lemma cofrees_lsuby_conf: ∀L1,U,d,i. L1 ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → + ∀L2. L1 ⊆[d, ∞] L2 → L2 ⊢ i ~ϵ 𝐅*[d]⦃U⦄. +/3 width=3 by lsuby_cpys_trans/ qed-. + +lemma cofrees_sort: ∀L,d,i,k. L ⊢ i ~ϵ 𝐅*[d]⦃⋆k⦄. +#L #d #i #k #X #H >(cpys_inv_sort1 … H) -X /2 width=2 by ex_intro/ +qed. + +lemma cofrees_gref: ∀L,d,i,p. L ⊢ i ~ϵ 𝐅*[d]⦃§p⦄. +#L #d #i #p #X #H >(cpys_inv_gref1 … H) -X /2 width=2 by ex_intro/ +qed. + +lemma cofrees_bind: ∀L,V,d,i. L ⊢ i ~ϵ 𝐅*[d] ⦃V⦄ → + ∀I,T. L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃T⦄ → + ∀a. L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}V.T⦄. +#L #W1 #d #i #HW1 #I #U1 #HU1 #a #X #H elim (cpys_inv_bind1 … H) -H +#W2 #U2 #HW12 #HU12 #H destruct +elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_bind, ex_intro/ +qed. + +lemma cofrees_flat: ∀L,V,d,i. L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ∀T. L ⊢ i ~ϵ 𝐅*[d]⦃T⦄ → + ∀I. L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}V.T⦄. +#L #W1 #d #i #HW1 #U1 #HU1 #I #X #H elim (cpys_inv_flat1 … H) -H +#W2 #U2 #HW12 #HU12 #H destruct +elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_flat, ex_intro/ +qed. + +lemma cofrees_cpy_trans: ∀L,U1,U2,d. ⦃⋆, L⦄ ⊢ U1 ▶[d, ∞] U2 → + ∀i. L ⊢ i ~ϵ 𝐅*[d]⦃U1⦄ → L ⊢ i ~ϵ 𝐅*[d]⦃U2⦄. +/3 width=3 by cpys_strap2/ qed-. + +axiom cofrees_dec: ∀L,T,d,i. Decidable (L ⊢ i ~ϵ 𝐅*[d]⦃T⦄). + +(* Basic negated properties *************************************************) + +lemma frees_cpy_div: ∀L,U1,U2,d. ⦃⋆, L⦄ ⊢ U1 ▶[d, ∞] U2 → + ∀i. (L ⊢ i ~ϵ 𝐅*[d]⦃U2⦄ → ⊥) → (L ⊢ i ~ϵ 𝐅*[d]⦃U1⦄ → ⊥). +/3 width=7 by cofrees_cpy_trans/ qed-. + +(* Basic negated inversion lemmas *******************************************) + +lemma frees_inv_bind: ∀a,I,L,V,T,d,i. (L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}V.T⦄ → ⊥) → + (L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ⊥) ∨ (L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃T⦄ → ⊥). +#a #I #L #W #U #d #i #H elim (cofrees_dec L W d i) +/4 width=9 by cofrees_bind, or_intror, or_introl/ +qed-. + +lemma frees_inv_flat: ∀I,L,V,T,d,i. (L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}V.T⦄ → ⊥) → + (L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ⊥) ∨ (L ⊢ i ~ϵ 𝐅*[d]⦃T⦄ → ⊥). +#I #L #W #U #d #H elim (cofrees_dec L W d) +/4 width=8 by cofrees_flat, or_intror, or_introl/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_alt.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_alt.etc new file mode 100644 index 000000000..7bb9c9ca7 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_alt.etc @@ -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/relocation/cpy_nlift.ma". +include "basic_2/substitution/cofrees_lift.ma". + +(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) + +(* Alternative definition of frees_ge ***************************************) + +lemma nlift_frees: ∀L,U,d,i. (∀T. ⇧[i, 1] T ≡ U → ⊥) → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥). +#L #U #d #i #HnTU #H elim (cofrees_fwd_lift … H) -H /2 width=2 by/ +qed-. + +lemma frees_inv_ge: ∀L,U,d,i. d ≤ yinj i → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥) → + (∀T. ⇧[i, 1] T ≡ U → ⊥) ∨ + ∃∃I,K,W,j. d ≤ yinj j & j < i & ⇩[j]L ≡ K.ⓑ{I}W & + (K ⊢ i-j-1 ~ϵ 𝐅*[yinj 0]⦃W⦄ → ⊥) & (∀T. ⇧[j, 1] T ≡ U → ⊥). +#L #U #d #i #Hdi #H @(frees_ind … H) -U /3 width=2 by or_introl/ +#U1 #U2 #HU12 #HU2 * +[ #HnU2 elim (cpy_fwd_nlift2_ge … HU12 … HnU2) -HU12 -HnU2 /3 width=2 by or_introl/ + * /5 width=9 by nlift_frees, ex5_4_intro, or_intror/ +| * #I2 #K2 #W2 #j2 #Hdj2 #Hj2i #HLK2 #HnW2 #HnU2 elim (cpy_fwd_nlift2_ge … HU12 … HnU2) -HU12 -HnU2 /4 width=9 by ex5_4_intro, or_intror/ + * #I1 #K1 #W1 #j1 #Hdj1 #Hj12 #HLK1 #HnW1 #HnU1 + lapply (ldrop_conf_ge … HLK1 … HLK2 ?) -HLK2 /2 width=1 by lt_to_le/ + #HK12 lapply (ldrop_inv_drop1_lt … HK12 ?) /2 width=1 by lt_plus_to_minus_r/ -HK12 + #HK12 + @or_intror @(ex5_4_intro … HLK1 … HnU1) -HLK1 -HnU1 /2 width=3 by transitive_lt/ + @(frees_be … HK12 … HnW1) /2 width=1 by arith_k_sn/ -HK12 -HnW1 + >minus_plus in ⊢ (??(?(?%?)?)??→?); >minus_plus in ⊢ (??(?(??%)?)??→?); >arith_b1 /2 width=1 by/ +] +qed-. + +lemma frees_ind_ge: ∀R:relation4 ynat nat lenv term. + (∀d,i,L,U. d ≤ yinj i → (∀T. ⇧[i, 1] T ≡ U → ⊥) → R d i L U) → + (∀d,i,j,I,L,K,W,U. d ≤ yinj j → j < i → ⇩[j]L ≡ K.ⓑ{I}W → (K ⊢ i-j-1 ~ϵ 𝐅*[0]⦃W⦄ → ⊥) → (∀T. ⇧[j, 1] T ≡ U → ⊥) → R 0 (i-j-1) K W → R d i L U) → + ∀d,i,L,U. d ≤ yinj i → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥) → R d i L U. +#R #IH1 #IH2 #d #i #L #U +generalize in match d; -d generalize in match i; -i +@(f2_ind … rfw … L U) -L -U +#n #IHn #L #U #Hn #i #d #Hdi #H elim (frees_inv_ge … H) -H /3 width=2 by/ +-IH1 * #I #K #W #j #Hdj #Hji #HLK #HnW #HnU destruct /4 width=12 by ldrop_fwd_rfw/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_lift.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_lift.etc new file mode 100644 index 000000000..f93f72216 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees/cofrees_lift.etc @@ -0,0 +1,180 @@ +(**************************************************************************) +(* ___ *) +(* ||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/cpys_lift.ma". +include "basic_2/substitution/cofrees.ma". + +(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) + +(* Advanced inversion lemmas ************************************************) + +lemma cofrees_inv_lref_be: ∀L,d,i,j. L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄ → d ≤ yinj j → j < i → + ∀I,K,W. ⇩[j]L ≡ K.ⓑ{I}W → K ⊢ i-j-1 ~ϵ 𝐅*[yinj 0]⦃W⦄. +#L #d #i #j #Hj #Hdj #Hji #I #K #W1 #HLK #W2 #HW12 elim (lift_total W2 0 (j+1)) +#X2 #HWX2 elim (Hj X2) /2 width=7 by cpys_subst_Y2/ -I -L -K -W1 -d +#Z2 #HZX2 elim (lift_div_le … HWX2 (i-j-1) 1 Z2) -HWX2 /2 width=2 by ex_intro/ +>minus_plus minus_plus_plus_l // +| #J #W #U #Hn #d #i #H1 #j #H2 #I #K #V #HLK #Hdj #Hji destruct + elim (cofrees_inv_flat … H1) -H1 #HW #HU + elim (nlift_inv_flat … H2) -H2 [ /3 width=9 by/ ] + #HnU @(IH … HU … HnU … HLK) // (**) (* full auto fails *) +] +qed-. + +(* Advanced properties ******************************************************) + +lemma cofrees_lref_skip: ∀L,d,i,j. j < i → yinj j < d → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. +#L #d #i #j #Hji #Hjd #X #H elim (cpys_inv_lref1_Y2 … H) -H +[ #H destruct /3 width=2 by lift_lref_lt, ex_intro/ +| * #I #K #W1 #W2 #Hdj elim (ylt_yle_false … Hdj) -i -I -L -K -W1 -W2 -X // +] +qed. + +lemma cofrees_lref_lt: ∀L,d,i,j. i < j → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. +#L #d #i #j #Hij #X #H elim (cpys_inv_lref1_Y2 … H) -H +[ #H destruct /3 width=2 by lift_lref_ge_minus, ex_intro/ +| * #I #K #V1 #V2 #_ #_ #_ #H -I -L -K -V1 -d + elim (lift_split … H i j) /2 width=2 by lt_to_le, ex_intro/ +] +qed. + +lemma cofrees_lref_gt: ∀I,L,K,W,d,i,j. j < i → ⇩[j] L ≡ K.ⓑ{I}W → + K ⊢ (i-j-1) ~ϵ 𝐅*[O]⦃W⦄ → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. +#I #L #K #W1 #d #i #j #Hji #HLK #HW1 #X #H elim (cpys_inv_lref1_Y2 … H) -H +[ #H destruct /3 width=2 by lift_lref_lt, ex_intro/ +| * #I0 #K0 #W0 #W2 #Hdj #HLK0 #HW12 #HW2 lapply (ldrop_mono … HLK0 … HLK) -L + #H destruct elim (HW1 … HW12) -I -K -W1 -d + #V2 #HVW2 elim (lift_trans_le … HVW2 … HW2) -W2 // + >minus_plus minus_plus yplus_inj >yminus_Y_inj #T2 #HT12 + lapply (cpys_weak … HT12 (d-yinj e0) (∞) ? ?) /2 width=1 by yle_plus2_to_minus_inj2/ -HT12 + | elim (cpys_inv_lift1_ge … HU12 … HLK … HTU1) // #T2 + ] +| elim (cpys_inv_lift1_be … HU12 … HLK … HTU1) // >yminus_Y_inj #T2 #HT12 + lapply (cpys_weak … HT12 (d-yinj e0) (∞) ? ?) // -HT12 +] +-s -L #HT12 #HTU2 +elim (HT1 … HT12) -T1 #V2 #HVT2 +elim (lift_trans_le … HVT2 … HTU2 ?) // (cpys_inv_sort1 … H) -X /2 width=2 by ex_intro/ -qed. - -lemma cofrees_gref: ∀L,i,p. L ⊢ i ~ϵ 𝐅*⦃§p⦄. -#L #i #p #X #H >(cpys_inv_gref1 … H) -X /2 width=2 by ex_intro/ -qed. - -lemma cofrees_bind: ∀L,V,i. L ⊢ i ~ϵ 𝐅*⦃V⦄ → - ∀I,T. L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*⦃T⦄ → - ∀a. L ⊢ i ~ϵ 𝐅*⦃ⓑ{a,I}V.T⦄. -#L #W1 #i #HW1 #I #U1 #HU1 #a #X #H elim (cpys_inv_bind1 … H) -H -#W2 #U2 #HW12 #HU12 #H destruct -elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_bind, ex_intro/ -qed. - -lemma cofrees_flat: ∀L,V,i. L ⊢ i ~ϵ 𝐅*⦃V⦄ → ∀T. L ⊢ i ~ϵ 𝐅*⦃T⦄ → - ∀I. L ⊢ i ~ϵ 𝐅*⦃ⓕ{I}V.T⦄. -#L #W1 #i #HW1 #U1 #HU1 #I #X #H elim (cpys_inv_flat1 … H) -H -#W2 #U2 #HW12 #HU12 #H destruct -elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_flat, ex_intro/ -qed. - -axiom cofrees_dec: ∀L,T,i. Decidable (L ⊢ i ~ϵ 𝐅*⦃T⦄). - -(* Basic negated inversion lemmas *******************************************) - -lemma frees_inv_bind: ∀a,I,L,V,T,i. (L ⊢ i ~ϵ 𝐅*⦃ⓑ{a,I}V.T⦄ → ⊥) → - (L ⊢ i ~ϵ 𝐅*⦃V⦄ → ⊥) ∨ (L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*⦃T⦄ → ⊥). -#a #I #L #W #U #i #H elim (cofrees_dec L W i) -/4 width=8 by cofrees_bind, or_intror, or_introl/ -qed-. - -lemma frees_inv_flat: ∀I,L,V,T,i. (L ⊢ i ~ϵ 𝐅*⦃ⓕ{I}V.T⦄ → ⊥) → - (L ⊢ i ~ϵ 𝐅*⦃V⦄ → ⊥) ∨ (L ⊢ i ~ϵ 𝐅*⦃T⦄ → ⊥). -#I #L #W #U #i #H elim (cofrees_dec L W i) -/4 width=7 by cofrees_flat, or_intror, or_introl/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_alt.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_alt.etc deleted file mode 100644 index 8443f38e3..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_alt.etc +++ /dev/null @@ -1,104 +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/relocation/lift_neg.ma". -include "basic_2/relocation/lift_lift.ma". -include "basic_2/substitution/cpys.ma". -include "basic_2/substitution/cofrees_lift.ma". - -(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) - -(* Alternative definition of frees_ge ***************************************) - -(* -lemma cpys_fwd_nlift2: ∀G,L,U1,U2. ⦃G, L⦄ ⊢ U1 ▶* U2 → - ∀i. (∀T2. ⇧[i, 1] T2 ≡ U2 → ⊥) → - (∀T1. ⇧[i, 1] T1 ≡ U1 → ⊥) ∨ - ∃∃I,K,W,j. j < i & ⇩[j]L ≡ K.ⓑ{I}W & - (∀V. ⇧[i-j-1, 1] V ≡ W → ⊥) & (∀T1. ⇧[j, 1] T1 ≡ U1 → ⊥). -#G #L #U1 #U2 #H elim H -G -L -U1 -U2 -[ /3 width=2 by or_introl/ -| #I #G #L #K #V1 #V2 #W2 #j #HLK #_ #HVW2 #IHV12 #i #HnW2 - elim (lt_or_ge j i) #Hij - [ @or_intror (**) @(ex4_4_intro … HLK) // - [ #X #HXV elim (lift_trans_le … HXV … HVW ?) -V // - #Y #HXY >minus_plus minus_plus in ⊢ (??(?(?%?)?)??→?); >minus_plus in ⊢ (??(?(??%)?)??→?); >arith_b1 /2 width=1 by/ -] -qed-. - -lemma frees_ind_ge: ∀R:relation4 ynat nat lenv term. - (∀d,i,L,U. d ≤ yinj i → (∀T. ⇧[i, 1] T ≡ U → ⊥) → R d i L U) → - (∀d,i,j,I,L,K,W,U. d ≤ yinj j → j < i → ⇩[j]L ≡ K.ⓑ{I}W → (K ⊢ i-j-1 ~ϵ 𝐅*[0]⦃W⦄ → ⊥) → (∀T. ⇧[j, 1] T ≡ U → ⊥) → R 0 (i-j-1) K W → R d i L U) → - ∀d,i,L,U. d ≤ yinj i → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥) → R d i L U. -#R #IH1 #IH2 #d #i #L #U -generalize in match d; -d generalize in match i; -i -@(f2_ind … rfw … L U) -L -U -#n #IHn #L #U #Hn #i #d #Hdi #H elim (frees_inv_ge … H) -H /3 width=2 by/ --IH1 * #I #K #W #j #Hdj #Hji #HLK #HnW #HnU destruct /4 width=12 by ldrop_fwd_rfw/ -qed-. -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_lift.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_lift.etc deleted file mode 100644 index 02f227a7a..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees0/cofrees_lift.etc +++ /dev/null @@ -1,148 +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/cpys_lift.ma". -include "basic_2/substitution/cofrees.ma". - -(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) - -(* Advanced inversion lemmas ************************************************) - -lemma cofrees_inv_lref_lt: ∀L,i,j. L ⊢ i ~ϵ 𝐅*⦃#j⦄ → j < i → - ∀I,K,W. ⇩[j]L ≡ K.ⓑ{I}W → K ⊢ i-j-1 ~ϵ 𝐅*⦃W⦄. -#L #i #j #Hj #Hji #I #K #W1 #HLK #W2 #HW12 elim (lift_total W2 0 (j+1)) -#X2 #HWX2 elim (Hj X2) /2 width=7 by cpys_delta/ -I -L -K -W1 -#Z2 #HZX2 elim (lift_div_le … HWX2 (i-j-1) 1 Z2) -HWX2 /2 width=2 by ex_intro/ ->minus_plus minus_plus_plus_l // -| #J #W #U #Hn #i #H1 #j #H2 #I #K #V #HLK #Hji destruct - elim (cofrees_inv_flat … H1) -H1 #HW #HU - elim (nlift_inv_flat … H2) -H2 [ /3 width=7 by/ ] - #HnU @(IH … HU … HnU … HLK) // (**) (* full auto fails *) -] -qed-. - -(* Advanced properties ******************************************************) - -lemma cofrees_lref_gt: ∀L,i,j. i < j → L ⊢ i ~ϵ 𝐅*⦃#j⦄. -#L #i #j #Hij #X #H elim (cpys_inv_lref1 … H) -H -[ #H destruct /3 width=2 by lift_lref_ge_minus, ex_intro/ -| * #I #K #V1 #V2 #_ #_ #H -I -L -K -V1 - elim (lift_split … H i j) /2 width=2 by lt_to_le, ex_intro/ -] -qed. - -lemma cofrees_lref_lt: ∀I,L,K,W,i,j. j < i → ⇩[j] L ≡ K.ⓑ{I}W → - K ⊢ (i-j-1) ~ϵ 𝐅*⦃W⦄ → L ⊢ i ~ϵ 𝐅*⦃#j⦄. -#I #L #K #W1 #i #j #Hji #HLK #HW1 #X #H elim (cpys_inv_lref1 … H) -H -[ #H destruct /3 width=2 by lift_lref_lt, ex_intro/ -| * #I0 #K0 #W0 #W2 #HLK0 #HW12 #HW2 lapply (ldrop_mono … HLK0 … HLK) -L - #H destruct elim (HW1 … HW12) -I -K -W1 - #V2 #HVW2 elim (lift_trans_le … HVW2 … HW2) -W2 // - >minus_plus minus_plus (cpys_inv_sort1 … H) -X /2 width=2 by ex_intro/ -qed. - -lemma cofrees_gref: ∀L,d,i,p. L ⊢ i ~ϵ 𝐅*[d]⦃§p⦄. -#L #d #i #p #X #H >(cpys_inv_gref1 … H) -X /2 width=2 by ex_intro/ -qed. - -lemma cofrees_bind: ∀L,V,d,i. L ⊢ i ~ϵ 𝐅*[d] ⦃V⦄ → - ∀I,T. L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃T⦄ → - ∀a. L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}V.T⦄. -#L #W1 #d #i #HW1 #I #U1 #HU1 #a #X #H elim (cpys_inv_bind1 … H) -H -#W2 #U2 #HW12 #HU12 #H destruct -elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_bind, ex_intro/ -qed. - -lemma cofrees_flat: ∀L,V,d,i. L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ∀T. L ⊢ i ~ϵ 𝐅*[d]⦃T⦄ → - ∀I. L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}V.T⦄. -#L #W1 #d #i #HW1 #U1 #HU1 #I #X #H elim (cpys_inv_flat1 … H) -H -#W2 #U2 #HW12 #HU12 #H destruct -elim (HW1 … HW12) elim (HU1 … HU12) -W1 -U1 /3 width=2 by lift_flat, ex_intro/ -qed. - -lemma cofrees_cpy_trans: ∀L,U1,U2,d. ⦃⋆, L⦄ ⊢ U1 ▶[d, ∞] U2 → - ∀i. L ⊢ i ~ϵ 𝐅*[d]⦃U1⦄ → L ⊢ i ~ϵ 𝐅*[d]⦃U2⦄. -/3 width=3 by cpys_strap2/ qed-. - -axiom cofrees_dec: ∀L,T,d,i. Decidable (L ⊢ i ~ϵ 𝐅*[d]⦃T⦄). - -(* Basic negated properties *************************************************) - -lemma frees_cpy_div: ∀L,U1,U2,d. ⦃⋆, L⦄ ⊢ U1 ▶[d, ∞] U2 → - ∀i. (L ⊢ i ~ϵ 𝐅*[d]⦃U2⦄ → ⊥) → (L ⊢ i ~ϵ 𝐅*[d]⦃U1⦄ → ⊥). -/3 width=7 by cofrees_cpy_trans/ qed-. - -(* Basic negated inversion lemmas *******************************************) - -lemma frees_inv_bind: ∀a,I,L,V,T,d,i. (L ⊢ i ~ϵ 𝐅*[d]⦃ⓑ{a,I}V.T⦄ → ⊥) → - (L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ⊥) ∨ (L.ⓑ{I}V ⊢ i+1 ~ϵ 𝐅*[⫯d]⦃T⦄ → ⊥). -#a #I #L #W #U #d #i #H elim (cofrees_dec L W d i) -/4 width=9 by cofrees_bind, or_intror, or_introl/ -qed-. - -lemma frees_inv_flat: ∀I,L,V,T,d,i. (L ⊢ i ~ϵ 𝐅*[d]⦃ⓕ{I}V.T⦄ → ⊥) → - (L ⊢ i ~ϵ 𝐅*[d]⦃V⦄ → ⊥) ∨ (L ⊢ i ~ϵ 𝐅*[d]⦃T⦄ → ⊥). -#I #L #W #U #d #H elim (cofrees_dec L W d) -/4 width=8 by cofrees_flat, or_intror, or_introl/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_alt.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_alt.etc deleted file mode 100644 index 7bb9c9ca7..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_alt.etc +++ /dev/null @@ -1,54 +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/relocation/cpy_nlift.ma". -include "basic_2/substitution/cofrees_lift.ma". - -(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) - -(* Alternative definition of frees_ge ***************************************) - -lemma nlift_frees: ∀L,U,d,i. (∀T. ⇧[i, 1] T ≡ U → ⊥) → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥). -#L #U #d #i #HnTU #H elim (cofrees_fwd_lift … H) -H /2 width=2 by/ -qed-. - -lemma frees_inv_ge: ∀L,U,d,i. d ≤ yinj i → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥) → - (∀T. ⇧[i, 1] T ≡ U → ⊥) ∨ - ∃∃I,K,W,j. d ≤ yinj j & j < i & ⇩[j]L ≡ K.ⓑ{I}W & - (K ⊢ i-j-1 ~ϵ 𝐅*[yinj 0]⦃W⦄ → ⊥) & (∀T. ⇧[j, 1] T ≡ U → ⊥). -#L #U #d #i #Hdi #H @(frees_ind … H) -U /3 width=2 by or_introl/ -#U1 #U2 #HU12 #HU2 * -[ #HnU2 elim (cpy_fwd_nlift2_ge … HU12 … HnU2) -HU12 -HnU2 /3 width=2 by or_introl/ - * /5 width=9 by nlift_frees, ex5_4_intro, or_intror/ -| * #I2 #K2 #W2 #j2 #Hdj2 #Hj2i #HLK2 #HnW2 #HnU2 elim (cpy_fwd_nlift2_ge … HU12 … HnU2) -HU12 -HnU2 /4 width=9 by ex5_4_intro, or_intror/ - * #I1 #K1 #W1 #j1 #Hdj1 #Hj12 #HLK1 #HnW1 #HnU1 - lapply (ldrop_conf_ge … HLK1 … HLK2 ?) -HLK2 /2 width=1 by lt_to_le/ - #HK12 lapply (ldrop_inv_drop1_lt … HK12 ?) /2 width=1 by lt_plus_to_minus_r/ -HK12 - #HK12 - @or_intror @(ex5_4_intro … HLK1 … HnU1) -HLK1 -HnU1 /2 width=3 by transitive_lt/ - @(frees_be … HK12 … HnW1) /2 width=1 by arith_k_sn/ -HK12 -HnW1 - >minus_plus in ⊢ (??(?(?%?)?)??→?); >minus_plus in ⊢ (??(?(??%)?)??→?); >arith_b1 /2 width=1 by/ -] -qed-. - -lemma frees_ind_ge: ∀R:relation4 ynat nat lenv term. - (∀d,i,L,U. d ≤ yinj i → (∀T. ⇧[i, 1] T ≡ U → ⊥) → R d i L U) → - (∀d,i,j,I,L,K,W,U. d ≤ yinj j → j < i → ⇩[j]L ≡ K.ⓑ{I}W → (K ⊢ i-j-1 ~ϵ 𝐅*[0]⦃W⦄ → ⊥) → (∀T. ⇧[j, 1] T ≡ U → ⊥) → R 0 (i-j-1) K W → R d i L U) → - ∀d,i,L,U. d ≤ yinj i → (L ⊢ i ~ϵ 𝐅*[d]⦃U⦄ → ⊥) → R d i L U. -#R #IH1 #IH2 #d #i #L #U -generalize in match d; -d generalize in match i; -i -@(f2_ind … rfw … L U) -L -U -#n #IHn #L #U #Hn #i #d #Hdi #H elim (frees_inv_ge … H) -H /3 width=2 by/ --IH1 * #I #K #W #j #Hdj #Hji #HLK #HnW #HnU destruct /4 width=12 by ldrop_fwd_rfw/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_lift.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_lift.etc deleted file mode 100644 index f93f72216..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/etc/cofrees1/cofrees_lift.etc +++ /dev/null @@ -1,180 +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/cpys_lift.ma". -include "basic_2/substitution/cofrees.ma". - -(* CONTEXT-SENSITIVE EXCLUSION FROM FREE VARIABLES **************************) - -(* Advanced inversion lemmas ************************************************) - -lemma cofrees_inv_lref_be: ∀L,d,i,j. L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄ → d ≤ yinj j → j < i → - ∀I,K,W. ⇩[j]L ≡ K.ⓑ{I}W → K ⊢ i-j-1 ~ϵ 𝐅*[yinj 0]⦃W⦄. -#L #d #i #j #Hj #Hdj #Hji #I #K #W1 #HLK #W2 #HW12 elim (lift_total W2 0 (j+1)) -#X2 #HWX2 elim (Hj X2) /2 width=7 by cpys_subst_Y2/ -I -L -K -W1 -d -#Z2 #HZX2 elim (lift_div_le … HWX2 (i-j-1) 1 Z2) -HWX2 /2 width=2 by ex_intro/ ->minus_plus minus_plus_plus_l // -| #J #W #U #Hn #d #i #H1 #j #H2 #I #K #V #HLK #Hdj #Hji destruct - elim (cofrees_inv_flat … H1) -H1 #HW #HU - elim (nlift_inv_flat … H2) -H2 [ /3 width=9 by/ ] - #HnU @(IH … HU … HnU … HLK) // (**) (* full auto fails *) -] -qed-. - -(* Advanced properties ******************************************************) - -lemma cofrees_lref_skip: ∀L,d,i,j. j < i → yinj j < d → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. -#L #d #i #j #Hji #Hjd #X #H elim (cpys_inv_lref1_Y2 … H) -H -[ #H destruct /3 width=2 by lift_lref_lt, ex_intro/ -| * #I #K #W1 #W2 #Hdj elim (ylt_yle_false … Hdj) -i -I -L -K -W1 -W2 -X // -] -qed. - -lemma cofrees_lref_lt: ∀L,d,i,j. i < j → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. -#L #d #i #j #Hij #X #H elim (cpys_inv_lref1_Y2 … H) -H -[ #H destruct /3 width=2 by lift_lref_ge_minus, ex_intro/ -| * #I #K #V1 #V2 #_ #_ #_ #H -I -L -K -V1 -d - elim (lift_split … H i j) /2 width=2 by lt_to_le, ex_intro/ -] -qed. - -lemma cofrees_lref_gt: ∀I,L,K,W,d,i,j. j < i → ⇩[j] L ≡ K.ⓑ{I}W → - K ⊢ (i-j-1) ~ϵ 𝐅*[O]⦃W⦄ → L ⊢ i ~ϵ 𝐅*[d]⦃#j⦄. -#I #L #K #W1 #d #i #j #Hji #HLK #HW1 #X #H elim (cpys_inv_lref1_Y2 … H) -H -[ #H destruct /3 width=2 by lift_lref_lt, ex_intro/ -| * #I0 #K0 #W0 #W2 #Hdj #HLK0 #HW12 #HW2 lapply (ldrop_mono … HLK0 … HLK) -L - #H destruct elim (HW1 … HW12) -I -K -W1 -d - #V2 #HVW2 elim (lift_trans_le … HVW2 … HW2) -W2 // - >minus_plus minus_plus yplus_inj >yminus_Y_inj #T2 #HT12 - lapply (cpys_weak … HT12 (d-yinj e0) (∞) ? ?) /2 width=1 by yle_plus2_to_minus_inj2/ -HT12 - | elim (cpys_inv_lift1_ge … HU12 … HLK … HTU1) // #T2 - ] -| elim (cpys_inv_lift1_be … HU12 … HLK … HTU1) // >yminus_Y_inj #T2 #HT12 - lapply (cpys_weak … HT12 (d-yinj e0) (∞) ? ?) // -HT12 -] --s -L #HT12 #HTU2 -elim (HT1 … HT12) -T1 #V2 #HVT2 -elim (lift_trans_le … HVT2 … HTU2 ?) // (cpy_inv_sort1 … HT2) -HT2 // +qed-. + +(* Note: this can be derived from cpys_inv_atom1 *) +lemma cpys_inv_gref1: ∀G,L,T2,p,d,e. ⦃G, L⦄ ⊢ §p ▶*[d, e] T2 → T2 = §p. +#G #L #T2 #p #d #e #H @(cpys_ind … H) -T2 // +#T #T2 #_ #HT2 #IHT1 destruct +>(cpy_inv_gref1 … HT2) -HT2 // +qed-. + +lemma cpys_inv_bind1: ∀a,I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓑ{a,I}V1.T1 ▶*[d, e] U2 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 & + ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶*[⫯d, e] T2 & + U2 = ⓑ{a,I}V2.T2. +#a #I #G #L #V1 #T1 #U2 #d #e #H @(cpys_ind … H) -U2 +[ /2 width=5 by ex3_2_intro/ +| #U #U2 #_ #HU2 * #V #T #HV1 #HT1 #H destruct + elim (cpy_inv_bind1 … HU2) -HU2 #V2 #T2 #HV2 #HT2 #H + lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V1) ?) -HT2 + /3 width=5 by cpys_strap1, lsuby_succ, ex3_2_intro/ +] +qed-. + +lemma cpys_inv_flat1: ∀I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓕ{I}V1.T1 ▶*[d, e] U2 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 & ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 & + U2 = ⓕ{I}V2.T2. +#I #G #L #V1 #T1 #U2 #d #e #H @(cpys_ind … H) -U2 +[ /2 width=5 by ex3_2_intro/ +| #U #U2 #_ #HU2 * #V #T #HV1 #HT1 #H destruct + elim (cpy_inv_flat1 … HU2) -HU2 + /3 width=5 by cpys_strap1, ex3_2_intro/ +] +qed-. + +lemma cpys_inv_refl_O2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶*[d, 0] T2 → T1 = T2. +#G #L #T1 #T2 #d #H @(cpys_ind … H) -T2 // +#T #T2 #_ #HT2 #IHT1 <(cpy_inv_refl_O2 … HT2) -HT2 // +qed-. + +lemma cpys_inv_lift1_eq: ∀G,L,U1,U2. ∀d,e:nat. + ⦃G, L⦄ ⊢ U1 ▶*[d, e] U2 → ∀T1. ⇧[d, e] T1 ≡ U1 → U1 = U2. +#G #L #U1 #U2 #d #e #H #T1 #HTU1 @(cpys_ind … H) -U2 +/2 width=7 by cpy_inv_lift1_eq/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_alt.ma new file mode 100644 index 000000000..d97bb7d37 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_alt.ma @@ -0,0 +1,102 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/psubststaralt_6.ma". +include "basic_2/multiple/cpys_lift.ma". + +(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) + +(* alternative definition of cpys *) +inductive cpysa: ynat → ynat → relation4 genv lenv term term ≝ +| cpysa_atom : ∀I,G,L,d,e. cpysa d e G L (⓪{I}) (⓪{I}) +| cpysa_subst: ∀I,G,L,K,V1,V2,W2,i,d,e. d ≤ yinj i → i < d+e → + ⇩[i] L ≡ K.ⓑ{I}V1 → cpysa 0 (⫰(d+e-i)) G K V1 V2 → + ⇧[0, i+1] V2 ≡ W2 → cpysa d e G L (#i) W2 +| cpysa_bind : ∀a,I,G,L,V1,V2,T1,T2,d,e. + cpysa d e G L V1 V2 → cpysa (⫯d) e G (L.ⓑ{I}V1) T1 T2 → + cpysa d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) +| cpysa_flat : ∀I,G,L,V1,V2,T1,T2,d,e. + cpysa d e G L V1 V2 → cpysa d e G L T1 T2 → + cpysa d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) +. + +interpretation + "context-sensitive extended multiple substritution (term) alternative" + 'PSubstStarAlt G L T1 d e T2 = (cpysa d e G L T1 T2). + +(* Basic properties *********************************************************) + +lemma lsuby_cpysa_trans: ∀G,d,e. lsub_trans … (cpysa d e G) (lsuby d e). +#G #d #e #L1 #T1 #T2 #H elim H -G -L1 -T1 -T2 -d -e +[ // +| #I #G #L1 #K1 #V1 #V2 #W2 #i #d #e #Hdi #Hide #HLK1 #_ #HVW2 #IHV12 #L2 #HL12 + elim (lsuby_ldrop_trans_be … HL12 … HLK1) -HL12 -HLK1 /3 width=7 by cpysa_subst/ +| /4 width=1 by lsuby_succ, cpysa_bind/ +| /3 width=1 by cpysa_flat/ +] +qed-. + +lemma cpysa_refl: ∀G,T,L,d,e. ⦃G, L⦄ ⊢ T ▶▶*[d, e] T. +#G #T elim T -T // +#I elim I -I /2 width=1 by cpysa_bind, cpysa_flat/ +qed. + +lemma cpysa_cpy_trans: ∀G,L,T1,T,d,e. ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T → + ∀T2. ⦃G, L⦄ ⊢ T ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2. +#G #L #T1 #T #d #e #H elim H -G -L -T1 -T -d -e +[ #I #G #L #d #e #X #H + elim (cpy_inv_atom1 … H) -H // * /2 width=7 by cpysa_subst/ +| #I #G #L #K #V1 #V2 #W2 #i #d #e #Hdi #Hide #HLK #_ #HVW2 #IHV12 #T2 #H + lapply (ldrop_fwd_drop2 … HLK) #H0LK + lapply (cpy_weak … H 0 (d+e) ? ?) -H // #H + elim (cpy_inv_lift1_be … H … H0LK … HVW2) -H -H0LK -HVW2 + /3 width=7 by cpysa_subst, ylt_fwd_le_succ/ +| #a #I #G #L #V1 #V #T1 #T #d #e #_ #_ #IHV1 #IHT1 #X #H + elim (cpy_inv_bind1 … H) -H #V2 #T2 #HV2 #HT2 #H destruct + /5 width=5 by cpysa_bind, lsuby_cpy_trans, lsuby_succ/ +| #I #G #L #V1 #V #T1 #T #d #e #_ #_ #IHV1 #IHT1 #X #H + elim (cpy_inv_flat1 … H) -H #V2 #T2 #HV2 #HT2 #H destruct /3 width=1 by cpysa_flat/ +] +qed-. + +lemma cpys_cpysa: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2. +/3 width=8 by cpysa_cpy_trans, cpys_ind/ qed. + +(* Basic inversion lemmas ***************************************************) + +lemma cpysa_inv_cpys: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e +/2 width=7 by cpys_subst, cpys_flat, cpys_bind, cpy_cpys/ +qed-. + +(* Advanced eliminators *****************************************************) + +lemma cpys_ind_alt: ∀R:ynat→ynat→relation4 genv lenv term term. + (∀I,G,L,d,e. R d e G L (⓪{I}) (⓪{I})) → + (∀I,G,L,K,V1,V2,W2,i,d,e. d ≤ yinj i → i < d + e → + ⇩[i] L ≡ K.ⓑ{I}V1 → ⦃G, K⦄ ⊢ V1 ▶*[O, ⫰(d+e-i)] V2 → + ⇧[O, i+1] V2 ≡ W2 → R O (⫰(d+e-i)) G K V1 V2 → R d e G L (#i) W2 + ) → + (∀a,I,G,L,V1,V2,T1,T2,d,e. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 → + ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶*[⫯d, e] T2 → R d e G L V1 V2 → + R (⫯d) e G (L.ⓑ{I}V1) T1 T2 → R d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) + ) → + (∀I,G,L,V1,V2,T1,T2,d,e. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 → + ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → R d e G L V1 V2 → + R d e G L T1 T2 → R d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) + ) → + ∀d,e,G,L,T1,T2. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → R d e G L T1 T2. +#R #H1 #H2 #H3 #H4 #d #e #G #L #T1 #T2 #H elim (cpys_cpysa … H) -G -L -T1 -T2 -d -e +/3 width=8 by cpysa_inv_cpys/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_cpys.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_cpys.ma new file mode 100644 index 000000000..1af1c2db0 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_cpys.ma @@ -0,0 +1,117 @@ +(**************************************************************************) +(* ___ *) +(* ||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/cpy_cpy.ma". +include "basic_2/multiple/cpys_alt.ma". + +(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) + +(* Advanced inversion lemmas ************************************************) + +lemma cpys_inv_SO2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶*[d, 1] T2 → ⦃G, L⦄ ⊢ T1 ▶[d, 1] T2. +#G #L #T1 #T2 #d #H @(cpys_ind … H) -T2 /2 width=3 by cpy_trans_ge/ +qed-. + +(* Advanced properties ******************************************************) + +lemma cpys_strip_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶*[d1, e1] T1 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶*[d1, e1] T. +normalize /3 width=3 by cpy_conf_eq, TC_strip1/ qed-. + +lemma cpys_strip_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶*[d1, e1] T1 → + ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶[d2, e2] T2 → + (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → + ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶*[d1, e1] T. +normalize /3 width=3 by cpy_conf_neq, TC_strip1/ qed-. + +lemma cpys_strap1_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶*[d1, e1] T0 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → d2 + e2 ≤ d1 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T ▶*[d1, e1] T2. +normalize /3 width=3 by cpy_trans_down, TC_strap1/ qed. + +lemma cpys_strap2_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T0 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → d2 + e2 ≤ d1 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T ▶[d1, e1] T2. +normalize /3 width=3 by cpy_trans_down, TC_strap2/ qed-. + +lemma cpys_split_up: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → + ∀i. d ≤ i → i ≤ d + e → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d, i - d] T & ⦃G, L⦄ ⊢ T ▶*[i, d + e - i] T2. +#G #L #T1 #T2 #d #e #H #i #Hdi #Hide @(cpys_ind … H) -T2 +[ /2 width=3 by ex2_intro/ +| #T #T2 #_ #HT12 * #T3 #HT13 #HT3 + elim (cpy_split_up … HT12 … Hide) -HT12 -Hide #T0 #HT0 #HT02 + elim (cpys_strap1_down … HT3 … HT0) -T /3 width=5 by cpys_strap1, ex2_intro/ + >ymax_pre_sn_comm // +] +qed-. + +lemma cpys_inv_lift1_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[d, dt + et - (yinj d + e)] T2 & + ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet +elim (cpys_split_up … HU12 (d + e)) -HU12 // -Hdedet #U #HU1 #HU2 +lapply (cpys_weak … HU1 d e ? ?) -HU1 // [ >ymax_pre_sn_comm // ] -Hddt -Hdtde #HU1 +lapply (cpys_inv_lift1_eq … HU1 … HTU1) -HU1 #HU1 destruct +elim (cpys_inv_lift1_ge … HU2 … HLK … HTU1) -HU2 -HLK -HTU1 // +>yplus_minus_inj /2 width=3 by ex2_intro/ +qed-. + +(* Main properties **********************************************************) + +theorem cpys_conf_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶*[d1, e1] T1 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶*[d1, e1] T. +normalize /3 width=3 by cpy_conf_eq, TC_confluent2/ qed-. + +theorem cpys_conf_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶*[d1, e1] T1 → + ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶*[d2, e2] T2 → + (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → + ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶*[d1, e1] T. +normalize /3 width=3 by cpy_conf_neq, TC_confluent2/ qed-. + +theorem cpys_trans_eq: ∀G,L,T1,T,T2,d,e. + ⦃G, L⦄ ⊢ T1 ▶*[d, e] T → ⦃G, L⦄ ⊢ T ▶*[d, e] T2 → + ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2. +normalize /2 width=3 by trans_TC/ qed-. + +theorem cpys_trans_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶*[d1, e1] T0 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → d2 + e2 ≤ d1 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T ▶*[d1, e1] T2. +normalize /3 width=3 by cpy_trans_down, TC_transitive2/ qed-. + +theorem cpys_antisym_eq: ∀G,L1,T1,T2,d,e. ⦃G, L1⦄ ⊢ T1 ▶*[d, e] T2 → + ∀L2. ⦃G, L2⦄ ⊢ T2 ▶*[d, e] T1 → T1 = T2. +#G #L1 #T1 #T2 #d #e #H @(cpys_ind_alt … H) -G -L1 -T1 -T2 // +[ #I1 #G #L1 #K1 #V1 #V2 #W2 #i #d #e #Hdi #Hide #_ #_ #HVW2 #_ #L2 #HW2 + elim (lt_or_ge (|L2|) (i+1)) #Hi [ -Hdi -Hide | ] + [ lapply (cpys_weak_full … HW2) -HW2 #HW2 + lapply (cpys_weak … HW2 0 (i+1) ? ?) -HW2 // + [ >yplus_O1 >yplus_O1 /3 width=1 by ylt_fwd_le, ylt_inj/ ] -Hi + #HW2 >(cpys_inv_lift1_eq … HW2) -HW2 // + | elim (ldrop_O1_le (Ⓕ) … Hi) -Hi #K2 #HLK2 + elim (cpys_inv_lift1_ge_up … HW2 … HLK2 … HVW2 ? ? ?) -HW2 -HLK2 -HVW2 + /2 width=1 by ylt_fwd_le_succ, yle_succ_dx/ -Hdi -Hide + #X #_ #H elim (lift_inv_lref2_be … H) -H // + ] +| #a #I #G #L1 #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #L2 #H elim (cpys_inv_bind1 … H) -H + #V #T #HV2 #HT2 #H destruct + lapply (IHV12 … HV2) #H destruct -IHV12 -HV2 /3 width=2 by eq_f2/ +| #I #G #L1 #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #L2 #H elim (cpys_inv_flat1 … H) -H + #V #T #HV2 #HT2 #H destruct /3 width=2 by eq_f2/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_lift.ma new file mode 100644 index 000000000..e2dc401e3 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/cpys_lift.ma @@ -0,0 +1,226 @@ +(**************************************************************************) +(* ___ *) +(* ||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/cpy_lift.ma". +include "basic_2/multiple/cpys.ma". + +(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) + +(* Advanced properties ******************************************************) + +lemma cpys_subst: ∀I,G,L,K,V,U1,i,d,e. + d ≤ yinj i → i < d + e → + ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, K⦄ ⊢ V ▶*[0, ⫰(d+e-i)] U1 → + ∀U2. ⇧[0, i+1] U1 ≡ U2 → ⦃G, L⦄ ⊢ #i ▶*[d, e] U2. +#I #G #L #K #V #U1 #i #d #e #Hdi #Hide #HLK #H @(cpys_ind … H) -U1 +[ /3 width=5 by cpy_cpys, cpy_subst/ +| #U #U1 #_ #HU1 #IHU #U2 #HU12 + elim (lift_total U 0 (i+1)) #U0 #HU0 + lapply (IHU … HU0) -IHU #H + lapply (ldrop_fwd_drop2 … HLK) -HLK #HLK + lapply (cpy_lift_ge … HU1 … HLK HU0 HU12 ?) -HU1 -HLK -HU0 -HU12 // #HU02 + lapply (cpy_weak … HU02 d e ? ?) -HU02 + [2,3: /2 width=3 by cpys_strap1, yle_succ_dx/ ] + >yplus_O1 ymax_pre_sn_comm /2 width=1 by ylt_fwd_le_succ/ +] +qed. + +lemma cpys_subst_Y2: ∀I,G,L,K,V,U1,i,d. + d ≤ yinj i → + ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, K⦄ ⊢ V ▶*[0, ∞] U1 → + ∀U2. ⇧[0, i+1] U1 ≡ U2 → ⦃G, L⦄ ⊢ #i ▶*[d, ∞] U2. +#I #G #L #K #V #U1 #i #d #Hdi #HLK #HVU1 #U2 #HU12 +@(cpys_subst … HLK … HU12) >yminus_Y_inj // +qed. + +(* Advanced inverion lemmas *************************************************) + +lemma cpys_inv_atom1: ∀I,G,L,T2,d,e. ⦃G, L⦄ ⊢ ⓪{I} ▶*[d, e] T2 → + T2 = ⓪{I} ∨ + ∃∃J,K,V1,V2,i. d ≤ yinj i & i < d + e & + ⇩[i] L ≡ K.ⓑ{J}V1 & + ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 & + ⇧[O, i+1] V2 ≡ T2 & + I = LRef i. +#I #G #L #T2 #d #e #H @(cpys_ind … H) -T2 +[ /2 width=1 by or_introl/ +| #T #T2 #_ #HT2 * + [ #H destruct + elim (cpy_inv_atom1 … HT2) -HT2 [ /2 width=1 by or_introl/ | * /3 width=11 by ex6_5_intro, or_intror/ ] + | * #J #K #V1 #V #i #Hdi #Hide #HLK #HV1 #HVT #HI + lapply (ldrop_fwd_drop2 … HLK) #H + elim (cpy_inv_lift1_ge_up … HT2 … H … HVT) -HT2 -H -HVT + [2,3,4: /2 width=1 by ylt_fwd_le_succ, yle_succ_dx/ ] + /4 width=11 by cpys_strap1, ex6_5_intro, or_intror/ + ] +] +qed-. + +lemma cpys_inv_lref1: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶*[d, e] T2 → + T2 = #i ∨ + ∃∃I,K,V1,V2. d ≤ i & i < d + e & + ⇩[i] L ≡ K.ⓑ{I}V1 & + ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 & + ⇧[O, i+1] V2 ≡ T2. +#G #L #T2 #i #d #e #H elim (cpys_inv_atom1 … H) -H /2 width=1 by or_introl/ +* #I #K #V1 #V2 #j #Hdj #Hjde #HLK #HV12 #HVT2 #H destruct /3 width=7 by ex5_4_intro, or_intror/ +qed-. + +lemma cpys_inv_lref1_Y2: ∀G,L,T2,i,d. ⦃G, L⦄ ⊢ #i ▶*[d, ∞] T2 → + T2 = #i ∨ + ∃∃I,K,V1,V2. d ≤ i & ⇩[i] L ≡ K.ⓑ{I}V1 & + ⦃G, K⦄ ⊢ V1 ▶*[0, ∞] V2 & ⇧[O, i+1] V2 ≡ T2. +#G #L #T2 #i #d #H elim (cpys_inv_lref1 … H) -H /2 width=1 by or_introl/ +* >yminus_Y_inj /3 width=7 by or_intror, ex4_4_intro/ +qed-. + +lemma cpys_inv_lref1_ldrop: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶*[d, e] T2 → + ∀I,K,V1. ⇩[i] L ≡ K.ⓑ{I}V1 → + ∀V2. ⇧[O, i+1] V2 ≡ T2 → + ∧∧ ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 + & d ≤ i + & i < d + e. +#G #L #T2 #i #d #e #H #I #K #V1 #HLK #V2 #HVT2 elim (cpys_inv_lref1 … H) -H +[ #H destruct elim (lift_inv_lref2_be … HVT2) -HVT2 -HLK // +| * #Z #Y #X1 #X2 #Hdi #Hide #HLY #HX12 #HXT2 + lapply (lift_inj … HXT2 … HVT2) -T2 #H destruct + lapply (ldrop_mono … HLY … HLK) -L #H destruct + /2 width=1 by and3_intro/ +] +qed-. + +(* Properties on relocation *************************************************) + +lemma cpys_lift_le: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → + ∀L,U1,s,d,e. dt + et ≤ yinj d → ⇩[s, d, e] L ≡ K → + ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → + ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2. +#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hdetd #HLK #HTU1 @(cpys_ind … H) -T2 +[ #U2 #H >(lift_mono … HTU1 … H) -H // +| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 + elim (lift_total T d e) #U #HTU + lapply (IHT … HTU) -IHT #HU1 + lapply (cpy_lift_le … HT2 … HLK HTU HTU2 ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ +] +qed-. + +lemma cpys_lift_be: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → + ∀L,U1,s,d,e. dt ≤ yinj d → d ≤ dt + et → + ⇩[s, d, e] L ≡ K → ⇧[d, e] T1 ≡ U1 → + ∀U2. ⇧[d, e] T2 ≡ U2 → ⦃G, L⦄ ⊢ U1 ▶*[dt, et + e] U2. +#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hdtd #Hddet #HLK #HTU1 @(cpys_ind … H) -T2 +[ #U2 #H >(lift_mono … HTU1 … H) -H // +| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 + elim (lift_total T d e) #U #HTU + lapply (IHT … HTU) -IHT #HU1 + lapply (cpy_lift_be … HT2 … HLK HTU HTU2 ? ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ +] +qed-. + +lemma cpys_lift_ge: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → + ∀L,U1,s,d,e. yinj d ≤ dt → ⇩[s, d, e] L ≡ K → + ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → + ⦃G, L⦄ ⊢ U1 ▶*[dt+e, et] U2. +#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hddt #HLK #HTU1 @(cpys_ind … H) -T2 +[ #U2 #H >(lift_mono … HTU1 … H) -H // +| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 + elim (lift_total T d e) #U #HTU + lapply (IHT … HTU) -IHT #HU1 + lapply (cpy_lift_ge … HT2 … HLK HTU HTU2 ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ +] +qed-. + +(* Inversion lemmas for relocation ******************************************) + +lemma cpys_inv_lift1_le: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt + et ≤ d → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdetd @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_le … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +lemma cpys_inv_lift1_be: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt ≤ d → yinj d + e ≤ dt + et → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, et - e] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdedet @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_be … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +lemma cpys_inv_lift1_ge: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + yinj d + e ≤ dt → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt - e, et] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdedt @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_ge … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +(* Advanced inversion lemmas on relocation **********************************) + +lemma cpys_inv_lift1_ge_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[d, dt + et - (yinj d + e)] T2 & + ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_ge_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +lemma cpys_inv_lift1_be_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt ≤ d → dt + et ≤ yinj d + e → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdetde @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_be_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +lemma cpys_inv_lift1_le_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt ≤ d → d ≤ dt + et → dt + et ≤ yinj d + e → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde @(cpys_ind … H) -U2 +[ /2 width=3 by ex2_intro/ +| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU + elim (cpy_inv_lift1_le_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ +] +qed-. + +lemma cpys_inv_lift1_subst: ∀G,L,W1,W2,d,e. ⦃G, L⦄ ⊢ W1 ▶*[d, e] W2 → + ∀K,V1,i. ⇩[i+1] L ≡ K → ⇧[O, i+1] V1 ≡ W1 → + d ≤ yinj i → i < d + e → + ∃∃V2. ⦃G, K⦄ ⊢ V1 ▶*[O, ⫰(d+e-i)] V2 & ⇧[O, i+1] V2 ≡ W2. +#G #L #W1 #W2 #d #e #HW12 #K #V1 #i #HLK #HVW1 #Hdi #Hide +elim (cpys_inv_lift1_ge_up … HW12 … HLK … HVW1 ? ? ?) // +>yplus_O1 yplus_SO2 +[ >yminus_succ2 /2 width=3 by ex2_intro/ +| /2 width=1 by ylt_fwd_le_succ1/ +| /2 width=3 by yle_trans/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq.ma new file mode 100644 index 000000000..b7120b85b --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq.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/notation/relations/lazyeq_7.ma". +include "basic_2/grammar/genv.ma". +include "basic_2/multiple/lleq.ma". + +(* LAZY EQUIVALENCE FOR CLOSURES ********************************************) + +inductive fleq (d) (G) (L1) (T): relation3 genv lenv term ≝ +| fleq_intro: ∀L2. L1 ≡[T, d] L2 → fleq d G L1 T G L2 T +. + +interpretation + "lazy equivalence (closure)" + 'LazyEq d G1 L1 T1 G2 L2 T2 = (fleq d G1 L1 T1 G2 L2 T2). + +(* Basic_properties *********************************************************) + +lemma fleq_refl: ∀d. tri_reflexive … (fleq d). +/2 width=1 by fleq_intro/ qed. + +lemma fleq_sym: ∀d. tri_symmetric … (fleq d). +#d #G1 #L1 #T1 #G2 #L2 #T2 * /3 width=1 by fleq_intro, lleq_sym/ +qed-. + +(* Basic inversion lemmas ***************************************************) + +lemma fleq_inv_gen: ∀G1,G2,L1,L2,T1,T2,d. ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄ → + ∧∧ G1 = G2 & L1 ≡[T1, d] L2 & T1 = T2. +#G1 #G2 #L1 #L2 #T1 #T2 #d * -G2 -L2 -T2 /2 width=1 by and3_intro/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq_fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq_fleq.ma new file mode 100644 index 000000000..781b1f1e5 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fleq_fleq.ma @@ -0,0 +1,34 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/lleq_lleq.ma". +include "basic_2/multiple/fleq.ma". + +(* LAZY EQUIVALENCE FOR CLOSURES *******************************************) + +(* Main properties **********************************************************) + +theorem fleq_trans: ∀d. tri_transitive … (fleq d). +#d #G1 #G #L1 #L #T1 #T * -G -L -T +#L #HT1 #G2 #L2 #T2 * -G2 -L2 -T2 +/3 width=3 by lleq_trans, fleq_intro/ +qed-. + +theorem fleq_canc_sn: ∀G,G1,G2,L,L1,L2,T,T1,T2,d. + ⦃G, L, T⦄ ≡[d] ⦃G1, L1, T1⦄→ ⦃G, L, T⦄ ≡[d] ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄. +/3 width=5 by fleq_trans, fleq_sym/ qed-. + +theorem fleq_canc_dx: ∀G1,G2,G,L1,L2,L,T1,T2,T,d. + ⦃G1, L1, T1⦄ ≡[d] ⦃G, L, T⦄ → ⦃G2, L2, T2⦄ ≡[d] ⦃G, L, T⦄ → ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄. +/3 width=5 by fleq_trans, fleq_sym/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup.ma new file mode 100644 index 000000000..6a4bb37e2 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup.ma @@ -0,0 +1,109 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/suptermplus_6.ma". +include "basic_2/substitution/fqu.ma". + +(* PLUS-ITERATED SUPCLOSURE *************************************************) + +definition fqup: tri_relation genv lenv term ≝ tri_TC … fqu. + +interpretation "plus-iterated structural successor (closure)" + 'SupTermPlus G1 L1 T1 G2 L2 T2 = (fqup G1 L1 T1 G2 L2 T2). + +(* Basic properties *********************************************************) + +lemma fqu_fqup: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +/2 width=1 by tri_inj/ qed. + +lemma fqup_strap1: ∀G1,G,G2,L1,L,L2,T1,T,T2. + ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +/2 width=5 by tri_step/ qed. + +lemma fqup_strap2: ∀G1,G,G2,L1,L,L2,T1,T,T2. + ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +/2 width=5 by tri_TC_strap/ qed. + +lemma fqup_ldrop: ∀G1,G2,L1,K1,K2,T1,T2,U1,e. ⇩[e] L1 ≡ K1 → ⇧[0, e] T1 ≡ U1 → + ⦃G1, K1, T1⦄ ⊐+ ⦃G2, K2, T2⦄ → ⦃G1, L1, U1⦄ ⊐+ ⦃G2, K2, T2⦄. +#G1 #G2 #L1 #K1 #K2 #T1 #T2 #U1 #e #HLK1 #HTU1 #HT12 elim (eq_or_gt … e) #H destruct +[ >(ldrop_inv_O2 … HLK1) -L1 <(lift_inv_O2 … HTU1) -U1 // +| /3 width=5 by fqup_strap2, fqu_drop_lt/ +] +qed-. + +lemma fqup_lref: ∀I,G,L,K,V,i. ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, L, #i⦄ ⊐+ ⦃G, K, V⦄. +/3 width=6 by fqu_lref_O, fqu_fqup, lift_lref_ge, fqup_ldrop/ qed. + +lemma fqup_pair_sn: ∀I,G,L,V,T. ⦃G, L, ②{I}V.T⦄ ⊐+ ⦃G, L, V⦄. +/2 width=1 by fqu_pair_sn, fqu_fqup/ qed. + +lemma fqup_bind_dx: ∀a,I,G,L,V,T. ⦃G, L, ⓑ{a,I}V.T⦄ ⊐+ ⦃G, L.ⓑ{I}V, T⦄. +/2 width=1 by fqu_bind_dx, fqu_fqup/ qed. + +lemma fqup_flat_dx: ∀I,G,L,V,T. ⦃G, L, ⓕ{I}V.T⦄ ⊐+ ⦃G, L, T⦄. +/2 width=1 by fqu_flat_dx, fqu_fqup/ qed. + +lemma fqup_flat_dx_pair_sn: ∀I1,I2,G,L,V1,V2,T. ⦃G, L, ⓕ{I1}V1.②{I2}V2.T⦄ ⊐+ ⦃G, L, V2⦄. +/2 width=5 by fqu_pair_sn, fqup_strap1/ qed. + +lemma fqup_bind_dx_flat_dx: ∀a,G,I1,I2,L,V1,V2,T. ⦃G, L, ⓑ{a,I1}V1.ⓕ{I2}V2.T⦄ ⊐+ ⦃G, L.ⓑ{I1}V1, T⦄. +/2 width=5 by fqu_flat_dx, fqup_strap1/ qed. + +lemma fqup_flat_dx_bind_dx: ∀a,I1,I2,G,L,V1,V2,T. ⦃G, L, ⓕ{I1}V1.ⓑ{a,I2}V2.T⦄ ⊐+ ⦃G, L.ⓑ{I2}V2, T⦄. +/2 width=5 by fqu_bind_dx, fqup_strap1/ qed. + +(* Basic eliminators ********************************************************) + +lemma fqup_ind: ∀G1,L1,T1. ∀R:relation3 …. + (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G2 L2 T2) → + (∀G,G2,L,L2,T,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → R G L T → R G2 L2 T2) → + ∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2. +#G1 #L1 #T1 #R #IH1 #IH2 #G2 #L2 #T2 #H +@(tri_TC_ind … IH1 IH2 G2 L2 T2 H) +qed-. + +lemma fqup_ind_dx: ∀G2,L2,T2. ∀R:relation3 …. + (∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G1 L1 T1) → + (∀G1,G,L1,L,T1,T. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → R G L T → R G1 L1 T1) → + ∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G1 L1 T1. +#G2 #L2 #T2 #R #IH1 #IH2 #G1 #L1 #T1 #H +@(tri_TC_ind_dx … IH1 IH2 G1 L1 T1 H) +qed-. + +(* Basic forward lemmas *****************************************************) + +lemma fqup_fwd_fw: ∀G1,G2,L1,L2,T1,T2. + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} < ♯{G1, L1, T1}. +#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind … H) -G2 -L2 -T2 +/3 width=3 by fqu_fwd_fw, transitive_lt/ +qed-. + +(* Advanced eliminators *****************************************************) + +lemma fqup_wf_ind: ∀R:relation3 …. ( + ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2) → + R G1 L1 T1 + ) → ∀G1,L1,T1. R G1 L1 T1. +#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=1 by fqup_fwd_fw/ +qed-. + +lemma fqup_wf_ind_eq: ∀R:relation3 …. ( + ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2) → + ∀G2,L2,T2. G1 = G2 → L1 = L2 → T1 = T2 → R G2 L2 T2 + ) → ∀G1,L1,T1. R G1 L1 T1. +#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=7 by fqup_fwd_fw/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup_fqup.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup_fqup.ma new file mode 100644 index 000000000..48420a7cf --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqup_fqup.ma @@ -0,0 +1,22 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/fqup.ma". + +(* PLUS-ITERATED SUPCLOSURE *************************************************) + +(* Main properties **********************************************************) + +theorem fqup_trans: tri_transitive … fqup. +/2 width=5 by tri_TC_transitive/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus.ma new file mode 100644 index 000000000..5fe07bd4a --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus.ma @@ -0,0 +1,83 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/suptermstar_6.ma". +include "basic_2/substitution/fquq.ma". +include "basic_2/multiple/fqup.ma". + +(* STAR-ITERATED SUPCLOSURE *************************************************) + +definition fqus: tri_relation genv lenv term ≝ tri_TC … fquq. + +interpretation "star-iterated structural successor (closure)" + 'SupTermStar G1 L1 T1 G2 L2 T2 = (fqus G1 L1 T1 G2 L2 T2). + +(* Basic eliminators ********************************************************) + +lemma fqus_ind: ∀G1,L1,T1. ∀R:relation3 …. R G1 L1 T1 → + (∀G,G2,L,L2,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐⸮ ⦃G2, L2, T2⦄ → R G L T → R G2 L2 T2) → + ∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → R G2 L2 T2. +#G1 #L1 #T1 #R #IH1 #IH2 #G2 #L2 #T2 #H +@(tri_TC_star_ind … IH1 IH2 G2 L2 T2 H) // +qed-. + +lemma fqus_ind_dx: ∀G2,L2,T2. ∀R:relation3 …. R G2 L2 T2 → + (∀G1,G,L1,L,T1,T. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → R G L T → R G1 L1 T1) → + ∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → R G1 L1 T1. +#G2 #L2 #T2 #R #IH1 #IH2 #G1 #L1 #T1 #H +@(tri_TC_star_ind_dx … IH1 IH2 G1 L1 T1 H) // +qed-. + +(* Basic properties *********************************************************) + +lemma fqus_refl: tri_reflexive … fqus. +/2 width=1 by tri_inj/ qed. + +lemma fquq_fqus: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. +/2 width=1 by tri_inj/ qed. + +lemma fqus_strap1: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐⸮ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. +/2 width=5 by tri_step/ qed-. + +lemma fqus_strap2: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. +/2 width=5 by tri_TC_strap/ qed-. + +lemma fqus_ldrop: ∀G1,G2,K1,K2,T1,T2. ⦃G1, K1, T1⦄ ⊐* ⦃G2, K2, T2⦄ → + ∀L1,U1,e. ⇩[e] L1 ≡ K1 → ⇧[0, e] T1 ≡ U1 → + ⦃G1, L1, U1⦄ ⊐* ⦃G2, K2, T2⦄. +#G1 #G2 #K1 #K2 #T1 #T2 #H @(fqus_ind … H) -G2 -K2 -T2 +/3 width=5 by fqus_strap1, fquq_fqus, fquq_drop/ +qed-. + +lemma fqup_fqus: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. +#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind … H) -G2 -L2 -T2 +/3 width=5 by fqus_strap1, fquq_fqus, fqu_fquq/ +qed. + +(* Basic forward lemmas *****************************************************) + +lemma fqus_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} ≤ ♯{G1, L1, T1}. +#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqus_ind … H) -L2 -T2 +/3 width=3 by fquq_fwd_fw, transitive_le/ +qed-. + +(* Basic inversion lemmas ***************************************************) + +lemma fqup_inv_step_sn: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → + ∃∃G,L,T. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ & ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄. +#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind_dx … H) -G1 -L1 -T1 /2 width=5 by ex2_3_intro/ +#G1 #G #L1 #L #T1 #T #H1 #_ * /4 width=9 by fqus_strap2, fqu_fquq, ex2_3_intro/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_alt.ma new file mode 100644 index 000000000..c9ec457b6 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_alt.ma @@ -0,0 +1,61 @@ +(**************************************************************************) +(* ___ *) +(* ||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/fquq_alt.ma". +include "basic_2/multiple/fqus.ma". + +(* STAR-ITERATED SUPCLOSURE *************************************************) + +(* Advanced inversion lemmas ************************************************) + +lemma fqus_inv_gen: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ ∨ (∧∧ G1 = G2 & L1 = L2 & T1 = T2). +#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqus_ind … H) -G2 -L2 -T2 // +#G #G2 #L #L2 #T #T2 #_ #H2 * elim (fquq_inv_gen … H2) -H2 +[ /3 width=5 by fqup_strap1, or_introl/ +| * #HG #HL #HT destruct /2 width=1 by or_introl/ +| #H2 * #HG #HL #HT destruct /3 width=1 by fqu_fqup, or_introl/ +| * #H1G #H1L #H1T * #H2G #H2L #H2T destruct /2 width=1 by or_intror/ +] +qed-. + +(* Advanced properties ******************************************************) + +lemma fqus_strap1_fqu: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 elim (fqus_inv_gen … H1) -H1 +[ /2 width=5 by fqup_strap1/ +| * #HG #HL #HT destruct /2 width=1 by fqu_fqup/ +] +qed-. + +lemma fqus_strap2_fqu: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 elim (fqus_inv_gen … H2) -H2 +[ /2 width=5 by fqup_strap2/ +| * #HG #HL #HT destruct /2 width=1 by fqu_fqup/ +] +qed-. + +lemma fqus_fqup_trans: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 @(fqup_ind … H2) -H2 -G2 -L2 -T2 +/2 width=5 by fqus_strap1_fqu, fqup_strap1/ +qed-. + +lemma fqup_fqus_trans: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → + ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. +#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 @(fqup_ind_dx … H1) -H1 -G1 -L1 -T1 +/3 width=5 by fqus_strap2_fqu, fqup_strap2/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_fqus.ma new file mode 100644 index 000000000..ef9902931 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/fqus_fqus.ma @@ -0,0 +1,22 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/fqus.ma". + +(* STAR-ITERATED SUPCLOSURE *************************************************) + +(* Main properties **********************************************************) + +theorem fqus_trans: tri_transitive … fqus. +/2 width=5 by tri_TC_transitive/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/frees.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/frees.ma new file mode 100644 index 000000000..16c2af962 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/frees.ma @@ -0,0 +1,160 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "ground_2/ynat/ynat_plus.ma". +include "basic_2/notation/relations/freestar_4.ma". +include "basic_2/substitution/lift_neg.ma". +include "basic_2/substitution/ldrop.ma". + +(* CONTEXT-SENSITIVE FREE VARIABLES *****************************************) + +inductive frees: relation4 ynat lenv term nat ≝ +| frees_eq: ∀L,U,d,i. (∀T. ⇧[i, 1] T ≡ U → ⊥) → frees d L U i +| frees_be: ∀I,L,K,U,W,d,i,j. d ≤ yinj j → j < i → + (∀T. ⇧[j, 1] T ≡ U → ⊥) → ⇩[j]L ≡ K.ⓑ{I}W → + frees 0 K W (i-j-1) → frees d L U i. + +interpretation + "context-sensitive free variables (term)" + 'FreeStar L i d U = (frees d L U i). + +(* Basic inversion lemmas ***************************************************) + +lemma frees_inv: ∀L,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃U⦄ → + (∀T. ⇧[i, 1] T ≡ U → ⊥) ∨ + ∃∃I,K,W,j. d ≤ yinj j & j < i & (∀T. ⇧[j, 1] T ≡ U → ⊥) & + ⇩[j]L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. +#L #U #d #i * -L -U -d -i /4 width=9 by ex5_4_intro, or_intror, or_introl/ +qed-. + +lemma frees_inv_sort: ∀L,d,i,k. L ⊢ i ϵ 𝐅*[d]⦃⋆k⦄ → ⊥. +#L #d #i #k #H elim (frees_inv … H) -H [|*] /2 width=2 by/ +qed-. + +lemma frees_inv_gref: ∀L,d,i,p. L ⊢ i ϵ 𝐅*[d]⦃§p⦄ → ⊥. +#L #d #i #p #H elim (frees_inv … H) -H [|*] /2 width=2 by/ +qed-. + +lemma frees_inv_lref: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → + j = i ∨ + ∃∃I,K,W. d ≤ yinj j & j < i & ⇩[j] L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. +#L #d #x #i #H elim (frees_inv … H) -H +[ /4 width=2 by nlift_inv_lref_be_SO, or_introl/ +| * #I #K #W #j #Hdj #Hji #Hnx #HLK #HW + >(nlift_inv_lref_be_SO … Hnx) -x /3 width=5 by ex4_3_intro, or_intror/ +] +qed-. + +lemma frees_inv_lref_free: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → |L| ≤ j → j = i. +#L #d #j #i #H #Hj elim (frees_inv_lref … H) -H // +* #I #K #W #_ #_ #HLK lapply (ldrop_fwd_length_lt2 … HLK) -I +#H elim (lt_refl_false j) /2 width=3 by lt_to_le_to_lt/ +qed-. + +lemma frees_inv_lref_skip: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → yinj j < d → j = i. +#L #d #j #i #H #Hjd elim (frees_inv_lref … H) -H // +* #I #K #W #Hdj elim (ylt_yle_false … Hdj) -Hdj // +qed-. + +lemma frees_inv_lref_ge: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → i ≤ j → j = i. +#L #d #j #i #H #Hij elim (frees_inv_lref … H) -H // +* #I #K #W #_ #Hji elim (lt_refl_false j) -I -L -K -W -d /2 width=3 by lt_to_le_to_lt/ +qed-. + +lemma frees_inv_lref_lt: ∀L,d,j,i.L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → j < i → + ∃∃I,K,W. d ≤ yinj j & ⇩[j] L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. +#L #d #j #i #H #Hji elim (frees_inv_lref … H) -H +[ #H elim (lt_refl_false j) // +| * /2 width=5 by ex3_3_intro/ +] +qed-. + +lemma frees_inv_bind: ∀a,I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄ → + L ⊢ i ϵ 𝐅*[d]⦃W⦄ ∨ L.ⓑ{I}W ⊢ i+1 ϵ 𝐅*[⫯d]⦃U⦄ . +#a #J #L #V #U #d #i #H elim (frees_inv … H) -H +[ #HnX elim (nlift_inv_bind … HnX) -HnX + /4 width=2 by frees_eq, or_intror, or_introl/ +| * #I #K #W #j #Hdj #Hji #HnX #HLK #HW elim (nlift_inv_bind … HnX) -HnX + [ /4 width=9 by frees_be, or_introl/ + | #HnT @or_intror @(frees_be … HnT) -HnT + [4,5,6: /2 width=1 by ldrop_drop, yle_succ, lt_minus_to_plus/ + |7: >minus_plus_plus_l // + |*: skip + ] + ] +] +qed-. + +lemma frees_inv_flat: ∀I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃ⓕ{I}W.U⦄ → + L ⊢ i ϵ 𝐅*[d]⦃W⦄ ∨ L ⊢ i ϵ 𝐅*[d]⦃U⦄ . +#J #L #V #U #d #i #H elim (frees_inv … H) -H +[ #HnX elim (nlift_inv_flat … HnX) -HnX + /4 width=2 by frees_eq, or_intror, or_introl/ +| * #I #K #W #j #Hdj #Hji #HnX #HLK #HW elim (nlift_inv_flat … HnX) -HnX + /4 width=9 by frees_be, or_intror, or_introl/ +] +qed-. + +(* Basic properties *********************************************************) + +lemma frees_lref_eq: ∀L,d,i. L ⊢ i ϵ 𝐅*[d]⦃#i⦄. +/3 width=7 by frees_eq, lift_inv_lref2_be/ qed. + +lemma frees_lref_be: ∀I,L,K,W,d,i,j. d ≤ yinj j → j < i → ⇩[j]L ≡ K.ⓑ{I}W → + K ⊢ i-j-1 ϵ 𝐅*[0]⦃W⦄ → L ⊢ i ϵ 𝐅*[d]⦃#j⦄. +/3 width=9 by frees_be, lift_inv_lref2_be/ qed. + +lemma frees_bind_sn: ∀a,I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃W⦄ → + L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄. +#a #I #L #W #U #d #i #H elim (frees_inv … H) -H [|*] +/4 width=9 by frees_be, frees_eq, nlift_bind_sn/ +qed. + +lemma frees_bind_dx: ∀a,I,L,W,U,d,i. L.ⓑ{I}W ⊢ i+1 ϵ 𝐅*[⫯d]⦃U⦄ → + L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄. +#a #J #L #V #U #d #i #H elim (frees_inv … H) -H +[ /4 width=9 by frees_eq, nlift_bind_dx/ +| * #I #K #W #j #Hdj #Hji #HnU #HLK #HW + elim (yle_inv_succ1 … Hdj) -Hdj (plus_minus_m_m j 1) in HnU; // (ldrops_inv_nil … H) -L1 /2 width=7 by lifts_nil, minuss_nil, ex4_3_intro, ldrops_nil/ +| #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 by lt_plus_to_minus_r/ #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 by lifts_cons, ldrops_cons/ | skip ] + normalize >plus_minus /3 width=1 by minuss_lt, lt_minus_to_plus/ (**) (* explicit constructors *) +| #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 by minuss_ge, ex4_3_intro, le_S_S/ +] +qed-. + +(* Basic properties *********************************************************) + +(* Basic_1: was: drop1_skip_bind *) +lemma ldrops_skip: ∀L1,L2,s,des. ⇩*[s, des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 → + ∀I. ⇩*[s, des + 1] L1.ⓑ{I}V1 ≡ L2.ⓑ{I}V2. +#L1 #L2 #s #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 by ldrop_skip, ldrops_cons/ +]. +qed. + +(* Basic_1: removed theorems 1: drop1_getl_trans *) diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/ldrops_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/ldrops_ldrop.ma new file mode 100644 index 000000000..cbbfd6788 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/ldrops_ldrop.ma @@ -0,0 +1,36 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/ldrops.ma". + +(* ITERATED LOCAL ENVIRONMENT SLICING ***************************************) + +(* Properties concerning basic local environment slicing ********************) + +lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[Ⓕ, des] L1 ≡ L → ∀L2,i. ⇩[i] L ≡ L2 → + ∃∃L0,des0,i0. ⇩[i0] L1 ≡ L0 & ⇩*[Ⓕ, des0] L0 ≡ L2 & + @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0. +#L1 #L #des #H elim H -L1 -L -des +[ /2 width=7 by ldrops_nil, minuss_nil, at_nil, ex4_3_intro/ +| #L1 #L0 #L #des #d #e #_ #HL0 #IHL0 #L2 #i #HL2 + elim (lt_or_ge i d) #Hid + [ elim (ldrop_trans_le … HL0 … HL2) -L /2 width=2 by lt_to_le/ + #L #HL0 #HL2 elim (IHL0 … HL0) -L0 /3 width=7 by ldrops_cons, minuss_lt, at_lt, ex4_3_intro/ + | lapply (ldrop_trans_ge … HL0 … HL2 ?) -L // #HL02 + elim (IHL0 … HL02) -L0 /3 width=7 by minuss_ge, at_ge, ex4_3_intro/ + ] +] +qed-. + diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/ldrops_ldrops.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/ldrops_ldrops.ma new file mode 100644 index 000000000..b51728ca9 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/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/multiple/ldrops_ldrop.ma". + +(* ITERATED LOCAL ENVIRONMENT SLICING ***************************************) + +(* Main properties **********************************************************) + +(* Basic_1: was: drop1_trans *) +theorem ldrops_trans: ∀L,L2,s,des2. ⇩*[s, des2] L ≡ L2 → ∀L1,des1. ⇩*[s, des1] L1 ≡ L → + ⇩*[s, des2 @@ des1] L1 ≡ L2. +#L #L2 #s #des2 #H elim H -L -L2 -des2 /3 width=3 by ldrops_cons/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts.ma new file mode 100644 index 000000000..217878d05 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/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/notation/relations/rliftstar_3.ma". +include "basic_2/substitution/lift.ma". +include "basic_2/multiple/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 by lifts_inv_nil_aux/ 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 by ex2_intro/ +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 by lifts_inv_cons_aux/ 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 by/ +] +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 by at_nil, ex2_intro/ +| #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 by at_lt, at_ge, ex2_intro/ +] +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 by/ +] +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 by ex3_2_intro, lifts_nil/ +| #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 by ex3_2_intro, lifts_cons/ +] +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 by ex3_2_intro, lifts_nil/ +| #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 by ex3_2_intro, lifts_cons/ +] +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 by lift_bind, lifts_cons/ +] +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 by lift_flat, lifts_cons/ +] +qed. + +lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2. +#des elim des -des /2 width=2 by lifts_nil, ex_intro/ +#d #e #des #IH #T1 elim (lift_total T1 d e) +#T #HT1 elim (IH T) -IH /3 width=4 by lifts_cons, ex_intro/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts_lift.ma new file mode 100644 index 000000000..efa5038d2 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/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/substitution/lift_lift.ma". +include "basic_2/multiple/gr2_minus.ma". +include "basic_2/multiple/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/multiple/lifts_lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts_lifts.ma new file mode 100644 index 000000000..d72f56868 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/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/multiple/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/multiple/lifts_vector.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lifts_vector.ma new file mode 100644 index 000000000..d6878c0a1 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/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/substitution/lift_vector.ma". +include "basic_2/multiple/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 by liftsv_cons/ |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 by lifts_flat/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq.ma new file mode 100644 index 000000000..ea34316fe --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq.ma @@ -0,0 +1,160 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/lazyeq_4.ma". +include "basic_2/multiple/llpx_sn.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +definition ceq: relation3 lenv term term ≝ λL,T1,T2. T1 = T2. + +definition lleq: relation4 ynat term lenv lenv ≝ llpx_sn ceq. + +interpretation + "lazy equivalence (local environment)" + 'LazyEq T d L1 L2 = (lleq d T L1 L2). + +definition lleq_transitive: predicate (relation3 lenv term term) ≝ + λR. ∀L2,T1,T2. R L2 T1 T2 → ∀L1. L1 ≡[T1, 0] L2 → R L1 T1 T2. + +(* Basic inversion lemmas ***************************************************) + +lemma lleq_ind: ∀R:relation4 ynat term lenv lenv. ( + ∀L1,L2,d,k. |L1| = |L2| → R d (⋆k) L1 L2 + ) → ( + ∀L1,L2,d,i. |L1| = |L2| → yinj i < d → R d (#i) L1 L2 + ) → ( + ∀I,L1,L2,K1,K2,V,d,i. d ≤ yinj i → + ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → + K1 ≡[V, yinj O] K2 → R (yinj O) V K1 K2 → R d (#i) L1 L2 + ) → ( + ∀L1,L2,d,i. |L1| = |L2| → |L1| ≤ i → |L2| ≤ i → R d (#i) L1 L2 + ) → ( + ∀L1,L2,d,p. |L1| = |L2| → R d (§p) L1 L2 + ) → ( + ∀a,I,L1,L2,V,T,d. + L1 ≡[V, d]L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → + R d V L1 L2 → R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → R d (ⓑ{a,I}V.T) L1 L2 + ) → ( + ∀I,L1,L2,V,T,d. + L1 ≡[V, d]L2 → L1 ≡[T, d] L2 → + R d V L1 L2 → R d T L1 L2 → R d (ⓕ{I}V.T) L1 L2 + ) → + ∀d,T,L1,L2. L1 ≡[T, d] L2 → R d T L1 L2. +#R #H1 #H2 #H3 #H4 #H5 #H6 #H7 #d #T #L1 #L2 #H elim H -L1 -L2 -T -d /2 width=8 by/ +qed-. + +lemma lleq_inv_bind: ∀a,I,L1,L2,V,T,d. L1 ≡[ⓑ{a,I}V.T, d] L2 → + L1 ≡[V, d] L2 ∧ L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V. +/2 width=2 by llpx_sn_inv_bind/ qed-. + +lemma lleq_inv_flat: ∀I,L1,L2,V,T,d. L1 ≡[ⓕ{I}V.T, d] L2 → + L1 ≡[V, d] L2 ∧ L1 ≡[T, d] L2. +/2 width=2 by llpx_sn_inv_flat/ qed-. + +(* Basic forward lemmas *****************************************************) + +lemma lleq_fwd_length: ∀L1,L2,T,d. L1 ≡[T, d] L2 → |L1| = |L2|. +/2 width=4 by llpx_sn_fwd_length/ qed-. + +lemma lleq_fwd_lref: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → + ∨∨ |L1| ≤ i ∧ |L2| ≤ i + | yinj i < d + | ∃∃I,K1,K2,V. ⇩[i] L1 ≡ K1.ⓑ{I}V & + ⇩[i] L2 ≡ K2.ⓑ{I}V & + K1 ≡[V, yinj 0] K2 & d ≤ yinj i. +#L1 #L2 #d #i #H elim (llpx_sn_fwd_lref … H) /2 width=1/ +* /3 width=7 by or3_intro2, ex4_4_intro/ +qed-. + +lemma lleq_fwd_ldrop_sn: ∀L1,L2,T,d. L1 ≡[d, T] L2 → ∀K1,i. ⇩[i] L1 ≡ K1 → + ∃K2. ⇩[i] L2 ≡ K2. +/2 width=7 by llpx_sn_fwd_ldrop_sn/ qed-. + +lemma lleq_fwd_ldrop_dx: ∀L1,L2,T,d. L1 ≡[d, T] L2 → ∀K2,i. ⇩[i] L2 ≡ K2 → + ∃K1. ⇩[i] L1 ≡ K1. +/2 width=7 by llpx_sn_fwd_ldrop_dx/ qed-. + +lemma lleq_fwd_bind_sn: ∀a,I,L1,L2,V,T,d. + L1 ≡[ⓑ{a,I}V.T, d] L2 → L1 ≡[V, d] L2. +/2 width=4 by llpx_sn_fwd_bind_sn/ qed-. + +lemma lleq_fwd_bind_dx: ∀a,I,L1,L2,V,T,d. + L1 ≡[ⓑ{a,I}V.T, d] L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V. +/2 width=2 by llpx_sn_fwd_bind_dx/ qed-. + +lemma lleq_fwd_flat_sn: ∀I,L1,L2,V,T,d. + L1 ≡[ⓕ{I}V.T, d] L2 → L1 ≡[V, d] L2. +/2 width=3 by llpx_sn_fwd_flat_sn/ qed-. + +lemma lleq_fwd_flat_dx: ∀I,L1,L2,V,T,d. + L1 ≡[ⓕ{I}V.T, d] L2 → L1 ≡[T, d] L2. +/2 width=3 by llpx_sn_fwd_flat_dx/ qed-. + +(* Basic properties *********************************************************) + +lemma lleq_sort: ∀L1,L2,d,k. |L1| = |L2| → L1 ≡[⋆k, d] L2. +/2 width=1 by llpx_sn_sort/ qed. + +lemma lleq_skip: ∀L1,L2,d,i. yinj i < d → |L1| = |L2| → L1 ≡[#i, d] L2. +/2 width=1 by llpx_sn_skip/ qed. + +lemma lleq_lref: ∀I,L1,L2,K1,K2,V,d,i. d ≤ yinj i → + ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → + K1 ≡[V, 0] K2 → L1 ≡[#i, d] L2. +/2 width=9 by llpx_sn_lref/ qed. + +lemma lleq_free: ∀L1,L2,d,i. |L1| ≤ i → |L2| ≤ i → |L1| = |L2| → L1 ≡[#i, d] L2. +/2 width=1 by llpx_sn_free/ qed. + +lemma lleq_gref: ∀L1,L2,d,p. |L1| = |L2| → L1 ≡[§p, d] L2. +/2 width=1 by llpx_sn_gref/ qed. + +lemma lleq_bind: ∀a,I,L1,L2,V,T,d. + L1 ≡[V, d] L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → + L1 ≡[ⓑ{a,I}V.T, d] L2. +/2 width=1 by llpx_sn_bind/ qed. + +lemma lleq_flat: ∀I,L1,L2,V,T,d. + L1 ≡[V, d] L2 → L1 ≡[T, d] L2 → L1 ≡[ⓕ{I}V.T, d] L2. +/2 width=1 by llpx_sn_flat/ qed. + +lemma lleq_refl: ∀d,T. reflexive … (lleq d T). +/2 width=1 by llpx_sn_refl/ qed. + +lemma lleq_Y: ∀L1,L2,T. |L1| = |L2| → L1 ≡[T, ∞] L2. +/2 width=1 by llpx_sn_Y/ qed. + +lemma lleq_sym: ∀d,T. symmetric … (lleq d T). +#d #T #L1 #L2 #H @(lleq_ind … H) -d -T -L1 -L2 +/2 width=7 by lleq_sort, lleq_skip, lleq_lref, lleq_free, lleq_gref, lleq_bind, lleq_flat/ +qed-. + +lemma lleq_ge_up: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → + ∀T,d,e. ⇧[d, e] T ≡ U → + dt ≤ d + e → L1 ≡[U, d] L2. +/2 width=6 by llpx_sn_ge_up/ qed-. + +lemma lleq_ge: ∀L1,L2,T,d1. L1 ≡[T, d1] L2 → ∀d2. d1 ≤ d2 → L1 ≡[T, d2] L2. +/2 width=3 by llpx_sn_ge/ qed-. + +lemma lleq_bind_O: ∀a,I,L1,L2,V,T. L1 ≡[V, 0] L2 → L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → + L1 ≡[ⓑ{a,I}V.T, 0] L2. +/2 width=1 by llpx_sn_bind_O/ qed-. + +(* Advancded properties on lazy pointwise exyensions ************************) + +lemma llpx_sn_lrefl: ∀R. (∀L. reflexive … (R L)) → + ∀L1,L2,T,d. L1 ≡[T, d] L2 → llpx_sn R d T L1 L2. +/2 width=3 by llpx_sn_co/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt.ma new file mode 100644 index 000000000..38b34aec5 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt.ma @@ -0,0 +1,41 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/llpx_sn_alt.ma". +include "basic_2/multiple/lleq.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Alternative definition (not recursive) ***********************************) + +theorem lleq_intro_alt: ∀L1,L2,T,d. |L1| = |L2| → + (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ V1 = V2 + ) → L1 ≡[T, d] L2. +#L1 #L2 #T #d #HL12 #IH @llpx_sn_alt_inv_llpx_sn @conj // -HL12 +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 +@(IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 // +qed. + +theorem lleq_inv_alt: ∀L1,L2,T,d. L1 ≡[T, d] L2 → + |L1| = |L2| ∧ + ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ V1 = V2. +#L1 #L2 #T #d #H elim (llpx_sn_llpx_sn_alt … H) -H +#HL12 #IH @conj // +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 +@(IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 // +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt_rec.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt_rec.ma new file mode 100644 index 000000000..b8646bc0e --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_alt_rec.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/multiple/llpx_sn_alt_rec.ma". +include "basic_2/multiple/lleq.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Alternative definition (recursive) ***************************************) + +theorem lleq_intro_alt_r: ∀L1,L2,T,d. |L1| = |L2| → + (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2 + ) → L1 ≡[T, d] L2. +#L1 #L2 #T #d #HL12 #IH @llpx_sn_intro_alt_r // -HL12 +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 +elim (IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 /2 width=1 by and3_intro/ +qed. + +theorem lleq_ind_alt_r: ∀S:relation4 ynat term lenv lenv. + (∀L1,L2,T,d. |L1| = |L2| → ( + ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2 & S 0 V1 K1 K2 + ) → S d T L1 L2) → + ∀L1,L2,T,d. L1 ≡[T, d] L2 → S d T L1 L2. +#S #IH1 #L1 #L2 #T #d #H @(llpx_sn_ind_alt_r … H) -L1 -L2 -T -d +#L1 #L2 #T #d #HL12 #IH2 @IH1 -IH1 // -HL12 +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 +elim (IH2 … HnT HLK1 HLK2) -IH2 -HnT -HLK1 -HLK2 /2 width=1 by and4_intro/ +qed-. + +theorem lleq_inv_alt_r: ∀L1,L2,T,d. L1 ≡[T, d] L2 → + |L1| = |L2| ∧ + ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2. +#L1 #L2 #T #d #H elim (llpx_sn_inv_alt_r … H) -H +#HL12 #IH @conj // +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 +elim (IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 /2 width=1 by and3_intro/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_fqus.ma new file mode 100644 index 000000000..87fd1e7f8 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_fqus.ma @@ -0,0 +1,75 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/fqus_alt.ma". +include "basic_2/multiple/lleq_ldrop.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Properties on supclosure *************************************************) + +lemma lleq_fqu_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐ ⦃G2, K2, U⦄ → + ∀L1. L1 ≡[T, 0] L2 → + ∃∃K1. ⦃G1, L1, T⦄ ⊐ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. +#G1 #G2 #L2 #K2 #T #U #H elim H -G1 -G2 -L2 -K2 -T -U +[ #I #G #L2 #V #L1 #H elim (lleq_inv_lref_ge_dx … H … I L2 V) -H // + #K1 #H1 #H2 lapply (ldrop_inv_O2 … H1) -H1 + #H destruct /2 width=3 by fqu_lref_O, ex2_intro/ +| * [ #a ] #I #G #L2 #V #T #L1 #H + [ elim (lleq_inv_bind … H) + | elim (lleq_inv_flat … H) + ] -H + /2 width=3 by fqu_pair_sn, ex2_intro/ +| #a #I #G #L2 #V #T #L1 #H elim (lleq_inv_bind_O … H) -H + #H3 #H4 /2 width=3 by fqu_bind_dx, ex2_intro/ +| #I #G #L2 #V #T #L1 #H elim (lleq_inv_flat … H) -H + /2 width=3 by fqu_flat_dx, ex2_intro/ +| #G #L2 #K2 #T #U #e #HLK2 #HTU #L1 #HL12 + elim (ldrop_O1_le (Ⓕ) (e+1) L1) + [ /3 width=12 by fqu_drop, lleq_inv_lift_le, ex2_intro/ + | lapply (ldrop_fwd_length_le2 … HLK2) -K2 + lapply (lleq_fwd_length … HL12) -T -U // + ] +] +qed-. + +lemma lleq_fquq_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐⸮ ⦃G2, K2, U⦄ → + ∀L1. L1 ≡[T, 0] L2 → + ∃∃K1. ⦃G1, L1, T⦄ ⊐⸮ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. +#G1 #G2 #L2 #K2 #T #U #H #L1 #HL12 elim(fquq_inv_gen … H) -H +[ #H elim (lleq_fqu_trans … H … HL12) -L2 /3 width=3 by fqu_fquq, ex2_intro/ +| * #HG #HL #HT destruct /2 width=3 by ex2_intro/ +] +qed-. + +lemma lleq_fqup_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐+ ⦃G2, K2, U⦄ → + ∀L1. L1 ≡[T, 0] L2 → + ∃∃K1. ⦃G1, L1, T⦄ ⊐+ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. +#G1 #G2 #L2 #K2 #T #U #H @(fqup_ind … H) -G2 -K2 -U +[ #G2 #K2 #U #HTU #L1 #HL12 elim (lleq_fqu_trans … HTU … HL12) -L2 + /3 width=3 by fqu_fqup, ex2_intro/ +| #G #G2 #K #K2 #U #U2 #_ #HU2 #IHTU #L1 #HL12 elim (IHTU … HL12) -L2 + #K1 #HTU #HK1 elim (lleq_fqu_trans … HU2 … HK1) -K + /3 width=5 by fqup_strap1, ex2_intro/ +] +qed-. + +lemma lleq_fqus_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐* ⦃G2, K2, U⦄ → + ∀L1. L1 ≡[T, 0] L2 → + ∃∃K1. ⦃G1, L1, T⦄ ⊐* ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. +#G1 #G2 #L2 #K2 #T #U #H #L1 #HL12 elim(fqus_inv_gen … H) -H +[ #H elim (lleq_fqup_trans … H … HL12) -L2 /3 width=3 by fqup_fqus, ex2_intro/ +| * #HG #HL #HT destruct /2 width=3 by ex2_intro/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_ldrop.ma new file mode 100644 index 000000000..a50e25bd8 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_ldrop.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/multiple/llpx_sn_ldrop.ma". +include "basic_2/multiple/lleq.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Advanced properties ******************************************************) + +lemma lleq_bind_repl_O: ∀I,L1,L2,V,T. L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → + ∀J,W. L1 ≡[W, 0] L2 → L1.ⓑ{J}W ≡[T, 0] L2.ⓑ{J}W. +/2 width=7 by llpx_sn_bind_repl_O/ qed-. + +lemma lleq_dec: ∀T,L1,L2,d. Decidable (L1 ≡[T, d] L2). +/3 width=1 by llpx_sn_dec, eq_term_dec/ qed-. + +lemma lleq_llpx_sn_trans: ∀R. lleq_transitive R → + ∀L1,L2,T,d. L1 ≡[T, d] L2 → + ∀L. llpx_sn R d T L2 L → llpx_sn R d T L1 L. +#R #HR #L1 #L2 #T #d #H @(lleq_ind … H) -L1 -L2 -T -d +[1,2,5: /4 width=6 by llpx_sn_fwd_length, llpx_sn_gref, llpx_sn_skip, llpx_sn_sort, trans_eq/ +|4: /4 width=6 by llpx_sn_fwd_length, llpx_sn_free, le_repl_sn_conf_aux, trans_eq/ +| #I #L1 #L2 #K1 #K2 #V #d #i #Hdi #HLK1 #HLK2 #HK12 #IHK12 #L #H elim (llpx_sn_inv_lref_ge_sn … H … HLK2) -H -HLK2 + /3 width=11 by llpx_sn_lref/ +| #a #I #L1 #L2 #V #T #d #_ #_ #IHV #IHT #L #H elim (llpx_sn_inv_bind … H) -H + /3 width=1 by llpx_sn_bind/ +| #I #L1 #L2 #V #T #d #_ #_ #IHV #IHT #L #H elim (llpx_sn_inv_flat … H) -H + /3 width=1 by llpx_sn_flat/ +] +qed-. + +lemma lleq_llpx_sn_conf: ∀R. lleq_transitive R → + ∀L1,L2,T,d. L1 ≡[T, d] L2 → + ∀L. llpx_sn R d T L1 L → llpx_sn R d T L2 L. +/3 width=3 by lleq_llpx_sn_trans, lleq_sym/ qed-. + +(* Advanced inversion lemmas ************************************************) + +lemma lleq_inv_lref_ge_dx: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → + ∀I,K2,V. ⇩[i] L2 ≡ K2.ⓑ{I}V → + ∃∃K1. ⇩[i] L1 ≡ K1.ⓑ{I}V & K1 ≡[V, 0] K2. +#L1 #L2 #d #i #H #Hdi #I #K2 #V #HLK2 elim (llpx_sn_inv_lref_ge_dx … H … HLK2) -L2 +/2 width=3 by ex2_intro/ +qed-. + +lemma lleq_inv_lref_ge_sn: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → + ∀I,K1,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → + ∃∃K2. ⇩[i] L2 ≡ K2.ⓑ{I}V & K1 ≡[V, 0] K2. +#L1 #L2 #d #i #H #Hdi #I1 #K1 #V #HLK1 elim (llpx_sn_inv_lref_ge_sn … H … HLK1) -L1 +/2 width=3 by ex2_intro/ +qed-. + +lemma lleq_inv_lref_ge_bi: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → + ∀I1,I2,K1,K2,V1,V2. + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + ∧∧ I1 = I2 & K1 ≡[V1, 0] K2 & V1 = V2. +/2 width=8 by llpx_sn_inv_lref_ge_bi/ qed-. + +lemma lleq_inv_lref_ge: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → + ∀I,K1,K2,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → + K1 ≡[V, 0] K2. +#L1 #L2 #d #i #HL12 #Hdi #I #K1 #K2 #V #HLK1 #HLK2 +elim (lleq_inv_lref_ge_bi … HL12 … HLK1 HLK2) // +qed-. + +lemma lleq_inv_S: ∀L1,L2,T,d. L1 ≡[T, d+1] L2 → + ∀I,K1,K2,V. ⇩[d] L1 ≡ K1.ⓑ{I}V → ⇩[d] L2 ≡ K2.ⓑ{I}V → + K1 ≡[V, 0] K2 → L1 ≡[T, d] L2. +/2 width=9 by llpx_sn_inv_S/ qed-. + +lemma lleq_inv_bind_O: ∀a,I,L1,L2,V,T. L1 ≡[ⓑ{a,I}V.T, 0] L2 → + L1 ≡[V, 0] L2 ∧ L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V. +/2 width=2 by llpx_sn_inv_bind_O/ qed-. + +(* Advanced forward lemmas **************************************************) + +lemma lleq_fwd_lref_dx: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → + ∀I,K2,V. ⇩[i] L2 ≡ K2.ⓑ{I}V → + i < d ∨ + ∃∃K1. ⇩[i] L1 ≡ K1.ⓑ{I}V & K1 ≡[V, 0] K2 & d ≤ i. +#L1 #L2 #d #i #H #I #K2 #V #HLK2 elim (llpx_sn_fwd_lref_dx … H … HLK2) -L2 +[ | * ] /3 width=3 by ex3_intro, or_intror, or_introl/ +qed-. + +lemma lleq_fwd_lref_sn: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → + ∀I,K1,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → + i < d ∨ + ∃∃K2. ⇩[i] L2 ≡ K2.ⓑ{I}V & K1 ≡[V, 0] K2 & d ≤ i. +#L1 #L2 #d #i #H #I #K1 #V #HLK1 elim (llpx_sn_fwd_lref_sn … H … HLK1) -L1 +[ | * ] /3 width=3 by ex3_intro, or_intror, or_introl/ +qed-. + +lemma lleq_fwd_bind_O_dx: ∀a,I,L1,L2,V,T. L1 ≡[ⓑ{a,I}V.T, 0] L2 → + L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V. +/2 width=2 by llpx_sn_fwd_bind_O_dx/ qed-. + +(* Properties on relocation *************************************************) + +lemma lleq_lift_le: ∀K1,K2,T,dt. K1 ≡[T, dt] K2 → + ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀U. ⇧[d, e] T ≡ U → dt ≤ d → L1 ≡[U, dt] L2. +/3 width=10 by llpx_sn_lift_le, lift_mono/ qed-. + +lemma lleq_lift_ge: ∀K1,K2,T,dt. K1 ≡[T, dt] K2 → + ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀U. ⇧[d, e] T ≡ U → d ≤ dt → L1 ≡[U, dt+e] L2. +/2 width=9 by llpx_sn_lift_ge/ qed-. + +(* Inversion lemmas on relocation *******************************************) + +lemma lleq_inv_lift_le: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → dt ≤ d → K1 ≡[T, dt] K2. +/3 width=10 by llpx_sn_inv_lift_le, ex2_intro/ qed-. + +lemma lleq_inv_lift_be: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → d ≤ dt → dt ≤ yinj d + e → K1 ≡[T, d] K2. +/2 width=11 by llpx_sn_inv_lift_be/ qed-. + +lemma lleq_inv_lift_ge: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → yinj d + e ≤ dt → K1 ≡[T, dt-e] K2. +/2 width=9 by llpx_sn_inv_lift_ge/ qed-. + +(* Inversion lemmas on negated lazy quivalence for local environments *******) + +lemma nlleq_inv_bind: ∀a,I,L1,L2,V,T,d. (L1 ≡[ⓑ{a,I}V.T, d] L2 → ⊥) → + (L1 ≡[V, d] L2 → ⊥) ∨ (L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → ⊥). +/3 width=2 by nllpx_sn_inv_bind, eq_term_dec/ qed-. + +lemma nlleq_inv_flat: ∀I,L1,L2,V,T,d. (L1 ≡[ⓕ{I}V.T, d] L2 → ⊥) → + (L1 ≡[V, d] L2 → ⊥) ∨ (L1 ≡[T, d] L2 → ⊥). +/3 width=2 by nllpx_sn_inv_flat, eq_term_dec/ qed-. + +lemma nlleq_inv_bind_O: ∀a,I,L1,L2,V,T. (L1 ≡[ⓑ{a,I}V.T, 0] L2 → ⊥) → + (L1 ≡[V, 0] L2 → ⊥) ∨ (L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → ⊥). +/3 width=2 by nllpx_sn_inv_bind_O, eq_term_dec/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_leq.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_leq.ma new file mode 100644 index 000000000..ea04da02c --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_leq.ma @@ -0,0 +1,36 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/llpx_sn_leq.ma". +include "basic_2/multiple/lleq.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Properties on equivalence for local environments *************************) + +lemma leq_lleq_trans: ∀L2,L,T,d. L2 ≡[T, d] L → + ∀L1. L1 ≃[d, ∞] L2 → L1 ≡[T, d] L. +/2 width=3 by leq_llpx_sn_trans/ qed-. + +lemma lleq_leq_trans: ∀L,L1,T,d. L ≡[T, d] L1 → + ∀L2. L1 ≃[d, ∞] L2 → L ≡[T, d] L2. +/2 width=3 by llpx_sn_leq_trans/ qed-. + +lemma lleq_leq_repl: ∀L1,L2,T,d. L1 ≡[T, d] L2 → ∀K1. K1 ≃[d, ∞] L1 → + ∀K2. L2 ≃[d, ∞] K2 → K1 ≡[T, d] K2. +/2 width=5 by llpx_sn_leq_repl/ qed-. + +lemma lleq_bind_repl_SO: ∀I1,I2,L1,L2,V1,V2,T. L1.ⓑ{I1}V1 ≡[T, 0] L2.ⓑ{I2}V2 → + ∀J1,J2,W1,W2. L1.ⓑ{J1}W1 ≡[T, 1] L2.ⓑ{J2}W2. +/2 width=5 by llpx_sn_bind_repl_SO/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_lleq.ma new file mode 100644 index 000000000..8d49cb591 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_lleq.ma @@ -0,0 +1,32 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/lleq_ldrop.ma". + +(* Main properties **********************************************************) + +theorem lleq_trans: ∀d,T. Transitive … (lleq d T). +/2 width=3 by lleq_llpx_sn_trans/ qed-. + +theorem lleq_canc_sn: ∀L,L1,L2,T,d. L ≡[d, T] L1→ L ≡[d, T] L2 → L1 ≡[d, T] L2. +/3 width=3 by lleq_trans, lleq_sym/ qed-. + +theorem lleq_canc_dx: ∀L1,L2,L,T,d. L1 ≡[d, T] L → L2 ≡[d, T] L → L1 ≡[d, T] L2. +/3 width=3 by lleq_trans, lleq_sym/ qed-. + +(* Note: lleq_nlleq_trans: ∀d,T,L1,L. L1≡[T, d] L → + ∀L2. (L ≡[T, d] L2 → ⊥) → (L1 ≡[T, d] L2 → ⊥). +/3 width=3 by lleq_canc_sn/ qed-. +works with /4 width=8/ so lleq_canc_sn is more convenient +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_llor.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_llor.ma new file mode 100644 index 000000000..2a31fece3 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/lleq_llor.ma @@ -0,0 +1,34 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/llor.ma". +include "basic_2/multiple/lleq_alt.ma". + +(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) + +(* Properties on poinwise union for local environments **********************) + +lemma llpx_sn_llor_dx: ∀R,L1,L2. + (∀U,i. L2 ⊢ i ϵ 𝐅*[0]⦃U⦄ → L1 ⊢ i ϵ 𝐅*[0]⦃U⦄) → + ∀T. llpx_sn R 0 T L1 L2 → ∀L. L1 ⩖[T] L2 ≡ L → L2 ≡[T, 0] L. +#R #L1 #L2 #HR #T #H1 #L #H2 +elim (llpx_sn_llpx_sn_alt … H1) -H1 #HL12 #IH1 +elim H2 -H2 #_ #HL1 #IH2 +@lleq_intro_alt // #I2 #I #K2 #K #V2 #V #i #Hi #HnT #HLK2 #HLK +lapply (ldrop_fwd_length_lt2 … HLK) #HiL +elim (ldrop_O1_lt (Ⓕ) L1 i) // -HiL #I1 #K1 #V1 #HLK1 +elim (IH1 … HLK1 HLK2) -IH1 /2 width=1 by/ #H #_ destruct +elim (IH2 … HLK1 HLK2 HLK) -IH2 -HLK1 -HLK2 -HLK * /2 width=1 by conj/ #H +elim H -H /2 width=1 by/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llor.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llor.ma new file mode 100644 index 000000000..eda4c00d6 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llor.ma @@ -0,0 +1,38 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/lazyor_4.ma". +include "basic_2/multiple/frees.ma". + +(* POINTWISE UNION FOR LOCAL ENVIRONMENTS ***********************************) + +definition llor: relation4 term lenv lenv lenv ≝ λT,L2,L1,L. + ∧∧ |L1| ≤ |L2| & |L1| = |L| + & (∀I1,I2,I,K1,K2,K,V1,V2,V,i. + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → ⇩[i] L ≡ K.ⓑ{I}V → + (∧∧ (L1 ⊢ i ϵ 𝐅*[yinj 0]⦃T⦄ → ⊥) & I1 = I & V1 = V) ∨ + (∧∧ L1 ⊢ i ϵ 𝐅*[yinj 0]⦃T⦄ & I1 = I & V2 = V) + ). + +interpretation + "lazy union (local environment)" + 'LazyOr L1 T L2 L = (llor T L2 L1 L). + +(* Basic properties *********************************************************) + +lemma llor_atom: ∀T,L2. ⋆ ⩖[T] L2 ≡ ⋆. +#T #L2 @and3_intro // +#I1 #I2 #I #K1 #K2 #K #V1 #V2 #V #i #HLK1 +elim (ldrop_inv_atom1 … HLK1) -HLK1 #H destruct +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llor_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llor_ldrop.ma new file mode 100644 index 000000000..d8a4789b0 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llor_ldrop.ma @@ -0,0 +1,22 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/frees_lift.ma". +include "basic_2/multiple/llor.ma". + +(* POINTWISE UNION FOR LOCAL ENVIRONMENTS ***********************************) + +(* Advanced properties ******************************************************) + +axiom llor_total: ∀L1,L2,T. |L1| ≤ |L2| → ∃L. L1 ⩖[T] L2 ≡ L. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn.ma new file mode 100644 index 000000000..006abfec3 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn.ma @@ -0,0 +1,209 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "ground_2/ynat/ynat_plus.ma". +include "basic_2/substitution/ldrop.ma". + +(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) + +inductive llpx_sn (R:relation3 lenv term term): relation4 ynat term lenv lenv ≝ +| llpx_sn_sort: ∀L1,L2,d,k. |L1| = |L2| → llpx_sn R d (⋆k) L1 L2 +| llpx_sn_skip: ∀L1,L2,d,i. |L1| = |L2| → yinj i < d → llpx_sn R d (#i) L1 L2 +| llpx_sn_lref: ∀I,L1,L2,K1,K2,V1,V2,d,i. d ≤ yinj i → + ⇩[i] L1 ≡ K1.ⓑ{I}V1 → ⇩[i] L2 ≡ K2.ⓑ{I}V2 → + llpx_sn R (yinj 0) V1 K1 K2 → R K1 V1 V2 → llpx_sn R d (#i) L1 L2 +| llpx_sn_free: ∀L1,L2,d,i. |L1| ≤ i → |L2| ≤ i → |L1| = |L2| → llpx_sn R d (#i) L1 L2 +| llpx_sn_gref: ∀L1,L2,d,p. |L1| = |L2| → llpx_sn R d (§p) L1 L2 +| llpx_sn_bind: ∀a,I,L1,L2,V,T,d. + llpx_sn R d V L1 L2 → llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → + llpx_sn R d (ⓑ{a,I}V.T) L1 L2 +| llpx_sn_flat: ∀I,L1,L2,V,T,d. + llpx_sn R d V L1 L2 → llpx_sn R d T L1 L2 → llpx_sn R d (ⓕ{I}V.T) L1 L2 +. + +(* Basic inversion lemmas ***************************************************) + +fact llpx_sn_inv_bind_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → + ∀a,I,V,T. X = ⓑ{a,I}V.T → + llpx_sn R d V L1 L2 ∧ llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). +#R #L1 #L2 #X #d * -L1 -L2 -X -d +[ #L1 #L2 #d #k #_ #b #J #W #U #H destruct +| #L1 #L2 #d #i #_ #_ #b #J #W #U #H destruct +| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #_ #_ #_ #_ #b #J #W #U #H destruct +| #L1 #L2 #d #i #_ #_ #_ #b #J #W #U #H destruct +| #L1 #L2 #d #p #_ #b #J #W #U #H destruct +| #a #I #L1 #L2 #V #T #d #HV #HT #b #J #W #U #H destruct /2 width=1 by conj/ +| #I #L1 #L2 #V #T #d #_ #_ #b #J #W #U #H destruct +] +qed-. + +lemma llpx_sn_inv_bind: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → + llpx_sn R d V L1 L2 ∧ llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). +/2 width=4 by llpx_sn_inv_bind_aux/ qed-. + +fact llpx_sn_inv_flat_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → + ∀I,V,T. X = ⓕ{I}V.T → + llpx_sn R d V L1 L2 ∧ llpx_sn R d T L1 L2. +#R #L1 #L2 #X #d * -L1 -L2 -X -d +[ #L1 #L2 #d #k #_ #J #W #U #H destruct +| #L1 #L2 #d #i #_ #_ #J #W #U #H destruct +| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #_ #_ #_ #_ #J #W #U #H destruct +| #L1 #L2 #d #i #_ #_ #_ #J #W #U #H destruct +| #L1 #L2 #d #p #_ #J #W #U #H destruct +| #a #I #L1 #L2 #V #T #d #_ #_ #J #W #U #H destruct +| #I #L1 #L2 #V #T #d #HV #HT #J #W #U #H destruct /2 width=1 by conj/ +] +qed-. + +lemma llpx_sn_inv_flat: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → + llpx_sn R d V L1 L2 ∧ llpx_sn R d T L1 L2. +/2 width=4 by llpx_sn_inv_flat_aux/ qed-. + +(* Basic forward lemmas *****************************************************) + +lemma llpx_sn_fwd_length: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → |L1| = |L2|. +#R #L1 #L2 #T #d #H elim H -L1 -L2 -T -d // +#I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #HLK1 #HLK2 #_ #_ #HK12 +lapply (ldrop_fwd_length … HLK1) -HLK1 +lapply (ldrop_fwd_length … HLK2) -HLK2 +normalize // +qed-. + +lemma llpx_sn_fwd_ldrop_sn: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → + ∀K1,i. ⇩[i] L1 ≡ K1 → ∃K2. ⇩[i] L2 ≡ K2. +#R #L1 #L2 #T #d #H #K1 #i #HLK1 lapply (llpx_sn_fwd_length … H) -H +#HL12 lapply (ldrop_fwd_length_le2 … HLK1) -HLK1 /2 width=1 by ldrop_O1_le/ +qed-. + +lemma llpx_sn_fwd_ldrop_dx: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → + ∀K2,i. ⇩[i] L2 ≡ K2 → ∃K1. ⇩[i] L1 ≡ K1. +#R #L1 #L2 #T #d #H #K2 #i #HLK2 lapply (llpx_sn_fwd_length … H) -H +#HL12 lapply (ldrop_fwd_length_le2 … HLK2) -HLK2 /2 width=1 by ldrop_O1_le/ +qed-. + +fact llpx_sn_fwd_lref_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → ∀i. X = #i → + ∨∨ |L1| ≤ i ∧ |L2| ≤ i + | yinj i < d + | ∃∃I,K1,K2,V1,V2. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & + ⇩[i] L2 ≡ K2.ⓑ{I}V2 & + llpx_sn R (yinj 0) V1 K1 K2 & + R K1 V1 V2 & d ≤ yinj i. +#R #L1 #L2 #X #d * -L1 -L2 -X -d +[ #L1 #L2 #d #k #_ #j #H destruct +| #L1 #L2 #d #i #_ #Hid #j #H destruct /2 width=1 by or3_intro1/ +| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #Hdi #HLK1 #HLK2 #HK12 #HV12 #j #H destruct + /3 width=9 by or3_intro2, ex5_5_intro/ +| #L1 #L2 #d #i #HL1 #HL2 #_ #j #H destruct /3 width=1 by or3_intro0, conj/ +| #L1 #L2 #d #p #_ #j #H destruct +| #a #I #L1 #L2 #V #T #d #_ #_ #j #H destruct +| #I #L1 #L2 #V #T #d #_ #_ #j #H destruct +] +qed-. + +lemma llpx_sn_fwd_lref: ∀R,L1,L2,d,i. llpx_sn R d (#i) L1 L2 → + ∨∨ |L1| ≤ i ∧ |L2| ≤ i + | yinj i < d + | ∃∃I,K1,K2,V1,V2. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & + ⇩[i] L2 ≡ K2.ⓑ{I}V2 & + llpx_sn R (yinj 0) V1 K1 K2 & + R K1 V1 V2 & d ≤ yinj i. +/2 width=3 by llpx_sn_fwd_lref_aux/ qed-. + +lemma llpx_sn_fwd_bind_sn: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → + llpx_sn R d V L1 L2. +#R #a #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_bind … H) -H // +qed-. + +lemma llpx_sn_fwd_bind_dx: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → + llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). +#R #a #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_bind … H) -H // +qed-. + +lemma llpx_sn_fwd_flat_sn: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → + llpx_sn R d V L1 L2. +#R #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_flat … H) -H // +qed-. + +lemma llpx_sn_fwd_flat_dx: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → + llpx_sn R d T L1 L2. +#R #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_flat … H) -H // +qed-. + +lemma llpx_sn_fwd_pair_sn: ∀R,I,L1,L2,V,T,d. llpx_sn R d (②{I}V.T) L1 L2 → + llpx_sn R d V L1 L2. +#R * /2 width=4 by llpx_sn_fwd_flat_sn, llpx_sn_fwd_bind_sn/ +qed-. + +(* Basic_properties *********************************************************) + +lemma llpx_sn_refl: ∀R. (∀L. reflexive … (R L)) → ∀T,L,d. llpx_sn R d T L L. +#R #HR #T #L @(f2_ind … rfw … L T) -L -T +#n #IH #L * * /3 width=1 by llpx_sn_sort, llpx_sn_gref, llpx_sn_bind, llpx_sn_flat/ +#i #Hn elim (lt_or_ge i (|L|)) /2 width=1 by llpx_sn_free/ +#HiL #d elim (ylt_split i d) /2 width=1 by llpx_sn_skip/ +elim (ldrop_O1_lt … HiL) -HiL destruct /4 width=9 by llpx_sn_lref, ldrop_fwd_rfw/ +qed-. + +lemma llpx_sn_Y: ∀R,T,L1,L2. |L1| = |L2| → llpx_sn R (∞) T L1 L2. +#R #T #L1 @(f2_ind … rfw … L1 T) -L1 -T +#n #IH #L1 * * /3 width=1 by llpx_sn_sort, llpx_sn_skip, llpx_sn_gref, llpx_sn_flat/ +#a #I #V1 #T1 #Hn #L2 #HL12 +@llpx_sn_bind /2 width=1/ (**) (* explicit constructor *) +@IH -IH // normalize /2 width=1 by eq_f2/ +qed-. + +lemma llpx_sn_ge_up: ∀R,L1,L2,U,dt. llpx_sn R dt U L1 L2 → ∀T,d,e. ⇧[d, e] T ≡ U → + dt ≤ d + e → llpx_sn R d U L1 L2. +#R #L1 #L2 #U #dt #H elim H -L1 -L2 -U -dt +[ #L1 #L2 #dt #k #HL12 #X #d #e #H #_ >(lift_inv_sort2 … H) -H /2 width=1 by llpx_sn_sort/ +| #L1 #L2 #dt #i #HL12 #Hidt #X #d #e #H #Hdtde + elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=1 by llpx_sn_skip, ylt_inj/ -HL12 + elim (ylt_yle_false … Hidt) -Hidt + @(yle_trans … Hdtde) /2 width=1 by yle_inj/ (**) (* full auto too slow 11s *) +| #I #L1 #L2 #K1 #K2 #W1 #W2 #dt #i #Hdti #HLK1 #HLK2 #HW1 #HW12 #_ #X #d #e #H #_ + elim (lift_inv_lref2 … H) -H * #Hid #H destruct + [ lapply (llpx_sn_fwd_length … HW1) -HW1 #HK12 + lapply (ldrop_fwd_length … HLK1) lapply (ldrop_fwd_length … HLK2) + normalize in ⊢ (%→%→?); -I -W1 -W2 -dt /3 width=1 by llpx_sn_skip, ylt_inj/ + | /4 width=9 by llpx_sn_lref, yle_inj, le_plus_b/ + ] +| /2 width=1 by llpx_sn_free/ +| #L1 #L2 #dt #p #HL12 #X #d #e #H #_ >(lift_inv_gref2 … H) -H /2 width=1 by llpx_sn_gref/ +| #a #I #L1 #L2 #W #U #dt #_ #_ #IHV #IHT #X #d #e #H #Hdtde destruct + elim (lift_inv_bind2 … H) -H #V #T #HVW >commutative_plus #HTU #H destruct + @(llpx_sn_bind) /2 width=4 by/ (**) (* full auto fails *) + @(IHT … HTU) /2 width=1 by yle_succ/ +| #I #L1 #L2 #W #U #dt #_ #_ #IHV #IHT #X #d #e #H #Hdtde destruct + elim (lift_inv_flat2 … H) -H #HVW #HTU #H destruct + /3 width=4 by llpx_sn_flat/ +] +qed-. + +(**) (* the minor premise comes first *) +lemma llpx_sn_ge: ∀R,L1,L2,T,d1,d2. d1 ≤ d2 → + llpx_sn R d1 T L1 L2 → llpx_sn R d2 T L1 L2. +#R #L1 #L2 #T #d1 #d2 * -d1 -d2 (**) (* destructed yle *) +/3 width=6 by llpx_sn_ge_up, llpx_sn_Y, llpx_sn_fwd_length, yle_inj/ +qed-. + +lemma llpx_sn_bind_O: ∀R,a,I,L1,L2,V,T. llpx_sn R 0 V L1 L2 → + llpx_sn R 0 T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → + llpx_sn R 0 (ⓑ{a,I}V.T) L1 L2. +/3 width=3 by llpx_sn_ge, llpx_sn_bind/ qed-. + +lemma llpx_sn_co: ∀R1,R2. (∀L,T1,T2. R1 L T1 T2 → R2 L T1 T2) → + ∀L1,L2,T,d. llpx_sn R1 d T L1 L2 → llpx_sn R2 d T L1 L2. +#R1 #R2 #HR12 #L1 #L2 #T #d #H elim H -L1 -L2 -T -d +/3 width=9 by llpx_sn_sort, llpx_sn_skip, llpx_sn_lref, llpx_sn_free, llpx_sn_gref, llpx_sn_bind, llpx_sn_flat/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_alt.ma new file mode 100644 index 000000000..247d4207d --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_alt.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/multiple/frees.ma". +include "basic_2/multiple/llpx_sn_alt_rec.ma". + +(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) + +(* alternative definition of llpx_sn (not recursive) *) +definition llpx_sn_alt: relation3 lenv term term → relation4 ynat term lenv lenv ≝ + λR,d,T,L1,L2. |L1| = |L2| ∧ + (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ R K1 V1 V2 + ). + +(* Main properties **********************************************************) + +theorem llpx_sn_llpx_sn_alt: ∀R,T,L1,L2,d. llpx_sn R d T L1 L2 → llpx_sn_alt R d T L1 L2. +#R #U #L1 @(f2_ind … rfw … L1 U) -L1 -U +#n #IHn #L1 #U #Hn #L2 #d #H elim (llpx_sn_inv_alt_r … H) -H +#HL12 #IHU @conj // +#I1 #I2 #K1 #K2 #V1 #V2 #i #Hdi #H #HLK1 #HLK2 elim (frees_inv … H) -H +[ -n #HnU elim (IHU … HnU HLK1 HLK2) -IHU -HnU -HLK1 -HLK2 /2 width=1 by conj/ +| * #J1 #K10 #W10 #j #Hdj #Hji #HnU #HLK10 #HnW10 destruct + lapply (ldrop_fwd_drop2 … HLK10) #H + lapply (ldrop_conf_ge … H … HLK1 ?) -H /2 width=1 by lt_to_le/ (minus_plus_m_m j (i+1)) in ⊢ (%→?); >commutative_plus (lift_inv_sort1 … H) -X + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d + /2 width=1 by llpx_sn_sort/ +| #K1 #K2 #d0 #i #HK12 #Hid0 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H + * #Hdi #H destruct + [ lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d + /2 width=1 by llpx_sn_skip/ + | elim (ylt_yle_false … Hid0) -L1 -L2 -K1 -K2 -e -Hid0 + /3 width=3 by yle_trans, yle_inj/ + ] +| #I #K1 #K2 #K11 #K22 #V1 #V2 #d0 #i #Hid0 #HK11 #HK22 #HK12 #HV12 #IHK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H + * #Hdi #H destruct [ -HK12 | -IHK12 ] + [ elim (ldrop_trans_lt … HLK1 … HK11) // -K1 + elim (ldrop_trans_lt … HLK2 … HK22) // -Hdi -K2 + /3 width=18 by llpx_sn_lref/ + | lapply (ldrop_trans_ge_comm … HLK1 … HK11 ?) // -K1 + lapply (ldrop_trans_ge_comm … HLK2 … HK22 ?) // -Hdi -Hd0 -K2 + /3 width=9 by llpx_sn_lref, yle_plus_dx1_trans/ + ] +| #K1 #K2 #d0 #i #HK1 #HK2 #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H + * #Hid #H destruct + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -HK12 + [ /3 width=7 by llpx_sn_free, ldrop_fwd_be/ + | lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1 + lapply (ldrop_fwd_length … HLK2) -HLK2 #HLK2 + @llpx_sn_free [ >HLK1 | >HLK2 ] -Hid -HLK1 -HLK2 /2 width=1 by monotonic_le_plus_r/ (**) (* explicit constructor *) + ] +| #K1 #K2 #d0 #p #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref1 … H) -X + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d -e + /2 width=1 by llpx_sn_gref/ +| #a #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind1 … H) -H + #W #U #HVW #HTU #H destruct /4 width=6 by llpx_sn_bind, ldrop_skip, yle_succ/ +| #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat1 … H) -H + #W #U #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ +] +qed-. + +lemma llpx_sn_lift_ge: ∀R,K1,K2,T,d0. llpx_sn R d0 T K1 K2 → + ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀U. ⇧[d, e] T ≡ U → d ≤ d0 → llpx_sn R (d0+e) U L1 L2. +#R #K1 #K2 #T #d0 #H elim H -K1 -K2 -T -d0 +[ #K1 #K2 #d0 #k #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort1 … H) -X + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d + /2 width=1 by llpx_sn_sort/ +| #K1 #K2 #d0 #i #HK12 #Hid0 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ elim (lift_inv_lref1 … H) -H + * #_ #H destruct + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 + [ /3 width=3 by llpx_sn_skip, ylt_plus_dx2_trans/ + | /3 width=3 by llpx_sn_skip, monotonic_ylt_plus_dx/ + ] +| #I #K1 #K2 #K11 #K22 #V1 #V2 #d0 #i #Hid0 #HK11 #HK22 #HK12 #HV12 #_ #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H + * #Hid #H destruct + [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K1 -K2 -K11 -K22 -V1 -V2 -e -Hid0 + /3 width=3 by ylt_yle_trans, ylt_inj/ + | lapply (ldrop_trans_ge_comm … HLK1 … HK11 ?) // -K1 + lapply (ldrop_trans_ge_comm … HLK2 … HK22 ?) // -Hid -Hd0 -K2 + /3 width=9 by llpx_sn_lref, monotonic_yle_plus_dx/ + ] +| #K1 #K2 #d0 #i #HK1 #HK2 #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H + * #Hid #H destruct + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -HK12 + [ /3 width=7 by llpx_sn_free, ldrop_fwd_be/ + | lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1 + lapply (ldrop_fwd_length … HLK2) -HLK2 #HLK2 + @llpx_sn_free [ >HLK1 | >HLK2 ] -Hid -HLK1 -HLK2 /2 width=1 by monotonic_le_plus_r/ (**) (* explicit constructor *) + ] +| #K1 #K2 #d0 #p #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref1 … H) -X + lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d + /2 width=1 by llpx_sn_gref/ +| #a #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind1 … H) -H + #W #U #HVW #HTU #H destruct /4 width=5 by llpx_sn_bind, ldrop_skip, yle_succ/ +| #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat1 … H) -H + #W #U #HVW #HTU #H destruct /3 width=5 by llpx_sn_flat/ +] +qed-. + +(* Inversion lemmas on relocation *******************************************) + +lemma llpx_sn_inv_lift_le: ∀R. l_deliftable_sn R → + ∀L1,L2,U,d0. llpx_sn R d0 U L1 L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → d0 ≤ d → llpx_sn R d0 T K1 K2. +#R #HR #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 +[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d -e + /2 width=1 by llpx_sn_sort/ +| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ elim (lift_inv_lref2 … H) -H + * #_ #H destruct + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 + [ /2 width=1 by llpx_sn_skip/ + | /3 width=3 by llpx_sn_skip, yle_ylt_trans/ + ] +| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #IHK12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref2 … H) -H + * #Hid #H destruct [ -HK12 | -IHK12 ] + [ elim (ldrop_conf_lt … HLK1 … HLK11) // -L1 #L1 #V1 #HKL1 #HKL11 #HVW1 + elim (ldrop_conf_lt … HLK2 … HLK22) // -Hid -L2 #L2 #V2 #HKL2 #HKL22 #HVW2 + elim (HR … HW12 … HKL11 … HVW1) -HR #V0 #HV0 #HV12 + lapply (lift_inj … HV0 … HVW2) -HV0 -HVW2 #H destruct + /3 width=10 by llpx_sn_lref/ + | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 + lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hid0 + elim (le_inv_plus_l … Hid) -Hid /4 width=9 by llpx_sn_lref, yle_trans, yle_inj/ (**) (* slow *) + ] +| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref2 … H) -H + * #_ #H destruct + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) + [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 + lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 + #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) + | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H + lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H + /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ + ] +| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d -e + /2 width=1 by llpx_sn_gref/ +| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind2 … H) -H + #V #T #HVW #HTU #H destruct /4 width=6 by llpx_sn_bind, ldrop_skip, yle_succ/ +| #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat2 … H) -H + #V #T #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ +] +qed-. + +lemma llpx_sn_inv_lift_be: ∀R,L1,L2,U,d0. llpx_sn R d0 U L1 L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → d ≤ d0 → d0 ≤ yinj d + e → llpx_sn R d T K1 K2. +#R #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 +[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ #_ >(lift_inv_sort2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d0 -e + /2 width=1 by llpx_sn_sort/ +| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H + * #Hid #H destruct + [ lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 + -Hid0 /3 width=1 by llpx_sn_skip, ylt_inj/ + | elim (ylt_yle_false … Hid0) -L1 -L2 -Hd0 -Hid0 + /3 width=3 by yle_trans, yle_inj/ (**) (* slow *) + ] +| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #_ #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H + * #Hid #H destruct + [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K11 -K22 -W1 -W2 -Hd0e -Hid0 + /3 width=3 by ylt_yle_trans, ylt_inj/ + | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 + lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hid0 -Hd0 -Hd0e + elim (le_inv_plus_l … Hid) -Hid /3 width=9 by llpx_sn_lref, yle_inj/ + ] +| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H + * #_ #H destruct + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) + [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 + lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 + #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) + | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H + lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H + /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ + ] +| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ #_ >(lift_inv_gref2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d0 -e + /2 width=1 by llpx_sn_gref/ +| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_bind2 … H) -H + >commutative_plus #V #T #HVW #HTU #H destruct + @llpx_sn_bind [ /2 width=5 by/ ] -IHW (**) (* explicit constructor *) + @(IHU … HTU) -IHU -HTU /2 width=1 by ldrop_skip, yle_succ/ +| #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_flat2 … H) -H + #V #T #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ +] +qed-. + +lemma llpx_sn_inv_lift_ge: ∀R,L1,L2,U,d0. llpx_sn R d0 U L1 L2 → + ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → + ∀T. ⇧[d, e] T ≡ U → yinj d + e ≤ d0 → llpx_sn R (d0-e) T K1 K2. +#R #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 +[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d + /2 width=1 by llpx_sn_sort/ +| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H + * #Hid #H destruct [ -Hid0 | -Hded0 ] + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 + [ /4 width=3 by llpx_sn_skip, yle_plus1_to_minus_inj2, ylt_yle_trans, ylt_inj/ + | elim (le_inv_plus_l … Hid) -Hid #_ + /4 width=1 by llpx_sn_skip, monotonic_ylt_minus_dx, yle_inj/ + ] +| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #_ #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H + * #Hid #H destruct + [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K11 -K22 -W1 -W2 -Hid0 + /3 width=3 by yle_fwd_plus_sn1, ylt_yle_trans, ylt_inj/ + | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 + lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hded0 -Hid + /3 width=9 by llpx_sn_lref, monotonic_yle_minus_dx/ + ] +| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H + * #_ #H destruct + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) + [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 + lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 + #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) + | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H + lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H + /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ + ] +| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref2 … H) -X + lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d + /2 width=1 by llpx_sn_gref/ +| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_bind2 … H) -H + #V #T #HVW #HTU #H destruct + @llpx_sn_bind [ /2 width=5 by/ ] -IHW (**) (* explicit constructor *) + yminus_Y_inj #K1 #HK12 #HLK1 + lapply (leq_inv_O_Y … HK12) -HK12 #H destruct /2 width=9 by llpx_sn_lref/ +| /4 width=5 by llpx_sn_free, leq_fwd_length, le_repl_sn_trans_aux, trans_eq/ +| /4 width=1 by llpx_sn_bind, leq_succ/ +] +qed-. + +lemma llpx_sn_leq_trans: ∀R,L,L1,T,d. llpx_sn R d T L L1 → + ∀L2. L1 ≃[d, ∞] L2 → llpx_sn R d T L L2. +#R #L #L1 #T #d #H elim H -L -L1 -T -d +/4 width=5 by llpx_sn_flat, llpx_sn_gref, llpx_sn_skip, llpx_sn_sort, leq_fwd_length, trans_eq/ +[ #I #L #L1 #K #K1 #V #V1 #d #i #Hdi #HLK #HLK1 #HK1 #HV1 #_ #L2 #HL12 + elim (leq_ldrop_conf_be … HL12 … HLK1) -L1 // >yminus_Y_inj #K2 #HK12 #HLK2 + lapply (leq_inv_O_Y … HK12) -HK12 #H destruct /2 width=9 by llpx_sn_lref/ +| /4 width=5 by llpx_sn_free, leq_fwd_length, le_repl_sn_conf_aux, trans_eq/ +| /4 width=1 by llpx_sn_bind, leq_succ/ +] +qed-. + +lemma llpx_sn_leq_repl: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → ∀K1. K1 ≃[d, ∞] L1 → + ∀K2. L2 ≃[d, ∞] K2 → llpx_sn R d T K1 K2. +/3 width=4 by llpx_sn_leq_trans, leq_llpx_sn_trans/ qed-. + +lemma llpx_sn_bind_repl_SO: ∀R,I1,I2,L1,L2,V1,V2,T. llpx_sn R 0 T (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) → + ∀J1,J2,W1,W2. llpx_sn R 1 T (L1.ⓑ{J1}W1) (L2.ⓑ{J2}W2). +#R #I1 #I2 #L1 #L2 #V1 #V2 #T #HT #J1 #J2 #W1 #W2 lapply (llpx_sn_ge R … 1 … HT) -HT +/3 width=7 by llpx_sn_leq_repl, leq_succ/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_llor.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_llor.ma new file mode 100644 index 000000000..4828b7b75 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_llor.ma @@ -0,0 +1,34 @@ +(**************************************************************************) +(* ___ *) +(* ||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/lpx_sn_alt.ma". +include "basic_2/multiple/llor.ma". +include "basic_2/multiple/lleq_alt.ma". + +(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) + +(* Inversion lemmas on poinwise union for local environments ****************) + +lemma llpx_sn_llor_fwd_sn: ∀R. (∀L. reflexive … (R L)) → + ∀L1,L2,T. llpx_sn R 0 T L1 L2 → + ∀L. L1 ⩖[T] L2 ≡ L → lpx_sn R L1 L. +#R #HR #L1 #L2 #T #H1 #L #H2 +elim (llpx_sn_llpx_sn_alt … H1) -H1 #HL12 #IH1 +elim H2 -H2 #_ #HL1 #IH2 +@lpx_sn_intro_alt // #I1 #I #K1 #K #V1 #V #i #HLK1 #HLK +lapply (ldrop_fwd_length_lt2 … HLK) #HiL +elim (ldrop_O1_lt (Ⓕ) L2 i) // -HiL -HL1 -HL12 #I2 #K2 #V2 #HLK2 +elim (IH2 … HLK1 HLK2 HLK) -IH2 -HLK * [ /2 width=1 by conj/ ] +#HnT #H1 #H2 elim (IH1 … HnT … HLK1 HLK2) -IH1 -HnT -HLK1 -HLK2 /2 width=1 by conj/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_lpx_sn.ma new file mode 100644 index 000000000..5b1a94f95 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_lpx_sn.ma @@ -0,0 +1,38 @@ +(**************************************************************************) +(* ___ *) +(* ||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/lpx_sn_ldrop.ma". +include "basic_2/multiple/llpx_sn.ma". + +(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) + +(* Properties on pointwise extensions ***************************************) + +lemma lpx_sn_llpx_sn: ∀R. (∀L. reflexive … (R L)) → + ∀T,L1,L2,d. lpx_sn R L1 L2 → llpx_sn R d T L1 L2. +#R #HR #T #L1 @(f2_ind … rfw … L1 T) -L1 -T +#n #IH #L1 * * +[ -HR -IH /4 width=2 by lpx_sn_fwd_length, llpx_sn_sort/ +| -HR #i elim (lt_or_ge i (|L1|)) + [2: -IH /4 width=4 by lpx_sn_fwd_length, llpx_sn_free, le_repl_sn_conf_aux/ ] + #Hi #Hn #L2 #d elim (ylt_split i d) + [ -n /3 width=2 by llpx_sn_skip, lpx_sn_fwd_length/ ] + #Hdi #HL12 elim (ldrop_O1_lt (Ⓕ) L1 i) // + #I #K1 #V1 #HLK1 elim (lpx_sn_ldrop_conf … HL12 … HLK1) -HL12 + /4 width=9 by llpx_sn_lref, ldrop_fwd_rfw/ +| -HR -IH /4 width=2 by lpx_sn_fwd_length, llpx_sn_gref/ +| /4 width=1 by llpx_sn_bind, lpx_sn_pair/ +| -HR /3 width=1 by llpx_sn_flat/ +] +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_tc.ma b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_tc.ma new file mode 100644 index 000000000..b308db740 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/multiple/llpx_sn_tc.ma @@ -0,0 +1,26 @@ +(**************************************************************************) +(* ___ *) +(* ||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/multiple/llpx_sn_ldrop.ma". + +(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) + +(* Properties about transitive closure **************************************) + +lemma llpx_sn_TC_pair_dx: ∀R. (∀L. reflexive … (R L)) → + ∀I,L,V1,V2,T. LTC … R L V1 V2 → + LTC … (llpx_sn R 0) T (L.ⓑ{I}V1) (L.ⓑ{I}V2). +#R #HR #I #L #V1 #V2 #T #H @(TC_star_ind … V2 H) -V2 +/4 width=9 by llpx_sn_bind_repl_O, llpx_sn_refl, step, inj/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_lift.ma index 36c349e4e..72cb5ad83 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/reduction/cpr.ma". (* CONTEXT-SENSITIVE PARALLEL REDUCTION FOR TERMS ***************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_llpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_llpx_sn.ma index ec085821e..4f3f051f7 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_llpx_sn.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpr_llpx_sn.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/llpx_sn_ldrop.ma". +include "basic_2/multiple/llpx_sn_ldrop.ma". include "basic_2/reduction/cpr.ma". (* CONTEXT-SENSITIVE PARALLEL REDUCTION FOR TERMS ***************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_leq.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_leq.ma index cbc336500..664688f74 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_leq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_leq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_leq.ma". +include "basic_2/substitution/ldrop_leq.ma". include "basic_2/reduction/cpx.ma". (* CONTEXT-SENSITIVE EXTENDED PARALLEL REDUCTION FOR TERMS ******************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lift.ma index 1cd6da260..13c3b0cfb 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lift.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". -include "basic_2/substitution/fqus_alt.ma". +include "basic_2/substitution/ldrop_ldrop.ma". +include "basic_2/multiple/fqus_alt.ma". include "basic_2/static/ssta.ma". include "basic_2/reduction/cpx.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lleq.ma index 507aaef29..f21e35959 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_lleq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_ldrop.ma". +include "basic_2/multiple/lleq_ldrop.ma". include "basic_2/reduction/cpx_llpx_sn.ma". (* CONTEXT-SENSITIVE EXTENDED PARALLEL REDUCTION FOR TERMS ******************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_llpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_llpx_sn.ma index 285157b45..4d5843f91 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_llpx_sn.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/cpx_llpx_sn.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/llpx_sn_ldrop.ma". +include "basic_2/multiple/llpx_sn_ldrop.ma". include "basic_2/reduction/cpx.ma". (* CONTEXT-SENSITIVE EXTENDED PARALLEL REDUCTION FOR TERMS ******************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/crr.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/crr.ma index 9158a53af..c0525d6a9 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/crr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/crr.ma @@ -14,7 +14,7 @@ include "basic_2/notation/relations/predreducible_3.ma". include "basic_2/grammar/genv.ma". -include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/ldrop.ma". (* REDUCIBLE TERMS FOR CONTEXT-SENSITIVE REDUCTION **************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/crr_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/crr_lift.ma index ddb58a580..47ab90f65 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/crr_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/crr_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/reduction/crr.ma". (* REDUCIBLE TERMS FOR CONTEXT-SENSITIVE REDUCTION **************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/crx_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/crx_lift.ma index b1afecdc5..5c63129cc 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/crx_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/crx_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/reduction/crx.ma". (* REDUCIBLE TERMS FOR CONTEXT-SENSITIVE EXTENDED REDUCTION *****************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/fpb.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/fpb.ma index 71d7a0cb9..efe7c5e3d 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/fpb.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/fpb.ma @@ -13,8 +13,8 @@ (**************************************************************************) include "basic_2/notation/relations/btpred_8.ma". -include "basic_2/relocation/fquq.ma". -include "basic_2/substitution/lleq.ma". +include "basic_2/substitution/fquq.ma". +include "basic_2/multiple/lleq.ma". include "basic_2/reduction/lpx.ma". (* "BIG TREE" PARALLEL REDUCTION FOR CLOSURES *******************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr.ma index 01966eefb..f644a728f 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/predsn_3.ma". -include "basic_2/relocation/lpx_sn.ma". +include "basic_2/substitution/lpx_sn.ma". include "basic_2/reduction/cpr.ma". (* SN PARALLEL REDUCTION FOR LOCAL ENVIRONMENTS *****************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_ldrop.ma index 8f268af2e..d9b78dbf8 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_ldrop.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_ldrop.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/relocation/lpx_sn_ldrop.ma". -include "basic_2/relocation/fquq_alt.ma". +include "basic_2/substitution/lpx_sn_ldrop.ma". +include "basic_2/substitution/fquq_alt.ma". include "basic_2/reduction/cpr_lift.ma". include "basic_2/reduction/lpr.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_lpr.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_lpr.ma index ebf3d6406..1e4335511 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_lpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpr_lpr.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/relocation/lpx_sn_lpx_sn.ma". -include "basic_2/substitution/fqup.ma". +include "basic_2/substitution/lpx_sn_lpx_sn.ma". +include "basic_2/multiple/fqup.ma". include "basic_2/reduction/lpr_ldrop.ma". (* SN PARALLEL REDUCTION FOR LOCAL ENVIRONMENTS *****************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_frees.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_frees.ma index e303b8386..1458cf3fa 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_frees.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_frees.ma @@ -12,18 +12,12 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fqup.ma". -include "basic_2/substitution/frees_lift.ma". +include "basic_2/multiple/fqup.ma". +include "basic_2/multiple/frees_lift.ma". include "basic_2/reduction/lpx_ldrop.ma". (* SN EXTENDED PARALLEL REDUCTION FOR LOCAL ENVIRONMENTS ********************) (* -lemma yle_plus2_to_minus_inj2: ∀x,y:ynat. ∀z:nat. x ≤ y + z → x - z ≤ y. -/2 width=1 by monotonic_yle_minus_dx/ qed-. - -lemma yle_plus2_to_minus_inj1: ∀x,y:ynat. ∀z:nat. x ≤ z + y → x - z ≤ y. -/2 width=1 by yle_plus2_to_minus_inj2/ qed-. - lemma cofrees_lsuby_conf: ∀L1,U,i. L1 ⊢ i ~ϵ 𝐅*⦃U⦄ → ∀L2. lsuby L1 L2 → L2 ⊢ i ~ϵ 𝐅*⦃U⦄. /3 width=3 by lsuby_cpys_trans/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_ldrop.ma index 5097cc114..d4e0ac6bb 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_ldrop.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_ldrop.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/lpx_sn_ldrop.ma". +include "basic_2/substitution/lpx_sn_ldrop.ma". include "basic_2/reduction/cpx_lift.ma". include "basic_2/reduction/lpx.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_lleq.ma index ad6e23ee7..08918429b 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_lleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reduction/lpx_lleq.ma @@ -12,8 +12,8 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_leq.ma". -include "basic_2/substitution/lleq_ldrop.ma". +include "basic_2/multiple/lleq_leq.ma". +include "basic_2/multiple/lleq_ldrop.ma". include "basic_2/reduction/cpx_leq.ma". include "basic_2/reduction/lpx_ldrop.ma". diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy.ma deleted file mode 100644 index a1e538ae0..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy.ma +++ /dev/null @@ -1,296 +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 "ground_2/ynat/ynat_max.ma". -include "basic_2/notation/relations/psubst_6.ma". -include "basic_2/grammar/genv.ma". -include "basic_2/relocation/lsuby.ma". - -(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) - -(* activate genv *) -inductive cpy: ynat → ynat → relation4 genv lenv term term ≝ -| cpy_atom : ∀I,G,L,d,e. cpy d e G L (⓪{I}) (⓪{I}) -| cpy_subst: ∀I,G,L,K,V,W,i,d,e. d ≤ yinj i → i < d+e → - ⇩[i] L ≡ K.ⓑ{I}V → ⇧[0, i+1] V ≡ W → cpy d e G L (#i) W -| cpy_bind : ∀a,I,G,L,V1,V2,T1,T2,d,e. - cpy d e G L V1 V2 → cpy (⫯d) e G (L.ⓑ{I}V1) T1 T2 → - cpy d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) -| cpy_flat : ∀I,G,L,V1,V2,T1,T2,d,e. - cpy d e G L V1 V2 → cpy d e G L T1 T2 → - cpy d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) -. - -interpretation "context-sensitive extended ordinary substritution (term)" - 'PSubst G L T1 d e T2 = (cpy d e G L T1 T2). - -(* Basic properties *********************************************************) - -lemma lsuby_cpy_trans: ∀G,d,e. lsub_trans … (cpy d e G) (lsuby d e). -#G #d #e #L1 #T1 #T2 #H elim H -G -L1 -T1 -T2 -d -e -[ // -| #I #G #L1 #K1 #V #W #i #d #e #Hdi #Hide #HLK1 #HVW #L2 #HL12 - elim (lsuby_ldrop_trans_be … HL12 … HLK1) -HL12 -HLK1 /2 width=5 by cpy_subst/ -| /4 width=1 by lsuby_succ, cpy_bind/ -| /3 width=1 by cpy_flat/ -] -qed-. - -lemma cpy_refl: ∀G,T,L,d,e. ⦃G, L⦄ ⊢ T ▶[d, e] T. -#G #T elim T -T // * /2 width=1 by cpy_bind, cpy_flat/ -qed. - -(* Basic_1: was: subst1_ex *) -lemma cpy_full: ∀I,G,K,V,T1,L,d. ⇩[d] L ≡ K.ⓑ{I}V → - ∃∃T2,T. ⦃G, L⦄ ⊢ T1 ▶[d, 1] T2 & ⇧[d, 1] T ≡ T2. -#I #G #K #V #T1 elim T1 -T1 -[ * #i #L #d #HLK - /2 width=4 by lift_sort, lift_gref, ex2_2_intro/ - elim (lt_or_eq_or_gt i d) #Hid - /3 width=4 by lift_lref_ge_minus, lift_lref_lt, ex2_2_intro/ - destruct - elim (lift_total V 0 (i+1)) #W #HVW - elim (lift_split … HVW i i) - /4 width=5 by cpy_subst, ylt_inj, ex2_2_intro/ -| * [ #a ] #J #W1 #U1 #IHW1 #IHU1 #L #d #HLK - elim (IHW1 … HLK) -IHW1 #W2 #W #HW12 #HW2 - [ elim (IHU1 (L.ⓑ{J}W1) (d+1)) -IHU1 - /3 width=9 by cpy_bind, ldrop_drop, lift_bind, ex2_2_intro/ - | elim (IHU1 … HLK) -IHU1 -HLK - /3 width=8 by cpy_flat, lift_flat, ex2_2_intro/ - ] -] -qed-. - -lemma cpy_weak: ∀G,L,T1,T2,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T2 → - ∀d2,e2. d2 ≤ d1 → d1 + e1 ≤ d2 + e2 → - ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T2. -#G #L #T1 #T2 #d1 #e1 #H elim H -G -L -T1 -T2 -d1 -e1 // -[ /3 width=5 by cpy_subst, ylt_yle_trans, yle_trans/ -| /4 width=3 by cpy_bind, ylt_yle_trans, yle_succ/ -| /3 width=1 by cpy_flat/ -] -qed-. - -lemma cpy_weak_top: ∀G,L,T1,T2,d,e. - ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶[d, |L| - d] T2. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e // -[ #I #G #L #K #V #W #i #d #e #Hdi #_ #HLK #HVW - lapply (ldrop_fwd_length_lt2 … HLK) - /4 width=5 by cpy_subst, ylt_yle_trans, ylt_inj/ -| #a #I #G #L #V1 #V2 normalize in match (|L.ⓑ{I}V2|); (**) (* |?| does not work *) - /2 width=1 by cpy_bind/ -| /2 width=1 by cpy_flat/ -] -qed-. - -lemma cpy_weak_full: ∀G,L,T1,T2,d,e. - ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶[0, |L|] T2. -#G #L #T1 #T2 #d #e #HT12 -lapply (cpy_weak … HT12 0 (d + e) ? ?) -HT12 -/2 width=2 by cpy_weak_top/ -qed-. - -lemma cpy_split_up: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀i. i ≤ d + e → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d, i-d] T & ⦃G, L⦄ ⊢ T ▶[i, d+e-i] T2. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e -[ /2 width=3 by ex2_intro/ -| #I #G #L #K #V #W #i #d #e #Hdi #Hide #HLK #HVW #j #Hjde - elim (ylt_split i j) [ -Hide -Hjde | -Hdi ] - /4 width=9 by cpy_subst, ylt_yle_trans, ex2_intro/ -| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide - elim (IHV12 i) -IHV12 // #V - elim (IHT12 (i+1)) -IHT12 /2 width=1 by yle_succ/ -Hide - >yplus_SO2 >yplus_succ1 #T #HT1 #HT2 - lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 - /3 width=5 by lsuby_succ, ex2_intro, cpy_bind/ -| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide - elim (IHV12 i) -IHV12 // elim (IHT12 i) -IHT12 // -Hide - /3 width=5 by ex2_intro, cpy_flat/ -] -qed-. - -lemma cpy_split_down: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀i. i ≤ d + e → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[i, d+e-i] T & ⦃G, L⦄ ⊢ T ▶[d, i-d] T2. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e -[ /2 width=3 by ex2_intro/ -| #I #G #L #K #V #W #i #d #e #Hdi #Hide #HLK #HVW #j #Hjde - elim (ylt_split i j) [ -Hide -Hjde | -Hdi ] - /4 width=9 by cpy_subst, ylt_yle_trans, ex2_intro/ -| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide - elim (IHV12 i) -IHV12 // #V - elim (IHT12 (i+1)) -IHT12 /2 width=1 by yle_succ/ -Hide - >yplus_SO2 >yplus_succ1 #T #HT1 #HT2 - lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 - /3 width=5 by lsuby_succ, ex2_intro, cpy_bind/ -| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide - elim (IHV12 i) -IHV12 // elim (IHT12 i) -IHT12 // -Hide - /3 width=5 by ex2_intro, cpy_flat/ -] -qed-. - -(* Basic forward lemmas *****************************************************) - -lemma cpy_fwd_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀T1,d,e. ⇧[d, e] T1 ≡ U1 → - d ≤ dt → d + e ≤ dt + et → - ∃∃T2. ⦃G, L⦄ ⊢ U1 ▶[d+e, dt+et-(d+e)] U2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et -[ * #i #G #L #dt #et #T1 #d #e #H #_ - [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ - | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ - | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ - ] -| #I #G #L #K #V #W #i #dt #et #Hdti #Hidet #HLK #HVW #T1 #d #e #H #Hddt #Hdedet - elim (lift_inv_lref2 … H) -H * #Hid #H destruct [ -V -Hidet -Hdedet | -Hdti -Hddt ] - [ elim (ylt_yle_false … Hddt) -Hddt /3 width=3 by yle_ylt_trans, ylt_inj/ - | elim (le_inv_plus_l … Hid) #Hdie #Hei - elim (lift_split … HVW d (i-e+1) ? ? ?) [2,3,4: /2 width=1 by le_S_S, le_S/ ] -Hdie - #T2 #_ >plus_minus // ymax_pre_sn_comm // (**) (* explicit constructor *) - ] -| #a #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #X #d #e #H #Hddt #Hdedet - elim (lift_inv_bind2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct - elim (IHW12 … HVW1) -V1 -IHW12 // - elim (IHU12 … HTU1) -T1 -IHU12 /2 width=1 by yle_succ/ - yplus_SO2 >yplus_succ1 >yplus_succ1 - /3 width=2 by cpy_bind, lift_bind, ex2_intro/ -| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #X #d #e #H #Hddt #Hdedet - elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct - elim (IHW12 … HVW1) -V1 -IHW12 // elim (IHU12 … HTU1) -T1 -IHU12 - /3 width=2 by cpy_flat, lift_flat, ex2_intro/ -] -qed-. - -lemma cpy_fwd_tw: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ♯{T1} ≤ ♯{T2}. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e normalize -/3 width=1 by monotonic_le_plus_l, le_plus/ -qed-. - -(* Basic inversion lemmas ***************************************************) - -fact cpy_inv_atom1_aux: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀J. T1 = ⓪{J} → - T2 = ⓪{J} ∨ - ∃∃I,K,V,i. d ≤ yinj i & i < d + e & - ⇩[i] L ≡ K.ⓑ{I}V & - ⇧[O, i+1] V ≡ T2 & - J = LRef i. -#G #L #T1 #T2 #d #e * -G -L -T1 -T2 -d -e -[ #I #G #L #d #e #J #H destruct /2 width=1 by or_introl/ -| #I #G #L #K #V #T2 #i #d #e #Hdi #Hide #HLK #HVT2 #J #H destruct /3 width=9 by ex5_4_intro, or_intror/ -| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #H destruct -| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #H destruct -] -qed-. - -lemma cpy_inv_atom1: ∀I,G,L,T2,d,e. ⦃G, L⦄ ⊢ ⓪{I} ▶[d, e] T2 → - T2 = ⓪{I} ∨ - ∃∃J,K,V,i. d ≤ yinj i & i < d + e & - ⇩[i] L ≡ K.ⓑ{J}V & - ⇧[O, i+1] V ≡ T2 & - I = LRef i. -/2 width=4 by cpy_inv_atom1_aux/ qed-. - -(* Basic_1: was: subst1_gen_sort *) -lemma cpy_inv_sort1: ∀G,L,T2,k,d,e. ⦃G, L⦄ ⊢ ⋆k ▶[d, e] T2 → T2 = ⋆k. -#G #L #T2 #k #d #e #H -elim (cpy_inv_atom1 … H) -H // -* #I #K #V #i #_ #_ #_ #_ #H destruct -qed-. - -(* Basic_1: was: subst1_gen_lref *) -lemma cpy_inv_lref1: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶[d, e] T2 → - T2 = #i ∨ - ∃∃I,K,V. d ≤ i & i < d + e & - ⇩[i] L ≡ K.ⓑ{I}V & - ⇧[O, i+1] V ≡ T2. -#G #L #T2 #i #d #e #H -elim (cpy_inv_atom1 … H) -H /2 width=1 by or_introl/ -* #I #K #V #j #Hdj #Hjde #HLK #HVT2 #H destruct /3 width=5 by ex4_3_intro, or_intror/ -qed-. - -lemma cpy_inv_gref1: ∀G,L,T2,p,d,e. ⦃G, L⦄ ⊢ §p ▶[d, e] T2 → T2 = §p. -#G #L #T2 #p #d #e #H -elim (cpy_inv_atom1 … H) -H // -* #I #K #V #i #_ #_ #_ #_ #H destruct -qed-. - -fact cpy_inv_bind1_aux: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → - ∀a,I,V1,T1. U1 = ⓑ{a,I}V1.T1 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & - ⦃G, L. ⓑ{I}V1⦄ ⊢ T1 ▶[⫯d, e] T2 & - U2 = ⓑ{a,I}V2.T2. -#G #L #U1 #U2 #d #e * -G -L -U1 -U2 -d -e -[ #I #G #L #d #e #b #J #W1 #U1 #H destruct -| #I #G #L #K #V #W #i #d #e #_ #_ #_ #_ #b #J #W1 #U1 #H destruct -| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #HV12 #HT12 #b #J #W1 #U1 #H destruct /2 width=5 by ex3_2_intro/ -| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #b #J #W1 #U1 #H destruct -] -qed-. - -lemma cpy_inv_bind1: ∀a,I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓑ{a,I} V1. T1 ▶[d, e] U2 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & - ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶[⫯d, e] T2 & - U2 = ⓑ{a,I}V2.T2. -/2 width=3 by cpy_inv_bind1_aux/ qed-. - -fact cpy_inv_flat1_aux: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → - ∀I,V1,T1. U1 = ⓕ{I}V1.T1 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & - ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 & - U2 = ⓕ{I}V2.T2. -#G #L #U1 #U2 #d #e * -G -L -U1 -U2 -d -e -[ #I #G #L #d #e #J #W1 #U1 #H destruct -| #I #G #L #K #V #W #i #d #e #_ #_ #_ #_ #J #W1 #U1 #H destruct -| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #W1 #U1 #H destruct -| #I #G #L #V1 #V2 #T1 #T2 #d #e #HV12 #HT12 #J #W1 #U1 #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -lemma cpy_inv_flat1: ∀I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓕ{I} V1. T1 ▶[d, e] U2 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & - ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 & - U2 = ⓕ{I}V2.T2. -/2 width=3 by cpy_inv_flat1_aux/ qed-. - - -fact cpy_inv_refl_O2_aux: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → e = 0 → T1 = T2. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e -[ // -| #I #G #L #K #V #W #i #d #e #Hdi #Hide #_ #_ #H destruct - elim (ylt_yle_false … Hdi) -Hdi // -| /3 width=1 by eq_f2/ -| /3 width=1 by eq_f2/ -] -qed-. - -lemma cpy_inv_refl_O2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶[d, 0] T2 → T1 = T2. -/2 width=6 by cpy_inv_refl_O2_aux/ qed-. - -(* Basic_1: was: subst1_gen_lift_eq *) -lemma cpy_inv_lift1_eq: ∀G,T1,U1,d,e. ⇧[d, e] T1 ≡ U1 → - ∀L,U2. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → U1 = U2. -#G #T1 #U1 #d #e #HTU1 #L #U2 #HU12 elim (cpy_fwd_up … HU12 … HTU1) -HU12 -HTU1 -/2 width=4 by cpy_inv_refl_O2/ -qed-. - -(* Basic_1: removed theorems 25: - 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 -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_cpy.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_cpy.ma deleted file mode 100644 index 66b0487db..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_cpy.ma +++ /dev/null @@ -1,122 +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/relocation/cpy_lift.ma". - -(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) - -(* Main properties **********************************************************) - -(* Basic_1: was: subst1_confluence_eq *) -theorem cpy_conf_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶[d1, e1] T1 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶[d1, e1] T. -#G #L #T0 #T1 #d1 #e1 #H elim H -G -L -T0 -T1 -d1 -e1 -[ /2 width=3 by ex2_intro/ -| #I1 #G #L #K1 #V1 #T1 #i0 #d1 #e1 #Hd1 #Hde1 #HLK1 #HVT1 #T2 #d2 #e2 #H - elim (cpy_inv_lref1 … H) -H - [ #HX destruct /3 width=7 by cpy_subst, ex2_intro/ - | -Hd1 -Hde1 * #I2 #K2 #V2 #_ #_ #HLK2 #HVT2 - lapply (ldrop_mono … HLK1 … HLK2) -HLK1 -HLK2 #H destruct - >(lift_mono … HVT1 … HVT2) -HVT1 -HVT2 /2 width=3 by ex2_intro/ - ] -| #a #I #G #L #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #X #d2 #e2 #HX - elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - elim (IHV01 … HV02) -IHV01 -HV02 #V #HV1 #HV2 - elim (IHT01 … HT02) -T0 #T #HT1 #HT2 - lapply (lsuby_cpy_trans … HT1 (L.ⓑ{I}V1) ?) -HT1 /2 width=1 by lsuby_succ/ - lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V2) ?) -HT2 - /3 width=5 by cpy_bind, lsuby_succ, ex2_intro/ -| #I #G #L #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #X #d2 #e2 #HX - elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - elim (IHV01 … HV02) -V0 - elim (IHT01 … HT02) -T0 /3 width=5 by cpy_flat, ex2_intro/ -] -qed-. - -(* Basic_1: was: subst1_confluence_neq *) -theorem cpy_conf_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶[d1, e1] T1 → - ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶[d2, e2] T2 → - (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → - ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶[d1, e1] T. -#G #L1 #T0 #T1 #d1 #e1 #H elim H -G -L1 -T0 -T1 -d1 -e1 -[ /2 width=3 by ex2_intro/ -| #I1 #G #L1 #K1 #V1 #T1 #i0 #d1 #e1 #Hd1 #Hde1 #HLK1 #HVT1 #L2 #T2 #d2 #e2 #H1 #H2 - elim (cpy_inv_lref1 … H1) -H1 - [ #H destruct /3 width=7 by cpy_subst, ex2_intro/ - | -HLK1 -HVT1 * #I2 #K2 #V2 #Hd2 #Hde2 #_ #_ elim H2 -H2 #Hded [ -Hd1 -Hde2 | -Hd2 -Hde1 ] - [ elim (ylt_yle_false … Hde1) -Hde1 /2 width=3 by yle_trans/ - | elim (ylt_yle_false … Hde2) -Hde2 /2 width=3 by yle_trans/ - ] - ] -| #a #I #G #L1 #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #L2 #X #d2 #e2 #HX #H - elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - elim (IHV01 … HV02 H) -IHV01 -HV02 #V #HV1 #HV2 - elim (IHT01 … HT02) -T0 - [ -H #T #HT1 #HT2 - lapply (lsuby_cpy_trans … HT1 (L2.ⓑ{I}V1) ?) -HT1 /2 width=1 by lsuby_succ/ - lapply (lsuby_cpy_trans … HT2 (L1.ⓑ{I}V2) ?) -HT2 /3 width=5 by cpy_bind, lsuby_succ, ex2_intro/ - | -HV1 -HV2 elim H -H /3 width=1 by yle_succ, or_introl, or_intror/ - ] -| #I #G #L1 #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #L2 #X #d2 #e2 #HX #H - elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - elim (IHV01 … HV02 H) -V0 - elim (IHT01 … HT02 H) -T0 -H /3 width=5 by cpy_flat, ex2_intro/ -] -qed-. - -(* Note: the constant 1 comes from cpy_subst *) -(* Basic_1: was: subst1_trans *) -theorem cpy_trans_ge: ∀G,L,T1,T0,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T0 → - ∀T2. ⦃G, L⦄ ⊢ T0 ▶[d, 1] T2 → 1 ≤ e → ⦃G, L⦄ ⊢ T1 ▶[d, e] T2. -#G #L #T1 #T0 #d #e #H elim H -G -L -T1 -T0 -d -e -[ #I #G #L #d #e #T2 #H #He - elim (cpy_inv_atom1 … H) -H - [ #H destruct // - | * #J #K #V #i #Hd2i #Hide2 #HLK #HVT2 #H destruct - lapply (ylt_yle_trans … (d+e) … Hide2) /2 width=5 by cpy_subst, monotonic_yle_plus_dx/ - ] -| #I #G #L #K #V #V2 #i #d #e #Hdi #Hide #HLK #HVW #T2 #HVT2 #He - lapply (cpy_weak … HVT2 0 (i+1) ? ?) -HVT2 /3 width=1 by yle_plus_dx2_trans, yle_succ/ - >yplus_inj #HVT2 <(cpy_inv_lift1_eq … HVW … HVT2) -HVT2 /2 width=5 by cpy_subst/ -| #a #I #G #L #V1 #V0 #T1 #T0 #d #e #_ #_ #IHV10 #IHT10 #X #H #He - elim (cpy_inv_bind1 … H) -H #V2 #T2 #HV02 #HT02 #H destruct - lapply (lsuby_cpy_trans … HT02 (L.ⓑ{I}V1) ?) -HT02 /2 width=1 by lsuby_succ/ #HT02 - lapply (IHT10 … HT02 He) -T0 /3 width=1 by cpy_bind/ -| #I #G #L #V1 #V0 #T1 #T0 #d #e #_ #_ #IHV10 #IHT10 #X #H #He - elim (cpy_inv_flat1 … H) -H #V2 #T2 #HV02 #HT02 #H destruct /3 width=1 by cpy_flat/ -] -qed-. - -theorem cpy_trans_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T0 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → d2 + e2 ≤ d1 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T ▶[d1, e1] T2. -#G #L #T1 #T0 #d1 #e1 #H elim H -G -L -T1 -T0 -d1 -e1 -[ /2 width=3 by ex2_intro/ -| #I #G #L #K #V #W #i1 #d1 #e1 #Hdi1 #Hide1 #HLK #HVW #T2 #d2 #e2 #HWT2 #Hde2d1 - lapply (yle_trans … Hde2d1 … Hdi1) -Hde2d1 #Hde2i1 - lapply (cpy_weak … HWT2 0 (i1+1) ? ?) -HWT2 /3 width=1 by yle_succ, yle_pred_sn/ -Hde2i1 - >yplus_inj #HWT2 <(cpy_inv_lift1_eq … HVW … HWT2) -HWT2 /3 width=9 by cpy_subst, ex2_intro/ -| #a #I #G #L #V1 #V0 #T1 #T0 #d1 #e1 #_ #_ #IHV10 #IHT10 #X #d2 #e2 #HX #de2d1 - elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - lapply (lsuby_cpy_trans … HT02 (L.ⓑ{I}V1) ?) -HT02 /2 width=1 by lsuby_succ/ #HT02 - elim (IHV10 … HV02) -IHV10 -HV02 // #V - elim (IHT10 … HT02) -T0 /2 width=1 by yle_succ/ #T #HT1 #HT2 - lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 /3 width=6 by cpy_bind, lsuby_succ, ex2_intro/ -| #I #G #L #V1 #V0 #T1 #T0 #d1 #e1 #_ #_ #IHV10 #IHT10 #X #d2 #e2 #HX #de2d1 - elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct - elim (IHV10 … HV02) -V0 // - elim (IHT10 … HT02) -T0 /3 width=6 by cpy_flat, ex2_intro/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_lift.ma deleted file mode 100644 index aa0b2416a..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_lift.ma +++ /dev/null @@ -1,249 +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/relocation/ldrop_ldrop.ma". -include "basic_2/relocation/cpy.ma". - -(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) - -(* Properties on relocation *************************************************) - -(* Basic_1: was: subst1_lift_lt *) -lemma cpy_lift_le: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → - ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → - ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → - dt + et ≤ d → ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2. -#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et -[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ - >(lift_mono … H1 … H2) -H1 -H2 // -| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hdetd - lapply (ylt_yle_trans … Hdetd … Hidet) -Hdetd #Hid - lapply (ylt_inv_inj … Hid) -Hid #Hid - lapply (lift_inv_lref1_lt … H … Hid) -H #H destruct - elim (lift_trans_ge … HVW … HWU2) -W // (lift_mono … HVY … HVW) -Y -HVW #H destruct /2 width=5 by cpy_subst/ -| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd - elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /4 width=7 by cpy_bind, ldrop_skip, yle_succ/ -| #G #I #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd - elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /3 width=7 by cpy_flat/ -] -qed-. - -lemma cpy_lift_be: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → - ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → - ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → - dt ≤ d → d ≤ dt + et → ⦃G, L⦄ ⊢ U1 ▶[dt, et + e] U2. -#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et -[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ #_ - >(lift_mono … H1 … H2) -H1 -H2 // -| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hdtd #_ - elim (lift_inv_lref1 … H) -H * #Hid #H destruct - [ -Hdtd - lapply (ylt_yle_trans … (dt+et+e) … Hidet) // -Hidet #Hidete - elim (lift_trans_ge … HVW … HWU2) -W // (lift_mono … HVY … HVW) -V #H destruct /2 width=5 by cpy_subst/ - | -Hdti - elim (yle_inv_inj2 … Hdtd) -Hdtd #dtt #Hdtd #H destruct - lapply (transitive_le … Hdtd Hid) -Hdtd #Hdti - lapply (lift_trans_be … HVW … HWU2 ? ?) -W /2 width=1 by le_S/ >plus_plus_comm_23 #HVU2 - lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid - /4 width=5 by cpy_subst, ldrop_inv_gen, monotonic_ylt_plus_dx, yle_plus_dx1_trans, yle_inj/ - ] -| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdtd #Hddet - elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /4 width=7 by cpy_bind, ldrop_skip, yle_succ/ -| #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd - elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /3 width=7 by cpy_flat/ -] -qed-. - -(* Basic_1: was: subst1_lift_ge *) -lemma cpy_lift_ge: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → - ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → - ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → - d ≤ dt → ⦃G, L⦄ ⊢ U1 ▶[dt+e, et] U2. -#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et -[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ - >(lift_mono … H1 … H2) -H1 -H2 // -| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hddt - lapply (yle_trans … Hddt … Hdti) -Hddt #Hid - elim (yle_inv_inj2 … Hid) -Hid #dd #Hddi #H0 destruct - lapply (lift_inv_lref1_ge … H … Hddi) -H #H destruct - lapply (lift_trans_be … HVW … HWU2 ? ?) -W /2 width=1 by le_S/ >plus_plus_comm_23 #HVU2 - lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hddi - /3 width=5 by cpy_subst, ldrop_inv_gen, monotonic_ylt_plus_dx, monotonic_yle_plus_dx/ -| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hddt - elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /4 width=6 by cpy_bind, ldrop_skip, yle_succ/ -| #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hddt - elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 - elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct - /3 width=6 by cpy_flat/ -] -qed-. - -(* Inversion lemmas on relocation *******************************************) - -(* Basic_1: was: subst1_gen_lift_lt *) -lemma cpy_inv_lift1_le: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt + et ≤ d → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et -[ * #i #G #L #dt #et #K #s #d #e #_ #T1 #H #_ - [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ - | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ - | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ - ] -| #I #G #L #KV #V #W #i #dt #et #Hdti #Hidet #HLKV #HVW #K #s #d #e #HLK #T1 #H #Hdetd - lapply (ylt_yle_trans … Hdetd … Hidet) -Hdetd #Hid - lapply (ylt_inv_inj … Hid) -Hid #Hid - lapply (lift_inv_lref2_lt … H … Hid) -H #H destruct - elim (ldrop_conf_lt … HLK … HLKV) -L // #L #U #HKL #_ #HUV - elim (lift_trans_le … HUV … HVW) -V // >minus_plus yplus_minus_assoc_inj /2 width=1 by yle_plus_to_minus_inj2/ ] -Hdedet #Hidete - elim (ldrop_conf_lt … HLK … HLKV) -L // #L #U #HKL #_ #HUV - elim (lift_trans_le … HUV … HVW) -V // >minus_plus plus_minus // yplus_minus_assoc_inj /3 width=1 by monotonic_ylt_minus_dx, yle_inj/ - ] -| #a #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdtd #Hdedet - elim (lift_inv_bind2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct - elim (IHW12 … HLK … HVW1) -IHW12 // #V2 #HV12 #HVW2 - elim (IHU12 … HTU1) -U1 - /3 width=6 by cpy_bind, ldrop_skip, lift_bind, yle_succ, ex2_intro/ -| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdtd #Hdedet - elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct - elim (IHW12 … HLK … HVW1) -W1 // - elim (IHU12 … HLK … HTU1) -U1 -HLK // - /3 width=5 by cpy_flat, lift_flat, ex2_intro/ -] -qed-. - -(* Basic_1: was: subst1_gen_lift_ge *) -lemma cpy_inv_lift1_ge: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - yinj d + e ≤ dt → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt-e, et] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et -[ * #i #G #L #dt #et #K #s #d #e #_ #T1 #H #_ - [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ - | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ - | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ - ] -| #I #G #L #KV #V #W #i #dt #et #Hdti #Hidet #HLKV #HVW #K #s #d #e #HLK #T1 #H #Hdedt - lapply (yle_trans … Hdedt … Hdti) #Hdei - elim (yle_inv_plus_inj2 … Hdedt) -Hdedt #_ #Hedt - elim (yle_inv_plus_inj2 … Hdei) #Hdie #Hei - lapply (lift_inv_lref2_ge … H ?) -H /2 width=1 by yle_inv_inj/ #H destruct - lapply (ldrop_conf_ge … HLK … HLKV ?) -L /2 width=1 by yle_inv_inj/ #HKV - elim (lift_split … HVW d (i-e+1)) -HVW [2,3,4: /3 width=1 by yle_inv_inj, le_S_S, le_S/ ] -Hdei -Hdie - #V0 #HV10 >plus_minus /2 width=1 by yle_inv_inj/ yminus_succ1_inj /3 width=5 by cpy_bind, lift_bind, ex2_intro/ -| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdetd - elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct - elim (IHW12 … HLK … HVW1) -W1 // - elim (IHU12 … HLK … HTU1) -U1 -HLK /3 width=5 by cpy_flat, lift_flat, ex2_intro/ -] -qed-. - -(* Advancd inversion lemmas on relocation ***********************************) - -lemma cpy_inv_lift1_ge_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[d, dt + et - (yinj d + e)] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet -elim (cpy_split_up … HU12 (d + e)) -HU12 // -Hdedet #U #HU1 #HU2 -lapply (cpy_weak … HU1 d e ? ?) -HU1 // [ >ymax_pre_sn_comm // ] -Hddt -Hdtde #HU1 -lapply (cpy_inv_lift1_eq … HTU1 … HU1) -HU1 #HU1 destruct -elim (cpy_inv_lift1_ge … HU2 … HLK … HTU1) -U -L /2 width=3 by ex2_intro/ -qed-. - -lemma cpy_inv_lift1_be_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt ≤ d → dt + et ≤ yinj d + e → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, d-dt] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdetde -lapply (cpy_weak … HU12 dt (d+e-dt) ? ?) -HU12 // -[ >ymax_pre_sn_comm /2 width=1 by yle_plus_dx1_trans/ ] -Hdetde #HU12 -elim (cpy_inv_lift1_be … HU12 … HLK … HTU1) -U1 -L /2 width=3 by ex2_intro/ -qed-. - -lemma cpy_inv_lift1_le_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt ≤ d → d ≤ dt + et → dt + et ≤ yinj d + e → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde -elim (cpy_split_up … HU12 d) -HU12 // #U #HU1 #HU2 -elim (cpy_inv_lift1_le … HU1 … HLK … HTU1) -U1 -[2: >ymax_pre_sn_comm // ] -Hdtd #T #HT1 #HTU -lapply (cpy_weak … HU2 d e ? ?) -HU2 // -[ >ymax_pre_sn_comm // ] -Hddet -Hdetde #HU2 -lapply (cpy_inv_lift1_eq … HTU … HU2) -L #H destruct /2 width=3 by ex2_intro/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_nlift.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_nlift.ma deleted file mode 100644 index 42bb3f146..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/cpy_nlift.ma +++ /dev/null @@ -1,66 +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/relocation/lift_neg.ma". -include "basic_2/relocation/lift_lift.ma". -include "basic_2/relocation/cpy.ma". - -(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) - -(* Inversion lemmas on negated relocation ***********************************) - -lemma cpy_fwd_nlift2_ge: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → - ∀i. d ≤ yinj i → (∀T2. ⇧[i, 1] T2 ≡ U2 → ⊥) → - (∀T1. ⇧[i, 1] T1 ≡ U1 → ⊥) ∨ - ∃∃I,K,W,j. d ≤ yinj j & j < i & ⇩[j]L ≡ K.ⓑ{I}W & - (∀V. ⇧[i-j-1, 1] V ≡ W → ⊥) & (∀T1. ⇧[j, 1] T1 ≡ U1 → ⊥). -#G #L #U1 #U2 #d #e #H elim H -G -L -U1 -U2 -d -e -[ /3 width=2 by or_introl/ -| #I #G #L #K #V #W #j #d #e #Hdj #Hjde #HLK #HVW #i #Hdi #HnW - elim (lt_or_ge j i) #Hij - [ @or_intror @(ex5_4_intro … HLK) // -HLK - [ #X #HXV elim (lift_trans_le … HXV … HVW ?) -V // - #Y #HXY >minus_plus (plus_minus_m_m j 1) in ⊢ (%→?); [2: /3 width=3 by yle_trans, yle_inv_inj/ ] - #HnU1 (plus_minus_m_m e 1) /2 width=3 by fqu_drop/ -qed. - -lemma fqu_lref_S_lt: ∀I,G,L,V,i. 0 < i → ⦃G, L.ⓑ{I}V, #i⦄ ⊐ ⦃G, L, #(i-1)⦄. -/3 width=3 by fqu_drop, ldrop_drop, lift_lref_ge_minus/ -qed. - -(* Basic forward lemmas *****************************************************) - -lemma fqu_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} < ♯{G1, L1, T1}. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 // -#G #L #K #T #U #e #HLK #HTU -lapply (ldrop_fwd_lw_lt … HLK ?) -HLK // #HKL -lapply (lift_fwd_tw … HTU) -e #H -normalize in ⊢ (?%%); /2 width=1 by lt_minus_to_plus/ -qed-. - -fact fqu_fwd_length_lref1_aux: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → - ∀i. T1 = #i → |L2| < |L1|. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 -[1: normalize // -|3: #a -|5: /2 width=4 by ldrop_fwd_length_lt4/ -] #I #G #L #V #T #j #H destruct -qed-. - -lemma fqu_fwd_length_lref1: ∀G1,G2,L1,L2,T2,i. ⦃G1, L1, #i⦄ ⊐ ⦃G2, L2, T2⦄ → |L2| < |L1|. -/2 width=7 by fqu_fwd_length_lref1_aux/ -qed-. - -(* Advanced eliminators *****************************************************) - -lemma fqu_wf_ind: ∀R:relation3 …. ( - ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G2 L2 T2) → - R G1 L1 T1 - ) → ∀G1,L1,T1. R G1 L1 T1. -#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=1 by fqu_fwd_fw/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq.ma deleted file mode 100644 index bc6931a46..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq.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/notation/relations/suptermopt_6.ma". -include "basic_2/relocation/fqu.ma". - -(* OPTIONAL SUPCLOSURE ******************************************************) - -(* activate genv *) -inductive fquq: tri_relation genv lenv term ≝ -| fquq_lref_O : ∀I,G,L,V. fquq G (L.ⓑ{I}V) (#0) G L V -| fquq_pair_sn: ∀I,G,L,V,T. fquq G L (②{I}V.T) G L V -| fquq_bind_dx: ∀a,I,G,L,V,T. fquq G L (ⓑ{a,I}V.T) G (L.ⓑ{I}V) T -| fquq_flat_dx: ∀I,G, L,V,T. fquq G L (ⓕ{I}V.T) G L T -| fquq_drop : ∀G,L,K,T,U,e. - ⇩[e] L ≡ K → ⇧[0, e] T ≡ U → fquq G L U G K T -. - -interpretation - "optional structural successor (closure)" - 'SupTermOpt G1 L1 T1 G2 L2 T2 = (fquq G1 L1 T1 G2 L2 T2). - -(* Basic properties *********************************************************) - -lemma fquq_refl: tri_reflexive … fquq. -/2 width=3 by fquq_drop/ qed. - -lemma fqu_fquq: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 /2 width=3 by fquq_drop/ -qed. - -(* Basic forward lemmas *****************************************************) - -lemma fquq_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} ≤ ♯{G1, L1, T1}. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 /2 width=1 by lt_to_le/ -#G1 #L1 #K1 #T1 #U1 #e #HLK1 #HTU1 -lapply (ldrop_fwd_lw … HLK1) -HLK1 -lapply (lift_fwd_tw … HTU1) -HTU1 -/2 width=1 by le_plus, le_n/ -qed-. - -fact fquq_fwd_length_lref1_aux: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → - ∀i. T1 = #i → |L2| ≤ |L1|. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 // -[ #a #I #G #L #V #T #j #H destruct -| #G1 #L1 #K1 #T1 #U1 #e #HLK1 #HTU1 #i #H destruct - /2 width=3 by ldrop_fwd_length_le4/ -] -qed-. - -lemma fquq_fwd_length_lref1: ∀G1,G2,L1,L2,T2,i. ⦃G1, L1, #i⦄ ⊐⸮ ⦃G2, L2, T2⦄ → |L2| ≤ |L1|. -/2 width=7 by fquq_fwd_length_lref1_aux/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq_alt.ma deleted file mode 100644 index c1048857c..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/fquq_alt.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/notation/relations/suptermoptalt_6.ma". -include "basic_2/relocation/fquq.ma". - -(* OPTIONAL SUPCLOSURE ******************************************************) - -(* alternative definition of fquq *) -definition fquqa: tri_relation genv lenv term ≝ tri_RC … fqu. - -interpretation - "optional structural successor (closure) alternative" - 'SupTermOptAlt G1 L1 T1 G2 L2 T2 = (fquqa G1 L1 T1 G2 L2 T2). - -(* Basic properties *********************************************************) - -lemma fquqa_refl: tri_reflexive … fquqa. -// qed. - -lemma fquqa_drop: ∀G,L,K,T,U,e. - ⇩[e] L ≡ K → ⇧[0, e] T ≡ U → ⦃G, L, U⦄ ⊐⊐⸮ ⦃G, K, T⦄. -#G #L #K #T #U #e #HLK #HTU elim (eq_or_gt e) -/3 width=5 by fqu_drop_lt, or_introl/ #H destruct ->(ldrop_inv_O2 … HLK) -L >(lift_inv_O2 … HTU) -T // -qed. - -(* Main properties **********************************************************) - -theorem fquq_fquqa: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⊐⸮ ⦃G2, L2, T2⦄. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 -/2 width=3 by fquqa_drop, fqu_lref_O, fqu_pair_sn, fqu_bind_dx, fqu_flat_dx, or_introl/ -qed. - -(* Main inversion properties ************************************************) - -theorem fquqa_inv_fquq: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄. -#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -H /2 width=1 by fqu_fquq/ -* #H1 #H2 #H3 destruct // -qed-. - -(* Advanced inversion lemmas ************************************************) - -lemma fquq_inv_gen: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ ∨ (∧∧ G1 = G2 & L1 = L2 & T1 = T2). -#G1 #G2 #L1 #L2 #T1 #T2 #H elim (fquq_fquqa … H) -H [| * ] -/2 width=1 by or_introl/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/gget.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/gget.ma deleted file mode 100644 index f299c9bea..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/gget.ma +++ /dev/null @@ -1,81 +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/notation/relations/rdrop_3.ma". -include "basic_2/grammar/genv.ma". - -(* GLOBAL ENVIRONMENT READING ***********************************************) - -inductive gget (e:nat): relation genv ≝ -| gget_gt: ∀G. |G| ≤ e → gget e G (⋆) -| gget_eq: ∀G. |G| = e + 1 → gget e G G -| gget_lt: ∀I,G1,G2,V. e < |G1| → gget e G1 G2 → gget e (G1. ⓑ{I} V) G2 -. - -interpretation "global reading" - 'RDrop e G1 G2 = (gget e G1 G2). - -(* basic inversion lemmas ***************************************************) - -lemma gget_inv_gt: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| ≤ e → G2 = ⋆. -#G1 #G2 #e * -G1 -G2 // -[ #G #H >H -H >commutative_plus #H (**) (* lemma needed here *) - 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 gget_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 (**) (* lemma needed here *) - 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 gget_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 gget_inv_lt: ∀I,G1,G2,V,e. - ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2. -/2 width=5 by gget_inv_lt_aux/ qed-. - -(* Basic properties *********************************************************) - -lemma gget_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: @gget_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *) -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/gget_gget.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/gget_gget.ma deleted file mode 100644 index ee7027ce4..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/gget_gget.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/relocation/gget.ma". - -(* GLOBAL ENVIRONMENT READING ***********************************************) - -(* Main properties **********************************************************) - -theorem gget_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 - >(gget_inv_gt … H He) -H -He // -| #G #He #G2 #H - >(gget_inv_eq … H He) -H -He // -| #I #G #G1 #V #He #_ #IHG1 #G2 #H - lapply (gget_inv_lt … H He) -H -He /2 width=1/ -] -qed-. - -lemma gget_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2). -#G1 #G2 #e -elim (gget_total e G1) #G #HG1 -elim (eq_genv_dec G G2) #HG2 -[ destruct /2 width=1/ -| @or_intror #HG12 - lapply (gget_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 deleted file mode 100644 index 75016aa63..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop.ma +++ /dev/null @@ -1,490 +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 "ground_2/lib/bool.ma". -include "ground_2/lib/lstar.ma". -include "basic_2/notation/relations/rdrop_5.ma". -include "basic_2/notation/relations/rdrop_4.ma". -include "basic_2/notation/relations/rdrop_3.ma". -include "basic_2/grammar/lenv_length.ma". -include "basic_2/grammar/cl_restricted_weight.ma". -include "basic_2/relocation/lift.ma". - -(* BASIC SLICING FOR LOCAL ENVIRONMENTS *************************************) - -(* Basic_1: includes: drop_skip_bind *) -inductive ldrop (s:bool): relation4 nat nat lenv lenv ≝ -| ldrop_atom: ∀d,e. (s = Ⓕ → e = 0) → ldrop s d e (⋆) (⋆) -| ldrop_pair: ∀I,L,V. ldrop s 0 0 (L.ⓑ{I}V) (L.ⓑ{I}V) -| ldrop_drop: ∀I,L1,L2,V,e. ldrop s 0 e L1 L2 → ldrop s 0 (e+1) (L1.ⓑ{I}V) L2 -| ldrop_skip: ∀I,L1,L2,V1,V2,d,e. - ldrop s d e L1 L2 → ⇧[d, e] V2 ≡ V1 → - ldrop s (d+1) e (L1.ⓑ{I}V1) (L2.ⓑ{I}V2) -. - -interpretation - "basic slicing (local environment) abstract" - 'RDrop s d e L1 L2 = (ldrop s d e L1 L2). -(* -interpretation - "basic slicing (local environment) general" - 'RDrop d e L1 L2 = (ldrop true d e L1 L2). -*) -interpretation - "basic slicing (local environment) lget" - 'RDrop e L1 L2 = (ldrop false O e L1 L2). - -definition l_liftable: predicate (lenv → relation term) ≝ - λR. ∀K,T1,T2. R K T1 T2 → ∀L,s,d,e. ⇩[s, d, e] L ≡ K → - ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2. - -definition l_deliftable_sn: predicate (lenv → relation term) ≝ - λR. ∀L,U1,U2. R L U1 U2 → ∀K,s,d,e. ⇩[s, d, e] L ≡ K → - ∀T1. ⇧[d, e] T1 ≡ U1 → - ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2. - -definition dropable_sn: predicate (relation lenv) ≝ - λR. ∀L1,K1,s,d,e. ⇩[s, d, e] L1 ≡ K1 → ∀L2. R L1 L2 → - ∃∃K2. R K1 K2 & ⇩[s, d, e] L2 ≡ K2. - -definition dropable_dx: predicate (relation lenv) ≝ - λR. ∀L1,L2. R L1 L2 → ∀K2,s,e. ⇩[s, 0, e] L2 ≡ K2 → - ∃∃K1. ⇩[s, 0, e] L1 ≡ K1 & R K1 K2. - -(* Basic inversion lemmas ***************************************************) - -fact ldrop_inv_atom1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → L1 = ⋆ → - L2 = ⋆ ∧ (s = Ⓕ → e = 0). -#L1 #L2 #s #d #e * -L1 -L2 -d -e -[ /3 width=1 by conj/ -| #I #L #V #H destruct -| #I #L1 #L2 #V #e #_ #H destruct -| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #H destruct -] -qed-. - -(* Basic_1: was: drop_gen_sort *) -lemma ldrop_inv_atom1: ∀L2,s,d,e. ⇩[s, d, e] ⋆ ≡ L2 → L2 = ⋆ ∧ (s = Ⓕ → e = 0). -/2 width=4 by ldrop_inv_atom1_aux/ qed-. - -fact ldrop_inv_O1_pair1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → d = 0 → - ∀K,I,V. L1 = K.ⓑ{I}V → - (e = 0 ∧ L2 = K.ⓑ{I}V) ∨ - (0 < e ∧ ⇩[s, d, e-1] K ≡ L2). -#L1 #L2 #s #d #e * -L1 -L2 -d -e -[ #d #e #_ #_ #K #J #W #H destruct -| #I #L #V #_ #K #J #W #HX destruct /3 width=1 by or_introl, conj/ -| #I #L1 #L2 #V #e #HL12 #_ #K #J #W #H destruct /3 width=1 by or_intror, conj/ -| #I #L1 #L2 #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct -] -qed-. - -lemma ldrop_inv_O1_pair1: ∀I,K,L2,V,s,e. ⇩[s, 0, e] K. ⓑ{I} V ≡ L2 → - (e = 0 ∧ L2 = K.ⓑ{I}V) ∨ - (0 < e ∧ ⇩[s, 0, e-1] K ≡ L2). -/2 width=3 by ldrop_inv_O1_pair1_aux/ qed-. - -lemma ldrop_inv_pair1: ∀I,K,L2,V,s. ⇩[s, 0, 0] K.ⓑ{I}V ≡ L2 → L2 = K.ⓑ{I}V. -#I #K #L2 #V #s #H -elim (ldrop_inv_O1_pair1 … H) -H * // #H destruct -elim (lt_refl_false … H) -qed-. - -(* Basic_1: was: drop_gen_drop *) -lemma ldrop_inv_drop1_lt: ∀I,K,L2,V,s,e. - ⇩[s, 0, e] K.ⓑ{I}V ≡ L2 → 0 < e → ⇩[s, 0, e-1] K ≡ L2. -#I #K #L2 #V #s #e #H #He -elim (ldrop_inv_O1_pair1 … H) -H * // #H destruct -elim (lt_refl_false … He) -qed-. - -lemma ldrop_inv_drop1: ∀I,K,L2,V,s,e. - ⇩[s, 0, e+1] K.ⓑ{I}V ≡ L2 → ⇩[s, 0, e] K ≡ L2. -#I #K #L2 #V #s #e #H lapply (ldrop_inv_drop1_lt … H ?) -H // -qed-. - -fact ldrop_inv_skip1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → 0 < d → - ∀I,K1,V1. L1 = K1.ⓑ{I}V1 → - ∃∃K2,V2. ⇩[s, d-1, e] K1 ≡ K2 & - ⇧[d-1, e] V2 ≡ V1 & - L2 = K2.ⓑ{I}V2. -#L1 #L2 #s #d #e * -L1 -L2 -d -e -[ #d #e #_ #_ #J #K1 #W1 #H destruct -| #I #L #V #H elim (lt_refl_false … H) -| #I #L1 #L2 #V #e #_ #H elim (lt_refl_false … H) -| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV21 #_ #J #K1 #W1 #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -(* Basic_1: was: drop_gen_skip_l *) -lemma ldrop_inv_skip1: ∀I,K1,V1,L2,s,d,e. ⇩[s, d, e] K1.ⓑ{I}V1 ≡ L2 → 0 < d → - ∃∃K2,V2. ⇩[s, d-1, e] K1 ≡ K2 & - ⇧[d-1, e] V2 ≡ V1 & - L2 = K2.ⓑ{I}V2. -/2 width=3 by ldrop_inv_skip1_aux/ qed-. - -lemma ldrop_inv_O1_pair2: ∀I,K,V,s,e,L1. ⇩[s, 0, e] L1 ≡ K.ⓑ{I}V → - (e = 0 ∧ L1 = K.ⓑ{I}V) ∨ - ∃∃I1,K1,V1. ⇩[s, 0, e-1] K1 ≡ K.ⓑ{I}V & L1 = K1.ⓑ{I1}V1 & 0 < e. -#I #K #V #s #e * -[ #H elim (ldrop_inv_atom1 … H) -H #H destruct -| #L1 #I1 #V1 #H - elim (ldrop_inv_O1_pair1 … H) -H * - [ #H1 #H2 destruct /3 width=1 by or_introl, conj/ - | /3 width=5 by ex3_3_intro, or_intror/ - ] -] -qed-. - -fact ldrop_inv_skip2_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → 0 < d → - ∀I,K2,V2. L2 = K2.ⓑ{I}V2 → - ∃∃K1,V1. ⇩[s, d-1, e] K1 ≡ K2 & - ⇧[d-1, e] V2 ≡ V1 & - L1 = K1.ⓑ{I}V1. -#L1 #L2 #s #d #e * -L1 -L2 -d -e -[ #d #e #_ #_ #J #K2 #W2 #H destruct -| #I #L #V #H elim (lt_refl_false … H) -| #I #L1 #L2 #V #e #_ #H elim (lt_refl_false … H) -| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV21 #_ #J #K2 #W2 #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -(* Basic_1: was: drop_gen_skip_r *) -lemma ldrop_inv_skip2: ∀I,L1,K2,V2,s,d,e. ⇩[s, d, e] L1 ≡ K2.ⓑ{I}V2 → 0 < d → - ∃∃K1,V1. ⇩[s, d-1, e] K1 ≡ K2 & ⇧[d-1, e] V2 ≡ V1 & - L1 = K1.ⓑ{I}V1. -/2 width=3 by ldrop_inv_skip2_aux/ qed-. - -lemma ldrop_inv_O1_gt: ∀L,K,e,s. ⇩[s, 0, e] L ≡ K → |L| < e → - s = Ⓣ ∧ K = ⋆. -#L elim L -L [| #L #Z #X #IHL ] #K #e #s #H normalize in ⊢ (?%?→?); #H1e -[ elim (ldrop_inv_atom1 … H) -H elim s -s /2 width=1 by conj/ - #_ #Hs lapply (Hs ?) // -Hs #H destruct elim (lt_zero_false … H1e) -| elim (ldrop_inv_O1_pair1 … H) -H * #H2e #HLK destruct - [ elim (lt_zero_false … H1e) - | elim (IHL … HLK) -IHL -HLK /2 width=1 by lt_plus_to_minus_r, conj/ - ] -] -qed-. - -(* Basic properties *********************************************************) - -lemma ldrop_refl_atom_O2: ∀s,d. ⇩[s, d, O] ⋆ ≡ ⋆. -/2 width=1 by ldrop_atom/ qed. - -(* Basic_1: was by definition: drop_refl *) -lemma ldrop_refl: ∀L,d,s. ⇩[s, d, 0] L ≡ L. -#L elim L -L // -#L #I #V #IHL #d #s @(nat_ind_plus … d) -d /2 width=1 by ldrop_pair, ldrop_skip/ -qed. - -lemma ldrop_drop_lt: ∀I,L1,L2,V,s,e. - ⇩[s, 0, e-1] L1 ≡ L2 → 0 < e → ⇩[s, 0, e] L1.ⓑ{I}V ≡ L2. -#I #L1 #L2 #V #s #e #HL12 #He >(plus_minus_m_m e 1) /2 width=1 by ldrop_drop/ -qed. - -lemma ldrop_skip_lt: ∀I,L1,L2,V1,V2,s,d,e. - ⇩[s, d-1, e] L1 ≡ L2 → ⇧[d-1, e] V2 ≡ V1 → 0 < d → - ⇩[s, d, e] L1. ⓑ{I} V1 ≡ L2.ⓑ{I}V2. -#I #L1 #L2 #V1 #V2 #s #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) /2 width=1 by ldrop_skip/ -qed. - -lemma ldrop_O1_le: ∀s,e,L. e ≤ |L| → ∃K. ⇩[s, 0, e] L ≡ K. -#s #e @(nat_ind_plus … e) -e /2 width=2 by ex_intro/ -#e #IHe * -[ #H elim (le_plus_xSy_O_false … H) -| #L #I #V normalize #H elim (IHe L) -IHe /3 width=2 by ldrop_drop, monotonic_pred, ex_intro/ -] -qed-. - -lemma ldrop_O1_lt: ∀s,L,e. e < |L| → ∃∃I,K,V. ⇩[s, 0, e] L ≡ K.ⓑ{I}V. -#s #L elim L -L -[ #e #H elim (lt_zero_false … H) -| #L #I #V #IHL #e @(nat_ind_plus … e) -e /2 width=4 by ldrop_pair, ex1_3_intro/ - #e #_ normalize #H elim (IHL e) -IHL /3 width=4 by ldrop_drop, lt_plus_to_minus_r, lt_plus_to_lt_l, ex1_3_intro/ -] -qed-. - -lemma ldrop_O1_pair: ∀L,K,e,s. ⇩[s, 0, e] L ≡ K → e ≤ |L| → ∀I,V. - ∃∃J,W. ⇩[s, 0, e] L.ⓑ{I}V ≡ K.ⓑ{J}W. -#L elim L -L [| #L #Z #X #IHL ] #K #e #s #H normalize #He #I #V -[ elim (ldrop_inv_atom1 … H) -H #H <(le_n_O_to_eq … He) -e - #Hs destruct /2 width=3 by ex1_2_intro/ -| elim (ldrop_inv_O1_pair1 … H) -H * #He #HLK destruct /2 width=3 by ex1_2_intro/ - elim (IHL … HLK … Z X) -IHL -HLK - /3 width=3 by ldrop_drop_lt, le_plus_to_minus, ex1_2_intro/ -] -qed-. - -lemma ldrop_O1_ge: ∀L,e. |L| ≤ e → ⇩[Ⓣ, 0, e] L ≡ ⋆. -#L elim L -L [ #e #_ @ldrop_atom #H destruct ] -#L #I #V #IHL #e @(nat_ind_plus … e) -e [ #H elim (le_plus_xSy_O_false … H) ] -normalize /4 width=1 by ldrop_drop, monotonic_pred/ -qed. - -lemma ldrop_split: ∀L1,L2,d,e2,s. ⇩[s, d, e2] L1 ≡ L2 → ∀e1. e1 ≤ e2 → - ∃∃L. ⇩[s, d, e2 - e1] L1 ≡ L & ⇩[s, d, e1] L ≡ L2. -#L1 #L2 #d #e2 #s #H elim H -L1 -L2 -d -e2 -[ #d #e2 #Hs #e1 #He12 @(ex2_intro … (⋆)) - @ldrop_atom #H lapply (Hs H) -s #H destruct /2 width=1 by le_n_O_to_eq/ -| #I #L1 #V #e1 #He1 lapply (le_n_O_to_eq … He1) -He1 - #H destruct /2 width=3 by ex2_intro/ -| #I #L1 #L2 #V #e2 #HL12 #IHL12 #e1 @(nat_ind_plus … e1) -e1 - [ /3 width=3 by ldrop_drop, ex2_intro/ - | -HL12 #e1 #_ #He12 lapply (le_plus_to_le_r … He12) -He12 - #He12 elim (IHL12 … He12) -IHL12 >minus_plus_plus_l - #L #HL1 #HL2 elim (lt_or_ge (|L1|) (e2-e1)) #H0 - [ elim (ldrop_inv_O1_gt … HL1 H0) -HL1 #H1 #H2 destruct - elim (ldrop_inv_atom1 … HL2) -HL2 #H #_ destruct - @(ex2_intro … (⋆)) [ @ldrop_O1_ge normalize // ] - @ldrop_atom #H destruct - | elim (ldrop_O1_pair … HL1 H0 I V) -HL1 -H0 /3 width=5 by ldrop_drop, ex2_intro/ - ] - ] -| #I #L1 #L2 #V1 #V2 #d #e2 #_ #HV21 #IHL12 #e1 #He12 elim (IHL12 … He12) -IHL12 - #L #HL1 #HL2 elim (lift_split … HV21 d e1) -HV21 /3 width=5 by ldrop_skip, ex2_intro/ -] -qed-. - -lemma ldrop_FT: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → ⇩[Ⓣ, d, e] L1 ≡ L2. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e -/3 width=1 by ldrop_atom, ldrop_drop, ldrop_skip/ -qed. - -lemma ldrop_gen: ∀L1,L2,s,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → ⇩[s, d, e] L1 ≡ L2. -#L1 #L2 * /2 width=1 by ldrop_FT/ -qed-. - -lemma ldrop_T: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → ⇩[Ⓣ, d, e] L1 ≡ L2. -#L1 #L2 * /2 width=1 by ldrop_FT/ -qed-. - -lemma l_liftable_LTC: ∀R. l_liftable R → l_liftable (LTC … R). -#R #HR #K #T1 #T2 #H elim H -T2 -[ /3 width=10 by inj/ -| #T #T2 #_ #HT2 #IHT1 #L #s #d #e #HLK #U1 #HTU1 #U2 #HTU2 - elim (lift_total T d e) /4 width=12 by step/ -] -qed-. - -lemma l_deliftable_sn_LTC: ∀R. l_deliftable_sn R → l_deliftable_sn (LTC … R). -#R #HR #L #U1 #U2 #H elim H -U2 -[ #U2 #HU12 #K #s #d #e #HLK #T1 #HTU1 - elim (HR … HU12 … HLK … HTU1) -HR -L -U1 /3 width=3 by inj, ex2_intro/ -| #U #U2 #_ #HU2 #IHU1 #K #s #d #e #HLK #T1 #HTU1 - elim (IHU1 … HLK … HTU1) -IHU1 -U1 #T #HTU #HT1 - elim (HR … HU2 … HLK … HTU) -HR -L -U /3 width=5 by step, ex2_intro/ -] -qed-. - -lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R). -#R #HR #L1 #K1 #s #d #e #HLK1 #L2 #H elim H -L2 -[ #L2 #HL12 elim (HR … HLK1 … HL12) -HR -L1 - /3 width=3 by inj, ex2_intro/ -| #L #L2 #_ #HL2 * #K #HK1 #HLK elim (HR … HLK … HL2) -HR -L - /3 width=3 by step, ex2_intro/ -] -qed-. - -lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R). -#R #HR #L1 #L2 #H elim H -L2 -[ #L2 #HL12 #K2 #s #e #HLK2 elim (HR … HL12 … HLK2) -HR -L2 - /3 width=3 by inj, ex2_intro/ -| #L #L2 #_ #HL2 #IHL1 #K2 #s #e #HLK2 elim (HR … HL2 … HLK2) -HR -L2 - #K #HLK #HK2 elim (IHL1 … HLK) -L - /3 width=5 by step, ex2_intro/ -] -qed-. - -lemma l_deliftable_sn_llstar: ∀R. l_deliftable_sn R → - ∀l. l_deliftable_sn (llstar … R l). -#R #HR #l #L #U1 #U2 #H @(lstar_ind_r … l U2 H) -l -U2 -[ /2 width=3 by lstar_O, ex2_intro/ -| #l #U #U2 #_ #HU2 #IHU1 #K #s #d #e #HLK #T1 #HTU1 - elim (IHU1 … HLK … HTU1) -IHU1 -U1 #T #HTU #HT1 - elim (HR … HU2 … HLK … HTU) -HR -L -U /3 width=5 by lstar_dx, ex2_intro/ -] -qed-. - -(* Basic forvard lemmas *****************************************************) - -(* Basic_1: was: drop_S *) -lemma ldrop_fwd_drop2: ∀L1,I2,K2,V2,s,e. ⇩[s, O, e] L1 ≡ K2. ⓑ{I2} V2 → - ⇩[s, O, e + 1] L1 ≡ K2. -#L1 elim L1 -L1 -[ #I2 #K2 #V2 #s #e #H lapply (ldrop_inv_atom1 … H) -H * #H destruct -| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #s #e #H - elim (ldrop_inv_O1_pair1 … H) -H * #He #H - [ -IHL1 destruct /2 width=1 by ldrop_drop/ - | @ldrop_drop >(plus_minus_m_m e 1) /2 width=3 by/ - ] -] -qed-. - -lemma ldrop_fwd_length_ge: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → |L1| ≤ d → |L2| = |L1|. -#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e // normalize -[ #I #L1 #L2 #V #e #_ #_ #H elim (le_plus_xSy_O_false … H) -| /4 width=2 by le_plus_to_le_r, eq_f/ -] -qed-. - -lemma ldrop_fwd_length_le_le: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → d ≤ |L1| → e ≤ |L1| - d → |L2| = |L1| - e. -#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e // normalize -[ /3 width=2 by le_plus_to_le_r/ -| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #IHL12 >minus_plus_plus_l - #Hd #He lapply (le_plus_to_le_r … Hd) -Hd - #Hd >IHL12 // -L2 >plus_minus /2 width=3 by transitive_le/ -] -qed-. - -lemma ldrop_fwd_length_le_ge: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → d ≤ |L1| → |L1| - d ≤ e → |L2| = d. -#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e normalize -[ /2 width=1 by le_n_O_to_eq/ -| #I #L #V #_ (lift_fwd_tw … HV21) -HV21 /2 width=1 by monotonic_le_plus_l/ -] -qed-. - -lemma ldrop_fwd_lw_lt: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → 0 < e → ♯{L2} < ♯{L1}. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e -[ #d #e #H >H -H // -| #I #L #V #H elim (lt_refl_false … H) -| #I #L1 #L2 #V #e #HL12 #_ #_ - lapply (ldrop_fwd_lw … HL12) -HL12 #HL12 - @(le_to_lt_to_lt … HL12) -HL12 // -| #I #L1 #L2 #V1 #V2 #d #e #_ #HV21 #IHL12 #H normalize in ⊢ (?%%); -I - >(lift_fwd_tw … HV21) -V2 /3 by lt_minus_to_plus/ -] -qed-. - -lemma ldrop_fwd_rfw: ∀I,L,K,V,i. ⇩[i] L ≡ K.ⓑ{I}V → ∀T. ♯{K, V} < ♯{L, T}. -#I #L #K #V #i #HLK lapply (ldrop_fwd_lw … HLK) -HLK -normalize in ⊢ (%→?→?%%); /3 width=3 by le_to_lt_to_lt/ -qed-. - -(* Advanced inversion lemmas ************************************************) - -fact ldrop_inv_O2_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → e = 0 → L1 = L2. -#L1 #L2 #s #d #e #H elim H -L1 -L2 -d -e -[ // -| // -| #I #L1 #L2 #V #e #_ #_ >commutative_plus normalize #H destruct -| #I #L1 #L2 #V1 #V2 #d #e #_ #HV21 #IHL12 #H - >(IHL12 H) -L1 >(lift_inv_O2_aux … HV21 … H) -V2 -d -e // -] -qed-. - -(* Basic_1: was: drop_gen_refl *) -lemma ldrop_inv_O2: ∀L1,L2,s,d. ⇩[s, d, 0] L1 ≡ L2 → L1 = L2. -/2 width=5 by ldrop_inv_O2_aux/ qed-. - -lemma ldrop_inv_length_eq: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → |L1| = |L2| → e = 0. -#L1 #L2 #d #e #H #HL12 lapply (ldrop_fwd_length_minus4 … H) // -qed-. - -lemma ldrop_inv_refl: ∀L,d,e. ⇩[Ⓕ, d, e] L ≡ L → e = 0. -/2 width=5 by ldrop_inv_length_eq/ qed-. - -fact ldrop_inv_FT_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → - ∀I,K,V. L2 = K.ⓑ{I}V → s = Ⓣ → d = 0 → - ⇩[Ⓕ, d, e] L1 ≡ K.ⓑ{I}V. -#L1 #L2 #s #d #e #H elim H -L1 -L2 -d -e -[ #d #e #_ #J #K #W #H destruct -| #I #L #V #J #K #W #H destruct // -| #I #L1 #L2 #V #e #_ #IHL12 #J #K #W #H1 #H2 destruct - /3 width=1 by ldrop_drop/ -| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #_ #J #K #W #_ #_ - (lift_inj … HVT1 … HVT2) -HVT1 -HVT2 - >(IHLK1 … HLK2) -IHLK1 -HLK2 // -] -qed-. - -(* Basic_1: was: drop_conf_ge *) -theorem ldrop_conf_ge: ∀L,L1,s1,d1,e1. ⇩[s1, d1, e1] L ≡ L1 → - ∀L2,s2,e2. ⇩[s2, 0, e2] L ≡ L2 → d1 + e1 ≤ e2 → - ⇩[s2, 0, e2 - e1] L1 ≡ L2. -#L #L1 #s1 #d1 #e1 #H elim H -L -L1 -d1 -e1 // -[ #d #e #_ #L2 #s2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H - #H #He destruct - @ldrop_atom #H >He // (**) (* explicit constructor *) -| #I #L #K #V #e #_ #IHLK #L2 #s2 #e2 #H #He2 - lapply (ldrop_inv_drop1_lt … H ?) -H /2 width=2 by ltn_to_ltO/ #HL2 - minus_minus_comm /3 width=1 by monotonic_pred/ -| #I #L #K #V1 #V2 #d #e #_ #_ #IHLK #L2 #s2 #e2 #H #Hdee2 - lapply (transitive_le 1 … Hdee2) // #He2 - lapply (ldrop_inv_drop1_lt … H ?) -H // -He2 #HL2 - lapply (transitive_le (1+e) … Hdee2) // #Hee2 - @ldrop_drop_lt >minus_minus_comm /3 width=1 by lt_minus_to_plus_r, monotonic_le_minus_r, monotonic_pred/ (**) (* explicit constructor *) -] -qed. - -(* Note: apparently this was missing in basic_1 *) -theorem ldrop_conf_be: ∀L0,L1,s1,d1,e1. ⇩[s1, d1, e1] L0 ≡ L1 → - ∀L2,e2. ⇩[e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 → - ∃∃L. ⇩[s1, 0, d1 + e1 - e2] L2 ≡ L & ⇩[d1] L1 ≡ L. -#L0 #L1 #s1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1 -[ #d1 #e1 #He1 #L2 #e2 #H #Hd1 #_ elim (ldrop_inv_atom1 … H) -H #H #He2 destruct - >(He2 ?) in Hd1; // -He2 #Hd1 <(le_n_O_to_eq … Hd1) -d1 - /4 width=3 by ldrop_atom, ex2_intro/ -| normalize #I #L #V #L2 #e2 #HL2 #_ #He2 - lapply (le_n_O_to_eq … He2) -He2 #H destruct - lapply (ldrop_inv_O2 … HL2) -HL2 #H destruct /2 width=3 by ldrop_pair, ex2_intro/ -| normalize #I #L0 #K0 #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21 - lapply (ldrop_inv_O1_pair1 … 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 by ldrop_drop_lt, ex2_intro/ - ] -] -qed-. - -(* Note: with "s2", the conclusion parameter is "s1 ∨ s2" *) -(* Basic_1: was: drop_trans_ge *) -theorem ldrop_trans_ge: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → - ∀L2,e2. ⇩[e2] L ≡ L2 → d1 ≤ e2 → ⇩[s1, 0, e1 + e2] L1 ≡ L2. -#L1 #L #s1 #d1 #e1 #H elim H -L1 -L -d1 -e1 -[ #d1 #e1 #He1 #L2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H - #H #He2 destruct /4 width=1 by ldrop_atom, eq_f2/ -| /2 width=1 by ldrop_gen/ -| /3 width=1 by ldrop_drop/ -| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #IHL12 #L #e2 #H #Hde2 - lapply (lt_to_le_to_lt 0 … Hde2) // #He2 - lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2 - lapply (ldrop_inv_drop1_lt … H ?) -H // #HL2 - @ldrop_drop_lt // >le_plus_minus /3 width=1 by monotonic_pred/ -] -qed. - -(* Basic_1: was: drop_trans_le *) -theorem ldrop_trans_le: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → - ∀L2,s2,e2. ⇩[s2, 0, e2] L ≡ L2 → e2 ≤ d1 → - ∃∃L0. ⇩[s2, 0, e2] L1 ≡ L0 & ⇩[s1, d1 - e2, e1] L0 ≡ L2. -#L1 #L #s1 #d1 #e1 #H elim H -L1 -L -d1 -e1 -[ #d1 #e1 #He1 #L2 #s2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H - #H #He2 destruct /4 width=3 by ldrop_atom, ex2_intro/ -| #I #K #V #L2 #s2 #e2 #HL2 #H lapply (le_n_O_to_eq … H) -H - #H destruct /2 width=3 by ldrop_pair, ex2_intro/ -| #I #L1 #L2 #V #e #_ #IHL12 #L #s2 #e2 #HL2 #H lapply (le_n_O_to_eq … H) -H - #H destruct elim (IHL12 … HL2) -IHL12 -HL2 // - #L0 #H #HL0 lapply (ldrop_inv_O2 … H) -H #H destruct - /3 width=5 by ldrop_pair, ldrop_drop, ex2_intro/ -| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV12 #IHL12 #L #s2 #e2 #H #He2d - elim (ldrop_inv_O1_pair1 … H) -H * - [ -He2d -IHL12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ldrop_skip, ex2_intro/ - | -HL12 -HV12 #He2 #HL2 - elim (IHL12 … HL2) -L2 [ >minus_le_minus_minus_comm // /3 width=3 by ldrop_drop_lt, ex2_intro/ | /2 width=1 by monotonic_pred/ ] - ] -] -qed-. - -(* Advanced properties ******************************************************) - -lemma l_liftable_llstar: ∀R. l_liftable R → ∀l. l_liftable (llstar … R l). -#R #HR #l #K #T1 #T2 #H @(lstar_ind_r … l T2 H) -l -T2 -[ #L #s #d #e #_ #U1 #HTU1 #U2 #HTU2 -HR -K - >(lift_mono … HTU2 … HTU1) -T1 -U2 -d -e // -| #l #T #T2 #_ #HT2 #IHT1 #L #s #d #e #HLK #U1 #HTU1 #U2 #HTU2 - elim (lift_total T d e) /3 width=12 by lstar_dx/ -] -qed-. - -(* Basic_1: was: drop_conf_lt *) -lemma ldrop_conf_lt: ∀L,L1,s1,d1,e1. ⇩[s1, d1, e1] L ≡ L1 → - ∀I,K2,V2,s2,e2. ⇩[s2, 0, e2] L ≡ K2.ⓑ{I}V2 → - e2 < d1 → let d ≝ d1 - e2 - 1 in - ∃∃K1,V1. ⇩[s2, 0, e2] L1 ≡ K1.ⓑ{I}V1 & - ⇩[s1, d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2. -#L #L1 #s1 #d1 #e1 #H1 #I #K2 #V2 #s2 #e2 #H2 #He2d1 -elim (ldrop_conf_le … H1 … H2) -L /2 width=2 by lt_to_le/ #K #HL1K #HK2 -elim (ldrop_inv_skip1 … HK2) -HK2 /2 width=1 by lt_plus_to_minus_r/ -#K1 #V1 #HK21 #HV12 #H destruct /2 width=5 by ex3_2_intro/ -qed-. - -(* Note: apparently this was missing in basic_1 *) -lemma ldrop_trans_lt: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → - ∀I,L2,V2,s2,e2. ⇩[s2, 0, e2] L ≡ L2.ⓑ{I}V2 → - e2 < d1 → let d ≝ d1 - e2 - 1 in - ∃∃L0,V0. ⇩[s2, 0, e2] L1 ≡ L0.ⓑ{I}V0 & - ⇩[s1, d, e1] L0 ≡ L2 & ⇧[d, e1] V2 ≡ V0. -#L1 #L #s1 #d1 #e1 #HL1 #I #L2 #V2 #s2 #e2 #HL2 #Hd21 -elim (ldrop_trans_le … HL1 … HL2) -L /2 width=1 by lt_to_le/ #L0 #HL10 #HL02 -elim (ldrop_inv_skip2 … HL02) -HL02 /2 width=1 by lt_plus_to_minus_r/ #L #V1 #HL2 #HV21 #H destruct /2 width=5 by ex3_2_intro/ -qed-. - -lemma ldrop_trans_ge_comm: ∀L1,L,L2,s1,d1,e1,e2. - ⇩[s1, d1, e1] L1 ≡ L → ⇩[e2] L ≡ L2 → d1 ≤ e2 → - ⇩[s1, 0, e2 + e1] L1 ≡ L2. -#L1 #L #L2 #s1 #d1 #e1 #e2 ->commutative_plus /2 width=5 by ldrop_trans_ge/ -qed. - -lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[e1] L ≡ K.ⓑ{I1}V1 → - ∀I2,V2,e2. ⇩[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_length_minus2 … HK) #H -elim (discr_minus_x_xy … H) -H -[1,3: normalize H in HK; #HK -lapply (ldrop_inv_O2 … HK) -HK #H destruct -lapply (inv_eq_minus_O … H) -H /3 width=1 by le_to_le_to_eq, and3_intro/ -qed-. - -(* Advanced forward lemmas **************************************************) - -lemma ldrop_fwd_be: ∀L,K,s,d,e,i. ⇩[s, d, e] L ≡ K → |K| ≤ i → i < d → |L| ≤ i. -#L #K #s #d #e #i #HLK #HK #Hd elim (lt_or_ge i (|L|)) // -#HL elim (ldrop_O1_lt (Ⓕ) … HL) #I #K0 #V #HLK0 -HL -elim (ldrop_conf_lt … HLK … HLK0) // -HLK -HLK0 -Hd -#K1 #V1 #HK1 #_ #_ lapply (ldrop_fwd_length_lt2 … HK1) -I -K1 -V1 -#H elim (lt_refl_false i) /2 width=3 by lt_to_le_to_lt/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_leq.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_leq.ma deleted file mode 100644 index 75586d3d3..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/ldrop_leq.ma +++ /dev/null @@ -1,92 +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/leq_leq.ma". -include "basic_2/relocation/ldrop.ma". - -(* BASIC SLICING FOR LOCAL ENVIRONMENTS *************************************) - -definition dedropable_sn: predicate (relation lenv) ≝ - λR. ∀L1,K1,s,d,e. ⇩[s, d, e] L1 ≡ K1 → ∀K2. R K1 K2 → - ∃∃L2. R L1 L2 & ⇩[s, d, e] L2 ≡ K2 & L1 ≃[d, e] L2. - -(* Properties on equivalence ************************************************) - -lemma leq_ldrop_trans_be: ∀L1,L2,d,e. L1 ≃[d, e] L2 → - ∀I,K2,W,s,i. ⇩[s, 0, i] L2 ≡ K2.ⓑ{I}W → - d ≤ i → i < d + e → - ∃∃K1. K1 ≃[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L1 ≡ K1.ⓑ{I}W. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e -[ #d #e #J #K2 #W #s #i #H - elim (ldrop_inv_atom1 … H) -H #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #_ #_ #J #K2 #W #s #i #_ #_ #H - elim (ylt_yle_false … H) // -| #I #L1 #L2 #V #e #HL12 #IHL12 #J #K2 #W #s #i #H #_ >yplus_O1 - elim (ldrop_inv_O1_pair1 … H) -H * #Hi #HLK1 [ -IHL12 | -HL12 ] - [ #_ destruct >ypred_succ - /2 width=3 by ldrop_pair, ex2_intro/ - | lapply (ylt_inv_O1 i ?) /2 width=1 by ylt_inj/ - #H yminus_succ yplus_succ1 #H lapply (ylt_inv_succ … H) -H - #Hide lapply (ldrop_inv_drop1_lt … HLK2 ?) -HLK2 /2 width=1 by ylt_O/ - #HLK1 elim (IHL12 … HLK1) -IHL12 -HLK1 yminus_SO2 - /4 width=3 by ylt_O, ldrop_drop_lt, ex2_intro/ -] -qed-. - -lemma leq_ldrop_conf_be: ∀L1,L2,d,e. L1 ≃[d, e] L2 → - ∀I,K1,W,s,i. ⇩[s, 0, i] L1 ≡ K1.ⓑ{I}W → - d ≤ i → i < d + e → - ∃∃K2. K1 ≃[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L2 ≡ K2.ⓑ{I}W. -#L1 #L2 #d #e #HL12 #I #K1 #W #s #i #HLK1 #Hdi #Hide -elim (leq_ldrop_trans_be … (leq_sym … HL12) … HLK1) // -L1 -Hdi -Hide -/3 width=3 by leq_sym, ex2_intro/ -qed-. - -lemma ldrop_O1_ex: ∀K2,i,L1. |L1| = |K2| + i → - ∃∃L2. L1 ≃[0, i] L2 & ⇩[i] L2 ≡ K2. -#K2 #i @(nat_ind_plus … i) -i -[ /3 width=3 by leq_O2, ex2_intro/ -| #i #IHi #Y #Hi elim (ldrop_O1_lt (Ⓕ) Y 0) // - #I #L1 #V #H lapply (ldrop_inv_O2 … H) -H #H destruct - normalize in Hi; elim (IHi L1) -IHi - /3 width=5 by ldrop_drop, leq_pair, injective_plus_l, ex2_intro/ -] -qed-. - -lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R). -#R #HR #L1 #K1 #s #d #e #HLK1 #K2 #H elim H -K2 -[ #K2 #HK12 elim (HR … HLK1 … HK12) -HR -K1 - /3 width=4 by inj, ex3_intro/ -| #K #K2 #_ #HK2 * #L #H1L1 #HLK #H2L1 elim (HR … HLK … HK2) -HR -K - /3 width=6 by leq_trans, step, ex3_intro/ -] -qed-. - -(* Inversion lemmas on equivalence ******************************************) - -lemma ldrop_O1_inj: ∀i,L1,L2,K. ⇩[i] L1 ≡ K → ⇩[i] L2 ≡ K → L1 ≃[i, ∞] L2. -#i @(nat_ind_plus … i) -i -[ #L1 #L2 #K #H <(ldrop_inv_O2 … H) -K #H <(ldrop_inv_O2 … H) -L1 // -| #i #IHi * [2: #L1 #I1 #V1 ] * [2,4: #L2 #I2 #V2 ] #K #HLK1 #HLK2 // - lapply (ldrop_fwd_length … HLK1) - <(ldrop_fwd_length … HLK2) [ /4 width=5 by ldrop_inv_drop1, leq_succ/ ] - normalize (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. - -(* 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 deleted file mode 100644 index 00973b220..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/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/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_associative // | /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 deleted file mode 100644 index f3ff80d11..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/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/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_neg.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_neg.ma deleted file mode 100644 index 6f4dd68d3..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lift_neg.ma +++ /dev/null @@ -1,67 +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/relocation/lift.ma". - -(* BASIC TERM RELOCATION ****************************************************) - -(* Properties on negated basic relocation ***********************************) - -lemma nlift_lref_be_SO: ∀X,i. ⇧[i, 1] X ≡ #i → ⊥. -/2 width=7 by lift_inv_lref2_be/ qed-. - -lemma nlift_bind_sn: ∀W,d,e. (∀V. ⇧[d, e] V ≡ W → ⊥) → - ∀a,I,U. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥). -#W #d #e #HW #a #I #U #X #H elim (lift_inv_bind2 … H) -H /2 width=2 by/ -qed-. - -lemma nlift_bind_dx: ∀U,d,e. (∀T. ⇧[d+1, e] T ≡ U → ⊥) → - ∀a,I,W. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥). -#U #d #e #HU #a #I #W #X #H elim (lift_inv_bind2 … H) -H /2 width=2 by/ -qed-. - -lemma nlift_flat_sn: ∀W,d,e. (∀V. ⇧[d, e] V ≡ W → ⊥) → - ∀I,U. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥). -#W #d #e #HW #I #U #X #H elim (lift_inv_flat2 … H) -H /2 width=2 by/ -qed-. - -lemma nlift_flat_dx: ∀U,d,e. (∀T. ⇧[d, e] T ≡ U → ⊥) → - ∀I,W. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥). -#U #d #e #HU #I #W #X #H elim (lift_inv_flat2 … H) -H /2 width=2 by/ -qed-. - -(* Inversion lemmas on negated basic relocation *****************************) - -lemma nlift_inv_lref_be_SO: ∀i,j. (∀X. ⇧[i, 1] X ≡ #j → ⊥) → j = i. -#i #j elim (lt_or_eq_or_gt i j) // #Hij #H -[ elim (H (#(j-1))) -H /2 width=1 by lift_lref_ge_minus/ -| elim (H (#j)) -H /2 width=1 by lift_lref_lt/ -] -qed-. - -lemma nlift_inv_bind: ∀a,I,W,U,d,e. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥) → - (∀V. ⇧[d, e] V ≡ W → ⊥) ∨ (∀T. ⇧[d+1, e] T ≡ U → ⊥). -#a #I #W #U #d #e #H elim (is_lift_dec W d e) -[ * /4 width=2 by lift_bind, or_intror/ -| /4 width=2 by ex_intro, or_introl/ -] -qed-. - -lemma nlift_inv_flat: ∀I,W,U,d,e. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥) → - (∀V. ⇧[d, e] V ≡ W → ⊥) ∨ (∀T. ⇧[d, e] T ≡ U → ⊥). -#I #W #U #d #e #H elim (is_lift_dec W d e) -[ * /4 width=2 by lift_flat, or_intror/ -| /4 width=2 by ex_intro, or_introl/ -] -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 deleted file mode 100644 index 52b7861be..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/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/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 by liftv_inv_nil1_aux/ 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 by ex3_2_intro/ -] -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 by liftv_inv_cons1_aux/ 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 by liftv_nil, ex_intro/ -| #T1 #T1s * #T2s #HT12s - elim (lift_total T1 d e) /3 width=2 by liftv_cons, ex_intro/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn.ma deleted file mode 100644 index 977fd887b..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn.ma +++ /dev/null @@ -1,89 +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_length.ma". - -(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) - -inductive lpx_sn (R:relation3 lenv term term): relation lenv ≝ -| lpx_sn_atom: lpx_sn R (⋆) (⋆) -| lpx_sn_pair: ∀I,K1,K2,V1,V2. - lpx_sn R K1 K2 → R K1 V1 V2 → - lpx_sn R (K1. ⓑ{I} V1) (K2. ⓑ{I} V2) -. - -(* Basic properties *********************************************************) - -lemma lpx_sn_refl: ∀R. (∀L. reflexive ? (R L)) → reflexive … (lpx_sn R). -#R #HR #L elim L -L /2 width=1 by lpx_sn_atom, lpx_sn_pair/ -qed-. - -(* Basic inversion lemmas ***************************************************) - -fact lpx_sn_inv_atom1_aux: ∀R,L1,L2. lpx_sn R L1 L2 → L1 = ⋆ → L2 = ⋆. -#R #L1 #L2 * -L1 -L2 -[ // -| #I #K1 #K2 #V1 #V2 #_ #_ #H destruct -] -qed-. - -lemma lpx_sn_inv_atom1: ∀R,L2. lpx_sn R (⋆) L2 → L2 = ⋆. -/2 width=4 by lpx_sn_inv_atom1_aux/ qed-. - -fact lpx_sn_inv_pair1_aux: ∀R,L1,L2. lpx_sn R L1 L2 → ∀I,K1,V1. L1 = K1. ⓑ{I} V1 → - ∃∃K2,V2. lpx_sn R K1 K2 & R K1 V1 V2 & L2 = K2. ⓑ{I} V2. -#R #L1 #L2 * -L1 -L2 -[ #J #K1 #V1 #H destruct -| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #J #L #W #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -lemma lpx_sn_inv_pair1: ∀R,I,K1,V1,L2. lpx_sn R (K1. ⓑ{I} V1) L2 → - ∃∃K2,V2. lpx_sn R K1 K2 & R K1 V1 V2 & L2 = K2. ⓑ{I} V2. -/2 width=3 by lpx_sn_inv_pair1_aux/ qed-. - -fact lpx_sn_inv_atom2_aux: ∀R,L1,L2. lpx_sn R L1 L2 → L2 = ⋆ → L1 = ⋆. -#R #L1 #L2 * -L1 -L2 -[ // -| #I #K1 #K2 #V1 #V2 #_ #_ #H destruct -] -qed-. - -lemma lpx_sn_inv_atom2: ∀R,L1. lpx_sn R L1 (⋆) → L1 = ⋆. -/2 width=4 by lpx_sn_inv_atom2_aux/ qed-. - -fact lpx_sn_inv_pair2_aux: ∀R,L1,L2. lpx_sn R L1 L2 → ∀I,K2,V2. L2 = K2. ⓑ{I} V2 → - ∃∃K1,V1. lpx_sn R K1 K2 & R K1 V1 V2 & L1 = K1. ⓑ{I} V1. -#R #L1 #L2 * -L1 -L2 -[ #J #K2 #V2 #H destruct -| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #J #K #W #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -lemma lpx_sn_inv_pair2: ∀R,I,L1,K2,V2. lpx_sn R L1 (K2. ⓑ{I} V2) → - ∃∃K1,V1. lpx_sn R K1 K2 & R K1 V1 V2 & L1 = K1. ⓑ{I} V1. -/2 width=3 by lpx_sn_inv_pair2_aux/ qed-. - -lemma lpx_sn_inv_pair: ∀R,I1,I2,L1,L2,V1,V2. - lpx_sn R (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) → - ∧∧ lpx_sn R L1 L2 & R L1 V1 V2 & I1 = I2. -#R #I1 #I2 #L1 #L2 #V1 #V2 #H elim (lpx_sn_inv_pair1 … H) -H -#L0 #V0 #HL10 #HV10 #H destruct /2 width=1 by and3_intro/ -qed-. - -(* Basic forward lemmas *****************************************************) - -lemma lpx_sn_fwd_length: ∀R,L1,L2. lpx_sn R L1 L2 → |L1| = |L2|. -#R #L1 #L2 #H elim H -L1 -L2 normalize // -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_alt.ma deleted file mode 100644 index 4f9ae350b..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_alt.ma +++ /dev/null @@ -1,125 +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/relocation/ldrop.ma". -include "basic_2/relocation/lpx_sn.ma". - -(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) - -(* alternative definition of lpx_sn *) -definition lpx_sn_alt: relation3 lenv term term → relation lenv ≝ - λR,L1,L2. |L1| = |L2| ∧ - (∀I1,I2,K1,K2,V1,V2,i. - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ R K1 V1 V2 - ). - -(* Basic forward lemmas ******************************************************) - -lemma lpx_sn_alt_fwd_length: ∀R,L1,L2. lpx_sn_alt R L1 L2 → |L1| = |L2|. -#R #L1 #L2 #H elim H // -qed-. - -(* Basic inversion lemmas ***************************************************) - -lemma lpx_sn_alt_inv_atom1: ∀R,L2. lpx_sn_alt R (⋆) L2 → L2 = ⋆. -#R #L2 #H lapply (lpx_sn_alt_fwd_length … H) -H -normalize /2 width=1 by length_inv_zero_sn/ -qed-. - -lemma lpx_sn_alt_inv_pair1: ∀R,I,L2,K1,V1. lpx_sn_alt R (K1.ⓑ{I}V1) L2 → - ∃∃K2,V2. lpx_sn_alt R K1 K2 & R K1 V1 V2 & L2 = K2.ⓑ{I}V2. -#R #I1 #L2 #K1 #V1 #H elim H -H -#H #IH elim (length_inv_pos_sn … H) -H -#I2 #K2 #V2 #HK12 #H destruct -elim (IH I1 I2 K1 K2 V1 V2 0) // -#H #HV12 destruct @(ex3_2_intro … K2 V2) // -HV12 -@conj // -HK12 -#J1 #J2 #L1 #L2 #W1 #W2 #i #HKL1 #HKL2 elim (IH J1 J2 L1 L2 W1 W2 (i+1)) -IH -/2 width=1 by ldrop_drop, conj/ -qed-. - -lemma lpx_sn_alt_inv_atom2: ∀R,L1. lpx_sn_alt R L1 (⋆) → L1 = ⋆. -#R #L1 #H lapply (lpx_sn_alt_fwd_length … H) -H -normalize /2 width=1 by length_inv_zero_dx/ -qed-. - -lemma lpx_sn_alt_inv_pair2: ∀R,I,L1,K2,V2. lpx_sn_alt R L1 (K2.ⓑ{I}V2) → - ∃∃K1,V1. lpx_sn_alt R K1 K2 & R K1 V1 V2 & L1 = K1.ⓑ{I}V1. -#R #I2 #L1 #K2 #V2 #H elim H -H -#H #IH elim (length_inv_pos_dx … H) -H -#I1 #K1 #V1 #HK12 #H destruct -elim (IH I1 I2 K1 K2 V1 V2 0) // -#H #HV12 destruct @(ex3_2_intro … K1 V1) // -HV12 -@conj // -HK12 -#J1 #J2 #L1 #L2 #W1 #W2 #i #HKL1 #HKL2 elim (IH J1 J2 L1 L2 W1 W2 (i+1)) -IH -/2 width=1 by ldrop_drop, conj/ -qed-. - -(* Basic properties *********************************************************) - -lemma lpx_sn_alt_atom: ∀R. lpx_sn_alt R (⋆) (⋆). -#R @conj // -#I1 #I2 #K1 #K2 #V1 #V2 #i #HLK1 elim (ldrop_inv_atom1 … HLK1) -HLK1 -#H destruct -qed. - -lemma lpx_sn_alt_pair: ∀R,I,L1,L2,V1,V2. - lpx_sn_alt R L1 L2 → R L1 V1 V2 → - lpx_sn_alt R (L1.ⓑ{I}V1) (L2.ⓑ{I}V2). -#R #I #L1 #L2 #V1 #V2 #H #HV12 elim H -H -#HL12 #IH @conj normalize // -#I1 #I2 #K1 #K2 #W1 #W2 #i @(nat_ind_plus … i) -i -[ #HLK1 #HLK2 - lapply (ldrop_inv_O2 … HLK1) -HLK1 #H destruct - lapply (ldrop_inv_O2 … HLK2) -HLK2 #H destruct - /2 width=1 by conj/ -| -HL12 -HV12 /3 width=6 by ldrop_inv_drop1/ -] -qed. - -(* Main properties **********************************************************) - -theorem lpx_sn_lpx_sn_alt: ∀R,L1,L2. lpx_sn R L1 L2 → lpx_sn_alt R L1 L2. -#R #L1 #L2 #H elim H -L1 -L2 -/2 width=1 by lpx_sn_alt_atom, lpx_sn_alt_pair/ -qed. - -(* Main inversion lemmas ****************************************************) - -theorem lpx_sn_alt_inv_lpx_sn: ∀R,L1,L2. lpx_sn_alt R L1 L2 → lpx_sn R L1 L2. -#R #L1 elim L1 -L1 -[ #L2 #H lapply (lpx_sn_alt_inv_atom1 … H) -H // -| #L1 #I #V1 #IH #X #H elim (lpx_sn_alt_inv_pair1 … H) -H - #L2 #V2 #HL12 #HV12 #H destruct /3 width=1 by lpx_sn_pair/ -] -qed-. - -(* alternative definition of lpx_sn *****************************************) - -lemma lpx_sn_intro_alt: ∀R,L1,L2. |L1| = |L2| → - (∀I1,I2,K1,K2,V1,V2,i. - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ R K1 V1 V2 - ) → lpx_sn R L1 L2. -/4 width=4 by lpx_sn_alt_inv_lpx_sn, conj/ qed. - -lemma lpx_sn_inv_alt: ∀R,L1,L2. lpx_sn R L1 L2 → - |L1| = |L2| ∧ - ∀I1,I2,K1,K2,V1,V2,i. - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ R K1 V1 V2. -#R #L1 #L2 #H lapply (lpx_sn_lpx_sn_alt … H) -H -#H elim H -H /3 width=4 by conj/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_ldrop.ma deleted file mode 100644 index 1edda7640..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_ldrop.ma +++ /dev/null @@ -1,104 +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/relocation/ldrop_leq.ma". -include "basic_2/relocation/lpx_sn.ma". - -(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) - -(* Properies on dropping ****************************************************) - -lemma lpx_sn_ldrop_conf: ∀R,L1,L2. lpx_sn R L1 L2 → - ∀I,K1,V1,i. ⇩[i] L1 ≡ K1.ⓑ{I}V1 → - ∃∃K2,V2. ⇩[i] L2 ≡ K2.ⓑ{I}V2 & lpx_sn R K1 K2 & R K1 V1 V2. -#R #L1 #L2 #H elim H -L1 -L2 -[ #I0 #K0 #V0 #i #H elim (ldrop_inv_atom1 … H) -H #H destruct -| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #IHK12 #I0 #K0 #V0 #i #H elim (ldrop_inv_O1_pair1 … H) * -H - [ -IHK12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ex3_2_intro/ - | -HK12 -HV12 #Hi #HK10 elim (IHK12 … HK10) -IHK12 -HK10 - /3 width=5 by ldrop_drop_lt, ex3_2_intro/ - ] -] -qed-. - -lemma lpx_sn_ldrop_trans: ∀R,L1,L2. lpx_sn R L1 L2 → - ∀I,K2,V2,i. ⇩[i] L2 ≡ K2.ⓑ{I}V2 → - ∃∃K1,V1. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & lpx_sn R K1 K2 & R K1 V1 V2. -#R #L1 #L2 #H elim H -L1 -L2 -[ #I0 #K0 #V0 #i #H elim (ldrop_inv_atom1 … H) -H #H destruct -| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #IHK12 #I0 #K0 #V0 #i #H elim (ldrop_inv_O1_pair1 … H) * -H - [ -IHK12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ex3_2_intro/ - | -HK12 -HV12 #Hi #HK10 elim (IHK12 … HK10) -IHK12 -HK10 - /3 width=5 by ldrop_drop_lt, ex3_2_intro/ - ] -] -qed-. - -lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R). -#R #HR #L1 #K1 #s #d #e #H elim H -L1 -K1 -d -e -[ #d #e #He #X #H >(lpx_sn_inv_atom1 … H) -H - /4 width=3 by ldrop_atom, lpx_sn_atom, ex2_intro/ -| #I #K1 #V1 #X #H elim (lpx_sn_inv_pair1 … H) -H - #L2 #V2 #HL12 #HV12 #H destruct - /3 width=5 by ldrop_pair, lpx_sn_pair, ex2_intro/ -| #I #L1 #K1 #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 by ldrop_drop, ex2_intro/ -| #I #L1 #K1 #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 by ldrop_skip, lpx_sn_pair, ex2_intro/ -] -qed-. - -lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) → - l_liftable R → dedropable_sn (lpx_sn R). -#R #H1R #H2R #L1 #K1 #s #d #e #H elim H -L1 -K1 -d -e -[ #d #e #He #X #H >(lpx_sn_inv_atom1 … H) -H - /4 width=4 by ldrop_atom, lpx_sn_atom, ex3_intro/ -| #I #K1 #V1 #X #H elim (lpx_sn_inv_pair1 … H) -H - #K2 #V2 #HK12 #HV12 #H destruct - lapply (lpx_sn_fwd_length … HK12) - #H @(ex3_intro … (K2.ⓑ{I}V2)) (**) (* explicit constructor *) - /3 width=1 by lpx_sn_pair, monotonic_le_plus_l/ - @leq_O2 normalize // -| #I #L1 #K1 #V1 #e #_ #IHLK1 #K2 #HK12 elim (IHLK1 … HK12) -K1 - /3 width=5 by ldrop_drop, leq_pair, lpx_sn_pair, ex3_intro/ -| #I #L1 #K1 #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=6 by ldrop_skip, leq_succ, lpx_sn_pair, ex3_intro/ -] -qed-. - -fact lpx_sn_dropable_aux: ∀R,L2,K2,s,d,e. ⇩[s, d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 → - d = 0 → ∃∃K1. ⇩[s, 0, e] L1 ≡ K1 & lpx_sn R K1 K2. -#R #L2 #K2 #s #d #e #H elim H -L2 -K2 -d -e -[ #d #e #He #X #H >(lpx_sn_inv_atom2 … H) -H - /4 width=3 by ldrop_atom, lpx_sn_atom, ex2_intro/ -| #I #K2 #V2 #X #H elim (lpx_sn_inv_pair2 … H) -H - #K1 #V1 #HK12 #HV12 #H destruct - /3 width=5 by ldrop_pair, lpx_sn_pair, ex2_intro/ -| #I #L2 #K2 #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 by ldrop_drop, ex2_intro/ -| #I #L2 #K2 #V2 #W2 #d #e #_ #_ #_ #L1 #_ - (lpx_sn_inv_atom1 … H1) -X1 - >(lpx_sn_inv_atom1 … H2) -X2 /2 width=3 by lpx_sn_atom, ex2_intro/ -| #L0 #I #V0 #Hn #X1 #H1 #X2 #H2 destruct - 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 (HR12 … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5 by lpx_sn_pair, ex2_intro/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_tc.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_tc.ma deleted file mode 100644 index e994bf076..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lpx_sn_tc.ma +++ /dev/null @@ -1,119 +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/relocation/lpx_sn.ma". - -(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) - -(* Properties on transitive_closure *****************************************) - -lemma TC_lpx_sn_pair_refl: ∀R. (∀L. reflexive … (R L)) → - ∀L1,L2. TC … (lpx_sn R) L1 L2 → - ∀I,V. TC … (lpx_sn R) (L1. ⓑ{I} V) (L2. ⓑ{I} V). -#R #HR #L1 #L2 #H @(TC_star_ind … L2 H) -L2 -[ /2 width=1 by lpx_sn_refl/ -| /3 width=1 by TC_reflexive, lpx_sn_refl/ -| /3 width=5 by lpx_sn_pair, step/ -] -qed-. - -lemma TC_lpx_sn_pair: ∀R. (∀L. reflexive … (R L)) → - ∀I,L1,L2. TC … (lpx_sn R) L1 L2 → - ∀V1,V2. LTC … R L1 V1 V2 → - TC … (lpx_sn R) (L1. ⓑ{I} V1) (L2. ⓑ{I} V2). -#R #HR #I #L1 #L2 #HL12 #V1 #V2 #H @(TC_star_ind_dx … V1 H) -V1 // -[ /2 width=1 by TC_lpx_sn_pair_refl/ -| /4 width=3 by TC_strap, lpx_sn_pair, lpx_sn_refl/ -] -qed-. - -lemma lpx_sn_LTC_TC_lpx_sn: ∀R. (∀L. reflexive … (R L)) → - ∀L1,L2. lpx_sn (LTC … R) L1 L2 → - TC … (lpx_sn R) L1 L2. -#R #HR #L1 #L2 #H elim H -L1 -L2 -/2 width=1 by TC_lpx_sn_pair, lpx_sn_atom, inj/ -qed-. - -(* Inversion lemmas on transitive closure ***********************************) - -lemma TC_lpx_sn_inv_atom2: ∀R,L1. TC … (lpx_sn R) L1 (⋆) → L1 = ⋆. -#R #L1 #H @(TC_ind_dx … L1 H) -L1 -[ /2 width=2 by lpx_sn_inv_atom2/ -| #L1 #L #HL1 #_ #IHL2 destruct /2 width=2 by lpx_sn_inv_atom2/ -] -qed-. - -lemma TC_lpx_sn_inv_pair2: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → - ∀I,L1,K2,V2. TC … (lpx_sn R) L1 (K2.ⓑ{I}V2) → - ∃∃K1,V1. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L1 = K1. ⓑ{I} V1. -#R #HR #I #L1 #K2 #V2 #H @(TC_ind_dx … L1 H) -L1 -[ #L1 #H elim (lpx_sn_inv_pair2 … H) -H /3 width=5 by inj, ex3_2_intro/ -| #L1 #L #HL1 #_ * #K #V #HK2 #HV2 #H destruct - elim (lpx_sn_inv_pair2 … HL1) -HL1 #K1 #V1 #HK1 #HV1 #H destruct - lapply (HR … HV2 … HK1) -HR -HV2 /3 width=5 by TC_strap, ex3_2_intro/ -] -qed-. - -lemma TC_lpx_sn_ind: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → - ∀S:relation lenv. - S (⋆) (⋆) → ( - ∀I,K1,K2,V1,V2. - TC … (lpx_sn R) K1 K2 → LTC … R K1 V1 V2 → - S K1 K2 → S (K1.ⓑ{I}V1) (K2.ⓑ{I}V2) - ) → - ∀L2,L1. TC … (lpx_sn R) L1 L2 → S L1 L2. -#R #HR #S #IH1 #IH2 #L2 elim L2 -L2 -[ #X #H >(TC_lpx_sn_inv_atom2 … H) -X // -| #L2 #I #V2 #IHL2 #X #H - elim (TC_lpx_sn_inv_pair2 … H) // -H -HR - #L1 #V1 #HL12 #HV12 #H destruct /3 width=1 by/ -] -qed-. - -lemma TC_lpx_sn_inv_atom1: ∀R,L2. TC … (lpx_sn R) (⋆) L2 → L2 = ⋆. -#R #L2 #H elim H -L2 -[ /2 width=2 by lpx_sn_inv_atom1/ -| #L #L2 #_ #HL2 #IHL1 destruct /2 width=2 by lpx_sn_inv_atom1/ -] -qed-. - -fact TC_lpx_sn_inv_pair1_aux: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → - ∀L1,L2. TC … (lpx_sn R) L1 L2 → - ∀I,K1,V1. L1 = K1.ⓑ{I}V1 → - ∃∃K2,V2. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L2 = K2. ⓑ{I} V2. -#R #HR #L1 #L2 #H @(TC_lpx_sn_ind … H) // -HR -L1 -L2 -[ #J #K #W #H destruct -| #I #L1 #L2 #V1 #V2 #HL12 #HV12 #_ #J #K #W #H destruct /2 width=5 by ex3_2_intro/ -] -qed-. - -lemma TC_lpx_sn_inv_pair1: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → - ∀I,K1,L2,V1. TC … (lpx_sn R) (K1.ⓑ{I}V1) L2 → - ∃∃K2,V2. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L2 = K2. ⓑ{I} V2. -/2 width=3 by TC_lpx_sn_inv_pair1_aux/ qed-. - -lemma TC_lpx_sn_inv_lpx_sn_LTC: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → - ∀L1,L2. TC … (lpx_sn R) L1 L2 → - lpx_sn (LTC … R) L1 L2. -/3 width=4 by TC_lpx_sn_ind, lpx_sn_pair/ qed-. - -(* Forward lemmas on transitive closure *************************************) - -lemma TC_lpx_sn_fwd_length: ∀R,L1,L2. TC … (lpx_sn R) L1 L2 → |L1| = |L2|. -#R #L1 #L2 #H elim H -L2 -[ #L2 #HL12 >(lpx_sn_fwd_length … HL12) -HL12 // -| #L #L2 #_ #HL2 #IHL1 - >IHL1 -L1 >(lpx_sn_fwd_length … HL2) -HL2 // -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby.ma deleted file mode 100644 index 77bcf4c7a..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby.ma +++ /dev/null @@ -1,237 +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 "ground_2/ynat/ynat_plus.ma". -include "basic_2/notation/relations/lrsubeq_4.ma". -include "basic_2/relocation/ldrop.ma". - -(* LOCAL ENVIRONMENT REFINEMENT FOR EXTENDED SUBSTITUTION *******************) - -inductive lsuby: relation4 ynat ynat lenv lenv ≝ -| lsuby_atom: ∀L,d,e. lsuby d e L (⋆) -| lsuby_zero: ∀I1,I2,L1,L2,V1,V2. - lsuby 0 0 L1 L2 → lsuby 0 0 (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) -| lsuby_pair: ∀I1,I2,L1,L2,V,e. lsuby 0 e L1 L2 → - lsuby 0 (⫯e) (L1.ⓑ{I1}V) (L2.ⓑ{I2}V) -| lsuby_succ: ∀I1,I2,L1,L2,V1,V2,d,e. - lsuby d e L1 L2 → lsuby (⫯d) e (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) -. - -interpretation - "local environment refinement (extended substitution)" - 'LRSubEq L1 d e L2 = (lsuby d e L1 L2). - -(* Basic properties *********************************************************) - -lemma lsuby_pair_lt: ∀I1,I2,L1,L2,V,e. L1 ⊆[0, ⫰e] L2 → 0 < e → - L1.ⓑ{I1}V ⊆[0, e] L2.ⓑ{I2}V. -#I1 #I2 #L1 #L2 #V #e #HL12 #He <(ylt_inv_O1 … He) /2 width=1 by lsuby_pair/ -qed. - -lemma lsuby_succ_lt: ∀I1,I2,L1,L2,V1,V2,d,e. L1 ⊆[⫰d, e] L2 → 0 < d → - L1.ⓑ{I1}V1 ⊆[d, e] L2. ⓑ{I2}V2. -#I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #Hd <(ylt_inv_O1 … Hd) /2 width=1 by lsuby_succ/ -qed. - -lemma lsuby_pair_O_Y: ∀L1,L2. L1 ⊆[0, ∞] L2 → - ∀I1,I2,V. L1.ⓑ{I1}V ⊆[0,∞] L2.ⓑ{I2}V. -#L1 #L2 #HL12 #I1 #I2 #V lapply (lsuby_pair I1 I2 … V … HL12) -HL12 // -qed. - -lemma lsuby_refl: ∀L,d,e. L ⊆[d, e] L. -#L elim L -L // -#L #I #V #IHL #d elim (ynat_cases … d) [| * #x ] -#Hd destruct /2 width=1 by lsuby_succ/ -#e elim (ynat_cases … e) [| * #x ] -#He destruct /2 width=1 by lsuby_zero, lsuby_pair/ -qed. - -lemma lsuby_O2: ∀L2,L1,d. |L2| ≤ |L1| → L1 ⊆[d, yinj 0] L2. -#L2 elim L2 -L2 // #L2 #I2 #V2 #IHL2 * normalize -[ #d #H elim (le_plus_xSy_O_false … H) -| #L1 #I1 #V1 #d #H lapply (le_plus_to_le_r … H) -H #HL12 - elim (ynat_cases d) /3 width=1 by lsuby_zero/ - * /3 width=1 by lsuby_succ/ -] -qed. - -lemma lsuby_sym: ∀d,e,L1,L2. L1 ⊆[d, e] L2 → |L1| = |L2| → L2 ⊆[d, e] L1. -#d #e #L1 #L2 #H elim H -d -e -L1 -L2 -[ #L1 #d #e #H >(length_inv_zero_dx … H) -L1 // -| /2 width=1 by lsuby_O2/ -| #I1 #I2 #L1 #L2 #V #e #_ #IHL12 #H lapply (injective_plus_l … H) - /3 width=1 by lsuby_pair/ -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #IHL12 #H lapply (injective_plus_l … H) - /3 width=1 by lsuby_succ/ -] -qed-. - -(* Basic inversion lemmas ***************************************************) - -fact lsuby_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → L1 = ⋆ → L2 = ⋆. -#L1 #L2 #d #e * -L1 -L2 -d -e // -[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #H destruct -| #I1 #I2 #L1 #L2 #V #e #_ #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #H destruct -] -qed-. - -lemma lsuby_inv_atom1: ∀L2,d,e. ⋆ ⊆[d, e] L2 → L2 = ⋆. -/2 width=5 by lsuby_inv_atom1_aux/ qed-. - -fact lsuby_inv_zero1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J1,K1,W1. L1 = K1.ⓑ{J1}W1 → d = 0 → e = 0 → - L2 = ⋆ ∨ - ∃∃J2,K2,W2. K1 ⊆[0, 0] K2 & L2 = K2.ⓑ{J2}W2. -#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ -[ #I1 #I2 #L1 #L2 #V1 #V2 #HL12 #J1 #K1 #W1 #H #_ #_ destruct - /3 width=5 by ex2_3_intro, or_intror/ -| #I1 #I2 #L1 #L2 #V #e #_ #J1 #K1 #W1 #_ #_ #H - elim (ysucc_inv_O_dx … H) -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J1 #K1 #W1 #_ #H - elim (ysucc_inv_O_dx … H) -] -qed-. - -lemma lsuby_inv_zero1: ∀I1,K1,L2,V1. K1.ⓑ{I1}V1 ⊆[0, 0] L2 → - L2 = ⋆ ∨ - ∃∃I2,K2,V2. K1 ⊆[0, 0] K2 & L2 = K2.ⓑ{I2}V2. -/2 width=9 by lsuby_inv_zero1_aux/ qed-. - -fact lsuby_inv_pair1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J1,K1,W. L1 = K1.ⓑ{J1}W → d = 0 → 0 < e → - L2 = ⋆ ∨ - ∃∃J2,K2. K1 ⊆[0, ⫰e] K2 & L2 = K2.ⓑ{J2}W. -#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ -[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #J1 #K1 #W #_ #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V #e #HL12 #J1 #K1 #W #H #_ #_ destruct - /3 width=4 by ex2_2_intro, or_intror/ -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J1 #K1 #W #_ #H - elim (ysucc_inv_O_dx … H) -] -qed-. - -lemma lsuby_inv_pair1: ∀I1,K1,L2,V,e. K1.ⓑ{I1}V ⊆[0, e] L2 → 0 < e → - L2 = ⋆ ∨ - ∃∃I2,K2. K1 ⊆[0, ⫰e] K2 & L2 = K2.ⓑ{I2}V. -/2 width=6 by lsuby_inv_pair1_aux/ qed-. - -fact lsuby_inv_succ1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J1,K1,W1. L1 = K1.ⓑ{J1}W1 → 0 < d → - L2 = ⋆ ∨ - ∃∃J2,K2,W2. K1 ⊆[⫰d, e] K2 & L2 = K2.ⓑ{J2}W2. -#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ -[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #J1 #K1 #W1 #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V #e #_ #J1 #K1 #W1 #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #J1 #K1 #W1 #H #_ destruct - /3 width=5 by ex2_3_intro, or_intror/ -] -qed-. - -lemma lsuby_inv_succ1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊆[d, e] L2 → 0 < d → - L2 = ⋆ ∨ - ∃∃I2,K2,V2. K1 ⊆[⫰d, e] K2 & L2 = K2.ⓑ{I2}V2. -/2 width=5 by lsuby_inv_succ1_aux/ qed-. - -fact lsuby_inv_zero2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J2,K2,W2. L2 = K2.ⓑ{J2}W2 → d = 0 → e = 0 → - ∃∃J1,K1,W1. K1 ⊆[0, 0] K2 & L1 = K1.ⓑ{J1}W1. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #L1 #d #e #J2 #K2 #W1 #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #HL12 #J2 #K2 #W2 #H #_ #_ destruct - /2 width=5 by ex2_3_intro/ -| #I1 #I2 #L1 #L2 #V #e #_ #J2 #K2 #W2 #_ #_ #H - elim (ysucc_inv_O_dx … H) -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J2 #K2 #W2 #_ #H - elim (ysucc_inv_O_dx … H) -] -qed-. - -lemma lsuby_inv_zero2: ∀I2,K2,L1,V2. L1 ⊆[0, 0] K2.ⓑ{I2}V2 → - ∃∃I1,K1,V1. K1 ⊆[0, 0] K2 & L1 = K1.ⓑ{I1}V1. -/2 width=9 by lsuby_inv_zero2_aux/ qed-. - -fact lsuby_inv_pair2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J2,K2,W. L2 = K2.ⓑ{J2}W → d = 0 → 0 < e → - ∃∃J1,K1. K1 ⊆[0, ⫰e] K2 & L1 = K1.ⓑ{J1}W. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #L1 #d #e #J2 #K2 #W #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #_ #J2 #K2 #W #_ #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V #e #HL12 #J2 #K2 #W #H #_ #_ destruct - /2 width=4 by ex2_2_intro/ -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J2 #K2 #W #_ #H - elim (ysucc_inv_O_dx … H) -] -qed-. - -lemma lsuby_inv_pair2: ∀I2,K2,L1,V,e. L1 ⊆[0, e] K2.ⓑ{I2}V → 0 < e → - ∃∃I1,K1. K1 ⊆[0, ⫰e] K2 & L1 = K1.ⓑ{I1}V. -/2 width=6 by lsuby_inv_pair2_aux/ qed-. - -fact lsuby_inv_succ2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀J2,K2,W2. L2 = K2.ⓑ{J2}W2 → 0 < d → - ∃∃J1,K1,W1. K1 ⊆[⫰d, e] K2 & L1 = K1.ⓑ{J1}W1. -#L1 #L2 #d #e * -L1 -L2 -d -e -[ #L1 #d #e #J2 #K2 #W2 #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #_ #J2 #K2 #W2 #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V #e #_ #J2 #K1 #W2 #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #J2 #K2 #W2 #H #_ destruct - /2 width=5 by ex2_3_intro/ -] -qed-. - -lemma lsuby_inv_succ2: ∀I2,K2,L1,V2,d,e. L1 ⊆[d, e] K2.ⓑ{I2}V2 → 0 < d → - ∃∃I1,K1,V1. K1 ⊆[⫰d, e] K2 & L1 = K1.ⓑ{I1}V1. -/2 width=5 by lsuby_inv_succ2_aux/ qed-. - -(* Basic forward lemmas *****************************************************) - -lemma lsuby_fwd_length: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → |L2| ≤ |L1|. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize /2 width=1 by le_S_S/ -qed-. - -(* Properties on basic slicing **********************************************) - -lemma lsuby_ldrop_trans_be: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → - ∀I2,K2,W,s,i. ⇩[s, 0, i] L2 ≡ K2.ⓑ{I2}W → - d ≤ i → i < d + e → - ∃∃I1,K1. K1 ⊆[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L1 ≡ K1.ⓑ{I1}W. -#L1 #L2 #d #e #H elim H -L1 -L2 -d -e -[ #L1 #d #e #J2 #K2 #W #s #i #H - elim (ldrop_inv_atom1 … H) -H #H destruct -| #I1 #I2 #L1 #L2 #V1 #V2 #_ #_ #J2 #K2 #W #s #i #_ #_ #H - elim (ylt_yle_false … H) // -| #I1 #I2 #L1 #L2 #V #e #HL12 #IHL12 #J2 #K2 #W #s #i #H #_ >yplus_O1 - elim (ldrop_inv_O1_pair1 … H) -H * #Hi #HLK1 [ -IHL12 | -HL12 ] - [ #_ destruct -I2 >ypred_succ - /2 width=4 by ldrop_pair, ex2_2_intro/ - | lapply (ylt_inv_O1 i ?) /2 width=1 by ylt_inj/ - #H yminus_succ yplus_succ1 #H lapply (ylt_inv_succ … H) -H - #Hide lapply (ldrop_inv_drop1_lt … HLK2 ?) -HLK2 /2 width=1 by ylt_O/ - #HLK1 elim (IHL12 … HLK1) -IHL12 -HLK1 yminus_SO2 - /4 width=4 by ylt_O, ldrop_drop_lt, ex2_2_intro/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby_lsuby.ma b/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby_lsuby.ma deleted file mode 100644 index 24361d3c0..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/relocation/lsuby_lsuby.ma +++ /dev/null @@ -1,32 +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/relocation/lsuby.ma". - -(* LOCAL ENVIRONMENT REFINEMENT FOR EXTENDED SUBSTITUTION *******************) - -(* Main properties **********************************************************) - -theorem lsuby_trans: ∀d,e. Transitive … (lsuby d e). -#d #e #L1 #L2 #H elim H -L1 -L2 -d -e -[ #L1 #d #e #X #H lapply (lsuby_inv_atom1 … H) -H - #H destruct // -| #I1 #I2 #L1 #L #V1 #V #_ #IHL1 #X #H elim (lsuby_inv_zero1 … H) -H // - * #I2 #L2 #V2 #HL2 #H destruct /3 width=1 by lsuby_zero/ -| #I1 #I2 #L1 #L2 #V #e #_ #IHL1 #X #H elim (lsuby_inv_pair1 … H) -H // - * #I2 #L2 #HL2 #H destruct /3 width=1 by lsuby_pair/ -| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #IHL1 #X #H elim (lsuby_inv_succ1 … H) -H // - * #I2 #L2 #V2 #HL2 #H destruct /3 width=1 by lsuby_succ/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa.ma index 5e93f55f1..e0039e238 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa.ma @@ -15,7 +15,7 @@ include "basic_2/notation/relations/atomicarity_4.ma". include "basic_2/grammar/aarity.ma". include "basic_2/grammar/genv.ma". -include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/ldrop.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_aaa.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_aaa.ma index d0cff387f..7c3645d22 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_aaa.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_aaa.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/static/aaa.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_fqus.ma index f0153d5a2..e32e0b529 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_fqus.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_fqus.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/fqus_alt.ma". +include "basic_2/multiple/fqus_alt.ma". include "basic_2/static/aaa_lift.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lift.ma index f0b5f8a40..c5fa16299 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/static/aaa.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lifts.ma index b803d42ae..1c4547819 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lifts.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lifts.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/ldrops.ma". +include "basic_2/multiple/ldrops.ma". include "basic_2/static/aaa_lift.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lleq.ma index 7650113a1..0daf65b6b 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lleq.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/aaa_lleq.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/lleq_ldrop.ma". +include "basic_2/multiple/lleq_ldrop.ma". include "basic_2/static/aaa.ma". (* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/da.ma b/matita/matita/contribs/lambdadelta/basic_2/static/da.ma index ad4d8c182..9b96b39c2 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/da.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/da.ma @@ -14,7 +14,7 @@ include "basic_2/notation/relations/degree_6.ma". include "basic_2/grammar/genv.ma". -include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/ldrop.ma". include "basic_2/static/sd.ma". (* DEGREE ASSIGNMENT FOR TERMS **********************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/da_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/static/da_lift.ma index 78d575b8d..597420ddf 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/da_lift.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/da_lift.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/relocation/ldrop_ldrop.ma". +include "basic_2/substitution/ldrop_ldrop.ma". include "basic_2/static/da.ma". (* DEGREE ASSIGNMENT FOR TERMS **********************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/lsubr.ma b/matita/matita/contribs/lambdadelta/basic_2/static/lsubr.ma index 0595e7c20..ea1ddabec 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/lsubr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/lsubr.ma @@ -13,7 +13,7 @@ (**************************************************************************) include "basic_2/notation/relations/lrsubeqc_2.ma". -include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/ldrop.ma". (* RESTRICTED LOCAL ENVIRONMENT REFINEMENT **********************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/ssta_llpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/static/ssta_llpx_sn.ma index 0d08b9f5d..1f784fffd 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/ssta_llpx_sn.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/ssta_llpx_sn.ma @@ -12,7 +12,7 @@ (* *) (**************************************************************************) -include "basic_2/substitution/llpx_sn_ldrop.ma". +include "basic_2/multiple/llpx_sn_ldrop.ma". include "basic_2/static/ssta.ma". (* STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS ******************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy.ma new file mode 100644 index 000000000..bf38e8a25 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy.ma @@ -0,0 +1,296 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "ground_2/ynat/ynat_max.ma". +include "basic_2/notation/relations/psubst_6.ma". +include "basic_2/grammar/genv.ma". +include "basic_2/substitution/lsuby.ma". + +(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) + +(* activate genv *) +inductive cpy: ynat → ynat → relation4 genv lenv term term ≝ +| cpy_atom : ∀I,G,L,d,e. cpy d e G L (⓪{I}) (⓪{I}) +| cpy_subst: ∀I,G,L,K,V,W,i,d,e. d ≤ yinj i → i < d+e → + ⇩[i] L ≡ K.ⓑ{I}V → ⇧[0, i+1] V ≡ W → cpy d e G L (#i) W +| cpy_bind : ∀a,I,G,L,V1,V2,T1,T2,d,e. + cpy d e G L V1 V2 → cpy (⫯d) e G (L.ⓑ{I}V1) T1 T2 → + cpy d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) +| cpy_flat : ∀I,G,L,V1,V2,T1,T2,d,e. + cpy d e G L V1 V2 → cpy d e G L T1 T2 → + cpy d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) +. + +interpretation "context-sensitive extended ordinary substritution (term)" + 'PSubst G L T1 d e T2 = (cpy d e G L T1 T2). + +(* Basic properties *********************************************************) + +lemma lsuby_cpy_trans: ∀G,d,e. lsub_trans … (cpy d e G) (lsuby d e). +#G #d #e #L1 #T1 #T2 #H elim H -G -L1 -T1 -T2 -d -e +[ // +| #I #G #L1 #K1 #V #W #i #d #e #Hdi #Hide #HLK1 #HVW #L2 #HL12 + elim (lsuby_ldrop_trans_be … HL12 … HLK1) -HL12 -HLK1 /2 width=5 by cpy_subst/ +| /4 width=1 by lsuby_succ, cpy_bind/ +| /3 width=1 by cpy_flat/ +] +qed-. + +lemma cpy_refl: ∀G,T,L,d,e. ⦃G, L⦄ ⊢ T ▶[d, e] T. +#G #T elim T -T // * /2 width=1 by cpy_bind, cpy_flat/ +qed. + +(* Basic_1: was: subst1_ex *) +lemma cpy_full: ∀I,G,K,V,T1,L,d. ⇩[d] L ≡ K.ⓑ{I}V → + ∃∃T2,T. ⦃G, L⦄ ⊢ T1 ▶[d, 1] T2 & ⇧[d, 1] T ≡ T2. +#I #G #K #V #T1 elim T1 -T1 +[ * #i #L #d #HLK + /2 width=4 by lift_sort, lift_gref, ex2_2_intro/ + elim (lt_or_eq_or_gt i d) #Hid + /3 width=4 by lift_lref_ge_minus, lift_lref_lt, ex2_2_intro/ + destruct + elim (lift_total V 0 (i+1)) #W #HVW + elim (lift_split … HVW i i) + /4 width=5 by cpy_subst, ylt_inj, ex2_2_intro/ +| * [ #a ] #J #W1 #U1 #IHW1 #IHU1 #L #d #HLK + elim (IHW1 … HLK) -IHW1 #W2 #W #HW12 #HW2 + [ elim (IHU1 (L.ⓑ{J}W1) (d+1)) -IHU1 + /3 width=9 by cpy_bind, ldrop_drop, lift_bind, ex2_2_intro/ + | elim (IHU1 … HLK) -IHU1 -HLK + /3 width=8 by cpy_flat, lift_flat, ex2_2_intro/ + ] +] +qed-. + +lemma cpy_weak: ∀G,L,T1,T2,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T2 → + ∀d2,e2. d2 ≤ d1 → d1 + e1 ≤ d2 + e2 → + ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T2. +#G #L #T1 #T2 #d1 #e1 #H elim H -G -L -T1 -T2 -d1 -e1 // +[ /3 width=5 by cpy_subst, ylt_yle_trans, yle_trans/ +| /4 width=3 by cpy_bind, ylt_yle_trans, yle_succ/ +| /3 width=1 by cpy_flat/ +] +qed-. + +lemma cpy_weak_top: ∀G,L,T1,T2,d,e. + ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶[d, |L| - d] T2. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e // +[ #I #G #L #K #V #W #i #d #e #Hdi #_ #HLK #HVW + lapply (ldrop_fwd_length_lt2 … HLK) + /4 width=5 by cpy_subst, ylt_yle_trans, ylt_inj/ +| #a #I #G #L #V1 #V2 normalize in match (|L.ⓑ{I}V2|); (**) (* |?| does not work *) + /2 width=1 by cpy_bind/ +| /2 width=1 by cpy_flat/ +] +qed-. + +lemma cpy_weak_full: ∀G,L,T1,T2,d,e. + ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶[0, |L|] T2. +#G #L #T1 #T2 #d #e #HT12 +lapply (cpy_weak … HT12 0 (d + e) ? ?) -HT12 +/2 width=2 by cpy_weak_top/ +qed-. + +lemma cpy_split_up: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀i. i ≤ d + e → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d, i-d] T & ⦃G, L⦄ ⊢ T ▶[i, d+e-i] T2. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e +[ /2 width=3 by ex2_intro/ +| #I #G #L #K #V #W #i #d #e #Hdi #Hide #HLK #HVW #j #Hjde + elim (ylt_split i j) [ -Hide -Hjde | -Hdi ] + /4 width=9 by cpy_subst, ylt_yle_trans, ex2_intro/ +| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide + elim (IHV12 i) -IHV12 // #V + elim (IHT12 (i+1)) -IHT12 /2 width=1 by yle_succ/ -Hide + >yplus_SO2 >yplus_succ1 #T #HT1 #HT2 + lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 + /3 width=5 by lsuby_succ, ex2_intro, cpy_bind/ +| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide + elim (IHV12 i) -IHV12 // elim (IHT12 i) -IHT12 // -Hide + /3 width=5 by ex2_intro, cpy_flat/ +] +qed-. + +lemma cpy_split_down: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀i. i ≤ d + e → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[i, d+e-i] T & ⦃G, L⦄ ⊢ T ▶[d, i-d] T2. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e +[ /2 width=3 by ex2_intro/ +| #I #G #L #K #V #W #i #d #e #Hdi #Hide #HLK #HVW #j #Hjde + elim (ylt_split i j) [ -Hide -Hjde | -Hdi ] + /4 width=9 by cpy_subst, ylt_yle_trans, ex2_intro/ +| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide + elim (IHV12 i) -IHV12 // #V + elim (IHT12 (i+1)) -IHT12 /2 width=1 by yle_succ/ -Hide + >yplus_SO2 >yplus_succ1 #T #HT1 #HT2 + lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 + /3 width=5 by lsuby_succ, ex2_intro, cpy_bind/ +| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #i #Hide + elim (IHV12 i) -IHV12 // elim (IHT12 i) -IHT12 // -Hide + /3 width=5 by ex2_intro, cpy_flat/ +] +qed-. + +(* Basic forward lemmas *****************************************************) + +lemma cpy_fwd_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀T1,d,e. ⇧[d, e] T1 ≡ U1 → + d ≤ dt → d + e ≤ dt + et → + ∃∃T2. ⦃G, L⦄ ⊢ U1 ▶[d+e, dt+et-(d+e)] U2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et +[ * #i #G #L #dt #et #T1 #d #e #H #_ + [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ + | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ + | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ + ] +| #I #G #L #K #V #W #i #dt #et #Hdti #Hidet #HLK #HVW #T1 #d #e #H #Hddt #Hdedet + elim (lift_inv_lref2 … H) -H * #Hid #H destruct [ -V -Hidet -Hdedet | -Hdti -Hddt ] + [ elim (ylt_yle_false … Hddt) -Hddt /3 width=3 by yle_ylt_trans, ylt_inj/ + | elim (le_inv_plus_l … Hid) #Hdie #Hei + elim (lift_split … HVW d (i-e+1) ? ? ?) [2,3,4: /2 width=1 by le_S_S, le_S/ ] -Hdie + #T2 #_ >plus_minus // ymax_pre_sn_comm // (**) (* explicit constructor *) + ] +| #a #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #X #d #e #H #Hddt #Hdedet + elim (lift_inv_bind2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct + elim (IHW12 … HVW1) -V1 -IHW12 // + elim (IHU12 … HTU1) -T1 -IHU12 /2 width=1 by yle_succ/ + yplus_SO2 >yplus_succ1 >yplus_succ1 + /3 width=2 by cpy_bind, lift_bind, ex2_intro/ +| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #X #d #e #H #Hddt #Hdedet + elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct + elim (IHW12 … HVW1) -V1 -IHW12 // elim (IHU12 … HTU1) -T1 -IHU12 + /3 width=2 by cpy_flat, lift_flat, ex2_intro/ +] +qed-. + +lemma cpy_fwd_tw: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ♯{T1} ≤ ♯{T2}. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e normalize +/3 width=1 by monotonic_le_plus_l, le_plus/ +qed-. + +(* Basic inversion lemmas ***************************************************) + +fact cpy_inv_atom1_aux: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → ∀J. T1 = ⓪{J} → + T2 = ⓪{J} ∨ + ∃∃I,K,V,i. d ≤ yinj i & i < d + e & + ⇩[i] L ≡ K.ⓑ{I}V & + ⇧[O, i+1] V ≡ T2 & + J = LRef i. +#G #L #T1 #T2 #d #e * -G -L -T1 -T2 -d -e +[ #I #G #L #d #e #J #H destruct /2 width=1 by or_introl/ +| #I #G #L #K #V #T2 #i #d #e #Hdi #Hide #HLK #HVT2 #J #H destruct /3 width=9 by ex5_4_intro, or_intror/ +| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #H destruct +| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #H destruct +] +qed-. + +lemma cpy_inv_atom1: ∀I,G,L,T2,d,e. ⦃G, L⦄ ⊢ ⓪{I} ▶[d, e] T2 → + T2 = ⓪{I} ∨ + ∃∃J,K,V,i. d ≤ yinj i & i < d + e & + ⇩[i] L ≡ K.ⓑ{J}V & + ⇧[O, i+1] V ≡ T2 & + I = LRef i. +/2 width=4 by cpy_inv_atom1_aux/ qed-. + +(* Basic_1: was: subst1_gen_sort *) +lemma cpy_inv_sort1: ∀G,L,T2,k,d,e. ⦃G, L⦄ ⊢ ⋆k ▶[d, e] T2 → T2 = ⋆k. +#G #L #T2 #k #d #e #H +elim (cpy_inv_atom1 … H) -H // +* #I #K #V #i #_ #_ #_ #_ #H destruct +qed-. + +(* Basic_1: was: subst1_gen_lref *) +lemma cpy_inv_lref1: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶[d, e] T2 → + T2 = #i ∨ + ∃∃I,K,V. d ≤ i & i < d + e & + ⇩[i] L ≡ K.ⓑ{I}V & + ⇧[O, i+1] V ≡ T2. +#G #L #T2 #i #d #e #H +elim (cpy_inv_atom1 … H) -H /2 width=1 by or_introl/ +* #I #K #V #j #Hdj #Hjde #HLK #HVT2 #H destruct /3 width=5 by ex4_3_intro, or_intror/ +qed-. + +lemma cpy_inv_gref1: ∀G,L,T2,p,d,e. ⦃G, L⦄ ⊢ §p ▶[d, e] T2 → T2 = §p. +#G #L #T2 #p #d #e #H +elim (cpy_inv_atom1 … H) -H // +* #I #K #V #i #_ #_ #_ #_ #H destruct +qed-. + +fact cpy_inv_bind1_aux: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → + ∀a,I,V1,T1. U1 = ⓑ{a,I}V1.T1 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & + ⦃G, L. ⓑ{I}V1⦄ ⊢ T1 ▶[⫯d, e] T2 & + U2 = ⓑ{a,I}V2.T2. +#G #L #U1 #U2 #d #e * -G -L -U1 -U2 -d -e +[ #I #G #L #d #e #b #J #W1 #U1 #H destruct +| #I #G #L #K #V #W #i #d #e #_ #_ #_ #_ #b #J #W1 #U1 #H destruct +| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #HV12 #HT12 #b #J #W1 #U1 #H destruct /2 width=5 by ex3_2_intro/ +| #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #b #J #W1 #U1 #H destruct +] +qed-. + +lemma cpy_inv_bind1: ∀a,I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓑ{a,I} V1. T1 ▶[d, e] U2 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & + ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶[⫯d, e] T2 & + U2 = ⓑ{a,I}V2.T2. +/2 width=3 by cpy_inv_bind1_aux/ qed-. + +fact cpy_inv_flat1_aux: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → + ∀I,V1,T1. U1 = ⓕ{I}V1.T1 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & + ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 & + U2 = ⓕ{I}V2.T2. +#G #L #U1 #U2 #d #e * -G -L -U1 -U2 -d -e +[ #I #G #L #d #e #J #W1 #U1 #H destruct +| #I #G #L #K #V #W #i #d #e #_ #_ #_ #_ #J #W1 #U1 #H destruct +| #a #I #G #L #V1 #V2 #T1 #T2 #d #e #_ #_ #J #W1 #U1 #H destruct +| #I #G #L #V1 #V2 #T1 #T2 #d #e #HV12 #HT12 #J #W1 #U1 #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +lemma cpy_inv_flat1: ∀I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓕ{I} V1. T1 ▶[d, e] U2 → + ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶[d, e] V2 & + ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 & + U2 = ⓕ{I}V2.T2. +/2 width=3 by cpy_inv_flat1_aux/ qed-. + + +fact cpy_inv_refl_O2_aux: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T2 → e = 0 → T1 = T2. +#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e +[ // +| #I #G #L #K #V #W #i #d #e #Hdi #Hide #_ #_ #H destruct + elim (ylt_yle_false … Hdi) -Hdi // +| /3 width=1 by eq_f2/ +| /3 width=1 by eq_f2/ +] +qed-. + +lemma cpy_inv_refl_O2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶[d, 0] T2 → T1 = T2. +/2 width=6 by cpy_inv_refl_O2_aux/ qed-. + +(* Basic_1: was: subst1_gen_lift_eq *) +lemma cpy_inv_lift1_eq: ∀G,T1,U1,d,e. ⇧[d, e] T1 ≡ U1 → + ∀L,U2. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → U1 = U2. +#G #T1 #U1 #d #e #HTU1 #L #U2 #HU12 elim (cpy_fwd_up … HU12 … HTU1) -HU12 -HTU1 +/2 width=4 by cpy_inv_refl_O2/ +qed-. + +(* Basic_1: removed theorems 25: + 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 +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_cpy.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_cpy.ma new file mode 100644 index 000000000..0aad278c1 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_cpy.ma @@ -0,0 +1,122 @@ +(**************************************************************************) +(* ___ *) +(* ||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/cpy_lift.ma". + +(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) + +(* Main properties **********************************************************) + +(* Basic_1: was: subst1_confluence_eq *) +theorem cpy_conf_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶[d1, e1] T1 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶[d1, e1] T. +#G #L #T0 #T1 #d1 #e1 #H elim H -G -L -T0 -T1 -d1 -e1 +[ /2 width=3 by ex2_intro/ +| #I1 #G #L #K1 #V1 #T1 #i0 #d1 #e1 #Hd1 #Hde1 #HLK1 #HVT1 #T2 #d2 #e2 #H + elim (cpy_inv_lref1 … H) -H + [ #HX destruct /3 width=7 by cpy_subst, ex2_intro/ + | -Hd1 -Hde1 * #I2 #K2 #V2 #_ #_ #HLK2 #HVT2 + lapply (ldrop_mono … HLK1 … HLK2) -HLK1 -HLK2 #H destruct + >(lift_mono … HVT1 … HVT2) -HVT1 -HVT2 /2 width=3 by ex2_intro/ + ] +| #a #I #G #L #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #X #d2 #e2 #HX + elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + elim (IHV01 … HV02) -IHV01 -HV02 #V #HV1 #HV2 + elim (IHT01 … HT02) -T0 #T #HT1 #HT2 + lapply (lsuby_cpy_trans … HT1 (L.ⓑ{I}V1) ?) -HT1 /2 width=1 by lsuby_succ/ + lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V2) ?) -HT2 + /3 width=5 by cpy_bind, lsuby_succ, ex2_intro/ +| #I #G #L #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #X #d2 #e2 #HX + elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + elim (IHV01 … HV02) -V0 + elim (IHT01 … HT02) -T0 /3 width=5 by cpy_flat, ex2_intro/ +] +qed-. + +(* Basic_1: was: subst1_confluence_neq *) +theorem cpy_conf_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶[d1, e1] T1 → + ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶[d2, e2] T2 → + (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → + ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶[d1, e1] T. +#G #L1 #T0 #T1 #d1 #e1 #H elim H -G -L1 -T0 -T1 -d1 -e1 +[ /2 width=3 by ex2_intro/ +| #I1 #G #L1 #K1 #V1 #T1 #i0 #d1 #e1 #Hd1 #Hde1 #HLK1 #HVT1 #L2 #T2 #d2 #e2 #H1 #H2 + elim (cpy_inv_lref1 … H1) -H1 + [ #H destruct /3 width=7 by cpy_subst, ex2_intro/ + | -HLK1 -HVT1 * #I2 #K2 #V2 #Hd2 #Hde2 #_ #_ elim H2 -H2 #Hded [ -Hd1 -Hde2 | -Hd2 -Hde1 ] + [ elim (ylt_yle_false … Hde1) -Hde1 /2 width=3 by yle_trans/ + | elim (ylt_yle_false … Hde2) -Hde2 /2 width=3 by yle_trans/ + ] + ] +| #a #I #G #L1 #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #L2 #X #d2 #e2 #HX #H + elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + elim (IHV01 … HV02 H) -IHV01 -HV02 #V #HV1 #HV2 + elim (IHT01 … HT02) -T0 + [ -H #T #HT1 #HT2 + lapply (lsuby_cpy_trans … HT1 (L2.ⓑ{I}V1) ?) -HT1 /2 width=1 by lsuby_succ/ + lapply (lsuby_cpy_trans … HT2 (L1.ⓑ{I}V2) ?) -HT2 /3 width=5 by cpy_bind, lsuby_succ, ex2_intro/ + | -HV1 -HV2 elim H -H /3 width=1 by yle_succ, or_introl, or_intror/ + ] +| #I #G #L1 #V0 #V1 #T0 #T1 #d1 #e1 #_ #_ #IHV01 #IHT01 #L2 #X #d2 #e2 #HX #H + elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + elim (IHV01 … HV02 H) -V0 + elim (IHT01 … HT02 H) -T0 -H /3 width=5 by cpy_flat, ex2_intro/ +] +qed-. + +(* Note: the constant 1 comes from cpy_subst *) +(* Basic_1: was: subst1_trans *) +theorem cpy_trans_ge: ∀G,L,T1,T0,d,e. ⦃G, L⦄ ⊢ T1 ▶[d, e] T0 → + ∀T2. ⦃G, L⦄ ⊢ T0 ▶[d, 1] T2 → 1 ≤ e → ⦃G, L⦄ ⊢ T1 ▶[d, e] T2. +#G #L #T1 #T0 #d #e #H elim H -G -L -T1 -T0 -d -e +[ #I #G #L #d #e #T2 #H #He + elim (cpy_inv_atom1 … H) -H + [ #H destruct // + | * #J #K #V #i #Hd2i #Hide2 #HLK #HVT2 #H destruct + lapply (ylt_yle_trans … (d+e) … Hide2) /2 width=5 by cpy_subst, monotonic_yle_plus_dx/ + ] +| #I #G #L #K #V #V2 #i #d #e #Hdi #Hide #HLK #HVW #T2 #HVT2 #He + lapply (cpy_weak … HVT2 0 (i+1) ? ?) -HVT2 /3 width=1 by yle_plus_dx2_trans, yle_succ/ + >yplus_inj #HVT2 <(cpy_inv_lift1_eq … HVW … HVT2) -HVT2 /2 width=5 by cpy_subst/ +| #a #I #G #L #V1 #V0 #T1 #T0 #d #e #_ #_ #IHV10 #IHT10 #X #H #He + elim (cpy_inv_bind1 … H) -H #V2 #T2 #HV02 #HT02 #H destruct + lapply (lsuby_cpy_trans … HT02 (L.ⓑ{I}V1) ?) -HT02 /2 width=1 by lsuby_succ/ #HT02 + lapply (IHT10 … HT02 He) -T0 /3 width=1 by cpy_bind/ +| #I #G #L #V1 #V0 #T1 #T0 #d #e #_ #_ #IHV10 #IHT10 #X #H #He + elim (cpy_inv_flat1 … H) -H #V2 #T2 #HV02 #HT02 #H destruct /3 width=1 by cpy_flat/ +] +qed-. + +theorem cpy_trans_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T0 → + ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → d2 + e2 ≤ d1 → + ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T ▶[d1, e1] T2. +#G #L #T1 #T0 #d1 #e1 #H elim H -G -L -T1 -T0 -d1 -e1 +[ /2 width=3 by ex2_intro/ +| #I #G #L #K #V #W #i1 #d1 #e1 #Hdi1 #Hide1 #HLK #HVW #T2 #d2 #e2 #HWT2 #Hde2d1 + lapply (yle_trans … Hde2d1 … Hdi1) -Hde2d1 #Hde2i1 + lapply (cpy_weak … HWT2 0 (i1+1) ? ?) -HWT2 /3 width=1 by yle_succ, yle_pred_sn/ -Hde2i1 + >yplus_inj #HWT2 <(cpy_inv_lift1_eq … HVW … HWT2) -HWT2 /3 width=9 by cpy_subst, ex2_intro/ +| #a #I #G #L #V1 #V0 #T1 #T0 #d1 #e1 #_ #_ #IHV10 #IHT10 #X #d2 #e2 #HX #de2d1 + elim (cpy_inv_bind1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + lapply (lsuby_cpy_trans … HT02 (L.ⓑ{I}V1) ?) -HT02 /2 width=1 by lsuby_succ/ #HT02 + elim (IHV10 … HV02) -IHV10 -HV02 // #V + elim (IHT10 … HT02) -T0 /2 width=1 by yle_succ/ #T #HT1 #HT2 + lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V) ?) -HT2 /3 width=6 by cpy_bind, lsuby_succ, ex2_intro/ +| #I #G #L #V1 #V0 #T1 #T0 #d1 #e1 #_ #_ #IHV10 #IHT10 #X #d2 #e2 #HX #de2d1 + elim (cpy_inv_flat1 … HX) -HX #V2 #T2 #HV02 #HT02 #HX destruct + elim (IHV10 … HV02) -V0 // + elim (IHT10 … HT02) -T0 /3 width=6 by cpy_flat, ex2_intro/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_lift.ma new file mode 100644 index 000000000..935844099 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_lift.ma @@ -0,0 +1,249 @@ +(**************************************************************************) +(* ___ *) +(* ||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/substitution/cpy.ma". + +(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) + +(* Properties on relocation *************************************************) + +(* Basic_1: was: subst1_lift_lt *) +lemma cpy_lift_le: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → + ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → + ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → + dt + et ≤ d → ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2. +#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et +[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ + >(lift_mono … H1 … H2) -H1 -H2 // +| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hdetd + lapply (ylt_yle_trans … Hdetd … Hidet) -Hdetd #Hid + lapply (ylt_inv_inj … Hid) -Hid #Hid + lapply (lift_inv_lref1_lt … H … Hid) -H #H destruct + elim (lift_trans_ge … HVW … HWU2) -W // (lift_mono … HVY … HVW) -Y -HVW #H destruct /2 width=5 by cpy_subst/ +| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd + elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /4 width=7 by cpy_bind, ldrop_skip, yle_succ/ +| #G #I #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd + elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /3 width=7 by cpy_flat/ +] +qed-. + +lemma cpy_lift_be: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → + ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → + ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → + dt ≤ d → d ≤ dt + et → ⦃G, L⦄ ⊢ U1 ▶[dt, et + e] U2. +#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et +[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ #_ + >(lift_mono … H1 … H2) -H1 -H2 // +| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hdtd #_ + elim (lift_inv_lref1 … H) -H * #Hid #H destruct + [ -Hdtd + lapply (ylt_yle_trans … (dt+et+e) … Hidet) // -Hidet #Hidete + elim (lift_trans_ge … HVW … HWU2) -W // (lift_mono … HVY … HVW) -V #H destruct /2 width=5 by cpy_subst/ + | -Hdti + elim (yle_inv_inj2 … Hdtd) -Hdtd #dtt #Hdtd #H destruct + lapply (transitive_le … Hdtd Hid) -Hdtd #Hdti + lapply (lift_trans_be … HVW … HWU2 ? ?) -W /2 width=1 by le_S/ >plus_plus_comm_23 #HVU2 + lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid + /4 width=5 by cpy_subst, ldrop_inv_gen, monotonic_ylt_plus_dx, yle_plus_dx1_trans, yle_inj/ + ] +| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdtd #Hddet + elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /4 width=7 by cpy_bind, ldrop_skip, yle_succ/ +| #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hdetd + elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /3 width=7 by cpy_flat/ +] +qed-. + +(* Basic_1: was: subst1_lift_ge *) +lemma cpy_lift_ge: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 → + ∀L,U1,U2,s,d,e. ⇩[s, d, e] L ≡ K → + ⇧[d, e] T1 ≡ U1 → ⇧[d, e] T2 ≡ U2 → + d ≤ dt → ⦃G, L⦄ ⊢ U1 ▶[dt+e, et] U2. +#G #K #T1 #T2 #dt #et #H elim H -G -K -T1 -T2 -dt -et +[ #I #G #K #dt #et #L #U1 #U2 #s #d #e #_ #H1 #H2 #_ + >(lift_mono … H1 … H2) -H1 -H2 // +| #I #G #K #KV #V #W #i #dt #et #Hdti #Hidet #HKV #HVW #L #U1 #U2 #s #d #e #HLK #H #HWU2 #Hddt + lapply (yle_trans … Hddt … Hdti) -Hddt #Hid + elim (yle_inv_inj2 … Hid) -Hid #dd #Hddi #H0 destruct + lapply (lift_inv_lref1_ge … H … Hddi) -H #H destruct + lapply (lift_trans_be … HVW … HWU2 ? ?) -W /2 width=1 by le_S/ >plus_plus_comm_23 #HVU2 + lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hddi + /3 width=5 by cpy_subst, ldrop_inv_gen, monotonic_ylt_plus_dx, monotonic_yle_plus_dx/ +| #a #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hddt + elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /4 width=6 by cpy_bind, ldrop_skip, yle_succ/ +| #I #G #K #V1 #V2 #T1 #T2 #dt #et #_ #_ #IHV12 #IHT12 #L #U1 #U2 #s #d #e #HLK #H1 #H2 #Hddt + elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 + elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct + /3 width=6 by cpy_flat/ +] +qed-. + +(* Inversion lemmas on relocation *******************************************) + +(* Basic_1: was: subst1_gen_lift_lt *) +lemma cpy_inv_lift1_le: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt + et ≤ d → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, et] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et +[ * #i #G #L #dt #et #K #s #d #e #_ #T1 #H #_ + [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ + | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ + | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ + ] +| #I #G #L #KV #V #W #i #dt #et #Hdti #Hidet #HLKV #HVW #K #s #d #e #HLK #T1 #H #Hdetd + lapply (ylt_yle_trans … Hdetd … Hidet) -Hdetd #Hid + lapply (ylt_inv_inj … Hid) -Hid #Hid + lapply (lift_inv_lref2_lt … H … Hid) -H #H destruct + elim (ldrop_conf_lt … HLK … HLKV) -L // #L #U #HKL #_ #HUV + elim (lift_trans_le … HUV … HVW) -V // >minus_plus yplus_minus_assoc_inj /2 width=1 by yle_plus1_to_minus_inj2/ ] -Hdedet #Hidete + elim (ldrop_conf_lt … HLK … HLKV) -L // #L #U #HKL #_ #HUV + elim (lift_trans_le … HUV … HVW) -V // >minus_plus plus_minus // yplus_minus_assoc_inj /3 width=1 by monotonic_ylt_minus_dx, yle_inj/ + ] +| #a #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdtd #Hdedet + elim (lift_inv_bind2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct + elim (IHW12 … HLK … HVW1) -IHW12 // #V2 #HV12 #HVW2 + elim (IHU12 … HTU1) -U1 + /3 width=6 by cpy_bind, ldrop_skip, lift_bind, yle_succ, ex2_intro/ +| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdtd #Hdedet + elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct + elim (IHW12 … HLK … HVW1) -W1 // + elim (IHU12 … HLK … HTU1) -U1 -HLK // + /3 width=5 by cpy_flat, lift_flat, ex2_intro/ +] +qed-. + +(* Basic_1: was: subst1_gen_lift_ge *) +lemma cpy_inv_lift1_ge: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + yinj d + e ≤ dt → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt-e, et] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #H elim H -G -L -U1 -U2 -dt -et +[ * #i #G #L #dt #et #K #s #d #e #_ #T1 #H #_ + [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3 by ex2_intro/ + | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3 by lift_lref_ge_minus, lift_lref_lt, ex2_intro/ + | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3 by ex2_intro/ + ] +| #I #G #L #KV #V #W #i #dt #et #Hdti #Hidet #HLKV #HVW #K #s #d #e #HLK #T1 #H #Hdedt + lapply (yle_trans … Hdedt … Hdti) #Hdei + elim (yle_inv_plus_inj2 … Hdedt) -Hdedt #_ #Hedt + elim (yle_inv_plus_inj2 … Hdei) #Hdie #Hei + lapply (lift_inv_lref2_ge … H ?) -H /2 width=1 by yle_inv_inj/ #H destruct + lapply (ldrop_conf_ge … HLK … HLKV ?) -L /2 width=1 by yle_inv_inj/ #HKV + elim (lift_split … HVW d (i-e+1)) -HVW [2,3,4: /3 width=1 by yle_inv_inj, le_S_S, le_S/ ] -Hdei -Hdie + #V0 #HV10 >plus_minus /2 width=1 by yle_inv_inj/ yminus_succ1_inj /3 width=5 by cpy_bind, lift_bind, ex2_intro/ +| #I #G #L #W1 #W2 #U1 #U2 #dt #et #_ #_ #IHW12 #IHU12 #K #s #d #e #HLK #X #H #Hdetd + elim (lift_inv_flat2 … H) -H #V1 #T1 #HVW1 #HTU1 #H destruct + elim (IHW12 … HLK … HVW1) -W1 // + elim (IHU12 … HLK … HTU1) -U1 -HLK /3 width=5 by cpy_flat, lift_flat, ex2_intro/ +] +qed-. + +(* Advancd inversion lemmas on relocation ***********************************) + +lemma cpy_inv_lift1_ge_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[d, dt + et - (yinj d + e)] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet +elim (cpy_split_up … HU12 (d + e)) -HU12 // -Hdedet #U #HU1 #HU2 +lapply (cpy_weak … HU1 d e ? ?) -HU1 // [ >ymax_pre_sn_comm // ] -Hddt -Hdtde #HU1 +lapply (cpy_inv_lift1_eq … HTU1 … HU1) -HU1 #HU1 destruct +elim (cpy_inv_lift1_ge … HU2 … HLK … HTU1) -U -L /2 width=3 by ex2_intro/ +qed-. + +lemma cpy_inv_lift1_be_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt ≤ d → dt + et ≤ yinj d + e → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, d-dt] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdetde +lapply (cpy_weak … HU12 dt (d+e-dt) ? ?) -HU12 // +[ >ymax_pre_sn_comm /2 width=1 by yle_plus_dx1_trans/ ] -Hdetde #HU12 +elim (cpy_inv_lift1_be … HU12 … HLK … HTU1) -U1 -L /2 width=3 by ex2_intro/ +qed-. + +lemma cpy_inv_lift1_le_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶[dt, et] U2 → + ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → + dt ≤ d → d ≤ dt + et → dt + et ≤ yinj d + e → + ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. +#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde +elim (cpy_split_up … HU12 d) -HU12 // #U #HU1 #HU2 +elim (cpy_inv_lift1_le … HU1 … HLK … HTU1) -U1 +[2: >ymax_pre_sn_comm // ] -Hdtd #T #HT1 #HTU +lapply (cpy_weak … HU2 d e ? ?) -HU2 // +[ >ymax_pre_sn_comm // ] -Hddet -Hdetde #HU2 +lapply (cpy_inv_lift1_eq … HTU … HU2) -L #H destruct /2 width=3 by ex2_intro/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_nlift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_nlift.ma new file mode 100644 index 000000000..226f6afab --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpy_nlift.ma @@ -0,0 +1,66 @@ +(**************************************************************************) +(* ___ *) +(* ||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_neg.ma". +include "basic_2/substitution/lift_lift.ma". +include "basic_2/substitution/cpy.ma". + +(* CONTEXT-SENSITIVE EXTENDED ORDINARY SUBSTITUTION FOR TERMS ***************) + +(* Inversion lemmas on negated relocation ***********************************) + +lemma cpy_fwd_nlift2_ge: ∀G,L,U1,U2,d,e. ⦃G, L⦄ ⊢ U1 ▶[d, e] U2 → + ∀i. d ≤ yinj i → (∀T2. ⇧[i, 1] T2 ≡ U2 → ⊥) → + (∀T1. ⇧[i, 1] T1 ≡ U1 → ⊥) ∨ + ∃∃I,K,W,j. d ≤ yinj j & j < i & ⇩[j]L ≡ K.ⓑ{I}W & + (∀V. ⇧[i-j-1, 1] V ≡ W → ⊥) & (∀T1. ⇧[j, 1] T1 ≡ U1 → ⊥). +#G #L #U1 #U2 #d #e #H elim H -G -L -U1 -U2 -d -e +[ /3 width=2 by or_introl/ +| #I #G #L #K #V #W #j #d #e #Hdj #Hjde #HLK #HVW #i #Hdi #HnW + elim (lt_or_ge j i) #Hij + [ @or_intror @(ex5_4_intro … HLK) // -HLK + [ #X #HXV elim (lift_trans_le … HXV … HVW ?) -V // + #Y #HXY >minus_plus (plus_minus_m_m j 1) in ⊢ (%→?); [2: /3 width=3 by yle_trans, yle_inv_inj/ ] + #HnU1 (cpy_inv_sort1 … HT2) -HT2 // -qed-. - -(* Note: this can be derived from cpys_inv_atom1 *) -lemma cpys_inv_gref1: ∀G,L,T2,p,d,e. ⦃G, L⦄ ⊢ §p ▶*[d, e] T2 → T2 = §p. -#G #L #T2 #p #d #e #H @(cpys_ind … H) -T2 // -#T #T2 #_ #HT2 #IHT1 destruct ->(cpy_inv_gref1 … HT2) -HT2 // -qed-. - -lemma cpys_inv_bind1: ∀a,I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓑ{a,I}V1.T1 ▶*[d, e] U2 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 & - ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶*[⫯d, e] T2 & - U2 = ⓑ{a,I}V2.T2. -#a #I #G #L #V1 #T1 #U2 #d #e #H @(cpys_ind … H) -U2 -[ /2 width=5 by ex3_2_intro/ -| #U #U2 #_ #HU2 * #V #T #HV1 #HT1 #H destruct - elim (cpy_inv_bind1 … HU2) -HU2 #V2 #T2 #HV2 #HT2 #H - lapply (lsuby_cpy_trans … HT2 (L.ⓑ{I}V1) ?) -HT2 - /3 width=5 by cpys_strap1, lsuby_succ, ex3_2_intro/ -] -qed-. - -lemma cpys_inv_flat1: ∀I,G,L,V1,T1,U2,d,e. ⦃G, L⦄ ⊢ ⓕ{I}V1.T1 ▶*[d, e] U2 → - ∃∃V2,T2. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 & ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 & - U2 = ⓕ{I}V2.T2. -#I #G #L #V1 #T1 #U2 #d #e #H @(cpys_ind … H) -U2 -[ /2 width=5 by ex3_2_intro/ -| #U #U2 #_ #HU2 * #V #T #HV1 #HT1 #H destruct - elim (cpy_inv_flat1 … HU2) -HU2 - /3 width=5 by cpys_strap1, ex3_2_intro/ -] -qed-. - -lemma cpys_inv_refl_O2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶*[d, 0] T2 → T1 = T2. -#G #L #T1 #T2 #d #H @(cpys_ind … H) -T2 // -#T #T2 #_ #HT2 #IHT1 <(cpy_inv_refl_O2 … HT2) -HT2 // -qed-. - -lemma cpys_inv_lift1_eq: ∀G,L,U1,U2. ∀d,e:nat. - ⦃G, L⦄ ⊢ U1 ▶*[d, e] U2 → ∀T1. ⇧[d, e] T1 ≡ U1 → U1 = U2. -#G #L #U1 #U2 #d #e #H #T1 #HTU1 @(cpys_ind … H) -U2 -/2 width=7 by cpy_inv_lift1_eq/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_alt.ma deleted file mode 100644 index e297be698..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_alt.ma +++ /dev/null @@ -1,102 +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/notation/relations/psubststaralt_6.ma". -include "basic_2/substitution/cpys_lift.ma". - -(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) - -(* alternative definition of cpys *) -inductive cpysa: ynat → ynat → relation4 genv lenv term term ≝ -| cpysa_atom : ∀I,G,L,d,e. cpysa d e G L (⓪{I}) (⓪{I}) -| cpysa_subst: ∀I,G,L,K,V1,V2,W2,i,d,e. d ≤ yinj i → i < d+e → - ⇩[i] L ≡ K.ⓑ{I}V1 → cpysa 0 (⫰(d+e-i)) G K V1 V2 → - ⇧[0, i+1] V2 ≡ W2 → cpysa d e G L (#i) W2 -| cpysa_bind : ∀a,I,G,L,V1,V2,T1,T2,d,e. - cpysa d e G L V1 V2 → cpysa (⫯d) e G (L.ⓑ{I}V1) T1 T2 → - cpysa d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) -| cpysa_flat : ∀I,G,L,V1,V2,T1,T2,d,e. - cpysa d e G L V1 V2 → cpysa d e G L T1 T2 → - cpysa d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) -. - -interpretation - "context-sensitive extended multiple substritution (term) alternative" - 'PSubstStarAlt G L T1 d e T2 = (cpysa d e G L T1 T2). - -(* Basic properties *********************************************************) - -lemma lsuby_cpysa_trans: ∀G,d,e. lsub_trans … (cpysa d e G) (lsuby d e). -#G #d #e #L1 #T1 #T2 #H elim H -G -L1 -T1 -T2 -d -e -[ // -| #I #G #L1 #K1 #V1 #V2 #W2 #i #d #e #Hdi #Hide #HLK1 #_ #HVW2 #IHV12 #L2 #HL12 - elim (lsuby_ldrop_trans_be … HL12 … HLK1) -HL12 -HLK1 /3 width=7 by cpysa_subst/ -| /4 width=1 by lsuby_succ, cpysa_bind/ -| /3 width=1 by cpysa_flat/ -] -qed-. - -lemma cpysa_refl: ∀G,T,L,d,e. ⦃G, L⦄ ⊢ T ▶▶*[d, e] T. -#G #T elim T -T // -#I elim I -I /2 width=1 by cpysa_bind, cpysa_flat/ -qed. - -lemma cpysa_cpy_trans: ∀G,L,T1,T,d,e. ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T → - ∀T2. ⦃G, L⦄ ⊢ T ▶[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2. -#G #L #T1 #T #d #e #H elim H -G -L -T1 -T -d -e -[ #I #G #L #d #e #X #H - elim (cpy_inv_atom1 … H) -H // * /2 width=7 by cpysa_subst/ -| #I #G #L #K #V1 #V2 #W2 #i #d #e #Hdi #Hide #HLK #_ #HVW2 #IHV12 #T2 #H - lapply (ldrop_fwd_drop2 … HLK) #H0LK - lapply (cpy_weak … H 0 (d+e) ? ?) -H // #H - elim (cpy_inv_lift1_be … H … H0LK … HVW2) -H -H0LK -HVW2 - /3 width=7 by cpysa_subst, ylt_fwd_le_succ/ -| #a #I #G #L #V1 #V #T1 #T #d #e #_ #_ #IHV1 #IHT1 #X #H - elim (cpy_inv_bind1 … H) -H #V2 #T2 #HV2 #HT2 #H destruct - /5 width=5 by cpysa_bind, lsuby_cpy_trans, lsuby_succ/ -| #I #G #L #V1 #V #T1 #T #d #e #_ #_ #IHV1 #IHT1 #X #H - elim (cpy_inv_flat1 … H) -H #V2 #T2 #HV2 #HT2 #H destruct /3 width=1 by cpysa_flat/ -] -qed-. - -lemma cpys_cpysa: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2. -/3 width=8 by cpysa_cpy_trans, cpys_ind/ qed. - -(* Basic inversion lemmas ***************************************************) - -lemma cpysa_inv_cpys: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶▶*[d, e] T2 → ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2. -#G #L #T1 #T2 #d #e #H elim H -G -L -T1 -T2 -d -e -/2 width=7 by cpys_subst, cpys_flat, cpys_bind, cpy_cpys/ -qed-. - -(* Advanced eliminators *****************************************************) - -lemma cpys_ind_alt: ∀R:ynat→ynat→relation4 genv lenv term term. - (∀I,G,L,d,e. R d e G L (⓪{I}) (⓪{I})) → - (∀I,G,L,K,V1,V2,W2,i,d,e. d ≤ yinj i → i < d + e → - ⇩[i] L ≡ K.ⓑ{I}V1 → ⦃G, K⦄ ⊢ V1 ▶*[O, ⫰(d+e-i)] V2 → - ⇧[O, i+1] V2 ≡ W2 → R O (⫰(d+e-i)) G K V1 V2 → R d e G L (#i) W2 - ) → - (∀a,I,G,L,V1,V2,T1,T2,d,e. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 → - ⦃G, L.ⓑ{I}V1⦄ ⊢ T1 ▶*[⫯d, e] T2 → R d e G L V1 V2 → - R (⫯d) e G (L.ⓑ{I}V1) T1 T2 → R d e G L (ⓑ{a,I}V1.T1) (ⓑ{a,I}V2.T2) - ) → - (∀I,G,L,V1,V2,T1,T2,d,e. ⦃G, L⦄ ⊢ V1 ▶*[d, e] V2 → - ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → R d e G L V1 V2 → - R d e G L T1 T2 → R d e G L (ⓕ{I}V1.T1) (ⓕ{I}V2.T2) - ) → - ∀d,e,G,L,T1,T2. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → R d e G L T1 T2. -#R #H1 #H2 #H3 #H4 #d #e #G #L #T1 #T2 #H elim (cpys_cpysa … H) -G -L -T1 -T2 -d -e -/3 width=8 by cpysa_inv_cpys/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_cpys.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_cpys.ma deleted file mode 100644 index c571d9991..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_cpys.ma +++ /dev/null @@ -1,117 +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/relocation/cpy_cpy.ma". -include "basic_2/substitution/cpys_alt.ma". - -(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) - -(* Advanced inversion lemmas ************************************************) - -lemma cpys_inv_SO2: ∀G,L,T1,T2,d. ⦃G, L⦄ ⊢ T1 ▶*[d, 1] T2 → ⦃G, L⦄ ⊢ T1 ▶[d, 1] T2. -#G #L #T1 #T2 #d #H @(cpys_ind … H) -T2 /2 width=3 by cpy_trans_ge/ -qed-. - -(* Advanced properties ******************************************************) - -lemma cpys_strip_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶*[d1, e1] T1 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶*[d1, e1] T. -normalize /3 width=3 by cpy_conf_eq, TC_strip1/ qed-. - -lemma cpys_strip_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶*[d1, e1] T1 → - ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶[d2, e2] T2 → - (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → - ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶*[d1, e1] T. -normalize /3 width=3 by cpy_conf_neq, TC_strip1/ qed-. - -lemma cpys_strap1_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶*[d1, e1] T0 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶[d2, e2] T2 → d2 + e2 ≤ d1 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶[d2, e2] T & ⦃G, L⦄ ⊢ T ▶*[d1, e1] T2. -normalize /3 width=3 by cpy_trans_down, TC_strap1/ qed. - -lemma cpys_strap2_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶[d1, e1] T0 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → d2 + e2 ≤ d1 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T ▶[d1, e1] T2. -normalize /3 width=3 by cpy_trans_down, TC_strap2/ qed-. - -lemma cpys_split_up: ∀G,L,T1,T2,d,e. ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2 → - ∀i. d ≤ i → i ≤ d + e → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d, i - d] T & ⦃G, L⦄ ⊢ T ▶*[i, d + e - i] T2. -#G #L #T1 #T2 #d #e #H #i #Hdi #Hide @(cpys_ind … H) -T2 -[ /2 width=3 by ex2_intro/ -| #T #T2 #_ #HT12 * #T3 #HT13 #HT3 - elim (cpy_split_up … HT12 … Hide) -HT12 -Hide #T0 #HT0 #HT02 - elim (cpys_strap1_down … HT3 … HT0) -T /3 width=5 by cpys_strap1, ex2_intro/ - >ymax_pre_sn_comm // -] -qed-. - -lemma cpys_inv_lift1_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[d, dt + et - (yinj d + e)] T2 & - ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #HU12 #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet -elim (cpys_split_up … HU12 (d + e)) -HU12 // -Hdedet #U #HU1 #HU2 -lapply (cpys_weak … HU1 d e ? ?) -HU1 // [ >ymax_pre_sn_comm // ] -Hddt -Hdtde #HU1 -lapply (cpys_inv_lift1_eq … HU1 … HTU1) -HU1 #HU1 destruct -elim (cpys_inv_lift1_ge … HU2 … HLK … HTU1) -HU2 -HLK -HTU1 // ->yplus_minus_inj /2 width=3 by ex2_intro/ -qed-. - -(* Main properties **********************************************************) - -theorem cpys_conf_eq: ∀G,L,T0,T1,d1,e1. ⦃G, L⦄ ⊢ T0 ▶*[d1, e1] T1 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T2 ▶*[d1, e1] T. -normalize /3 width=3 by cpy_conf_eq, TC_confluent2/ qed-. - -theorem cpys_conf_neq: ∀G,L1,T0,T1,d1,e1. ⦃G, L1⦄ ⊢ T0 ▶*[d1, e1] T1 → - ∀L2,T2,d2,e2. ⦃G, L2⦄ ⊢ T0 ▶*[d2, e2] T2 → - (d1 + e1 ≤ d2 ∨ d2 + e2 ≤ d1) → - ∃∃T. ⦃G, L2⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L1⦄ ⊢ T2 ▶*[d1, e1] T. -normalize /3 width=3 by cpy_conf_neq, TC_confluent2/ qed-. - -theorem cpys_trans_eq: ∀G,L,T1,T,T2,d,e. - ⦃G, L⦄ ⊢ T1 ▶*[d, e] T → ⦃G, L⦄ ⊢ T ▶*[d, e] T2 → - ⦃G, L⦄ ⊢ T1 ▶*[d, e] T2. -normalize /2 width=3 by trans_TC/ qed-. - -theorem cpys_trans_down: ∀G,L,T1,T0,d1,e1. ⦃G, L⦄ ⊢ T1 ▶*[d1, e1] T0 → - ∀T2,d2,e2. ⦃G, L⦄ ⊢ T0 ▶*[d2, e2] T2 → d2 + e2 ≤ d1 → - ∃∃T. ⦃G, L⦄ ⊢ T1 ▶*[d2, e2] T & ⦃G, L⦄ ⊢ T ▶*[d1, e1] T2. -normalize /3 width=3 by cpy_trans_down, TC_transitive2/ qed-. - -theorem cpys_antisym_eq: ∀G,L1,T1,T2,d,e. ⦃G, L1⦄ ⊢ T1 ▶*[d, e] T2 → - ∀L2. ⦃G, L2⦄ ⊢ T2 ▶*[d, e] T1 → T1 = T2. -#G #L1 #T1 #T2 #d #e #H @(cpys_ind_alt … H) -G -L1 -T1 -T2 // -[ #I1 #G #L1 #K1 #V1 #V2 #W2 #i #d #e #Hdi #Hide #_ #_ #HVW2 #_ #L2 #HW2 - elim (lt_or_ge (|L2|) (i+1)) #Hi [ -Hdi -Hide | ] - [ lapply (cpys_weak_full … HW2) -HW2 #HW2 - lapply (cpys_weak … HW2 0 (i+1) ? ?) -HW2 // - [ >yplus_O1 >yplus_O1 /3 width=1 by ylt_fwd_le, ylt_inj/ ] -Hi - #HW2 >(cpys_inv_lift1_eq … HW2) -HW2 // - | elim (ldrop_O1_le (Ⓕ) … Hi) -Hi #K2 #HLK2 - elim (cpys_inv_lift1_ge_up … HW2 … HLK2 … HVW2 ? ? ?) -HW2 -HLK2 -HVW2 - /2 width=1 by ylt_fwd_le_succ, yle_succ_dx/ -Hdi -Hide - #X #_ #H elim (lift_inv_lref2_be … H) -H // - ] -| #a #I #G #L1 #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #L2 #H elim (cpys_inv_bind1 … H) -H - #V #T #HV2 #HT2 #H destruct - lapply (IHV12 … HV2) #H destruct -IHV12 -HV2 /3 width=2 by eq_f2/ -| #I #G #L1 #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #L2 #H elim (cpys_inv_flat1 … H) -H - #V #T #HV2 #HT2 #H destruct /3 width=2 by eq_f2/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_lift.ma deleted file mode 100644 index f4803a17d..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/cpys_lift.ma +++ /dev/null @@ -1,226 +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/relocation/cpy_lift.ma". -include "basic_2/substitution/cpys.ma". - -(* CONTEXT-SENSITIVE EXTENDED MULTIPLE SUBSTITUTION FOR TERMS ***************) - -(* Advanced properties ******************************************************) - -lemma cpys_subst: ∀I,G,L,K,V,U1,i,d,e. - d ≤ yinj i → i < d + e → - ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, K⦄ ⊢ V ▶*[0, ⫰(d+e-i)] U1 → - ∀U2. ⇧[0, i+1] U1 ≡ U2 → ⦃G, L⦄ ⊢ #i ▶*[d, e] U2. -#I #G #L #K #V #U1 #i #d #e #Hdi #Hide #HLK #H @(cpys_ind … H) -U1 -[ /3 width=5 by cpy_cpys, cpy_subst/ -| #U #U1 #_ #HU1 #IHU #U2 #HU12 - elim (lift_total U 0 (i+1)) #U0 #HU0 - lapply (IHU … HU0) -IHU #H - lapply (ldrop_fwd_drop2 … HLK) -HLK #HLK - lapply (cpy_lift_ge … HU1 … HLK HU0 HU12 ?) -HU1 -HLK -HU0 -HU12 // #HU02 - lapply (cpy_weak … HU02 d e ? ?) -HU02 - [2,3: /2 width=3 by cpys_strap1, yle_succ_dx/ ] - >yplus_O1 ymax_pre_sn_comm /2 width=1 by ylt_fwd_le_succ/ -] -qed. - -lemma cpys_subst_Y2: ∀I,G,L,K,V,U1,i,d. - d ≤ yinj i → - ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, K⦄ ⊢ V ▶*[0, ∞] U1 → - ∀U2. ⇧[0, i+1] U1 ≡ U2 → ⦃G, L⦄ ⊢ #i ▶*[d, ∞] U2. -#I #G #L #K #V #U1 #i #d #Hdi #HLK #HVU1 #U2 #HU12 -@(cpys_subst … HLK … HU12) >yminus_Y_inj // -qed. - -(* Advanced inverion lemmas *************************************************) - -lemma cpys_inv_atom1: ∀I,G,L,T2,d,e. ⦃G, L⦄ ⊢ ⓪{I} ▶*[d, e] T2 → - T2 = ⓪{I} ∨ - ∃∃J,K,V1,V2,i. d ≤ yinj i & i < d + e & - ⇩[i] L ≡ K.ⓑ{J}V1 & - ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 & - ⇧[O, i+1] V2 ≡ T2 & - I = LRef i. -#I #G #L #T2 #d #e #H @(cpys_ind … H) -T2 -[ /2 width=1 by or_introl/ -| #T #T2 #_ #HT2 * - [ #H destruct - elim (cpy_inv_atom1 … HT2) -HT2 [ /2 width=1 by or_introl/ | * /3 width=11 by ex6_5_intro, or_intror/ ] - | * #J #K #V1 #V #i #Hdi #Hide #HLK #HV1 #HVT #HI - lapply (ldrop_fwd_drop2 … HLK) #H - elim (cpy_inv_lift1_ge_up … HT2 … H … HVT) -HT2 -H -HVT - [2,3,4: /2 width=1 by ylt_fwd_le_succ, yle_succ_dx/ ] - /4 width=11 by cpys_strap1, ex6_5_intro, or_intror/ - ] -] -qed-. - -lemma cpys_inv_lref1: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶*[d, e] T2 → - T2 = #i ∨ - ∃∃I,K,V1,V2. d ≤ i & i < d + e & - ⇩[i] L ≡ K.ⓑ{I}V1 & - ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 & - ⇧[O, i+1] V2 ≡ T2. -#G #L #T2 #i #d #e #H elim (cpys_inv_atom1 … H) -H /2 width=1 by or_introl/ -* #I #K #V1 #V2 #j #Hdj #Hjde #HLK #HV12 #HVT2 #H destruct /3 width=7 by ex5_4_intro, or_intror/ -qed-. - -lemma cpys_inv_lref1_Y2: ∀G,L,T2,i,d. ⦃G, L⦄ ⊢ #i ▶*[d, ∞] T2 → - T2 = #i ∨ - ∃∃I,K,V1,V2. d ≤ i & ⇩[i] L ≡ K.ⓑ{I}V1 & - ⦃G, K⦄ ⊢ V1 ▶*[0, ∞] V2 & ⇧[O, i+1] V2 ≡ T2. -#G #L #T2 #i #d #H elim (cpys_inv_lref1 … H) -H /2 width=1 by or_introl/ -* >yminus_Y_inj /3 width=7 by or_intror, ex4_4_intro/ -qed-. - -lemma cpys_inv_lref1_ldrop: ∀G,L,T2,i,d,e. ⦃G, L⦄ ⊢ #i ▶*[d, e] T2 → - ∀I,K,V1. ⇩[i] L ≡ K.ⓑ{I}V1 → - ∀V2. ⇧[O, i+1] V2 ≡ T2 → - ∧∧ ⦃G, K⦄ ⊢ V1 ▶*[0, ⫰(d+e-i)] V2 - & d ≤ i - & i < d + e. -#G #L #T2 #i #d #e #H #I #K #V1 #HLK #V2 #HVT2 elim (cpys_inv_lref1 … H) -H -[ #H destruct elim (lift_inv_lref2_be … HVT2) -HVT2 -HLK // -| * #Z #Y #X1 #X2 #Hdi #Hide #HLY #HX12 #HXT2 - lapply (lift_inj … HXT2 … HVT2) -T2 #H destruct - lapply (ldrop_mono … HLY … HLK) -L #H destruct - /2 width=1 by and3_intro/ -] -qed-. - -(* Properties on relocation *************************************************) - -lemma cpys_lift_le: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → - ∀L,U1,s,d,e. dt + et ≤ yinj d → ⇩[s, d, e] L ≡ K → - ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → - ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2. -#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hdetd #HLK #HTU1 @(cpys_ind … H) -T2 -[ #U2 #H >(lift_mono … HTU1 … H) -H // -| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 - elim (lift_total T d e) #U #HTU - lapply (IHT … HTU) -IHT #HU1 - lapply (cpy_lift_le … HT2 … HLK HTU HTU2 ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ -] -qed-. - -lemma cpys_lift_be: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → - ∀L,U1,s,d,e. dt ≤ yinj d → d ≤ dt + et → - ⇩[s, d, e] L ≡ K → ⇧[d, e] T1 ≡ U1 → - ∀U2. ⇧[d, e] T2 ≡ U2 → ⦃G, L⦄ ⊢ U1 ▶*[dt, et + e] U2. -#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hdtd #Hddet #HLK #HTU1 @(cpys_ind … H) -T2 -[ #U2 #H >(lift_mono … HTU1 … H) -H // -| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 - elim (lift_total T d e) #U #HTU - lapply (IHT … HTU) -IHT #HU1 - lapply (cpy_lift_be … HT2 … HLK HTU HTU2 ? ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ -] -qed-. - -lemma cpys_lift_ge: ∀G,K,T1,T2,dt,et. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 → - ∀L,U1,s,d,e. yinj d ≤ dt → ⇩[s, d, e] L ≡ K → - ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → - ⦃G, L⦄ ⊢ U1 ▶*[dt+e, et] U2. -#G #K #T1 #T2 #dt #et #H #L #U1 #s #d #e #Hddt #HLK #HTU1 @(cpys_ind … H) -T2 -[ #U2 #H >(lift_mono … HTU1 … H) -H // -| -HTU1 #T #T2 #_ #HT2 #IHT #U2 #HTU2 - elim (lift_total T d e) #U #HTU - lapply (IHT … HTU) -IHT #HU1 - lapply (cpy_lift_ge … HT2 … HLK HTU HTU2 ?) -HT2 -HLK -HTU -HTU2 /2 width=3 by cpys_strap1/ -] -qed-. - -(* Inversion lemmas for relocation ******************************************) - -lemma cpys_inv_lift1_le: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt + et ≤ d → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, et] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdetd @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_le … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -lemma cpys_inv_lift1_be: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt ≤ d → yinj d + e ≤ dt + et → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, et - e] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdedet @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_be … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -lemma cpys_inv_lift1_ge: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - yinj d + e ≤ dt → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt - e, et] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdedt @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_ge … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -(* Advanced inversion lemmas on relocation **********************************) - -lemma cpys_inv_lift1_ge_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - d ≤ dt → dt ≤ yinj d + e → yinj d + e ≤ dt + et → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[d, dt + et - (yinj d + e)] T2 & - ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_ge_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -lemma cpys_inv_lift1_be_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt ≤ d → dt + et ≤ yinj d + e → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hdetde @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_be_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -lemma cpys_inv_lift1_le_up: ∀G,L,U1,U2,dt,et. ⦃G, L⦄ ⊢ U1 ▶*[dt, et] U2 → - ∀K,s,d,e. ⇩[s, d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 → - dt ≤ d → d ≤ dt + et → dt + et ≤ yinj d + e → - ∃∃T2. ⦃G, K⦄ ⊢ T1 ▶*[dt, d - dt] T2 & ⇧[d, e] T2 ≡ U2. -#G #L #U1 #U2 #dt #et #H #K #s #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde @(cpys_ind … H) -U2 -[ /2 width=3 by ex2_intro/ -| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU - elim (cpy_inv_lift1_le_up … HU2 … HLK … HTU) -HU2 -HLK -HTU /3 width=3 by cpys_strap1, ex2_intro/ -] -qed-. - -lemma cpys_inv_lift1_subst: ∀G,L,W1,W2,d,e. ⦃G, L⦄ ⊢ W1 ▶*[d, e] W2 → - ∀K,V1,i. ⇩[i+1] L ≡ K → ⇧[O, i+1] V1 ≡ W1 → - d ≤ yinj i → i < d + e → - ∃∃V2. ⦃G, K⦄ ⊢ V1 ▶*[O, ⫰(d+e-i)] V2 & ⇧[O, i+1] V2 ≡ W2. -#G #L #W1 #W2 #d #e #HW12 #K #V1 #i #HLK #HVW1 #Hdi #Hide -elim (cpys_inv_lift1_ge_up … HW12 … HLK … HVW1 ? ? ?) // ->yplus_O1 yplus_SO2 -[ >yminus_succ2 /2 width=3 by ex2_intro/ -| /2 width=1 by ylt_fwd_le_succ1/ -| /2 width=3 by yle_trans/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq.ma deleted file mode 100644 index 3c90f5a9f..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq.ma +++ /dev/null @@ -1,43 +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/notation/relations/lazyeq_7.ma". -include "basic_2/grammar/genv.ma". -include "basic_2/substitution/lleq.ma". - -(* LAZY EQUIVALENCE FOR CLOSURES ********************************************) - -inductive fleq (d) (G) (L1) (T): relation3 genv lenv term ≝ -| fleq_intro: ∀L2. L1 ≡[T, d] L2 → fleq d G L1 T G L2 T -. - -interpretation - "lazy equivalence (closure)" - 'LazyEq d G1 L1 T1 G2 L2 T2 = (fleq d G1 L1 T1 G2 L2 T2). - -(* Basic_properties *********************************************************) - -lemma fleq_refl: ∀d. tri_reflexive … (fleq d). -/2 width=1 by fleq_intro/ qed. - -lemma fleq_sym: ∀d. tri_symmetric … (fleq d). -#d #G1 #L1 #T1 #G2 #L2 #T2 * /3 width=1 by fleq_intro, lleq_sym/ -qed-. - -(* Basic inversion lemmas ***************************************************) - -lemma fleq_inv_gen: ∀G1,G2,L1,L2,T1,T2,d. ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄ → - ∧∧ G1 = G2 & L1 ≡[T1, d] L2 & T1 = T2. -#G1 #G2 #L1 #L2 #T1 #T2 #d * -G2 -L2 -T2 /2 width=1 by and3_intro/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq_fleq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq_fleq.ma deleted file mode 100644 index e8d5dac02..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fleq_fleq.ma +++ /dev/null @@ -1,34 +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/lleq_lleq.ma". -include "basic_2/substitution/fleq.ma". - -(* LAZY EQUIVALENCE FOR CLOSURES *******************************************) - -(* Main properties **********************************************************) - -theorem fleq_trans: ∀d. tri_transitive … (fleq d). -#d #G1 #G #L1 #L #T1 #T * -G -L -T -#L #HT1 #G2 #L2 #T2 * -G2 -L2 -T2 -/3 width=3 by lleq_trans, fleq_intro/ -qed-. - -theorem fleq_canc_sn: ∀G,G1,G2,L,L1,L2,T,T1,T2,d. - ⦃G, L, T⦄ ≡[d] ⦃G1, L1, T1⦄→ ⦃G, L, T⦄ ≡[d] ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄. -/3 width=5 by fleq_trans, fleq_sym/ qed-. - -theorem fleq_canc_dx: ∀G1,G2,G,L1,L2,L,T1,T2,T,d. - ⦃G1, L1, T1⦄ ≡[d] ⦃G, L, T⦄ → ⦃G2, L2, T2⦄ ≡[d] ⦃G, L, T⦄ → ⦃G1, L1, T1⦄ ≡[d] ⦃G2, L2, T2⦄. -/3 width=5 by fleq_trans, fleq_sym/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqu.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqu.ma new file mode 100644 index 000000000..651ca4322 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqu.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/notation/relations/supterm_6.ma". +include "basic_2/grammar/cl_weight.ma". +include "basic_2/substitution/ldrop.ma". + +(* SUPCLOSURE ***************************************************************) + +(* activate genv *) +inductive fqu: tri_relation genv lenv term ≝ +| fqu_lref_O : ∀I,G,L,V. fqu G (L.ⓑ{I}V) (#0) G L V +| fqu_pair_sn: ∀I,G,L,V,T. fqu G L (②{I}V.T) G L V +| fqu_bind_dx: ∀a,I,G,L,V,T. fqu G L (ⓑ{a,I}V.T) G (L.ⓑ{I}V) T +| fqu_flat_dx: ∀I,G,L,V,T. fqu G L (ⓕ{I}V.T) G L T +| fqu_drop : ∀G,L,K,T,U,e. + ⇩[e+1] L ≡ K → ⇧[0, e+1] T ≡ U → fqu G L U G K T +. + +interpretation + "structural successor (closure)" + 'SupTerm G1 L1 T1 G2 L2 T2 = (fqu G1 L1 T1 G2 L2 T2). + +(* Basic properties *********************************************************) + +lemma fqu_drop_lt: ∀G,L,K,T,U,e. 0 < e → + ⇩[e] L ≡ K → ⇧[0, e] T ≡ U → ⦃G, L, U⦄ ⊐ ⦃G, K, T⦄. +#G #L #K #T #U #e #He >(plus_minus_m_m e 1) /2 width=3 by fqu_drop/ +qed. + +lemma fqu_lref_S_lt: ∀I,G,L,V,i. 0 < i → ⦃G, L.ⓑ{I}V, #i⦄ ⊐ ⦃G, L, #(i-1)⦄. +/3 width=3 by fqu_drop, ldrop_drop, lift_lref_ge_minus/ +qed. + +(* Basic forward lemmas *****************************************************) + +lemma fqu_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} < ♯{G1, L1, T1}. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 // +#G #L #K #T #U #e #HLK #HTU +lapply (ldrop_fwd_lw_lt … HLK ?) -HLK // #HKL +lapply (lift_fwd_tw … HTU) -e #H +normalize in ⊢ (?%%); /2 width=1 by lt_minus_to_plus/ +qed-. + +fact fqu_fwd_length_lref1_aux: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → + ∀i. T1 = #i → |L2| < |L1|. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 +[1: normalize // +|3: #a +|5: /2 width=4 by ldrop_fwd_length_lt4/ +] #I #G #L #V #T #j #H destruct +qed-. + +lemma fqu_fwd_length_lref1: ∀G1,G2,L1,L2,T2,i. ⦃G1, L1, #i⦄ ⊐ ⦃G2, L2, T2⦄ → |L2| < |L1|. +/2 width=7 by fqu_fwd_length_lref1_aux/ +qed-. + +(* Advanced eliminators *****************************************************) + +lemma fqu_wf_ind: ∀R:relation3 …. ( + ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G2 L2 T2) → + R G1 L1 T1 + ) → ∀G1,L1,T1. R G1 L1 T1. +#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=1 by fqu_fwd_fw/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup.ma deleted file mode 100644 index 1e1ede2f2..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup.ma +++ /dev/null @@ -1,109 +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/notation/relations/suptermplus_6.ma". -include "basic_2/relocation/fqu.ma". - -(* PLUS-ITERATED SUPCLOSURE *************************************************) - -definition fqup: tri_relation genv lenv term ≝ tri_TC … fqu. - -interpretation "plus-iterated structural successor (closure)" - 'SupTermPlus G1 L1 T1 G2 L2 T2 = (fqup G1 L1 T1 G2 L2 T2). - -(* Basic properties *********************************************************) - -lemma fqu_fqup: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -/2 width=1 by tri_inj/ qed. - -lemma fqup_strap1: ∀G1,G,G2,L1,L,L2,T1,T,T2. - ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -/2 width=5 by tri_step/ qed. - -lemma fqup_strap2: ∀G1,G,G2,L1,L,L2,T1,T,T2. - ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -/2 width=5 by tri_TC_strap/ qed. - -lemma fqup_ldrop: ∀G1,G2,L1,K1,K2,T1,T2,U1,e. ⇩[e] L1 ≡ K1 → ⇧[0, e] T1 ≡ U1 → - ⦃G1, K1, T1⦄ ⊐+ ⦃G2, K2, T2⦄ → ⦃G1, L1, U1⦄ ⊐+ ⦃G2, K2, T2⦄. -#G1 #G2 #L1 #K1 #K2 #T1 #T2 #U1 #e #HLK1 #HTU1 #HT12 elim (eq_or_gt … e) #H destruct -[ >(ldrop_inv_O2 … HLK1) -L1 <(lift_inv_O2 … HTU1) -U1 // -| /3 width=5 by fqup_strap2, fqu_drop_lt/ -] -qed-. - -lemma fqup_lref: ∀I,G,L,K,V,i. ⇩[i] L ≡ K.ⓑ{I}V → ⦃G, L, #i⦄ ⊐+ ⦃G, K, V⦄. -/3 width=6 by fqu_lref_O, fqu_fqup, lift_lref_ge, fqup_ldrop/ qed. - -lemma fqup_pair_sn: ∀I,G,L,V,T. ⦃G, L, ②{I}V.T⦄ ⊐+ ⦃G, L, V⦄. -/2 width=1 by fqu_pair_sn, fqu_fqup/ qed. - -lemma fqup_bind_dx: ∀a,I,G,L,V,T. ⦃G, L, ⓑ{a,I}V.T⦄ ⊐+ ⦃G, L.ⓑ{I}V, T⦄. -/2 width=1 by fqu_bind_dx, fqu_fqup/ qed. - -lemma fqup_flat_dx: ∀I,G,L,V,T. ⦃G, L, ⓕ{I}V.T⦄ ⊐+ ⦃G, L, T⦄. -/2 width=1 by fqu_flat_dx, fqu_fqup/ qed. - -lemma fqup_flat_dx_pair_sn: ∀I1,I2,G,L,V1,V2,T. ⦃G, L, ⓕ{I1}V1.②{I2}V2.T⦄ ⊐+ ⦃G, L, V2⦄. -/2 width=5 by fqu_pair_sn, fqup_strap1/ qed. - -lemma fqup_bind_dx_flat_dx: ∀a,G,I1,I2,L,V1,V2,T. ⦃G, L, ⓑ{a,I1}V1.ⓕ{I2}V2.T⦄ ⊐+ ⦃G, L.ⓑ{I1}V1, T⦄. -/2 width=5 by fqu_flat_dx, fqup_strap1/ qed. - -lemma fqup_flat_dx_bind_dx: ∀a,I1,I2,G,L,V1,V2,T. ⦃G, L, ⓕ{I1}V1.ⓑ{a,I2}V2.T⦄ ⊐+ ⦃G, L.ⓑ{I2}V2, T⦄. -/2 width=5 by fqu_bind_dx, fqup_strap1/ qed. - -(* Basic eliminators ********************************************************) - -lemma fqup_ind: ∀G1,L1,T1. ∀R:relation3 …. - (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G2 L2 T2) → - (∀G,G2,L,L2,T,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → R G L T → R G2 L2 T2) → - ∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2. -#G1 #L1 #T1 #R #IH1 #IH2 #G2 #L2 #T2 #H -@(tri_TC_ind … IH1 IH2 G2 L2 T2 H) -qed-. - -lemma fqup_ind_dx: ∀G2,L2,T2. ∀R:relation3 …. - (∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → R G1 L1 T1) → - (∀G1,G,L1,L,T1,T. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → R G L T → R G1 L1 T1) → - ∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G1 L1 T1. -#G2 #L2 #T2 #R #IH1 #IH2 #G1 #L1 #T1 #H -@(tri_TC_ind_dx … IH1 IH2 G1 L1 T1 H) -qed-. - -(* Basic forward lemmas *****************************************************) - -lemma fqup_fwd_fw: ∀G1,G2,L1,L2,T1,T2. - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} < ♯{G1, L1, T1}. -#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind … H) -G2 -L2 -T2 -/3 width=3 by fqu_fwd_fw, transitive_lt/ -qed-. - -(* Advanced eliminators *****************************************************) - -lemma fqup_wf_ind: ∀R:relation3 …. ( - ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2) → - R G1 L1 T1 - ) → ∀G1,L1,T1. R G1 L1 T1. -#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=1 by fqup_fwd_fw/ -qed-. - -lemma fqup_wf_ind_eq: ∀R:relation3 …. ( - ∀G1,L1,T1. (∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → R G2 L2 T2) → - ∀G2,L2,T2. G1 = G2 → L1 = L2 → T1 = T2 → R G2 L2 T2 - ) → ∀G1,L1,T1. R G1 L1 T1. -#R #HR @(f3_ind … fw) #n #IHn #G1 #L1 #T1 #H destruct /4 width=7 by fqup_fwd_fw/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup_fqup.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup_fqup.ma deleted file mode 100644 index 0dd0e336f..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqup_fqup.ma +++ /dev/null @@ -1,22 +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/fqup.ma". - -(* PLUS-ITERATED SUPCLOSURE *************************************************) - -(* Main properties **********************************************************) - -theorem fqup_trans: tri_transitive … fqup. -/2 width=5 by tri_TC_transitive/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq.ma new file mode 100644 index 000000000..1a5c549d8 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq.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/notation/relations/suptermopt_6.ma". +include "basic_2/substitution/fqu.ma". + +(* OPTIONAL SUPCLOSURE ******************************************************) + +(* activate genv *) +inductive fquq: tri_relation genv lenv term ≝ +| fquq_lref_O : ∀I,G,L,V. fquq G (L.ⓑ{I}V) (#0) G L V +| fquq_pair_sn: ∀I,G,L,V,T. fquq G L (②{I}V.T) G L V +| fquq_bind_dx: ∀a,I,G,L,V,T. fquq G L (ⓑ{a,I}V.T) G (L.ⓑ{I}V) T +| fquq_flat_dx: ∀I,G, L,V,T. fquq G L (ⓕ{I}V.T) G L T +| fquq_drop : ∀G,L,K,T,U,e. + ⇩[e] L ≡ K → ⇧[0, e] T ≡ U → fquq G L U G K T +. + +interpretation + "optional structural successor (closure)" + 'SupTermOpt G1 L1 T1 G2 L2 T2 = (fquq G1 L1 T1 G2 L2 T2). + +(* Basic properties *********************************************************) + +lemma fquq_refl: tri_reflexive … fquq. +/2 width=3 by fquq_drop/ qed. + +lemma fqu_fquq: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 /2 width=3 by fquq_drop/ +qed. + +(* Basic forward lemmas *****************************************************) + +lemma fquq_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} ≤ ♯{G1, L1, T1}. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 /2 width=1 by lt_to_le/ +#G1 #L1 #K1 #T1 #U1 #e #HLK1 #HTU1 +lapply (ldrop_fwd_lw … HLK1) -HLK1 +lapply (lift_fwd_tw … HTU1) -HTU1 +/2 width=1 by le_plus, le_n/ +qed-. + +fact fquq_fwd_length_lref1_aux: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → + ∀i. T1 = #i → |L2| ≤ |L1|. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 // +[ #a #I #G #L #V #T #j #H destruct +| #G1 #L1 #K1 #T1 #U1 #e #HLK1 #HTU1 #i #H destruct + /2 width=3 by ldrop_fwd_length_le4/ +] +qed-. + +lemma fquq_fwd_length_lref1: ∀G1,G2,L1,L2,T2,i. ⦃G1, L1, #i⦄ ⊐⸮ ⦃G2, L2, T2⦄ → |L2| ≤ |L1|. +/2 width=7 by fquq_fwd_length_lref1_aux/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq_alt.ma new file mode 100644 index 000000000..cacb1106d --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/fquq_alt.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/notation/relations/suptermoptalt_6.ma". +include "basic_2/substitution/fquq.ma". + +(* OPTIONAL SUPCLOSURE ******************************************************) + +(* alternative definition of fquq *) +definition fquqa: tri_relation genv lenv term ≝ tri_RC … fqu. + +interpretation + "optional structural successor (closure) alternative" + 'SupTermOptAlt G1 L1 T1 G2 L2 T2 = (fquqa G1 L1 T1 G2 L2 T2). + +(* Basic properties *********************************************************) + +lemma fquqa_refl: tri_reflexive … fquqa. +// qed. + +lemma fquqa_drop: ∀G,L,K,T,U,e. + ⇩[e] L ≡ K → ⇧[0, e] T ≡ U → ⦃G, L, U⦄ ⊐⊐⸮ ⦃G, K, T⦄. +#G #L #K #T #U #e #HLK #HTU elim (eq_or_gt e) +/3 width=5 by fqu_drop_lt, or_introl/ #H destruct +>(ldrop_inv_O2 … HLK) -L >(lift_inv_O2 … HTU) -T // +qed. + +(* Main properties **********************************************************) + +theorem fquq_fquqa: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⊐⸮ ⦃G2, L2, T2⦄. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -G1 -G2 -L1 -L2 -T1 -T2 +/2 width=3 by fquqa_drop, fqu_lref_O, fqu_pair_sn, fqu_bind_dx, fqu_flat_dx, or_introl/ +qed. + +(* Main inversion properties ************************************************) + +theorem fquqa_inv_fquq: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄. +#G1 #G2 #L1 #L2 #T1 #T2 #H elim H -H /2 width=1 by fqu_fquq/ +* #H1 #H2 #H3 destruct // +qed-. + +(* Advanced inversion lemmas ************************************************) + +lemma fquq_inv_gen: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → + ⦃G1, L1, T1⦄ ⊐ ⦃G2, L2, T2⦄ ∨ (∧∧ G1 = G2 & L1 = L2 & T1 = T2). +#G1 #G2 #L1 #L2 #T1 #T2 #H elim (fquq_fquqa … H) -H [| * ] +/2 width=1 by or_introl/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus.ma deleted file mode 100644 index d7b8c8661..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus.ma +++ /dev/null @@ -1,83 +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/notation/relations/suptermstar_6.ma". -include "basic_2/relocation/fquq.ma". -include "basic_2/substitution/fqup.ma". - -(* STAR-ITERATED SUPCLOSURE *************************************************) - -definition fqus: tri_relation genv lenv term ≝ tri_TC … fquq. - -interpretation "star-iterated structural successor (closure)" - 'SupTermStar G1 L1 T1 G2 L2 T2 = (fqus G1 L1 T1 G2 L2 T2). - -(* Basic eliminators ********************************************************) - -lemma fqus_ind: ∀G1,L1,T1. ∀R:relation3 …. R G1 L1 T1 → - (∀G,G2,L,L2,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐⸮ ⦃G2, L2, T2⦄ → R G L T → R G2 L2 T2) → - ∀G2,L2,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → R G2 L2 T2. -#G1 #L1 #T1 #R #IH1 #IH2 #G2 #L2 #T2 #H -@(tri_TC_star_ind … IH1 IH2 G2 L2 T2 H) // -qed-. - -lemma fqus_ind_dx: ∀G2,L2,T2. ∀R:relation3 …. R G2 L2 T2 → - (∀G1,G,L1,L,T1,T. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → R G L T → R G1 L1 T1) → - ∀G1,L1,T1. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → R G1 L1 T1. -#G2 #L2 #T2 #R #IH1 #IH2 #G1 #L1 #T1 #H -@(tri_TC_star_ind_dx … IH1 IH2 G1 L1 T1 H) // -qed-. - -(* Basic properties *********************************************************) - -lemma fqus_refl: tri_reflexive … fqus. -/2 width=1 by tri_inj/ qed. - -lemma fquq_fqus: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. -/2 width=1 by tri_inj/ qed. - -lemma fqus_strap1: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐⸮ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. -/2 width=5 by tri_step/ qed-. - -lemma fqus_strap2: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐⸮ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. -/2 width=5 by tri_TC_strap/ qed-. - -lemma fqus_ldrop: ∀G1,G2,K1,K2,T1,T2. ⦃G1, K1, T1⦄ ⊐* ⦃G2, K2, T2⦄ → - ∀L1,U1,e. ⇩[e] L1 ≡ K1 → ⇧[0, e] T1 ≡ U1 → - ⦃G1, L1, U1⦄ ⊐* ⦃G2, K2, T2⦄. -#G1 #G2 #K1 #K2 #T1 #T2 #H @(fqus_ind … H) -G2 -K2 -T2 -/3 width=5 by fqus_strap1, fquq_fqus, fquq_drop/ -qed-. - -lemma fqup_fqus: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄. -#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind … H) -G2 -L2 -T2 -/3 width=5 by fqus_strap1, fquq_fqus, fqu_fquq/ -qed. - -(* Basic forward lemmas *****************************************************) - -lemma fqus_fwd_fw: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → ♯{G2, L2, T2} ≤ ♯{G1, L1, T1}. -#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqus_ind … H) -L2 -T2 -/3 width=3 by fquq_fwd_fw, transitive_le/ -qed-. - -(* Basic inversion lemmas ***************************************************) - -lemma fqup_inv_step_sn: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ → - ∃∃G,L,T. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ & ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄. -#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqup_ind_dx … H) -G1 -L1 -T1 /2 width=5 by ex2_3_intro/ -#G1 #G #L1 #L #T1 #T #H1 #_ * /4 width=9 by fqus_strap2, fqu_fquq, ex2_3_intro/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_alt.ma deleted file mode 100644 index 2afb20c02..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_alt.ma +++ /dev/null @@ -1,61 +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/relocation/fquq_alt.ma". -include "basic_2/substitution/fqus.ma". - -(* STAR-ITERATED SUPCLOSURE *************************************************) - -(* Advanced inversion lemmas ************************************************) - -lemma fqus_inv_gen: ∀G1,G2,L1,L2,T1,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄ ∨ (∧∧ G1 = G2 & L1 = L2 & T1 = T2). -#G1 #G2 #L1 #L2 #T1 #T2 #H @(fqus_ind … H) -G2 -L2 -T2 // -#G #G2 #L #L2 #T #T2 #_ #H2 * elim (fquq_inv_gen … H2) -H2 -[ /3 width=5 by fqup_strap1, or_introl/ -| * #HG #HL #HT destruct /2 width=1 by or_introl/ -| #H2 * #HG #HL #HT destruct /3 width=1 by fqu_fqup, or_introl/ -| * #H1G #H1L #H1T * #H2G #H2L #H2T destruct /2 width=1 by or_intror/ -] -qed-. - -(* Advanced properties ******************************************************) - -lemma fqus_strap1_fqu: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 elim (fqus_inv_gen … H1) -H1 -[ /2 width=5 by fqup_strap1/ -| * #HG #HL #HT destruct /2 width=1 by fqu_fqup/ -] -qed-. - -lemma fqus_strap2_fqu: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐ ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 elim (fqus_inv_gen … H2) -H2 -[ /2 width=5 by fqup_strap2/ -| * #HG #HL #HT destruct /2 width=1 by fqu_fqup/ -] -qed-. - -lemma fqus_fqup_trans: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐* ⦃G, L, T⦄ → ⦃G, L, T⦄ ⊐+ ⦃G2, L2, T2⦄ → - ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 #H2 @(fqup_ind … H2) -H2 -G2 -L2 -T2 -/2 width=5 by fqus_strap1_fqu, fqup_strap1/ -qed-. - -lemma fqup_fqus_trans: ∀G1,G,G2,L1,L,L2,T1,T,T2. ⦃G1, L1, T1⦄ ⊐+ ⦃G, L, T⦄ → - ⦃G, L, T⦄ ⊐* ⦃G2, L2, T2⦄ → ⦃G1, L1, T1⦄ ⊐+ ⦃G2, L2, T2⦄. -#G1 #G #G2 #L1 #L #L2 #T1 #T #T2 #H1 @(fqup_ind_dx … H1) -H1 -G1 -L1 -T1 -/3 width=5 by fqus_strap2_fqu, fqup_strap2/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_fqus.ma deleted file mode 100644 index 295d45b17..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/fqus_fqus.ma +++ /dev/null @@ -1,22 +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/fqus.ma". - -(* STAR-ITERATED SUPCLOSURE *************************************************) - -(* Main properties **********************************************************) - -theorem fqus_trans: tri_transitive … fqus. -/2 width=5 by tri_TC_transitive/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/frees.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/frees.ma deleted file mode 100644 index 1b817427d..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/frees.ma +++ /dev/null @@ -1,160 +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 "ground_2/ynat/ynat_plus.ma". -include "basic_2/notation/relations/freestar_4.ma". -include "basic_2/relocation/lift_neg.ma". -include "basic_2/relocation/ldrop.ma". - -(* CONTEXT-SENSITIVE FREE VARIABLES *****************************************) - -inductive frees: relation4 ynat lenv term nat ≝ -| frees_eq: ∀L,U,d,i. (∀T. ⇧[i, 1] T ≡ U → ⊥) → frees d L U i -| frees_be: ∀I,L,K,U,W,d,i,j. d ≤ yinj j → j < i → - (∀T. ⇧[j, 1] T ≡ U → ⊥) → ⇩[j]L ≡ K.ⓑ{I}W → - frees 0 K W (i-j-1) → frees d L U i. - -interpretation - "context-sensitive free variables (term)" - 'FreeStar L i d U = (frees d L U i). - -(* Basic inversion lemmas ***************************************************) - -lemma frees_inv: ∀L,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃U⦄ → - (∀T. ⇧[i, 1] T ≡ U → ⊥) ∨ - ∃∃I,K,W,j. d ≤ yinj j & j < i & (∀T. ⇧[j, 1] T ≡ U → ⊥) & - ⇩[j]L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. -#L #U #d #i * -L -U -d -i /4 width=9 by ex5_4_intro, or_intror, or_introl/ -qed-. - -lemma frees_inv_sort: ∀L,d,i,k. L ⊢ i ϵ 𝐅*[d]⦃⋆k⦄ → ⊥. -#L #d #i #k #H elim (frees_inv … H) -H [|*] /2 width=2 by/ -qed-. - -lemma frees_inv_gref: ∀L,d,i,p. L ⊢ i ϵ 𝐅*[d]⦃§p⦄ → ⊥. -#L #d #i #p #H elim (frees_inv … H) -H [|*] /2 width=2 by/ -qed-. - -lemma frees_inv_lref: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → - j = i ∨ - ∃∃I,K,W. d ≤ yinj j & j < i & ⇩[j] L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. -#L #d #x #i #H elim (frees_inv … H) -H -[ /4 width=2 by nlift_inv_lref_be_SO, or_introl/ -| * #I #K #W #j #Hdj #Hji #Hnx #HLK #HW - >(nlift_inv_lref_be_SO … Hnx) -x /3 width=5 by ex4_3_intro, or_intror/ -] -qed-. - -lemma frees_inv_lref_free: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → |L| ≤ j → j = i. -#L #d #j #i #H #Hj elim (frees_inv_lref … H) -H // -* #I #K #W #_ #_ #HLK lapply (ldrop_fwd_length_lt2 … HLK) -I -#H elim (lt_refl_false j) /2 width=3 by lt_to_le_to_lt/ -qed-. - -lemma frees_inv_lref_skip: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → yinj j < d → j = i. -#L #d #j #i #H #Hjd elim (frees_inv_lref … H) -H // -* #I #K #W #Hdj elim (ylt_yle_false … Hdj) -Hdj // -qed-. - -lemma frees_inv_lref_ge: ∀L,d,j,i. L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → i ≤ j → j = i. -#L #d #j #i #H #Hij elim (frees_inv_lref … H) -H // -* #I #K #W #_ #Hji elim (lt_refl_false j) -I -L -K -W -d /2 width=3 by lt_to_le_to_lt/ -qed-. - -lemma frees_inv_lref_lt: ∀L,d,j,i.L ⊢ i ϵ 𝐅*[d]⦃#j⦄ → j < i → - ∃∃I,K,W. d ≤ yinj j & ⇩[j] L ≡ K.ⓑ{I}W & K ⊢ (i-j-1) ϵ 𝐅*[yinj 0]⦃W⦄. -#L #d #j #i #H #Hji elim (frees_inv_lref … H) -H -[ #H elim (lt_refl_false j) // -| * /2 width=5 by ex3_3_intro/ -] -qed-. - -lemma frees_inv_bind: ∀a,I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄ → - L ⊢ i ϵ 𝐅*[d]⦃W⦄ ∨ L.ⓑ{I}W ⊢ i+1 ϵ 𝐅*[⫯d]⦃U⦄ . -#a #J #L #V #U #d #i #H elim (frees_inv … H) -H -[ #HnX elim (nlift_inv_bind … HnX) -HnX - /4 width=2 by frees_eq, or_intror, or_introl/ -| * #I #K #W #j #Hdj #Hji #HnX #HLK #HW elim (nlift_inv_bind … HnX) -HnX - [ /4 width=9 by frees_be, or_introl/ - | #HnT @or_intror @(frees_be … HnT) -HnT - [4,5,6: /2 width=1 by ldrop_drop, yle_succ, lt_minus_to_plus/ - |7: >minus_plus_plus_l // - |*: skip - ] - ] -] -qed-. - -lemma frees_inv_flat: ∀I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃ⓕ{I}W.U⦄ → - L ⊢ i ϵ 𝐅*[d]⦃W⦄ ∨ L ⊢ i ϵ 𝐅*[d]⦃U⦄ . -#J #L #V #U #d #i #H elim (frees_inv … H) -H -[ #HnX elim (nlift_inv_flat … HnX) -HnX - /4 width=2 by frees_eq, or_intror, or_introl/ -| * #I #K #W #j #Hdj #Hji #HnX #HLK #HW elim (nlift_inv_flat … HnX) -HnX - /4 width=9 by frees_be, or_intror, or_introl/ -] -qed-. - -(* Basic properties *********************************************************) - -lemma frees_lref_eq: ∀L,d,i. L ⊢ i ϵ 𝐅*[d]⦃#i⦄. -/3 width=7 by frees_eq, lift_inv_lref2_be/ qed. - -lemma frees_lref_be: ∀I,L,K,W,d,i,j. d ≤ yinj j → j < i → ⇩[j]L ≡ K.ⓑ{I}W → - K ⊢ i-j-1 ϵ 𝐅*[0]⦃W⦄ → L ⊢ i ϵ 𝐅*[d]⦃#j⦄. -/3 width=9 by frees_be, lift_inv_lref2_be/ qed. - -lemma frees_bind_sn: ∀a,I,L,W,U,d,i. L ⊢ i ϵ 𝐅*[d]⦃W⦄ → - L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄. -#a #I #L #W #U #d #i #H elim (frees_inv … H) -H [|*] -/4 width=9 by frees_be, frees_eq, nlift_bind_sn/ -qed. - -lemma frees_bind_dx: ∀a,I,L,W,U,d,i. L.ⓑ{I}W ⊢ i+1 ϵ 𝐅*[⫯d]⦃U⦄ → - L ⊢ i ϵ 𝐅*[d]⦃ⓑ{a,I}W.U⦄. -#a #J #L #V #U #d #i #H elim (frees_inv … H) -H -[ /4 width=9 by frees_eq, nlift_bind_dx/ -| * #I #K #W #j #Hdj #Hji #HnU #HLK #HW - elim (yle_inv_succ1 … Hdj) -Hdj (plus_minus_m_m j 1) in HnU; // H -H >commutative_plus #H (**) (* lemma needed here *) + 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 gget_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 (**) (* lemma needed here *) + 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 gget_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 gget_inv_lt: ∀I,G1,G2,V,e. + ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2. +/2 width=5 by gget_inv_lt_aux/ qed-. + +(* Basic properties *********************************************************) + +lemma gget_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: @gget_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *) +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/gget_gget.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/gget_gget.ma new file mode 100644 index 000000000..2f75c9812 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/gget_gget.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/gget.ma". + +(* GLOBAL ENVIRONMENT READING ***********************************************) + +(* Main properties **********************************************************) + +theorem gget_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 + >(gget_inv_gt … H He) -H -He // +| #G #He #G2 #H + >(gget_inv_eq … H He) -H -He // +| #I #G #G1 #V #He #_ #IHG1 #G2 #H + lapply (gget_inv_lt … H He) -H -He /2 width=1/ +] +qed-. + +lemma gget_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2). +#G1 #G2 #e +elim (gget_total e G1) #G #HG1 +elim (eq_genv_dec G G2) #HG2 +[ destruct /2 width=1/ +| @or_intror #HG12 + lapply (gget_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 deleted file mode 100644 index 57bb952b4..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2.ma +++ /dev/null @@ -1,74 +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/notation/relations/rat_3.ma". -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 by at_inv_nil_aux/ 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 by or_introl, conj/ -| #des1 #d1 #e1 #i1 #i2 #Hdi1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1 by or_intror, conj/ -] -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 by at_inv_cons_aux/ 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 deleted file mode 100644 index 22bf6af97..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_gr2.ma +++ /dev/null @@ -1,29 +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/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 by/ -| #des #d #e #i #i1 #Hdi #_ #IHi1 #x #H - lapply (at_inv_cons_ge … H Hdi) -H -Hdi /2 width=1 by/ -] -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 deleted file mode 100644 index 3c32514d2..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_minus.ma +++ /dev/null @@ -1,76 +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/notation/relations/rminus_3.ma". -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 by minuss_inv_nil1_aux/ 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 by ex3_intro, or_intror/ -| #des1 #des #d1 #e1 #i1 #Hdi1 #Hdes #d2 #e2 #des2 #H destruct /3 width=1 by or_introl, conj/ -] -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 by minuss_inv_cons1_aux/ 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 by ex2_intro/ -#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 deleted file mode 100644 index fc1618572..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/gr2_plus.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/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 new file mode 100644 index 000000000..97eab47d4 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop.ma @@ -0,0 +1,490 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "ground_2/lib/bool.ma". +include "ground_2/lib/lstar.ma". +include "basic_2/notation/relations/rdrop_5.ma". +include "basic_2/notation/relations/rdrop_4.ma". +include "basic_2/notation/relations/rdrop_3.ma". +include "basic_2/grammar/lenv_length.ma". +include "basic_2/grammar/cl_restricted_weight.ma". +include "basic_2/substitution/lift.ma". + +(* BASIC SLICING FOR LOCAL ENVIRONMENTS *************************************) + +(* Basic_1: includes: drop_skip_bind *) +inductive ldrop (s:bool): relation4 nat nat lenv lenv ≝ +| ldrop_atom: ∀d,e. (s = Ⓕ → e = 0) → ldrop s d e (⋆) (⋆) +| ldrop_pair: ∀I,L,V. ldrop s 0 0 (L.ⓑ{I}V) (L.ⓑ{I}V) +| ldrop_drop: ∀I,L1,L2,V,e. ldrop s 0 e L1 L2 → ldrop s 0 (e+1) (L1.ⓑ{I}V) L2 +| ldrop_skip: ∀I,L1,L2,V1,V2,d,e. + ldrop s d e L1 L2 → ⇧[d, e] V2 ≡ V1 → + ldrop s (d+1) e (L1.ⓑ{I}V1) (L2.ⓑ{I}V2) +. + +interpretation + "basic slicing (local environment) abstract" + 'RDrop s d e L1 L2 = (ldrop s d e L1 L2). +(* +interpretation + "basic slicing (local environment) general" + 'RDrop d e L1 L2 = (ldrop true d e L1 L2). +*) +interpretation + "basic slicing (local environment) lget" + 'RDrop e L1 L2 = (ldrop false O e L1 L2). + +definition l_liftable: predicate (lenv → relation term) ≝ + λR. ∀K,T1,T2. R K T1 T2 → ∀L,s,d,e. ⇩[s, d, e] L ≡ K → + ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2. + +definition l_deliftable_sn: predicate (lenv → relation term) ≝ + λR. ∀L,U1,U2. R L U1 U2 → ∀K,s,d,e. ⇩[s, d, e] L ≡ K → + ∀T1. ⇧[d, e] T1 ≡ U1 → + ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2. + +definition dropable_sn: predicate (relation lenv) ≝ + λR. ∀L1,K1,s,d,e. ⇩[s, d, e] L1 ≡ K1 → ∀L2. R L1 L2 → + ∃∃K2. R K1 K2 & ⇩[s, d, e] L2 ≡ K2. + +definition dropable_dx: predicate (relation lenv) ≝ + λR. ∀L1,L2. R L1 L2 → ∀K2,s,e. ⇩[s, 0, e] L2 ≡ K2 → + ∃∃K1. ⇩[s, 0, e] L1 ≡ K1 & R K1 K2. + +(* Basic inversion lemmas ***************************************************) + +fact ldrop_inv_atom1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → L1 = ⋆ → + L2 = ⋆ ∧ (s = Ⓕ → e = 0). +#L1 #L2 #s #d #e * -L1 -L2 -d -e +[ /3 width=1 by conj/ +| #I #L #V #H destruct +| #I #L1 #L2 #V #e #_ #H destruct +| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #H destruct +] +qed-. + +(* Basic_1: was: drop_gen_sort *) +lemma ldrop_inv_atom1: ∀L2,s,d,e. ⇩[s, d, e] ⋆ ≡ L2 → L2 = ⋆ ∧ (s = Ⓕ → e = 0). +/2 width=4 by ldrop_inv_atom1_aux/ qed-. + +fact ldrop_inv_O1_pair1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → d = 0 → + ∀K,I,V. L1 = K.ⓑ{I}V → + (e = 0 ∧ L2 = K.ⓑ{I}V) ∨ + (0 < e ∧ ⇩[s, d, e-1] K ≡ L2). +#L1 #L2 #s #d #e * -L1 -L2 -d -e +[ #d #e #_ #_ #K #J #W #H destruct +| #I #L #V #_ #K #J #W #HX destruct /3 width=1 by or_introl, conj/ +| #I #L1 #L2 #V #e #HL12 #_ #K #J #W #H destruct /3 width=1 by or_intror, conj/ +| #I #L1 #L2 #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct +] +qed-. + +lemma ldrop_inv_O1_pair1: ∀I,K,L2,V,s,e. ⇩[s, 0, e] K. ⓑ{I} V ≡ L2 → + (e = 0 ∧ L2 = K.ⓑ{I}V) ∨ + (0 < e ∧ ⇩[s, 0, e-1] K ≡ L2). +/2 width=3 by ldrop_inv_O1_pair1_aux/ qed-. + +lemma ldrop_inv_pair1: ∀I,K,L2,V,s. ⇩[s, 0, 0] K.ⓑ{I}V ≡ L2 → L2 = K.ⓑ{I}V. +#I #K #L2 #V #s #H +elim (ldrop_inv_O1_pair1 … H) -H * // #H destruct +elim (lt_refl_false … H) +qed-. + +(* Basic_1: was: drop_gen_drop *) +lemma ldrop_inv_drop1_lt: ∀I,K,L2,V,s,e. + ⇩[s, 0, e] K.ⓑ{I}V ≡ L2 → 0 < e → ⇩[s, 0, e-1] K ≡ L2. +#I #K #L2 #V #s #e #H #He +elim (ldrop_inv_O1_pair1 … H) -H * // #H destruct +elim (lt_refl_false … He) +qed-. + +lemma ldrop_inv_drop1: ∀I,K,L2,V,s,e. + ⇩[s, 0, e+1] K.ⓑ{I}V ≡ L2 → ⇩[s, 0, e] K ≡ L2. +#I #K #L2 #V #s #e #H lapply (ldrop_inv_drop1_lt … H ?) -H // +qed-. + +fact ldrop_inv_skip1_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → 0 < d → + ∀I,K1,V1. L1 = K1.ⓑ{I}V1 → + ∃∃K2,V2. ⇩[s, d-1, e] K1 ≡ K2 & + ⇧[d-1, e] V2 ≡ V1 & + L2 = K2.ⓑ{I}V2. +#L1 #L2 #s #d #e * -L1 -L2 -d -e +[ #d #e #_ #_ #J #K1 #W1 #H destruct +| #I #L #V #H elim (lt_refl_false … H) +| #I #L1 #L2 #V #e #_ #H elim (lt_refl_false … H) +| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV21 #_ #J #K1 #W1 #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +(* Basic_1: was: drop_gen_skip_l *) +lemma ldrop_inv_skip1: ∀I,K1,V1,L2,s,d,e. ⇩[s, d, e] K1.ⓑ{I}V1 ≡ L2 → 0 < d → + ∃∃K2,V2. ⇩[s, d-1, e] K1 ≡ K2 & + ⇧[d-1, e] V2 ≡ V1 & + L2 = K2.ⓑ{I}V2. +/2 width=3 by ldrop_inv_skip1_aux/ qed-. + +lemma ldrop_inv_O1_pair2: ∀I,K,V,s,e,L1. ⇩[s, 0, e] L1 ≡ K.ⓑ{I}V → + (e = 0 ∧ L1 = K.ⓑ{I}V) ∨ + ∃∃I1,K1,V1. ⇩[s, 0, e-1] K1 ≡ K.ⓑ{I}V & L1 = K1.ⓑ{I1}V1 & 0 < e. +#I #K #V #s #e * +[ #H elim (ldrop_inv_atom1 … H) -H #H destruct +| #L1 #I1 #V1 #H + elim (ldrop_inv_O1_pair1 … H) -H * + [ #H1 #H2 destruct /3 width=1 by or_introl, conj/ + | /3 width=5 by ex3_3_intro, or_intror/ + ] +] +qed-. + +fact ldrop_inv_skip2_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → 0 < d → + ∀I,K2,V2. L2 = K2.ⓑ{I}V2 → + ∃∃K1,V1. ⇩[s, d-1, e] K1 ≡ K2 & + ⇧[d-1, e] V2 ≡ V1 & + L1 = K1.ⓑ{I}V1. +#L1 #L2 #s #d #e * -L1 -L2 -d -e +[ #d #e #_ #_ #J #K2 #W2 #H destruct +| #I #L #V #H elim (lt_refl_false … H) +| #I #L1 #L2 #V #e #_ #H elim (lt_refl_false … H) +| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV21 #_ #J #K2 #W2 #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +(* Basic_1: was: drop_gen_skip_r *) +lemma ldrop_inv_skip2: ∀I,L1,K2,V2,s,d,e. ⇩[s, d, e] L1 ≡ K2.ⓑ{I}V2 → 0 < d → + ∃∃K1,V1. ⇩[s, d-1, e] K1 ≡ K2 & ⇧[d-1, e] V2 ≡ V1 & + L1 = K1.ⓑ{I}V1. +/2 width=3 by ldrop_inv_skip2_aux/ qed-. + +lemma ldrop_inv_O1_gt: ∀L,K,e,s. ⇩[s, 0, e] L ≡ K → |L| < e → + s = Ⓣ ∧ K = ⋆. +#L elim L -L [| #L #Z #X #IHL ] #K #e #s #H normalize in ⊢ (?%?→?); #H1e +[ elim (ldrop_inv_atom1 … H) -H elim s -s /2 width=1 by conj/ + #_ #Hs lapply (Hs ?) // -Hs #H destruct elim (lt_zero_false … H1e) +| elim (ldrop_inv_O1_pair1 … H) -H * #H2e #HLK destruct + [ elim (lt_zero_false … H1e) + | elim (IHL … HLK) -IHL -HLK /2 width=1 by lt_plus_to_minus_r, conj/ + ] +] +qed-. + +(* Basic properties *********************************************************) + +lemma ldrop_refl_atom_O2: ∀s,d. ⇩[s, d, O] ⋆ ≡ ⋆. +/2 width=1 by ldrop_atom/ qed. + +(* Basic_1: was by definition: drop_refl *) +lemma ldrop_refl: ∀L,d,s. ⇩[s, d, 0] L ≡ L. +#L elim L -L // +#L #I #V #IHL #d #s @(nat_ind_plus … d) -d /2 width=1 by ldrop_pair, ldrop_skip/ +qed. + +lemma ldrop_drop_lt: ∀I,L1,L2,V,s,e. + ⇩[s, 0, e-1] L1 ≡ L2 → 0 < e → ⇩[s, 0, e] L1.ⓑ{I}V ≡ L2. +#I #L1 #L2 #V #s #e #HL12 #He >(plus_minus_m_m e 1) /2 width=1 by ldrop_drop/ +qed. + +lemma ldrop_skip_lt: ∀I,L1,L2,V1,V2,s,d,e. + ⇩[s, d-1, e] L1 ≡ L2 → ⇧[d-1, e] V2 ≡ V1 → 0 < d → + ⇩[s, d, e] L1. ⓑ{I} V1 ≡ L2.ⓑ{I}V2. +#I #L1 #L2 #V1 #V2 #s #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) /2 width=1 by ldrop_skip/ +qed. + +lemma ldrop_O1_le: ∀s,e,L. e ≤ |L| → ∃K. ⇩[s, 0, e] L ≡ K. +#s #e @(nat_ind_plus … e) -e /2 width=2 by ex_intro/ +#e #IHe * +[ #H elim (le_plus_xSy_O_false … H) +| #L #I #V normalize #H elim (IHe L) -IHe /3 width=2 by ldrop_drop, monotonic_pred, ex_intro/ +] +qed-. + +lemma ldrop_O1_lt: ∀s,L,e. e < |L| → ∃∃I,K,V. ⇩[s, 0, e] L ≡ K.ⓑ{I}V. +#s #L elim L -L +[ #e #H elim (lt_zero_false … H) +| #L #I #V #IHL #e @(nat_ind_plus … e) -e /2 width=4 by ldrop_pair, ex1_3_intro/ + #e #_ normalize #H elim (IHL e) -IHL /3 width=4 by ldrop_drop, lt_plus_to_minus_r, lt_plus_to_lt_l, ex1_3_intro/ +] +qed-. + +lemma ldrop_O1_pair: ∀L,K,e,s. ⇩[s, 0, e] L ≡ K → e ≤ |L| → ∀I,V. + ∃∃J,W. ⇩[s, 0, e] L.ⓑ{I}V ≡ K.ⓑ{J}W. +#L elim L -L [| #L #Z #X #IHL ] #K #e #s #H normalize #He #I #V +[ elim (ldrop_inv_atom1 … H) -H #H <(le_n_O_to_eq … He) -e + #Hs destruct /2 width=3 by ex1_2_intro/ +| elim (ldrop_inv_O1_pair1 … H) -H * #He #HLK destruct /2 width=3 by ex1_2_intro/ + elim (IHL … HLK … Z X) -IHL -HLK + /3 width=3 by ldrop_drop_lt, le_plus_to_minus, ex1_2_intro/ +] +qed-. + +lemma ldrop_O1_ge: ∀L,e. |L| ≤ e → ⇩[Ⓣ, 0, e] L ≡ ⋆. +#L elim L -L [ #e #_ @ldrop_atom #H destruct ] +#L #I #V #IHL #e @(nat_ind_plus … e) -e [ #H elim (le_plus_xSy_O_false … H) ] +normalize /4 width=1 by ldrop_drop, monotonic_pred/ +qed. + +lemma ldrop_split: ∀L1,L2,d,e2,s. ⇩[s, d, e2] L1 ≡ L2 → ∀e1. e1 ≤ e2 → + ∃∃L. ⇩[s, d, e2 - e1] L1 ≡ L & ⇩[s, d, e1] L ≡ L2. +#L1 #L2 #d #e2 #s #H elim H -L1 -L2 -d -e2 +[ #d #e2 #Hs #e1 #He12 @(ex2_intro … (⋆)) + @ldrop_atom #H lapply (Hs H) -s #H destruct /2 width=1 by le_n_O_to_eq/ +| #I #L1 #V #e1 #He1 lapply (le_n_O_to_eq … He1) -He1 + #H destruct /2 width=3 by ex2_intro/ +| #I #L1 #L2 #V #e2 #HL12 #IHL12 #e1 @(nat_ind_plus … e1) -e1 + [ /3 width=3 by ldrop_drop, ex2_intro/ + | -HL12 #e1 #_ #He12 lapply (le_plus_to_le_r … He12) -He12 + #He12 elim (IHL12 … He12) -IHL12 >minus_plus_plus_l + #L #HL1 #HL2 elim (lt_or_ge (|L1|) (e2-e1)) #H0 + [ elim (ldrop_inv_O1_gt … HL1 H0) -HL1 #H1 #H2 destruct + elim (ldrop_inv_atom1 … HL2) -HL2 #H #_ destruct + @(ex2_intro … (⋆)) [ @ldrop_O1_ge normalize // ] + @ldrop_atom #H destruct + | elim (ldrop_O1_pair … HL1 H0 I V) -HL1 -H0 /3 width=5 by ldrop_drop, ex2_intro/ + ] + ] +| #I #L1 #L2 #V1 #V2 #d #e2 #_ #HV21 #IHL12 #e1 #He12 elim (IHL12 … He12) -IHL12 + #L #HL1 #HL2 elim (lift_split … HV21 d e1) -HV21 /3 width=5 by ldrop_skip, ex2_intro/ +] +qed-. + +lemma ldrop_FT: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → ⇩[Ⓣ, d, e] L1 ≡ L2. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e +/3 width=1 by ldrop_atom, ldrop_drop, ldrop_skip/ +qed. + +lemma ldrop_gen: ∀L1,L2,s,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → ⇩[s, d, e] L1 ≡ L2. +#L1 #L2 * /2 width=1 by ldrop_FT/ +qed-. + +lemma ldrop_T: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → ⇩[Ⓣ, d, e] L1 ≡ L2. +#L1 #L2 * /2 width=1 by ldrop_FT/ +qed-. + +lemma l_liftable_LTC: ∀R. l_liftable R → l_liftable (LTC … R). +#R #HR #K #T1 #T2 #H elim H -T2 +[ /3 width=10 by inj/ +| #T #T2 #_ #HT2 #IHT1 #L #s #d #e #HLK #U1 #HTU1 #U2 #HTU2 + elim (lift_total T d e) /4 width=12 by step/ +] +qed-. + +lemma l_deliftable_sn_LTC: ∀R. l_deliftable_sn R → l_deliftable_sn (LTC … R). +#R #HR #L #U1 #U2 #H elim H -U2 +[ #U2 #HU12 #K #s #d #e #HLK #T1 #HTU1 + elim (HR … HU12 … HLK … HTU1) -HR -L -U1 /3 width=3 by inj, ex2_intro/ +| #U #U2 #_ #HU2 #IHU1 #K #s #d #e #HLK #T1 #HTU1 + elim (IHU1 … HLK … HTU1) -IHU1 -U1 #T #HTU #HT1 + elim (HR … HU2 … HLK … HTU) -HR -L -U /3 width=5 by step, ex2_intro/ +] +qed-. + +lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R). +#R #HR #L1 #K1 #s #d #e #HLK1 #L2 #H elim H -L2 +[ #L2 #HL12 elim (HR … HLK1 … HL12) -HR -L1 + /3 width=3 by inj, ex2_intro/ +| #L #L2 #_ #HL2 * #K #HK1 #HLK elim (HR … HLK … HL2) -HR -L + /3 width=3 by step, ex2_intro/ +] +qed-. + +lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R). +#R #HR #L1 #L2 #H elim H -L2 +[ #L2 #HL12 #K2 #s #e #HLK2 elim (HR … HL12 … HLK2) -HR -L2 + /3 width=3 by inj, ex2_intro/ +| #L #L2 #_ #HL2 #IHL1 #K2 #s #e #HLK2 elim (HR … HL2 … HLK2) -HR -L2 + #K #HLK #HK2 elim (IHL1 … HLK) -L + /3 width=5 by step, ex2_intro/ +] +qed-. + +lemma l_deliftable_sn_llstar: ∀R. l_deliftable_sn R → + ∀l. l_deliftable_sn (llstar … R l). +#R #HR #l #L #U1 #U2 #H @(lstar_ind_r … l U2 H) -l -U2 +[ /2 width=3 by lstar_O, ex2_intro/ +| #l #U #U2 #_ #HU2 #IHU1 #K #s #d #e #HLK #T1 #HTU1 + elim (IHU1 … HLK … HTU1) -IHU1 -U1 #T #HTU #HT1 + elim (HR … HU2 … HLK … HTU) -HR -L -U /3 width=5 by lstar_dx, ex2_intro/ +] +qed-. + +(* Basic forvard lemmas *****************************************************) + +(* Basic_1: was: drop_S *) +lemma ldrop_fwd_drop2: ∀L1,I2,K2,V2,s,e. ⇩[s, O, e] L1 ≡ K2. ⓑ{I2} V2 → + ⇩[s, O, e + 1] L1 ≡ K2. +#L1 elim L1 -L1 +[ #I2 #K2 #V2 #s #e #H lapply (ldrop_inv_atom1 … H) -H * #H destruct +| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #s #e #H + elim (ldrop_inv_O1_pair1 … H) -H * #He #H + [ -IHL1 destruct /2 width=1 by ldrop_drop/ + | @ldrop_drop >(plus_minus_m_m e 1) /2 width=3 by/ + ] +] +qed-. + +lemma ldrop_fwd_length_ge: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → |L1| ≤ d → |L2| = |L1|. +#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e // normalize +[ #I #L1 #L2 #V #e #_ #_ #H elim (le_plus_xSy_O_false … H) +| /4 width=2 by le_plus_to_le_r, eq_f/ +] +qed-. + +lemma ldrop_fwd_length_le_le: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → d ≤ |L1| → e ≤ |L1| - d → |L2| = |L1| - e. +#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e // normalize +[ /3 width=2 by le_plus_to_le_r/ +| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #IHL12 >minus_plus_plus_l + #Hd #He lapply (le_plus_to_le_r … Hd) -Hd + #Hd >IHL12 // -L2 >plus_minus /2 width=3 by transitive_le/ +] +qed-. + +lemma ldrop_fwd_length_le_ge: ∀L1,L2,d,e,s. ⇩[s, d, e] L1 ≡ L2 → d ≤ |L1| → |L1| - d ≤ e → |L2| = d. +#L1 #L2 #d #e #s #H elim H -L1 -L2 -d -e normalize +[ /2 width=1 by le_n_O_to_eq/ +| #I #L #V #_ (lift_fwd_tw … HV21) -HV21 /2 width=1 by monotonic_le_plus_l/ +] +qed-. + +lemma ldrop_fwd_lw_lt: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → 0 < e → ♯{L2} < ♯{L1}. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e +[ #d #e #H >H -H // +| #I #L #V #H elim (lt_refl_false … H) +| #I #L1 #L2 #V #e #HL12 #_ #_ + lapply (ldrop_fwd_lw … HL12) -HL12 #HL12 + @(le_to_lt_to_lt … HL12) -HL12 // +| #I #L1 #L2 #V1 #V2 #d #e #_ #HV21 #IHL12 #H normalize in ⊢ (?%%); -I + >(lift_fwd_tw … HV21) -V2 /3 by lt_minus_to_plus/ +] +qed-. + +lemma ldrop_fwd_rfw: ∀I,L,K,V,i. ⇩[i] L ≡ K.ⓑ{I}V → ∀T. ♯{K, V} < ♯{L, T}. +#I #L #K #V #i #HLK lapply (ldrop_fwd_lw … HLK) -HLK +normalize in ⊢ (%→?→?%%); /3 width=3 by le_to_lt_to_lt/ +qed-. + +(* Advanced inversion lemmas ************************************************) + +fact ldrop_inv_O2_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → e = 0 → L1 = L2. +#L1 #L2 #s #d #e #H elim H -L1 -L2 -d -e +[ // +| // +| #I #L1 #L2 #V #e #_ #_ >commutative_plus normalize #H destruct +| #I #L1 #L2 #V1 #V2 #d #e #_ #HV21 #IHL12 #H + >(IHL12 H) -L1 >(lift_inv_O2_aux … HV21 … H) -V2 -d -e // +] +qed-. + +(* Basic_1: was: drop_gen_refl *) +lemma ldrop_inv_O2: ∀L1,L2,s,d. ⇩[s, d, 0] L1 ≡ L2 → L1 = L2. +/2 width=5 by ldrop_inv_O2_aux/ qed-. + +lemma ldrop_inv_length_eq: ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ L2 → |L1| = |L2| → e = 0. +#L1 #L2 #d #e #H #HL12 lapply (ldrop_fwd_length_minus4 … H) // +qed-. + +lemma ldrop_inv_refl: ∀L,d,e. ⇩[Ⓕ, d, e] L ≡ L → e = 0. +/2 width=5 by ldrop_inv_length_eq/ qed-. + +fact ldrop_inv_FT_aux: ∀L1,L2,s,d,e. ⇩[s, d, e] L1 ≡ L2 → + ∀I,K,V. L2 = K.ⓑ{I}V → s = Ⓣ → d = 0 → + ⇩[Ⓕ, d, e] L1 ≡ K.ⓑ{I}V. +#L1 #L2 #s #d #e #H elim H -L1 -L2 -d -e +[ #d #e #_ #J #K #W #H destruct +| #I #L #V #J #K #W #H destruct // +| #I #L1 #L2 #V #e #_ #IHL12 #J #K #W #H1 #H2 destruct + /3 width=1 by ldrop_drop/ +| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #_ #J #K #W #_ #_ + (lift_inj … HVT1 … HVT2) -HVT1 -HVT2 + >(IHLK1 … HLK2) -IHLK1 -HLK2 // +] +qed-. + +(* Basic_1: was: drop_conf_ge *) +theorem ldrop_conf_ge: ∀L,L1,s1,d1,e1. ⇩[s1, d1, e1] L ≡ L1 → + ∀L2,s2,e2. ⇩[s2, 0, e2] L ≡ L2 → d1 + e1 ≤ e2 → + ⇩[s2, 0, e2 - e1] L1 ≡ L2. +#L #L1 #s1 #d1 #e1 #H elim H -L -L1 -d1 -e1 // +[ #d #e #_ #L2 #s2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H + #H #He destruct + @ldrop_atom #H >He // (**) (* explicit constructor *) +| #I #L #K #V #e #_ #IHLK #L2 #s2 #e2 #H #He2 + lapply (ldrop_inv_drop1_lt … H ?) -H /2 width=2 by ltn_to_ltO/ #HL2 + minus_minus_comm /3 width=1 by monotonic_pred/ +| #I #L #K #V1 #V2 #d #e #_ #_ #IHLK #L2 #s2 #e2 #H #Hdee2 + lapply (transitive_le 1 … Hdee2) // #He2 + lapply (ldrop_inv_drop1_lt … H ?) -H // -He2 #HL2 + lapply (transitive_le (1+e) … Hdee2) // #Hee2 + @ldrop_drop_lt >minus_minus_comm /3 width=1 by lt_minus_to_plus_r, monotonic_le_minus_r, monotonic_pred/ (**) (* explicit constructor *) +] +qed. + +(* Note: apparently this was missing in basic_1 *) +theorem ldrop_conf_be: ∀L0,L1,s1,d1,e1. ⇩[s1, d1, e1] L0 ≡ L1 → + ∀L2,e2. ⇩[e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 → + ∃∃L. ⇩[s1, 0, d1 + e1 - e2] L2 ≡ L & ⇩[d1] L1 ≡ L. +#L0 #L1 #s1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1 +[ #d1 #e1 #He1 #L2 #e2 #H #Hd1 #_ elim (ldrop_inv_atom1 … H) -H #H #He2 destruct + >(He2 ?) in Hd1; // -He2 #Hd1 <(le_n_O_to_eq … Hd1) -d1 + /4 width=3 by ldrop_atom, ex2_intro/ +| normalize #I #L #V #L2 #e2 #HL2 #_ #He2 + lapply (le_n_O_to_eq … He2) -He2 #H destruct + lapply (ldrop_inv_O2 … HL2) -HL2 #H destruct /2 width=3 by ldrop_pair, ex2_intro/ +| normalize #I #L0 #K0 #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21 + lapply (ldrop_inv_O1_pair1 … 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 by ldrop_drop_lt, ex2_intro/ + ] +] +qed-. + +(* Note: with "s2", the conclusion parameter is "s1 ∨ s2" *) +(* Basic_1: was: drop_trans_ge *) +theorem ldrop_trans_ge: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → + ∀L2,e2. ⇩[e2] L ≡ L2 → d1 ≤ e2 → ⇩[s1, 0, e1 + e2] L1 ≡ L2. +#L1 #L #s1 #d1 #e1 #H elim H -L1 -L -d1 -e1 +[ #d1 #e1 #He1 #L2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H + #H #He2 destruct /4 width=1 by ldrop_atom, eq_f2/ +| /2 width=1 by ldrop_gen/ +| /3 width=1 by ldrop_drop/ +| #I #L1 #L2 #V1 #V2 #d #e #_ #_ #IHL12 #L #e2 #H #Hde2 + lapply (lt_to_le_to_lt 0 … Hde2) // #He2 + lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2 + lapply (ldrop_inv_drop1_lt … H ?) -H // #HL2 + @ldrop_drop_lt // >le_plus_minus /3 width=1 by monotonic_pred/ +] +qed. + +(* Basic_1: was: drop_trans_le *) +theorem ldrop_trans_le: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → + ∀L2,s2,e2. ⇩[s2, 0, e2] L ≡ L2 → e2 ≤ d1 → + ∃∃L0. ⇩[s2, 0, e2] L1 ≡ L0 & ⇩[s1, d1 - e2, e1] L0 ≡ L2. +#L1 #L #s1 #d1 #e1 #H elim H -L1 -L -d1 -e1 +[ #d1 #e1 #He1 #L2 #s2 #e2 #H #_ elim (ldrop_inv_atom1 … H) -H + #H #He2 destruct /4 width=3 by ldrop_atom, ex2_intro/ +| #I #K #V #L2 #s2 #e2 #HL2 #H lapply (le_n_O_to_eq … H) -H + #H destruct /2 width=3 by ldrop_pair, ex2_intro/ +| #I #L1 #L2 #V #e #_ #IHL12 #L #s2 #e2 #HL2 #H lapply (le_n_O_to_eq … H) -H + #H destruct elim (IHL12 … HL2) -IHL12 -HL2 // + #L0 #H #HL0 lapply (ldrop_inv_O2 … H) -H #H destruct + /3 width=5 by ldrop_pair, ldrop_drop, ex2_intro/ +| #I #L1 #L2 #V1 #V2 #d #e #HL12 #HV12 #IHL12 #L #s2 #e2 #H #He2d + elim (ldrop_inv_O1_pair1 … H) -H * + [ -He2d -IHL12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ldrop_skip, ex2_intro/ + | -HL12 -HV12 #He2 #HL2 + elim (IHL12 … HL2) -L2 [ >minus_le_minus_minus_comm // /3 width=3 by ldrop_drop_lt, ex2_intro/ | /2 width=1 by monotonic_pred/ ] + ] +] +qed-. + +(* Advanced properties ******************************************************) + +lemma l_liftable_llstar: ∀R. l_liftable R → ∀l. l_liftable (llstar … R l). +#R #HR #l #K #T1 #T2 #H @(lstar_ind_r … l T2 H) -l -T2 +[ #L #s #d #e #_ #U1 #HTU1 #U2 #HTU2 -HR -K + >(lift_mono … HTU2 … HTU1) -T1 -U2 -d -e // +| #l #T #T2 #_ #HT2 #IHT1 #L #s #d #e #HLK #U1 #HTU1 #U2 #HTU2 + elim (lift_total T d e) /3 width=12 by lstar_dx/ +] +qed-. + +(* Basic_1: was: drop_conf_lt *) +lemma ldrop_conf_lt: ∀L,L1,s1,d1,e1. ⇩[s1, d1, e1] L ≡ L1 → + ∀I,K2,V2,s2,e2. ⇩[s2, 0, e2] L ≡ K2.ⓑ{I}V2 → + e2 < d1 → let d ≝ d1 - e2 - 1 in + ∃∃K1,V1. ⇩[s2, 0, e2] L1 ≡ K1.ⓑ{I}V1 & + ⇩[s1, d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2. +#L #L1 #s1 #d1 #e1 #H1 #I #K2 #V2 #s2 #e2 #H2 #He2d1 +elim (ldrop_conf_le … H1 … H2) -L /2 width=2 by lt_to_le/ #K #HL1K #HK2 +elim (ldrop_inv_skip1 … HK2) -HK2 /2 width=1 by lt_plus_to_minus_r/ +#K1 #V1 #HK21 #HV12 #H destruct /2 width=5 by ex3_2_intro/ +qed-. + +(* Note: apparently this was missing in basic_1 *) +lemma ldrop_trans_lt: ∀L1,L,s1,d1,e1. ⇩[s1, d1, e1] L1 ≡ L → + ∀I,L2,V2,s2,e2. ⇩[s2, 0, e2] L ≡ L2.ⓑ{I}V2 → + e2 < d1 → let d ≝ d1 - e2 - 1 in + ∃∃L0,V0. ⇩[s2, 0, e2] L1 ≡ L0.ⓑ{I}V0 & + ⇩[s1, d, e1] L0 ≡ L2 & ⇧[d, e1] V2 ≡ V0. +#L1 #L #s1 #d1 #e1 #HL1 #I #L2 #V2 #s2 #e2 #HL2 #Hd21 +elim (ldrop_trans_le … HL1 … HL2) -L /2 width=1 by lt_to_le/ #L0 #HL10 #HL02 +elim (ldrop_inv_skip2 … HL02) -HL02 /2 width=1 by lt_plus_to_minus_r/ #L #V1 #HL2 #HV21 #H destruct /2 width=5 by ex3_2_intro/ +qed-. + +lemma ldrop_trans_ge_comm: ∀L1,L,L2,s1,d1,e1,e2. + ⇩[s1, d1, e1] L1 ≡ L → ⇩[e2] L ≡ L2 → d1 ≤ e2 → + ⇩[s1, 0, e2 + e1] L1 ≡ L2. +#L1 #L #L2 #s1 #d1 #e1 #e2 +>commutative_plus /2 width=5 by ldrop_trans_ge/ +qed. + +lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[e1] L ≡ K.ⓑ{I1}V1 → + ∀I2,V2,e2. ⇩[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_length_minus2 … HK) #H +elim (discr_minus_x_xy … H) -H +[1,3: normalize H in HK; #HK +lapply (ldrop_inv_O2 … HK) -HK #H destruct +lapply (inv_eq_minus_O … H) -H /3 width=1 by le_to_le_to_eq, and3_intro/ +qed-. + +(* Advanced forward lemmas **************************************************) + +lemma ldrop_fwd_be: ∀L,K,s,d,e,i. ⇩[s, d, e] L ≡ K → |K| ≤ i → i < d → |L| ≤ i. +#L #K #s #d #e #i #HLK #HK #Hd elim (lt_or_ge i (|L|)) // +#HL elim (ldrop_O1_lt (Ⓕ) … HL) #I #K0 #V #HLK0 -HL +elim (ldrop_conf_lt … HLK … HLK0) // -HLK -HLK0 -Hd +#K1 #V1 #HK1 #_ #_ lapply (ldrop_fwd_length_lt2 … HK1) -I -K1 -V1 +#H elim (lt_refl_false i) /2 width=3 by lt_to_le_to_lt/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_leq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_leq.ma new file mode 100644 index 000000000..30d962a01 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrop_leq.ma @@ -0,0 +1,92 @@ +(**************************************************************************) +(* ___ *) +(* ||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/leq_leq.ma". +include "basic_2/substitution/ldrop.ma". + +(* BASIC SLICING FOR LOCAL ENVIRONMENTS *************************************) + +definition dedropable_sn: predicate (relation lenv) ≝ + λR. ∀L1,K1,s,d,e. ⇩[s, d, e] L1 ≡ K1 → ∀K2. R K1 K2 → + ∃∃L2. R L1 L2 & ⇩[s, d, e] L2 ≡ K2 & L1 ≃[d, e] L2. + +(* Properties on equivalence ************************************************) + +lemma leq_ldrop_trans_be: ∀L1,L2,d,e. L1 ≃[d, e] L2 → + ∀I,K2,W,s,i. ⇩[s, 0, i] L2 ≡ K2.ⓑ{I}W → + d ≤ i → i < d + e → + ∃∃K1. K1 ≃[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L1 ≡ K1.ⓑ{I}W. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e +[ #d #e #J #K2 #W #s #i #H + elim (ldrop_inv_atom1 … H) -H #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #_ #_ #J #K2 #W #s #i #_ #_ #H + elim (ylt_yle_false … H) // +| #I #L1 #L2 #V #e #HL12 #IHL12 #J #K2 #W #s #i #H #_ >yplus_O1 + elim (ldrop_inv_O1_pair1 … H) -H * #Hi #HLK1 [ -IHL12 | -HL12 ] + [ #_ destruct >ypred_succ + /2 width=3 by ldrop_pair, ex2_intro/ + | lapply (ylt_inv_O1 i ?) /2 width=1 by ylt_inj/ + #H yminus_succ yplus_succ1 #H lapply (ylt_inv_succ … H) -H + #Hide lapply (ldrop_inv_drop1_lt … HLK2 ?) -HLK2 /2 width=1 by ylt_O/ + #HLK1 elim (IHL12 … HLK1) -IHL12 -HLK1 yminus_SO2 + /4 width=3 by ylt_O, ldrop_drop_lt, ex2_intro/ +] +qed-. + +lemma leq_ldrop_conf_be: ∀L1,L2,d,e. L1 ≃[d, e] L2 → + ∀I,K1,W,s,i. ⇩[s, 0, i] L1 ≡ K1.ⓑ{I}W → + d ≤ i → i < d + e → + ∃∃K2. K1 ≃[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L2 ≡ K2.ⓑ{I}W. +#L1 #L2 #d #e #HL12 #I #K1 #W #s #i #HLK1 #Hdi #Hide +elim (leq_ldrop_trans_be … (leq_sym … HL12) … HLK1) // -L1 -Hdi -Hide +/3 width=3 by leq_sym, ex2_intro/ +qed-. + +lemma ldrop_O1_ex: ∀K2,i,L1. |L1| = |K2| + i → + ∃∃L2. L1 ≃[0, i] L2 & ⇩[i] L2 ≡ K2. +#K2 #i @(nat_ind_plus … i) -i +[ /3 width=3 by leq_O2, ex2_intro/ +| #i #IHi #Y #Hi elim (ldrop_O1_lt (Ⓕ) Y 0) // + #I #L1 #V #H lapply (ldrop_inv_O2 … H) -H #H destruct + normalize in Hi; elim (IHi L1) -IHi + /3 width=5 by ldrop_drop, leq_pair, injective_plus_l, ex2_intro/ +] +qed-. + +lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R). +#R #HR #L1 #K1 #s #d #e #HLK1 #K2 #H elim H -K2 +[ #K2 #HK12 elim (HR … HLK1 … HK12) -HR -K1 + /3 width=4 by inj, ex3_intro/ +| #K #K2 #_ #HK2 * #L #H1L1 #HLK #H2L1 elim (HR … HLK … HK2) -HR -K + /3 width=6 by leq_trans, step, ex3_intro/ +] +qed-. + +(* Inversion lemmas on equivalence ******************************************) + +lemma ldrop_O1_inj: ∀i,L1,L2,K. ⇩[i] L1 ≡ K → ⇩[i] L2 ≡ K → L1 ≃[i, ∞] L2. +#i @(nat_ind_plus … i) -i +[ #L1 #L2 #K #H <(ldrop_inv_O2 … H) -K #H <(ldrop_inv_O2 … H) -L1 // +| #i #IHi * [2: #L1 #I1 #V1 ] * [2,4: #L2 #I2 #V2 ] #K #HLK1 #HLK2 // + lapply (ldrop_fwd_length … HLK1) + <(ldrop_fwd_length … HLK2) [ /4 width=5 by ldrop_inv_drop1, leq_succ/ ] + normalize (ldrops_inv_nil … H) -L1 /2 width=7 by lifts_nil, minuss_nil, ex4_3_intro, ldrops_nil/ -| #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 by lt_plus_to_minus_r/ #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 by lifts_cons, ldrops_cons/ | skip ] - normalize >plus_minus /3 width=1 by minuss_lt, lt_minus_to_plus/ (**) (* explicit constructors *) -| #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 by minuss_ge, ex4_3_intro, le_S_S/ -] -qed-. - -(* Basic properties *********************************************************) - -(* Basic_1: was: drop1_skip_bind *) -lemma ldrops_skip: ∀L1,L2,s,des. ⇩*[s, des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 → - ∀I. ⇩*[s, des + 1] L1.ⓑ{I}V1 ≡ L2.ⓑ{I}V2. -#L1 #L2 #s #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 by ldrop_skip, ldrops_cons/ -]. -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 deleted file mode 100644 index 302829e62..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/ldrops_ldrop.ma +++ /dev/null @@ -1,36 +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/relocation/ldrop_ldrop.ma". -include "basic_2/substitution/ldrops.ma". - -(* ITERATED LOCAL ENVIRONMENT SLICING ***************************************) - -(* Properties concerning basic local environment slicing ********************) - -lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[Ⓕ, des] L1 ≡ L → ∀L2,i. ⇩[i] L ≡ L2 → - ∃∃L0,des0,i0. ⇩[i0] L1 ≡ L0 & ⇩*[Ⓕ, des0] L0 ≡ L2 & - @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0. -#L1 #L #des #H elim H -L1 -L -des -[ /2 width=7 by ldrops_nil, minuss_nil, at_nil, ex4_3_intro/ -| #L1 #L0 #L #des #d #e #_ #HL0 #IHL0 #L2 #i #HL2 - elim (lt_or_ge i d) #Hid - [ elim (ldrop_trans_le … HL0 … HL2) -L /2 width=2 by lt_to_le/ - #L #HL0 #HL2 elim (IHL0 … HL0) -L0 /3 width=7 by ldrops_cons, minuss_lt, at_lt, ex4_3_intro/ - | lapply (ldrop_trans_ge … HL0 … HL2 ?) -L // #HL02 - elim (IHL0 … HL02) -L0 /3 width=7 by minuss_ge, at_ge, ex4_3_intro/ - ] -] -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 deleted file mode 100644 index 474862b8c..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/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/substitution/ldrops_ldrop.ma". - -(* ITERATED LOCAL ENVIRONMENT SLICING ***************************************) - -(* Main properties **********************************************************) - -(* Basic_1: was: drop1_trans *) -theorem ldrops_trans: ∀L,L2,s,des2. ⇩*[s, des2] L ≡ L2 → ∀L1,des1. ⇩*[s, des1] L1 ≡ L → - ⇩*[s, des2 @@ des1] L1 ≡ L2. -#L #L2 #s #des2 #H elim H -L -L2 -des2 /3 width=3 by ldrops_cons/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma new file mode 100644 index 000000000..f90b349b3 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift.ma @@ -0,0 +1,394 @@ +(**************************************************************************) +(* ___ *) +(* ||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/notation/relations/rlift_4.ma". +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: relation4 nat nat term 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). + +(* Basic inversion lemmas ***************************************************) + +fact lift_inv_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_O2: ∀d,T1,T2. ⇧[d, 0] T1 ≡ T2 → T1 = T2. +/2 width=4 by lift_inv_O2_aux/ 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 by lift_inv_sort1_aux/ 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 by lift_inv_lref1_aux/ 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 by lift_inv_gref1_aux/ 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 by lift_inv_bind1_aux/ 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 by lift_inv_flat1_aux/ 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 by lift_inv_sort2_aux/ 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. + +(* 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 new file mode 100644 index 000000000..46b257efe --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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 by monotonic_le_plus_l/ +| #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 by eq_f2/ +| #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 by eq_f2/ +] +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 by lift_sort, ex2_intro/ +| #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 /3 width=3 by lift_lref_lt, lt_plus_to_minus_r, lt_to_le_to_lt, ex2_intro/ +| #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 by lift_lref_lt, lift_lref_ge, ex2_intro/ + | -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 ⊢ (? ? ? %); + /4 width=3 by lift_lref_ge, ex2_intro/ + ] +| #p #d1 #e1 #d2 #e2 #T2 #Hk #Hd12 + lapply (lift_inv_gref2 … Hk) -Hk #Hk destruct /3 width=3 by lift_gref, ex2_intro/ +| #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) /3 width=5 by lift_bind, le_S_S, ex2_intro/ +| #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 by lift_flat, ex2_intro/ +] +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 by lift_sort, ex2_intro/ +| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2 + >(lift_inv_lref2_lt … H) -H /3 width=3 by lift_lref_lt, lt_plus_to_minus_r, lt_to_le_to_lt, ex2_intro/ +| #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 by le_plus/ + | >(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_associative // | /2 width=1 by minus_le_minus_minus_comm/ ] + ] +| #p #d1 #e1 #e #e2 #T2 #H >(lift_inv_gref2 … H) -H /2 width=3 by lift_gref, ex2_intro/ +| #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 /3 width=5 by lift_bind, ex2_intro/ +| #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 /3 width=5 by lift_flat, ex2_intro/ +] +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 by eq_f2/ +| #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 by eq_f2/ +] +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 by lift_lref_lt/ +| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #_ #Hd21 + lapply (lift_inv_lref1_ge … HT2 ?) -HT2 + [ @(transitive_le … Hd21 ?) -Hd21 /2 width=1 by monotonic_le_plus_l/ + | -Hd21 /2 width=1 by lift_lref_ge/ + ] +| #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 by lift_bind, le_S_S/ (**) (* full auto a bit slow *) +| #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 by lift_flat/ (**) (* full auto a bit slow *) +] +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 by lift_sort, ex2_intro/ +| #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 /4 width=3 by lift_lref_ge_minus, lift_lref_lt, lt_minus_to_plus, monotonic_le_plus_l, ex2_intro/ +| #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 by transitive_le/ #HX destruct + >plus_plus_comm_23 /4 width=3 by lift_lref_ge_minus, lift_lref_ge, monotonic_le_plus_l, ex2_intro/ +| #p #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_gref1 … HX) -HX /2 width=3 by lift_gref, ex2_intro/ +| #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 /3 width=5 by lift_bind, le_S_S, ex2_intro/ +| #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 by lift_flat, ex2_intro/ +] +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 by lift_sort, ex2_intro/ +| #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 by le_plus_to_minus_r/ #Hid2e + lapply (lt_to_le_to_lt … Hid1e Hded) -Hid1e -Hded #Hid2 + lapply (lift_inv_lref1_lt … HX ?) -HX // #HX destruct /3 width=3 by lift_lref_lt, ex2_intro/ +| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_ + elim (lift_inv_lref1 … HX) -HX * #Hied #HX destruct /4 width=3 by lift_lref_lt, lift_lref_ge, monotonic_le_minus_l, lt_plus_to_minus_r, transitive_le, ex2_intro/ +| #p #d1 #e1 #d2 #e2 #X #HX #_ + >(lift_inv_gref1 … HX) -HX /2 width=3 by lift_gref, ex2_intro/ +| #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 by le_S_S/ #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 new file mode 100644 index 000000000..cdc11129d --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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_neg.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_neg.ma new file mode 100644 index 000000000..ba97d5c54 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lift_neg.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/lift.ma". + +(* BASIC TERM RELOCATION ****************************************************) + +(* Properties on negated basic relocation ***********************************) + +lemma nlift_lref_be_SO: ∀X,i. ⇧[i, 1] X ≡ #i → ⊥. +/2 width=7 by lift_inv_lref2_be/ qed-. + +lemma nlift_bind_sn: ∀W,d,e. (∀V. ⇧[d, e] V ≡ W → ⊥) → + ∀a,I,U. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥). +#W #d #e #HW #a #I #U #X #H elim (lift_inv_bind2 … H) -H /2 width=2 by/ +qed-. + +lemma nlift_bind_dx: ∀U,d,e. (∀T. ⇧[d+1, e] T ≡ U → ⊥) → + ∀a,I,W. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥). +#U #d #e #HU #a #I #W #X #H elim (lift_inv_bind2 … H) -H /2 width=2 by/ +qed-. + +lemma nlift_flat_sn: ∀W,d,e. (∀V. ⇧[d, e] V ≡ W → ⊥) → + ∀I,U. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥). +#W #d #e #HW #I #U #X #H elim (lift_inv_flat2 … H) -H /2 width=2 by/ +qed-. + +lemma nlift_flat_dx: ∀U,d,e. (∀T. ⇧[d, e] T ≡ U → ⊥) → + ∀I,W. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥). +#U #d #e #HU #I #W #X #H elim (lift_inv_flat2 … H) -H /2 width=2 by/ +qed-. + +(* Inversion lemmas on negated basic relocation *****************************) + +lemma nlift_inv_lref_be_SO: ∀i,j. (∀X. ⇧[i, 1] X ≡ #j → ⊥) → j = i. +#i #j elim (lt_or_eq_or_gt i j) // #Hij #H +[ elim (H (#(j-1))) -H /2 width=1 by lift_lref_ge_minus/ +| elim (H (#j)) -H /2 width=1 by lift_lref_lt/ +] +qed-. + +lemma nlift_inv_bind: ∀a,I,W,U,d,e. (∀X. ⇧[d, e] X ≡ ⓑ{a,I}W.U → ⊥) → + (∀V. ⇧[d, e] V ≡ W → ⊥) ∨ (∀T. ⇧[d+1, e] T ≡ U → ⊥). +#a #I #W #U #d #e #H elim (is_lift_dec W d e) +[ * /4 width=2 by lift_bind, or_intror/ +| /4 width=2 by ex_intro, or_introl/ +] +qed-. + +lemma nlift_inv_flat: ∀I,W,U,d,e. (∀X. ⇧[d, e] X ≡ ⓕ{I}W.U → ⊥) → + (∀V. ⇧[d, e] V ≡ W → ⊥) ∨ (∀T. ⇧[d, e] T ≡ U → ⊥). +#I #W #U #d #e #H elim (is_lift_dec W d e) +[ * /4 width=2 by lift_flat, or_intror/ +| /4 width=2 by ex_intro, or_introl/ +] +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 new file mode 100644 index 000000000..ea5458ec7 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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 by liftv_inv_nil1_aux/ 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 by ex3_2_intro/ +] +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 by liftv_inv_cons1_aux/ 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 by liftv_nil, ex_intro/ +| #T1 #T1s * #T2s #HT12s + elim (lift_total T1 d e) /3 width=2 by liftv_cons, ex_intro/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lifts.ma deleted file mode 100644 index 31b383145..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/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/notation/relations/rliftstar_3.ma". -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 by lifts_inv_nil_aux/ 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 by ex2_intro/ -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 by lifts_inv_cons_aux/ 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 by/ -] -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 by at_nil, ex2_intro/ -| #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 by at_lt, at_ge, ex2_intro/ -] -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 by/ -] -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 by ex3_2_intro, lifts_nil/ -| #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 by ex3_2_intro, lifts_cons/ -] -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 by ex3_2_intro, lifts_nil/ -| #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 by ex3_2_intro, lifts_cons/ -] -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 by lift_bind, lifts_cons/ -] -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 by lift_flat, lifts_cons/ -] -qed. - -lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2. -#des elim des -des /2 width=2 by lifts_nil, ex_intro/ -#d #e #des #IH #T1 elim (lift_total T1 d e) -#T #HT1 elim (IH T) -IH /3 width=4 by lifts_cons, ex_intro/ -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 deleted file mode 100644 index 9ec4d7e1f..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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 deleted file mode 100644 index bfe0d2529..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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 deleted file mode 100644 index e86d928d7..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/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/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 by liftsv_cons/ |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 by lifts_flat/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq.ma deleted file mode 100644 index 92dffd80f..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq.ma +++ /dev/null @@ -1,160 +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/notation/relations/lazyeq_4.ma". -include "basic_2/substitution/llpx_sn.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -definition ceq: relation3 lenv term term ≝ λL,T1,T2. T1 = T2. - -definition lleq: relation4 ynat term lenv lenv ≝ llpx_sn ceq. - -interpretation - "lazy equivalence (local environment)" - 'LazyEq T d L1 L2 = (lleq d T L1 L2). - -definition lleq_transitive: predicate (relation3 lenv term term) ≝ - λR. ∀L2,T1,T2. R L2 T1 T2 → ∀L1. L1 ≡[T1, 0] L2 → R L1 T1 T2. - -(* Basic inversion lemmas ***************************************************) - -lemma lleq_ind: ∀R:relation4 ynat term lenv lenv. ( - ∀L1,L2,d,k. |L1| = |L2| → R d (⋆k) L1 L2 - ) → ( - ∀L1,L2,d,i. |L1| = |L2| → yinj i < d → R d (#i) L1 L2 - ) → ( - ∀I,L1,L2,K1,K2,V,d,i. d ≤ yinj i → - ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → - K1 ≡[V, yinj O] K2 → R (yinj O) V K1 K2 → R d (#i) L1 L2 - ) → ( - ∀L1,L2,d,i. |L1| = |L2| → |L1| ≤ i → |L2| ≤ i → R d (#i) L1 L2 - ) → ( - ∀L1,L2,d,p. |L1| = |L2| → R d (§p) L1 L2 - ) → ( - ∀a,I,L1,L2,V,T,d. - L1 ≡[V, d]L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → - R d V L1 L2 → R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → R d (ⓑ{a,I}V.T) L1 L2 - ) → ( - ∀I,L1,L2,V,T,d. - L1 ≡[V, d]L2 → L1 ≡[T, d] L2 → - R d V L1 L2 → R d T L1 L2 → R d (ⓕ{I}V.T) L1 L2 - ) → - ∀d,T,L1,L2. L1 ≡[T, d] L2 → R d T L1 L2. -#R #H1 #H2 #H3 #H4 #H5 #H6 #H7 #d #T #L1 #L2 #H elim H -L1 -L2 -T -d /2 width=8 by/ -qed-. - -lemma lleq_inv_bind: ∀a,I,L1,L2,V,T,d. L1 ≡[ⓑ{a,I}V.T, d] L2 → - L1 ≡[V, d] L2 ∧ L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V. -/2 width=2 by llpx_sn_inv_bind/ qed-. - -lemma lleq_inv_flat: ∀I,L1,L2,V,T,d. L1 ≡[ⓕ{I}V.T, d] L2 → - L1 ≡[V, d] L2 ∧ L1 ≡[T, d] L2. -/2 width=2 by llpx_sn_inv_flat/ qed-. - -(* Basic forward lemmas *****************************************************) - -lemma lleq_fwd_length: ∀L1,L2,T,d. L1 ≡[T, d] L2 → |L1| = |L2|. -/2 width=4 by llpx_sn_fwd_length/ qed-. - -lemma lleq_fwd_lref: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → - ∨∨ |L1| ≤ i ∧ |L2| ≤ i - | yinj i < d - | ∃∃I,K1,K2,V. ⇩[i] L1 ≡ K1.ⓑ{I}V & - ⇩[i] L2 ≡ K2.ⓑ{I}V & - K1 ≡[V, yinj 0] K2 & d ≤ yinj i. -#L1 #L2 #d #i #H elim (llpx_sn_fwd_lref … H) /2 width=1/ -* /3 width=7 by or3_intro2, ex4_4_intro/ -qed-. - -lemma lleq_fwd_ldrop_sn: ∀L1,L2,T,d. L1 ≡[d, T] L2 → ∀K1,i. ⇩[i] L1 ≡ K1 → - ∃K2. ⇩[i] L2 ≡ K2. -/2 width=7 by llpx_sn_fwd_ldrop_sn/ qed-. - -lemma lleq_fwd_ldrop_dx: ∀L1,L2,T,d. L1 ≡[d, T] L2 → ∀K2,i. ⇩[i] L2 ≡ K2 → - ∃K1. ⇩[i] L1 ≡ K1. -/2 width=7 by llpx_sn_fwd_ldrop_dx/ qed-. - -lemma lleq_fwd_bind_sn: ∀a,I,L1,L2,V,T,d. - L1 ≡[ⓑ{a,I}V.T, d] L2 → L1 ≡[V, d] L2. -/2 width=4 by llpx_sn_fwd_bind_sn/ qed-. - -lemma lleq_fwd_bind_dx: ∀a,I,L1,L2,V,T,d. - L1 ≡[ⓑ{a,I}V.T, d] L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V. -/2 width=2 by llpx_sn_fwd_bind_dx/ qed-. - -lemma lleq_fwd_flat_sn: ∀I,L1,L2,V,T,d. - L1 ≡[ⓕ{I}V.T, d] L2 → L1 ≡[V, d] L2. -/2 width=3 by llpx_sn_fwd_flat_sn/ qed-. - -lemma lleq_fwd_flat_dx: ∀I,L1,L2,V,T,d. - L1 ≡[ⓕ{I}V.T, d] L2 → L1 ≡[T, d] L2. -/2 width=3 by llpx_sn_fwd_flat_dx/ qed-. - -(* Basic properties *********************************************************) - -lemma lleq_sort: ∀L1,L2,d,k. |L1| = |L2| → L1 ≡[⋆k, d] L2. -/2 width=1 by llpx_sn_sort/ qed. - -lemma lleq_skip: ∀L1,L2,d,i. yinj i < d → |L1| = |L2| → L1 ≡[#i, d] L2. -/2 width=1 by llpx_sn_skip/ qed. - -lemma lleq_lref: ∀I,L1,L2,K1,K2,V,d,i. d ≤ yinj i → - ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → - K1 ≡[V, 0] K2 → L1 ≡[#i, d] L2. -/2 width=9 by llpx_sn_lref/ qed. - -lemma lleq_free: ∀L1,L2,d,i. |L1| ≤ i → |L2| ≤ i → |L1| = |L2| → L1 ≡[#i, d] L2. -/2 width=1 by llpx_sn_free/ qed. - -lemma lleq_gref: ∀L1,L2,d,p. |L1| = |L2| → L1 ≡[§p, d] L2. -/2 width=1 by llpx_sn_gref/ qed. - -lemma lleq_bind: ∀a,I,L1,L2,V,T,d. - L1 ≡[V, d] L2 → L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → - L1 ≡[ⓑ{a,I}V.T, d] L2. -/2 width=1 by llpx_sn_bind/ qed. - -lemma lleq_flat: ∀I,L1,L2,V,T,d. - L1 ≡[V, d] L2 → L1 ≡[T, d] L2 → L1 ≡[ⓕ{I}V.T, d] L2. -/2 width=1 by llpx_sn_flat/ qed. - -lemma lleq_refl: ∀d,T. reflexive … (lleq d T). -/2 width=1 by llpx_sn_refl/ qed. - -lemma lleq_Y: ∀L1,L2,T. |L1| = |L2| → L1 ≡[T, ∞] L2. -/2 width=1 by llpx_sn_Y/ qed. - -lemma lleq_sym: ∀d,T. symmetric … (lleq d T). -#d #T #L1 #L2 #H @(lleq_ind … H) -d -T -L1 -L2 -/2 width=7 by lleq_sort, lleq_skip, lleq_lref, lleq_free, lleq_gref, lleq_bind, lleq_flat/ -qed-. - -lemma lleq_ge_up: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → - ∀T,d,e. ⇧[d, e] T ≡ U → - dt ≤ d + e → L1 ≡[U, d] L2. -/2 width=6 by llpx_sn_ge_up/ qed-. - -lemma lleq_ge: ∀L1,L2,T,d1. L1 ≡[T, d1] L2 → ∀d2. d1 ≤ d2 → L1 ≡[T, d2] L2. -/2 width=3 by llpx_sn_ge/ qed-. - -lemma lleq_bind_O: ∀a,I,L1,L2,V,T. L1 ≡[V, 0] L2 → L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → - L1 ≡[ⓑ{a,I}V.T, 0] L2. -/2 width=1 by llpx_sn_bind_O/ qed-. - -(* Advancded properties on lazy pointwise exyensions ************************) - -lemma llpx_sn_lrefl: ∀R. (∀L. reflexive … (R L)) → - ∀L1,L2,T,d. L1 ≡[T, d] L2 → llpx_sn R d T L1 L2. -/2 width=3 by llpx_sn_co/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt.ma deleted file mode 100644 index a05a51d26..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt.ma +++ /dev/null @@ -1,41 +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/llpx_sn_alt.ma". -include "basic_2/substitution/lleq.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Alternative definition (not recursive) ***********************************) - -theorem lleq_intro_alt: ∀L1,L2,T,d. |L1| = |L2| → - (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ V1 = V2 - ) → L1 ≡[T, d] L2. -#L1 #L2 #T #d #HL12 #IH @llpx_sn_alt_inv_llpx_sn @conj // -HL12 -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 -@(IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 // -qed. - -theorem lleq_inv_alt: ∀L1,L2,T,d. L1 ≡[T, d] L2 → - |L1| = |L2| ∧ - ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ V1 = V2. -#L1 #L2 #T #d #H elim (llpx_sn_llpx_sn_alt … H) -H -#HL12 #IH @conj // -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 -@(IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 // -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt_rec.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt_rec.ma deleted file mode 100644 index 258e6e9a9..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_alt_rec.ma +++ /dev/null @@ -1,54 +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/llpx_sn_alt_rec.ma". -include "basic_2/substitution/lleq.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Alternative definition (recursive) ***************************************) - -theorem lleq_intro_alt_r: ∀L1,L2,T,d. |L1| = |L2| → - (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2 - ) → L1 ≡[T, d] L2. -#L1 #L2 #T #d #HL12 #IH @llpx_sn_intro_alt_r // -HL12 -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 -elim (IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 /2 width=1 by and3_intro/ -qed. - -theorem lleq_ind_alt_r: ∀S:relation4 ynat term lenv lenv. - (∀L1,L2,T,d. |L1| = |L2| → ( - ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2 & S 0 V1 K1 K2 - ) → S d T L1 L2) → - ∀L1,L2,T,d. L1 ≡[T, d] L2 → S d T L1 L2. -#S #IH1 #L1 #L2 #T #d #H @(llpx_sn_ind_alt_r … H) -L1 -L2 -T -d -#L1 #L2 #T #d #HL12 #IH2 @IH1 -IH1 // -HL12 -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 -elim (IH2 … HnT HLK1 HLK2) -IH2 -HnT -HLK1 -HLK2 /2 width=1 by and4_intro/ -qed-. - -theorem lleq_inv_alt_r: ∀L1,L2,T,d. L1 ≡[T, d] L2 → - |L1| = |L2| ∧ - ∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → (∀U. ⇧[i, 1] U ≡ T → ⊥) → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - ∧∧ I1 = I2 & V1 = V2 & K1 ≡[V1, 0] K2. -#L1 #L2 #T #d #H elim (llpx_sn_inv_alt_r … H) -H -#HL12 #IH @conj // -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hid #HnT #HLK1 #HLK2 -elim (IH … HnT HLK1 HLK2) -IH -HnT -HLK1 -HLK2 /2 width=1 by and3_intro/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_fqus.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_fqus.ma deleted file mode 100644 index c54215e60..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_fqus.ma +++ /dev/null @@ -1,75 +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/fqus_alt.ma". -include "basic_2/substitution/lleq_ldrop.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Properties on supclosure *************************************************) - -lemma lleq_fqu_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐ ⦃G2, K2, U⦄ → - ∀L1. L1 ≡[T, 0] L2 → - ∃∃K1. ⦃G1, L1, T⦄ ⊐ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. -#G1 #G2 #L2 #K2 #T #U #H elim H -G1 -G2 -L2 -K2 -T -U -[ #I #G #L2 #V #L1 #H elim (lleq_inv_lref_ge_dx … H … I L2 V) -H // - #K1 #H1 #H2 lapply (ldrop_inv_O2 … H1) -H1 - #H destruct /2 width=3 by fqu_lref_O, ex2_intro/ -| * [ #a ] #I #G #L2 #V #T #L1 #H - [ elim (lleq_inv_bind … H) - | elim (lleq_inv_flat … H) - ] -H - /2 width=3 by fqu_pair_sn, ex2_intro/ -| #a #I #G #L2 #V #T #L1 #H elim (lleq_inv_bind_O … H) -H - #H3 #H4 /2 width=3 by fqu_bind_dx, ex2_intro/ -| #I #G #L2 #V #T #L1 #H elim (lleq_inv_flat … H) -H - /2 width=3 by fqu_flat_dx, ex2_intro/ -| #G #L2 #K2 #T #U #e #HLK2 #HTU #L1 #HL12 - elim (ldrop_O1_le (Ⓕ) (e+1) L1) - [ /3 width=12 by fqu_drop, lleq_inv_lift_le, ex2_intro/ - | lapply (ldrop_fwd_length_le2 … HLK2) -K2 - lapply (lleq_fwd_length … HL12) -T -U // - ] -] -qed-. - -lemma lleq_fquq_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐⸮ ⦃G2, K2, U⦄ → - ∀L1. L1 ≡[T, 0] L2 → - ∃∃K1. ⦃G1, L1, T⦄ ⊐⸮ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. -#G1 #G2 #L2 #K2 #T #U #H #L1 #HL12 elim(fquq_inv_gen … H) -H -[ #H elim (lleq_fqu_trans … H … HL12) -L2 /3 width=3 by fqu_fquq, ex2_intro/ -| * #HG #HL #HT destruct /2 width=3 by ex2_intro/ -] -qed-. - -lemma lleq_fqup_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐+ ⦃G2, K2, U⦄ → - ∀L1. L1 ≡[T, 0] L2 → - ∃∃K1. ⦃G1, L1, T⦄ ⊐+ ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. -#G1 #G2 #L2 #K2 #T #U #H @(fqup_ind … H) -G2 -K2 -U -[ #G2 #K2 #U #HTU #L1 #HL12 elim (lleq_fqu_trans … HTU … HL12) -L2 - /3 width=3 by fqu_fqup, ex2_intro/ -| #G #G2 #K #K2 #U #U2 #_ #HU2 #IHTU #L1 #HL12 elim (IHTU … HL12) -L2 - #K1 #HTU #HK1 elim (lleq_fqu_trans … HU2 … HK1) -K - /3 width=5 by fqup_strap1, ex2_intro/ -] -qed-. - -lemma lleq_fqus_trans: ∀G1,G2,L2,K2,T,U. ⦃G1, L2, T⦄ ⊐* ⦃G2, K2, U⦄ → - ∀L1. L1 ≡[T, 0] L2 → - ∃∃K1. ⦃G1, L1, T⦄ ⊐* ⦃G2, K1, U⦄ & K1 ≡[U, 0] K2. -#G1 #G2 #L2 #K2 #T #U #H #L1 #HL12 elim(fqus_inv_gen … H) -H -[ #H elim (lleq_fqup_trans … H … HL12) -L2 /3 width=3 by fqup_fqus, ex2_intro/ -| * #HG #HL #HT destruct /2 width=3 by ex2_intro/ -] -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_ldrop.ma deleted file mode 100644 index cc527074c..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_ldrop.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/llpx_sn_ldrop.ma". -include "basic_2/substitution/lleq.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Advanced properties ******************************************************) - -lemma lleq_bind_repl_O: ∀I,L1,L2,V,T. L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → - ∀J,W. L1 ≡[W, 0] L2 → L1.ⓑ{J}W ≡[T, 0] L2.ⓑ{J}W. -/2 width=7 by llpx_sn_bind_repl_O/ qed-. - -lemma lleq_dec: ∀T,L1,L2,d. Decidable (L1 ≡[T, d] L2). -/3 width=1 by llpx_sn_dec, eq_term_dec/ qed-. - -lemma lleq_llpx_sn_trans: ∀R. lleq_transitive R → - ∀L1,L2,T,d. L1 ≡[T, d] L2 → - ∀L. llpx_sn R d T L2 L → llpx_sn R d T L1 L. -#R #HR #L1 #L2 #T #d #H @(lleq_ind … H) -L1 -L2 -T -d -[1,2,5: /4 width=6 by llpx_sn_fwd_length, llpx_sn_gref, llpx_sn_skip, llpx_sn_sort, trans_eq/ -|4: /4 width=6 by llpx_sn_fwd_length, llpx_sn_free, le_repl_sn_conf_aux, trans_eq/ -| #I #L1 #L2 #K1 #K2 #V #d #i #Hdi #HLK1 #HLK2 #HK12 #IHK12 #L #H elim (llpx_sn_inv_lref_ge_sn … H … HLK2) -H -HLK2 - /3 width=11 by llpx_sn_lref/ -| #a #I #L1 #L2 #V #T #d #_ #_ #IHV #IHT #L #H elim (llpx_sn_inv_bind … H) -H - /3 width=1 by llpx_sn_bind/ -| #I #L1 #L2 #V #T #d #_ #_ #IHV #IHT #L #H elim (llpx_sn_inv_flat … H) -H - /3 width=1 by llpx_sn_flat/ -] -qed-. - -lemma lleq_llpx_sn_conf: ∀R. lleq_transitive R → - ∀L1,L2,T,d. L1 ≡[T, d] L2 → - ∀L. llpx_sn R d T L1 L → llpx_sn R d T L2 L. -/3 width=3 by lleq_llpx_sn_trans, lleq_sym/ qed-. - -(* Advanced inversion lemmas ************************************************) - -lemma lleq_inv_lref_ge_dx: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → - ∀I,K2,V. ⇩[i] L2 ≡ K2.ⓑ{I}V → - ∃∃K1. ⇩[i] L1 ≡ K1.ⓑ{I}V & K1 ≡[V, 0] K2. -#L1 #L2 #d #i #H #Hdi #I #K2 #V #HLK2 elim (llpx_sn_inv_lref_ge_dx … H … HLK2) -L2 -/2 width=3 by ex2_intro/ -qed-. - -lemma lleq_inv_lref_ge_sn: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → - ∀I,K1,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → - ∃∃K2. ⇩[i] L2 ≡ K2.ⓑ{I}V & K1 ≡[V, 0] K2. -#L1 #L2 #d #i #H #Hdi #I1 #K1 #V #HLK1 elim (llpx_sn_inv_lref_ge_sn … H … HLK1) -L1 -/2 width=3 by ex2_intro/ -qed-. - -lemma lleq_inv_lref_ge_bi: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → - ∀I1,I2,K1,K2,V1,V2. - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - ∧∧ I1 = I2 & K1 ≡[V1, 0] K2 & V1 = V2. -/2 width=8 by llpx_sn_inv_lref_ge_bi/ qed-. - -lemma lleq_inv_lref_ge: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → d ≤ i → - ∀I,K1,K2,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → ⇩[i] L2 ≡ K2.ⓑ{I}V → - K1 ≡[V, 0] K2. -#L1 #L2 #d #i #HL12 #Hdi #I #K1 #K2 #V #HLK1 #HLK2 -elim (lleq_inv_lref_ge_bi … HL12 … HLK1 HLK2) // -qed-. - -lemma lleq_inv_S: ∀L1,L2,T,d. L1 ≡[T, d+1] L2 → - ∀I,K1,K2,V. ⇩[d] L1 ≡ K1.ⓑ{I}V → ⇩[d] L2 ≡ K2.ⓑ{I}V → - K1 ≡[V, 0] K2 → L1 ≡[T, d] L2. -/2 width=9 by llpx_sn_inv_S/ qed-. - -lemma lleq_inv_bind_O: ∀a,I,L1,L2,V,T. L1 ≡[ⓑ{a,I}V.T, 0] L2 → - L1 ≡[V, 0] L2 ∧ L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V. -/2 width=2 by llpx_sn_inv_bind_O/ qed-. - -(* Advanced forward lemmas **************************************************) - -lemma lleq_fwd_lref_dx: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → - ∀I,K2,V. ⇩[i] L2 ≡ K2.ⓑ{I}V → - i < d ∨ - ∃∃K1. ⇩[i] L1 ≡ K1.ⓑ{I}V & K1 ≡[V, 0] K2 & d ≤ i. -#L1 #L2 #d #i #H #I #K2 #V #HLK2 elim (llpx_sn_fwd_lref_dx … H … HLK2) -L2 -[ | * ] /3 width=3 by ex3_intro, or_intror, or_introl/ -qed-. - -lemma lleq_fwd_lref_sn: ∀L1,L2,d,i. L1 ≡[#i, d] L2 → - ∀I,K1,V. ⇩[i] L1 ≡ K1.ⓑ{I}V → - i < d ∨ - ∃∃K2. ⇩[i] L2 ≡ K2.ⓑ{I}V & K1 ≡[V, 0] K2 & d ≤ i. -#L1 #L2 #d #i #H #I #K1 #V #HLK1 elim (llpx_sn_fwd_lref_sn … H … HLK1) -L1 -[ | * ] /3 width=3 by ex3_intro, or_intror, or_introl/ -qed-. - -lemma lleq_fwd_bind_O_dx: ∀a,I,L1,L2,V,T. L1 ≡[ⓑ{a,I}V.T, 0] L2 → - L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V. -/2 width=2 by llpx_sn_fwd_bind_O_dx/ qed-. - -(* Properties on relocation *************************************************) - -lemma lleq_lift_le: ∀K1,K2,T,dt. K1 ≡[T, dt] K2 → - ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀U. ⇧[d, e] T ≡ U → dt ≤ d → L1 ≡[U, dt] L2. -/3 width=10 by llpx_sn_lift_le, lift_mono/ qed-. - -lemma lleq_lift_ge: ∀K1,K2,T,dt. K1 ≡[T, dt] K2 → - ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀U. ⇧[d, e] T ≡ U → d ≤ dt → L1 ≡[U, dt+e] L2. -/2 width=9 by llpx_sn_lift_ge/ qed-. - -(* Inversion lemmas on relocation *******************************************) - -lemma lleq_inv_lift_le: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → dt ≤ d → K1 ≡[T, dt] K2. -/3 width=10 by llpx_sn_inv_lift_le, ex2_intro/ qed-. - -lemma lleq_inv_lift_be: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → d ≤ dt → dt ≤ yinj d + e → K1 ≡[T, d] K2. -/2 width=11 by llpx_sn_inv_lift_be/ qed-. - -lemma lleq_inv_lift_ge: ∀L1,L2,U,dt. L1 ≡[U, dt] L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → yinj d + e ≤ dt → K1 ≡[T, dt-e] K2. -/2 width=9 by llpx_sn_inv_lift_ge/ qed-. - -(* Inversion lemmas on negated lazy quivalence for local environments *******) - -lemma nlleq_inv_bind: ∀a,I,L1,L2,V,T,d. (L1 ≡[ⓑ{a,I}V.T, d] L2 → ⊥) → - (L1 ≡[V, d] L2 → ⊥) ∨ (L1.ⓑ{I}V ≡[T, ⫯d] L2.ⓑ{I}V → ⊥). -/3 width=2 by nllpx_sn_inv_bind, eq_term_dec/ qed-. - -lemma nlleq_inv_flat: ∀I,L1,L2,V,T,d. (L1 ≡[ⓕ{I}V.T, d] L2 → ⊥) → - (L1 ≡[V, d] L2 → ⊥) ∨ (L1 ≡[T, d] L2 → ⊥). -/3 width=2 by nllpx_sn_inv_flat, eq_term_dec/ qed-. - -lemma nlleq_inv_bind_O: ∀a,I,L1,L2,V,T. (L1 ≡[ⓑ{a,I}V.T, 0] L2 → ⊥) → - (L1 ≡[V, 0] L2 → ⊥) ∨ (L1.ⓑ{I}V ≡[T, 0] L2.ⓑ{I}V → ⊥). -/3 width=2 by nllpx_sn_inv_bind_O, eq_term_dec/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_leq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_leq.ma deleted file mode 100644 index bef6eeb7f..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_leq.ma +++ /dev/null @@ -1,36 +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/llpx_sn_leq.ma". -include "basic_2/substitution/lleq.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Properties on equivalence for local environments *************************) - -lemma leq_lleq_trans: ∀L2,L,T,d. L2 ≡[T, d] L → - ∀L1. L1 ≃[d, ∞] L2 → L1 ≡[T, d] L. -/2 width=3 by leq_llpx_sn_trans/ qed-. - -lemma lleq_leq_trans: ∀L,L1,T,d. L ≡[T, d] L1 → - ∀L2. L1 ≃[d, ∞] L2 → L ≡[T, d] L2. -/2 width=3 by llpx_sn_leq_trans/ qed-. - -lemma lleq_leq_repl: ∀L1,L2,T,d. L1 ≡[T, d] L2 → ∀K1. K1 ≃[d, ∞] L1 → - ∀K2. L2 ≃[d, ∞] K2 → K1 ≡[T, d] K2. -/2 width=5 by llpx_sn_leq_repl/ qed-. - -lemma lleq_bind_repl_SO: ∀I1,I2,L1,L2,V1,V2,T. L1.ⓑ{I1}V1 ≡[T, 0] L2.ⓑ{I2}V2 → - ∀J1,J2,W1,W2. L1.ⓑ{J1}W1 ≡[T, 1] L2.ⓑ{J2}W2. -/2 width=5 by llpx_sn_bind_repl_SO/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_lleq.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_lleq.ma deleted file mode 100644 index abee448a3..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_lleq.ma +++ /dev/null @@ -1,32 +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/lleq_ldrop.ma". - -(* Main properties **********************************************************) - -theorem lleq_trans: ∀d,T. Transitive … (lleq d T). -/2 width=3 by lleq_llpx_sn_trans/ qed-. - -theorem lleq_canc_sn: ∀L,L1,L2,T,d. L ≡[d, T] L1→ L ≡[d, T] L2 → L1 ≡[d, T] L2. -/3 width=3 by lleq_trans, lleq_sym/ qed-. - -theorem lleq_canc_dx: ∀L1,L2,L,T,d. L1 ≡[d, T] L → L2 ≡[d, T] L → L1 ≡[d, T] L2. -/3 width=3 by lleq_trans, lleq_sym/ qed-. - -(* Note: lleq_nlleq_trans: ∀d,T,L1,L. L1≡[T, d] L → - ∀L2. (L ≡[T, d] L2 → ⊥) → (L1 ≡[T, d] L2 → ⊥). -/3 width=3 by lleq_canc_sn/ qed-. -works with /4 width=8/ so lleq_canc_sn is more convenient -*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_llor.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_llor.ma deleted file mode 100644 index 8cbff4cd9..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/lleq_llor.ma +++ /dev/null @@ -1,34 +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/llor.ma". -include "basic_2/substitution/lleq_alt.ma". - -(* LAZY EQUIVALENCE FOR LOCAL ENVIRONMENTS **********************************) - -(* Properties on poinwise union for local environments **********************) - -lemma llpx_sn_llor_dx: ∀R,L1,L2. - (∀U,i. L2 ⊢ i ϵ 𝐅*[0]⦃U⦄ → L1 ⊢ i ϵ 𝐅*[0]⦃U⦄) → - ∀T. llpx_sn R 0 T L1 L2 → ∀L. L1 ⩖[T] L2 ≡ L → L2 ≡[T, 0] L. -#R #L1 #L2 #HR #T #H1 #L #H2 -elim (llpx_sn_llpx_sn_alt … H1) -H1 #HL12 #IH1 -elim H2 -H2 #_ #HL1 #IH2 -@lleq_intro_alt // #I2 #I #K2 #K #V2 #V #i #Hi #HnT #HLK2 #HLK -lapply (ldrop_fwd_length_lt2 … HLK) #HiL -elim (ldrop_O1_lt (Ⓕ) L1 i) // -HiL #I1 #K1 #V1 #HLK1 -elim (IH1 … HLK1 HLK2) -IH1 /2 width=1 by/ #H #_ destruct -elim (IH2 … HLK1 HLK2 HLK) -IH2 -HLK1 -HLK2 -HLK * /2 width=1 by conj/ #H -elim H -H /2 width=1 by/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llor.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llor.ma deleted file mode 100644 index 94dfeeb25..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llor.ma +++ /dev/null @@ -1,38 +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/notation/relations/lazyor_4.ma". -include "basic_2/substitution/frees.ma". - -(* POINTWISE UNION FOR LOCAL ENVIRONMENTS ***********************************) - -definition llor: relation4 term lenv lenv lenv ≝ λT,L2,L1,L. - ∧∧ |L1| ≤ |L2| & |L1| = |L| - & (∀I1,I2,I,K1,K2,K,V1,V2,V,i. - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → ⇩[i] L ≡ K.ⓑ{I}V → - (∧∧ (L1 ⊢ i ϵ 𝐅*[yinj 0]⦃T⦄ → ⊥) & I1 = I & V1 = V) ∨ - (∧∧ L1 ⊢ i ϵ 𝐅*[yinj 0]⦃T⦄ & I1 = I & V2 = V) - ). - -interpretation - "lazy union (local environment)" - 'LazyOr L1 T L2 L = (llor T L2 L1 L). - -(* Basic properties *********************************************************) - -lemma llor_atom: ∀T,L2. ⋆ ⩖[T] L2 ≡ ⋆. -#T #L2 @and3_intro // -#I1 #I2 #I #K1 #K2 #K #V1 #V2 #V #i #HLK1 -elim (ldrop_inv_atom1 … HLK1) -HLK1 #H destruct -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llor_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llor_ldrop.ma deleted file mode 100644 index 07f88b0f4..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llor_ldrop.ma +++ /dev/null @@ -1,22 +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/frees_lift.ma". -include "basic_2/substitution/llor.ma". - -(* POINTWISE UNION FOR LOCAL ENVIRONMENTS ***********************************) - -(* Advanced properties ******************************************************) - -axiom llor_total: ∀L1,L2,T. |L1| ≤ |L2| → ∃L. L1 ⩖[T] L2 ≡ L. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn.ma deleted file mode 100644 index 4c4fd5edb..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn.ma +++ /dev/null @@ -1,209 +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 "ground_2/ynat/ynat_plus.ma". -include "basic_2/relocation/ldrop.ma". - -(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) - -inductive llpx_sn (R:relation3 lenv term term): relation4 ynat term lenv lenv ≝ -| llpx_sn_sort: ∀L1,L2,d,k. |L1| = |L2| → llpx_sn R d (⋆k) L1 L2 -| llpx_sn_skip: ∀L1,L2,d,i. |L1| = |L2| → yinj i < d → llpx_sn R d (#i) L1 L2 -| llpx_sn_lref: ∀I,L1,L2,K1,K2,V1,V2,d,i. d ≤ yinj i → - ⇩[i] L1 ≡ K1.ⓑ{I}V1 → ⇩[i] L2 ≡ K2.ⓑ{I}V2 → - llpx_sn R (yinj 0) V1 K1 K2 → R K1 V1 V2 → llpx_sn R d (#i) L1 L2 -| llpx_sn_free: ∀L1,L2,d,i. |L1| ≤ i → |L2| ≤ i → |L1| = |L2| → llpx_sn R d (#i) L1 L2 -| llpx_sn_gref: ∀L1,L2,d,p. |L1| = |L2| → llpx_sn R d (§p) L1 L2 -| llpx_sn_bind: ∀a,I,L1,L2,V,T,d. - llpx_sn R d V L1 L2 → llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → - llpx_sn R d (ⓑ{a,I}V.T) L1 L2 -| llpx_sn_flat: ∀I,L1,L2,V,T,d. - llpx_sn R d V L1 L2 → llpx_sn R d T L1 L2 → llpx_sn R d (ⓕ{I}V.T) L1 L2 -. - -(* Basic inversion lemmas ***************************************************) - -fact llpx_sn_inv_bind_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → - ∀a,I,V,T. X = ⓑ{a,I}V.T → - llpx_sn R d V L1 L2 ∧ llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). -#R #L1 #L2 #X #d * -L1 -L2 -X -d -[ #L1 #L2 #d #k #_ #b #J #W #U #H destruct -| #L1 #L2 #d #i #_ #_ #b #J #W #U #H destruct -| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #_ #_ #_ #_ #b #J #W #U #H destruct -| #L1 #L2 #d #i #_ #_ #_ #b #J #W #U #H destruct -| #L1 #L2 #d #p #_ #b #J #W #U #H destruct -| #a #I #L1 #L2 #V #T #d #HV #HT #b #J #W #U #H destruct /2 width=1 by conj/ -| #I #L1 #L2 #V #T #d #_ #_ #b #J #W #U #H destruct -] -qed-. - -lemma llpx_sn_inv_bind: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → - llpx_sn R d V L1 L2 ∧ llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). -/2 width=4 by llpx_sn_inv_bind_aux/ qed-. - -fact llpx_sn_inv_flat_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → - ∀I,V,T. X = ⓕ{I}V.T → - llpx_sn R d V L1 L2 ∧ llpx_sn R d T L1 L2. -#R #L1 #L2 #X #d * -L1 -L2 -X -d -[ #L1 #L2 #d #k #_ #J #W #U #H destruct -| #L1 #L2 #d #i #_ #_ #J #W #U #H destruct -| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #_ #_ #_ #_ #J #W #U #H destruct -| #L1 #L2 #d #i #_ #_ #_ #J #W #U #H destruct -| #L1 #L2 #d #p #_ #J #W #U #H destruct -| #a #I #L1 #L2 #V #T #d #_ #_ #J #W #U #H destruct -| #I #L1 #L2 #V #T #d #HV #HT #J #W #U #H destruct /2 width=1 by conj/ -] -qed-. - -lemma llpx_sn_inv_flat: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → - llpx_sn R d V L1 L2 ∧ llpx_sn R d T L1 L2. -/2 width=4 by llpx_sn_inv_flat_aux/ qed-. - -(* Basic forward lemmas *****************************************************) - -lemma llpx_sn_fwd_length: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → |L1| = |L2|. -#R #L1 #L2 #T #d #H elim H -L1 -L2 -T -d // -#I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #_ #HLK1 #HLK2 #_ #_ #HK12 -lapply (ldrop_fwd_length … HLK1) -HLK1 -lapply (ldrop_fwd_length … HLK2) -HLK2 -normalize // -qed-. - -lemma llpx_sn_fwd_ldrop_sn: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → - ∀K1,i. ⇩[i] L1 ≡ K1 → ∃K2. ⇩[i] L2 ≡ K2. -#R #L1 #L2 #T #d #H #K1 #i #HLK1 lapply (llpx_sn_fwd_length … H) -H -#HL12 lapply (ldrop_fwd_length_le2 … HLK1) -HLK1 /2 width=1 by ldrop_O1_le/ -qed-. - -lemma llpx_sn_fwd_ldrop_dx: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → - ∀K2,i. ⇩[i] L2 ≡ K2 → ∃K1. ⇩[i] L1 ≡ K1. -#R #L1 #L2 #T #d #H #K2 #i #HLK2 lapply (llpx_sn_fwd_length … H) -H -#HL12 lapply (ldrop_fwd_length_le2 … HLK2) -HLK2 /2 width=1 by ldrop_O1_le/ -qed-. - -fact llpx_sn_fwd_lref_aux: ∀R,L1,L2,X,d. llpx_sn R d X L1 L2 → ∀i. X = #i → - ∨∨ |L1| ≤ i ∧ |L2| ≤ i - | yinj i < d - | ∃∃I,K1,K2,V1,V2. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & - ⇩[i] L2 ≡ K2.ⓑ{I}V2 & - llpx_sn R (yinj 0) V1 K1 K2 & - R K1 V1 V2 & d ≤ yinj i. -#R #L1 #L2 #X #d * -L1 -L2 -X -d -[ #L1 #L2 #d #k #_ #j #H destruct -| #L1 #L2 #d #i #_ #Hid #j #H destruct /2 width=1 by or3_intro1/ -| #I #L1 #L2 #K1 #K2 #V1 #V2 #d #i #Hdi #HLK1 #HLK2 #HK12 #HV12 #j #H destruct - /3 width=9 by or3_intro2, ex5_5_intro/ -| #L1 #L2 #d #i #HL1 #HL2 #_ #j #H destruct /3 width=1 by or3_intro0, conj/ -| #L1 #L2 #d #p #_ #j #H destruct -| #a #I #L1 #L2 #V #T #d #_ #_ #j #H destruct -| #I #L1 #L2 #V #T #d #_ #_ #j #H destruct -] -qed-. - -lemma llpx_sn_fwd_lref: ∀R,L1,L2,d,i. llpx_sn R d (#i) L1 L2 → - ∨∨ |L1| ≤ i ∧ |L2| ≤ i - | yinj i < d - | ∃∃I,K1,K2,V1,V2. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & - ⇩[i] L2 ≡ K2.ⓑ{I}V2 & - llpx_sn R (yinj 0) V1 K1 K2 & - R K1 V1 V2 & d ≤ yinj i. -/2 width=3 by llpx_sn_fwd_lref_aux/ qed-. - -lemma llpx_sn_fwd_bind_sn: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → - llpx_sn R d V L1 L2. -#R #a #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_bind … H) -H // -qed-. - -lemma llpx_sn_fwd_bind_dx: ∀R,a,I,L1,L2,V,T,d. llpx_sn R d (ⓑ{a,I}V.T) L1 L2 → - llpx_sn R (⫯d) T (L1.ⓑ{I}V) (L2.ⓑ{I}V). -#R #a #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_bind … H) -H // -qed-. - -lemma llpx_sn_fwd_flat_sn: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → - llpx_sn R d V L1 L2. -#R #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_flat … H) -H // -qed-. - -lemma llpx_sn_fwd_flat_dx: ∀R,I,L1,L2,V,T,d. llpx_sn R d (ⓕ{I}V.T) L1 L2 → - llpx_sn R d T L1 L2. -#R #I #L1 #L2 #V #T #d #H elim (llpx_sn_inv_flat … H) -H // -qed-. - -lemma llpx_sn_fwd_pair_sn: ∀R,I,L1,L2,V,T,d. llpx_sn R d (②{I}V.T) L1 L2 → - llpx_sn R d V L1 L2. -#R * /2 width=4 by llpx_sn_fwd_flat_sn, llpx_sn_fwd_bind_sn/ -qed-. - -(* Basic_properties *********************************************************) - -lemma llpx_sn_refl: ∀R. (∀L. reflexive … (R L)) → ∀T,L,d. llpx_sn R d T L L. -#R #HR #T #L @(f2_ind … rfw … L T) -L -T -#n #IH #L * * /3 width=1 by llpx_sn_sort, llpx_sn_gref, llpx_sn_bind, llpx_sn_flat/ -#i #Hn elim (lt_or_ge i (|L|)) /2 width=1 by llpx_sn_free/ -#HiL #d elim (ylt_split i d) /2 width=1 by llpx_sn_skip/ -elim (ldrop_O1_lt … HiL) -HiL destruct /4 width=9 by llpx_sn_lref, ldrop_fwd_rfw/ -qed-. - -lemma llpx_sn_Y: ∀R,T,L1,L2. |L1| = |L2| → llpx_sn R (∞) T L1 L2. -#R #T #L1 @(f2_ind … rfw … L1 T) -L1 -T -#n #IH #L1 * * /3 width=1 by llpx_sn_sort, llpx_sn_skip, llpx_sn_gref, llpx_sn_flat/ -#a #I #V1 #T1 #Hn #L2 #HL12 -@llpx_sn_bind /2 width=1/ (**) (* explicit constructor *) -@IH -IH // normalize /2 width=1 by eq_f2/ -qed-. - -lemma llpx_sn_ge_up: ∀R,L1,L2,U,dt. llpx_sn R dt U L1 L2 → ∀T,d,e. ⇧[d, e] T ≡ U → - dt ≤ d + e → llpx_sn R d U L1 L2. -#R #L1 #L2 #U #dt #H elim H -L1 -L2 -U -dt -[ #L1 #L2 #dt #k #HL12 #X #d #e #H #_ >(lift_inv_sort2 … H) -H /2 width=1 by llpx_sn_sort/ -| #L1 #L2 #dt #i #HL12 #Hidt #X #d #e #H #Hdtde - elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=1 by llpx_sn_skip, ylt_inj/ -HL12 - elim (ylt_yle_false … Hidt) -Hidt - @(yle_trans … Hdtde) /2 width=1 by yle_inj/ (**) (* full auto too slow 11s *) -| #I #L1 #L2 #K1 #K2 #W1 #W2 #dt #i #Hdti #HLK1 #HLK2 #HW1 #HW12 #_ #X #d #e #H #_ - elim (lift_inv_lref2 … H) -H * #Hid #H destruct - [ lapply (llpx_sn_fwd_length … HW1) -HW1 #HK12 - lapply (ldrop_fwd_length … HLK1) lapply (ldrop_fwd_length … HLK2) - normalize in ⊢ (%→%→?); -I -W1 -W2 -dt /3 width=1 by llpx_sn_skip, ylt_inj/ - | /4 width=9 by llpx_sn_lref, yle_inj, le_plus_b/ - ] -| /2 width=1 by llpx_sn_free/ -| #L1 #L2 #dt #p #HL12 #X #d #e #H #_ >(lift_inv_gref2 … H) -H /2 width=1 by llpx_sn_gref/ -| #a #I #L1 #L2 #W #U #dt #_ #_ #IHV #IHT #X #d #e #H #Hdtde destruct - elim (lift_inv_bind2 … H) -H #V #T #HVW >commutative_plus #HTU #H destruct - @(llpx_sn_bind) /2 width=4 by/ (**) (* full auto fails *) - @(IHT … HTU) /2 width=1 by yle_succ/ -| #I #L1 #L2 #W #U #dt #_ #_ #IHV #IHT #X #d #e #H #Hdtde destruct - elim (lift_inv_flat2 … H) -H #HVW #HTU #H destruct - /3 width=4 by llpx_sn_flat/ -] -qed-. - -(**) (* the minor premise comes first *) -lemma llpx_sn_ge: ∀R,L1,L2,T,d1,d2. d1 ≤ d2 → - llpx_sn R d1 T L1 L2 → llpx_sn R d2 T L1 L2. -#R #L1 #L2 #T #d1 #d2 * -d1 -d2 (**) (* destructed yle *) -/3 width=6 by llpx_sn_ge_up, llpx_sn_Y, llpx_sn_fwd_length, yle_inj/ -qed-. - -lemma llpx_sn_bind_O: ∀R,a,I,L1,L2,V,T. llpx_sn R 0 V L1 L2 → - llpx_sn R 0 T (L1.ⓑ{I}V) (L2.ⓑ{I}V) → - llpx_sn R 0 (ⓑ{a,I}V.T) L1 L2. -/3 width=3 by llpx_sn_ge, llpx_sn_bind/ qed-. - -lemma llpx_sn_co: ∀R1,R2. (∀L,T1,T2. R1 L T1 T2 → R2 L T1 T2) → - ∀L1,L2,T,d. llpx_sn R1 d T L1 L2 → llpx_sn R2 d T L1 L2. -#R1 #R2 #HR12 #L1 #L2 #T #d #H elim H -L1 -L2 -T -d -/3 width=9 by llpx_sn_sort, llpx_sn_skip, llpx_sn_lref, llpx_sn_free, llpx_sn_gref, llpx_sn_bind, llpx_sn_flat/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_alt.ma deleted file mode 100644 index 23c48d45a..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_alt.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/substitution/frees.ma". -include "basic_2/substitution/llpx_sn_alt_rec.ma". - -(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) - -(* alternative definition of llpx_sn (not recursive) *) -definition llpx_sn_alt: relation3 lenv term term → relation4 ynat term lenv lenv ≝ - λR,d,T,L1,L2. |L1| = |L2| ∧ - (∀I1,I2,K1,K2,V1,V2,i. d ≤ yinj i → L1 ⊢ i ϵ 𝐅*[d]⦃T⦄ → - ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → - I1 = I2 ∧ R K1 V1 V2 - ). - -(* Main properties **********************************************************) - -theorem llpx_sn_llpx_sn_alt: ∀R,T,L1,L2,d. llpx_sn R d T L1 L2 → llpx_sn_alt R d T L1 L2. -#R #U #L1 @(f2_ind … rfw … L1 U) -L1 -U -#n #IHn #L1 #U #Hn #L2 #d #H elim (llpx_sn_inv_alt_r … H) -H -#HL12 #IHU @conj // -#I1 #I2 #K1 #K2 #V1 #V2 #i #Hdi #H #HLK1 #HLK2 elim (frees_inv … H) -H -[ -n #HnU elim (IHU … HnU HLK1 HLK2) -IHU -HnU -HLK1 -HLK2 /2 width=1 by conj/ -| * #J1 #K10 #W10 #j #Hdj #Hji #HnU #HLK10 #HnW10 destruct - lapply (ldrop_fwd_drop2 … HLK10) #H - lapply (ldrop_conf_ge … H … HLK1 ?) -H /2 width=1 by lt_to_le/ (minus_plus_m_m j (i+1)) in ⊢ (%→?); >commutative_plus (lift_inv_sort1 … H) -X - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d - /2 width=1 by llpx_sn_sort/ -| #K1 #K2 #d0 #i #HK12 #Hid0 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H - * #Hdi #H destruct - [ lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d - /2 width=1 by llpx_sn_skip/ - | elim (ylt_yle_false … Hid0) -L1 -L2 -K1 -K2 -e -Hid0 - /3 width=3 by yle_trans, yle_inj/ - ] -| #I #K1 #K2 #K11 #K22 #V1 #V2 #d0 #i #Hid0 #HK11 #HK22 #HK12 #HV12 #IHK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H - * #Hdi #H destruct [ -HK12 | -IHK12 ] - [ elim (ldrop_trans_lt … HLK1 … HK11) // -K1 - elim (ldrop_trans_lt … HLK2 … HK22) // -Hdi -K2 - /3 width=18 by llpx_sn_lref/ - | lapply (ldrop_trans_ge_comm … HLK1 … HK11 ?) // -K1 - lapply (ldrop_trans_ge_comm … HLK2 … HK22 ?) // -Hdi -Hd0 -K2 - /3 width=9 by llpx_sn_lref, yle_plus_dx1_trans/ - ] -| #K1 #K2 #d0 #i #HK1 #HK2 #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H - * #Hid #H destruct - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -HK12 - [ /3 width=7 by llpx_sn_free, ldrop_fwd_be/ - | lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1 - lapply (ldrop_fwd_length … HLK2) -HLK2 #HLK2 - @llpx_sn_free [ >HLK1 | >HLK2 ] -Hid -HLK1 -HLK2 /2 width=1 by monotonic_le_plus_r/ (**) (* explicit constructor *) - ] -| #K1 #K2 #d0 #p #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref1 … H) -X - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d -e - /2 width=1 by llpx_sn_gref/ -| #a #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind1 … H) -H - #W #U #HVW #HTU #H destruct /4 width=6 by llpx_sn_bind, ldrop_skip, yle_succ/ -| #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat1 … H) -H - #W #U #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ -] -qed-. - -lemma llpx_sn_lift_ge: ∀R,K1,K2,T,d0. llpx_sn R d0 T K1 K2 → - ∀L1,L2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀U. ⇧[d, e] T ≡ U → d ≤ d0 → llpx_sn R (d0+e) U L1 L2. -#R #K1 #K2 #T #d0 #H elim H -K1 -K2 -T -d0 -[ #K1 #K2 #d0 #k #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort1 … H) -X - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d - /2 width=1 by llpx_sn_sort/ -| #K1 #K2 #d0 #i #HK12 #Hid0 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ elim (lift_inv_lref1 … H) -H - * #_ #H destruct - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 - [ /3 width=3 by llpx_sn_skip, ylt_plus_dx2_trans/ - | /3 width=3 by llpx_sn_skip, monotonic_ylt_plus_dx/ - ] -| #I #K1 #K2 #K11 #K22 #V1 #V2 #d0 #i #Hid0 #HK11 #HK22 #HK12 #HV12 #_ #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H - * #Hid #H destruct - [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K1 -K2 -K11 -K22 -V1 -V2 -e -Hid0 - /3 width=3 by ylt_yle_trans, ylt_inj/ - | lapply (ldrop_trans_ge_comm … HLK1 … HK11 ?) // -K1 - lapply (ldrop_trans_ge_comm … HLK2 … HK22 ?) // -Hid -Hd0 -K2 - /3 width=9 by llpx_sn_lref, monotonic_yle_plus_dx/ - ] -| #K1 #K2 #d0 #i #HK1 #HK2 #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref1 … H) -H - * #Hid #H destruct - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -HK12 - [ /3 width=7 by llpx_sn_free, ldrop_fwd_be/ - | lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1 - lapply (ldrop_fwd_length … HLK2) -HLK2 #HLK2 - @llpx_sn_free [ >HLK1 | >HLK2 ] -Hid -HLK1 -HLK2 /2 width=1 by monotonic_le_plus_r/ (**) (* explicit constructor *) - ] -| #K1 #K2 #d0 #p #HK12 #L1 #L2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref1 … H) -X - lapply (ldrop_fwd_length_eq2 … HLK1 HLK2 HK12) -K1 -K2 -d - /2 width=1 by llpx_sn_gref/ -| #a #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind1 … H) -H - #W #U #HVW #HTU #H destruct /4 width=5 by llpx_sn_bind, ldrop_skip, yle_succ/ -| #I #K1 #K2 #V #T #d0 #_ #_ #IHV #IHT #L1 #L2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat1 … H) -H - #W #U #HVW #HTU #H destruct /3 width=5 by llpx_sn_flat/ -] -qed-. - -(* Inversion lemmas on relocation *******************************************) - -lemma llpx_sn_inv_lift_le: ∀R. l_deliftable_sn R → - ∀L1,L2,U,d0. llpx_sn R d0 U L1 L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → d0 ≤ d → llpx_sn R d0 T K1 K2. -#R #HR #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 -[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d -e - /2 width=1 by llpx_sn_sort/ -| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ elim (lift_inv_lref2 … H) -H - * #_ #H destruct - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 - [ /2 width=1 by llpx_sn_skip/ - | /3 width=3 by llpx_sn_skip, yle_ylt_trans/ - ] -| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #IHK12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref2 … H) -H - * #Hid #H destruct [ -HK12 | -IHK12 ] - [ elim (ldrop_conf_lt … HLK1 … HLK11) // -L1 #L1 #V1 #HKL1 #HKL11 #HVW1 - elim (ldrop_conf_lt … HLK2 … HLK22) // -Hid -L2 #L2 #V2 #HKL2 #HKL22 #HVW2 - elim (HR … HW12 … HKL11 … HVW1) -HR #V0 #HV0 #HV12 - lapply (lift_inj … HV0 … HVW2) -HV0 -HVW2 #H destruct - /3 width=10 by llpx_sn_lref/ - | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 - lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hid0 - elim (le_inv_plus_l … Hid) -Hid /4 width=9 by llpx_sn_lref, yle_trans, yle_inj/ (**) (* slow *) - ] -| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_lref2 … H) -H - * #_ #H destruct - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) - [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 - lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 - #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) - | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H - lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H - /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ - ] -| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d -e - /2 width=1 by llpx_sn_gref/ -| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_bind2 … H) -H - #V #T #HVW #HTU #H destruct /4 width=6 by llpx_sn_bind, ldrop_skip, yle_succ/ -| #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 elim (lift_inv_flat2 … H) -H - #V #T #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ -] -qed-. - -lemma llpx_sn_inv_lift_be: ∀R,L1,L2,U,d0. llpx_sn R d0 U L1 L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → d ≤ d0 → d0 ≤ yinj d + e → llpx_sn R d T K1 K2. -#R #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 -[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ #_ >(lift_inv_sort2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d0 -e - /2 width=1 by llpx_sn_sort/ -| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H - * #Hid #H destruct - [ lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 - -Hid0 /3 width=1 by llpx_sn_skip, ylt_inj/ - | elim (ylt_yle_false … Hid0) -L1 -L2 -Hd0 -Hid0 - /3 width=3 by yle_trans, yle_inj/ (**) (* slow *) - ] -| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #_ #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H - * #Hid #H destruct - [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K11 -K22 -W1 -W2 -Hd0e -Hid0 - /3 width=3 by ylt_yle_trans, ylt_inj/ - | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 - lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hid0 -Hd0 -Hd0e - elim (le_inv_plus_l … Hid) -Hid /3 width=9 by llpx_sn_lref, yle_inj/ - ] -| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_lref2 … H) -H - * #_ #H destruct - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) - [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 - lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 - #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) - | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H - lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H - /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ - ] -| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ #_ >(lift_inv_gref2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d0 -e - /2 width=1 by llpx_sn_gref/ -| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_bind2 … H) -H - >commutative_plus #V #T #HVW #HTU #H destruct - @llpx_sn_bind [ /2 width=5 by/ ] -IHW (**) (* explicit constructor *) - @(IHU … HTU) -IHU -HTU /2 width=1 by ldrop_skip, yle_succ/ -| #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hd0 #Hd0e elim (lift_inv_flat2 … H) -H - #V #T #HVW #HTU #H destruct /3 width=6 by llpx_sn_flat/ -] -qed-. - -lemma llpx_sn_inv_lift_ge: ∀R,L1,L2,U,d0. llpx_sn R d0 U L1 L2 → - ∀K1,K2,d,e. ⇩[Ⓕ, d, e] L1 ≡ K1 → ⇩[Ⓕ, d, e] L2 ≡ K2 → - ∀T. ⇧[d, e] T ≡ U → yinj d + e ≤ d0 → llpx_sn R (d0-e) T K1 K2. -#R #L1 #L2 #U #d0 #H elim H -L1 -L2 -U -d0 -[ #L1 #L2 #d0 #k #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_sort2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d - /2 width=1 by llpx_sn_sort/ -| #L1 #L2 #d0 #i #HL12 #Hid0 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H - * #Hid #H destruct [ -Hid0 | -Hded0 ] - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 - [ /4 width=3 by llpx_sn_skip, yle_plus_to_minus_inj2, ylt_yle_trans, ylt_inj/ - | elim (le_inv_plus_l … Hid) -Hid #_ - /4 width=1 by llpx_sn_skip, monotonic_ylt_minus_dx, yle_inj/ - ] -| #I #L1 #L2 #K11 #K22 #W1 #W2 #d0 #i #Hid0 #HLK11 #HLK22 #HK12 #HW12 #_ #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H - * #Hid #H destruct - [ elim (ylt_yle_false … Hid0) -I -L1 -L2 -K11 -K22 -W1 -W2 -Hid0 - /3 width=3 by yle_fwd_plus_sn1, ylt_yle_trans, ylt_inj/ - | lapply (ldrop_conf_ge … HLK1 … HLK11 ?) // -L1 - lapply (ldrop_conf_ge … HLK2 … HLK22 ?) // -L2 -Hded0 -Hid - /3 width=9 by llpx_sn_lref, monotonic_yle_minus_dx/ - ] -| #L1 #L2 #d0 #i #HL1 #HL2 #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_lref2 … H) -H - * #_ #H destruct - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) - [ lapply (ldrop_fwd_length_le4 … HLK1) -HLK1 - lapply (ldrop_fwd_length_le4 … HLK2) -HLK2 - #HKL2 #HKL1 #HK12 @llpx_sn_free // /2 width=3 by transitive_le/ (**) (* full auto too slow *) - | lapply (ldrop_fwd_length … HLK1) -HLK1 #H >H in HL1; -H - lapply (ldrop_fwd_length … HLK2) -HLK2 #H >H in HL2; -H - /3 width=1 by llpx_sn_free, le_plus_to_minus_r/ - ] -| #L1 #L2 #d0 #p #HL12 #K1 #K2 #d #e #HLK1 #HLK2 #X #H #_ >(lift_inv_gref2 … H) -X - lapply (ldrop_fwd_length_eq1 … HLK1 HLK2 HL12) -L1 -L2 -d - /2 width=1 by llpx_sn_gref/ -| #a #I #L1 #L2 #W #U #d0 #_ #_ #IHW #IHU #K1 #K2 #d #e #HLK1 #HLK2 #X #H #Hded0 elim (lift_inv_bind2 … H) -H - #V #T #HVW #HTU #H destruct - @llpx_sn_bind [ /2 width=5 by/ ] -IHW (**) (* explicit constructor *) - yminus_Y_inj #K1 #HK12 #HLK1 - lapply (leq_inv_O_Y … HK12) -HK12 #H destruct /2 width=9 by llpx_sn_lref/ -| /4 width=5 by llpx_sn_free, leq_fwd_length, le_repl_sn_trans_aux, trans_eq/ -| /4 width=1 by llpx_sn_bind, leq_succ/ -] -qed-. - -lemma llpx_sn_leq_trans: ∀R,L,L1,T,d. llpx_sn R d T L L1 → - ∀L2. L1 ≃[d, ∞] L2 → llpx_sn R d T L L2. -#R #L #L1 #T #d #H elim H -L -L1 -T -d -/4 width=5 by llpx_sn_flat, llpx_sn_gref, llpx_sn_skip, llpx_sn_sort, leq_fwd_length, trans_eq/ -[ #I #L #L1 #K #K1 #V #V1 #d #i #Hdi #HLK #HLK1 #HK1 #HV1 #_ #L2 #HL12 - elim (leq_ldrop_conf_be … HL12 … HLK1) -L1 // >yminus_Y_inj #K2 #HK12 #HLK2 - lapply (leq_inv_O_Y … HK12) -HK12 #H destruct /2 width=9 by llpx_sn_lref/ -| /4 width=5 by llpx_sn_free, leq_fwd_length, le_repl_sn_conf_aux, trans_eq/ -| /4 width=1 by llpx_sn_bind, leq_succ/ -] -qed-. - -lemma llpx_sn_leq_repl: ∀R,L1,L2,T,d. llpx_sn R d T L1 L2 → ∀K1. K1 ≃[d, ∞] L1 → - ∀K2. L2 ≃[d, ∞] K2 → llpx_sn R d T K1 K2. -/3 width=4 by llpx_sn_leq_trans, leq_llpx_sn_trans/ qed-. - -lemma llpx_sn_bind_repl_SO: ∀R,I1,I2,L1,L2,V1,V2,T. llpx_sn R 0 T (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) → - ∀J1,J2,W1,W2. llpx_sn R 1 T (L1.ⓑ{J1}W1) (L2.ⓑ{J2}W2). -#R #I1 #I2 #L1 #L2 #V1 #V2 #T #HT #J1 #J2 #W1 #W2 lapply (llpx_sn_ge R … 1 … HT) -HT -/3 width=7 by llpx_sn_leq_repl, leq_succ/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_llor.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_llor.ma deleted file mode 100644 index a22618f1c..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_llor.ma +++ /dev/null @@ -1,34 +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/relocation/lpx_sn_alt.ma". -include "basic_2/substitution/llor.ma". -include "basic_2/substitution/lleq_alt.ma". - -(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) - -(* Inversion lemmas on poinwise union for local environments ****************) - -lemma llpx_sn_llor_fwd_sn: ∀R. (∀L. reflexive … (R L)) → - ∀L1,L2,T. llpx_sn R 0 T L1 L2 → - ∀L. L1 ⩖[T] L2 ≡ L → lpx_sn R L1 L. -#R #HR #L1 #L2 #T #H1 #L #H2 -elim (llpx_sn_llpx_sn_alt … H1) -H1 #HL12 #IH1 -elim H2 -H2 #_ #HL1 #IH2 -@lpx_sn_intro_alt // #I1 #I #K1 #K #V1 #V #i #HLK1 #HLK -lapply (ldrop_fwd_length_lt2 … HLK) #HiL -elim (ldrop_O1_lt (Ⓕ) L2 i) // -HiL -HL1 -HL12 #I2 #K2 #V2 #HLK2 -elim (IH2 … HLK1 HLK2 HLK) -IH2 -HLK * [ /2 width=1 by conj/ ] -#HnT #H1 #H2 elim (IH1 … HnT … HLK1 HLK2) -IH1 -HnT -HLK1 -HLK2 /2 width=1 by conj/ -qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_lpx_sn.ma deleted file mode 100644 index 6a0a210ca..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_lpx_sn.ma +++ /dev/null @@ -1,38 +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/relocation/lpx_sn_ldrop.ma". -include "basic_2/substitution/llpx_sn.ma". - -(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) - -(* Properties on pointwise extensions ***************************************) - -lemma lpx_sn_llpx_sn: ∀R. (∀L. reflexive … (R L)) → - ∀T,L1,L2,d. lpx_sn R L1 L2 → llpx_sn R d T L1 L2. -#R #HR #T #L1 @(f2_ind … rfw … L1 T) -L1 -T -#n #IH #L1 * * -[ -HR -IH /4 width=2 by lpx_sn_fwd_length, llpx_sn_sort/ -| -HR #i elim (lt_or_ge i (|L1|)) - [2: -IH /4 width=4 by lpx_sn_fwd_length, llpx_sn_free, le_repl_sn_conf_aux/ ] - #Hi #Hn #L2 #d elim (ylt_split i d) - [ -n /3 width=2 by llpx_sn_skip, lpx_sn_fwd_length/ ] - #Hdi #HL12 elim (ldrop_O1_lt (Ⓕ) L1 i) // - #I #K1 #V1 #HLK1 elim (lpx_sn_ldrop_conf … HL12 … HLK1) -HL12 - /4 width=9 by llpx_sn_lref, ldrop_fwd_rfw/ -| -HR -IH /4 width=2 by lpx_sn_fwd_length, llpx_sn_gref/ -| /4 width=1 by llpx_sn_bind, lpx_sn_pair/ -| -HR /3 width=1 by llpx_sn_flat/ -] -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_tc.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_tc.ma deleted file mode 100644 index 1ab9a7984..000000000 --- a/matita/matita/contribs/lambdadelta/basic_2/substitution/llpx_sn_tc.ma +++ /dev/null @@ -1,26 +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/llpx_sn_ldrop.ma". - -(* LAZY SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS ****) - -(* Properties about transitive closure **************************************) - -lemma llpx_sn_TC_pair_dx: ∀R. (∀L. reflexive … (R L)) → - ∀I,L,V1,V2,T. LTC … R L V1 V2 → - LTC … (llpx_sn R 0) T (L.ⓑ{I}V1) (L.ⓑ{I}V2). -#R #HR #I #L #V1 #V2 #T #H @(TC_star_ind … V2 H) -V2 -/4 width=9 by llpx_sn_bind_repl_O, llpx_sn_refl, step, inj/ -qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn.ma new file mode 100644 index 000000000..977fd887b --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn.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/grammar/lenv_length.ma". + +(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) + +inductive lpx_sn (R:relation3 lenv term term): relation lenv ≝ +| lpx_sn_atom: lpx_sn R (⋆) (⋆) +| lpx_sn_pair: ∀I,K1,K2,V1,V2. + lpx_sn R K1 K2 → R K1 V1 V2 → + lpx_sn R (K1. ⓑ{I} V1) (K2. ⓑ{I} V2) +. + +(* Basic properties *********************************************************) + +lemma lpx_sn_refl: ∀R. (∀L. reflexive ? (R L)) → reflexive … (lpx_sn R). +#R #HR #L elim L -L /2 width=1 by lpx_sn_atom, lpx_sn_pair/ +qed-. + +(* Basic inversion lemmas ***************************************************) + +fact lpx_sn_inv_atom1_aux: ∀R,L1,L2. lpx_sn R L1 L2 → L1 = ⋆ → L2 = ⋆. +#R #L1 #L2 * -L1 -L2 +[ // +| #I #K1 #K2 #V1 #V2 #_ #_ #H destruct +] +qed-. + +lemma lpx_sn_inv_atom1: ∀R,L2. lpx_sn R (⋆) L2 → L2 = ⋆. +/2 width=4 by lpx_sn_inv_atom1_aux/ qed-. + +fact lpx_sn_inv_pair1_aux: ∀R,L1,L2. lpx_sn R L1 L2 → ∀I,K1,V1. L1 = K1. ⓑ{I} V1 → + ∃∃K2,V2. lpx_sn R K1 K2 & R K1 V1 V2 & L2 = K2. ⓑ{I} V2. +#R #L1 #L2 * -L1 -L2 +[ #J #K1 #V1 #H destruct +| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #J #L #W #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +lemma lpx_sn_inv_pair1: ∀R,I,K1,V1,L2. lpx_sn R (K1. ⓑ{I} V1) L2 → + ∃∃K2,V2. lpx_sn R K1 K2 & R K1 V1 V2 & L2 = K2. ⓑ{I} V2. +/2 width=3 by lpx_sn_inv_pair1_aux/ qed-. + +fact lpx_sn_inv_atom2_aux: ∀R,L1,L2. lpx_sn R L1 L2 → L2 = ⋆ → L1 = ⋆. +#R #L1 #L2 * -L1 -L2 +[ // +| #I #K1 #K2 #V1 #V2 #_ #_ #H destruct +] +qed-. + +lemma lpx_sn_inv_atom2: ∀R,L1. lpx_sn R L1 (⋆) → L1 = ⋆. +/2 width=4 by lpx_sn_inv_atom2_aux/ qed-. + +fact lpx_sn_inv_pair2_aux: ∀R,L1,L2. lpx_sn R L1 L2 → ∀I,K2,V2. L2 = K2. ⓑ{I} V2 → + ∃∃K1,V1. lpx_sn R K1 K2 & R K1 V1 V2 & L1 = K1. ⓑ{I} V1. +#R #L1 #L2 * -L1 -L2 +[ #J #K2 #V2 #H destruct +| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #J #K #W #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +lemma lpx_sn_inv_pair2: ∀R,I,L1,K2,V2. lpx_sn R L1 (K2. ⓑ{I} V2) → + ∃∃K1,V1. lpx_sn R K1 K2 & R K1 V1 V2 & L1 = K1. ⓑ{I} V1. +/2 width=3 by lpx_sn_inv_pair2_aux/ qed-. + +lemma lpx_sn_inv_pair: ∀R,I1,I2,L1,L2,V1,V2. + lpx_sn R (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) → + ∧∧ lpx_sn R L1 L2 & R L1 V1 V2 & I1 = I2. +#R #I1 #I2 #L1 #L2 #V1 #V2 #H elim (lpx_sn_inv_pair1 … H) -H +#L0 #V0 #HL10 #HV10 #H destruct /2 width=1 by and3_intro/ +qed-. + +(* Basic forward lemmas *****************************************************) + +lemma lpx_sn_fwd_length: ∀R,L1,L2. lpx_sn R L1 L2 → |L1| = |L2|. +#R #L1 #L2 #H elim H -L1 -L2 normalize // +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_alt.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_alt.ma new file mode 100644 index 000000000..f7bb7697a --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_alt.ma @@ -0,0 +1,125 @@ +(**************************************************************************) +(* ___ *) +(* ||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". +include "basic_2/substitution/lpx_sn.ma". + +(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) + +(* alternative definition of lpx_sn *) +definition lpx_sn_alt: relation3 lenv term term → relation lenv ≝ + λR,L1,L2. |L1| = |L2| ∧ + (∀I1,I2,K1,K2,V1,V2,i. + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ R K1 V1 V2 + ). + +(* Basic forward lemmas ******************************************************) + +lemma lpx_sn_alt_fwd_length: ∀R,L1,L2. lpx_sn_alt R L1 L2 → |L1| = |L2|. +#R #L1 #L2 #H elim H // +qed-. + +(* Basic inversion lemmas ***************************************************) + +lemma lpx_sn_alt_inv_atom1: ∀R,L2. lpx_sn_alt R (⋆) L2 → L2 = ⋆. +#R #L2 #H lapply (lpx_sn_alt_fwd_length … H) -H +normalize /2 width=1 by length_inv_zero_sn/ +qed-. + +lemma lpx_sn_alt_inv_pair1: ∀R,I,L2,K1,V1. lpx_sn_alt R (K1.ⓑ{I}V1) L2 → + ∃∃K2,V2. lpx_sn_alt R K1 K2 & R K1 V1 V2 & L2 = K2.ⓑ{I}V2. +#R #I1 #L2 #K1 #V1 #H elim H -H +#H #IH elim (length_inv_pos_sn … H) -H +#I2 #K2 #V2 #HK12 #H destruct +elim (IH I1 I2 K1 K2 V1 V2 0) // +#H #HV12 destruct @(ex3_2_intro … K2 V2) // -HV12 +@conj // -HK12 +#J1 #J2 #L1 #L2 #W1 #W2 #i #HKL1 #HKL2 elim (IH J1 J2 L1 L2 W1 W2 (i+1)) -IH +/2 width=1 by ldrop_drop, conj/ +qed-. + +lemma lpx_sn_alt_inv_atom2: ∀R,L1. lpx_sn_alt R L1 (⋆) → L1 = ⋆. +#R #L1 #H lapply (lpx_sn_alt_fwd_length … H) -H +normalize /2 width=1 by length_inv_zero_dx/ +qed-. + +lemma lpx_sn_alt_inv_pair2: ∀R,I,L1,K2,V2. lpx_sn_alt R L1 (K2.ⓑ{I}V2) → + ∃∃K1,V1. lpx_sn_alt R K1 K2 & R K1 V1 V2 & L1 = K1.ⓑ{I}V1. +#R #I2 #L1 #K2 #V2 #H elim H -H +#H #IH elim (length_inv_pos_dx … H) -H +#I1 #K1 #V1 #HK12 #H destruct +elim (IH I1 I2 K1 K2 V1 V2 0) // +#H #HV12 destruct @(ex3_2_intro … K1 V1) // -HV12 +@conj // -HK12 +#J1 #J2 #L1 #L2 #W1 #W2 #i #HKL1 #HKL2 elim (IH J1 J2 L1 L2 W1 W2 (i+1)) -IH +/2 width=1 by ldrop_drop, conj/ +qed-. + +(* Basic properties *********************************************************) + +lemma lpx_sn_alt_atom: ∀R. lpx_sn_alt R (⋆) (⋆). +#R @conj // +#I1 #I2 #K1 #K2 #V1 #V2 #i #HLK1 elim (ldrop_inv_atom1 … HLK1) -HLK1 +#H destruct +qed. + +lemma lpx_sn_alt_pair: ∀R,I,L1,L2,V1,V2. + lpx_sn_alt R L1 L2 → R L1 V1 V2 → + lpx_sn_alt R (L1.ⓑ{I}V1) (L2.ⓑ{I}V2). +#R #I #L1 #L2 #V1 #V2 #H #HV12 elim H -H +#HL12 #IH @conj normalize // +#I1 #I2 #K1 #K2 #W1 #W2 #i @(nat_ind_plus … i) -i +[ #HLK1 #HLK2 + lapply (ldrop_inv_O2 … HLK1) -HLK1 #H destruct + lapply (ldrop_inv_O2 … HLK2) -HLK2 #H destruct + /2 width=1 by conj/ +| -HL12 -HV12 /3 width=6 by ldrop_inv_drop1/ +] +qed. + +(* Main properties **********************************************************) + +theorem lpx_sn_lpx_sn_alt: ∀R,L1,L2. lpx_sn R L1 L2 → lpx_sn_alt R L1 L2. +#R #L1 #L2 #H elim H -L1 -L2 +/2 width=1 by lpx_sn_alt_atom, lpx_sn_alt_pair/ +qed. + +(* Main inversion lemmas ****************************************************) + +theorem lpx_sn_alt_inv_lpx_sn: ∀R,L1,L2. lpx_sn_alt R L1 L2 → lpx_sn R L1 L2. +#R #L1 elim L1 -L1 +[ #L2 #H lapply (lpx_sn_alt_inv_atom1 … H) -H // +| #L1 #I #V1 #IH #X #H elim (lpx_sn_alt_inv_pair1 … H) -H + #L2 #V2 #HL12 #HV12 #H destruct /3 width=1 by lpx_sn_pair/ +] +qed-. + +(* alternative definition of lpx_sn *****************************************) + +lemma lpx_sn_intro_alt: ∀R,L1,L2. |L1| = |L2| → + (∀I1,I2,K1,K2,V1,V2,i. + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ R K1 V1 V2 + ) → lpx_sn R L1 L2. +/4 width=4 by lpx_sn_alt_inv_lpx_sn, conj/ qed. + +lemma lpx_sn_inv_alt: ∀R,L1,L2. lpx_sn R L1 L2 → + |L1| = |L2| ∧ + ∀I1,I2,K1,K2,V1,V2,i. + ⇩[i] L1 ≡ K1.ⓑ{I1}V1 → ⇩[i] L2 ≡ K2.ⓑ{I2}V2 → + I1 = I2 ∧ R K1 V1 V2. +#R #L1 #L2 #H lapply (lpx_sn_lpx_sn_alt … H) -H +#H elim H -H /3 width=4 by conj/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_ldrop.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_ldrop.ma new file mode 100644 index 000000000..2dac3b282 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_ldrop.ma @@ -0,0 +1,104 @@ +(**************************************************************************) +(* ___ *) +(* ||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_leq.ma". +include "basic_2/substitution/lpx_sn.ma". + +(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) + +(* Properies on dropping ****************************************************) + +lemma lpx_sn_ldrop_conf: ∀R,L1,L2. lpx_sn R L1 L2 → + ∀I,K1,V1,i. ⇩[i] L1 ≡ K1.ⓑ{I}V1 → + ∃∃K2,V2. ⇩[i] L2 ≡ K2.ⓑ{I}V2 & lpx_sn R K1 K2 & R K1 V1 V2. +#R #L1 #L2 #H elim H -L1 -L2 +[ #I0 #K0 #V0 #i #H elim (ldrop_inv_atom1 … H) -H #H destruct +| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #IHK12 #I0 #K0 #V0 #i #H elim (ldrop_inv_O1_pair1 … H) * -H + [ -IHK12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ex3_2_intro/ + | -HK12 -HV12 #Hi #HK10 elim (IHK12 … HK10) -IHK12 -HK10 + /3 width=5 by ldrop_drop_lt, ex3_2_intro/ + ] +] +qed-. + +lemma lpx_sn_ldrop_trans: ∀R,L1,L2. lpx_sn R L1 L2 → + ∀I,K2,V2,i. ⇩[i] L2 ≡ K2.ⓑ{I}V2 → + ∃∃K1,V1. ⇩[i] L1 ≡ K1.ⓑ{I}V1 & lpx_sn R K1 K2 & R K1 V1 V2. +#R #L1 #L2 #H elim H -L1 -L2 +[ #I0 #K0 #V0 #i #H elim (ldrop_inv_atom1 … H) -H #H destruct +| #I #K1 #K2 #V1 #V2 #HK12 #HV12 #IHK12 #I0 #K0 #V0 #i #H elim (ldrop_inv_O1_pair1 … H) * -H + [ -IHK12 #H1 #H2 destruct /3 width=5 by ldrop_pair, ex3_2_intro/ + | -HK12 -HV12 #Hi #HK10 elim (IHK12 … HK10) -IHK12 -HK10 + /3 width=5 by ldrop_drop_lt, ex3_2_intro/ + ] +] +qed-. + +lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R). +#R #HR #L1 #K1 #s #d #e #H elim H -L1 -K1 -d -e +[ #d #e #He #X #H >(lpx_sn_inv_atom1 … H) -H + /4 width=3 by ldrop_atom, lpx_sn_atom, ex2_intro/ +| #I #K1 #V1 #X #H elim (lpx_sn_inv_pair1 … H) -H + #L2 #V2 #HL12 #HV12 #H destruct + /3 width=5 by ldrop_pair, lpx_sn_pair, ex2_intro/ +| #I #L1 #K1 #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 by ldrop_drop, ex2_intro/ +| #I #L1 #K1 #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 by ldrop_skip, lpx_sn_pair, ex2_intro/ +] +qed-. + +lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) → + l_liftable R → dedropable_sn (lpx_sn R). +#R #H1R #H2R #L1 #K1 #s #d #e #H elim H -L1 -K1 -d -e +[ #d #e #He #X #H >(lpx_sn_inv_atom1 … H) -H + /4 width=4 by ldrop_atom, lpx_sn_atom, ex3_intro/ +| #I #K1 #V1 #X #H elim (lpx_sn_inv_pair1 … H) -H + #K2 #V2 #HK12 #HV12 #H destruct + lapply (lpx_sn_fwd_length … HK12) + #H @(ex3_intro … (K2.ⓑ{I}V2)) (**) (* explicit constructor *) + /3 width=1 by lpx_sn_pair, monotonic_le_plus_l/ + @leq_O2 normalize // +| #I #L1 #K1 #V1 #e #_ #IHLK1 #K2 #HK12 elim (IHLK1 … HK12) -K1 + /3 width=5 by ldrop_drop, leq_pair, lpx_sn_pair, ex3_intro/ +| #I #L1 #K1 #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=6 by ldrop_skip, leq_succ, lpx_sn_pair, ex3_intro/ +] +qed-. + +fact lpx_sn_dropable_aux: ∀R,L2,K2,s,d,e. ⇩[s, d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 → + d = 0 → ∃∃K1. ⇩[s, 0, e] L1 ≡ K1 & lpx_sn R K1 K2. +#R #L2 #K2 #s #d #e #H elim H -L2 -K2 -d -e +[ #d #e #He #X #H >(lpx_sn_inv_atom2 … H) -H + /4 width=3 by ldrop_atom, lpx_sn_atom, ex2_intro/ +| #I #K2 #V2 #X #H elim (lpx_sn_inv_pair2 … H) -H + #K1 #V1 #HK12 #HV12 #H destruct + /3 width=5 by ldrop_pair, lpx_sn_pair, ex2_intro/ +| #I #L2 #K2 #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 by ldrop_drop, ex2_intro/ +| #I #L2 #K2 #V2 #W2 #d #e #_ #_ #_ #L1 #_ + (lpx_sn_inv_atom1 … H1) -X1 + >(lpx_sn_inv_atom1 … H2) -X2 /2 width=3 by lpx_sn_atom, ex2_intro/ +| #L0 #I #V0 #Hn #X1 #H1 #X2 #H2 destruct + 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 (HR12 … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5 by lpx_sn_pair, ex2_intro/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_tc.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_tc.ma new file mode 100644 index 000000000..ef4419780 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lpx_sn_tc.ma @@ -0,0 +1,119 @@ +(**************************************************************************) +(* ___ *) +(* ||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/lpx_sn.ma". + +(* SN POINTWISE EXTENSION OF A CONTEXT-SENSITIVE REALTION FOR TERMS *********) + +(* Properties on transitive_closure *****************************************) + +lemma TC_lpx_sn_pair_refl: ∀R. (∀L. reflexive … (R L)) → + ∀L1,L2. TC … (lpx_sn R) L1 L2 → + ∀I,V. TC … (lpx_sn R) (L1. ⓑ{I} V) (L2. ⓑ{I} V). +#R #HR #L1 #L2 #H @(TC_star_ind … L2 H) -L2 +[ /2 width=1 by lpx_sn_refl/ +| /3 width=1 by TC_reflexive, lpx_sn_refl/ +| /3 width=5 by lpx_sn_pair, step/ +] +qed-. + +lemma TC_lpx_sn_pair: ∀R. (∀L. reflexive … (R L)) → + ∀I,L1,L2. TC … (lpx_sn R) L1 L2 → + ∀V1,V2. LTC … R L1 V1 V2 → + TC … (lpx_sn R) (L1. ⓑ{I} V1) (L2. ⓑ{I} V2). +#R #HR #I #L1 #L2 #HL12 #V1 #V2 #H @(TC_star_ind_dx … V1 H) -V1 // +[ /2 width=1 by TC_lpx_sn_pair_refl/ +| /4 width=3 by TC_strap, lpx_sn_pair, lpx_sn_refl/ +] +qed-. + +lemma lpx_sn_LTC_TC_lpx_sn: ∀R. (∀L. reflexive … (R L)) → + ∀L1,L2. lpx_sn (LTC … R) L1 L2 → + TC … (lpx_sn R) L1 L2. +#R #HR #L1 #L2 #H elim H -L1 -L2 +/2 width=1 by TC_lpx_sn_pair, lpx_sn_atom, inj/ +qed-. + +(* Inversion lemmas on transitive closure ***********************************) + +lemma TC_lpx_sn_inv_atom2: ∀R,L1. TC … (lpx_sn R) L1 (⋆) → L1 = ⋆. +#R #L1 #H @(TC_ind_dx … L1 H) -L1 +[ /2 width=2 by lpx_sn_inv_atom2/ +| #L1 #L #HL1 #_ #IHL2 destruct /2 width=2 by lpx_sn_inv_atom2/ +] +qed-. + +lemma TC_lpx_sn_inv_pair2: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → + ∀I,L1,K2,V2. TC … (lpx_sn R) L1 (K2.ⓑ{I}V2) → + ∃∃K1,V1. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L1 = K1. ⓑ{I} V1. +#R #HR #I #L1 #K2 #V2 #H @(TC_ind_dx … L1 H) -L1 +[ #L1 #H elim (lpx_sn_inv_pair2 … H) -H /3 width=5 by inj, ex3_2_intro/ +| #L1 #L #HL1 #_ * #K #V #HK2 #HV2 #H destruct + elim (lpx_sn_inv_pair2 … HL1) -HL1 #K1 #V1 #HK1 #HV1 #H destruct + lapply (HR … HV2 … HK1) -HR -HV2 /3 width=5 by TC_strap, ex3_2_intro/ +] +qed-. + +lemma TC_lpx_sn_ind: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → + ∀S:relation lenv. + S (⋆) (⋆) → ( + ∀I,K1,K2,V1,V2. + TC … (lpx_sn R) K1 K2 → LTC … R K1 V1 V2 → + S K1 K2 → S (K1.ⓑ{I}V1) (K2.ⓑ{I}V2) + ) → + ∀L2,L1. TC … (lpx_sn R) L1 L2 → S L1 L2. +#R #HR #S #IH1 #IH2 #L2 elim L2 -L2 +[ #X #H >(TC_lpx_sn_inv_atom2 … H) -X // +| #L2 #I #V2 #IHL2 #X #H + elim (TC_lpx_sn_inv_pair2 … H) // -H -HR + #L1 #V1 #HL12 #HV12 #H destruct /3 width=1 by/ +] +qed-. + +lemma TC_lpx_sn_inv_atom1: ∀R,L2. TC … (lpx_sn R) (⋆) L2 → L2 = ⋆. +#R #L2 #H elim H -L2 +[ /2 width=2 by lpx_sn_inv_atom1/ +| #L #L2 #_ #HL2 #IHL1 destruct /2 width=2 by lpx_sn_inv_atom1/ +] +qed-. + +fact TC_lpx_sn_inv_pair1_aux: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → + ∀L1,L2. TC … (lpx_sn R) L1 L2 → + ∀I,K1,V1. L1 = K1.ⓑ{I}V1 → + ∃∃K2,V2. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L2 = K2. ⓑ{I} V2. +#R #HR #L1 #L2 #H @(TC_lpx_sn_ind … H) // -HR -L1 -L2 +[ #J #K #W #H destruct +| #I #L1 #L2 #V1 #V2 #HL12 #HV12 #_ #J #K #W #H destruct /2 width=5 by ex3_2_intro/ +] +qed-. + +lemma TC_lpx_sn_inv_pair1: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → + ∀I,K1,L2,V1. TC … (lpx_sn R) (K1.ⓑ{I}V1) L2 → + ∃∃K2,V2. TC … (lpx_sn R) K1 K2 & LTC … R K1 V1 V2 & L2 = K2. ⓑ{I} V2. +/2 width=3 by TC_lpx_sn_inv_pair1_aux/ qed-. + +lemma TC_lpx_sn_inv_lpx_sn_LTC: ∀R. s_rs_transitive … R (λ_. lpx_sn R) → + ∀L1,L2. TC … (lpx_sn R) L1 L2 → + lpx_sn (LTC … R) L1 L2. +/3 width=4 by TC_lpx_sn_ind, lpx_sn_pair/ qed-. + +(* Forward lemmas on transitive closure *************************************) + +lemma TC_lpx_sn_fwd_length: ∀R,L1,L2. TC … (lpx_sn R) L1 L2 → |L1| = |L2|. +#R #L1 #L2 #H elim H -L2 +[ #L2 #HL12 >(lpx_sn_fwd_length … HL12) -HL12 // +| #L #L2 #_ #HL2 #IHL1 + >IHL1 -L1 >(lpx_sn_fwd_length … HL2) -HL2 // +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby.ma new file mode 100644 index 000000000..8d5b2954e --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby.ma @@ -0,0 +1,237 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "ground_2/ynat/ynat_plus.ma". +include "basic_2/notation/relations/lrsubeq_4.ma". +include "basic_2/substitution/ldrop.ma". + +(* LOCAL ENVIRONMENT REFINEMENT FOR EXTENDED SUBSTITUTION *******************) + +inductive lsuby: relation4 ynat ynat lenv lenv ≝ +| lsuby_atom: ∀L,d,e. lsuby d e L (⋆) +| lsuby_zero: ∀I1,I2,L1,L2,V1,V2. + lsuby 0 0 L1 L2 → lsuby 0 0 (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) +| lsuby_pair: ∀I1,I2,L1,L2,V,e. lsuby 0 e L1 L2 → + lsuby 0 (⫯e) (L1.ⓑ{I1}V) (L2.ⓑ{I2}V) +| lsuby_succ: ∀I1,I2,L1,L2,V1,V2,d,e. + lsuby d e L1 L2 → lsuby (⫯d) e (L1.ⓑ{I1}V1) (L2.ⓑ{I2}V2) +. + +interpretation + "local environment refinement (extended substitution)" + 'LRSubEq L1 d e L2 = (lsuby d e L1 L2). + +(* Basic properties *********************************************************) + +lemma lsuby_pair_lt: ∀I1,I2,L1,L2,V,e. L1 ⊆[0, ⫰e] L2 → 0 < e → + L1.ⓑ{I1}V ⊆[0, e] L2.ⓑ{I2}V. +#I1 #I2 #L1 #L2 #V #e #HL12 #He <(ylt_inv_O1 … He) /2 width=1 by lsuby_pair/ +qed. + +lemma lsuby_succ_lt: ∀I1,I2,L1,L2,V1,V2,d,e. L1 ⊆[⫰d, e] L2 → 0 < d → + L1.ⓑ{I1}V1 ⊆[d, e] L2. ⓑ{I2}V2. +#I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #Hd <(ylt_inv_O1 … Hd) /2 width=1 by lsuby_succ/ +qed. + +lemma lsuby_pair_O_Y: ∀L1,L2. L1 ⊆[0, ∞] L2 → + ∀I1,I2,V. L1.ⓑ{I1}V ⊆[0,∞] L2.ⓑ{I2}V. +#L1 #L2 #HL12 #I1 #I2 #V lapply (lsuby_pair I1 I2 … V … HL12) -HL12 // +qed. + +lemma lsuby_refl: ∀L,d,e. L ⊆[d, e] L. +#L elim L -L // +#L #I #V #IHL #d elim (ynat_cases … d) [| * #x ] +#Hd destruct /2 width=1 by lsuby_succ/ +#e elim (ynat_cases … e) [| * #x ] +#He destruct /2 width=1 by lsuby_zero, lsuby_pair/ +qed. + +lemma lsuby_O2: ∀L2,L1,d. |L2| ≤ |L1| → L1 ⊆[d, yinj 0] L2. +#L2 elim L2 -L2 // #L2 #I2 #V2 #IHL2 * normalize +[ #d #H elim (le_plus_xSy_O_false … H) +| #L1 #I1 #V1 #d #H lapply (le_plus_to_le_r … H) -H #HL12 + elim (ynat_cases d) /3 width=1 by lsuby_zero/ + * /3 width=1 by lsuby_succ/ +] +qed. + +lemma lsuby_sym: ∀d,e,L1,L2. L1 ⊆[d, e] L2 → |L1| = |L2| → L2 ⊆[d, e] L1. +#d #e #L1 #L2 #H elim H -d -e -L1 -L2 +[ #L1 #d #e #H >(length_inv_zero_dx … H) -L1 // +| /2 width=1 by lsuby_O2/ +| #I1 #I2 #L1 #L2 #V #e #_ #IHL12 #H lapply (injective_plus_l … H) + /3 width=1 by lsuby_pair/ +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #IHL12 #H lapply (injective_plus_l … H) + /3 width=1 by lsuby_succ/ +] +qed-. + +(* Basic inversion lemmas ***************************************************) + +fact lsuby_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → L1 = ⋆ → L2 = ⋆. +#L1 #L2 #d #e * -L1 -L2 -d -e // +[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #H destruct +| #I1 #I2 #L1 #L2 #V #e #_ #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #H destruct +] +qed-. + +lemma lsuby_inv_atom1: ∀L2,d,e. ⋆ ⊆[d, e] L2 → L2 = ⋆. +/2 width=5 by lsuby_inv_atom1_aux/ qed-. + +fact lsuby_inv_zero1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J1,K1,W1. L1 = K1.ⓑ{J1}W1 → d = 0 → e = 0 → + L2 = ⋆ ∨ + ∃∃J2,K2,W2. K1 ⊆[0, 0] K2 & L2 = K2.ⓑ{J2}W2. +#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ +[ #I1 #I2 #L1 #L2 #V1 #V2 #HL12 #J1 #K1 #W1 #H #_ #_ destruct + /3 width=5 by ex2_3_intro, or_intror/ +| #I1 #I2 #L1 #L2 #V #e #_ #J1 #K1 #W1 #_ #_ #H + elim (ysucc_inv_O_dx … H) +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J1 #K1 #W1 #_ #H + elim (ysucc_inv_O_dx … H) +] +qed-. + +lemma lsuby_inv_zero1: ∀I1,K1,L2,V1. K1.ⓑ{I1}V1 ⊆[0, 0] L2 → + L2 = ⋆ ∨ + ∃∃I2,K2,V2. K1 ⊆[0, 0] K2 & L2 = K2.ⓑ{I2}V2. +/2 width=9 by lsuby_inv_zero1_aux/ qed-. + +fact lsuby_inv_pair1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J1,K1,W. L1 = K1.ⓑ{J1}W → d = 0 → 0 < e → + L2 = ⋆ ∨ + ∃∃J2,K2. K1 ⊆[0, ⫰e] K2 & L2 = K2.ⓑ{J2}W. +#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ +[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #J1 #K1 #W #_ #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V #e #HL12 #J1 #K1 #W #H #_ #_ destruct + /3 width=4 by ex2_2_intro, or_intror/ +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J1 #K1 #W #_ #H + elim (ysucc_inv_O_dx … H) +] +qed-. + +lemma lsuby_inv_pair1: ∀I1,K1,L2,V,e. K1.ⓑ{I1}V ⊆[0, e] L2 → 0 < e → + L2 = ⋆ ∨ + ∃∃I2,K2. K1 ⊆[0, ⫰e] K2 & L2 = K2.ⓑ{I2}V. +/2 width=6 by lsuby_inv_pair1_aux/ qed-. + +fact lsuby_inv_succ1_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J1,K1,W1. L1 = K1.ⓑ{J1}W1 → 0 < d → + L2 = ⋆ ∨ + ∃∃J2,K2,W2. K1 ⊆[⫰d, e] K2 & L2 = K2.ⓑ{J2}W2. +#L1 #L2 #d #e * -L1 -L2 -d -e /2 width=1 by or_introl/ +[ #I1 #I2 #L1 #L2 #V1 #V2 #_ #J1 #K1 #W1 #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V #e #_ #J1 #K1 #W1 #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #J1 #K1 #W1 #H #_ destruct + /3 width=5 by ex2_3_intro, or_intror/ +] +qed-. + +lemma lsuby_inv_succ1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊆[d, e] L2 → 0 < d → + L2 = ⋆ ∨ + ∃∃I2,K2,V2. K1 ⊆[⫰d, e] K2 & L2 = K2.ⓑ{I2}V2. +/2 width=5 by lsuby_inv_succ1_aux/ qed-. + +fact lsuby_inv_zero2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J2,K2,W2. L2 = K2.ⓑ{J2}W2 → d = 0 → e = 0 → + ∃∃J1,K1,W1. K1 ⊆[0, 0] K2 & L1 = K1.ⓑ{J1}W1. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #L1 #d #e #J2 #K2 #W1 #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #HL12 #J2 #K2 #W2 #H #_ #_ destruct + /2 width=5 by ex2_3_intro/ +| #I1 #I2 #L1 #L2 #V #e #_ #J2 #K2 #W2 #_ #_ #H + elim (ysucc_inv_O_dx … H) +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J2 #K2 #W2 #_ #H + elim (ysucc_inv_O_dx … H) +] +qed-. + +lemma lsuby_inv_zero2: ∀I2,K2,L1,V2. L1 ⊆[0, 0] K2.ⓑ{I2}V2 → + ∃∃I1,K1,V1. K1 ⊆[0, 0] K2 & L1 = K1.ⓑ{I1}V1. +/2 width=9 by lsuby_inv_zero2_aux/ qed-. + +fact lsuby_inv_pair2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J2,K2,W. L2 = K2.ⓑ{J2}W → d = 0 → 0 < e → + ∃∃J1,K1. K1 ⊆[0, ⫰e] K2 & L1 = K1.ⓑ{J1}W. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #L1 #d #e #J2 #K2 #W #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #_ #J2 #K2 #W #_ #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V #e #HL12 #J2 #K2 #W #H #_ #_ destruct + /2 width=4 by ex2_2_intro/ +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #J2 #K2 #W #_ #H + elim (ysucc_inv_O_dx … H) +] +qed-. + +lemma lsuby_inv_pair2: ∀I2,K2,L1,V,e. L1 ⊆[0, e] K2.ⓑ{I2}V → 0 < e → + ∃∃I1,K1. K1 ⊆[0, ⫰e] K2 & L1 = K1.ⓑ{I1}V. +/2 width=6 by lsuby_inv_pair2_aux/ qed-. + +fact lsuby_inv_succ2_aux: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀J2,K2,W2. L2 = K2.ⓑ{J2}W2 → 0 < d → + ∃∃J1,K1,W1. K1 ⊆[⫰d, e] K2 & L1 = K1.ⓑ{J1}W1. +#L1 #L2 #d #e * -L1 -L2 -d -e +[ #L1 #d #e #J2 #K2 #W2 #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #_ #J2 #K2 #W2 #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V #e #_ #J2 #K1 #W2 #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #HL12 #J2 #K2 #W2 #H #_ destruct + /2 width=5 by ex2_3_intro/ +] +qed-. + +lemma lsuby_inv_succ2: ∀I2,K2,L1,V2,d,e. L1 ⊆[d, e] K2.ⓑ{I2}V2 → 0 < d → + ∃∃I1,K1,V1. K1 ⊆[⫰d, e] K2 & L1 = K1.ⓑ{I1}V1. +/2 width=5 by lsuby_inv_succ2_aux/ qed-. + +(* Basic forward lemmas *****************************************************) + +lemma lsuby_fwd_length: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → |L2| ≤ |L1|. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize /2 width=1 by le_S_S/ +qed-. + +(* Properties on basic slicing **********************************************) + +lemma lsuby_ldrop_trans_be: ∀L1,L2,d,e. L1 ⊆[d, e] L2 → + ∀I2,K2,W,s,i. ⇩[s, 0, i] L2 ≡ K2.ⓑ{I2}W → + d ≤ i → i < d + e → + ∃∃I1,K1. K1 ⊆[0, ⫰(d+e-i)] K2 & ⇩[s, 0, i] L1 ≡ K1.ⓑ{I1}W. +#L1 #L2 #d #e #H elim H -L1 -L2 -d -e +[ #L1 #d #e #J2 #K2 #W #s #i #H + elim (ldrop_inv_atom1 … H) -H #H destruct +| #I1 #I2 #L1 #L2 #V1 #V2 #_ #_ #J2 #K2 #W #s #i #_ #_ #H + elim (ylt_yle_false … H) // +| #I1 #I2 #L1 #L2 #V #e #HL12 #IHL12 #J2 #K2 #W #s #i #H #_ >yplus_O1 + elim (ldrop_inv_O1_pair1 … H) -H * #Hi #HLK1 [ -IHL12 | -HL12 ] + [ #_ destruct -I2 >ypred_succ + /2 width=4 by ldrop_pair, ex2_2_intro/ + | lapply (ylt_inv_O1 i ?) /2 width=1 by ylt_inj/ + #H yminus_succ yplus_succ1 #H lapply (ylt_inv_succ … H) -H + #Hide lapply (ldrop_inv_drop1_lt … HLK2 ?) -HLK2 /2 width=1 by ylt_O/ + #HLK1 elim (IHL12 … HLK1) -IHL12 -HLK1 yminus_SO2 + /4 width=4 by ylt_O, ldrop_drop_lt, ex2_2_intro/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby_lsuby.ma b/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby_lsuby.ma new file mode 100644 index 000000000..c3b792c42 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/substitution/lsuby_lsuby.ma @@ -0,0 +1,32 @@ +(**************************************************************************) +(* ___ *) +(* ||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/lsuby.ma". + +(* LOCAL ENVIRONMENT REFINEMENT FOR EXTENDED SUBSTITUTION *******************) + +(* Main properties **********************************************************) + +theorem lsuby_trans: ∀d,e. Transitive … (lsuby d e). +#d #e #L1 #L2 #H elim H -L1 -L2 -d -e +[ #L1 #d #e #X #H lapply (lsuby_inv_atom1 … H) -H + #H destruct // +| #I1 #I2 #L1 #L #V1 #V #_ #IHL1 #X #H elim (lsuby_inv_zero1 … H) -H // + * #I2 #L2 #V2 #HL2 #H destruct /3 width=1 by lsuby_zero/ +| #I1 #I2 #L1 #L2 #V #e #_ #IHL1 #X #H elim (lsuby_inv_pair1 … H) -H // + * #I2 #L2 #HL2 #H destruct /3 width=1 by lsuby_pair/ +| #I1 #I2 #L1 #L2 #V1 #V2 #d #e #_ #IHL1 #X #H elim (lsuby_inv_succ1 … H) -H // + * #I2 #L2 #V2 #HL2 #H destruct /3 width=1 by lsuby_succ/ +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/unfold/unfold.ma b/matita/matita/contribs/lambdadelta/basic_2/unfold/unfold.ma index 4599cf038..17f6b1428 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/unfold/unfold.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/unfold/unfold.ma @@ -15,7 +15,7 @@ include "basic_2/notation/relations/unfold_4.ma". include "basic_2/grammar/lenv_append.ma". include "basic_2/grammar/genv.ma". -include "basic_2/relocation/ldrop.ma". +include "basic_2/substitution/ldrop.ma". (* CONTEXT-SENSITIVE UNFOLD FOR TERMS ***************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/web/basic_2_src.tbl b/matita/matita/contribs/lambdadelta/basic_2/web/basic_2_src.tbl index 40a36882b..525a89592 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/web/basic_2_src.tbl +++ b/matita/matita/contribs/lambdadelta/basic_2/web/basic_2_src.tbl @@ -208,7 +208,7 @@ table { } ] class "yellow" - [ { "substitution" * } { + [ { "multiple substitution" * } { [ { "lazy equivalence" * } { [ "fleq ( ⦃?,?,?⦄ ⋕[?] ⦃?,?,?⦄ )" "fleq_fleq" * ] [ "lleq ( ? ⋕[?,?] ? )" "lleq_alt" + "lleq_alt_rec" + "lleq_leq" + "lleq_ldrop" + "lleq_fqus" + "lleq_llor" + "lleq_lleq" * ] @@ -251,7 +251,7 @@ table { } ] class "orange" - [ { "relocation" * } { + [ { "substitution" * } { [ { "structural successor for closures" * } { [ "fquq ( ⦃?,?,?⦄ ⊐⸮ ⦃?,?,?⦄ )" "fquq_alt ( ⦃?,?,?⦄ ⊐⊐⸮ ⦃?,?,?⦄ )" * ] [ "fqu ( ⦃?,?,?⦄ ⊐ ⦃?,?,?⦄ )" * ] diff --git a/matita/matita/contribs/lambdadelta/ground_2/ynat/ynat_plus.ma b/matita/matita/contribs/lambdadelta/ground_2/ynat/ynat_plus.ma index 2428caa68..e8390c8dd 100644 --- a/matita/matita/contribs/lambdadelta/ground_2/ynat/ynat_plus.ma +++ b/matita/matita/contribs/lambdadelta/ground_2/ynat/ynat_plus.ma @@ -168,11 +168,17 @@ qed. (* Forward lemmas on minus **************************************************) -lemma yle_plus_to_minus_inj2: ∀x,z:ynat. ∀y:nat. x + y ≤ z → x ≤ z - y. +lemma yle_plus1_to_minus_inj2: ∀x,z:ynat. ∀y:nat. x + y ≤ z → x ≤ z - y. /2 width=1 by monotonic_yle_minus_dx/ qed-. -lemma yle_plus_to_minus_inj1: ∀x,z:ynat. ∀y:nat. y + x ≤ z → x ≤ z - y. -/2 width=1 by yle_plus_to_minus_inj2/ qed-. +lemma yle_plus1_to_minus_inj1: ∀x,z:ynat. ∀y:nat. y + x ≤ z → x ≤ z - y. +/2 width=1 by yle_plus1_to_minus_inj2/ qed-. + +lemma yle_plus2_to_minus_inj2: ∀x,y:ynat. ∀z:nat. x ≤ y + z → x - z ≤ y. +/2 width=1 by monotonic_yle_minus_dx/ qed-. + +lemma yle_plus2_to_minus_inj1: ∀x,y:ynat. ∀z:nat. x ≤ z + y → x - z ≤ y. +/2 width=1 by yle_plus2_to_minus_inj2/ qed-. lemma yplus_minus_assoc_inj: ∀x:nat. ∀y,z:ynat. x ≤ y → z + (y - x) = z + y - x. #x * @@ -191,7 +197,7 @@ qed-. (* Inversion lemmas on minus ************************************************) lemma yle_inv_plus_inj2: ∀x,z:ynat. ∀y:nat. x + y ≤ z → x ≤ z - y ∧ y ≤ z. -/3 width=3 by yle_plus_to_minus_inj2, yle_trans, conj/ qed-. +/3 width=3 by yle_plus1_to_minus_inj2, yle_trans, conj/ qed-. lemma yle_inv_plus_inj1: ∀x,z:ynat. ∀y:nat. y + x ≤ z → x ≤ z - y ∧ y ≤ z. /2 width=1 by yle_inv_plus_inj2/ qed-.