From: Ferruccio Guidi Date: Fri, 8 Mar 2013 13:33:29 +0000 (+0000) Subject: improved "big treee" computation allows to close a case in the X-Git-Tag: make_still_working~1232 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=7982e65abf88a2fbaa6422debb29121e4c884dd8;p=helm.git improved "big treee" computation allows to close a case in the preservation proof --- diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/ygt.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/ygt.ma index e5140a8e7..708c1a8c7 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/ygt.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/ygt.ma @@ -12,84 +12,84 @@ (* *) (**************************************************************************) -include "basic_2/unwind/sstas.ma". include "basic_2/reducibility/ysc.ma". -include "basic_2/computation/cprs.ma". +include "basic_2/computation/yprs.ma". -(* "BIG TREE" ORDER FOR CLOSURES ********************************************) +(* "BIG TREE" PROPER PARALLEL COMPUTATION FOR CLOSURES **********************) -definition ygt: ∀h. sd h → bi_relation lenv term ≝ - λh,g. bi_TC … (ysc h g). +inductive ygt (h) (g) (L1) (T1): relation2 lenv term ≝ +| ygt_inj : ∀L,L2,T,T2. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L, T⦄ → h ⊢ ⦃L, T⦄ ≻[g] ⦃L2, T2⦄ → + ygt h g L1 T1 L2 T2 +| ygt_step: ∀L,L2,T. ygt h g L1 T1 L T → L ➡ L2 → ygt h g L1 T1 L2 T +. -interpretation "'big tree' order (closure)" - 'BTGreaterThan h g L1 T1 L2 T2 = (ygt h g L1 T1 L2 T2). +interpretation "'big tree' proper parallel computation (closure)" + 'BTPRedStarProper h g L1 T1 L2 T2 = (ygt h g L1 T1 L2 T2). -(* Basic eliminators ********************************************************) +(* Basic forvard lemmas *****************************************************) -lemma ygt_ind: ∀h,g,L1,T1. ∀R:relation2 lenv term. - (∀L2,T2. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L2, T2⦄ → R L2 T2) → - (∀L,T,L2,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → h ⊢ ⦃L, T⦄ ≻[g] ⦃L2, T2⦄ → R L T → R L2 T2) → - ∀L2,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄ → R L2 T2. -#h #g #L1 #T1 #R #IH1 #IH2 #L2 #T2 #H -@(bi_TC_ind … IH1 IH2 L2 T2 H) -qed-. (**) (* /3 width=6 by bi_TC_ind/ fails *) - -lemma ygt_ind_dx: ∀h,g,L2,T2. ∀R:relation2 lenv term. - (∀L1,T1. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L2, T2⦄ → R L1 T1) → - (∀L1,L,T1,T. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L, T⦄ → h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → R L T → R L1 T1) → - ∀L1,T1. h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄ → R L1 T1. -/3 width=6 by bi_TC_ind_dx/ qed-. +lemma ygt_fwd_yprs: ∀h,g,L1,L2,T1,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄ → + h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +#h #g #L1 #L2 #T1 #T2 #H elim H -L2 -T2 +/3 width=4 by yprs_strap1, ysc_ypr, ypr_ltpr/ +qed-. (* Basic properties *********************************************************) -lemma ygt_strap1: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → - h ⊢ ⦃L, T⦄ ≻[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. -/2 width=4/ qed-. - -lemma ygt_strap2: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L, T⦄ → - h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. -/2 width=4/ qed-. +lemma ysc_ygt: ∀h,g,L1,L2,T1,T2. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L2, T2⦄ → + h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. +/3 width=4/ qed. -lemma ygt_cprs_trans: ∀h,g,L1,L,T1,T. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → - ∀T2. L ⊢ T ➡* T2 → h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T2⦄. -#h #g #L1 #L #T1 #T #HLT1 #T2 #H @(cprs_ind … H) -T2 // -#T0 #T2 #_ #HT02 #IHT0 -HLT1 -elim (term_eq_dec T0 T2) #HT02 destruct // -@(ygt_strap1 … IHT0) /3 width=1/ +lemma ygt_strap1: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → + h ⊢ ⦃L, T⦄ ≽[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. +#h #g #L1 #L #L2 #T1 #T #T2 #H1 #H2 +lapply (ygt_fwd_yprs … H1) #H0 +elim (ypr_inv_ysc … H2) -H2 [| * #HL2 #H destruct ] /2 width=4/ qed-. -lemma ygt_sstas_trans: ∀h,g,L1,L,T1,T. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → - ∀T2. ⦃h, L⦄ ⊢ T •*[g] T2 → h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T2⦄. -#h #g #L1 #L #T1 #T #HLT1 #T2 #H @(sstas_ind … H) -T2 // -#T0 #T2 #l #_ #HT02 #IHT0 -HLT1 -@(ygt_strap1 … IHT0) -IHT0 /2 width=2/ +lemma ygt_strap2: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L, T⦄ → + h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. +#h #g #L1 #L #L2 #T1 #T #T2 #H1 #H2 elim H2 -L2 -T2 +[ /3 width=4 by ygt_inj, yprs_strap2/ | /2 width=3/ ] qed-. -lemma cprs_ygt_trans: ∀h,g,L,T1,T. L ⊢ T1 ➡* T → - ∀L2,T2. h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → h ⊢ ⦃L, T1⦄ >[g] ⦃L2, T2⦄. -#h #g #L #T1 #T #H @(cprs_ind … H) -T // -#T0 #T #_ #HT0 #IHT10 #L2 #T2 #HLT2 -elim (term_eq_dec T0 T) #HT0 destruct /2 width=1/ -@IHT10 -IHT10 @(ygt_strap2 … HLT2) /3 width=1/ +lemma ygt_yprs_trans: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ >[g] ⦃L, T⦄ → + h ⊢ ⦃L, T⦄ ≥[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. +#h #g #L1 #L #L2 #T1 #T #T2 #HT1 #HT2 @(yprs_ind … HT2) -L2 -T2 // +/2 width=4 by ygt_strap1/ qed-. -lemma sstas_ygt_trans: ∀h,g,L,T1,T. ⦃h, L⦄ ⊢ T1 •*[g] T → - ∀L2,T2. h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → h ⊢ ⦃L, T1⦄ >[g] ⦃L2, T2⦄. -#h #g #L #T1 #T #H @(sstas_ind … H) -T // -#T0 #T #l #_ #HT0 #IHT10 #L2 #T2 #HLT2 -@IHT10 -IHT10 @(ygt_strap2 … HLT2) /2 width=2/ +lemma yprs_ygt_trans: ∀h,g,L1,L,T1,T. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L, T⦄ → + ∀L2,T2. h ⊢ ⦃L, T⦄ >[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. +#h #g #L1 #L #T1 #T #HT1 @(yprs_ind … HT1) -L -T // +/3 width=4 by ygt_strap2/ qed-. lemma fw_ygt: ∀h,g,L1,L2,T1,T2. ♯{L2, T2} < ♯{L1, T1} → h ⊢ ⦃L1, T1⦄ >[g] ⦃L2, T2⦄. /3 width=1/ qed. -lemma cprs_ygt: ∀h,g,L,T1,T2. L ⊢ T1 ➡* T2 → (T1 = T2 → ⊥) → h ⊢ ⦃L, T1⦄ >[g] ⦃L, T2⦄. +lemma cprs_ygt: ∀h,g,L,T1,T2. L ⊢ T1 ➡* T2 → (T1 = T2 → ⊥) → + h ⊢ ⦃L, T1⦄ >[g] ⦃L, T2⦄. #h #g #L #T1 #T2 #H @(cprs_ind … H) -T2 -[ #H elim H -H // -| #T #T2 #_ #HT2 #IHT1 #H - elim (term_eq_dec T1 T) #HT1 destruct - [ -IHT1 /4 width=1 by ysc_cpr, bi_inj/ (**) (* auto too slow without trace *) - | -H /4 width=3 by inj, ygt_cprs_trans/ +[ #H elim H // +| #T #T2 #_ #HT2 #IHT1 #HT12 + elim (term_eq_dec T1 T) #H destruct + [ -IHT1 /4 width=1/ + | lapply (IHT1 … H) -IHT1 -H -HT12 #HT1 + @(ygt_strap1 … HT1) -HT1 /2 width=1/ + ] +] +qed. + +lemma sstas_ygt: ∀h,g,L,T1,T2. ⦃h, L⦄ ⊢ T1 •*[g] T2 → (T1 = T2 → ⊥) → + h ⊢ ⦃L, T1⦄ >[g] ⦃L, T2⦄. +#h #g #L #T1 #T2 #H @(sstas_ind … H) -T2 +[ #H elim H // +| #T #T2 #l #_ #HT2 #IHT1 #HT12 -HT12 + elim (term_eq_dec T1 T) #H destruct + [ -IHT1 /3 width=2/ + | lapply (IHT1 … H) -IHT1 -H #HT1 + @(ygt_strap1 … HT1) -HT1 /2 width=2/ ] ] qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/ygt_ygt.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/ygt_ygt.ma index 0c2ae2995..31ab7a917 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/computation/ygt_ygt.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/ygt_ygt.ma @@ -16,5 +16,7 @@ include "basic_2/computation/ygt.ma". (* "BIG TREE" ORDER FOR CLOSURES ********************************************) +(* Main properties **********************************************************) + theorem ygt_trans: ∀h,g. bi_transitive … (ygt h g). -/2 width=4/ qed-. +/3 width=4 by ygt_fwd_yprs, ygt_yprs_trans/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/yprs.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/yprs.ma new file mode 100644 index 000000000..8b7e4cc98 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/yprs.ma @@ -0,0 +1,77 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/unwind/sstas.ma". +include "basic_2/reducibility/ypr.ma". +include "basic_2/computation/ltprs.ma". +include "basic_2/computation/cprs.ma". + +(* "BIG TREE" PARALLEL COMPUTATION FOR CLOSURES *****************************) + +definition yprs: ∀h. sd h → bi_relation lenv term ≝ + λh,g. bi_TC … (ypr h g). + +interpretation "'big tree' parallel computation (closure)" + 'BTPRedStar h g L1 T1 L2 T2 = (yprs h g L1 T1 L2 T2). + +(* Basic eliminators ********************************************************) + +lemma yprs_ind: ∀h,g,L1,T1. ∀R:relation2 lenv term. R L1 T1 → + (∀L,L2,T,T2. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L, T⦄ → h ⊢ ⦃L, T⦄ ≽[g] ⦃L2, T2⦄ → R L T → R L2 T2) → + ∀L2,T2. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄ → R L2 T2. +/3 width=7 by bi_TC_star_ind/ qed-. + +lemma yprs_ind_dx: ∀h,g,L2,T2. ∀R:relation2 lenv term. R L2 T2 → + (∀L1,L,T1,T. h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L, T⦄ → h ⊢ ⦃L, T⦄ ≥[g] ⦃L2, T2⦄ → R L T → R L1 T1) → + ∀L1,T1. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄ → R L1 T1. +/3 width=7 by bi_TC_star_ind_dx/ qed-. + +(* Basic properties *********************************************************) + +lemma yprs_refl: ∀h,g. bi_reflexive … (yprs h g). +/2 width=1/ qed. + +lemma ypr_yprs: ∀h,g,L1,L2,T1,T2. h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L2, T2⦄ → + h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +/2 width=1/ qed. + +lemma yprs_strap1: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L, T⦄ → + h ⊢ ⦃L, T⦄ ≽[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +/2 width=4/ qed-. + +lemma yprs_strap2: ∀h,g,L1,L,L2,T1,T,T2. h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L, T⦄ → + h ⊢ ⦃L, T⦄ ≥[g] ⦃L2, T2⦄ → h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +/2 width=4/ qed-. + +lemma fw_yprs: ∀h,g,L1,L2,T1,T2. ♯{L2, T2} < ♯{L1, T1} → + h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +/3 width=1/ qed. + +lemma cprs_yprs: ∀h,g,L,T1,T2. L ⊢ T1 ➡* T2 → h ⊢ ⦃L, T1⦄ ≥[g] ⦃L, T2⦄. +#h #g #L #T1 #T2 #H @(cprs_ind … H) -T2 // /3 width=4 by ypr_cpr, yprs_strap1/ +qed. + +lemma ltprs_yprs: ∀h,g,L1,L2,T. L1 ➡* L2 → h ⊢ ⦃L1, T⦄ ≥[g] ⦃L2, T⦄. +#h #g #L1 #L2 #T #H @(ltprs_ind … H) -L2 // /3 width=4 by ypr_ltpr, yprs_strap1/ +qed. + +lemma sstas_yprs: ∀h,g,L,T1,T2. ⦃h, L⦄ ⊢ T1 •*[g] T2 → + h ⊢ ⦃L, T1⦄ ≥[g] ⦃L, T2⦄. +#h #g #L #T1 #T2 #H @(sstas_ind … H) -T2 // /3 width=4 by ypr_ssta, yprs_strap1/ +qed. + +lemma ltpr_cprs_yprs: ∀h,g,L1,L2,T1,T2. L1 ➡ L2 → L2 ⊢ T1 ➡* T2 → + h ⊢ ⦃L1, T1⦄ ≥[g] ⦃L2, T2⦄. +/3 width=4 by yprs_strap2, ypr_ltpr, cprs_yprs/ +qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/computation/yprs_yprs.ma b/matita/matita/contribs/lambdadelta/basic_2/computation/yprs_yprs.ma new file mode 100644 index 000000000..4fd2d2a60 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/computation/yprs_yprs.ma @@ -0,0 +1,20 @@ +(**************************************************************************) +(* ___ *) +(* ||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/computation/yprs.ma". + +(* "BIG TREE" PARALLEL COMPUTATION FOR CLOSURES *****************************) + +theorem yprs_trans: ∀h,g. bi_transitive … (yprs h g). +/2 width=4/ qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_cpcs.ma b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_cpcs.ma index 7078c9f3e..7f325d41a 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_cpcs.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_cpcs.ma @@ -14,43 +14,28 @@ include "basic_2/static/ssta_ssta.ma". include "basic_2/computation/ygt.ma". +include "basic_2/equivalence/cpcs_ltpr.ma". include "basic_2/dynamic/snv_ltpss_dx.ma". include "basic_2/dynamic/snv_sstas.ma". (* STRATIFIED NATIVE VALIDITY FOR TERMS *************************************) (* Inductive premises for the preservation results **************************) -(* -definition IH_snv_dxprs: ∀h:sh. sd h → relation2 lenv term ≝ - λh,g,L1,T1. ⦃h, L1⦄ ⊩ T1 :[g] → - ∀L2. L1 ➡ L2 → ∀T2. ⦃h, L2⦄ ⊢ T1 •*➡*[g] T2 → ⦃h, L2⦄ ⊩ T2 :[g]. -*) -definition IH_ssta_ltpr_tpr: ∀h:sh. sd h → relation2 lenv term ≝ - λh,g,L1,T1. ⦃h, L1⦄ ⊩ T1 :[g] → - ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → - ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → - ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & L1 ⊢ U1 ⬌* U2. definition IH_snv_ltpr_tpr: ∀h:sh. sd h → relation2 lenv term ≝ λh,g,L1,T1. ⦃h, L1⦄ ⊩ T1 :[g] → ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → ⦃h, L2⦄ ⊩ T2 :[g]. +definition IH_ssta_ltpr_tpr: ∀h:sh. sd h → relation2 lenv term ≝ + λh,g,L1,T1. ⦃h, L1⦄ ⊩ T1 :[g] → + ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → + ∀L2. L1 ➡ L2 → ∀T2. T1 ➡ T2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & L2 ⊢ U1 ⬌* U2. + definition IH_snv_ssta: ∀h:sh. sd h → relation2 lenv term ≝ λh,g,L1,T1. ⦃h, L1⦄ ⊩ T1 :[g] → ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l + 1] U1 → ⦃h, L1⦄ ⊩ U1 :[g]. -fact ssta_ltpr_cpr_aux: ∀h,g,L1,T1. IH_ssta_ltpr_tpr h g L1 T1 → - ⦃h, L1⦄ ⊩ T1 :[g] → - ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → - ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡ T2 → - ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & L1 ⊢ U1 ⬌* U2. -#h #g #L1 #T1 #IH #HT1 #U1 #l #HTU1 #L2 #HL12 #T2 * #T #HT1T #HTT2 -elim (IH … HTU1 … HL12 … HT1T) // -T1 #U #HTU #HU1 -elim (ssta_tpss_conf … HTU … HTT2) -T #U2 #HTU2 #HU2 -lapply (ltpr_cpr_trans … HL12 U U2 ?) -HL12 /2 width=3/ -HU2 #HU2 -lapply (cpcs_cprs_strap1 … HU1 … HU2) -U /2 width=3/ -qed-. - fact snv_ltpr_cpr_aux: ∀h,g,L1,T1. IH_snv_ltpr_tpr h g L1 T1 → ⦃h, L1⦄ ⊩ T1 :[g] → ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡ T2 → ⦃h, L2⦄ ⊩ T2 :[g]. @@ -59,44 +44,56 @@ lapply (IH … HL12 … HT1T) -HL12 // -T1 #HT0 lapply (snv_tpss_conf … HT0 … HTT2) -T // qed-. -fact snv_cprs_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → - ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → - ∀T2. L1 ⊢ T1 ➡* T2 → ⦃h, L1⦄ ⊩ T2 :[g]. -#h #g #L0 #T0 #IH #L1 #T1 #HLT0 #HT1 #T2 #H -@(cprs_ind … H) -T2 // -HT1 -/4 width=6 by snv_ltpr_cpr_aux, ygt_cprs_trans/ +fact ssta_ltpr_cpr_aux: ∀h,g,L1,T1. IH_ssta_ltpr_tpr h g L1 T1 → + ⦃h, L1⦄ ⊩ T1 :[g] → + ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → + ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡ T2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & L2 ⊢ U1 ⬌* U2. +#h #g #L1 #T1 #IH #HT1 #U1 #l #HTU1 #L2 #HL12 #T2 * #T #HT1T #HTT2 +elim (IH … HTU1 … HL12 … HT1T) // -L1 -T1 #U #HTU #HU1 +elim (ssta_tpss_conf … HTU … HTT2) -T #U2 #HTU2 #HU2 +lapply (cpcs_cpr_strap1 … HU1 U2 ?) /2 width=3/ +qed-. + +fact snv_ltpr_cprs_aux: ∀h,g,L0,T0. + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → + ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → + ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡* T2 → ⦃h, L2⦄ ⊩ T2 :[g]. +#h #g #L0 #T0 #IH #L1 #T1 #HLT0 #HT1 #L2 #HL12 #T2 #H +@(cprs_ind … H) -T2 [ /2 width=6 by snv_ltpr_cpr_aux/ ] -HT1 +/5 width=6 by snv_ltpr_cpr_aux, ygt_yprs_trans, ltpr_cprs_yprs/ qed-. -fact ssta_cprs_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → - ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → - ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → ∀T2. L1 ⊢ T1 ➡* T2 → - ∃∃U2. ⦃h, L1⦄ ⊢ T2 •[g, l] U2 & L1 ⊢ U1 ⬌* U2. -#h #g #L0 #T0 #IH2 #IH1 #L1 #T1 #H01 #HT1 #U1 #l #HTU1 #T2 #H -@(cprs_ind … H) -T2 [ /2 width=3/ ] -#T #T2 #HT1T #HTT2 * #U #HTU #HU1 +fact ssta_ltpr_cprs_aux: ∀h,g,L0,T0. + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → + ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → + ∀U1,l. ⦃h, L1⦄ ⊢ T1 •[g, l] U1 → + ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡* T2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •[g, l] U2 & L2 ⊢ U1 ⬌* U2. +#h #g #L0 #T0 #IH2 #IH1 #L1 #T1 #H01 #HT1 #U1 #l #HTU1 #L2 #HL12 #T2 #H +@(cprs_ind … H) -T2 [ /2 width=7 by ssta_ltpr_cpr_aux/ ] +#T #T2 #HT1T #HTT2 * #U #HTU #HU1 elim (ssta_ltpr_cpr_aux … HTU … HTT2) // -[2: /3 width=7 by snv_cprs_aux, ygt_cprs_trans/ -|3: /3 width=3 by ygt_cprs_trans/ -] -L0 -T0 -T1 -T #U2 #HTU2 #HU2 +[2: /3 width=9 by snv_ltpr_cprs_aux/ +|3: /5 width=6 by ygt_yprs_trans, ltpr_cprs_yprs/ +] -L0 -L1 -T0 -T1 -T #U2 #HTU2 #HU2 lapply (cpcs_trans … HU1 … HU2) -U /2 width=3/ qed-. -fact ssta_cpcs_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → - ∀L,T1,T2. h ⊢ ⦃L0, T0⦄ >[g] ⦃L, T1⦄ → h ⊢ ⦃L0, T0⦄ >[g] ⦃L, T2⦄ → - ⦃h, L⦄ ⊩ T1 :[g] → ⦃h, L⦄ ⊩ T2 :[g] → - ∀U1,l1. ⦃h, L⦄ ⊢ T1 •[g, l1] U1 → - ∀U2,l2. ⦃h, L⦄ ⊢ T2 •[g, l2] U2 → - L ⊢ T1 ⬌* T2 → - l1 = l2 ∧ L ⊢ U1 ⬌* U2. -#h #g #L0 #T0 #IH2 #IH1 #L #T1 #T2 #HLT01 #HLT02 #HT1 #HT2 #U1 #l1 #HTU1 #U2 #l2 #HTU2 #H +fact ssta_ltpr_cpcs_aux: ∀h,g,L0,T0. + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → + ∀L1,L2,T1,T2. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → h ⊢ ⦃L0, T0⦄ >[g] ⦃L2, T2⦄ → + ⦃h, L1⦄ ⊩ T1 :[g] → ⦃h, L2⦄ ⊩ T2 :[g] → + ∀U1,l1. ⦃h, L1⦄ ⊢ T1 •[g, l1] U1 → + ∀U2,l2. ⦃h, L2⦄ ⊢ T2 •[g, l2] U2 → + L1 ➡ L2 → L2 ⊢ T1 ⬌* T2 → + l1 = l2 ∧ L2 ⊢ U1 ⬌* U2. +#h #g #L0 #T0 #IH2 #IH1 #L1 #L2 #T1 #T2 #HLT01 #HLT02 #HT1 #HT2 #U1 #l1 #HTU1 #U2 #l2 #HTU2 #HL12 #H elim (cpcs_inv_cprs … H) -H #T #H1 #H2 -elim (ssta_cprs_aux … HLT01 HT1 … HTU1 … H1) -T1 /2 width=1/ #W1 #H1 #HUW1 -elim (ssta_cprs_aux … HLT02 HT2 … HTU2 … H2) -T2 /2 width=1/ #W2 #H2 #HUW2 -L0 -T0 +elim (ssta_ltpr_cprs_aux … HLT01 HT1 … HTU1 … H1) -T1 /2 width=1/ #W1 #H1 #HUW1 +elim (ssta_ltpr_cprs_aux … HLT02 HT2 … HTU2 … H2) -T2 /2 width=1/ #W2 #H2 #HUW2 -L1 -L0 -T0 elim (ssta_mono … H1 … H2) -h -T #H1 #H2 destruct lapply (cpcs_canc_dx … HUW1 … HUW2) -W2 /2 width=1/ qed-. @@ -106,55 +103,43 @@ fact snv_sstas_aux: ∀h,g,L0,T0. ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → ∀U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 → ⦃h, L1⦄ ⊩ U1 :[g]. #h #g #L0 #T0 #IH #L1 #T1 #HLT0 #HT1 #U1 #H -@(sstas_ind … H) -U1 // -HT1 /3 width=5 by ygt_sstas_trans/ +@(sstas_ind … H) -U1 // -HT1 /4 width=5 by ygt_yprs_trans, sstas_yprs/ qed-. -fact sstas_cprs_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → - ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → - ∀T2. L1 ⊢ T1 ➡* T2 → ∀U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 → - ∃∃U2. ⦃h, L1⦄ ⊢ T2 •*[g] U2 & L1 ⊢ U1 ⬌* U2. -#h #g #L0 #T0 #IH3 #IH2 #IH1 #L1 #T1 #H01 #HT1 #T2 #HT12 #U1 #H +fact sstas_ltpr_cprs_aux: ∀h,g,L0,T0. + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → + ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → + ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡* T2 → ∀U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •*[g] U2 & L2 ⊢ U1 ⬌* U2. +#h #g #L0 #T0 #IH3 #IH2 #IH1 #L1 #T1 #H01 #HT1 #L2 #HL12 #T2 #HT12 #U1 #H @(sstas_ind … H) -U1 [ /3 width=3/ ] #U1 #W1 #l1 #HTU1 #HUW1 * #U2 #HTU2 #HU12 -lapply (snv_cprs_aux … IH2 … HT1 … HT12) // #HT2 +lapply (snv_ltpr_cprs_aux … IH2 … HT1 … HT12) // #HT2 elim (snv_sstas_fwd_correct … HTU2) // #W2 #l2 #HUW2 -elim (ssta_cpcs_aux … IH2 IH1 … HUW1 … HUW2 … HU12) -IH2 -IH1 -HUW1 -HU12 -[2,3: /3 width=7 by snv_sstas_aux, ygt_cprs_trans/ -|4,5: /3 width=3 by ygt_sstas_trans, ygt_cprs_trans/ +elim (ssta_ltpr_cpcs_aux … IH2 IH1 … HUW1 … HUW2 … HU12) -IH2 -IH1 -HUW1 -HU12 // +[2: /4 width=8 by snv_sstas_aux, ygt_yprs_trans, ltpr_cprs_yprs/ +|3: /3 width=7 by snv_sstas_aux, ygt_yprs_trans, cprs_yprs/ +|4: /4 width=5 by ygt_yprs_trans, ltpr_cprs_yprs, sstas_yprs/ +|5: /3 width=4 by ygt_yprs_trans, cprs_yprs, sstas_yprs/ ] -L0 -T0 -T1 -HT2 #H #HW12 destruct /3 width=4/ qed-. -fact dxprs_cprs_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → - ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → - ∀T2. L1 ⊢ T1 ➡* T2 → ∀U1. ⦃h, L1⦄ ⊢ T1 •*➡*[g] U1 → - ∃∃U2. ⦃h, L1⦄ ⊢ T2 •*➡*[g] U2 & L1 ⊢ U1 ➡* U2. -#h #g #L0 #T0 #IH3 #IH2 #IH1 #L1 #T1 #H01 #HT1 #T2 #HT12 #U1 * #W1 #HTW1 #HWU1 -elim (sstas_cprs_aux … IH3 IH2 IH1 … H01 … HT12 … HTW1) // -L0 -T0 -T1 #W2 #HTW2 #HW12 -lapply (cpcs_cprs_conf … HWU1 … HW12) -W1 #H +fact dxprs_ltpr_cprs_aux: ∀h,g,L0,T0. + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ltpr_tpr h g L1 T1) → + (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → + ∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → ⦃h, L1⦄ ⊩ T1 :[g] → + ∀U1. ⦃h, L1⦄ ⊢ T1 •*➡*[g] U1 → + ∀L2. L1 ➡ L2 → ∀T2. L2 ⊢ T1 ➡* T2 → + ∃∃U2. ⦃h, L2⦄ ⊢ T2 •*➡*[g] U2 & L2 ⊢ U1 ➡* U2. +#h #g #L0 #T0 #IH3 #IH2 #IH1 #L1 #T1 #H01 #HT1 #U1 * #W1 #HTW1 #HWU1 #L2 #HL12 #T2 #HT12 +elim (sstas_ltpr_cprs_aux … IH3 IH2 IH1 … H01 … HT12 … HTW1) // -L0 -T0 -T1 #W2 #HTW2 #HW12 +lapply (ltpr_cprs_conf … HL12 … HWU1) -L1 #HWU1 +lapply (cpcs_canc_sn … HW12 HWU1) -W1 #H elim (cpcs_inv_cprs … H) -H /3 width=3/ qed-. - -fact sstas_ltpr_aux: ∀h,g,L0,T0. - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → - (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_ssta_ltpr_tpr h g L1 T1) → - ∀L1,T. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T⦄ → ⦃h, L1⦄ ⊩ T :[g] → - ∀L2. L1 ➡ L2 → ∀U1. ⦃h, L1⦄ ⊢ T •*[g] U1 → - ∃∃U2. ⦃h, L2⦄ ⊢ T •*[g] U2 & L1 ⊢ U1 ⬌* U2. -#h #g #L0 #T0 #IH2 #IH1 #L1 #T #H01 #HT #L2 #HL12 #U1 #H -@(sstas_ind … H) -U1 [ /4 width=3/ ] -#W1 #U1 #l1 #HTW1 #HWU1 * #W2 #HTW2 #HW12 -lapply (snv_sstas_aux … IH2 … HTW1) // -IH2 -HT #HW1 - -(* -elim (IH1 … HWU1 … HL12 W1) // -IH1 -HW1 -HWU1 -HL12 -[2: /2 width=3 by ygt_sstas_trans/ ] #U2 -*) (* fact sstas_dxprs_aux: ∀h,g,L0,T0. (∀L1,T1. h ⊢ ⦃L0, T0⦄ >[g] ⦃L1, T1⦄ → IH_snv_ssta h g L1 T1) → @@ -164,4 +149,4 @@ fact sstas_dxprs_aux: ∀h,g,L0,T0. ∀U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 → ∀T2. ⦃h, L1⦄ ⊢ T1 •*➡*[g] T2 → ∃∃U2. ⦃h, L1⦄ ⊢ T2 •*[g] U2 & L1 ⊢ U1 ⬌* U2. #h #g #L0 #T0 #IH3 #IH2 #IH1 #L1 #T1 #H01 #HT1 #U1 #HTU1 #T2 * #T #HT1T #HTT2 -*) \ No newline at end of file +*) diff --git a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma index 04f7dcb4c..5b4df6be5 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ltpr.ma @@ -12,6 +12,7 @@ (* *) (**************************************************************************) +include "basic_2/computation/dxprs_dxprs.ma". include "basic_2/dynamic/snv_cpcs.ma". (* STRATIFIED NATIVE VALIDITY FOR TERMS *************************************) @@ -54,11 +55,10 @@ fact snv_ltpr_tpr_aux: ∀h,g,L0,T0. lapply (IH1 … HV1 … HL12 … HV12) [ /2 width=1/ ] #HV2 lapply (IH1 … HT1 … HL12 … HT12) [ /2 width=1/ ] #HT2 elim (IH3 … HVW1 … HL12 … HV12) -HVW1 -HV12 // -HV1 [2: /2 width=1/ ] #W2 #HVW2 #HW12 - lapply (cpcs_cprs_conf … HW10 … HW12) -W10 #HW12 - elim (dxprs_cprs_aux … IH2 IH1 IH3 … T2 … HTU1) // [2: /3 width=1/ |3: /2 width=1/ ] -IH2 -IH1 -IH3 -HT1 -HT12 -HTU1 #U2 #HTU2 #HU12 - @(snv_appl … HV2 HT2 HVW2) -(* - lapply (IH1 … HT1 … HTU1) -IH1 // #H - elim (snv_inv_bind … H) -H #HW1 #HU1 - elim (IH2 … HVW1 … HL12 … HV12 HV1) -IH2 -HVW1 -HV12 -HV1 // #W2 #HVW2 #HW12 -*) + elim (dxprs_ltpr_cprs_aux … IH2 IH1 IH3 … HTU1 … HL12 T2) // [2: /3 width=1/ |3: /2 width=1/ ] -IH2 -IH1 -IH3 -HT1 -HT12 -HTU1 #X #HTU2 #H + elim (cprs_inv_abst1 Abst W1 … H) -H #W20 #U2 #HW120 #_ #H destruct + lapply (ltpr_cprs_conf … HL12 … HW10) -L1 #HW10 + lapply (cpcs_cprs_strap1 … HW10 … HW120) -W1 #HW120 + lapply (cpcs_canc_sn … HW12 HW120) -W10 #HW20 + elim (cpcs_inv_cprs … HW20) -HW20 #W0 #HW20 #HW200 + lapply (dxprs_cprs_trans … (ⓛ{a}W0.U2) HTU2 ?) [ /2 width=1/ ] -HW200 /2 width=8/ diff --git a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ssta_ltpr.ma b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ssta_ltpr.ma index 5ee41883b..a82640426 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ssta_ltpr.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/dynamic/snv_ssta_ltpr.ma @@ -12,7 +12,6 @@ (* *) (**************************************************************************) -include "basic_2/equivalence/cpcs_ltpr.ma". include "basic_2/equivalence/lsubse_ssta.ma". include "basic_2/dynamic/snv_cpcs.ma". @@ -36,12 +35,12 @@ fact ssta_ltpr_tpr_aux: ∀h,g,L0,T0. [ #V1 #W1 #HLK1 #HVW1 #HWU1 lapply (ldrop_mono … H … HLK1) -H #H destruct lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) #HKV1 - elim (ltpr_ldrop_conf … HLK1 … HL12) #X #H #HLK2 + elim (ltpr_ldrop_conf … HLK1 … HL12) -HLK1 -HL12 #X #H #HLK2 elim (ltpr_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct - elim (IH1 … HVW1 … HK12 … HV12) -IH1 -HVW1 -HV12 // [2: /2 width=1/ ] -HV1 -HKV1 #W2 #HVW2 #HW12 - lapply (ldrop_fwd_ldrop2 … HLK1) -V1 #H1 + elim (IH1 … HVW1 … HK12 … HV12) -IH1 -HVW1 -HV12 // [2: /2 width=1/ ] -V1 #W2 #HVW2 #HW12 + lapply (ldrop_fwd_ldrop2 … HLK2) #H2 elim (lift_total W2 0 (i+1)) #U2 #HWU2 - lapply (cpcs_lift … H1 … HWU1 … HWU2 HW12) -H1 -W1 /3 width=6/ + lapply (cpcs_lift … H2 … HWU1 … HWU2 HW12) -H2 -W1 /3 width=6/ | #V1 #W1 #l0 #HLK1 #HVW1 #HVU1 #H destruct lapply (ldrop_mono … H … HLK1) -H #H destruct lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) #HKV1 @@ -61,7 +60,7 @@ fact ssta_ltpr_tpr_aux: ∀h,g,L0,T0. lapply (tps_lsubs_trans … HT02 (L2.ⓑ{I}V2) ?) -HT02 [ /2 width=1/ ] #HT02 elim (ssta_ltpr_cpr_aux … HT1 … HTU1 (L2.ⓑ{I}V2) … T2) -HT1 -HTU1 [2: /3 width=5 by cpr_intro, tps_tpss/ |3: /2 width=1/ |4: /3 width=1/ ] -IH1 -T0 -HL12 #U2 #HTU2 #HU12 - lapply (cpcs_bind1 … HU12 … V2 … a) -HU12 [ /2 width=1/ ] -HV12 /3 width=3/ + lapply (cpcs_bind2 … V1 … HU12 … a) -HU12 [ /2 width=1/ ] -HV12 /3 width=3/ | #T2 #HT12 #HT2 #H1 #H2 destruct elim (IH1 … HTU1 (L2.ⓓV1) … T2) -IH1 -HTU1 // [2,3: /2 width=1/ ] -T1 -HL12 #U2 #HTU2 #HU12 lapply (cpcs_bind1 … HU12 … V1 … true) // -HU12 #HU12 @@ -83,26 +82,25 @@ fact ssta_ltpr_tpr_aux: ∀h,g,L0,T0. elim (ssta_fwd_correct … HVW1) break [ term 46 g ] break ⦃ term 46 L2 , break term 46 T2 ⦄ )" non associative with precedence 45 - for @{ 'BTGreaterThan $h $g $L1 $T1 $L2 $T2 }. + for @{ 'BTPRedStarProper $h $g $L1 $T1 $L2 $T2 }. (* Conversion ***************************************************************) diff --git a/matita/matita/contribs/lambdadelta/basic_2/reducibility/ypr.ma b/matita/matita/contribs/lambdadelta/basic_2/reducibility/ypr.ma new file mode 100644 index 000000000..4b4122549 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/reducibility/ypr.ma @@ -0,0 +1,35 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basic_2/static/ssta.ma". +include "basic_2/reducibility/ltpr.ma". +include "basic_2/reducibility/cpr.ma". + +(* "BIG TREE" PARALLEL REDUCTION FOR CLOSURES *******************************) + +inductive ypr (h) (g) (L1) (T1): relation2 lenv term ≝ +| ypr_fw : ∀L2,T2. ♯{L2, T2} < ♯{L1, T1} → ypr h g L1 T1 L2 T2 +| ypr_ltpr: ∀L2. L1 ➡ L2 → ypr h g L1 T1 L2 T1 +| ypr_cpr : ∀T2. L1 ⊢ T1 ➡ T2 → ypr h g L1 T1 L1 T2 +| ypr_ssta: ∀T2,l. ⦃h, L1⦄ ⊢ T1 •[g, l + 1] T2 → ypr h g L1 T1 L1 T2 +. + +interpretation + "'big tree' parallel reduction (closure)" + 'BTPRed h g L1 T1 L2 T2 = (ypr h g L1 T1 L2 T2). + +(* Basic properties *********************************************************) + +lemma ypr_refl: ∀h,g. bi_reflexive … (ypr h g). +/2 width=1/ qed. diff --git a/matita/matita/contribs/lambdadelta/basic_2/reducibility/ysc.ma b/matita/matita/contribs/lambdadelta/basic_2/reducibility/ysc.ma index 8762efb02..e0aa31061 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/reducibility/ysc.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/reducibility/ysc.ma @@ -12,10 +12,9 @@ (* *) (**************************************************************************) -include "basic_2/static/ssta.ma". -include "basic_2/reducibility/cpr.ma". +include "basic_2/reducibility/ypr.ma". -(* "BIG TREE" SUCCESSOR ON CLOSURES *****************************************) +(* "BIG TREE" PROPER PARALLEL REDUCTION FOR CLOSURES ************************) inductive ysc (h) (g) (L1) (T1): relation2 lenv term ≝ | ysc_fw : ∀L2,T2. ♯{L2, T2} < ♯{L1, T1} → ysc h g L1 T1 L2 T2 @@ -24,5 +23,20 @@ inductive ysc (h) (g) (L1) (T1): relation2 lenv term ≝ . interpretation - "'big tree' successor (closure)" - 'BTSuccessor h g L1 T1 L2 T2 = (ysc h g L1 T1 L2 T2). + "'big tree' proper parallel reduction (closure)" + 'BTPRedProper h g L1 T1 L2 T2 = (ysc h g L1 T1 L2 T2). + +(* Basic properties *********************************************************) + +lemma ysc_ypr: ∀h,g,L1,L2,T1,T2. h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L2, T2⦄ → + h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L2, T2⦄. +#h #g #L1 #L2 #T1 #T2 * -L2 -T2 /2 width=1/ /2 width=2/ +qed. + +(* Inversion lemmas on "big tree" parallel reduction for closures ***********) + +lemma ypr_inv_ysc: ∀h,g,L1,L2,T1,T2. h ⊢ ⦃L1, T1⦄ ≽[g] ⦃L2, T2⦄ → + h ⊢ ⦃L1, T1⦄ ≻[g] ⦃L2, T2⦄ ∨ (L1 ➡ L2 ∧ T1 = T2). +#h #g #L1 #L2 #T1 #T2 * -L2 -T2 /3 width=1/ /3 width=2/ +#T2 #HT12 elim (term_eq_dec T1 T2) #H destruct /3 width=1/ /4 width=1/ +qed-.