definition lpx_sn_confluent: relation (lenv→relation term) ≝ λR1,R2.
∀L0,T0,T1. R1 L0 T0 T1 → ∀T2. R2 L0 T0 T2 →
∀L1. lpx_sn R1 L0 L1 → ∀L2. lpx_sn R2 L0 L2 →
- ∃∃T. R1 L1 T1 T & R2 L2 T2 T.
+ ∃∃T. R2 L1 T1 T & R1 L2 T2 T.
definition lpx_sn_transitive: relation (lenv→relation term) ≝ λR1,R2.
∀L1,T1,T. R1 L1 T1 T → ∀L2. lpx_sn R1 L1 L2 →
elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL2 #HV2 #H destruct /3 width=5/
qed-.
-lemma lpx_sn_conf: ∀R. lpx_sn_confluent R R → confluent … (lpx_sn R).
-#R #HR #L0 @(f_ind … length … L0) -L0 #n #IH *
+lemma lpx_sn_conf: ∀R1,R2. lpx_sn_confluent R1 R2 →
+ confluent2 … (lpx_sn R1) (lpx_sn R2).
+#R1 #R2 #HR12 #L0 @(f_ind … length … L0) -L0 #n #IH *
[ #_ #X1 #H1 #X2 #H2 -n
>(lpx_sn_inv_atom1 … H1) -X1
>(lpx_sn_inv_atom1 … H2) -X2 /2 width=3/
elim (lpx_sn_inv_pair1 … H1) -H1 #L1 #V1 #HL01 #HV01 #H destruct
elim (lpx_sn_inv_pair1 … H2) -H2 #L2 #V2 #HL02 #HV02 #H destruct
elim (IH … HL01 … HL02) -IH normalize // #L #HL1 #HL2
- elim (HR … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5/
+ elim (HR12 … HV01 … HV02 … HL01 … HL02) -L0 -V0 /3 width=5/
]
qed-.
non associative with precedence 55
for @{ 'SnItem2 $I $T1 $T }.
-notation "hvbox( ⓑ { term 46 a , term 46 I } break term 55 T1 . break term 55 T )"
+notation "hvbox( ⓑ { term 46 a , break term 46 I } break term 55 T1 . break term 55 T )"
non associative with precedence 55
for @{ 'SnBind2 $a $I $T1 $T }.
non associative with precedence 55
for @{ 'SnFlat2 $I $T1 $T }.
-notation "hvbox( ⓓ { term 46 a } term 55 T1 . break term 55 T2 )"
+notation "hvbox( ⓓ { term 46 a } break term 55 T1 . break term 55 T2 )"
non associative with precedence 55
for @{ 'SnAbbr $a $T1 $T2 }.
non associative with precedence 55
for @{ 'SnAbbrNeg $T1 $T2 }.
-notation "hvbox( ⓛ { term 46 a } term 55 T1 . break term 55 T2 )"
+notation "hvbox( ⓛ { term 46 a } break term 55 T1 . break term 55 T2 )"
non associative with precedence 55
for @{ 'SnAbst $a $T1 $T2 }.
non associative with precedence 45
for @{ 'Iso $T1 $T2 }.
-(* Substitution *************************************************************)
+(* Relocation ***************************************************************)
notation "hvbox( ⇧ [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )"
non associative with precedence 45
non associative with precedence 45
for @{ 'ICM $L $T $k }.
-(* Unfold *******************************************************************)
+(* Substitution *************************************************************)
notation "hvbox( @ ⦃ term 46 T1 , break term 46 f ⦄ ≡ break term 46 T2 )"
non associative with precedence 45
non associative with precedence 45
for @{ 'PSubstStarSn $T1 $T2 }.
-notation "hvbox( ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )"
- non associative with precedence 45
- for @{ 'TSubst $T1 $d $e $T2 }.
-
-notation "hvbox( L ⊢ break ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )"
- non associative with precedence 45
- for @{ 'TSubst $L $T1 $d $e $T2 }.
-
-notation "hvbox( ▼ ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )"
- non associative with precedence 45
- for @{ 'TSubstAlt $T1 $d $e $T2 }.
-
-notation "hvbox( L ⊢ break ▼ ▼ * [ term 46 d , break term 46 e ] break term 46 T1 ≡ break term 46 T2 )"
- non associative with precedence 45
- for @{ 'TSubstAlt $L $T1 $d $e $T2 }.
-
(* Static typing ************************************************************)
notation "hvbox( L ⊢ break term 46 T ⁝ break term 46 A )"
non associative with precedence 45
for @{ 'StaticType $h $g $L $T1 $T2 $l }.
-(* Unwind *******************************************************************)
+(* Unfold *******************************************************************)
notation "hvbox( ⦃ term 46 h , break term 46 L ⦄ ⊢ break term 46 T1 •* break [ term 46 g ] break term 46 T2 )"
non associative with precedence 45
notation "hvbox( L1 ⊢ ⧫ * break term 46 T ≡ break term 46 L2 )"
non associative with precedence 45
- for @{ 'Unwind $L1 $T $L2 }.
-
-(* Restricted ***************************************************************)
+ for @{ 'Unfold $L1 $T $L2 }.
notation "hvbox( L ⊢ break term 46 T1 ➤ * break term 46 T2 )"
non associative with precedence 45
non associative with precedence 45
for @{ 'PRestStarSn $T1 $T2 }.
-(* Reducibility *************************************************************)
+(* Reduction ****************************************************************)
notation "hvbox( L ⊢ break 𝐑 ⦃ term 46 T ⦄ )"
non associative with precedence 45
non associative with precedence 45
for @{ 'PRedSn $L1 $L2 }.
-notation "hvbox( L1 ⊢ ➡ ➡ break term 46 L2 )"
- non associative with precedence 45
- for @{ 'PRedSnAlt $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1, break term 46 T1 ⦄ ➡ break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRed $L1 $T1 $L2 $T2 }.
-
-notation "hvbox( L ⊢ break ⦃ term 46 L1, break term 46 T1 ⦄ ➡ break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRed $L $L1 $T1 $L2 $T2 }.
-
(* Computation **************************************************************)
-notation "hvbox( T1 ➡ * break term 46 T2 )"
- non associative with precedence 45
- for @{ 'PRedStar $T1 $T2 }.
-
notation "hvbox( L ⊢ break term 46 T1 ➡ * break term 46 T2 )"
non associative with precedence 45
for @{ 'PRedStar $L $T1 $T2 }.
-notation "hvbox( T1 ➡ ➡ * break term 46 T2 )"
+notation "hvbox( L1 ⊢ ➡* break term 46 L2 )"
non associative with precedence 45
- for @{ 'PRedStarAlt $T1 $T2 }.
-
-notation "hvbox( ⦃ term 46 L1 ⦄ ➡ * break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRedStar $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , term 46 T1 ⦄ ➡ * break ⦃ term 46 L2 , term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRedStar $L1 $T1 $L2 $T2 }.
-
-notation "hvbox( ⦃ term 46 L1 ⦄ ➡ ➡ * break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRedStarAlt $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , term 46 T1 ⦄ ➡ ➡ * break ⦃ term 46 L2 , term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPRedStarAlt $L1 $T1 $L2 $T2 }.
+ for @{ 'PRedSnStar $L1 $L2 }.
notation "hvbox( L ⊢ break term 46 T1 ➡ * break 𝐍 ⦃ term 46 T2 ⦄ )"
non associative with precedence 45
non associative with precedence 45
for @{ 'PConv $L $T1 $T2 }.
-notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConv $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
+notation "hvbox( L1 ⊢ ⬌ break term 46 L2 )"
non associative with precedence 45
- for @{ 'FocalizedPConv $L1 $T1 $L2 $T2 }.
-
-notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ ⬌ break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConvAlt $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ ⬌ break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConvAlt $L1 $T1 $L2 $T2 }.
+ for @{ 'PConvSn $L1 $L2 }.
(* Equivalence **************************************************************)
non associative with precedence 45
for @{ 'CrSubEqS $h $g $L1 $L2 }.
-notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ * break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConvStar $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ * break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConvStar $L1 $T1 $L2 $T2 }.
-
-notation "hvbox( ⦃ term 46 L1 ⦄ ⬌ ⬌ * break ⦃ term 46 L2 ⦄ )"
- non associative with precedence 45
- for @{ 'FocalizedPConvStarAlt $L1 $L2 }.
-
-notation "hvbox( ⦃ term 46 L1 , break term 46 T1 ⦄ ⬌ ⬌ * break ⦃ term 46 L2 , break term 46 T2 ⦄ )"
+notation "hvbox( L1 ⊢ ⬌* break term 46 L2 )"
non associative with precedence 45
- for @{ 'FocalizedPConvStarAlt $L1 $T1 $L2 $T2 }.
+ for @{ 'PConvSnStar $L1 $L2 }.
(* Dynamic typing ***********************************************************)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop.ma".
+
+(* SUPCLOSURE ***************************************************************)
+
+inductive fsup: bi_relation lenv term ≝
+| fsup_lref : ∀I,L,V. fsup (L.ⓑ{I}V) (#0) L V
+| fsup_bind_sn: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) L V
+| fsup_bind_dx: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) (L.ⓑ{I}V) T
+| fsup_flat_sn: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L V
+| fsup_flat_dx: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L T
+| fsup_ldrop : ∀L1,K1,K2,T1,T2,U1,d,e.
+ ⇩[d, e] L1 ≡ K1 → ⇧[d, e] T1 ≡ U1 →
+ fsup K1 T1 K2 T2 → fsup L1 U1 K2 T2
+.
+
+interpretation
+ "structural successor (closure)"
+ 'SupTerm L1 T1 L2 T2 = (fsup L1 T1 L2 T2).
+
+(* Basic properties *********************************************************)
+
+lemma fsup_lref_S_lt: ∀I,L,K,V,T,i. 0 < i → ⦃L, #(i-1)⦄ ⊃ ⦃K, T⦄ → ⦃L.ⓑ{I}V, #i⦄ ⊃ ⦃K, T⦄.
+/3 width=7/ qed.
+
+lemma fsup_lref: ∀I,K,V,i,L. ⇩[0, i] L ≡ K.ⓑ{I}V → ⦃L, #i⦄ ⊃ ⦃K, V⦄.
+#I #K #V #i @(nat_elim1 i) -i #i #IH #L #H
+elim (ldrop_inv_O1_pair2 … H) -H *
+[ #H1 #H2 destruct //
+| #I1 #K1 #V1 #HK1 #H #Hi destruct
+ lapply (IH … HK1) /2 width=1/
+]
+qed.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma fsup_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ♯{L2, T2} < ♯{L1, T1}.
+#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 //
+#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12
+lapply (ldrop_fwd_lw … HLK1) -HLK1 #HLK1
+lapply (lift_fwd_tw … HTU1) -HTU1 #HTU1
+@(lt_to_le_to_lt … IHT12) -IHT12 /2 width=1/
+qed-.
+
+fact fsup_fwd_length_lref1_aux: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀i. T1 = #i → |L2| < |L1|.
+#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2
+[ 6: #L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #i #H destruct
+ lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1
+ elim (lift_inv_lref2 … HTU1) -HTU1 * #Hdei #H destruct
+ @(lt_to_le_to_lt … HLK1) /2 width=2/
+| normalize // |2,3: #a
+] #I #L #V #T #j #H destruct
+qed-.
+
+lemma fsup_fwd_length_lref1: ∀L1,L2,T2,i. ⦃L1, #i⦄ ⊃ ⦃L2, T2⦄ → |L2| < |L1|.
+/2 width=5 by fsup_fwd_length_lref1_aux/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/genv.ma".
+
+(* GLOBAL ENVIRONMENT SLICING ***********************************************)
+
+inductive gdrop (e:nat): relation genv ≝
+| gdrop_gt: ∀G. |G| ≤ e → gdrop e G (⋆)
+| gdrop_eq: ∀G. |G| = e + 1 → gdrop e G G
+| gdrop_lt: ∀I,G1,G2,V. e < |G1| → gdrop e G1 G2 → gdrop e (G1. ⓑ{I} V) G2
+.
+
+interpretation "global slicing"
+ 'RDrop e G1 G2 = (gdrop e G1 G2).
+
+(* basic inversion lemmas ***************************************************)
+
+lemma gdrop_inv_gt: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| ≤ e → G2 = ⋆.
+#G1 #G2 #e * -G1 -G2 //
+[ #G #H >H -H >commutative_plus #H
+ lapply (le_plus_to_le_r … 0 H) -H #H
+ lapply (le_n_O_to_eq … H) -H #H destruct
+| #I #G1 #G2 #V #H1 #_ #H2
+ lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 normalize in ⊢ (? % ? → ?); >commutative_plus #H
+ lapply (lt_plus_to_lt_l … 0 H) -H #H
+ elim (lt_zero_false … H)
+]
+qed-.
+
+lemma gdrop_inv_eq: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| = e + 1 → G1 = G2.
+#G1 #G2 #e * -G1 -G2 //
+[ #G #H1 #H2 >H2 in H1; -H2 >commutative_plus #H
+ lapply (le_plus_to_le_r … 0 H) -H #H
+ lapply (le_n_O_to_eq … H) -H #H destruct
+| #I #G1 #G2 #V #H1 #_ normalize #H2
+ <(injective_plus_l … H2) in H1; -H2 #H
+ elim (lt_refl_false … H)
+]
+qed-.
+
+fact gdrop_inv_lt_aux: ∀I,G,G1,G2,V,e. ⇩[e] G ≡ G2 → G = G1. ⓑ{I} V →
+ e < |G1| → ⇩[e] G1 ≡ G2.
+#I #G #G1 #G2 #V #e * -G -G2
+[ #G #H1 #H destruct #H2
+ lapply (le_to_lt_to_lt … H1 H2) -H1 -H2 normalize in ⊢ (? % ? → ?); >commutative_plus #H
+ lapply (lt_plus_to_lt_l … 0 H) -H #H
+ elim (lt_zero_false … H)
+| #G #H1 #H2 destruct >(injective_plus_l … H1) -H1 #H
+ elim (lt_refl_false … H)
+| #J #G #G2 #W #_ #HG2 #H destruct //
+]
+qed.
+
+lemma gdrop_inv_lt: ∀I,G1,G2,V,e.
+ ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2.
+/2 width=5/ qed-.
+
+(* Basic properties *********************************************************)
+
+lemma gdrop_total: ∀e,G1. ∃G2. ⇩[e] G1 ≡ G2.
+#e #G1 elim G1 -G1 /3 width=2/
+#I #V #G1 * #G2 #HG12
+elim (lt_or_eq_or_gt e (|G1|)) #He
+[ /3 width=2/
+| destruct /3 width=2/
+| @ex_intro [2: @gdrop_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *)
+]
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/gdrop.ma".
+
+(* GLOBAL ENVIRONMENT SLICING ***********************************************)
+
+(* Main properties **********************************************************)
+
+theorem gdrop_mono: ∀G,G1,e. ⇩[e] G ≡ G1 → ∀G2. ⇩[e] G ≡ G2 → G1 = G2.
+#G #G1 #e #H elim H -G -G1
+[ #G #He #G2 #H
+ >(gdrop_inv_gt … H He) -H -He //
+| #G #He #G2 #H
+ >(gdrop_inv_eq … H He) -H -He //
+| #I #G #G1 #V #He #_ #IHG1 #G2 #H
+ lapply (gdrop_inv_lt … H He) -H -He /2 width=1/
+]
+qed-.
+
+lemma gdrop_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2).
+#G1 #G2 #e
+elim (gdrop_total e G1) #G #HG1
+elim (genv_eq_dec G G2) #HG2
+[ destruct /2 width=1/
+| @or_intror #HG12
+ lapply (gdrop_mono … HG1 … HG12) -HG1 -HG12 /2 width=1/
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/cl_weight.ma".
+include "basic_2/relocation/lift.ma".
+include "basic_2/relocation/lsubr.ma".
+
+(* LOCAL ENVIRONMENT SLICING ************************************************)
+
+(* Basic_1: includes: drop_skip_bind *)
+inductive ldrop: nat → nat → relation lenv ≝
+| ldrop_atom : ∀d,e. ldrop d e (⋆) (⋆)
+| ldrop_pair : ∀L,I,V. ldrop 0 0 (L. ⓑ{I} V) (L. ⓑ{I} V)
+| ldrop_ldrop: ∀L1,L2,I,V,e. ldrop 0 e L1 L2 → ldrop 0 (e + 1) (L1. ⓑ{I} V) L2
+| ldrop_skip : ∀L1,L2,I,V1,V2,d,e.
+ ldrop d e L1 L2 → ⇧[d,e] V2 ≡ V1 →
+ ldrop (d + 1) e (L1. ⓑ{I} V1) (L2. ⓑ{I} V2)
+.
+
+interpretation "local slicing" 'RDrop d e L1 L2 = (ldrop d e L1 L2).
+
+definition l_liftable: (lenv → relation term) → Prop ≝
+ λR. ∀K,T1,T2. R K T1 T2 → ∀L,d,e. ⇩[d, e] L ≡ K →
+ ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2.
+
+definition l_deliftable_sn: (lenv → relation term) → Prop ≝
+ λR. ∀L,U1,U2. R L U1 U2 → ∀K,d,e. ⇩[d, e] L ≡ K →
+ ∀T1. ⇧[d, e] T1 ≡ U1 →
+ ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2.
+
+definition dropable_sn: relation lenv → Prop ≝
+ λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀L2. R L1 L2 →
+ ∃∃K2. R K1 K2 & ⇩[d, e] L2 ≡ K2.
+
+definition dedropable_sn: relation lenv → Prop ≝
+ λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀K2. R K1 K2 →
+ ∃∃L2. R L1 L2 & ⇩[d, e] L2 ≡ K2.
+
+definition dropable_dx: relation lenv → Prop ≝
+ λR. ∀L1,L2. R L1 L2 → ∀K2,e. ⇩[0, e] L2 ≡ K2 →
+ ∃∃K1. ⇩[0, e] L1 ≡ K1 & R K1 K2.
+
+(* Basic inversion lemmas ***************************************************)
+
+fact ldrop_inv_refl_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → e = 0 → L1 = L2.
+#d #e #L1 #L2 * -d -e -L1 -L2
+[ //
+| //
+| #L1 #L2 #I #V #e #_ #_ >commutative_plus normalize #H destruct
+| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct
+]
+qed.
+
+(* Basic_1: was: drop_gen_refl *)
+lemma ldrop_inv_refl: ∀L1,L2. ⇩[0, 0] L1 ≡ L2 → L1 = L2.
+/2 width=5/ qed-.
+
+fact ldrop_inv_atom1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → L1 = ⋆ →
+ L2 = ⋆.
+#d #e #L1 #L2 * -d -e -L1 -L2
+[ //
+| #L #I #V #H destruct
+| #L1 #L2 #I #V #e #_ #H destruct
+| #L1 #L2 #I #V1 #V2 #d #e #_ #_ #H destruct
+]
+qed.
+
+(* Basic_1: was: drop_gen_sort *)
+lemma ldrop_inv_atom1: ∀d,e,L2. ⇩[d, e] ⋆ ≡ L2 → L2 = ⋆.
+/2 width=5/ qed-.
+
+fact ldrop_inv_O1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 →
+ ∀K,I,V. L1 = K. ⓑ{I} V →
+ (e = 0 ∧ L2 = K. ⓑ{I} V) ∨
+ (0 < e ∧ ⇩[d, e - 1] K ≡ L2).
+#d #e #L1 #L2 * -d -e -L1 -L2
+[ #d #e #_ #K #I #V #H destruct
+| #L #I #V #_ #K #J #W #HX destruct /3 width=1/
+| #L1 #L2 #I #V #e #HL12 #_ #K #J #W #H destruct /3 width=1/
+| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct
+]
+qed.
+
+lemma ldrop_inv_O1: ∀e,K,I,V,L2. ⇩[0, e] K. ⓑ{I} V ≡ L2 →
+ (e = 0 ∧ L2 = K. ⓑ{I} V) ∨
+ (0 < e ∧ ⇩[0, e - 1] K ≡ L2).
+/2 width=3/ qed-.
+
+lemma ldrop_inv_pair1: ∀K,I,V,L2. ⇩[0, 0] K. ⓑ{I} V ≡ L2 → L2 = K. ⓑ{I} V.
+#K #I #V #L2 #H
+elim (ldrop_inv_O1 … H) -H * // #H destruct
+elim (lt_refl_false … H)
+qed-.
+
+(* Basic_1: was: drop_gen_drop *)
+lemma ldrop_inv_ldrop1: ∀e,K,I,V,L2.
+ ⇩[0, e] K. ⓑ{I} V ≡ L2 → 0 < e → ⇩[0, e - 1] K ≡ L2.
+#e #K #I #V #L2 #H #He
+elim (ldrop_inv_O1 … H) -H * // #H destruct
+elim (lt_refl_false … He)
+qed-.
+
+fact ldrop_inv_skip1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d →
+ ∀I,K1,V1. L1 = K1. ⓑ{I} V1 →
+ ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 &
+ ⇧[d - 1, e] V2 ≡ V1 &
+ L2 = K2. ⓑ{I} V2.
+#d #e #L1 #L2 * -d -e -L1 -L2
+[ #d #e #_ #I #K #V #H destruct
+| #L #I #V #H elim (lt_refl_false … H)
+| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H)
+| #X #L2 #Y #Z #V2 #d #e #HL12 #HV12 #_ #I #L1 #V1 #H destruct /2 width=5/
+]
+qed.
+
+(* Basic_1: was: drop_gen_skip_l *)
+lemma ldrop_inv_skip1: ∀d,e,I,K1,V1,L2. ⇩[d, e] K1. ⓑ{I} V1 ≡ L2 → 0 < d →
+ ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 &
+ ⇧[d - 1, e] V2 ≡ V1 &
+ L2 = K2. ⓑ{I} V2.
+/2 width=3/ qed-.
+
+lemma ldrop_inv_O1_pair2: ∀I,K,V,e,L1. ⇩[0, e] L1 ≡ K. ⓑ{I} V →
+ (e = 0 ∧ L1 = K. ⓑ{I} V) ∨
+ ∃∃I1,K1,V1. ⇩[0, e - 1] K1 ≡ K. ⓑ{I} V & L1 = K1.ⓑ{I1}V1 & 0 < e.
+#I #K #V #e *
+[ #H lapply (ldrop_inv_atom1 … H) -H #H destruct
+| #L1 #I1 #V1 #H
+ elim (ldrop_inv_O1 … H) -H *
+ [ #H1 #H2 destruct /3 width=1/
+ | /3 width=5/
+ ]
+]
+qed-.
+
+fact ldrop_inv_skip2_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d →
+ ∀I,K2,V2. L2 = K2. ⓑ{I} V2 →
+ ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 &
+ ⇧[d - 1, e] V2 ≡ V1 &
+ L1 = K1. ⓑ{I} V1.
+#d #e #L1 #L2 * -d -e -L1 -L2
+[ #d #e #_ #I #K #V #H destruct
+| #L #I #V #H elim (lt_refl_false … H)
+| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H)
+| #L1 #X #Y #V1 #Z #d #e #HL12 #HV12 #_ #I #L2 #V2 #H destruct /2 width=5/
+]
+qed.
+
+(* Basic_1: was: drop_gen_skip_r *)
+lemma ldrop_inv_skip2: ∀d,e,I,L1,K2,V2. ⇩[d, e] L1 ≡ K2. ⓑ{I} V2 → 0 < d →
+ ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & ⇧[d - 1, e] V2 ≡ V1 &
+ L1 = K1. ⓑ{I} V1.
+/2 width=3/ qed-.
+
+(* Basic properties *********************************************************)
+
+(* Basic_1: was by definition: drop_refl *)
+lemma ldrop_refl: ∀L. ⇩[0, 0] L ≡ L.
+#L elim L -L //
+qed.
+
+lemma ldrop_ldrop_lt: ∀L1,L2,I,V,e.
+ ⇩[0, e - 1] L1 ≡ L2 → 0 < e → ⇩[0, e] L1. ⓑ{I} V ≡ L2.
+#L1 #L2 #I #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
+qed.
+
+lemma ldrop_skip_lt: ∀L1,L2,I,V1,V2,d,e.
+ ⇩[d - 1, e] L1 ≡ L2 → ⇧[d - 1, e] V2 ≡ V1 → 0 < d →
+ ⇩[d, e] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2.
+#L1 #L2 #I #V1 #V2 #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) // /2 width=1/
+qed.
+
+lemma ldrop_O1_le: ∀i,L. i ≤ |L| → ∃K. ⇩[0, i] L ≡ K.
+#i @(nat_ind_plus … i) -i /2 width=2/
+#i #IHi *
+[ #H lapply (le_n_O_to_eq … H) -H >commutative_plus normalize #H destruct
+| #L #I #V normalize #H
+ elim (IHi L ?) -IHi /2 width=1/ -H /3 width=2/
+]
+qed.
+
+lemma ldrop_O1_lt: ∀L,i. i < |L| → ∃∃I,K,V. ⇩[0, i] L ≡ K.ⓑ{I}V.
+#L elim L -L
+[ #i #H elim (lt_zero_false … H)
+| #L #I #V #IHL #i @(nat_ind_plus … i) -i /2 width=4/
+ #i #_ normalize #H
+ elim (IHL i ? ) -IHL /2 width=1/ -H /3 width=4/
+]
+qed.
+
+lemma ldrop_lsubr_ldrop2_abbr: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ ∀K2,V,i. ⇩[0, i] L2 ≡ K2. ⓓV →
+ d ≤ i → i < d + e →
+ ∃∃K1. K1 ⊑ [0, d + e - i - 1] K2 &
+ ⇩[0, i] L1 ≡ K1. ⓓV.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e
+[ #d #e #K1 #V #i #H
+ lapply (ldrop_inv_atom1 … H) -H #H destruct
+| #L1 #L2 #K1 #V #i #_ #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #V #e #HL12 #IHL12 #K1 #W #i #H #_ #Hie
+ elim (ldrop_inv_O1 … H) -H * #Hi #HLK1
+ [ -IHL12 -Hie destruct
+ <minus_n_O <minus_plus_m_m // /2 width=3/
+ | -HL12
+ elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /4 width=3/
+ ]
+| #L1 #L2 #I #V1 #V2 #e #_ #IHL12 #K1 #W #i #H #_ #Hie
+ elim (ldrop_inv_O1 … H) -H * #Hi #HLK1
+ [ -IHL12 -Hie -Hi destruct
+ | elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /3 width=3/
+ ]
+| #L1 #L2 #I1 #I2 #V1 #V2 #d #e #_ #IHL12 #K1 #V #i #H #Hdi >plus_plus_comm_23 #Hide
+ elim (le_inv_plus_l … Hdi) #Hdim #Hi
+ lapply (ldrop_inv_ldrop1 … H ?) -H // #HLK1
+ elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hdi -Hide >minus_minus_comm >arith_b1 // /3 width=3/
+]
+qed.
+
+lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R).
+#R #HR #L1 #K1 #d #e #HLK1 #L2 #H elim H -L2
+[ #L2 #HL12
+ elim (HR … HLK1 … HL12) -HR -L1 /3 width=3/
+| #L #L2 #_ #HL2 * #K #HK1 #HLK
+ elim (HR … HLK … HL2) -HR -L /3 width=3/
+]
+qed.
+
+lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R).
+#R #HR #L1 #K1 #d #e #HLK1 #K2 #H elim H -K2
+[ #K2 #HK12
+ elim (HR … HLK1 … HK12) -HR -K1 /3 width=3/
+| #K #K2 #_ #HK2 * #L #HL1 #HLK
+ elim (HR … HLK … HK2) -HR -K /3 width=3/
+]
+qed.
+
+lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R).
+#R #HR #L1 #L2 #H elim H -L2
+[ #L2 #HL12 #K2 #e #HLK2
+ elim (HR … HL12 … HLK2) -HR -L2 /3 width=3/
+| #L #L2 #_ #HL2 #IHL1 #K2 #e #HLK2
+ elim (HR … HL2 … HLK2) -HR -L2 #K #HLK #HK2
+ elim (IHL1 … HLK) -L /3 width=5/
+]
+qed.
+
+(* Basic forvard lemmas *****************************************************)
+
+(* Basic_1: was: drop_S *)
+lemma ldrop_fwd_ldrop2: ∀L1,I2,K2,V2,e. ⇩[O, e] L1 ≡ K2. ⓑ{I2} V2 →
+ ⇩[O, e + 1] L1 ≡ K2.
+#L1 elim L1 -L1
+[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct
+| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H
+ elim (ldrop_inv_O1 … H) -H * #He #H
+ [ -IHL1 destruct /2 width=1/
+ | @ldrop_ldrop >(plus_minus_m_m e 1) // /2 width=3/
+ ]
+]
+qed-.
+
+lemma ldrop_fwd_length: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → |L2| ≤ |L1|.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize /2 width=1/
+qed-.
+
+lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ♯{L2} ≤ ♯{L1}.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize
+[ /2 width=3/
+| #L1 #L2 #I #V1 #V2 #d #e #_ #HV21 #IHL12
+ >(lift_fwd_tw … HV21) -HV21 /2 width=1/
+]
+qed-.
+
+lemma ldrop_pair2_fwd_fw: ∀I,L,K,V,d,e. ⇩[d, e] L ≡ K. ⓑ{I} V →
+ ∀T. ♯{K, V} < ♯{L, T}.
+#I #L #K #V #d #e #H #T
+lapply (ldrop_fwd_lw … H) -H #H
+@(le_to_lt_to_lt … H) -H /3 width=1/
+qed-.
+
+lemma ldrop_fwd_ldrop2_length: ∀L1,I2,K2,V2,e.
+ ⇩[0, e] L1 ≡ K2. ⓑ{I2} V2 → e < |L1|.
+#L1 elim L1 -L1
+[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct
+| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H
+ elim (ldrop_inv_O1 … H) -H * #He #H
+ [ -IHL1 destruct //
+ | lapply (IHL1 … H) -IHL1 -H #HeK1 whd in ⊢ (? ? %); /2 width=1/
+ ]
+]
+qed-.
+
+lemma ldrop_fwd_O1_length: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → |L2| = |L1| - e.
+#L1 elim L1 -L1
+[ #L2 #e #H >(ldrop_inv_atom1 … H) -H //
+| #K1 #I1 #V1 #IHL1 #L2 #e #H
+ elim (ldrop_inv_O1 … H) -H * #He #H
+ [ -IHL1 destruct //
+ | lapply (IHL1 … H) -IHL1 -H #H >H -H normalize
+ >minus_le_minus_minus_comm //
+ ]
+]
+qed-.
+
+(* Basic_1: removed theorems 50:
+ drop_ctail drop_skip_flat
+ cimp_flat_sx cimp_flat_dx cimp_bind cimp_getl_conf
+ drop_clear drop_clear_O drop_clear_S
+ clear_gen_sort clear_gen_bind clear_gen_flat clear_gen_flat_r
+ clear_gen_all clear_clear clear_mono clear_trans clear_ctail clear_cle
+ getl_ctail_clen getl_gen_tail clear_getl_trans getl_clear_trans
+ getl_clear_bind getl_clear_conf getl_dec getl_drop getl_drop_conf_lt
+ getl_drop_conf_ge getl_conf_ge_drop getl_drop_conf_rev
+ drop_getl_trans_lt drop_getl_trans_le drop_getl_trans_ge
+ getl_drop_trans getl_flt getl_gen_all getl_gen_sort getl_gen_O
+ getl_gen_S getl_gen_2 getl_gen_flat getl_gen_bind getl_conf_le
+ getl_trans getl_refl getl_head getl_flat getl_ctail getl_mono
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop.ma".
+
+(* DROPPING *****************************************************************)
+
+(* Properties on append for local environments ******************************)
+
+fact ldrop_O1_append_sn_le_aux: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 →
+ d = 0 → e ≤ |L1| →
+ ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize // /4 width=1/
+#d #e #_ #H #L -d
+lapply (le_n_O_to_eq … H) -H //
+qed-.
+
+lemma ldrop_O1_append_sn_le: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → e ≤ |L1| →
+ ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2.
+/2 width=3 by ldrop_O1_append_sn_le_aux/ qed.
+
+(* Inversion lemmas on append for local environments ************************)
+
+lemma ldrop_O1_inv_append1_ge: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K →
+ |L2| ≤ e → ⇩[0, e - |L2|] L1 ≡ K.
+#K #L1 #L2 elim L2 -L2 normalize //
+#L2 #I #V #IHL2 #e #H #H1e
+elim (ldrop_inv_O1 … H) -H * #H2e #HL12 destruct
+[ lapply (le_n_O_to_eq … H1e) -H1e -IHL2
+ >commutative_plus normalize #H destruct
+| <minus_plus >minus_minus_comm /3 width=1/
+]
+qed-.
+
+lemma ldrop_O1_inv_append1_le: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → e ≤ |L2| →
+ ∀K2. ⇩[0, e] L2 ≡ K2 → K = L1 @@ K2.
+#K #L1 #L2 elim L2 -L2 normalize
+[ #e #H1 #H2 #K2 #H3
+ lapply (le_n_O_to_eq … H2) -H2 #H2
+ lapply (ldrop_inv_atom1 … H3) -H3 #H3 destruct
+ >(ldrop_inv_refl … H1) -H1 //
+| #L2 #I #V #IHL2 #e @(nat_ind_plus … e) -e [ -IHL2 ]
+ [ #H1 #_ #K2 #H2
+ lapply (ldrop_inv_refl … H1) -H1 #H1
+ lapply (ldrop_inv_refl … H2) -H2 #H2 destruct //
+ | #e #_ #H1 #H #K2 #H2
+ lapply (le_plus_to_le_r … H) -H
+ lapply (ldrop_inv_ldrop1 … H1 ?) -H1 //
+ lapply (ldrop_inv_ldrop1 … H2 ?) -H2 //
+ <minus_plus_m_m /2 width=4/
+ ]
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lsubr_lbotr.ma".
+include "basic_2/relocation/ldrop_ldrop.ma".
+
+(* DROPPING *****************************************************************)
+
+(* Inversion lemmas about local env. full refinement for substitution *******)
+
+(* Note: ldrop_ldrop not needed *)
+lemma lbotr_inv_ldrop: ∀I,L,K,V,i. ⇩[0, i] L ≡ K. ⓑ{I}V → ∀d,e. ⊒[d, e] L →
+ d ≤ i → i < d + e → I = Abbr.
+#I #L elim L -L
+[ #K #V #i #H
+ lapply (ldrop_inv_atom1 … H) -H #H destruct
+| #L #J #W #IHL #K #V #i #H
+ elim (ldrop_inv_O1 … H) -H *
+ [ -IHL #H1 #H2 #d #e #HL #Hdi #Hide destruct
+ lapply (le_n_O_to_eq … Hdi) -Hdi #H destruct
+ lapply (HL … (L.ⓓW) ?) -HL /2 width=1/ #H
+ elim (lsubr_inv_abbr2 … H ?) -H // -Hide #K #_ #H destruct //
+ | #Hi #HLK #d @(nat_ind_plus … d) -d
+ [ #e #H #_ #Hide
+ elim (lbotr_inv_bind … H ?) -H [2: /2 width=2/ ] #HL #H destruct
+ @(IHL … HLK … HL) -IHL -HLK -HL // /2 width=1/
+ | #d #_ #e #H #Hdi #Hide
+ lapply (lbotr_inv_skip … H ?) -H // #HL
+ @(IHL … HLK … HL) -IHL -HLK -HL /2 width=1/
+ ]
+ ]
+]
+qed-.
+
+(* Properties about local env. full refinement for substitution *************)
+
+(* Note: ldrop_ldrop not needed *)
+lemma lbotr_ldrop: ∀L,d,e.
+ (∀I,K,V,i. d ≤ i → i < d + e → ⇩[0, i] L ≡ K. ⓑ{I}V → I = Abbr) →
+ ⊒[d, e] L.
+#L elim L -L //
+#L #I #V #IHL #d @(nat_ind_plus … d) -d
+[ #e @(nat_ind_plus … e) -e //
+ #e #_ #H0
+ >(H0 I L V 0 ? ? ?) //
+ /5 width=6 by lbotr_abbr, ldrop_ldrop, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *)
+| #d #_ #e #H0
+ /5 width=6 by lbotr_skip, ldrop_ldrop, le_S_S, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *)
+]
+qed.
+
+lemma lbotr_ldrop_trans_le: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 →
+ dd + ee ≤ d → ⊒[dd, ee] L2.
+#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee
+@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2
+lapply (lt_to_le_to_lt … Hiddee Hddee) -Hddee #Hid
+elim (ldrop_trans_le … HL12 … HLK2 ?) -L2 /2 width=2/ #X #HLK1 #H
+elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K1 #V1 #HK12 #HV21 #H destruct
+@(lbotr_inv_ldrop … HLK1 … HL1) -L1 -K1 -V1 //
+qed.
+
+lemma lbotr_ldrop_trans_be_up: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 →
+ ∀dd,ee. ⊒[dd, ee] L1 →
+ dd ≤ d + e → d + e ≤ dd + ee →
+ ⊒[d, dd + ee - d - e] L2.
+#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hdde #Hddee
+@lbotr_ldrop #I #K2 #V2 #i #Hdi #Hiddee #HLK2
+lapply (transitive_le ? ? (i+e)… Hdde ?) -Hdde /2 width=1/ #Hddie
+>commutative_plus in Hiddee; >minus_minus_comm <plus_minus_m_m /2 width=1/ -Hddee #Hiddee
+lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hdi #HL1K2
+@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus // -Hddie /2 width=1/
+qed.
+
+lemma lbotr_ldrop_trans_ge: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 →
+ d + e ≤ dd → ⊒[dd - e, ee] L2.
+#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee
+@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2
+elim (le_inv_plus_l … Hddee) -Hddee #Hdde #Hedd
+>plus_minus in Hiddee; // #Hiddee
+lapply (transitive_le … Hdde Hddi) -Hdde #Hid
+lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hid #HL1K2
+@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus /2 width=1/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lift_lift.ma".
+include "basic_2/relocation/ldrop.ma".
+
+(* DROPPING *****************************************************************)
+
+(* Main properties **********************************************************)
+
+(* Basic_1: was: drop_mono *)
+theorem ldrop_mono: ∀d,e,L,L1. ⇩[d, e] L ≡ L1 →
+ ∀L2. ⇩[d, e] L ≡ L2 → L1 = L2.
+#d #e #L #L1 #H elim H -d -e -L -L1
+[ #d #e #L2 #H
+ >(ldrop_inv_atom1 … H) -L2 //
+| #K #I #V #L2 #HL12
+ <(ldrop_inv_refl … HL12) -L2 //
+| #L #K #I #V #e #_ #IHLK #L2 #H
+ lapply (ldrop_inv_ldrop1 … H ?) -H // /2 width=1/
+| #L #K1 #I #T #V1 #d #e #_ #HVT1 #IHLK1 #X #H
+ elim (ldrop_inv_skip1 … H ?) -H // <minus_plus_m_m #K2 #V2 #HLK2 #HVT2 #H destruct
+ >(lift_inj … HVT1 … HVT2) -HVT1 -HVT2
+ >(IHLK1 … HLK2) -IHLK1 -HLK2 //
+]
+qed-.
+
+(* Basic_1: was: drop_conf_ge *)
+theorem ldrop_conf_ge: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 →
+ ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 + e1 ≤ e2 →
+ ⇩[0, e2 - e1] L1 ≡ L2.
+#d1 #e1 #L #L1 #H elim H -d1 -e1 -L -L1
+[ #d #e #e2 #L2 #H
+ >(ldrop_inv_atom1 … H) -L2 //
+| //
+| #L #K #I #V #e #_ #IHLK #e2 #L2 #H #He2
+ lapply (ldrop_inv_ldrop1 … H ?) -H /2 width=2/ #HL2
+ <minus_plus >minus_minus_comm /3 width=1/
+| #L #K #I #V1 #V2 #d #e #_ #_ #IHLK #e2 #L2 #H #Hdee2
+ lapply (transitive_le 1 … Hdee2) // #He2
+ lapply (ldrop_inv_ldrop1 … H ?) -H // -He2 #HL2
+ lapply (transitive_le (1 + e) … Hdee2) // #Hee2
+ @ldrop_ldrop_lt >minus_minus_comm /3 width=1/ (**) (* explicit constructor *)
+]
+qed.
+
+(* Note: apparently this was missing in basic_1 *)
+theorem ldrop_conf_be: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 →
+ ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 →
+ ∃∃L. ⇩[0, d1 + e1 - e2] L2 ≡ L & ⇩[0, d1] L1 ≡ L.
+#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1
+[ #d1 #e1 #L2 #e2 #H >(ldrop_inv_atom1 … H) -H /2 width=3/
+| normalize #L #I #V #L2 #e2 #HL2 #_ #He2
+ lapply (le_n_O_to_eq … He2) -He2 #H destruct
+ lapply (ldrop_inv_refl … HL2) -HL2 #H destruct /2 width=3/
+| normalize #L0 #K0 #I #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21
+ lapply (ldrop_inv_O1 … H) -H * * #He2 #HL20
+ [ -IHLK0 -He21 destruct <minus_n_O /3 width=3/
+ | -HLK0 <minus_le_minus_minus_comm //
+ elim (IHLK0 … HL20 ? ?) -L0 // /2 width=1/ /2 width=3/
+ ]
+| #L0 #K0 #I #V0 #V1 #d1 #e1 >plus_plus_comm_23 #_ #_ #IHLK0 #L2 #e2 #H #Hd1e2 #He2de1
+ elim (le_inv_plus_l … Hd1e2) #_ #He2
+ <minus_le_minus_minus_comm //
+ lapply (ldrop_inv_ldrop1 … H ?) -H // #HL02
+ elim (IHLK0 … HL02 ? ?) -L0 /2 width=1/ /3 width=3/
+]
+qed.
+
+(* Note: apparently this was missing in basic_1 *)
+theorem ldrop_conf_le: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 →
+ ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → e2 ≤ d1 →
+ ∃∃L. ⇩[0, e2] L1 ≡ L & ⇩[d1 - e2, e1] L2 ≡ L.
+#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1
+[ #d1 #e1 #L2 #e2 #H
+ lapply (ldrop_inv_atom1 … H) -H #H destruct /2 width=3/
+| #K0 #I #V0 #L2 #e2 #H1 #H2
+ lapply (le_n_O_to_eq … H2) -H2 #H destruct
+ lapply (ldrop_inv_pair1 … H1) -H1 #H destruct /2 width=3/
+| #K0 #K1 #I #V0 #e1 #HK01 #_ #L2 #e2 #H1 #H2
+ lapply (le_n_O_to_eq … H2) -H2 #H destruct
+ lapply (ldrop_inv_pair1 … H1) -H1 #H destruct /3 width=3/
+| #K0 #K1 #I #V0 #V1 #d1 #e1 #HK01 #HV10 #IHK01 #L2 #e2 #H #He2d1
+ elim (ldrop_inv_O1 … H) -H *
+ [ -IHK01 -He2d1 #H1 #H2 destruct /3 width=5/
+ | -HK01 -HV10 #He2 #HK0L2
+ elim (IHK01 … HK0L2 ?) -IHK01 -HK0L2 /2 width=1/ >minus_le_minus_minus_comm // /3 width=3/
+ ]
+]
+qed.
+
+(* Basic_1: was: drop_trans_ge *)
+theorem ldrop_trans_ge: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L →
+ ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → ⇩[0, e1 + e2] L1 ≡ L2.
+#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L
+[ #d #e #e2 #L2 #H
+ >(ldrop_inv_atom1 … H) -H -L2 //
+| //
+| /3 width=1/
+| #L1 #L2 #I #V1 #V2 #d #e #H_ #_ #IHL12 #e2 #L #H #Hde2
+ lapply (lt_to_le_to_lt 0 … Hde2) // #He2
+ lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2
+ lapply (ldrop_inv_ldrop1 … H ?) -H // #HL2
+ @ldrop_ldrop_lt // >le_plus_minus // @IHL12 /2 width=1/ (**) (* explicit constructor *)
+]
+qed.
+
+(* Basic_1: was: drop_trans_le *)
+theorem ldrop_trans_le: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L →
+ ∀e2,L2. ⇩[0, e2] L ≡ L2 → e2 ≤ d1 →
+ ∃∃L0. ⇩[0, e2] L1 ≡ L0 & ⇩[d1 - e2, e1] L0 ≡ L2.
+#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L
+[ #d #e #e2 #L2 #H
+ >(ldrop_inv_atom1 … H) -L2 /2 width=3/
+| #K #I #V #e2 #L2 #HL2 #H
+ lapply (le_n_O_to_eq … H) -H #H destruct /2 width=3/
+| #L1 #L2 #I #V #e #_ #IHL12 #e2 #L #HL2 #H
+ lapply (le_n_O_to_eq … H) -H #H destruct
+ elim (IHL12 … HL2 ?) -IHL12 -HL2 // #L0 #H #HL0
+ lapply (ldrop_inv_refl … H) -H #H destruct /3 width=5/
+| #L1 #L2 #I #V1 #V2 #d #e #HL12 #HV12 #IHL12 #e2 #L #H #He2d
+ elim (ldrop_inv_O1 … H) -H *
+ [ -He2d -IHL12 #H1 #H2 destruct /3 width=5/
+ | -HL12 -HV12 #He2 #HL2
+ elim (IHL12 … HL2 ?) -L2 [ >minus_le_minus_minus_comm // /3 width=3/ | /2 width=1/ ]
+ ]
+]
+qed.
+
+(* Basic_1: was: drop_conf_rev *)
+axiom ldrop_div: ∀e1,L1,L. ⇩[0, e1] L1 ≡ L → ∀e2,L2. ⇩[0, e2] L2 ≡ L →
+ ∃∃L0. ⇩[0, e1] L0 ≡ L2 & ⇩[e1, e2] L0 ≡ L1.
+
+(* Basic_1: was: drop_conf_lt *)
+lemma ldrop_conf_lt: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 →
+ ∀e2,K2,I,V2. ⇩[0, e2] L ≡ K2. ⓑ{I} V2 →
+ e2 < d1 → let d ≝ d1 - e2 - 1 in
+ ∃∃K1,V1. ⇩[0, e2] L1 ≡ K1. ⓑ{I} V1 &
+ ⇩[d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2.
+#d1 #e1 #L #L1 #H1 #e2 #K2 #I #V2 #H2 #He2d1
+elim (ldrop_conf_le … H1 … H2 ?) -L [2: /2 width=2/] #K #HL1K #HK2
+elim (ldrop_inv_skip1 … HK2 ?) -HK2 [2: /2 width=1/] #K1 #V1 #HK21 #HV12 #H destruct /2 width=5/
+qed.
+
+lemma ldrop_trans_ge_comm: ∀d1,e1,e2,L1,L2,L.
+ ⇩[d1, e1] L1 ≡ L → ⇩[0, e2] L ≡ L2 → d1 ≤ e2 →
+ ⇩[0, e2 + e1] L1 ≡ L2.
+#e1 #e1 #e2 >commutative_plus /2 width=5/
+qed.
+
+lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[0, e1] L ≡ K. ⓑ{I1} V1 →
+ ∀I2,V2,e2. ⇩[0, e2] L ≡ K. ⓑ{I2} V2 →
+ ∧∧ e1 = e2 & I1 = I2 & V1 = V2.
+#I1 #L #K #V1 #e1 #HLK1 #I2 #V2 #e2 #HLK2
+elim (le_or_ge e1 e2) #He
+[ lapply (ldrop_conf_ge … HLK1 … HLK2 ?)
+| lapply (ldrop_conf_ge … HLK2 … HLK1 ?)
+] -HLK1 -HLK2 // #HK
+lapply (ldrop_fwd_O1_length … HK) #H
+elim (discr_minus_x_xy … H) -H
+[1,3: normalize <plus_n_Sm #H destruct ]
+#H >H in HK; #HK
+lapply (ldrop_inv_refl … HK) -HK #H destruct
+lapply (inv_eq_minus_O … H) -H /3 width=1/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/lenv_px.ma".
+include "basic_2/relocation/ldrop.ma".
+
+(* DROPPING *****************************************************************)
+
+(* Properties on pointwise extension ****************************************)
+
+lemma lpx_deliftable_dropable: ∀R. t_deliftable_sn R → dropable_sn (lpx R).
+#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
+[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/
+| #K1 #I #V1 #X #H
+ elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/
+| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H
+ elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
+ elim (IHLK1 … HL12) -L1 /3 width=3/
+| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H
+ elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
+ elim (HR … HV12 … HWV1) -V1
+ elim (IHLK1 … HL12) -L1 /3 width=5/
+]
+qed.
+
+lemma lpx_liftable_dedropable: ∀R. reflexive ? R →
+ t_liftable R → dedropable_sn (lpx R).
+#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
+[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/
+| #K1 #I #V1 #X #H
+ elim (lpx_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/
+| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12
+ elim (IHLK1 … HK12) -K1 /3 width=5/
+| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H
+ elim (lpx_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct
+ elim (lift_total W2 d e) #V2 #HWV2
+ lapply (H2R … HW12 … HWV1 … HWV2) -W1
+ elim (IHLK1 … HK12) -K1 /3 width=5/
+]
+qed.
+
+fact lpx_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx R L1 L2 →
+ d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx R K1 K2.
+#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e
+[ #d #e #X #H >(lpx_inv_atom2 … H) -H /2 width=3/
+| #K2 #I #V2 #X #H
+ elim (lpx_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/
+| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_
+ elim (lpx_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct
+ elim (IHLK2 … HL12 ?) -L2 // /3 width=3/
+| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_
+ >commutative_plus normalize #H destruct
+]
+qed-.
+
+lemma lpx_dropable: ∀R. dropable_dx (lpx R).
+/2 width=5 by lpx_dropable_aux/ qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/lenv_px_sn.ma".
+include "basic_2/relocation/ldrop.ma".
+
+(* DROPPING *****************************************************************)
+
+(* Properties on sn pointwise extension *************************************)
+
+lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R).
+#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
+[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/
+| #K1 #I #V1 #X #H
+ elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/
+| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H
+ elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
+ elim (IHLK1 … HL12) -L1 /3 width=3/
+| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H
+ elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
+ elim (HR … HV12 … HLK1 … HWV1) -V1
+ elim (IHLK1 … HL12) -L1 /3 width=5/
+]
+qed-.
+
+lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) →
+ l_liftable R → dedropable_sn (lpx_sn R).
+#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
+[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/
+| #K1 #I #V1 #X #H
+ elim (lpx_sn_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/
+| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12
+ elim (IHLK1 … HK12) -K1 /3 width=5/
+| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H
+ elim (lpx_sn_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct
+ elim (lift_total W2 d e) #V2 #HWV2
+ lapply (H2R … HW12 … HLK1 … HWV1 … HWV2) -W1
+ elim (IHLK1 … HK12) -K1 /3 width=5/
+]
+qed-.
+
+fact lpx_sn_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 →
+ d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx_sn R K1 K2.
+#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e
+[ #d #e #X #H >(lpx_sn_inv_atom2 … H) -H /2 width=3/
+| #K2 #I #V2 #X #H
+ elim (lpx_sn_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/
+| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_
+ elim (lpx_sn_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct
+ elim (IHLK2 … HL12 ?) -L2 // /3 width=3/
+| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_
+ >commutative_plus normalize #H destruct
+]
+qed-.
+
+lemma lpx_sn_dropable: ∀R. dropable_dx (lpx_sn R).
+/2 width=5 by lpx_sn_dropable_aux/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/term_weight.ma".
+include "basic_2/grammar/term_simple.ma".
+
+(* BASIC TERM RELOCATION ****************************************************)
+
+(* Basic_1: includes:
+ lift_sort lift_lref_lt lift_lref_ge lift_bind lift_flat
+*)
+inductive lift: nat → nat → relation term ≝
+| lift_sort : ∀k,d,e. lift d e (⋆k) (⋆k)
+| lift_lref_lt: ∀i,d,e. i < d → lift d e (#i) (#i)
+| lift_lref_ge: ∀i,d,e. d ≤ i → lift d e (#i) (#(i + e))
+| lift_gref : ∀p,d,e. lift d e (§p) (§p)
+| lift_bind : ∀a,I,V1,V2,T1,T2,d,e.
+ lift d e V1 V2 → lift (d + 1) e T1 T2 →
+ lift d e (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2)
+| lift_flat : ∀I,V1,V2,T1,T2,d,e.
+ lift d e V1 V2 → lift d e T1 T2 →
+ lift d e (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
+.
+
+interpretation "relocation" 'RLift d e T1 T2 = (lift d e T1 T2).
+
+definition t_liftable: relation term → Prop ≝
+ λR. ∀T1,T2. R T1 T2 → ∀U1,d,e. ⇧[d, e] T1 ≡ U1 →
+ ∀U2. ⇧[d, e] T2 ≡ U2 → R U1 U2.
+
+definition t_deliftable_sn: relation term → Prop ≝
+ λR. ∀U1,U2. R U1 U2 → ∀T1,d,e. ⇧[d, e] T1 ≡ U1 →
+ ∃∃T2. ⇧[d, e] T2 ≡ U2 & R T1 T2.
+
+(* Basic inversion lemmas ***************************************************)
+
+fact lift_inv_refl_O2_aux: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → e = 0 → T1 = T2.
+#d #e #T1 #T2 #H elim H -d -e -T1 -T2 // /3 width=1/
+qed.
+
+lemma lift_inv_refl_O2: ∀d,T1,T2. ⇧[d, 0] T1 ≡ T2 → T1 = T2.
+/2 width=4/ qed-.
+
+fact lift_inv_sort1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T1 = ⋆k → T2 = ⋆k.
+#d #e #T1 #T2 * -d -e -T1 -T2 //
+[ #i #d #e #_ #k #H destruct
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+]
+qed.
+
+lemma lift_inv_sort1: ∀d,e,T2,k. ⇧[d,e] ⋆k ≡ T2 → T2 = ⋆k.
+/2 width=5/ qed-.
+
+fact lift_inv_lref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T1 = #i →
+ (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)).
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #i #H destruct
+| #j #d #e #Hj #i #Hi destruct /3 width=1/
+| #j #d #e #Hj #i #Hi destruct /3 width=1/
+| #p #d #e #i #H destruct
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct
+]
+qed.
+
+lemma lift_inv_lref1: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 →
+ (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)).
+/2 width=3/ qed-.
+
+lemma lift_inv_lref1_lt: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → i < d → T2 = #i.
+#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * //
+#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
+elim (lt_refl_false … Hdd)
+qed-.
+
+lemma lift_inv_lref1_ge: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → d ≤ i → T2 = #(i + e).
+#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * //
+#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
+elim (lt_refl_false … Hdd)
+qed-.
+
+fact lift_inv_gref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T1 = §p → T2 = §p.
+#d #e #T1 #T2 * -d -e -T1 -T2 //
+[ #i #d #e #_ #k #H destruct
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+]
+qed.
+
+lemma lift_inv_gref1: ∀d,e,T2,p. ⇧[d,e] §p ≡ T2 → T2 = §p.
+/2 width=5/ qed-.
+
+fact lift_inv_bind1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
+ ∀a,I,V1,U1. T1 = ⓑ{a,I} V1.U1 →
+ ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
+ T2 = ⓑ{a,I} V2. U2.
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #a #I #V1 #U1 #H destruct
+| #i #d #e #_ #a #I #V1 #U1 #H destruct
+| #i #d #e #_ #a #I #V1 #U1 #H destruct
+| #p #d #e #a #I #V1 #U1 #H destruct
+| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V1 #U1 #H destruct /2 width=5/
+| #J #W1 #W2 #T1 #T2 #d #e #_ #HT #a #I #V1 #U1 #H destruct
+]
+qed.
+
+lemma lift_inv_bind1: ∀d,e,T2,a,I,V1,U1. ⇧[d,e] ⓑ{a,I} V1. U1 ≡ T2 →
+ ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
+ T2 = ⓑ{a,I} V2. U2.
+/2 width=3/ qed-.
+
+fact lift_inv_flat1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
+ ∀I,V1,U1. T1 = ⓕ{I} V1.U1 →
+ ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
+ T2 = ⓕ{I} V2. U2.
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #I #V1 #U1 #H destruct
+| #i #d #e #_ #I #V1 #U1 #H destruct
+| #i #d #e #_ #I #V1 #U1 #H destruct
+| #p #d #e #I #V1 #U1 #H destruct
+| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V1 #U1 #H destruct
+| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V1 #U1 #H destruct /2 width=5/
+]
+qed.
+
+lemma lift_inv_flat1: ∀d,e,T2,I,V1,U1. ⇧[d,e] ⓕ{I} V1. U1 ≡ T2 →
+ ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
+ T2 = ⓕ{I} V2. U2.
+/2 width=3/ qed-.
+
+fact lift_inv_sort2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T2 = ⋆k → T1 = ⋆k.
+#d #e #T1 #T2 * -d -e -T1 -T2 //
+[ #i #d #e #_ #k #H destruct
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
+]
+qed.
+
+(* Basic_1: was: lift_gen_sort *)
+lemma lift_inv_sort2: ∀d,e,T1,k. ⇧[d,e] T1 ≡ ⋆k → T1 = ⋆k.
+/2 width=5/ qed-.
+
+fact lift_inv_lref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T2 = #i →
+ (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)).
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #i #H destruct
+| #j #d #e #Hj #i #Hi destruct /3 width=1/
+| #j #d #e #Hj #i #Hi destruct <minus_plus_m_m /4 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.
+
+(* Basic_1: was: lift_gen_lref *)
+lemma lift_inv_lref2: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i →
+ (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)).
+/2 width=3/ qed-.
+
+(* Basic_1: was: lift_gen_lref_lt *)
+lemma lift_inv_lref2_lt: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i → i < d → T1 = #i.
+#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H * //
+#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
+elim (lt_inv_plus_l … Hdd) -Hdd #Hdd
+elim (lt_refl_false … Hdd)
+qed-.
+
+(* Basic_1: was: lift_gen_lref_false *)
+lemma lift_inv_lref2_be: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i →
+ d ≤ i → i < d + e → ⊥.
+#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H *
+[ #H1 #_ #H2 #_ | #H2 #_ #_ #H1 ]
+lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 #H
+elim (lt_refl_false … H)
+qed-.
+
+(* Basic_1: was: lift_gen_lref_ge *)
+lemma lift_inv_lref2_ge: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i → d + e ≤ i → T1 = #(i - e).
+#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H * //
+#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
+elim (lt_inv_plus_l … Hdd) -Hdd #Hdd
+elim (lt_refl_false … Hdd)
+qed-.
+
+fact lift_inv_gref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T2 = §p → T1 = §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_gref2: ∀d,e,T1,p. ⇧[d,e] T1 ≡ §p → T1 = §p.
+/2 width=5/ qed-.
+
+fact lift_inv_bind2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
+ ∀a,I,V2,U2. T2 = ⓑ{a,I} V2.U2 →
+ ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
+ T1 = ⓑ{a,I} V1. U1.
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #a #I #V2 #U2 #H destruct
+| #i #d #e #_ #a #I #V2 #U2 #H destruct
+| #i #d #e #_ #a #I #V2 #U2 #H destruct
+| #p #d #e #a #I #V2 #U2 #H destruct
+| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V2 #U2 #H destruct /2 width=5/
+| #J #W1 #W2 #T1 #T2 #d #e #_ #_ #a #I #V2 #U2 #H destruct
+]
+qed.
+
+(* Basic_1: was: lift_gen_bind *)
+lemma lift_inv_bind2: ∀d,e,T1,a,I,V2,U2. ⇧[d,e] T1 ≡ ⓑ{a,I} V2. U2 →
+ ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
+ T1 = ⓑ{a,I} V1. U1.
+/2 width=3/ qed-.
+
+fact lift_inv_flat2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
+ ∀I,V2,U2. T2 = ⓕ{I} V2.U2 →
+ ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
+ T1 = ⓕ{I} V1. U1.
+#d #e #T1 #T2 * -d -e -T1 -T2
+[ #k #d #e #I #V2 #U2 #H destruct
+| #i #d #e #_ #I #V2 #U2 #H destruct
+| #i #d #e #_ #I #V2 #U2 #H destruct
+| #p #d #e #I #V2 #U2 #H destruct
+| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V2 #U2 #H destruct
+| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V2 #U2 #H destruct /2 width=5/
+]
+qed.
+
+(* Basic_1: was: lift_gen_flat *)
+lemma lift_inv_flat2: ∀d,e,T1,I,V2,U2. ⇧[d,e] T1 ≡ ⓕ{I} V2. U2 →
+ ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
+ T1 = ⓕ{I} V1. U1.
+/2 width=3/ qed-.
+
+lemma lift_inv_pair_xy_x: ∀d,e,I,V,T. ⇧[d, e] ②{I} V. T ≡ V → ⊥.
+#d #e #J #V elim V -V
+[ * #i #T #H
+ [ lapply (lift_inv_sort2 … H) -H #H destruct
+ | elim (lift_inv_lref2 … H) -H * #_ #H destruct
+ | lapply (lift_inv_gref2 … H) -H #H destruct
+ ]
+| * [ #a ] #I #W2 #U2 #IHW2 #_ #T #H
+ [ elim (lift_inv_bind2 … H) -H #W1 #U1 #HW12 #_ #H destruct /2 width=2/
+ | elim (lift_inv_flat2 … H) -H #W1 #U1 #HW12 #_ #H destruct /2 width=2/
+ ]
+]
+qed-.
+
+(* Basic_1: was: thead_x_lift_y_y *)
+lemma lift_inv_pair_xy_y: ∀I,T,V,d,e. ⇧[d, e] ②{I} V. T ≡ T → ⊥.
+#J #T elim T -T
+[ * #i #V #d #e #H
+ [ lapply (lift_inv_sort2 … H) -H #H destruct
+ | elim (lift_inv_lref2 … H) -H * #_ #H destruct
+ | lapply (lift_inv_gref2 … H) -H #H destruct
+ ]
+| * [ #a ] #I #W2 #U2 #_ #IHU2 #V #d #e #H
+ [ elim (lift_inv_bind2 … H) -H #W1 #U1 #_ #HU12 #H destruct /2 width=4/
+ | elim (lift_inv_flat2 … H) -H #W1 #U1 #_ #HU12 #H destruct /2 width=4/
+ ]
+]
+qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma lift_fwd_tw: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → ♯{T1} = ♯{T2}.
+#d #e #T1 #T2 #H elim H -d -e -T1 -T2 normalize //
+qed-.
+
+lemma lift_simple_dx: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄.
+#d #e #T1 #T2 #H elim H -d -e -T1 -T2 //
+#a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #_ #_ #H
+elim (simple_inv_bind … H)
+qed-.
+
+lemma lift_simple_sn: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄.
+#d #e #T1 #T2 #H elim H -d -e -T1 -T2 //
+#a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #_ #_ #H
+elim (simple_inv_bind … H)
+qed-.
+
+(* Basic properties *********************************************************)
+
+(* Basic_1: was: lift_lref_gt *)
+lemma lift_lref_ge_minus: ∀d,e,i. d + e ≤ i → ⇧[d, e] #(i - e) ≡ #i.
+#d #e #i #H >(plus_minus_m_m i e) in ⊢ (? ? ? ? %); /2 width=2/ /3 width=2/
+qed.
+
+lemma lift_lref_ge_minus_eq: ∀d,e,i,j. d + e ≤ i → j = i - e → ⇧[d, e] #j ≡ #i.
+/2 width=1/ qed-.
+
+(* Basic_1: was: lift_r *)
+lemma lift_refl: ∀T,d. ⇧[d, 0] T ≡ T.
+#T elim T -T
+[ * #i // #d elim (lt_or_ge i d) /2 width=1/
+| * /2 width=1/
+]
+qed.
+
+lemma lift_total: ∀T1,d,e. ∃T2. ⇧[d,e] T1 ≡ T2.
+#T1 elim T1 -T1
+[ * #i /2 width=2/ #d #e elim (lt_or_ge i d) /3 width=2/
+| * [ #a ] #I #V1 #T1 #IHV1 #IHT1 #d #e
+ elim (IHV1 d e) -IHV1 #V2 #HV12
+ [ elim (IHT1 (d+1) e) -IHT1 /3 width=2/
+ | elim (IHT1 d e) -IHT1 /3 width=2/
+ ]
+]
+qed.
+
+(* Basic_1: was: lift_free (right to left) *)
+lemma lift_split: ∀d1,e2,T1,T2. ⇧[d1, e2] T1 ≡ T2 →
+ ∀d2,e1. d1 ≤ d2 → d2 ≤ d1 + e1 → e1 ≤ e2 →
+ ∃∃T. ⇧[d1, e1] T1 ≡ T & ⇧[d2, e2 - e1] T ≡ T2.
+#d1 #e2 #T1 #T2 #H elim H -d1 -e2 -T1 -T2
+[ /3 width=3/
+| #i #d1 #e2 #Hid1 #d2 #e1 #Hd12 #_ #_
+ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 /4 width=3/
+| #i #d1 #e2 #Hid1 #d2 #e1 #_ #Hd21 #He12
+ lapply (transitive_le … (i+e1) Hd21 ?) /2 width=1/ -Hd21 #Hd21
+ >(plus_minus_m_m e2 e1 ?) // /3 width=3/
+| /3 width=3/
+| #a #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12
+ elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b
+ elim (IHT (d2+1) … ? ? He12) /2 width=1/ /3 width=5/
+| #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12
+ elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b
+ elim (IHT d2 … ? ? He12) // /3 width=5/
+]
+qed.
+
+(* Basic_1: was only: dnf_dec2 dnf_dec *)
+lemma is_lift_dec: ∀T2,d,e. Decidable (∃T1. ⇧[d,e] T1 ≡ T2).
+#T1 elim T1 -T1
+[ * [1,3: /3 width=2/ ] #i #d #e
+ elim (lt_dec i d) #Hid
+ [ /4 width=2/
+ | lapply (false_lt_to_le … Hid) -Hid #Hid
+ elim (lt_dec i (d + e)) #Hide
+ [ @or_intror * #T1 #H
+ elim (lift_inv_lref2_be … H Hid Hide)
+ | lapply (false_lt_to_le … Hide) -Hide /4 width=2/
+ ]
+ ]
+| * [ #a ] #I #V2 #T2 #IHV2 #IHT2 #d #e
+ [ elim (IHV2 d e) -IHV2
+ [ * #V1 #HV12 elim (IHT2 (d+1) e) -IHT2
+ [ * #T1 #HT12 @or_introl /3 width=2/
+ | -V1 #HT2 @or_intror * #X #H
+ elim (lift_inv_bind2 … H) -H /3 width=2/
+ ]
+ | -IHT2 #HV2 @or_intror * #X #H
+ elim (lift_inv_bind2 … H) -H /3 width=2/
+ ]
+ | elim (IHV2 d e) -IHV2
+ [ * #V1 #HV12 elim (IHT2 d e) -IHT2
+ [ * #T1 #HT12 /4 width=2/
+ | -V1 #HT2 @or_intror * #X #H
+ elim (lift_inv_flat2 … H) -H /3 width=2/
+ ]
+ | -IHT2 #HV2 @or_intror * #X #H
+ elim (lift_inv_flat2 … H) -H /3 width=2/
+ ]
+ ]
+]
+qed.
+
+lemma t_liftable_TC: ∀R. t_liftable R → t_liftable (TC … R).
+#R #HR #T1 #T2 #H elim H -T2
+[ /3 width=7/
+| #T #T2 #_ #HT2 #IHT1 #U1 #d #e #HTU1 #U2 #HTU2
+ elim (lift_total T d e) /3 width=9/
+]
+qed.
+
+lemma t_deliftable_sn_TC: ∀R. t_deliftable_sn R → t_deliftable_sn (TC … R).
+#R #HR #U1 #U2 #H elim H -U2
+[ #U2 #HU12 #T1 #d #e #HTU1
+ elim (HR … HU12 … HTU1) -U1 /3 width=3/
+| #U #U2 #_ #HU2 #IHU1 #T1 #d #e #HTU1
+ elim (IHU1 … HTU1) -U1 #T #HTU #HT1
+ elim (HR … HU2 … HTU) -U /3 width=5/
+]
+qed-.
+
+(* Basic_1: removed theorems 7:
+ lift_head lift_gen_head
+ lift_weight_map lift_weight lift_weight_add lift_weight_add_O
+ lift_tlt_dx
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lift.ma".
+
+(* BASIC TERM RELOCATION ****************************************************)
+
+(* Main properies ***********************************************************)
+
+(* Basic_1: was: lift_inj *)
+theorem lift_inj: ∀d,e,T1,U. ⇧[d,e] T1 ≡ U → ∀T2. ⇧[d,e] T2 ≡ U → T1 = T2.
+#d #e #T1 #U #H elim H -d -e -T1 -U
+[ #k #d #e #X #HX
+ lapply (lift_inv_sort2 … HX) -HX //
+| #i #d #e #Hid #X #HX
+ lapply (lift_inv_lref2_lt … HX ?) -HX //
+| #i #d #e #Hdi #X #HX
+ lapply (lift_inv_lref2_ge … HX ?) -HX // /2 width=1/
+| #p #d #e #X #HX
+ lapply (lift_inv_gref2 … HX) -HX //
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
+ elim (lift_inv_bind2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
+ elim (lift_inv_flat2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
+]
+qed-.
+
+(* Basic_1: was: lift_gen_lift *)
+theorem lift_div_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
+ ∀d2,e2,T2. ⇧[d2 + e1, e2] T2 ≡ T →
+ d1 ≤ d2 →
+ ∃∃T0. ⇧[d1, e1] T0 ≡ T2 & ⇧[d2, e2] T0 ≡ T1.
+#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
+[ #k #d1 #e1 #d2 #e2 #T2 #Hk #Hd12
+ lapply (lift_inv_sort2 … Hk) -Hk #Hk destruct /3 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12
+ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2
+ lapply (lift_inv_lref2_lt … Hi ?) -Hi /2 width=3/ /3 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12
+ elim (lift_inv_lref2 … Hi) -Hi * #Hid2 #H destruct
+ [ -Hd12 lapply (lt_plus_to_lt_l … Hid2) -Hid2 #Hid2 /3 width=3/
+ | -Hid1 >plus_plus_comm_23 in Hid2; #H lapply (le_plus_to_le_r … H) -H #H
+ elim (le_inv_plus_l … H) -H #Hide2 #He2i
+ lapply (transitive_le … Hd12 Hide2) -Hd12 #Hd12
+ >le_plus_minus_comm // >(plus_minus_m_m i e2) in ⊢ (? ? ? %); // -He2i
+ /4 width=3/
+ ]
+| #p #d1 #e1 #d2 #e2 #T2 #Hk #Hd12
+ lapply (lift_inv_gref2 … Hk) -Hk #Hk destruct /3 width=3/
+| #a #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12
+ lapply (lift_inv_bind2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct
+ elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1
+ >plus_plus_comm_23 in HU2; #HU2 elim (IHU … HU2 ?) /2 width=1/ /3 width=5/
+| #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12
+ lapply (lift_inv_flat2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct
+ elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1
+ elim (IHU … HU2 ?) // /3 width=5/
+]
+qed.
+
+(* Note: apparently this was missing in basic_1 *)
+theorem lift_div_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
+ ∀e,e2,T2. ⇧[d1 + e, e2] T2 ≡ T →
+ e ≤ e1 → e1 ≤ e + e2 →
+ ∃∃T0. ⇧[d1, e] T0 ≡ T2 & ⇧[d1, e + e2 - e1] T0 ≡ T1.
+#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
+[ #k #d1 #e1 #e #e2 #T2 #H >(lift_inv_sort2 … H) -H /2 width=3/
+| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2
+ >(lift_inv_lref2_lt … H) -H [ /3 width=3/ | /2 width=3/ ]
+| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2
+ elim (lt_or_ge (i+e1) (d1+e+e2)) #Hie1d1e2
+ [ elim (lift_inv_lref2_be … H ? ?) -H // /2 width=1/
+ | >(lift_inv_lref2_ge … H ?) -H //
+ lapply (le_plus_to_minus … Hie1d1e2) #Hd1e21i
+ elim (le_inv_plus_l … Hie1d1e2) -Hie1d1e2 #Hd1e12 #He2ie1
+ @ex2_intro [2: /2 width=1/ | skip ] -Hd1e12
+ @lift_lref_ge_minus_eq [ >plus_minus_commutative // | /2 width=1/ ]
+ ]
+| #p #d1 #e1 #e #e2 #T2 #H >(lift_inv_gref2 … H) -H /2 width=3/
+| #a #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2
+ elim (lift_inv_bind2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct
+ elim (IHV1 … HV2 ? ?) -V // >plus_plus_comm_23 in HT2; #HT2
+ elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/
+| #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2
+ elim (lift_inv_flat2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct
+ elim (IHV1 … HV2 ? ?) -V //
+ elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/
+]
+qed.
+
+theorem lift_mono: ∀d,e,T,U1. ⇧[d,e] T ≡ U1 → ∀U2. ⇧[d,e] T ≡ U2 → U1 = U2.
+#d #e #T #U1 #H elim H -d -e -T -U1
+[ #k #d #e #X #HX
+ lapply (lift_inv_sort1 … HX) -HX //
+| #i #d #e #Hid #X #HX
+ lapply (lift_inv_lref1_lt … HX ?) -HX //
+| #i #d #e #Hdi #X #HX
+ lapply (lift_inv_lref1_ge … HX ?) -HX //
+| #p #d #e #X #HX
+ lapply (lift_inv_gref1 … HX) -HX //
+| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
+ elim (lift_inv_bind1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
+| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
+ elim (lift_inv_flat1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
+]
+qed-.
+
+(* Basic_1: was: lift_free (left to right) *)
+theorem lift_trans_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
+ ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 →
+ d1 ≤ d2 → d2 ≤ d1 + e1 → ⇧[d1, e1 + e2] T1 ≡ T2.
+#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
+[ #k #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_
+ >(lift_inv_sort1 … HT2) -HT2 //
+| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #Hd12 #_
+ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2
+ lapply (lift_inv_lref1_lt … HT2 Hid2) /2 width=1/
+| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #_ #Hd21
+ lapply (lift_inv_lref1_ge … HT2 ?) -HT2
+ [ @(transitive_le … Hd21 ?) -Hd21 /2 width=1/
+ | -Hd21 /2 width=1/
+ ]
+| #p #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_
+ >(lift_inv_gref1 … HT2) -HT2 //
+| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21
+ elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
+ lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10
+ lapply (IHT12 … HT20 ? ?) /2 width=1/
+| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21
+ elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
+ lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10
+ lapply (IHT12 … HT20 ? ?) // /2 width=1/
+]
+qed.
+
+(* Basic_1: was: lift_d (right to left) *)
+theorem lift_trans_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
+ ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d2 ≤ d1 →
+ ∃∃T0. ⇧[d2, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T0 ≡ T2.
+#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
+[ #k #d1 #e1 #d2 #e2 #X #HX #_
+ >(lift_inv_sort1 … HX) -HX /2 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_
+ lapply (lt_to_le_to_lt … (d1+e2) Hid1 ?) // #Hie2
+ elim (lift_inv_lref1 … HX) -HX * #Hid2 #HX destruct /3 width=3/ /4 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hd21
+ lapply (transitive_le … Hd21 Hid1) -Hd21 #Hid2
+ lapply (lift_inv_lref1_ge … HX ?) -HX /2 width=3/ #HX destruct
+ >plus_plus_comm_23 /4 width=3/
+| #p #d1 #e1 #d2 #e2 #X #HX #_
+ >(lift_inv_gref1 … HX) -HX /2 width=3/
+| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21
+ elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
+ elim (IHV12 … HV20 ?) -IHV12 -HV20 //
+ elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ /3 width=5/
+| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21
+ elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
+ elim (IHV12 … HV20 ?) -IHV12 -HV20 //
+ elim (IHT12 … HT20 ?) -IHT12 -HT20 // /3 width=5/
+]
+qed.
+
+(* Basic_1: was: lift_d (left to right) *)
+theorem lift_trans_ge: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
+ ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d1 + e1 ≤ d2 →
+ ∃∃T0. ⇧[d2 - e1, e2] T1 ≡ T0 & ⇧[d1, e1] T0 ≡ T2.
+#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
+[ #k #d1 #e1 #d2 #e2 #X #HX #_
+ >(lift_inv_sort1 … HX) -HX /2 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hded
+ lapply (lt_to_le_to_lt … (d1+e1) Hid1 ?) // #Hid1e
+ lapply (lt_to_le_to_lt … (d2-e1) Hid1 ?) /2 width=1/ #Hid2e
+ lapply (lt_to_le_to_lt … Hid1e Hded) -Hid1e -Hded #Hid2
+ lapply (lift_inv_lref1_lt … HX ?) -HX // #HX destruct /3 width=3/
+| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_
+ elim (lift_inv_lref1 … HX) -HX * #Hied #HX destruct /4 width=3/
+| #p #d1 #e1 #d2 #e2 #X #HX #_
+ >(lift_inv_gref1 … HX) -HX /2 width=3/
+| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded
+ elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
+ elim (IHV12 … HV20 ?) -IHV12 -HV20 //
+ elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ #T
+ <plus_minus /2 width=2/ /3 width=5/
+| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded
+ 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.
+
+(* Advanced properties ******************************************************)
+
+lemma lift_conf_O1: ∀T,T1,d1,e1. ⇧[d1, e1] T ≡ T1 → ∀T2,e2. ⇧[0, e2] T ≡ T2 →
+ ∃∃T0. ⇧[0, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T2 ≡ T0.
+#T #T1 #d1 #e1 #HT1 #T2 #e2 #HT2
+elim (lift_total T1 0 e2) #T0 #HT10
+elim (lift_trans_le … HT1 … HT10 ?) -HT1 // #X #HTX #HT20
+lapply (lift_mono … HTX … HT2) -T #H destruct /2 width=3/
+qed.
+
+lemma lift_conf_be: ∀T,T1,d,e1. ⇧[d, e1] T ≡ T1 → ∀T2,e2. ⇧[d, e2] T ≡ T2 →
+ e1 ≤ e2 → ⇧[d + e1, e2 - e1] T1 ≡ T2.
+#T #T1 #d #e1 #HT1 #T2 #e2 #HT2 #He12
+elim (lift_split … HT2 (d+e1) e1 ? ? ?) -HT2 // #X #H
+>(lift_mono … H … HT1) -T //
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/term_vector.ma".
+include "basic_2/relocation/lift.ma".
+
+(* BASIC TERM VECTOR RELOCATION *********************************************)
+
+inductive liftv (d,e:nat) : relation (list term) ≝
+| liftv_nil : liftv d e ◊ ◊
+| liftv_cons: ∀T1s,T2s,T1,T2.
+ ⇧[d, e] T1 ≡ T2 → liftv d e T1s T2s →
+ liftv d e (T1 @ T1s) (T2 @ T2s)
+.
+
+interpretation "relocation (vector)" 'RLift d e T1s T2s = (liftv d e T1s T2s).
+
+(* Basic inversion lemmas ***************************************************)
+
+fact liftv_inv_nil1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → T1s = ◊ → T2s = ◊.
+#T1s #T2s #d #e * -T1s -T2s //
+#T1s #T2s #T1 #T2 #_ #_ #H destruct
+qed.
+
+lemma liftv_inv_nil1: ∀T2s,d,e. ⇧[d, e] ◊ ≡ T2s → T2s = ◊.
+/2 width=5/ qed-.
+
+fact liftv_inv_cons1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s →
+ ∀U1,U1s. T1s = U1 @ U1s →
+ ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s &
+ T2s = U2 @ U2s.
+#T1s #T2s #d #e * -T1s -T2s
+[ #U1 #U1s #H destruct
+| #T1s #T2s #T1 #T2 #HT12 #HT12s #U1 #U1s #H destruct /2 width=5/
+]
+qed.
+
+lemma liftv_inv_cons1: ∀U1,U1s,T2s,d,e. ⇧[d, e] U1 @ U1s ≡ T2s →
+ ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s &
+ T2s = U2 @ U2s.
+/2 width=3/ qed-.
+
+(* Basic properties *********************************************************)
+
+lemma liftv_total: ∀d,e. ∀T1s:list term. ∃T2s. ⇧[d, e] T1s ≡ T2s.
+#d #e #T1s elim T1s -T1s
+[ /2 width=2/
+| #T1 #T1s * #T2s #HT12s
+ elim (lift_total T1 d e) /3 width=2/
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/lenv_length.ma".
+
+(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************)
+
+inductive lsubr: nat → nat → relation lenv ≝
+| lsubr_sort: ∀d,e. lsubr d e (⋆) (⋆)
+| lsubr_OO: ∀L1,L2. lsubr 0 0 L1 L2
+| lsubr_abbr: ∀L1,L2,V,e. lsubr 0 e L1 L2 →
+ lsubr 0 (e + 1) (L1. ⓓV) (L2.ⓓV)
+| lsubr_abst: ∀L1,L2,I,V1,V2,e. lsubr 0 e L1 L2 →
+ lsubr 0 (e + 1) (L1. ⓑ{I}V1) (L2. ⓛV2)
+| lsubr_skip: ∀L1,L2,I1,I2,V1,V2,d,e.
+ lsubr d e L1 L2 → lsubr (d + 1) e (L1. ⓑ{I1} V1) (L2. ⓑ{I2} V2)
+.
+
+interpretation
+ "local environment refinement (substitution)"
+ 'SubEq L1 d e L2 = (lsubr d e L1 L2).
+
+definition lsubr_trans: ∀S. (lenv → relation S) → Prop ≝ λS,R.
+ ∀L2,s1,s2. R L2 s1 s2 →
+ ∀L1,d,e. L1 ⊑ [d, e] L2 → R L1 s1 s2.
+
+(* Basic properties *********************************************************)
+
+lemma lsubr_bind_eq: ∀L1,L2,e. L1 ⊑ [0, e] L2 → ∀I,V.
+ L1. ⓑ{I} V ⊑ [0, e + 1] L2.ⓑ{I} V.
+#L1 #L2 #e #HL12 #I #V elim I -I /2 width=1/
+qed.
+
+lemma lsubr_abbr_lt: ∀L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
+ L1. ⓓV ⊑ [0, e] L2.ⓓV.
+#L1 #L2 #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
+qed.
+
+lemma lsubr_abst_lt: ∀L1,L2,I,V1,V2,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
+ L1. ⓑ{I}V1 ⊑ [0, e] L2. ⓛV2.
+#L1 #L2 #I #V1 #V2 #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
+qed.
+
+lemma lsubr_skip_lt: ∀L1,L2,d,e. L1 ⊑ [d - 1, e] L2 → 0 < d →
+ ∀I1,I2,V1,V2. L1. ⓑ{I1} V1 ⊑ [d, e] L2. ⓑ{I2} V2.
+#L1 #L2 #d #e #HL12 #Hd >(plus_minus_m_m d 1) // /2 width=1/
+qed.
+
+lemma lsubr_bind_lt: ∀I,L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
+ L1. ⓓV ⊑ [0, e] L2. ⓑ{I}V.
+* /2 width=1/ qed.
+
+lemma lsubr_refl: ∀d,e,L. L ⊑ [d, e] L.
+#d elim d -d
+[ #e elim e -e // #e #IHe #L elim L -L // /2 width=1/
+| #d #IHd #e #L elim L -L // /2 width=1/
+]
+qed.
+
+lemma TC_lsubr_trans: ∀S,R. lsubr_trans S R → lsubr_trans S (λL. (TC … (R L))).
+#S #R #HR #L1 #s1 #s2 #H elim H -s2
+[ /3 width=5/
+| #s #s2 #_ #Hs2 #IHs1 #L2 #d #e #HL12
+ lapply (HR … Hs2 … HL12) -HR -Hs2 -HL12 /3 width=3/
+]
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+fact lsubr_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L1 = ⋆ →
+ L2 = ⋆ ∨ (d = 0 ∧ e = 0).
+#L1 #L2 #d #e * -L1 -L2 -d -e
+[ /2 width=1/
+| /3 width=1/
+| #L1 #L2 #W #e #_ #H destruct
+| #L1 #L2 #I #W1 #W2 #e #_ #H destruct
+| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct
+]
+qed.
+
+lemma lsubr_inv_atom1: ∀L2,d,e. ⋆ ⊑ [d, e] L2 →
+ L2 = ⋆ ∨ (d = 0 ∧ e = 0).
+/2 width=3/ qed-.
+
+fact lsubr_inv_skip1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ ∀I1,K1,V1. L1 = K1.ⓑ{I1}V1 → 0 < d →
+ ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2.
+#L1 #L2 #d #e * -L1 -L2 -d -e
+[ #d #e #I1 #K1 #V1 #H destruct
+| #L1 #L2 #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/
+]
+qed.
+
+lemma lsubr_inv_skip1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊑ [d, e] L2 → 0 < d →
+ ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2.
+/2 width=5/ qed-.
+
+fact lsubr_inv_atom2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L2 = ⋆ →
+ L1 = ⋆ ∨ (d = 0 ∧ e = 0).
+#L1 #L2 #d #e * -L1 -L2 -d -e
+[ /2 width=1/
+| /3 width=1/
+| #L1 #L2 #W #e #_ #H destruct
+| #L1 #L2 #I #W1 #W2 #e #_ #H destruct
+| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct
+]
+qed.
+
+lemma lsubr_inv_atom2: ∀L1,d,e. L1 ⊑ [d, e] ⋆ →
+ L1 = ⋆ ∨ (d = 0 ∧ e = 0).
+/2 width=3/ qed-.
+
+fact lsubr_inv_abbr2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ ∀K2,V. L2 = K2.ⓓV → d = 0 → 0 < e →
+ ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV.
+#L1 #L2 #d #e * -L1 -L2 -d -e
+[ #d #e #K1 #V #H destruct
+| #L1 #L2 #K1 #V #_ #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #W #e #HL12 #K1 #V #H #_ #_ destruct /2 width=3/
+| #L1 #L2 #I #W1 #W2 #e #_ #K1 #V #H destruct
+| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #K1 #V #_ >commutative_plus normalize #H destruct
+]
+qed.
+
+lemma lsubr_inv_abbr2: ∀L1,K2,V,e. L1 ⊑ [0, e] K2.ⓓV → 0 < e →
+ ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV.
+/2 width=5/ qed-.
+
+fact lsubr_inv_skip2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ ∀I2,K2,V2. L2 = K2.ⓑ{I2}V2 → 0 < d →
+ ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1.
+#L1 #L2 #d #e * -L1 -L2 -d -e
+[ #d #e #I1 #K1 #V1 #H destruct
+| #L1 #L2 #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H
+ elim (lt_zero_false … H)
+| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/
+]
+qed.
+
+lemma lsubr_inv_skip2: ∀I2,L1,K2,V2,d,e. L1 ⊑ [d, e] K2.ⓑ{I2}V2 → 0 < d →
+ ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1.
+/2 width=5/ qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+fact lsubr_fwd_length_full1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ d = 0 → e = |L1| → |L1| ≤ |L2|.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize
+[ //
+| /2 width=1/
+| /3 width=1/
+| /3 width=1/
+| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct
+]
+qed.
+
+lemma lsubr_fwd_length_full1: ∀L1,L2. L1 ⊑ [0, |L1|] L2 → |L1| ≤ |L2|.
+/2 width=5/ qed-.
+
+fact lsubr_fwd_length_full2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
+ d = 0 → e = |L2| → |L2| ≤ |L1|.
+#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize
+[ //
+| /2 width=1/
+| /3 width=1/
+| /3 width=1/
+| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct
+]
+qed.
+
+lemma lsubr_fwd_length_full2: ∀L1,L2. L1 ⊑ [0, |L2|] L2 → |L2| ≤ |L1|.
+/2 width=5/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lsubr.ma".
+
+(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************)
+
+(* bottom element of the refinement *)
+definition lbotr: nat → nat → predicate lenv ≝
+ λd,e. NF_sn … (lsubr d e) (lsubr d e …).
+
+interpretation
+ "local environment full refinement (substitution)"
+ 'SubEqBottom d e L = (lbotr d e L).
+
+(* Basic properties *********************************************************)
+
+lemma lbotr_atom: ∀d,e. ⊒[d, e] ⋆.
+#d #e #L #H
+elim (lsubr_inv_atom2 … H) -H
+[ #H destruct //
+| * #H1 #H2 destruct //
+]
+qed.
+
+lemma lbotr_OO: ∀L. ⊒[0, 0] L.
+// qed.
+
+lemma lbotr_abbr: ∀L,V,e. ⊒[0, e] L → ⊒[0, e + 1] L.ⓓV.
+#L #V #e #HL #K #H
+elim (lsubr_inv_abbr2 … H ?) -H // <minus_plus_m_m #X #HLX #H destruct
+lapply (HL … HLX) -HL -HLX /2 width=1/
+qed.
+
+lemma lbotr_abbr_O: ∀L,V. ⊒[0,1] L.ⓓV.
+#L #V
+@(lbotr_abbr … 0) //
+qed.
+
+lemma lbotr_skip: ∀I,L,V,d,e. ⊒[d, e] L → ⊒[d + 1, e] L.ⓑ{I}V.
+#I #L #V #d #e #HL #K #H
+elim (lsubr_inv_skip2 … H ?) -H // <minus_plus_m_m #J #X #W #HLX #H destruct
+lapply (HL … HLX) -HL -HLX /2 width=1/
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+lemma lbotr_inv_bind: ∀I,L,V,e. ⊒[0, e] L.ⓑ{I}V → 0 < e →
+ ⊒[0, e - 1] L ∧ I = Abbr.
+#I #L #V #e #HL #He
+lapply (HL (L.ⓓV) ?) /2 width=1/ #H
+elim (lsubr_inv_abbr2 … H ?) -H // #K #_ #H destruct
+@conj // #L #HKL
+lapply (HL (L.ⓓV) ?) -HL /2 width=1/ -HKL #H
+elim (lsubr_inv_abbr2 … H ?) -H // -He #X #HLX #H destruct //
+qed-.
+
+lemma lbotr_inv_skip: ∀I,L,V,d,e. ⊒[d, e] L.ⓑ{I}V → 0 < d → ⊒[d - 1, e] L.
+#I #L #V #d #e #HL #Hd #K #HLK
+lapply (HL (K.ⓑ{I}V) ?) -HL /2 width=1/ -HLK #H
+elim (lsubr_inv_skip2 … H ?) -H // -Hd #J #X #W #HKX #H destruct //
+qed-.
(**************************************************************************)
include "basic_2/grammar/aarity.ma".
-include "basic_2/substitution/ldrop.ma".
+include "basic_2/relocation/ldrop.ma".
(* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************)
(* *)
(**************************************************************************)
-include "basic_2/substitution/ldrop_ldrop.ma".
+include "basic_2/relocation/ldrop_ldrop.ma".
include "basic_2/static/aaa.ma".
(* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************)
(* *)
(**************************************************************************)
-include "basic_2/substitution/ldrop_ldrop.ma".
+include "basic_2/relocation/ldrop_ldrop.ma".
include "basic_2/static/aaa.ma".
(* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************)
(* *)
(**************************************************************************)
-include "basic_2/unfold/ldrops.ma".
+include "basic_2/substitution/ldrops.ma".
include "basic_2/static/aaa_lift.ma".
(* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************)
(* *)
(**************************************************************************)
-include "basic_2/unfold/lpss_ldrop.ma".
+include "basic_2/substitution/lpss_ldrop.ma".
include "basic_2/static/aaa_lift.ma".
(* ATONIC ARITY ASSIGNMENT ON TERMS *****************************************)
-(* Properties about sn parallel unfold **************************************)
+(* Properties about sn parallel substitution ********************************)
(* Note: lemma 500 *)
lemma aaa_cpss_lpss_conf: ∀L1,T1,A. L1 ⊢ T1 ⁝ A → ∀T2. L1 ⊢ T1 ▶* T2 →
(* *)
(**************************************************************************)
-include "basic_2/substitution/ldrop.ma".
+include "basic_2/relocation/ldrop.ma".
include "basic_2/static/sd.ma".
(* STRATIFIED STATIC TYPE ASSIGNMENT ON TERMS *******************************)
(* *)
(**************************************************************************)
-include "basic_2/substitution/ldrop_ldrop.ma".
+include "basic_2/relocation/ldrop_ldrop.ma".
include "basic_2/static/ssta.ma".
(* STRATIFIED STATIC TYPE ASSIGNMENT ON TERMS *******************************)
(* *)
(**************************************************************************)
-include "basic_2/unfold/lpss_ldrop.ma".
+include "basic_2/substitution/lpss_ldrop.ma".
include "basic_2/static/ssta_lift.ma".
(* STRATIFIED STATIC TYPE ASSIGNMENT ON TERMS *******************************)
-(* Properties about sn parallel unfold **************************************)
+(* Properties about sn parallel substitution ********************************)
(* Note: apparently this was missing in basic_1 *)
lemma ssta_tpss_lpss_conf: ∀h,g,L1,T1,U1,l. ⦃h, L1⦄ ⊢ T1 •[g] ⦃l, U1⦄ →
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_append.ma".
+
+(* CONTEXT-SENSITIVE PARALLEL SUBSTITUTION FOR TERMS ************************)
+
+inductive cpss: lenv → relation term ≝
+| cpss_atom : ∀I,L. cpss L (⓪{I}) (⓪{I})
+| cpss_delta: ∀L,K,V,V2,W2,i.
+ ⇩[0, i] L ≡ K. ⓓV → cpss K V V2 →
+ ⇧[0, i + 1] V2 ≡ W2 → cpss L (#i) W2
+| cpss_bind : ∀a,I,L,V1,V2,T1,T2.
+ cpss L V1 V2 → cpss (L. ⓑ{I} V1) T1 T2 →
+ cpss L (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2)
+| cpss_flat : ∀I,L,V1,V2,T1,T2.
+ cpss L V1 V2 → cpss L T1 T2 →
+ cpss L (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
+.
+
+interpretation "context-sensitive parallel substitution (term)"
+ 'PSubstStar L T1 T2 = (cpss L T1 T2).
+
+(* Basic properties *********************************************************)
+
+(* Note: it does not hold replacing |L1| with |L2| *)
+lemma cpss_lsubr_trans: ∀L1,T1,T2. L1 ⊢ T1 ▶* T2 →
+ ∀L2. L2 ⊑ [0, |L1|] L1 → L2 ⊢ T1 ▶* T2.
+#L1 #T1 #T2 #H elim H -L1 -T1 -T2
+[ //
+| #L1 #K1 #V1 #V2 #W2 #i #HLK1 #_ #HVW2 #IHV12 #L2 #HL12
+ lapply (ldrop_fwd_ldrop2_length … HLK1) #Hi
+ lapply (ldrop_fwd_O1_length … HLK1) #H2i
+ elim (ldrop_lsubr_ldrop2_abbr … HL12 … HLK1 ? ?) -HL12 -HLK1 // -Hi
+ <H2i -H2i <minus_plus_m_m /3 width=6/
+| /4 width=1/
+| /3 width=1/
+]
+qed-.
+
+(* Basic_1: was by definition: subst1_refl *)
+lemma cpss_refl: ∀T,L. L ⊢ T ▶* T.
+#T elim T -T //
+#I elim I -I /2 width=1/
+qed.
+
+(* Basic_1: was only: subst1_ex *)
+lemma cpss_delift: ∀K,V,T1,L,d. ⇩[0, d] L ≡ (K. ⓓV) →
+ ∃∃T2,T. L ⊢ T1 ▶* T2 & ⇧[d, 1] T ≡ T2.
+#K #V #T1 elim T1 -T1
+[ * #i #L #d #HLK /2 width=4/
+ elim (lt_or_eq_or_gt i d) #Hid /3 width=4/
+ destruct
+ elim (lift_total V 0 (i+1)) #W #HVW
+ elim (lift_split … HVW i i ? ? ?) // /3 width=6/
+| * [ #a ] #I #W1 #U1 #IHW1 #IHU1 #L #d #HLK
+ elim (IHW1 … HLK) -IHW1 #W2 #W #HW12 #HW2
+ [ elim (IHU1 (L. ⓑ{I} W1) (d+1) ?) -IHU1 /2 width=1/ -HLK /3 width=9/
+ | elim (IHU1 … HLK) -IHU1 -HLK /3 width=8/
+ ]
+]
+qed-.
+
+lemma cpss_append: l_appendable_sn … cpss.
+#K #T1 #T2 #H elim H -K -T1 -T2 // /2 width=1/
+#K #K0 #V1 #V2 #W2 #i #HK0 #_ #HVW2 #IHV12 #L
+lapply (ldrop_fwd_ldrop2_length … HK0) #H
+@(cpss_delta … (L@@K0) V1 … HVW2) //
+@(ldrop_O1_append_sn_le … HK0) /2 width=2/ (**) (* /3/ does not work *)
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+fact cpss_inv_atom1_aux: ∀L,T1,T2. L ⊢ T1 ▶* T2 → ∀I. T1 = ⓪{I} →
+ T2 = ⓪{I} ∨
+ ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ▶* V2 &
+ ⇧[O, i + 1] V2 ≡ T2 &
+ I = LRef i.
+#L #T1 #T2 * -L -T1 -T2
+[ #I #L #J #H destruct /2 width=1/
+| #L #K #V #V2 #T2 #i #HLK #HV2 #HVT2 #I #H destruct /3 width=8/
+| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
+| #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
+]
+qed-.
+
+lemma cpss_inv_atom1: ∀I,L,T2. L ⊢ ⓪{I} ▶* T2 →
+ T2 = ⓪{I} ∨
+ ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ▶* V2 &
+ ⇧[O, i + 1] V2 ≡ T2 &
+ I = LRef i.
+/2 width=3 by cpss_inv_atom1_aux/ qed-.
+
+(* Basic_1: was only: subst1_gen_sort *)
+lemma cpss_inv_sort1: ∀L,T2,k. L ⊢ ⋆k ▶* T2 → T2 = ⋆k.
+#L #T2 #k #H
+elim (cpss_inv_atom1 … H) -H //
+* #K #V #V2 #i #_ #_ #_ #H destruct
+qed-.
+
+(* Basic_1: was only: subst1_gen_lref *)
+lemma cpss_inv_lref1: ∀L,T2,i. L ⊢ #i ▶* T2 →
+ T2 = #i ∨
+ ∃∃K,V,V2. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ▶* V2 &
+ ⇧[O, i + 1] V2 ≡ T2.
+#L #T2 #i #H
+elim (cpss_inv_atom1 … H) -H /2 width=1/
+* #K #V #V2 #j #HLK #HV2 #HVT2 #H destruct /3 width=6/
+qed-.
+
+lemma cpss_inv_gref1: ∀L,T2,p. L ⊢ §p ▶* T2 → T2 = §p.
+#L #T2 #p #H
+elim (cpss_inv_atom1 … H) -H //
+* #K #V #V2 #i #_ #_ #_ #H destruct
+qed-.
+
+fact cpss_inv_bind1_aux: ∀L,U1,U2. L ⊢ U1 ▶* U2 →
+ ∀a,I,V1,T1. U1 = ⓑ{a,I} V1. T1 →
+ ∃∃V2,T2. L ⊢ V1 ▶* V2 &
+ L. ⓑ{I} V1 ⊢ T1 ▶* T2 &
+ U2 = ⓑ{a,I} V2. T2.
+#L #U1 #U2 * -L -U1 -U2
+[ #I #L #b #J #W1 #U1 #H destruct
+| #L #K #V #V2 #W2 #i #_ #_ #_ #b #J #W1 #U1 #H destruct
+| #a #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #b #J #W1 #U1 #H destruct /2 width=5/
+| #I #L #V1 #V2 #T1 #T2 #_ #_ #b #J #W1 #U1 #H destruct
+]
+qed-.
+
+lemma cpss_inv_bind1: ∀a,I,L,V1,T1,U2. L ⊢ ⓑ{a,I} V1. T1 ▶* U2 →
+ ∃∃V2,T2. L ⊢ V1 ▶* V2 &
+ L. ⓑ{I} V1 ⊢ T1 ▶* T2 &
+ U2 = ⓑ{a,I} V2. T2.
+/2 width=3 by cpss_inv_bind1_aux/ qed-.
+
+fact cpss_inv_flat1_aux: ∀L,U1,U2. L ⊢ U1 ▶* U2 →
+ ∀I,V1,T1. U1 = ⓕ{I} V1. T1 →
+ ∃∃V2,T2. L ⊢ V1 ▶* V2 & L ⊢ T1 ▶* T2 &
+ U2 = ⓕ{I} V2. T2.
+#L #U1 #U2 * -L -U1 -U2
+[ #I #L #J #W1 #U1 #H destruct
+| #L #K #V #V2 #W2 #i #_ #_ #_ #J #W1 #U1 #H destruct
+| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #W1 #U1 #H destruct
+| #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #J #W1 #U1 #H destruct /2 width=5/
+]
+qed-.
+
+lemma cpss_inv_flat1: ∀I,L,V1,T1,U2. L ⊢ ⓕ{I} V1. T1 ▶* U2 →
+ ∃∃V2,T2. L ⊢ V1 ▶* V2 & L ⊢ T1 ▶* T2 &
+ U2 = ⓕ{I} V2. T2.
+/2 width=3 by cpss_inv_flat1_aux/ qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma cpss_fwd_tw: ∀L,T1,T2. L ⊢ T1 ▶* T2 → ♯{T1} ≤ ♯{T2}.
+#L #T1 #T2 #H elim H -L -T1 -T2 normalize
+/3 width=1 by monotonic_le_plus_l, le_plus/ (**) (* auto is too slow without trace *)
+qed-.
+
+lemma cpss_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ▶* T →
+ ∃∃L2,T2. |L1| = |L2| & T = L2 @@ T2.
+#L1 @(lenv_ind_dx … L1) -L1 normalize
+[ #L #T1 #T #HT1
+ @(ex2_2_intro … (⋆)) // (**) (* explicit constructor *)
+| #I #L1 #V1 #IH #L #T1 #X
+ >shift_append_assoc normalize #H
+ elim (cpss_inv_bind1 … H) -H
+ #V0 #T0 #_ #HT10 #H destruct
+ elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct
+ >append_length >HL12 -HL12
+ @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *)
+]
+qed-.
+
+(* Basic_1: removed theorems 27:
+ subst0_gen_sort subst0_gen_lref subst0_gen_head subst0_gen_lift_lt
+ subst0_gen_lift_false subst0_gen_lift_ge subst0_refl subst0_trans
+ subst0_lift_lt subst0_lift_ge subst0_lift_ge_S subst0_lift_ge_s
+ subst0_subst0 subst0_subst0_back subst0_weight_le subst0_weight_lt
+ subst0_confluence_neq subst0_confluence_eq subst0_tlt_head
+ subst0_confluence_lift subst0_tlt
+ subst1_head subst1_gen_head subst1_lift_S subst1_confluence_lift
+ subst1_gen_lift_eq subst1_confluence_neq
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop_ldrop.ma".
+include "basic_2/substitution/cpss.ma".
+
+(* CONTEXT-SENSITIVE PARALLEL SUBSTITUTION FOR TERMS ************************)
+
+(* Relocation properties ****************************************************)
+
+(* Basic_1: was only: subst1_lift_lt subst1_lift_ge *)
+lemma cpss_lift: l_liftable cpss.
+#K #T1 #T2 #H elim H -K -T1 -T2
+[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2
+ >(lift_mono … H1 … H2) -H1 -H2 //
+| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2
+ elim (lift_inv_lref1 … H) * #Hid #H destruct
+ [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // <minus_plus #W2 #HVW2 #HWU2
+ elim (ldrop_trans_le … HLK … HKV) -K /2 width=2/ #X #HLK #H
+ elim (ldrop_inv_skip2 … H) -H /2 width=1/ -Hid #K #Y #HKV #HVY #H destruct /3 width=8/
+ | lapply (lift_trans_be … HVW2 … HWU2 ? ?) -W2 // /2 width=1/ >plus_plus_comm_23 #HVU2
+ lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/
+ ]
+| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
+ elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
+ elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/
+| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
+ elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
+ elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/
+]
+qed.
+
+(* Basic_1: was only: subst1_gen_lift_lt subst1_gen_lift_ge *)
+lemma cpss_inv_lift1: l_deliftable_sn cpss.
+#L #U1 #U2 #H elim H -L -U1 -U2
+[ * #L #i #K #d #e #_ #T1 #H
+ [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/
+ | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/
+ | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/
+ ]
+| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H
+ elim (lift_inv_lref2 … H) -H * #Hid #H destruct
+ [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV
+ elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2
+ elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus <plus_minus_m_m // -Hid /3 width=8/
+ | elim (le_inv_plus_l … Hid) #Hdie #Hei
+ lapply (ldrop_conf_ge … HLK … HLV ?) -L // #HKLV
+ elim (lift_split … HVW2 d (i - e + 1)) -HVW2 [4: // |3: /2 width=1/ |2: /3 width=1/ ] -Hid -Hdie
+ #V1 #HV1 >plus_minus // <minus_minus // /2 width=1/ <minus_n_n <plus_n_O /3 width=8/
+ ]
+| #a #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
+ elim (lift_inv_bind2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHV12 … HLK … HWV1) -IHV12 #W2 #HW12 #HWV2
+ elim (IHU12 … HTU1) -IHU12 -HTU1 /3 width=5/
+| #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
+ elim (lift_inv_flat2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHV12 … HLK … HWV1) -V1
+ elim (IHU12 … HLK … HTU1) -U1 -HLK /3 width=5/
+]
+qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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".
-
-(* SUPCLOSURE ***************************************************************)
-
-inductive fsup: bi_relation lenv term ≝
-| fsup_lref : ∀I,L,V. fsup (L.ⓑ{I}V) (#0) L V
-| fsup_bind_sn: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) L V
-| fsup_bind_dx: ∀a,I,L,V,T. fsup L (ⓑ{a,I}V.T) (L.ⓑ{I}V) T
-| fsup_flat_sn: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L V
-| fsup_flat_dx: ∀I,L,V,T. fsup L (ⓕ{I}V.T) L T
-| fsup_ldrop : ∀L1,K1,K2,T1,T2,U1,d,e.
- ⇩[d, e] L1 ≡ K1 → ⇧[d, e] T1 ≡ U1 →
- fsup K1 T1 K2 T2 → fsup L1 U1 K2 T2
-.
-
-interpretation
- "structural successor (closure)"
- 'SupTerm L1 T1 L2 T2 = (fsup L1 T1 L2 T2).
-
-(* Basic properties *********************************************************)
-
-lemma fsup_lref_S_lt: ∀I,L,K,V,T,i. 0 < i → ⦃L, #(i-1)⦄ ⊃ ⦃K, T⦄ → ⦃L.ⓑ{I}V, #i⦄ ⊃ ⦃K, T⦄.
-/3 width=7/ qed.
-
-lemma fsup_lref: ∀I,K,V,i,L. ⇩[0, i] L ≡ K.ⓑ{I}V → ⦃L, #i⦄ ⊃ ⦃K, V⦄.
-#I #K #V #i @(nat_elim1 i) -i #i #IH #L #H
-elim (ldrop_inv_O1_pair2 … H) -H *
-[ #H1 #H2 destruct //
-| #I1 #K1 #V1 #HK1 #H #Hi destruct
- lapply (IH … HK1) /2 width=1/
-]
-qed.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma fsup_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ♯{L2, T2} < ♯{L1, T1}.
-#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 //
-#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12
-lapply (ldrop_fwd_lw … HLK1) -HLK1 #HLK1
-lapply (lift_fwd_tw … HTU1) -HTU1 #HTU1
-@(lt_to_le_to_lt … IHT12) -IHT12 /2 width=1/
-qed-.
-
-fact fsup_fwd_length_lref1_aux: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀i. T1 = #i → |L2| < |L1|.
-#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2
-[ 6: #L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #i #H destruct
- lapply (ldrop_fwd_length … HLK1) -HLK1 #HLK1
- elim (lift_inv_lref2 … HTU1) -HTU1 * #Hdei #H destruct
- @(lt_to_le_to_lt … HLK1) /2 width=2/
-| normalize // |2,3: #a
-] #I #L #V #T #j #H destruct
-qed-.
-
-lemma fsup_fwd_length_lref1: ∀L1,L2,T2,i. ⦃L1, #i⦄ ⊃ ⦃L2, T2⦄ → |L2| < |L1|.
-/2 width=5 by fsup_fwd_length_lref1_aux/
-qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/fsup.ma".
+
+(* PLUS-ITERATED SUPCLOSURE *************************************************)
+
+definition fsupp: bi_relation lenv term ≝ bi_TC … fsup.
+
+interpretation "plus-iterated structural successor (closure)"
+ 'SupTermPlus L1 T1 L2 T2 = (fsupp L1 T1 L2 T2).
+
+(* Basic eliminators ********************************************************)
+
+lemma fsupp_ind: ∀L1,T1. ∀R:relation2 lenv term.
+ (∀L2,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → R L2 T2) →
+ (∀L,T,L2,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ → R L T → R L2 T2) →
+ ∀L2,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → R L2 T2.
+#L1 #T1 #R #IH1 #IH2 #L2 #T2 #H
+@(bi_TC_ind … IH1 IH2 ? ? H)
+qed-.
+
+lemma fsupp_ind_dx: ∀L2,T2. ∀R:relation2 lenv term.
+ (∀L1,T1. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → R L1 T1) →
+ (∀L1,L,T1,T. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ → R L T → R L1 T1) →
+ ∀L1,T1. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → R L1 T1.
+#L2 #T2 #R #IH1 #IH2 #L1 #T1 #H
+@(bi_TC_ind_dx … IH1 IH2 ? ? H)
+qed-.
+
+(* Basic properties *********************************************************)
+
+lemma fsup_fsupp: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
+/2 width=1/ qed.
+
+lemma fsupp_strap1: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ →
+ ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+lemma fsupp_strap2: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ →
+ ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma fsupp_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → ♯{L2, T2} < ♯{L1, T1}.
+#L1 #L2 #T1 #T2 #H @(fsupp_ind … H) -L2 -T2
+/3 width=3 by fsup_fwd_cw, transitive_lt/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/fsupp.ma".
+
+(* PLUS-ITERATED SUPCLOSURE *************************************************)
+
+(* Main propertis ***********************************************************)
+
+theorem fsupp_trans: bi_transitive … fsupp.
+/2 width=4/ qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/fsupp.ma".
+
+(* STAR-ITERATED SUPCLOSURE *************************************************)
+
+definition fsups: bi_relation lenv term ≝ bi_star … fsup.
+
+interpretation "star-iterated structural successor (closure)"
+ 'SupTermStar L1 T1 L2 T2 = (fsups L1 T1 L2 T2).
+
+(* Basic eliminators ********************************************************)
+
+lemma fsups_ind: ∀L1,T1. ∀R:relation2 lenv term. R L1 T1 →
+ (∀L,L2,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ → R L T → R L2 T2) →
+ ∀L2,T2. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → R L2 T2.
+#L1 #T1 #R #IH1 #IH2 #L2 #T2 #H
+@(bi_star_ind … IH1 IH2 ? ? H)
+qed-.
+
+lemma fsups_ind_dx: ∀L2,T2. ∀R:relation2 lenv term. R L2 T2 →
+ (∀L1,L,T1,T. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃* ⦃L2, T2⦄ → R L T → R L1 T1) →
+ ∀L1,T1. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → R L1 T1.
+#L2 #T2 #R #IH1 #IH2 #L1 #T1 #H
+@(bi_star_ind_dx … IH1 IH2 ? ? H)
+qed-.
+
+(* Basic properties *********************************************************)
+
+lemma fsups_refl: bi_reflexive … fsups.
+/2 width=1/ qed.
+
+lemma fsupp_fsups: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
+/2 width=1/ qed.
+
+lemma fsup_fsups: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
+/2 width=1/ qed.
+
+lemma fsups_strap1: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ →
+ ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+lemma fsups_strap2: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃* ⦃L2, T2⦄ →
+ ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+lemma fsups_fsupp_fsupp: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ →
+ ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+lemma fsupp_fsups_fsupp: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ →
+ ⦃L, T⦄ ⊃* ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
+/2 width=4/ qed.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma fsups_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → ♯{L2, T2} ≤ ♯{L1, T1}.
+#L1 #L2 #T1 #T2 #H @(fsups_ind … H) -L2 -T2 //
+/4 width=3 by fsup_fwd_cw, lt_to_le_to_lt, lt_to_le/ (**) (* slow even with trace *)
+qed-.
+(*
+(* Advanced inversion lemmas on plus-iterated supclosure ********************)
+
+lemma fsupp_inv_bind1_fsups: ∀b,J,L1,L2,W,U,T2. ⦃L1, ⓑ{b,J}W.U⦄ ⊃+ ⦃L2, T2⦄ →
+ ⦃L1, W⦄ ⊃* ⦃L2, T2⦄ ∨ ⦃L1.ⓑ{J}W, U⦄ ⊃* ⦃L2, T2⦄.
+#b #J #L1 #L2 #W #U #T2 #H @(fsupp_ind … H) -L2 -T2
+[ #L2 #T2 #H
+ elim (fsup_inv_bind1 … H) -H * #H1 #H2 destruct /2 width=1/
+| #L #T #L2 #T2 #_ #HT2 * /3 width=4/
+]
+qed-.
+
+lemma fsupp_inv_flat1_fsups: ∀J,L1,L2,W,U,T2. ⦃L1, ⓕ{J}W.U⦄ ⊃+ ⦃L2, T2⦄ →
+ ⦃L1, W⦄ ⊃* ⦃L2, T2⦄ ∨ ⦃L1, U⦄ ⊃* ⦃L2, T2⦄.
+#J #L1 #L2 #W #U #T2 #H @(fsupp_ind … H) -L2 -T2
+[ #L2 #T2 #H
+ elim (fsup_inv_flat1 … H) -H #H1 * #H2 destruct /2 width=1/
+| #L #T #L2 #T2 #_ #HT2 * /3 width=4/
+]
+qed-.
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/fsups.ma".
+
+(* STAR-ITERATED SUPCLOSURE *************************************************)
+
+(* Main properties **********************************************************)
+
+theorem fsups_trans: bi_transitive … fsups.
+/2 width=4/ qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/genv.ma".
-
-(* GLOBAL ENVIRONMENT SLICING ***********************************************)
-
-inductive gdrop (e:nat): relation genv ≝
-| gdrop_gt: ∀G. |G| ≤ e → gdrop e G (⋆)
-| gdrop_eq: ∀G. |G| = e + 1 → gdrop e G G
-| gdrop_lt: ∀I,G1,G2,V. e < |G1| → gdrop e G1 G2 → gdrop e (G1. ⓑ{I} V) G2
-.
-
-interpretation "global slicing"
- 'RDrop e G1 G2 = (gdrop e G1 G2).
-
-(* basic inversion lemmas ***************************************************)
-
-lemma gdrop_inv_gt: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| ≤ e → G2 = ⋆.
-#G1 #G2 #e * -G1 -G2 //
-[ #G #H >H -H >commutative_plus #H
- lapply (le_plus_to_le_r … 0 H) -H #H
- lapply (le_n_O_to_eq … H) -H #H destruct
-| #I #G1 #G2 #V #H1 #_ #H2
- lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 normalize in ⊢ (? % ? → ?); >commutative_plus #H
- lapply (lt_plus_to_lt_l … 0 H) -H #H
- elim (lt_zero_false … H)
-]
-qed-.
-
-lemma gdrop_inv_eq: ∀G1,G2,e. ⇩[e] G1 ≡ G2 → |G1| = e + 1 → G1 = G2.
-#G1 #G2 #e * -G1 -G2 //
-[ #G #H1 #H2 >H2 in H1; -H2 >commutative_plus #H
- lapply (le_plus_to_le_r … 0 H) -H #H
- lapply (le_n_O_to_eq … H) -H #H destruct
-| #I #G1 #G2 #V #H1 #_ normalize #H2
- <(injective_plus_l … H2) in H1; -H2 #H
- elim (lt_refl_false … H)
-]
-qed-.
-
-fact gdrop_inv_lt_aux: ∀I,G,G1,G2,V,e. ⇩[e] G ≡ G2 → G = G1. ⓑ{I} V →
- e < |G1| → ⇩[e] G1 ≡ G2.
-#I #G #G1 #G2 #V #e * -G -G2
-[ #G #H1 #H destruct #H2
- lapply (le_to_lt_to_lt … H1 H2) -H1 -H2 normalize in ⊢ (? % ? → ?); >commutative_plus #H
- lapply (lt_plus_to_lt_l … 0 H) -H #H
- elim (lt_zero_false … H)
-| #G #H1 #H2 destruct >(injective_plus_l … H1) -H1 #H
- elim (lt_refl_false … H)
-| #J #G #G2 #W #_ #HG2 #H destruct //
-]
-qed.
-
-lemma gdrop_inv_lt: ∀I,G1,G2,V,e.
- ⇩[e] G1. ⓑ{I} V ≡ G2 → e < |G1| → ⇩[e] G1 ≡ G2.
-/2 width=5/ qed-.
-
-(* Basic properties *********************************************************)
-
-lemma gdrop_total: ∀e,G1. ∃G2. ⇩[e] G1 ≡ G2.
-#e #G1 elim G1 -G1 /3 width=2/
-#I #V #G1 * #G2 #HG12
-elim (lt_or_eq_or_gt e (|G1|)) #He
-[ /3 width=2/
-| destruct /3 width=2/
-| @ex_intro [2: @gdrop_gt normalize /2 width=1/ | skip ] (**) (* explicit constructor *)
-]
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/gdrop.ma".
-
-(* GLOBAL ENVIRONMENT SLICING ***********************************************)
-
-(* Main properties **********************************************************)
-
-theorem gdrop_mono: ∀G,G1,e. ⇩[e] G ≡ G1 → ∀G2. ⇩[e] G ≡ G2 → G1 = G2.
-#G #G1 #e #H elim H -G -G1
-[ #G #He #G2 #H
- >(gdrop_inv_gt … H He) -H -He //
-| #G #He #G2 #H
- >(gdrop_inv_eq … H He) -H -He //
-| #I #G #G1 #V #He #_ #IHG1 #G2 #H
- lapply (gdrop_inv_lt … H He) -H -He /2 width=1/
-]
-qed-.
-
-lemma gdrop_dec: ∀G1,G2,e. Decidable (⇩[e] G1 ≡ G2).
-#G1 #G2 #e
-elim (gdrop_total e G1) #G #HG1
-elim (genv_eq_dec G G2) #HG2
-[ destruct /2 width=1/
-| @or_intror #HG12
- lapply (gdrop_mono … HG1 … HG12) -HG1 -HG12 /2 width=1/
-]
-qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/term_vector.ma".
+
+(* GENERIC RELOCATION WITH PAIRS ********************************************)
+
+inductive at: list2 nat nat → relation nat ≝
+| at_nil: ∀i. at ⟠ i i
+| at_lt : ∀des,d,e,i1,i2. i1 < d →
+ at des i1 i2 → at ({d, e} @ des) i1 i2
+| at_ge : ∀des,d,e,i1,i2. d ≤ i1 →
+ at des (i1 + e) i2 → at ({d, e} @ des) i1 i2
+.
+
+interpretation "application (generic relocation with pairs)"
+ 'RAt i1 des i2 = (at des i1 i2).
+
+(* Basic inversion lemmas ***************************************************)
+
+fact at_inv_nil_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 → des = ⟠ → i1 = i2.
+#des #i1 #i2 * -des -i1 -i2
+[ //
+| #des #d #e #i1 #i2 #_ #_ #H destruct
+| #des #d #e #i1 #i2 #_ #_ #H destruct
+]
+qed.
+
+lemma at_inv_nil: ∀i1,i2. @⦃i1, ⟠⦄ ≡ i2 → i1 = i2.
+/2 width=3/ qed-.
+
+fact at_inv_cons_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 →
+ ∀d,e,des0. des = {d, e} @ des0 →
+ i1 < d ∧ @⦃i1, des0⦄ ≡ i2 ∨
+ d ≤ i1 ∧ @⦃i1 + e, des0⦄ ≡ i2.
+#des #i1 #i2 * -des -i1 -i2
+[ #i #d #e #des #H destruct
+| #des1 #d1 #e1 #i1 #i2 #Hid1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/
+| #des1 #d1 #e1 #i1 #i2 #Hdi1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/
+]
+qed.
+
+lemma at_inv_cons: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
+ i1 < d ∧ @⦃i1, des⦄ ≡ i2 ∨
+ d ≤ i1 ∧ @⦃i1 + e, des⦄ ≡ i2.
+/2 width=3/ qed-.
+
+lemma at_inv_cons_lt: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
+ i1 < d → @⦃i1, des⦄ ≡ i2.
+#des #d #e #i1 #e2 #H
+elim (at_inv_cons … H) -H * // #Hdi1 #_ #Hi1d
+lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd
+elim (lt_refl_false … Hd)
+qed-.
+
+lemma at_inv_cons_ge: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
+ d ≤ i1 → @⦃i1 + e, des⦄ ≡ i2.
+#des #d #e #i1 #e2 #H
+elim (at_inv_cons … H) -H * // #Hi1d #_ #Hdi1
+lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd
+elim (lt_refl_false … Hd)
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/substitution/gr2.ma".
+
+(* GENERIC RELOCATION WITH PAIRS ********************************************)
+
+(* Main properties **********************************************************)
+
+theorem at_mono: ∀des,i,i1. @⦃i, des⦄ ≡ i1 → ∀i2. @⦃i, des⦄ ≡ i2 → i1 = i2.
+#des #i #i1 #H elim H -des -i -i1
+[ #i #x #H <(at_inv_nil … H) -x //
+| #des #d #e #i #i1 #Hid #_ #IHi1 #x #H
+ lapply (at_inv_cons_lt … H Hid) -H -Hid /2 width=1/
+| #des #d #e #i #i1 #Hdi #_ #IHi1 #x #H
+ lapply (at_inv_cons_ge … H Hdi) -H -Hdi /2 width=1/
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/substitution/gr2.ma".
+
+(* GENERIC RELOCATION WITH PAIRS ********************************************)
+
+inductive minuss: nat → relation (list2 nat nat) ≝
+| minuss_nil: ∀i. minuss i ⟠ ⟠
+| minuss_lt : ∀des1,des2,d,e,i. i < d → minuss i des1 des2 →
+ minuss i ({d, e} @ des1) ({d - i, e} @ des2)
+| minuss_ge : ∀des1,des2,d,e,i. d ≤ i → minuss (e + i) des1 des2 →
+ minuss i ({d, e} @ des1) des2
+.
+
+interpretation "minus (generic relocation with pairs)"
+ 'RMinus des1 i des2 = (minuss i des1 des2).
+
+(* Basic inversion lemmas ***************************************************)
+
+fact minuss_inv_nil1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 → des1 = ⟠ → des2 = ⟠.
+#des1 #des2 #i * -des1 -des2 -i
+[ //
+| #des1 #des2 #d #e #i #_ #_ #H destruct
+| #des1 #des2 #d #e #i #_ #_ #H destruct
+]
+qed.
+
+lemma minuss_inv_nil1: ∀des2,i. ⟠ ▭ i ≡ des2 → des2 = ⟠.
+/2 width=4/ qed-.
+
+fact minuss_inv_cons1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 →
+ ∀d,e,des. des1 = {d, e} @ des →
+ d ≤ i ∧ des ▭ e + i ≡ des2 ∨
+ ∃∃des0. i < d & des ▭ i ≡ des0 &
+ des2 = {d - i, e} @ des0.
+#des1 #des2 #i * -des1 -des2 -i
+[ #i #d #e #des #H destruct
+| #des1 #des #d1 #e1 #i1 #Hid1 #Hdes #d2 #e2 #des2 #H destruct /3 width=3/
+| #des1 #des #d1 #e1 #i1 #Hdi1 #Hdes #d2 #e2 #des2 #H destruct /3 width=1/
+]
+qed.
+
+lemma minuss_inv_cons1: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
+ d ≤ i ∧ des1 ▭ e + i ≡ des2 ∨
+ ∃∃des. i < d & des1 ▭ i ≡ des &
+ des2 = {d - i, e} @ des.
+/2 width=3/ qed-.
+
+lemma minuss_inv_cons1_ge: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
+ d ≤ i → des1 ▭ e + i ≡ des2.
+#des1 #des2 #d #e #i #H
+elim (minuss_inv_cons1 … H) -H * // #des #Hid #_ #_ #Hdi
+lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi
+elim (lt_refl_false … Hi)
+qed-.
+
+lemma minuss_inv_cons1_lt: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
+ i < d →
+ ∃∃des. des1 ▭ i ≡ des & des2 = {d - i, e} @ des.
+#des1 #des2 #d #e #i #H
+elim (minuss_inv_cons1 … H) -H * /2 width=3/ #Hdi #_ #Hid
+lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi
+elim (lt_refl_false … Hi)
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/cl_weight.ma".
-include "basic_2/substitution/lift.ma".
-include "basic_2/substitution/lsubr.ma".
-
-(* LOCAL ENVIRONMENT SLICING ************************************************)
-
-(* Basic_1: includes: drop_skip_bind *)
-inductive ldrop: nat → nat → relation lenv ≝
-| ldrop_atom : ∀d,e. ldrop d e (⋆) (⋆)
-| ldrop_pair : ∀L,I,V. ldrop 0 0 (L. ⓑ{I} V) (L. ⓑ{I} V)
-| ldrop_ldrop: ∀L1,L2,I,V,e. ldrop 0 e L1 L2 → ldrop 0 (e + 1) (L1. ⓑ{I} V) L2
-| ldrop_skip : ∀L1,L2,I,V1,V2,d,e.
- ldrop d e L1 L2 → ⇧[d,e] V2 ≡ V1 →
- ldrop (d + 1) e (L1. ⓑ{I} V1) (L2. ⓑ{I} V2)
-.
-
-interpretation "local slicing" 'RDrop d e L1 L2 = (ldrop d e L1 L2).
-
-definition l_liftable: (lenv → relation term) → Prop ≝
- λR. ∀K,T1,T2. R K T1 T2 → ∀L,d,e. ⇩[d, e] L ≡ K →
- ∀U1. ⇧[d, e] T1 ≡ U1 → ∀U2. ⇧[d, e] T2 ≡ U2 → R L U1 U2.
-
-definition l_deliftable_sn: (lenv → relation term) → Prop ≝
- λR. ∀L,U1,U2. R L U1 U2 → ∀K,d,e. ⇩[d, e] L ≡ K →
- ∀T1. ⇧[d, e] T1 ≡ U1 →
- ∃∃T2. ⇧[d, e] T2 ≡ U2 & R K T1 T2.
-
-definition dropable_sn: relation lenv → Prop ≝
- λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀L2. R L1 L2 →
- ∃∃K2. R K1 K2 & ⇩[d, e] L2 ≡ K2.
-
-definition dedropable_sn: relation lenv → Prop ≝
- λR. ∀L1,K1,d,e. ⇩[d, e] L1 ≡ K1 → ∀K2. R K1 K2 →
- ∃∃L2. R L1 L2 & ⇩[d, e] L2 ≡ K2.
-
-definition dropable_dx: relation lenv → Prop ≝
- λR. ∀L1,L2. R L1 L2 → ∀K2,e. ⇩[0, e] L2 ≡ K2 →
- ∃∃K1. ⇩[0, e] L1 ≡ K1 & R K1 K2.
-
-(* Basic inversion lemmas ***************************************************)
-
-fact ldrop_inv_refl_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 → e = 0 → L1 = L2.
-#d #e #L1 #L2 * -d -e -L1 -L2
-[ //
-| //
-| #L1 #L2 #I #V #e #_ #_ >commutative_plus normalize #H destruct
-| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct
-]
-qed.
-
-(* Basic_1: was: drop_gen_refl *)
-lemma ldrop_inv_refl: ∀L1,L2. ⇩[0, 0] L1 ≡ L2 → L1 = L2.
-/2 width=5/ qed-.
-
-fact ldrop_inv_atom1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → L1 = ⋆ →
- L2 = ⋆.
-#d #e #L1 #L2 * -d -e -L1 -L2
-[ //
-| #L #I #V #H destruct
-| #L1 #L2 #I #V #e #_ #H destruct
-| #L1 #L2 #I #V1 #V2 #d #e #_ #_ #H destruct
-]
-qed.
-
-(* Basic_1: was: drop_gen_sort *)
-lemma ldrop_inv_atom1: ∀d,e,L2. ⇩[d, e] ⋆ ≡ L2 → L2 = ⋆.
-/2 width=5/ qed-.
-
-fact ldrop_inv_O1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → d = 0 →
- ∀K,I,V. L1 = K. ⓑ{I} V →
- (e = 0 ∧ L2 = K. ⓑ{I} V) ∨
- (0 < e ∧ ⇩[d, e - 1] K ≡ L2).
-#d #e #L1 #L2 * -d -e -L1 -L2
-[ #d #e #_ #K #I #V #H destruct
-| #L #I #V #_ #K #J #W #HX destruct /3 width=1/
-| #L1 #L2 #I #V #e #HL12 #_ #K #J #W #H destruct /3 width=1/
-| #L1 #L2 #I #V1 #V2 #d #e #_ #_ >commutative_plus normalize #H destruct
-]
-qed.
-
-lemma ldrop_inv_O1: ∀e,K,I,V,L2. ⇩[0, e] K. ⓑ{I} V ≡ L2 →
- (e = 0 ∧ L2 = K. ⓑ{I} V) ∨
- (0 < e ∧ ⇩[0, e - 1] K ≡ L2).
-/2 width=3/ qed-.
-
-lemma ldrop_inv_pair1: ∀K,I,V,L2. ⇩[0, 0] K. ⓑ{I} V ≡ L2 → L2 = K. ⓑ{I} V.
-#K #I #V #L2 #H
-elim (ldrop_inv_O1 … H) -H * // #H destruct
-elim (lt_refl_false … H)
-qed-.
-
-(* Basic_1: was: drop_gen_drop *)
-lemma ldrop_inv_ldrop1: ∀e,K,I,V,L2.
- ⇩[0, e] K. ⓑ{I} V ≡ L2 → 0 < e → ⇩[0, e - 1] K ≡ L2.
-#e #K #I #V #L2 #H #He
-elim (ldrop_inv_O1 … H) -H * // #H destruct
-elim (lt_refl_false … He)
-qed-.
-
-fact ldrop_inv_skip1_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d →
- ∀I,K1,V1. L1 = K1. ⓑ{I} V1 →
- ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 &
- ⇧[d - 1, e] V2 ≡ V1 &
- L2 = K2. ⓑ{I} V2.
-#d #e #L1 #L2 * -d -e -L1 -L2
-[ #d #e #_ #I #K #V #H destruct
-| #L #I #V #H elim (lt_refl_false … H)
-| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H)
-| #X #L2 #Y #Z #V2 #d #e #HL12 #HV12 #_ #I #L1 #V1 #H destruct /2 width=5/
-]
-qed.
-
-(* Basic_1: was: drop_gen_skip_l *)
-lemma ldrop_inv_skip1: ∀d,e,I,K1,V1,L2. ⇩[d, e] K1. ⓑ{I} V1 ≡ L2 → 0 < d →
- ∃∃K2,V2. ⇩[d - 1, e] K1 ≡ K2 &
- ⇧[d - 1, e] V2 ≡ V1 &
- L2 = K2. ⓑ{I} V2.
-/2 width=3/ qed-.
-
-lemma ldrop_inv_O1_pair2: ∀I,K,V,e,L1. ⇩[0, e] L1 ≡ K. ⓑ{I} V →
- (e = 0 ∧ L1 = K. ⓑ{I} V) ∨
- ∃∃I1,K1,V1. ⇩[0, e - 1] K1 ≡ K. ⓑ{I} V & L1 = K1.ⓑ{I1}V1 & 0 < e.
-#I #K #V #e *
-[ #H lapply (ldrop_inv_atom1 … H) -H #H destruct
-| #L1 #I1 #V1 #H
- elim (ldrop_inv_O1 … H) -H *
- [ #H1 #H2 destruct /3 width=1/
- | /3 width=5/
- ]
-]
-qed-.
-
-fact ldrop_inv_skip2_aux: ∀d,e,L1,L2. ⇩[d, e] L1 ≡ L2 → 0 < d →
- ∀I,K2,V2. L2 = K2. ⓑ{I} V2 →
- ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 &
- ⇧[d - 1, e] V2 ≡ V1 &
- L1 = K1. ⓑ{I} V1.
-#d #e #L1 #L2 * -d -e -L1 -L2
-[ #d #e #_ #I #K #V #H destruct
-| #L #I #V #H elim (lt_refl_false … H)
-| #L1 #L2 #I #V #e #_ #H elim (lt_refl_false … H)
-| #L1 #X #Y #V1 #Z #d #e #HL12 #HV12 #_ #I #L2 #V2 #H destruct /2 width=5/
-]
-qed.
-
-(* Basic_1: was: drop_gen_skip_r *)
-lemma ldrop_inv_skip2: ∀d,e,I,L1,K2,V2. ⇩[d, e] L1 ≡ K2. ⓑ{I} V2 → 0 < d →
- ∃∃K1,V1. ⇩[d - 1, e] K1 ≡ K2 & ⇧[d - 1, e] V2 ≡ V1 &
- L1 = K1. ⓑ{I} V1.
-/2 width=3/ qed-.
-
-(* Basic properties *********************************************************)
-
-(* Basic_1: was by definition: drop_refl *)
-lemma ldrop_refl: ∀L. ⇩[0, 0] L ≡ L.
-#L elim L -L //
-qed.
-
-lemma ldrop_ldrop_lt: ∀L1,L2,I,V,e.
- ⇩[0, e - 1] L1 ≡ L2 → 0 < e → ⇩[0, e] L1. ⓑ{I} V ≡ L2.
-#L1 #L2 #I #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
-qed.
-
-lemma ldrop_skip_lt: ∀L1,L2,I,V1,V2,d,e.
- ⇩[d - 1, e] L1 ≡ L2 → ⇧[d - 1, e] V2 ≡ V1 → 0 < d →
- ⇩[d, e] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2.
-#L1 #L2 #I #V1 #V2 #d #e #HL12 #HV21 #Hd >(plus_minus_m_m d 1) // /2 width=1/
-qed.
-
-lemma ldrop_O1_le: ∀i,L. i ≤ |L| → ∃K. ⇩[0, i] L ≡ K.
-#i @(nat_ind_plus … i) -i /2 width=2/
-#i #IHi *
-[ #H lapply (le_n_O_to_eq … H) -H >commutative_plus normalize #H destruct
-| #L #I #V normalize #H
- elim (IHi L ?) -IHi /2 width=1/ -H /3 width=2/
-]
-qed.
-
-lemma ldrop_O1_lt: ∀L,i. i < |L| → ∃∃I,K,V. ⇩[0, i] L ≡ K.ⓑ{I}V.
-#L elim L -L
-[ #i #H elim (lt_zero_false … H)
-| #L #I #V #IHL #i @(nat_ind_plus … i) -i /2 width=4/
- #i #_ normalize #H
- elim (IHL i ? ) -IHL /2 width=1/ -H /3 width=4/
-]
-qed.
-
-lemma ldrop_lsubr_ldrop2_abbr: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- ∀K2,V,i. ⇩[0, i] L2 ≡ K2. ⓓV →
- d ≤ i → i < d + e →
- ∃∃K1. K1 ⊑ [0, d + e - i - 1] K2 &
- ⇩[0, i] L1 ≡ K1. ⓓV.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e
-[ #d #e #K1 #V #i #H
- lapply (ldrop_inv_atom1 … H) -H #H destruct
-| #L1 #L2 #K1 #V #i #_ #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #V #e #HL12 #IHL12 #K1 #W #i #H #_ #Hie
- elim (ldrop_inv_O1 … H) -H * #Hi #HLK1
- [ -IHL12 -Hie destruct
- <minus_n_O <minus_plus_m_m // /2 width=3/
- | -HL12
- elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /4 width=3/
- ]
-| #L1 #L2 #I #V1 #V2 #e #_ #IHL12 #K1 #W #i #H #_ #Hie
- elim (ldrop_inv_O1 … H) -H * #Hi #HLK1
- [ -IHL12 -Hie -Hi destruct
- | elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hie >minus_minus_comm >arith_b1 // /3 width=3/
- ]
-| #L1 #L2 #I1 #I2 #V1 #V2 #d #e #_ #IHL12 #K1 #V #i #H #Hdi >plus_plus_comm_23 #Hide
- elim (le_inv_plus_l … Hdi) #Hdim #Hi
- lapply (ldrop_inv_ldrop1 … H ?) -H // #HLK1
- elim (IHL12 … HLK1 ? ?) -IHL12 -HLK1 // /2 width=1/ -Hdi -Hide >minus_minus_comm >arith_b1 // /3 width=3/
-]
-qed.
-
-lemma dropable_sn_TC: ∀R. dropable_sn R → dropable_sn (TC … R).
-#R #HR #L1 #K1 #d #e #HLK1 #L2 #H elim H -L2
-[ #L2 #HL12
- elim (HR … HLK1 … HL12) -HR -L1 /3 width=3/
-| #L #L2 #_ #HL2 * #K #HK1 #HLK
- elim (HR … HLK … HL2) -HR -L /3 width=3/
-]
-qed.
-
-lemma dedropable_sn_TC: ∀R. dedropable_sn R → dedropable_sn (TC … R).
-#R #HR #L1 #K1 #d #e #HLK1 #K2 #H elim H -K2
-[ #K2 #HK12
- elim (HR … HLK1 … HK12) -HR -K1 /3 width=3/
-| #K #K2 #_ #HK2 * #L #HL1 #HLK
- elim (HR … HLK … HK2) -HR -K /3 width=3/
-]
-qed.
-
-lemma dropable_dx_TC: ∀R. dropable_dx R → dropable_dx (TC … R).
-#R #HR #L1 #L2 #H elim H -L2
-[ #L2 #HL12 #K2 #e #HLK2
- elim (HR … HL12 … HLK2) -HR -L2 /3 width=3/
-| #L #L2 #_ #HL2 #IHL1 #K2 #e #HLK2
- elim (HR … HL2 … HLK2) -HR -L2 #K #HLK #HK2
- elim (IHL1 … HLK) -L /3 width=5/
-]
-qed.
-
-(* Basic forvard lemmas *****************************************************)
-
-(* Basic_1: was: drop_S *)
-lemma ldrop_fwd_ldrop2: ∀L1,I2,K2,V2,e. ⇩[O, e] L1 ≡ K2. ⓑ{I2} V2 →
- ⇩[O, e + 1] L1 ≡ K2.
-#L1 elim L1 -L1
-[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct
-| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H
- elim (ldrop_inv_O1 … H) -H * #He #H
- [ -IHL1 destruct /2 width=1/
- | @ldrop_ldrop >(plus_minus_m_m e 1) // /2 width=3/
- ]
-]
-qed-.
-
-lemma ldrop_fwd_length: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → |L2| ≤ |L1|.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize /2 width=1/
-qed-.
-
-lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ♯{L2} ≤ ♯{L1}.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e // normalize
-[ /2 width=3/
-| #L1 #L2 #I #V1 #V2 #d #e #_ #HV21 #IHL12
- >(lift_fwd_tw … HV21) -HV21 /2 width=1/
-]
-qed-.
-
-lemma ldrop_pair2_fwd_fw: ∀I,L,K,V,d,e. ⇩[d, e] L ≡ K. ⓑ{I} V →
- ∀T. ♯{K, V} < ♯{L, T}.
-#I #L #K #V #d #e #H #T
-lapply (ldrop_fwd_lw … H) -H #H
-@(le_to_lt_to_lt … H) -H /3 width=1/
-qed-.
-
-lemma ldrop_fwd_ldrop2_length: ∀L1,I2,K2,V2,e.
- ⇩[0, e] L1 ≡ K2. ⓑ{I2} V2 → e < |L1|.
-#L1 elim L1 -L1
-[ #I2 #K2 #V2 #e #H lapply (ldrop_inv_atom1 … H) -H #H destruct
-| #K1 #I1 #V1 #IHL1 #I2 #K2 #V2 #e #H
- elim (ldrop_inv_O1 … H) -H * #He #H
- [ -IHL1 destruct //
- | lapply (IHL1 … H) -IHL1 -H #HeK1 whd in ⊢ (? ? %); /2 width=1/
- ]
-]
-qed-.
-
-lemma ldrop_fwd_O1_length: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → |L2| = |L1| - e.
-#L1 elim L1 -L1
-[ #L2 #e #H >(ldrop_inv_atom1 … H) -H //
-| #K1 #I1 #V1 #IHL1 #L2 #e #H
- elim (ldrop_inv_O1 … H) -H * #He #H
- [ -IHL1 destruct //
- | lapply (IHL1 … H) -IHL1 -H #H >H -H normalize
- >minus_le_minus_minus_comm //
- ]
-]
-qed-.
-
-(* Basic_1: removed theorems 50:
- drop_ctail drop_skip_flat
- cimp_flat_sx cimp_flat_dx cimp_bind cimp_getl_conf
- drop_clear drop_clear_O drop_clear_S
- clear_gen_sort clear_gen_bind clear_gen_flat clear_gen_flat_r
- clear_gen_all clear_clear clear_mono clear_trans clear_ctail clear_cle
- getl_ctail_clen getl_gen_tail clear_getl_trans getl_clear_trans
- getl_clear_bind getl_clear_conf getl_dec getl_drop getl_drop_conf_lt
- getl_drop_conf_ge getl_conf_ge_drop getl_drop_conf_rev
- drop_getl_trans_lt drop_getl_trans_le drop_getl_trans_ge
- getl_drop_trans getl_flt getl_gen_all getl_gen_sort getl_gen_O
- getl_gen_S getl_gen_2 getl_gen_flat getl_gen_bind getl_conf_le
- getl_trans getl_refl getl_head getl_flat getl_ctail getl_mono
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/ldrop.ma".
-
-(* DROPPING *****************************************************************)
-
-(* Properties on append for local environments ******************************)
-
-fact ldrop_O1_append_sn_le_aux: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 →
- d = 0 → e ≤ |L1| →
- ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize // /4 width=1/
-#d #e #_ #H #L -d
-lapply (le_n_O_to_eq … H) -H //
-qed-.
-
-lemma ldrop_O1_append_sn_le: ∀L1,L2,e. ⇩[0, e] L1 ≡ L2 → e ≤ |L1| →
- ∀L. ⇩[0, e] L @@ L1 ≡ L @@ L2.
-/2 width=3 by ldrop_O1_append_sn_le_aux/ qed.
-
-(* Inversion lemmas on append for local environments ************************)
-
-lemma ldrop_O1_inv_append1_ge: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K →
- |L2| ≤ e → ⇩[0, e - |L2|] L1 ≡ K.
-#K #L1 #L2 elim L2 -L2 normalize //
-#L2 #I #V #IHL2 #e #H #H1e
-elim (ldrop_inv_O1 … H) -H * #H2e #HL12 destruct
-[ lapply (le_n_O_to_eq … H1e) -H1e -IHL2
- >commutative_plus normalize #H destruct
-| <minus_plus >minus_minus_comm /3 width=1/
-]
-qed-.
-
-lemma ldrop_O1_inv_append1_le: ∀K,L1,L2,e. ⇩[0, e] L1 @@ L2 ≡ K → e ≤ |L2| →
- ∀K2. ⇩[0, e] L2 ≡ K2 → K = L1 @@ K2.
-#K #L1 #L2 elim L2 -L2 normalize
-[ #e #H1 #H2 #K2 #H3
- lapply (le_n_O_to_eq … H2) -H2 #H2
- lapply (ldrop_inv_atom1 … H3) -H3 #H3 destruct
- >(ldrop_inv_refl … H1) -H1 //
-| #L2 #I #V #IHL2 #e @(nat_ind_plus … e) -e [ -IHL2 ]
- [ #H1 #_ #K2 #H2
- lapply (ldrop_inv_refl … H1) -H1 #H1
- lapply (ldrop_inv_refl … H2) -H2 #H2 destruct //
- | #e #_ #H1 #H #K2 #H2
- lapply (le_plus_to_le_r … H) -H
- lapply (ldrop_inv_ldrop1 … H1 ?) -H1 //
- lapply (ldrop_inv_ldrop1 … H2 ?) -H2 //
- <minus_plus_m_m /2 width=4/
- ]
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lsubr_lbotr.ma".
-include "basic_2/substitution/ldrop_ldrop.ma".
-
-(* DROPPING *****************************************************************)
-
-(* Inversion lemmas about local env. full refinement for substitution *******)
-
-(* Note: ldrop_ldrop not needed *)
-lemma lbotr_inv_ldrop: ∀I,L,K,V,i. ⇩[0, i] L ≡ K. ⓑ{I}V → ∀d,e. ⊒[d, e] L →
- d ≤ i → i < d + e → I = Abbr.
-#I #L elim L -L
-[ #K #V #i #H
- lapply (ldrop_inv_atom1 … H) -H #H destruct
-| #L #J #W #IHL #K #V #i #H
- elim (ldrop_inv_O1 … H) -H *
- [ -IHL #H1 #H2 #d #e #HL #Hdi #Hide destruct
- lapply (le_n_O_to_eq … Hdi) -Hdi #H destruct
- lapply (HL … (L.ⓓW) ?) -HL /2 width=1/ #H
- elim (lsubr_inv_abbr2 … H ?) -H // -Hide #K #_ #H destruct //
- | #Hi #HLK #d @(nat_ind_plus … d) -d
- [ #e #H #_ #Hide
- elim (lbotr_inv_bind … H ?) -H [2: /2 width=2/ ] #HL #H destruct
- @(IHL … HLK … HL) -IHL -HLK -HL // /2 width=1/
- | #d #_ #e #H #Hdi #Hide
- lapply (lbotr_inv_skip … H ?) -H // #HL
- @(IHL … HLK … HL) -IHL -HLK -HL /2 width=1/
- ]
- ]
-]
-qed-.
-
-(* Properties about local env. full refinement for substitution *************)
-
-(* Note: ldrop_ldrop not needed *)
-lemma lbotr_ldrop: ∀L,d,e.
- (∀I,K,V,i. d ≤ i → i < d + e → ⇩[0, i] L ≡ K. ⓑ{I}V → I = Abbr) →
- ⊒[d, e] L.
-#L elim L -L //
-#L #I #V #IHL #d @(nat_ind_plus … d) -d
-[ #e @(nat_ind_plus … e) -e //
- #e #_ #H0
- >(H0 I L V 0 ? ? ?) //
- /5 width=6 by lbotr_abbr, ldrop_ldrop, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *)
-| #d #_ #e #H0
- /5 width=6 by lbotr_skip, ldrop_ldrop, le_S_S, lt_minus_to_plus_r/ (**) (* auto now too slow without trace *)
-]
-qed.
-
-lemma lbotr_ldrop_trans_le: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 →
- dd + ee ≤ d → ⊒[dd, ee] L2.
-#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee
-@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2
-lapply (lt_to_le_to_lt … Hiddee Hddee) -Hddee #Hid
-elim (ldrop_trans_le … HL12 … HLK2 ?) -L2 /2 width=2/ #X #HLK1 #H
-elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K1 #V1 #HK12 #HV21 #H destruct
-@(lbotr_inv_ldrop … HLK1 … HL1) -L1 -K1 -V1 //
-qed.
-
-lemma lbotr_ldrop_trans_be_up: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 →
- ∀dd,ee. ⊒[dd, ee] L1 →
- dd ≤ d + e → d + e ≤ dd + ee →
- ⊒[d, dd + ee - d - e] L2.
-#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hdde #Hddee
-@lbotr_ldrop #I #K2 #V2 #i #Hdi #Hiddee #HLK2
-lapply (transitive_le ? ? (i+e)… Hdde ?) -Hdde /2 width=1/ #Hddie
->commutative_plus in Hiddee; >minus_minus_comm <plus_minus_m_m /2 width=1/ -Hddee #Hiddee
-lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hdi #HL1K2
-@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus // -Hddie /2 width=1/
-qed.
-
-lemma lbotr_ldrop_trans_ge: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀dd,ee. ⊒[dd, ee] L1 →
- d + e ≤ dd → ⊒[dd - e, ee] L2.
-#L1 #L2 #d #e #HL12 #dd #ee #HL1 #Hddee
-@lbotr_ldrop #I #K2 #V2 #i #Hddi #Hiddee #HLK2
-elim (le_inv_plus_l … Hddee) -Hddee #Hdde #Hedd
->plus_minus in Hiddee; // #Hiddee
-lapply (transitive_le … Hdde Hddi) -Hdde #Hid
-lapply (ldrop_trans_ge … HL12 … HLK2 ?) -L2 // -Hid #HL1K2
-@(lbotr_inv_ldrop … HL1K2 … HL1) -L1 >commutative_plus /2 width=1/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lift_lift.ma".
-include "basic_2/substitution/ldrop.ma".
-
-(* DROPPING *****************************************************************)
-
-(* Main properties **********************************************************)
-
-(* Basic_1: was: drop_mono *)
-theorem ldrop_mono: ∀d,e,L,L1. ⇩[d, e] L ≡ L1 →
- ∀L2. ⇩[d, e] L ≡ L2 → L1 = L2.
-#d #e #L #L1 #H elim H -d -e -L -L1
-[ #d #e #L2 #H
- >(ldrop_inv_atom1 … H) -L2 //
-| #K #I #V #L2 #HL12
- <(ldrop_inv_refl … HL12) -L2 //
-| #L #K #I #V #e #_ #IHLK #L2 #H
- lapply (ldrop_inv_ldrop1 … H ?) -H // /2 width=1/
-| #L #K1 #I #T #V1 #d #e #_ #HVT1 #IHLK1 #X #H
- elim (ldrop_inv_skip1 … H ?) -H // <minus_plus_m_m #K2 #V2 #HLK2 #HVT2 #H destruct
- >(lift_inj … HVT1 … HVT2) -HVT1 -HVT2
- >(IHLK1 … HLK2) -IHLK1 -HLK2 //
-]
-qed-.
-
-(* Basic_1: was: drop_conf_ge *)
-theorem ldrop_conf_ge: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 →
- ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 + e1 ≤ e2 →
- ⇩[0, e2 - e1] L1 ≡ L2.
-#d1 #e1 #L #L1 #H elim H -d1 -e1 -L -L1
-[ #d #e #e2 #L2 #H
- >(ldrop_inv_atom1 … H) -L2 //
-| //
-| #L #K #I #V #e #_ #IHLK #e2 #L2 #H #He2
- lapply (ldrop_inv_ldrop1 … H ?) -H /2 width=2/ #HL2
- <minus_plus >minus_minus_comm /3 width=1/
-| #L #K #I #V1 #V2 #d #e #_ #_ #IHLK #e2 #L2 #H #Hdee2
- lapply (transitive_le 1 … Hdee2) // #He2
- lapply (ldrop_inv_ldrop1 … H ?) -H // -He2 #HL2
- lapply (transitive_le (1 + e) … Hdee2) // #Hee2
- @ldrop_ldrop_lt >minus_minus_comm /3 width=1/ (**) (* explicit constructor *)
-]
-qed.
-
-(* Note: apparently this was missing in basic_1 *)
-theorem ldrop_conf_be: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 →
- ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → d1 ≤ e2 → e2 ≤ d1 + e1 →
- ∃∃L. ⇩[0, d1 + e1 - e2] L2 ≡ L & ⇩[0, d1] L1 ≡ L.
-#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1
-[ #d1 #e1 #L2 #e2 #H >(ldrop_inv_atom1 … H) -H /2 width=3/
-| normalize #L #I #V #L2 #e2 #HL2 #_ #He2
- lapply (le_n_O_to_eq … He2) -He2 #H destruct
- lapply (ldrop_inv_refl … HL2) -HL2 #H destruct /2 width=3/
-| normalize #L0 #K0 #I #V1 #e1 #HLK0 #IHLK0 #L2 #e2 #H #_ #He21
- lapply (ldrop_inv_O1 … H) -H * * #He2 #HL20
- [ -IHLK0 -He21 destruct <minus_n_O /3 width=3/
- | -HLK0 <minus_le_minus_minus_comm //
- elim (IHLK0 … HL20 ? ?) -L0 // /2 width=1/ /2 width=3/
- ]
-| #L0 #K0 #I #V0 #V1 #d1 #e1 >plus_plus_comm_23 #_ #_ #IHLK0 #L2 #e2 #H #Hd1e2 #He2de1
- elim (le_inv_plus_l … Hd1e2) #_ #He2
- <minus_le_minus_minus_comm //
- lapply (ldrop_inv_ldrop1 … H ?) -H // #HL02
- elim (IHLK0 … HL02 ? ?) -L0 /2 width=1/ /3 width=3/
-]
-qed.
-
-(* Note: apparently this was missing in basic_1 *)
-theorem ldrop_conf_le: ∀L0,L1,d1,e1. ⇩[d1, e1] L0 ≡ L1 →
- ∀L2,e2. ⇩[0, e2] L0 ≡ L2 → e2 ≤ d1 →
- ∃∃L. ⇩[0, e2] L1 ≡ L & ⇩[d1 - e2, e1] L2 ≡ L.
-#L0 #L1 #d1 #e1 #H elim H -L0 -L1 -d1 -e1
-[ #d1 #e1 #L2 #e2 #H
- lapply (ldrop_inv_atom1 … H) -H #H destruct /2 width=3/
-| #K0 #I #V0 #L2 #e2 #H1 #H2
- lapply (le_n_O_to_eq … H2) -H2 #H destruct
- lapply (ldrop_inv_pair1 … H1) -H1 #H destruct /2 width=3/
-| #K0 #K1 #I #V0 #e1 #HK01 #_ #L2 #e2 #H1 #H2
- lapply (le_n_O_to_eq … H2) -H2 #H destruct
- lapply (ldrop_inv_pair1 … H1) -H1 #H destruct /3 width=3/
-| #K0 #K1 #I #V0 #V1 #d1 #e1 #HK01 #HV10 #IHK01 #L2 #e2 #H #He2d1
- elim (ldrop_inv_O1 … H) -H *
- [ -IHK01 -He2d1 #H1 #H2 destruct /3 width=5/
- | -HK01 -HV10 #He2 #HK0L2
- elim (IHK01 … HK0L2 ?) -IHK01 -HK0L2 /2 width=1/ >minus_le_minus_minus_comm // /3 width=3/
- ]
-]
-qed.
-
-(* Basic_1: was: drop_trans_ge *)
-theorem ldrop_trans_ge: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L →
- ∀e2,L2. ⇩[0, e2] L ≡ L2 → d1 ≤ e2 → ⇩[0, e1 + e2] L1 ≡ L2.
-#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L
-[ #d #e #e2 #L2 #H
- >(ldrop_inv_atom1 … H) -H -L2 //
-| //
-| /3 width=1/
-| #L1 #L2 #I #V1 #V2 #d #e #H_ #_ #IHL12 #e2 #L #H #Hde2
- lapply (lt_to_le_to_lt 0 … Hde2) // #He2
- lapply (lt_to_le_to_lt … (e + e2) He2 ?) // #Hee2
- lapply (ldrop_inv_ldrop1 … H ?) -H // #HL2
- @ldrop_ldrop_lt // >le_plus_minus // @IHL12 /2 width=1/ (**) (* explicit constructor *)
-]
-qed.
-
-(* Basic_1: was: drop_trans_le *)
-theorem ldrop_trans_le: ∀d1,e1,L1,L. ⇩[d1, e1] L1 ≡ L →
- ∀e2,L2. ⇩[0, e2] L ≡ L2 → e2 ≤ d1 →
- ∃∃L0. ⇩[0, e2] L1 ≡ L0 & ⇩[d1 - e2, e1] L0 ≡ L2.
-#d1 #e1 #L1 #L #H elim H -d1 -e1 -L1 -L
-[ #d #e #e2 #L2 #H
- >(ldrop_inv_atom1 … H) -L2 /2 width=3/
-| #K #I #V #e2 #L2 #HL2 #H
- lapply (le_n_O_to_eq … H) -H #H destruct /2 width=3/
-| #L1 #L2 #I #V #e #_ #IHL12 #e2 #L #HL2 #H
- lapply (le_n_O_to_eq … H) -H #H destruct
- elim (IHL12 … HL2 ?) -IHL12 -HL2 // #L0 #H #HL0
- lapply (ldrop_inv_refl … H) -H #H destruct /3 width=5/
-| #L1 #L2 #I #V1 #V2 #d #e #HL12 #HV12 #IHL12 #e2 #L #H #He2d
- elim (ldrop_inv_O1 … H) -H *
- [ -He2d -IHL12 #H1 #H2 destruct /3 width=5/
- | -HL12 -HV12 #He2 #HL2
- elim (IHL12 … HL2 ?) -L2 [ >minus_le_minus_minus_comm // /3 width=3/ | /2 width=1/ ]
- ]
-]
-qed.
-
-(* Basic_1: was: drop_conf_rev *)
-axiom ldrop_div: ∀e1,L1,L. ⇩[0, e1] L1 ≡ L → ∀e2,L2. ⇩[0, e2] L2 ≡ L →
- ∃∃L0. ⇩[0, e1] L0 ≡ L2 & ⇩[e1, e2] L0 ≡ L1.
-
-(* Basic_1: was: drop_conf_lt *)
-lemma ldrop_conf_lt: ∀d1,e1,L,L1. ⇩[d1, e1] L ≡ L1 →
- ∀e2,K2,I,V2. ⇩[0, e2] L ≡ K2. ⓑ{I} V2 →
- e2 < d1 → let d ≝ d1 - e2 - 1 in
- ∃∃K1,V1. ⇩[0, e2] L1 ≡ K1. ⓑ{I} V1 &
- ⇩[d, e1] K2 ≡ K1 & ⇧[d, e1] V1 ≡ V2.
-#d1 #e1 #L #L1 #H1 #e2 #K2 #I #V2 #H2 #He2d1
-elim (ldrop_conf_le … H1 … H2 ?) -L [2: /2 width=2/] #K #HL1K #HK2
-elim (ldrop_inv_skip1 … HK2 ?) -HK2 [2: /2 width=1/] #K1 #V1 #HK21 #HV12 #H destruct /2 width=5/
-qed.
-
-lemma ldrop_trans_ge_comm: ∀d1,e1,e2,L1,L2,L.
- ⇩[d1, e1] L1 ≡ L → ⇩[0, e2] L ≡ L2 → d1 ≤ e2 →
- ⇩[0, e2 + e1] L1 ≡ L2.
-#e1 #e1 #e2 >commutative_plus /2 width=5/
-qed.
-
-lemma ldrop_conf_div: ∀I1,L,K,V1,e1. ⇩[0, e1] L ≡ K. ⓑ{I1} V1 →
- ∀I2,V2,e2. ⇩[0, e2] L ≡ K. ⓑ{I2} V2 →
- ∧∧ e1 = e2 & I1 = I2 & V1 = V2.
-#I1 #L #K #V1 #e1 #HLK1 #I2 #V2 #e2 #HLK2
-elim (le_or_ge e1 e2) #He
-[ lapply (ldrop_conf_ge … HLK1 … HLK2 ?)
-| lapply (ldrop_conf_ge … HLK2 … HLK1 ?)
-] -HLK1 -HLK2 // #HK
-lapply (ldrop_fwd_O1_length … HK) #H
-elim (discr_minus_x_xy … H) -H
-[1,3: normalize <plus_n_Sm #H destruct ]
-#H >H in HK; #HK
-lapply (ldrop_inv_refl … HK) -HK #H destruct
-lapply (inv_eq_minus_O … H) -H /3 width=1/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/lenv_px.ma".
-include "basic_2/substitution/ldrop.ma".
-
-(* DROPPING *****************************************************************)
-
-(* Properties on pointwise extension ****************************************)
-
-lemma lpx_deliftable_dropable: ∀R. t_deliftable_sn R → dropable_sn (lpx R).
-#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
-[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/
-| #K1 #I #V1 #X #H
- elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/
-| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H
- elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
- elim (IHLK1 … HL12) -L1 /3 width=3/
-| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H
- elim (lpx_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
- elim (HR … HV12 … HWV1) -V1
- elim (IHLK1 … HL12) -L1 /3 width=5/
-]
-qed.
-
-lemma lpx_liftable_dedropable: ∀R. reflexive ? R →
- t_liftable R → dedropable_sn (lpx R).
-#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
-[ #d #e #X #H >(lpx_inv_atom1 … H) -H /2 width=3/
-| #K1 #I #V1 #X #H
- elim (lpx_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/
-| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12
- elim (IHLK1 … HK12) -K1 /3 width=5/
-| #L1 #K1 #I #V1 #W1 #d #e #_ #HWV1 #IHLK1 #X #H
- elim (lpx_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct
- elim (lift_total W2 d e) #V2 #HWV2
- lapply (H2R … HW12 … HWV1 … HWV2) -W1
- elim (IHLK1 … HK12) -K1 /3 width=5/
-]
-qed.
-
-fact lpx_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx R L1 L2 →
- d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx R K1 K2.
-#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e
-[ #d #e #X #H >(lpx_inv_atom2 … H) -H /2 width=3/
-| #K2 #I #V2 #X #H
- elim (lpx_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/
-| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_
- elim (lpx_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct
- elim (IHLK2 … HL12 ?) -L2 // /3 width=3/
-| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_
- >commutative_plus normalize #H destruct
-]
-qed-.
-
-lemma lpx_dropable: ∀R. dropable_dx (lpx R).
-/2 width=5 by lpx_dropable_aux/ qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/lenv_px_sn.ma".
-include "basic_2/substitution/ldrop.ma".
-
-(* DROPPING *****************************************************************)
-
-(* Properties on sn pointwise extension *************************************)
-
-lemma lpx_sn_deliftable_dropable: ∀R. l_deliftable_sn R → dropable_sn (lpx_sn R).
-#R #HR #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
-[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/
-| #K1 #I #V1 #X #H
- elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct /3 width=5/
-| #L1 #K1 #I #V1 #e #_ #IHLK1 #X #H
- elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
- elim (IHLK1 … HL12) -L1 /3 width=3/
-| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H
- elim (lpx_sn_inv_pair1 … H) -H #L2 #V2 #HL12 #HV12 #H destruct
- elim (HR … HV12 … HLK1 … HWV1) -V1
- elim (IHLK1 … HL12) -L1 /3 width=5/
-]
-qed-.
-
-lemma lpx_sn_liftable_dedropable: ∀R. (∀L. reflexive ? (R L)) →
- l_liftable R → dedropable_sn (lpx_sn R).
-#R #H1R #H2R #L1 #K1 #d #e #H elim H -L1 -K1 -d -e
-[ #d #e #X #H >(lpx_sn_inv_atom1 … H) -H /2 width=3/
-| #K1 #I #V1 #X #H
- elim (lpx_sn_inv_pair1 … H) -H #K2 #V2 #HK12 #HV12 #H destruct /3 width=5/
-| #L1 #K1 #I #V1 #e #_ #IHLK1 #K2 #HK12
- elim (IHLK1 … HK12) -K1 /3 width=5/
-| #L1 #K1 #I #V1 #W1 #d #e #HLK1 #HWV1 #IHLK1 #X #H
- elim (lpx_sn_inv_pair1 … H) -H #K2 #W2 #HK12 #HW12 #H destruct
- elim (lift_total W2 d e) #V2 #HWV2
- lapply (H2R … HW12 … HLK1 … HWV1 … HWV2) -W1
- elim (IHLK1 … HK12) -K1 /3 width=5/
-]
-qed-.
-
-fact lpx_sn_dropable_aux: ∀R,L2,K2,d,e. ⇩[d, e] L2 ≡ K2 → ∀L1. lpx_sn R L1 L2 →
- d = 0 → ∃∃K1. ⇩[0, e] L1 ≡ K1 & lpx_sn R K1 K2.
-#R #L2 #K2 #d #e #H elim H -L2 -K2 -d -e
-[ #d #e #X #H >(lpx_sn_inv_atom2 … H) -H /2 width=3/
-| #K2 #I #V2 #X #H
- elim (lpx_sn_inv_pair2 … H) -H #K1 #V1 #HK12 #HV12 #H destruct /3 width=5/
-| #L2 #K2 #I #V2 #e #_ #IHLK2 #X #H #_
- elim (lpx_sn_inv_pair2 … H) -H #L1 #V1 #HL12 #HV12 #H destruct
- elim (IHLK2 … HL12 ?) -L2 // /3 width=3/
-| #L2 #K2 #I #V2 #W2 #d #e #_ #_ #_ #L1 #_
- >commutative_plus normalize #H destruct
-]
-qed-.
-
-lemma lpx_sn_dropable: ∀R. dropable_dx (lpx_sn R).
-/2 width=5 by lpx_sn_dropable_aux/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop.ma".
+include "basic_2/substitution/gr2_minus.ma".
+include "basic_2/substitution/lifts.ma".
+
+(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
+
+inductive ldrops: list2 nat nat → relation lenv ≝
+| ldrops_nil : ∀L. ldrops ⟠ L L
+| ldrops_cons: ∀L1,L,L2,des,d,e.
+ ldrops des L1 L → ⇩[d,e] L ≡ L2 → ldrops ({d, e} @ des) L1 L2
+.
+
+interpretation "generic local environment slicing"
+ 'RDropStar des T1 T2 = (ldrops des T1 T2).
+
+(* Basic inversion lemmas ***************************************************)
+
+fact ldrops_inv_nil_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → des = ⟠ → L1 = L2.
+#L1 #L2 #des * -L1 -L2 -des //
+#L1 #L #L2 #d #e #des #_ #_ #H destruct
+qed.
+
+(* Basic_1: was: drop1_gen_pnil *)
+lemma ldrops_inv_nil: ∀L1,L2. ⇩*[⟠] L1 ≡ L2 → L1 = L2.
+/2 width=3/ qed-.
+
+fact ldrops_inv_cons_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 →
+ ∀d,e,tl. des = {d, e} @ tl →
+ ∃∃L. ⇩*[tl] L1 ≡ L & ⇩[d, e] L ≡ L2.
+#L1 #L2 #des * -L1 -L2 -des
+[ #L #d #e #tl #H destruct
+| #L1 #L #L2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct
+ /2 width=3/
+qed.
+
+(* Basic_1: was: drop1_gen_pcons *)
+lemma ldrops_inv_cons: ∀L1,L2,d,e,des. ⇩*[{d, e} @ des] L1 ≡ L2 →
+ ∃∃L. ⇩*[des] L1 ≡ L & ⇩[d, e] L ≡ L2.
+/2 width=3/ qed-.
+
+lemma ldrops_inv_skip2: ∀I,des,i,des2. des ▭ i ≡ des2 →
+ ∀L1,K2,V2. ⇩*[des2] L1 ≡ K2. ⓑ{I} V2 →
+ ∃∃K1,V1,des1. des + 1 ▭ i + 1 ≡ des1 + 1 &
+ ⇩*[des1] K1 ≡ K2 &
+ ⇧*[des1] V2 ≡ V1 &
+ L1 = K1. ⓑ{I} V1.
+#I #des #i #des2 #H elim H -des -i -des2
+[ #i #L1 #K2 #V2 #H
+ >(ldrops_inv_nil … H) -L1 /2 width=7/
+| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H
+ elim (ldrops_inv_cons … H) -H #L #HL1 #H
+ elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ #K #V >minus_plus #HK2 #HV2 #H destruct
+ elim (IHdes2 … HL1) -IHdes2 -HL1 #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct
+ @(ex4_3_intro … K1 V1 … ) // [3,4: /2 width=7/ | skip ]
+ normalize >plus_minus // @minuss_lt // /2 width=1/ (**) (* explicit constructors, /3 width=1/ is a bit slow *)
+| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H
+ elim (IHdes2 … H) -IHdes2 -H #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct
+ /4 width=7/
+]
+qed-.
+
+(* Basic properties *********************************************************)
+
+(* Basic_1: was: drop1_skip_bind *)
+lemma ldrops_skip: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 →
+ ∀I. ⇩*[des + 1] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2.
+#L1 #L2 #des #H elim H -L1 -L2 -des
+[ #L #V1 #V2 #HV12 #I
+ >(lifts_inv_nil … HV12) -HV12 //
+| #L1 #L #L2 #des #d #e #_ #HL2 #IHL #V1 #V2 #H #I
+ elim (lifts_inv_cons … H) -H /3 width=5/
+].
+qed.
+
+(* Basic_1: removed theorems 1: drop1_getl_trans *)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop_ldrop.ma".
+include "basic_2/substitution/ldrops.ma".
+
+(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
+
+(* Properties concerning basic local environment slicing ********************)
+
+lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[des] L1 ≡ L → ∀L2,i. ⇩[0, i] L ≡ L2 →
+ ∃∃L0,des0,i0. ⇩[0, i0] L1 ≡ L0 & ⇩*[des0] L0 ≡ L2 &
+ @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0.
+#L1 #L #des #H elim H -L1 -L -des
+[ /2 width=7/
+| #L1 #L3 #L #des3 #d #e #_ #HL3 #IHL13 #L2 #i #HL2
+ elim (lt_or_ge i d) #Hid
+ [ elim (ldrop_trans_le … HL3 … HL2 ?) -L /2 width=2/ #L #HL3 #HL2
+ elim (IHL13 … HL3) -L3 /3 width=7/
+ | lapply (ldrop_trans_ge … HL3 … HL2 ?) -L // #HL32
+ elim (IHL13 … HL32) -L3 /3 width=7/
+ ]
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/substitution/ldrops_ldrop.ma".
+
+(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
+
+(* Main properties **********************************************************)
+
+(* Basic_1: was: drop1_trans *)
+theorem ldrops_trans: ∀L,L2,des2. ⇩*[des2] L ≡ L2 → ∀L1,des1. ⇩*[des1] L1 ≡ L →
+ ⇩*[des2 @@ des1] L1 ≡ L2.
+#L #L2 #des2 #H elim H -L -L2 -des2 // /3 width=3/
+qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/term_weight.ma".
-include "basic_2/grammar/term_simple.ma".
-
-(* BASIC TERM RELOCATION ****************************************************)
-
-(* Basic_1: includes:
- lift_sort lift_lref_lt lift_lref_ge lift_bind lift_flat
-*)
-inductive lift: nat → nat → relation term ≝
-| lift_sort : ∀k,d,e. lift d e (⋆k) (⋆k)
-| lift_lref_lt: ∀i,d,e. i < d → lift d e (#i) (#i)
-| lift_lref_ge: ∀i,d,e. d ≤ i → lift d e (#i) (#(i + e))
-| lift_gref : ∀p,d,e. lift d e (§p) (§p)
-| lift_bind : ∀a,I,V1,V2,T1,T2,d,e.
- lift d e V1 V2 → lift (d + 1) e T1 T2 →
- lift d e (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2)
-| lift_flat : ∀I,V1,V2,T1,T2,d,e.
- lift d e V1 V2 → lift d e T1 T2 →
- lift d e (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
-.
-
-interpretation "relocation" 'RLift d e T1 T2 = (lift d e T1 T2).
-
-definition t_liftable: relation term → Prop ≝
- λR. ∀T1,T2. R T1 T2 → ∀U1,d,e. ⇧[d, e] T1 ≡ U1 →
- ∀U2. ⇧[d, e] T2 ≡ U2 → R U1 U2.
-
-definition t_deliftable_sn: relation term → Prop ≝
- λR. ∀U1,U2. R U1 U2 → ∀T1,d,e. ⇧[d, e] T1 ≡ U1 →
- ∃∃T2. ⇧[d, e] T2 ≡ U2 & R T1 T2.
-
-(* Basic inversion lemmas ***************************************************)
-
-fact lift_inv_refl_O2_aux: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → e = 0 → T1 = T2.
-#d #e #T1 #T2 #H elim H -d -e -T1 -T2 // /3 width=1/
-qed.
-
-lemma lift_inv_refl_O2: ∀d,T1,T2. ⇧[d, 0] T1 ≡ T2 → T1 = T2.
-/2 width=4/ qed-.
-
-fact lift_inv_sort1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T1 = ⋆k → T2 = ⋆k.
-#d #e #T1 #T2 * -d -e -T1 -T2 //
-[ #i #d #e #_ #k #H destruct
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-]
-qed.
-
-lemma lift_inv_sort1: ∀d,e,T2,k. ⇧[d,e] ⋆k ≡ T2 → T2 = ⋆k.
-/2 width=5/ qed-.
-
-fact lift_inv_lref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T1 = #i →
- (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)).
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #i #H destruct
-| #j #d #e #Hj #i #Hi destruct /3 width=1/
-| #j #d #e #Hj #i #Hi destruct /3 width=1/
-| #p #d #e #i #H destruct
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #i #H destruct
-]
-qed.
-
-lemma lift_inv_lref1: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 →
- (i < d ∧ T2 = #i) ∨ (d ≤ i ∧ T2 = #(i + e)).
-/2 width=3/ qed-.
-
-lemma lift_inv_lref1_lt: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → i < d → T2 = #i.
-#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * //
-#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
-elim (lt_refl_false … Hdd)
-qed-.
-
-lemma lift_inv_lref1_ge: ∀d,e,T2,i. ⇧[d,e] #i ≡ T2 → d ≤ i → T2 = #(i + e).
-#d #e #T2 #i #H elim (lift_inv_lref1 … H) -H * //
-#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
-elim (lt_refl_false … Hdd)
-qed-.
-
-fact lift_inv_gref1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T1 = §p → T2 = §p.
-#d #e #T1 #T2 * -d -e -T1 -T2 //
-[ #i #d #e #_ #k #H destruct
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-]
-qed.
-
-lemma lift_inv_gref1: ∀d,e,T2,p. ⇧[d,e] §p ≡ T2 → T2 = §p.
-/2 width=5/ qed-.
-
-fact lift_inv_bind1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
- ∀a,I,V1,U1. T1 = ⓑ{a,I} V1.U1 →
- ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
- T2 = ⓑ{a,I} V2. U2.
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #a #I #V1 #U1 #H destruct
-| #i #d #e #_ #a #I #V1 #U1 #H destruct
-| #i #d #e #_ #a #I #V1 #U1 #H destruct
-| #p #d #e #a #I #V1 #U1 #H destruct
-| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V1 #U1 #H destruct /2 width=5/
-| #J #W1 #W2 #T1 #T2 #d #e #_ #HT #a #I #V1 #U1 #H destruct
-]
-qed.
-
-lemma lift_inv_bind1: ∀d,e,T2,a,I,V1,U1. ⇧[d,e] ⓑ{a,I} V1. U1 ≡ T2 →
- ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
- T2 = ⓑ{a,I} V2. U2.
-/2 width=3/ qed-.
-
-fact lift_inv_flat1_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
- ∀I,V1,U1. T1 = ⓕ{I} V1.U1 →
- ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
- T2 = ⓕ{I} V2. U2.
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #I #V1 #U1 #H destruct
-| #i #d #e #_ #I #V1 #U1 #H destruct
-| #i #d #e #_ #I #V1 #U1 #H destruct
-| #p #d #e #I #V1 #U1 #H destruct
-| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V1 #U1 #H destruct
-| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V1 #U1 #H destruct /2 width=5/
-]
-qed.
-
-lemma lift_inv_flat1: ∀d,e,T2,I,V1,U1. ⇧[d,e] ⓕ{I} V1. U1 ≡ T2 →
- ∃∃V2,U2. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
- T2 = ⓕ{I} V2. U2.
-/2 width=3/ qed-.
-
-fact lift_inv_sort2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀k. T2 = ⋆k → T1 = ⋆k.
-#d #e #T1 #T2 * -d -e -T1 -T2 //
-[ #i #d #e #_ #k #H destruct
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #k #H destruct
-]
-qed.
-
-(* Basic_1: was: lift_gen_sort *)
-lemma lift_inv_sort2: ∀d,e,T1,k. ⇧[d,e] T1 ≡ ⋆k → T1 = ⋆k.
-/2 width=5/ qed-.
-
-fact lift_inv_lref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀i. T2 = #i →
- (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)).
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #i #H destruct
-| #j #d #e #Hj #i #Hi destruct /3 width=1/
-| #j #d #e #Hj #i #Hi destruct <minus_plus_m_m /4 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.
-
-(* Basic_1: was: lift_gen_lref *)
-lemma lift_inv_lref2: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i →
- (i < d ∧ T1 = #i) ∨ (d + e ≤ i ∧ T1 = #(i - e)).
-/2 width=3/ qed-.
-
-(* Basic_1: was: lift_gen_lref_lt *)
-lemma lift_inv_lref2_lt: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i → i < d → T1 = #i.
-#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H * //
-#Hdi #_ #Hid lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
-elim (lt_inv_plus_l … Hdd) -Hdd #Hdd
-elim (lt_refl_false … Hdd)
-qed-.
-
-(* Basic_1: was: lift_gen_lref_false *)
-lemma lift_inv_lref2_be: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i →
- d ≤ i → i < d + e → ⊥.
-#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H *
-[ #H1 #_ #H2 #_ | #H2 #_ #_ #H1 ]
-lapply (le_to_lt_to_lt … H2 H1) -H2 -H1 #H
-elim (lt_refl_false … H)
-qed-.
-
-(* Basic_1: was: lift_gen_lref_ge *)
-lemma lift_inv_lref2_ge: ∀d,e,T1,i. ⇧[d,e] T1 ≡ #i → d + e ≤ i → T1 = #(i - e).
-#d #e #T1 #i #H elim (lift_inv_lref2 … H) -H * //
-#Hid #_ #Hdi lapply (le_to_lt_to_lt … Hdi Hid) -Hdi -Hid #Hdd
-elim (lt_inv_plus_l … Hdd) -Hdd #Hdd
-elim (lt_refl_false … Hdd)
-qed-.
-
-fact lift_inv_gref2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 → ∀p. T2 = §p → T1 = §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_gref2: ∀d,e,T1,p. ⇧[d,e] T1 ≡ §p → T1 = §p.
-/2 width=5/ qed-.
-
-fact lift_inv_bind2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
- ∀a,I,V2,U2. T2 = ⓑ{a,I} V2.U2 →
- ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
- T1 = ⓑ{a,I} V1. U1.
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #a #I #V2 #U2 #H destruct
-| #i #d #e #_ #a #I #V2 #U2 #H destruct
-| #i #d #e #_ #a #I #V2 #U2 #H destruct
-| #p #d #e #a #I #V2 #U2 #H destruct
-| #b #J #W1 #W2 #T1 #T2 #d #e #HW #HT #a #I #V2 #U2 #H destruct /2 width=5/
-| #J #W1 #W2 #T1 #T2 #d #e #_ #_ #a #I #V2 #U2 #H destruct
-]
-qed.
-
-(* Basic_1: was: lift_gen_bind *)
-lemma lift_inv_bind2: ∀d,e,T1,a,I,V2,U2. ⇧[d,e] T1 ≡ ⓑ{a,I} V2. U2 →
- ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d+1,e] U1 ≡ U2 &
- T1 = ⓑ{a,I} V1. U1.
-/2 width=3/ qed-.
-
-fact lift_inv_flat2_aux: ∀d,e,T1,T2. ⇧[d,e] T1 ≡ T2 →
- ∀I,V2,U2. T2 = ⓕ{I} V2.U2 →
- ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
- T1 = ⓕ{I} V1. U1.
-#d #e #T1 #T2 * -d -e -T1 -T2
-[ #k #d #e #I #V2 #U2 #H destruct
-| #i #d #e #_ #I #V2 #U2 #H destruct
-| #i #d #e #_ #I #V2 #U2 #H destruct
-| #p #d #e #I #V2 #U2 #H destruct
-| #a #J #W1 #W2 #T1 #T2 #d #e #_ #_ #I #V2 #U2 #H destruct
-| #J #W1 #W2 #T1 #T2 #d #e #HW #HT #I #V2 #U2 #H destruct /2 width=5/
-]
-qed.
-
-(* Basic_1: was: lift_gen_flat *)
-lemma lift_inv_flat2: ∀d,e,T1,I,V2,U2. ⇧[d,e] T1 ≡ ⓕ{I} V2. U2 →
- ∃∃V1,U1. ⇧[d,e] V1 ≡ V2 & ⇧[d,e] U1 ≡ U2 &
- T1 = ⓕ{I} V1. U1.
-/2 width=3/ qed-.
-
-lemma lift_inv_pair_xy_x: ∀d,e,I,V,T. ⇧[d, e] ②{I} V. T ≡ V → ⊥.
-#d #e #J #V elim V -V
-[ * #i #T #H
- [ lapply (lift_inv_sort2 … H) -H #H destruct
- | elim (lift_inv_lref2 … H) -H * #_ #H destruct
- | lapply (lift_inv_gref2 … H) -H #H destruct
- ]
-| * [ #a ] #I #W2 #U2 #IHW2 #_ #T #H
- [ elim (lift_inv_bind2 … H) -H #W1 #U1 #HW12 #_ #H destruct /2 width=2/
- | elim (lift_inv_flat2 … H) -H #W1 #U1 #HW12 #_ #H destruct /2 width=2/
- ]
-]
-qed-.
-
-(* Basic_1: was: thead_x_lift_y_y *)
-lemma lift_inv_pair_xy_y: ∀I,T,V,d,e. ⇧[d, e] ②{I} V. T ≡ T → ⊥.
-#J #T elim T -T
-[ * #i #V #d #e #H
- [ lapply (lift_inv_sort2 … H) -H #H destruct
- | elim (lift_inv_lref2 … H) -H * #_ #H destruct
- | lapply (lift_inv_gref2 … H) -H #H destruct
- ]
-| * [ #a ] #I #W2 #U2 #_ #IHU2 #V #d #e #H
- [ elim (lift_inv_bind2 … H) -H #W1 #U1 #_ #HU12 #H destruct /2 width=4/
- | elim (lift_inv_flat2 … H) -H #W1 #U1 #_ #HU12 #H destruct /2 width=4/
- ]
-]
-qed-.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma lift_fwd_tw: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → ♯{T1} = ♯{T2}.
-#d #e #T1 #T2 #H elim H -d -e -T1 -T2 normalize //
-qed-.
-
-lemma lift_simple_dx: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄.
-#d #e #T1 #T2 #H elim H -d -e -T1 -T2 //
-#a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #_ #_ #H
-elim (simple_inv_bind … H)
-qed-.
-
-lemma lift_simple_sn: ∀d,e,T1,T2. ⇧[d, e] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄.
-#d #e #T1 #T2 #H elim H -d -e -T1 -T2 //
-#a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #_ #_ #H
-elim (simple_inv_bind … H)
-qed-.
-
-(* Basic properties *********************************************************)
-
-(* Basic_1: was: lift_lref_gt *)
-lemma lift_lref_ge_minus: ∀d,e,i. d + e ≤ i → ⇧[d, e] #(i - e) ≡ #i.
-#d #e #i #H >(plus_minus_m_m i e) in ⊢ (? ? ? ? %); /2 width=2/ /3 width=2/
-qed.
-
-lemma lift_lref_ge_minus_eq: ∀d,e,i,j. d + e ≤ i → j = i - e → ⇧[d, e] #j ≡ #i.
-/2 width=1/ qed-.
-
-(* Basic_1: was: lift_r *)
-lemma lift_refl: ∀T,d. ⇧[d, 0] T ≡ T.
-#T elim T -T
-[ * #i // #d elim (lt_or_ge i d) /2 width=1/
-| * /2 width=1/
-]
-qed.
-
-lemma lift_total: ∀T1,d,e. ∃T2. ⇧[d,e] T1 ≡ T2.
-#T1 elim T1 -T1
-[ * #i /2 width=2/ #d #e elim (lt_or_ge i d) /3 width=2/
-| * [ #a ] #I #V1 #T1 #IHV1 #IHT1 #d #e
- elim (IHV1 d e) -IHV1 #V2 #HV12
- [ elim (IHT1 (d+1) e) -IHT1 /3 width=2/
- | elim (IHT1 d e) -IHT1 /3 width=2/
- ]
-]
-qed.
-
-(* Basic_1: was: lift_free (right to left) *)
-lemma lift_split: ∀d1,e2,T1,T2. ⇧[d1, e2] T1 ≡ T2 →
- ∀d2,e1. d1 ≤ d2 → d2 ≤ d1 + e1 → e1 ≤ e2 →
- ∃∃T. ⇧[d1, e1] T1 ≡ T & ⇧[d2, e2 - e1] T ≡ T2.
-#d1 #e2 #T1 #T2 #H elim H -d1 -e2 -T1 -T2
-[ /3 width=3/
-| #i #d1 #e2 #Hid1 #d2 #e1 #Hd12 #_ #_
- lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 /4 width=3/
-| #i #d1 #e2 #Hid1 #d2 #e1 #_ #Hd21 #He12
- lapply (transitive_le … (i+e1) Hd21 ?) /2 width=1/ -Hd21 #Hd21
- >(plus_minus_m_m e2 e1 ?) // /3 width=3/
-| /3 width=3/
-| #a #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12
- elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b
- elim (IHT (d2+1) … ? ? He12) /2 width=1/ /3 width=5/
-| #I #V1 #V2 #T1 #T2 #d1 #e2 #_ #_ #IHV #IHT #d2 #e1 #Hd12 #Hd21 #He12
- elim (IHV … Hd12 Hd21 He12) -IHV #V0 #HV0a #HV0b
- elim (IHT d2 … ? ? He12) // /3 width=5/
-]
-qed.
-
-(* Basic_1: was only: dnf_dec2 dnf_dec *)
-lemma is_lift_dec: ∀T2,d,e. Decidable (∃T1. ⇧[d,e] T1 ≡ T2).
-#T1 elim T1 -T1
-[ * [1,3: /3 width=2/ ] #i #d #e
- elim (lt_dec i d) #Hid
- [ /4 width=2/
- | lapply (false_lt_to_le … Hid) -Hid #Hid
- elim (lt_dec i (d + e)) #Hide
- [ @or_intror * #T1 #H
- elim (lift_inv_lref2_be … H Hid Hide)
- | lapply (false_lt_to_le … Hide) -Hide /4 width=2/
- ]
- ]
-| * [ #a ] #I #V2 #T2 #IHV2 #IHT2 #d #e
- [ elim (IHV2 d e) -IHV2
- [ * #V1 #HV12 elim (IHT2 (d+1) e) -IHT2
- [ * #T1 #HT12 @or_introl /3 width=2/
- | -V1 #HT2 @or_intror * #X #H
- elim (lift_inv_bind2 … H) -H /3 width=2/
- ]
- | -IHT2 #HV2 @or_intror * #X #H
- elim (lift_inv_bind2 … H) -H /3 width=2/
- ]
- | elim (IHV2 d e) -IHV2
- [ * #V1 #HV12 elim (IHT2 d e) -IHT2
- [ * #T1 #HT12 /4 width=2/
- | -V1 #HT2 @or_intror * #X #H
- elim (lift_inv_flat2 … H) -H /3 width=2/
- ]
- | -IHT2 #HV2 @or_intror * #X #H
- elim (lift_inv_flat2 … H) -H /3 width=2/
- ]
- ]
-]
-qed.
-
-lemma t_liftable_TC: ∀R. t_liftable R → t_liftable (TC … R).
-#R #HR #T1 #T2 #H elim H -T2
-[ /3 width=7/
-| #T #T2 #_ #HT2 #IHT1 #U1 #d #e #HTU1 #U2 #HTU2
- elim (lift_total T d e) /3 width=9/
-]
-qed.
-
-lemma t_deliftable_sn_TC: ∀R. t_deliftable_sn R → t_deliftable_sn (TC … R).
-#R #HR #U1 #U2 #H elim H -U2
-[ #U2 #HU12 #T1 #d #e #HTU1
- elim (HR … HU12 … HTU1) -U1 /3 width=3/
-| #U #U2 #_ #HU2 #IHU1 #T1 #d #e #HTU1
- elim (IHU1 … HTU1) -U1 #T #HTU #HT1
- elim (HR … HU2 … HTU) -U /3 width=5/
-]
-qed-.
-
-(* Basic_1: removed theorems 7:
- lift_head lift_gen_head
- lift_weight_map lift_weight lift_weight_add lift_weight_add_O
- lift_tlt_dx
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lift.ma".
-
-(* BASIC TERM RELOCATION ****************************************************)
-
-(* Main properies ***********************************************************)
-
-(* Basic_1: was: lift_inj *)
-theorem lift_inj: ∀d,e,T1,U. ⇧[d,e] T1 ≡ U → ∀T2. ⇧[d,e] T2 ≡ U → T1 = T2.
-#d #e #T1 #U #H elim H -d -e -T1 -U
-[ #k #d #e #X #HX
- lapply (lift_inv_sort2 … HX) -HX //
-| #i #d #e #Hid #X #HX
- lapply (lift_inv_lref2_lt … HX ?) -HX //
-| #i #d #e #Hdi #X #HX
- lapply (lift_inv_lref2_ge … HX ?) -HX // /2 width=1/
-| #p #d #e #X #HX
- lapply (lift_inv_gref2 … HX) -HX //
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
- elim (lift_inv_bind2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
- elim (lift_inv_flat2 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
-]
-qed-.
-
-(* Basic_1: was: lift_gen_lift *)
-theorem lift_div_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
- ∀d2,e2,T2. ⇧[d2 + e1, e2] T2 ≡ T →
- d1 ≤ d2 →
- ∃∃T0. ⇧[d1, e1] T0 ≡ T2 & ⇧[d2, e2] T0 ≡ T1.
-#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
-[ #k #d1 #e1 #d2 #e2 #T2 #Hk #Hd12
- lapply (lift_inv_sort2 … Hk) -Hk #Hk destruct /3 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12
- lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2
- lapply (lift_inv_lref2_lt … Hi ?) -Hi /2 width=3/ /3 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #Hi #Hd12
- elim (lift_inv_lref2 … Hi) -Hi * #Hid2 #H destruct
- [ -Hd12 lapply (lt_plus_to_lt_l … Hid2) -Hid2 #Hid2 /3 width=3/
- | -Hid1 >plus_plus_comm_23 in Hid2; #H lapply (le_plus_to_le_r … H) -H #H
- elim (le_inv_plus_l … H) -H #Hide2 #He2i
- lapply (transitive_le … Hd12 Hide2) -Hd12 #Hd12
- >le_plus_minus_comm // >(plus_minus_m_m i e2) in ⊢ (? ? ? %); // -He2i
- /4 width=3/
- ]
-| #p #d1 #e1 #d2 #e2 #T2 #Hk #Hd12
- lapply (lift_inv_gref2 … Hk) -Hk #Hk destruct /3 width=3/
-| #a #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12
- lapply (lift_inv_bind2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct
- elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1
- >plus_plus_comm_23 in HU2; #HU2 elim (IHU … HU2 ?) /2 width=1/ /3 width=5/
-| #I #W1 #W #U1 #U #d1 #e1 #_ #_ #IHW #IHU #d2 #e2 #T2 #H #Hd12
- lapply (lift_inv_flat2 … H) -H * #W2 #U2 #HW2 #HU2 #H destruct
- elim (IHW … HW2 ?) // -IHW -HW2 #W0 #HW2 #HW1
- elim (IHU … HU2 ?) // /3 width=5/
-]
-qed.
-
-(* Note: apparently this was missing in basic_1 *)
-theorem lift_div_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
- ∀e,e2,T2. ⇧[d1 + e, e2] T2 ≡ T →
- e ≤ e1 → e1 ≤ e + e2 →
- ∃∃T0. ⇧[d1, e] T0 ≡ T2 & ⇧[d1, e + e2 - e1] T0 ≡ T1.
-#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
-[ #k #d1 #e1 #e #e2 #T2 #H >(lift_inv_sort2 … H) -H /2 width=3/
-| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2
- >(lift_inv_lref2_lt … H) -H [ /3 width=3/ | /2 width=3/ ]
-| #i #d1 #e1 #Hid1 #e #e2 #T2 #H #He1 #He1e2
- elim (lt_or_ge (i+e1) (d1+e+e2)) #Hie1d1e2
- [ elim (lift_inv_lref2_be … H ? ?) -H // /2 width=1/
- | >(lift_inv_lref2_ge … H ?) -H //
- lapply (le_plus_to_minus … Hie1d1e2) #Hd1e21i
- elim (le_inv_plus_l … Hie1d1e2) -Hie1d1e2 #Hd1e12 #He2ie1
- @ex2_intro [2: /2 width=1/ | skip ] -Hd1e12
- @lift_lref_ge_minus_eq [ >plus_minus_commutative // | /2 width=1/ ]
- ]
-| #p #d1 #e1 #e #e2 #T2 #H >(lift_inv_gref2 … H) -H /2 width=3/
-| #a #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2
- elim (lift_inv_bind2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct
- elim (IHV1 … HV2 ? ?) -V // >plus_plus_comm_23 in HT2; #HT2
- elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/
-| #I #V1 #V #T1 #T #d1 #e1 #_ #_ #IHV1 #IHT1 #e #e2 #X #H #He1 #He1e2
- elim (lift_inv_flat2 … H) -H #V2 #T2 #HV2 #HT2 #H destruct
- elim (IHV1 … HV2 ? ?) -V //
- elim (IHT1 … HT2 ? ?) -T // -He1 -He1e2 /3 width=5/
-]
-qed.
-
-theorem lift_mono: ∀d,e,T,U1. ⇧[d,e] T ≡ U1 → ∀U2. ⇧[d,e] T ≡ U2 → U1 = U2.
-#d #e #T #U1 #H elim H -d -e -T -U1
-[ #k #d #e #X #HX
- lapply (lift_inv_sort1 … HX) -HX //
-| #i #d #e #Hid #X #HX
- lapply (lift_inv_lref1_lt … HX ?) -HX //
-| #i #d #e #Hdi #X #HX
- lapply (lift_inv_lref1_ge … HX ?) -HX //
-| #p #d #e #X #HX
- lapply (lift_inv_gref1 … HX) -HX //
-| #a #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
- elim (lift_inv_bind1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
-| #I #V1 #V2 #T1 #T2 #d #e #_ #_ #IHV12 #IHT12 #X #HX
- elim (lift_inv_flat1 … HX) -HX #V #T #HV1 #HT1 #HX destruct /3 width=1/
-]
-qed-.
-
-(* Basic_1: was: lift_free (left to right) *)
-theorem lift_trans_be: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
- ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 →
- d1 ≤ d2 → d2 ≤ d1 + e1 → ⇧[d1, e1 + e2] T1 ≡ T2.
-#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
-[ #k #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_
- >(lift_inv_sort1 … HT2) -HT2 //
-| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #Hd12 #_
- lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2
- lapply (lift_inv_lref1_lt … HT2 Hid2) /2 width=1/
-| #i #d1 #e1 #Hid1 #d2 #e2 #T2 #HT2 #_ #Hd21
- lapply (lift_inv_lref1_ge … HT2 ?) -HT2
- [ @(transitive_le … Hd21 ?) -Hd21 /2 width=1/
- | -Hd21 /2 width=1/
- ]
-| #p #d1 #e1 #d2 #e2 #T2 #HT2 #_ #_
- >(lift_inv_gref1 … HT2) -HT2 //
-| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21
- elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
- lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10
- lapply (IHT12 … HT20 ? ?) /2 width=1/
-| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd12 #Hd21
- elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
- lapply (IHV12 … HV20 ? ?) // -IHV12 -HV20 #HV10
- lapply (IHT12 … HT20 ? ?) // /2 width=1/
-]
-qed.
-
-(* Basic_1: was: lift_d (right to left) *)
-theorem lift_trans_le: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
- ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d2 ≤ d1 →
- ∃∃T0. ⇧[d2, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T0 ≡ T2.
-#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
-[ #k #d1 #e1 #d2 #e2 #X #HX #_
- >(lift_inv_sort1 … HX) -HX /2 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_
- lapply (lt_to_le_to_lt … (d1+e2) Hid1 ?) // #Hie2
- elim (lift_inv_lref1 … HX) -HX * #Hid2 #HX destruct /3 width=3/ /4 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hd21
- lapply (transitive_le … Hd21 Hid1) -Hd21 #Hid2
- lapply (lift_inv_lref1_ge … HX ?) -HX /2 width=3/ #HX destruct
- >plus_plus_comm_23 /4 width=3/
-| #p #d1 #e1 #d2 #e2 #X #HX #_
- >(lift_inv_gref1 … HX) -HX /2 width=3/
-| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21
- elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
- elim (IHV12 … HV20 ?) -IHV12 -HV20 //
- elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ /3 width=5/
-| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hd21
- elim (lift_inv_flat1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
- elim (IHV12 … HV20 ?) -IHV12 -HV20 //
- elim (IHT12 … HT20 ?) -IHT12 -HT20 // /3 width=5/
-]
-qed.
-
-(* Basic_1: was: lift_d (left to right) *)
-theorem lift_trans_ge: ∀d1,e1,T1,T. ⇧[d1, e1] T1 ≡ T →
- ∀d2,e2,T2. ⇧[d2, e2] T ≡ T2 → d1 + e1 ≤ d2 →
- ∃∃T0. ⇧[d2 - e1, e2] T1 ≡ T0 & ⇧[d1, e1] T0 ≡ T2.
-#d1 #e1 #T1 #T #H elim H -d1 -e1 -T1 -T
-[ #k #d1 #e1 #d2 #e2 #X #HX #_
- >(lift_inv_sort1 … HX) -HX /2 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #Hded
- lapply (lt_to_le_to_lt … (d1+e1) Hid1 ?) // #Hid1e
- lapply (lt_to_le_to_lt … (d2-e1) Hid1 ?) /2 width=1/ #Hid2e
- lapply (lt_to_le_to_lt … Hid1e Hded) -Hid1e -Hded #Hid2
- lapply (lift_inv_lref1_lt … HX ?) -HX // #HX destruct /3 width=3/
-| #i #d1 #e1 #Hid1 #d2 #e2 #X #HX #_
- elim (lift_inv_lref1 … HX) -HX * #Hied #HX destruct /4 width=3/
-| #p #d1 #e1 #d2 #e2 #X #HX #_
- >(lift_inv_gref1 … HX) -HX /2 width=3/
-| #a #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded
- elim (lift_inv_bind1 … HX) -HX #V0 #T0 #HV20 #HT20 #HX destruct
- elim (IHV12 … HV20 ?) -IHV12 -HV20 //
- elim (IHT12 … HT20 ?) -IHT12 -HT20 /2 width=1/ #T
- <plus_minus /2 width=2/ /3 width=5/
-| #I #V1 #V2 #T1 #T2 #d1 #e1 #_ #_ #IHV12 #IHT12 #d2 #e2 #X #HX #Hded
- 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.
-
-(* Advanced properties ******************************************************)
-
-lemma lift_conf_O1: ∀T,T1,d1,e1. ⇧[d1, e1] T ≡ T1 → ∀T2,e2. ⇧[0, e2] T ≡ T2 →
- ∃∃T0. ⇧[0, e2] T1 ≡ T0 & ⇧[d1 + e2, e1] T2 ≡ T0.
-#T #T1 #d1 #e1 #HT1 #T2 #e2 #HT2
-elim (lift_total T1 0 e2) #T0 #HT10
-elim (lift_trans_le … HT1 … HT10 ?) -HT1 // #X #HTX #HT20
-lapply (lift_mono … HTX … HT2) -T #H destruct /2 width=3/
-qed.
-
-lemma lift_conf_be: ∀T,T1,d,e1. ⇧[d, e1] T ≡ T1 → ∀T2,e2. ⇧[d, e2] T ≡ T2 →
- e1 ≤ e2 → ⇧[d + e1, e2 - e1] T1 ≡ T2.
-#T #T1 #d #e1 #HT1 #T2 #e2 #HT2 #He12
-elim (lift_split … HT2 (d+e1) e1 ? ? ?) -HT2 // #X #H
->(lift_mono … H … HT1) -T //
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/term_vector.ma".
-include "basic_2/substitution/lift.ma".
-
-(* BASIC TERM VECTOR RELOCATION *********************************************)
-
-inductive liftv (d,e:nat) : relation (list term) ≝
-| liftv_nil : liftv d e ◊ ◊
-| liftv_cons: ∀T1s,T2s,T1,T2.
- ⇧[d, e] T1 ≡ T2 → liftv d e T1s T2s →
- liftv d e (T1 @ T1s) (T2 @ T2s)
-.
-
-interpretation "relocation (vector)" 'RLift d e T1s T2s = (liftv d e T1s T2s).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact liftv_inv_nil1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s → T1s = ◊ → T2s = ◊.
-#T1s #T2s #d #e * -T1s -T2s //
-#T1s #T2s #T1 #T2 #_ #_ #H destruct
-qed.
-
-lemma liftv_inv_nil1: ∀T2s,d,e. ⇧[d, e] ◊ ≡ T2s → T2s = ◊.
-/2 width=5/ qed-.
-
-fact liftv_inv_cons1_aux: ∀T1s,T2s,d,e. ⇧[d, e] T1s ≡ T2s →
- ∀U1,U1s. T1s = U1 @ U1s →
- ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s &
- T2s = U2 @ U2s.
-#T1s #T2s #d #e * -T1s -T2s
-[ #U1 #U1s #H destruct
-| #T1s #T2s #T1 #T2 #HT12 #HT12s #U1 #U1s #H destruct /2 width=5/
-]
-qed.
-
-lemma liftv_inv_cons1: ∀U1,U1s,T2s,d,e. ⇧[d, e] U1 @ U1s ≡ T2s →
- ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s &
- T2s = U2 @ U2s.
-/2 width=3/ qed-.
-
-(* Basic properties *********************************************************)
-
-lemma liftv_total: ∀d,e. ∀T1s:list term. ∃T2s. ⇧[d, e] T1s ≡ T2s.
-#d #e #T1s elim T1s -T1s
-[ /2 width=2/
-| #T1 #T1s * #T2s #HT12s
- elim (lift_total T1 d e) /3 width=2/
-]
-qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lift.ma".
+include "basic_2/substitution/gr2_plus.ma".
+
+(* GENERIC TERM RELOCATION **************************************************)
+
+inductive lifts: list2 nat nat → relation term ≝
+| lifts_nil : ∀T. lifts ⟠ T T
+| lifts_cons: ∀T1,T,T2,des,d,e.
+ ⇧[d,e] T1 ≡ T → lifts des T T2 → lifts ({d, e} @ des) T1 T2
+.
+
+interpretation "generic relocation (term)"
+ 'RLiftStar des T1 T2 = (lifts des T1 T2).
+
+(* Basic inversion lemmas ***************************************************)
+
+fact lifts_inv_nil_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → des = ⟠ → T1 = T2.
+#T1 #T2 #des * -T1 -T2 -des //
+#T1 #T #T2 #d #e #des #_ #_ #H destruct
+qed.
+
+lemma lifts_inv_nil: ∀T1,T2. ⇧*[⟠] T1 ≡ T2 → T1 = T2.
+/2 width=3/ qed-.
+
+fact lifts_inv_cons_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 →
+ ∀d,e,tl. des = {d, e} @ tl →
+ ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[tl] T ≡ T2.
+#T1 #T2 #des * -T1 -T2 -des
+[ #T #d #e #tl #H destruct
+| #T1 #T #T2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct
+ /2 width=3/
+qed.
+
+lemma lifts_inv_cons: ∀T1,T2,d,e,des. ⇧*[{d, e} @ des] T1 ≡ T2 →
+ ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[des] T ≡ T2.
+/2 width=3/ qed-.
+
+(* Basic_1: was: lift1_sort *)
+lemma lifts_inv_sort1: ∀T2,k,des. ⇧*[des] ⋆k ≡ T2 → T2 = ⋆k.
+#T2 #k #des elim des -des
+[ #H <(lifts_inv_nil … H) -H //
+| #d #e #des #IH #H
+ elim (lifts_inv_cons … H) -H #X #H
+ >(lift_inv_sort1 … H) -H /2 width=1/
+]
+qed-.
+
+(* Basic_1: was: lift1_lref *)
+lemma lifts_inv_lref1: ∀T2,des,i1. ⇧*[des] #i1 ≡ T2 →
+ ∃∃i2. @⦃i1, des⦄ ≡ i2 & T2 = #i2.
+#T2 #des elim des -des
+[ #i1 #H <(lifts_inv_nil … H) -H /2 width=3/
+| #d #e #des #IH #i1 #H
+ elim (lifts_inv_cons … H) -H #X #H1 #H2
+ elim (lift_inv_lref1 … H1) -H1 * #Hdi1 #H destruct
+ elim (IH … H2) -IH -H2 /3 width=3/
+]
+qed-.
+
+lemma lifts_inv_gref1: ∀T2,p,des. ⇧*[des] §p ≡ T2 → T2 = §p.
+#T2 #p #des elim des -des
+[ #H <(lifts_inv_nil … H) -H //
+| #d #e #des #IH #H
+ elim (lifts_inv_cons … H) -H #X #H
+ >(lift_inv_gref1 … H) -H /2 width=1/
+]
+qed-.
+
+(* Basic_1: was: lift1_bind *)
+lemma lifts_inv_bind1: ∀a,I,T2,des,V1,U1. ⇧*[des] ⓑ{a,I} V1. U1 ≡ T2 →
+ ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des + 1] U1 ≡ U2 &
+ T2 = ⓑ{a,I} V2. U2.
+#a #I #T2 #des elim des -des
+[ #V1 #U1 #H
+ <(lifts_inv_nil … H) -H /2 width=5/
+| #d #e #des #IHdes #V1 #U1 #H
+ elim (lifts_inv_cons … H) -H #X #H #HT2
+ elim (lift_inv_bind1 … H) -H #V #U #HV1 #HU1 #H destruct
+ elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct
+ /3 width=5/
+]
+qed-.
+
+(* Basic_1: was: lift1_flat *)
+lemma lifts_inv_flat1: ∀I,T2,des,V1,U1. ⇧*[des] ⓕ{I} V1. U1 ≡ T2 →
+ ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des] U1 ≡ U2 &
+ T2 = ⓕ{I} V2. U2.
+#I #T2 #des elim des -des
+[ #V1 #U1 #H
+ <(lifts_inv_nil … H) -H /2 width=5/
+| #d #e #des #IHdes #V1 #U1 #H
+ elim (lifts_inv_cons … H) -H #X #H #HT2
+ elim (lift_inv_flat1 … H) -H #V #U #HV1 #HU1 #H destruct
+ elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct
+ /3 width=5/
+]
+qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma lifts_simple_dx: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄.
+#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_dx/
+qed-.
+
+lemma lifts_simple_sn: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄.
+#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_sn/
+qed-.
+
+(* Basic properties *********************************************************)
+
+lemma lifts_bind: ∀a,I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 →
+ ∀T1. ⇧*[des + 1] T1 ≡ T2 →
+ ⇧*[des] ⓑ{a,I} V1. T1 ≡ ⓑ{a,I} V2. T2.
+#a #I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des
+[ #V #T1 #H >(lifts_inv_nil … H) -H //
+| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H
+ elim (lifts_inv_cons … H) -H /3 width=3/
+]
+qed.
+
+lemma lifts_flat: ∀I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 →
+ ∀T1. ⇧*[des] T1 ≡ T2 →
+ ⇧*[des] ⓕ{I} V1. T1 ≡ ⓕ{I} V2. T2.
+#I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des
+[ #V #T1 #H >(lifts_inv_nil … H) -H //
+| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H
+ elim (lifts_inv_cons … H) -H /3 width=3/
+]
+qed.
+
+lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2.
+#des elim des -des /2 width=2/
+#d #e #des #IH #T1
+elim (lift_total T1 d e) #T #HT1
+elim (IH T) -IH /3 width=4/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_le_minus_minus_comm // <minus_plus_m_m #H
+ elim (pluss_inv_cons2 … H) -H #des2 #H1 #H2 destruct
+ elim (lifts_inv_cons … HT10) -HT10 #T >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 <plus_minus_m_m /2 width=1/ /3 width=5/
+ | >commutative_plus in Hi0; #Hi0
+ lapply (minuss_inv_cons1_ge … H2 ?) -H2 [ /2 width=1/ ] <associative_plus #Hdes0
+ elim (IHdes … Hi0 … Hdes0 … HT10 … HT02) -IHdes -Hi0 -Hdes0 -T0 #T0 #HT0 #HT02
+ elim (lift_split … HT0 d (i+1) ? ? ?) -HT0 /2 width=1/ /3 width=5/
+ ]
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_vector.ma".
+include "basic_2/substitution/lifts_lift.ma".
+include "basic_2/substitution/lifts_vector.ma".
+
+(* GENERIC RELOCATION *******************************************************)
+
+(* Main properties **********************************************************)
+
+(* Basic_1: was: lifts1_xhg (right to left) *)
+lemma liftsv_liftv_trans_le: ∀T1s,Ts,des. ⇧*[des] T1s ≡ Ts →
+ ∀T2s:list term. ⇧[0, 1] Ts ≡ T2s →
+ ∃∃T0s. ⇧[0, 1] T1s ≡ T0s & ⇧*[des + 1] T0s ≡ T2s.
+#T1s #Ts #des #H elim H -T1s -Ts
+[ #T1s #H
+ >(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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/lift_vector.ma".
+include "basic_2/substitution/lifts.ma".
+
+(* GENERIC TERM VECTOR RELOCATION *******************************************)
+
+inductive liftsv (des:list2 nat nat) : relation (list term) ≝
+| liftsv_nil : liftsv des ◊ ◊
+| liftsv_cons: ∀T1s,T2s,T1,T2.
+ ⇧*[des] T1 ≡ T2 → liftsv des T1s T2s →
+ liftsv des (T1 @ T1s) (T2 @ T2s)
+.
+
+interpretation "generic relocation (vector)"
+ 'RLiftStar des T1s T2s = (liftsv des T1s T2s).
+
+(* Basic inversion lemmas ***************************************************)
+
+(* Basic_1: was: lifts1_flat (left to right) *)
+lemma lifts_inv_applv1: ∀V1s,U1,T2,des. ⇧*[des] Ⓐ V1s. U1 ≡ T2 →
+ ∃∃V2s,U2. ⇧*[des] V1s ≡ V2s & ⇧*[des] U1 ≡ U2 &
+ T2 = Ⓐ V2s. U2.
+#V1s elim V1s -V1s normalize
+[ #T1 #T2 #des #HT12
+ @(ex3_2_intro) [3,4: // |1,2: skip | // ] (**) (* explicit constructor *)
+| #V1 #V1s #IHV1s #T1 #X #des #H
+ elim (lifts_inv_flat1 … H) -H #V2 #Y #HV12 #HY #H destruct
+ elim (IHV1s … HY) -IHV1s -HY #V2s #T2 #HV12s #HT12 #H destruct
+ @(ex3_2_intro) [4: // |3: /2 width=2/ |1,2: skip | // ] (**) (* explicit constructor *)
+]
+qed-.
+
+(* Basic properties *********************************************************)
+
+(* Basic_1: was: lifts1_flat (right to left) *)
+lemma lifts_applv: ∀V1s,V2s,des. ⇧*[des] V1s ≡ V2s →
+ ∀T1,T2. ⇧*[des] T1 ≡ T2 →
+ ⇧*[des] Ⓐ V1s. T1 ≡ Ⓐ V2s. T2.
+#V1s #V2s #des #H elim H -V1s -V2s // /3 width=1/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/grammar/lenv_px_sn.ma".
+include "basic_2/substitution/cpss.ma".
+
+(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************)
+
+(* Basic_1: includes: csubst1_bind *)
+definition lpss: relation lenv ≝ lpx_sn cpss.
+
+interpretation "parallel substitution (local environment, sn variant)"
+ 'PSubstStarSn L1 L2 = (lpss L1 L2).
+
+(* Basic inversion lemmas ***************************************************)
+
+lemma lpss_inv_atom1: ∀L2. ⋆ ⊢ ▶* L2 → L2 = ⋆.
+/2 width=4 by lpx_sn_inv_atom1_aux/ qed-.
+
+lemma lpss_inv_pair1: ∀I,K1,V1,L2. K1. ⓑ{I} V1 ⊢ ▶* L2 →
+ ∃∃K2,V2. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L2 = K2. ⓑ{I} V2.
+/2 width=3 by lpx_sn_inv_pair1_aux/ qed-.
+
+lemma lpss_inv_atom2: ∀L1. L1 ⊢ ▶* ⋆ → L1 = ⋆.
+/2 width=4 by lpx_sn_inv_atom2_aux/ qed-.
+
+lemma lpss_inv_pair2: ∀I,L1,K2,V2. L1 ⊢ ▶* K2. ⓑ{I} V2 →
+ ∃∃K1,V1. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L1 = K1. ⓑ{I} V1.
+/2 width=3 by lpx_sn_inv_pair2_aux/ qed-.
+
+(* Basic properties *********************************************************)
+
+(* Basic_1: was by definition: csubst1_refl *)
+lemma lpss_refl: ∀L. L ⊢ ▶* L.
+/2 width=1 by lpx_sn_refl/ qed.
+
+lemma lpss_append: ∀K1,K2. K1 ⊢ ▶* K2 → ∀L1,L2. L1 ⊢ ▶* L2 →
+ L1 @@ K1 ⊢ ▶* L2 @@ K2.
+/3 width=1 by lpx_sn_append, cpss_append/ qed.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma lpss_fwd_length: ∀L1,L2. L1 ⊢ ▶* L2 → |L1| = |L2|.
+/2 width=2 by lpx_sn_fwd_length/ qed-.
+
+(* Advanced forward lemmas **************************************************)
+
+lemma lpss_fwd_append1: ∀K1,L1,L. K1 @@ L1 ⊢ ▶* L →
+ ∃∃K2,L2. K1 ⊢ ▶* K2 & L = K2 @@ L2.
+/2 width=2 by lpx_sn_fwd_append1/ qed-.
+
+lemma lpss_fwd_append2: ∀L,K2,L2. L ⊢ ▶* K2 @@ L2 →
+ ∃∃K1,L1. K1 ⊢ ▶* K2 & L = K1 @@ L1.
+/2 width=2 by lpx_sn_fwd_append2/ qed-.
+
+(* Basic_1: removed theorems 28:
+ csubst0_clear_O csubst0_drop_lt csubst0_drop_gt csubst0_drop_eq
+ csubst0_clear_O_back csubst0_clear_S csubst0_clear_trans
+ csubst0_drop_gt_back csubst0_drop_eq_back csubst0_drop_lt_back
+ csubst0_gen_sort csubst0_gen_head csubst0_getl_ge csubst0_getl_lt
+ csubst0_gen_S_bind_2 csubst0_getl_ge_back csubst0_getl_lt_back
+ csubst0_snd_bind csubst0_fst_bind csubst0_both_bind
+ csubst1_head csubst1_flat csubst1_gen_head
+ csubst1_getl_ge csubst1_getl_lt csubst1_getl_ge_back getl_csubst1
+ fsubst0_gen_base
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/fsup.ma".
+include "basic_2/substitution/lpss_ldrop.ma".
+
+(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************)
+
+(* Main properties on context-sensitive parallel substitution for terms *****)
+
+fact cpss_conf_lpss_atom_atom:
+ ∀I,L1,L2. ∃∃T. L1 ⊢ ⓪{I} ▶* T & L2 ⊢ ⓪{I} ▶* T.
+/2 width=3/ qed-.
+
+fact cpss_conf_lpss_atom_delta:
+ ∀L0,i. (
+ ∀L,T.♯{L, T} < ♯{L0, #i} →
+ ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
+ ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
+ ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
+ ) →
+ ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
+ ∀V2. K0 ⊢ V0 ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
+ ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
+ ∃∃T. L1 ⊢ #i ▶* T & L2 ⊢ T2 ▶* T.
+#L0 #i #IH #K0 #V0 #HLK0 #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
+elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
+elim (lpss_inv_pair1 … H1) -H1 #K1 #V1 #HK01 #HV01 #H destruct
+elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
+elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
+elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
+elim (lift_total V 0 (i+1)) #T #HVT
+lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 /3 width=6/
+qed-.
+
+fact cpss_conf_lpss_delta_delta:
+ ∀L0,i. (
+ ∀L,T.♯{L, T} < ♯{L0, #i} →
+ ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
+ ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
+ ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
+ ) →
+ ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
+ ∀V1. K0 ⊢ V0 ▶* V1 → ∀T1. ⇧[O, i + 1] V1 ≡ T1 →
+ ∀KX,VX. ⇩[O, i] L0 ≡ KX.ⓓVX →
+ ∀V2. KX ⊢ VX ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
+ ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
+ ∃∃T. L1 ⊢ T1 ▶* T & L2 ⊢ T2 ▶* T.
+#L0 #i #IH #K0 #V0 #HLK0 #V1 #HV01 #T1 #HVT1
+#KX #VX #H #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
+lapply (ldrop_mono … H … HLK0) -H #H destruct
+elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
+elim (lpss_inv_pair1 … H1) -H1 #K1 #W1 #HK01 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK1) -W1 #HLK1
+elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
+elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
+elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
+elim (lift_total V 0 (i+1)) #T #HVT
+lapply (cpss_lift … HV1 … HLK1 … HVT1 … HVT) -K1 -V1
+lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 -V /2 width=3/
+qed-.
+
+fact cpss_conf_lpss_bind_bind:
+ ∀a,I,L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓑ{a,I}V0.T0} →
+ ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
+ ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
+ ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
+ ) →
+ ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0.ⓑ{I}V0 ⊢ T0 ▶* T1 →
+ ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0.ⓑ{I}V0 ⊢ T0 ▶* T2 →
+ ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
+ ∃∃T. L1 ⊢ ⓑ{a,I}V1.T1 ▶* T & L2 ⊢ ⓑ{a,I}V2.T2 ▶* T.
+#a #I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
+#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HV01 … HV02 … HL01 … HL02) //
+elim (IH … HT01 … HT02 (L1.ⓑ{I}V1) … (L2.ⓑ{I}V2)) -IH // /2 width=1/ /3 width=5/
+qed-.
+
+fact cpss_conf_lpss_flat_flat:
+ ∀I,L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓕ{I}V0.T0} →
+ ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
+ ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
+ ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
+ ) →
+ ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0 ⊢ T0 ▶* T1 →
+ ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0 ⊢ T0 ▶* T2 →
+ ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
+ ∃∃T. L1 ⊢ ⓕ{I}V1.T1 ▶* T & L2 ⊢ ⓕ{I}V2.T2 ▶* T.
+#I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
+#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HV01 … HV02 … HL01 … HL02) //
+elim (IH … HT01 … HT02 … HL01 … HL02) // /3 width=5/
+qed-.
+
+theorem cpss_conf_lpss: lpx_sn_confluent cpss cpss.
+#L0 #T0 @(f2_ind … fw … L0 T0) -L0 -T0 #n #IH #L0 * [|*]
+[ #I0 #Hn #T1 #H1 #T2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpss_inv_atom1 … H1) -H1
+ elim (cpss_inv_atom1 … H2) -H2
+ [ #H2 #H1 destruct
+ /2 width=1 by cpss_conf_lpss_atom_atom/
+ | * #K0 #V0 #V2 #i2 #HLK0 #HV02 #HVT2 #H2 #H1 destruct
+ /3 width=10 by cpss_conf_lpss_atom_delta/
+ | #H2 * #K0 #V0 #V1 #i1 #HLK0 #HV01 #HVT1 #H1 destruct
+ /4 width=10 by ex2_commute, cpss_conf_lpss_atom_delta/
+ | * #X #Y #V2 #z #H #HV02 #HVT2 #H2
+ * #K0 #V0 #V1 #i #HLK0 #HV01 #HVT1 #H1 destruct
+ /3 width=17 by cpss_conf_lpss_delta_delta/
+ ]
+| #a #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpss_inv_bind1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct
+ elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct
+ /3 width=10 by cpss_conf_lpss_bind_bind/
+| #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpss_inv_flat1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct
+ elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct
+ /3 width=10 by cpss_conf_lpss_flat_flat/
+]
+qed-.
+
+(* Basic_1: was only: subst1_confluence_eq *)
+theorem cpss_conf: ∀L. confluent … (cpss L).
+/2 width=6 by cpss_conf_lpss/ qed-.
+
+theorem cpss_trans_lpss: lpx_sn_transitive cpss cpss.
+#L1 #T1 @(f2_ind … fw … L1 T1) -L1 -T1 #n #IH #L1 * [|*]
+[ #I #Hn #T #H1 #L2 #HL12 #T2 #HT2 destruct
+ elim (cpss_inv_atom1 … H1) -H1
+ [ #H destruct
+ elim (cpss_inv_atom1 … HT2) -HT2
+ [ #H destruct //
+ | * #K2 #V #V2 #i #HLK2 #HV2 #HVT2 #H destruct
+ elim (lpss_ldrop_trans_O1 … HL12 … HLK2) -L2 #X #HLK1 #H
+ elim (lpss_inv_pair2 … H) -H #K1 #V1 #HK12 #HV1 #H destruct
+ lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
+ ]
+ | * #K1 #V1 #V #i #HLK1 #HV1 #HVT #H destruct
+ elim (lpss_ldrop_conf … HLK1 … HL12) -HL12 #X #H #HLK2
+ elim (lpss_inv_pair1 … H) -H #K2 #W2 #HK12 #_ #H destruct
+ lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+ elim (cpss_inv_lift1 … HT2 … HLK2 … HVT) -L2 -T
+ lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
+ ]
+| #a #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
+ elim (cpss_inv_bind1 … H1) -H1 #V #T #HV1 #HT1 #H destruct
+ elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /4 width=5/
+| #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
+ elim (cpss_inv_flat1 … H1) -H1 #V #T #HV1 #HT1 #H destruct
+ elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /3 width=5/
+]
+qed-.
+
+(* Basic_1: was only: subst1_trans *)
+theorem cpss_trans: ∀L. Transitive … (cpss L).
+/2 width=5 by cpss_trans_lpss/ qed-.
+
+(* Properties on context-sensitive parallel substitution for terms **********)
+
+(* Basic_1: was only: subst1_subst1_back *)
+lemma lpss_cpss_conf_dx: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 →
+ ∃∃T. L1 ⊢ T0 ▶* T & L1 ⊢ T1 ▶* T.
+#L0 #T0 #T1 #HT01 #L1 #HL01
+elim (cpss_conf_lpss … HT01 T0 … HL01 … HL01) // -L0 /2 width=3/
+qed-.
+
+lemma lpss_cpss_conf_sn: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 →
+ ∃∃T. L1 ⊢ T0 ▶* T & L0 ⊢ T1 ▶* T.
+#L0 #T0 #T1 #HT01 #L1 #HL01
+elim (cpss_conf_lpss … HT01 T0 … L0 … HL01) // -HT01 -HL01 /2 width=3/
+qed-.
+
+(* Basic_1: was only: subst1_subst1 *)
+lemma lpss_cpss_trans: ∀L1,L2. L1 ⊢ ▶* L2 →
+ ∀T1,T2. L2 ⊢ T1 ▶* T2 → L1 ⊢ T1 ▶* T2.
+/2 width=5 by cpss_trans_lpss/ qed-.
+
+lemma fsup_cpss_trans: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀U2. L2 ⊢ T2 ▶* U2 →
+ ∃∃L,U1. L1 ⊢ ▶* L & L ⊢ T1 ▶* U1 & ⦃L, U1⦄ ⊃ ⦃L2, U2⦄.
+#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 [1,2,3,4,5: /3 width=5/ ]
+#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #U2 #HTU2
+elim (IHT12 … HTU2) -IHT12 -HTU2 #K #T #HK1 #HT1 #HT2
+elim (lift_total T d e) #U #HTU
+elim (ldrop_lpss_trans … HLK1 … HK1) -HLK1 -HK1 #L2 #HL12 #HL2K
+lapply (cpss_lift … HT1 … HL2K … HTU1 … HTU) -HT1 -HTU1 /3 width=11/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop_lpx_sn.ma".
+include "basic_2/substitution/cpss_lift.ma".
+include "basic_2/substitution/lpss.ma".
+
+(* SN PARALLEL SUBSTITUTION FOR LOCAL ENVIRONMENTS **************************)
+
+(* Properies on local environment slicing ***********************************)
+
+lemma lpss_ldrop_conf: dropable_sn lpss.
+/3 width=5 by lpx_sn_deliftable_dropable, cpss_inv_lift1/ qed-.
+
+lemma ldrop_lpss_trans: dedropable_sn lpss.
+/3 width=9 by lpx_sn_liftable_dedropable, cpss_lift/ qed-.
+
+lemma lpss_ldrop_trans_O1: dropable_dx lpss.
+/2 width=3 by lpx_sn_dropable/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/substitution/lpss_cpss.ma".
+
+(* SN PARALLEL SUBSTITUTION ON LOCAL ENVIRONMENTS ***************************)
+
+(* Main properties **********************************************************)
+
+theorem lpss_conf: confluent … lpss.
+/3 width=6 by lpx_sn_conf, cpss_conf_lpss/
+qed-.
+
+theorem lpss_trans: Transitive … lpss.
+/3 width=5 by lpx_sn_trans, cpss_trans_lpss/
+qed-.
+
+(* Advanced forward lemmas **************************************************)
+
+lemma cpss_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ▶* T →
+ ∃∃L2,T2. L @@ L1 ⊢ ▶* L @@ L2 & L @@ L1 ⊢ T1 ▶* T2 &
+ T = L2 @@ T2.
+#L1 @(lenv_ind_dx … L1) -L1
+[ #L #T1 #T #HT1
+ @ex3_2_intro [3: // |4,5: // |1,2: skip ] (**) (* /2 width=4/ does not work *)
+| #I #L1 #V1 #IH #L #T1 #T >shift_append_assoc #H <append_assoc
+ elim (cpss_inv_bind1 … H) -H #V2 #T2 #HV12 #HT12 #H destruct
+ elim (IH … HT12) -IH -HT12 #L2 #T #HL12 #HT1 #H destruct
+ lapply (lpss_trans … HL12 (L.ⓑ{I}V2@@L2) ?) -HL12 /3 width=1/ #HL12
+ @(ex3_2_intro … (⋆.ⓑ{I}V2@@L2)) [4: /2 width=3/ | skip ] <append_assoc // (**) (* explicit constructor *)
+]
+qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/lenv_length.ma".
-
-(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************)
-
-inductive lsubr: nat → nat → relation lenv ≝
-| lsubr_sort: ∀d,e. lsubr d e (⋆) (⋆)
-| lsubr_OO: ∀L1,L2. lsubr 0 0 L1 L2
-| lsubr_abbr: ∀L1,L2,V,e. lsubr 0 e L1 L2 →
- lsubr 0 (e + 1) (L1. ⓓV) (L2.ⓓV)
-| lsubr_abst: ∀L1,L2,I,V1,V2,e. lsubr 0 e L1 L2 →
- lsubr 0 (e + 1) (L1. ⓑ{I}V1) (L2. ⓛV2)
-| lsubr_skip: ∀L1,L2,I1,I2,V1,V2,d,e.
- lsubr d e L1 L2 → lsubr (d + 1) e (L1. ⓑ{I1} V1) (L2. ⓑ{I2} V2)
-.
-
-interpretation
- "local environment refinement (substitution)"
- 'SubEq L1 d e L2 = (lsubr d e L1 L2).
-
-definition lsubr_trans: ∀S. (lenv → relation S) → Prop ≝ λS,R.
- ∀L2,s1,s2. R L2 s1 s2 →
- ∀L1,d,e. L1 ⊑ [d, e] L2 → R L1 s1 s2.
-
-(* Basic properties *********************************************************)
-
-lemma lsubr_bind_eq: ∀L1,L2,e. L1 ⊑ [0, e] L2 → ∀I,V.
- L1. ⓑ{I} V ⊑ [0, e + 1] L2.ⓑ{I} V.
-#L1 #L2 #e #HL12 #I #V elim I -I /2 width=1/
-qed.
-
-lemma lsubr_abbr_lt: ∀L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
- L1. ⓓV ⊑ [0, e] L2.ⓓV.
-#L1 #L2 #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
-qed.
-
-lemma lsubr_abst_lt: ∀L1,L2,I,V1,V2,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
- L1. ⓑ{I}V1 ⊑ [0, e] L2. ⓛV2.
-#L1 #L2 #I #V1 #V2 #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
-qed.
-
-lemma lsubr_skip_lt: ∀L1,L2,d,e. L1 ⊑ [d - 1, e] L2 → 0 < d →
- ∀I1,I2,V1,V2. L1. ⓑ{I1} V1 ⊑ [d, e] L2. ⓑ{I2} V2.
-#L1 #L2 #d #e #HL12 #Hd >(plus_minus_m_m d 1) // /2 width=1/
-qed.
-
-lemma lsubr_bind_lt: ∀I,L1,L2,V,e. L1 ⊑ [0, e - 1] L2 → 0 < e →
- L1. ⓓV ⊑ [0, e] L2. ⓑ{I}V.
-* /2 width=1/ qed.
-
-lemma lsubr_refl: ∀d,e,L. L ⊑ [d, e] L.
-#d elim d -d
-[ #e elim e -e // #e #IHe #L elim L -L // /2 width=1/
-| #d #IHd #e #L elim L -L // /2 width=1/
-]
-qed.
-
-lemma TC_lsubr_trans: ∀S,R. lsubr_trans S R → lsubr_trans S (λL. (TC … (R L))).
-#S #R #HR #L1 #s1 #s2 #H elim H -s2
-[ /3 width=5/
-| #s #s2 #_ #Hs2 #IHs1 #L2 #d #e #HL12
- lapply (HR … Hs2 … HL12) -HR -Hs2 -HL12 /3 width=3/
-]
-qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-fact lsubr_inv_atom1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L1 = ⋆ →
- L2 = ⋆ ∨ (d = 0 ∧ e = 0).
-#L1 #L2 #d #e * -L1 -L2 -d -e
-[ /2 width=1/
-| /3 width=1/
-| #L1 #L2 #W #e #_ #H destruct
-| #L1 #L2 #I #W1 #W2 #e #_ #H destruct
-| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct
-]
-qed.
-
-lemma lsubr_inv_atom1: ∀L2,d,e. ⋆ ⊑ [d, e] L2 →
- L2 = ⋆ ∨ (d = 0 ∧ e = 0).
-/2 width=3/ qed-.
-
-fact lsubr_inv_skip1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- ∀I1,K1,V1. L1 = K1.ⓑ{I1}V1 → 0 < d →
- ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2.
-#L1 #L2 #d #e * -L1 -L2 -d -e
-[ #d #e #I1 #K1 #V1 #H destruct
-| #L1 #L2 #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/
-]
-qed.
-
-lemma lsubr_inv_skip1: ∀I1,K1,L2,V1,d,e. K1.ⓑ{I1}V1 ⊑ [d, e] L2 → 0 < d →
- ∃∃I2,K2,V2. K1 ⊑ [d - 1, e] K2 & L2 = K2.ⓑ{I2}V2.
-/2 width=5/ qed-.
-
-fact lsubr_inv_atom2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 → L2 = ⋆ →
- L1 = ⋆ ∨ (d = 0 ∧ e = 0).
-#L1 #L2 #d #e * -L1 -L2 -d -e
-[ /2 width=1/
-| /3 width=1/
-| #L1 #L2 #W #e #_ #H destruct
-| #L1 #L2 #I #W1 #W2 #e #_ #H destruct
-| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #H destruct
-]
-qed.
-
-lemma lsubr_inv_atom2: ∀L1,d,e. L1 ⊑ [d, e] ⋆ →
- L1 = ⋆ ∨ (d = 0 ∧ e = 0).
-/2 width=3/ qed-.
-
-fact lsubr_inv_abbr2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- ∀K2,V. L2 = K2.ⓓV → d = 0 → 0 < e →
- ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV.
-#L1 #L2 #d #e * -L1 -L2 -d -e
-[ #d #e #K1 #V #H destruct
-| #L1 #L2 #K1 #V #_ #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #W #e #HL12 #K1 #V #H #_ #_ destruct /2 width=3/
-| #L1 #L2 #I #W1 #W2 #e #_ #K1 #V #H destruct
-| #L1 #L2 #I1 #I2 #W1 #W2 #d #e #_ #K1 #V #_ >commutative_plus normalize #H destruct
-]
-qed.
-
-lemma lsubr_inv_abbr2: ∀L1,K2,V,e. L1 ⊑ [0, e] K2.ⓓV → 0 < e →
- ∃∃K1. K1 ⊑ [0, e - 1] K2 & L1 = K1.ⓓV.
-/2 width=5/ qed-.
-
-fact lsubr_inv_skip2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- ∀I2,K2,V2. L2 = K2.ⓑ{I2}V2 → 0 < d →
- ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1.
-#L1 #L2 #d #e * -L1 -L2 -d -e
-[ #d #e #I1 #K1 #V1 #H destruct
-| #L1 #L2 #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #W #e #_ #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #I #W1 #W2 #e #_ #I1 #K1 #V1 #_ #H
- elim (lt_zero_false … H)
-| #L1 #L2 #J1 #J2 #W1 #W2 #d #e #HL12 #I1 #K1 #V1 #H #_ destruct /2 width=5/
-]
-qed.
-
-lemma lsubr_inv_skip2: ∀I2,L1,K2,V2,d,e. L1 ⊑ [d, e] K2.ⓑ{I2}V2 → 0 < d →
- ∃∃I1,K1,V1. K1 ⊑ [d - 1, e] K2 & L1 = K1.ⓑ{I1}V1.
-/2 width=5/ qed-.
-
-(* Basic forward lemmas *****************************************************)
-
-fact lsubr_fwd_length_full1_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- d = 0 → e = |L1| → |L1| ≤ |L2|.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize
-[ //
-| /2 width=1/
-| /3 width=1/
-| /3 width=1/
-| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct
-]
-qed.
-
-lemma lsubr_fwd_length_full1: ∀L1,L2. L1 ⊑ [0, |L1|] L2 → |L1| ≤ |L2|.
-/2 width=5/ qed-.
-
-fact lsubr_fwd_length_full2_aux: ∀L1,L2,d,e. L1 ⊑ [d, e] L2 →
- d = 0 → e = |L2| → |L2| ≤ |L1|.
-#L1 #L2 #d #e #H elim H -L1 -L2 -d -e normalize
-[ //
-| /2 width=1/
-| /3 width=1/
-| /3 width=1/
-| #L1 #L2 #_ #_ #_ #_ #d #e #_ #_ >commutative_plus normalize #H destruct
-]
-qed.
-
-lemma lsubr_fwd_length_full2: ∀L1,L2. L1 ⊑ [0, |L2|] L2 → |L2| ≤ |L1|.
-/2 width=5/ qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lsubr.ma".
-
-(* LOCAL ENVIRONMENT REFINEMENT FOR SUBSTITUTION ****************************)
-
-(* bottom element of the refinement *)
-definition lbotr: nat → nat → predicate lenv ≝
- λd,e. NF_sn … (lsubr d e) (lsubr d e …).
-
-interpretation
- "local environment full refinement (substitution)"
- 'SubEqBottom d e L = (lbotr d e L).
-
-(* Basic properties *********************************************************)
-
-lemma lbotr_atom: ∀d,e. ⊒[d, e] ⋆.
-#d #e #L #H
-elim (lsubr_inv_atom2 … H) -H
-[ #H destruct //
-| * #H1 #H2 destruct //
-]
-qed.
-
-lemma lbotr_OO: ∀L. ⊒[0, 0] L.
-// qed.
-
-lemma lbotr_abbr: ∀L,V,e. ⊒[0, e] L → ⊒[0, e + 1] L.ⓓV.
-#L #V #e #HL #K #H
-elim (lsubr_inv_abbr2 … H ?) -H // <minus_plus_m_m #X #HLX #H destruct
-lapply (HL … HLX) -HL -HLX /2 width=1/
-qed.
-
-lemma lbotr_abbr_O: ∀L,V. ⊒[0,1] L.ⓓV.
-#L #V
-@(lbotr_abbr … 0) //
-qed.
-
-lemma lbotr_skip: ∀I,L,V,d,e. ⊒[d, e] L → ⊒[d + 1, e] L.ⓑ{I}V.
-#I #L #V #d #e #HL #K #H
-elim (lsubr_inv_skip2 … H ?) -H // <minus_plus_m_m #J #X #W #HLX #H destruct
-lapply (HL … HLX) -HL -HLX /2 width=1/
-qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma lbotr_inv_bind: ∀I,L,V,e. ⊒[0, e] L.ⓑ{I}V → 0 < e →
- ⊒[0, e - 1] L ∧ I = Abbr.
-#I #L #V #e #HL #He
-lapply (HL (L.ⓓV) ?) /2 width=1/ #H
-elim (lsubr_inv_abbr2 … H ?) -H // #K #_ #H destruct
-@conj // #L #HKL
-lapply (HL (L.ⓓV) ?) -HL /2 width=1/ -HKL #H
-elim (lsubr_inv_abbr2 … H ?) -H // -He #X #HLX #H destruct //
-qed-.
-
-lemma lbotr_inv_skip: ∀I,L,V,d,e. ⊒[d, e] L.ⓑ{I}V → 0 < d → ⊒[d - 1, e] L.
-#I #L #V #d #e #HL #Hd #K #HLK
-lapply (HL (K.ⓑ{I}V) ?) -HL /2 width=1/ -HLK #H
-elim (lsubr_inv_skip2 … H ?) -H // -Hd #J #X #W #HKX #H destruct //
-qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/cpss.ma".
+
+(* CONTEXT-SENSITIVE RESTRICTED PARALLEL COMPUTATION FOR TERMS **************)
+
+inductive cpqs: lenv → relation term ≝
+| cpqs_atom : ∀I,L. cpqs L (⓪{I}) (⓪{I})
+| cpqs_delta: ∀L,K,V,V2,W2,i.
+ ⇩[0, i] L ≡ K. ⓓV → cpqs K V V2 →
+ ⇧[0, i + 1] V2 ≡ W2 → cpqs L (#i) W2
+| cpqs_bind : ∀a,I,L,V1,V2,T1,T2.
+ cpqs L V1 V2 → cpqs (L. ⓑ{I} V1) T1 T2 →
+ cpqs L (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2)
+| cpqs_flat : ∀I,L,V1,V2,T1,T2.
+ cpqs L V1 V2 → cpqs L T1 T2 →
+ cpqs L (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
+| cpqs_zeta : ∀L,V,T1,T,T2. cpqs (L.ⓓV) T1 T →
+ ⇧[0, 1] T2 ≡ T → cpqs L (+ⓓV. T1) T2
+| cpqs_tau : ∀L,V,T1,T2. cpqs L T1 T2 → cpqs L (ⓝV. T1) T2
+.
+
+interpretation "context-sensitive restricted parallel computation (term)"
+ 'PRestStar L T1 T2 = (cpqs L T1 T2).
+
+(* Basic properties *********************************************************)
+
+(* Note: it does not hold replacing |L1| with |L2| *)
+lemma cpqs_lsubr_trans: ∀L1,T1,T2. L1 ⊢ T1 ➤* T2 →
+ ∀L2. L2 ⊑ [0, |L1|] L1 → L2 ⊢ T1 ➤* T2.
+#L1 #T1 #T2 #H elim H -L1 -T1 -T2
+[ //
+| #L1 #K1 #V1 #V2 #W2 #i #HLK1 #_ #HVW2 #IHV12 #L2 #HL12
+ lapply (ldrop_fwd_ldrop2_length … HLK1) #Hi
+ lapply (ldrop_fwd_O1_length … HLK1) #H2i
+ elim (ldrop_lsubr_ldrop2_abbr … HL12 … HLK1 ? ?) -HL12 -HLK1 // -Hi
+ <H2i -H2i <minus_plus_m_m /3 width=6/
+| /4 width=1/
+|4,6: /3 width=1/
+| /4 width=3/
+]
+qed-.
+
+lemma cpss_cpqs: ∀L,T1,T2. L ⊢ T1 ▶* T2 → L ⊢ T1 ➤* T2.
+#L #T1 #T2 #H elim H -L -T1 -T2 // /2 width=1/ /2 width=6/
+qed.
+
+lemma cpqs_refl: ∀T,L. L ⊢ T ➤* T.
+/2 width=1/ qed.
+
+lemma cpqs_delift: ∀L,K,V,T1,d. ⇩[0, d] L ≡ (K. ⓓV) →
+ ∃∃T2,T. L ⊢ T1 ➤* T2 & ⇧[d, 1] T ≡ T2.
+#L #K #V #T1 #d #HLK
+elim (cpss_delift … T1 … HLK) -HLK /3 width=4/
+qed-.
+
+lemma cpqs_append: l_appendable_sn … cpqs.
+#K #T1 #T2 #H elim H -K -T1 -T2 // /2 width=1/ /2 width=3/
+#K #K0 #V1 #V2 #W2 #i #HK0 #_ #HVW2 #IHV12 #L
+lapply (ldrop_fwd_ldrop2_length … HK0) #H
+@(cpqs_delta … (L@@K0) V1 … HVW2) //
+@(ldrop_O1_append_sn_le … HK0) /2 width=2/ (**) (* /3/ does not work *)
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+fact cpqs_inv_atom1_aux: ∀L,T1,T2. L ⊢ T1 ➤* T2 → ∀I. T1 = ⓪{I} →
+ T2 = ⓪{I} ∨
+ ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ➤* V2 &
+ ⇧[O, i + 1] V2 ≡ T2 &
+ I = LRef i.
+#L #T1 #T2 * -L -T1 -T2
+[ #I #L #J #H destruct /2 width=1/
+| #L #K #V #V2 #T2 #i #HLK #HV2 #HVT2 #J #H destruct /3 width=8/
+| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
+| #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
+| #L #V #T1 #T #T2 #_ #_ #J #H destruct
+| #L #V #T1 #T2 #_ #J #H destruct
+]
+qed-.
+
+lemma cpqs_inv_atom1: ∀I,L,T2. L ⊢ ⓪{I} ➤* T2 →
+ T2 = ⓪{I} ∨
+ ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ➤* V2 &
+ ⇧[O, i + 1] V2 ≡ T2 &
+ I = LRef i.
+/2 width=3 by cpqs_inv_atom1_aux/ qed-.
+
+lemma cpqs_inv_sort1: ∀L,T2,k. L ⊢ ⋆k ➤* T2 → T2 = ⋆k.
+#L #T2 #k #H
+elim (cpqs_inv_atom1 … H) -H //
+* #K #V #V2 #i #_ #_ #_ #H destruct
+qed-.
+
+lemma cpqs_inv_lref1: ∀L,T2,i. L ⊢ #i ➤* T2 →
+ T2 = #i ∨
+ ∃∃K,V,V2. ⇩[O, i] L ≡ K. ⓓV &
+ K ⊢ V ➤* V2 &
+ ⇧[O, i + 1] V2 ≡ T2.
+#L #T2 #i #H
+elim (cpqs_inv_atom1 … H) -H /2 width=1/
+* #K #V #V2 #j #HLK #HV2 #HVT2 #H destruct /3 width=6/
+qed-.
+
+lemma cpqs_inv_gref1: ∀L,T2,p. L ⊢ §p ➤* T2 → T2 = §p.
+#L #T2 #p #H
+elim (cpqs_inv_atom1 … H) -H //
+* #K #V #V2 #i #_ #_ #_ #H destruct
+qed-.
+
+fact cpqs_inv_bind1_aux: ∀L,U1,U2. L ⊢ U1 ➤* U2 →
+ ∀a,I,V1,T1. U1 = ⓑ{a,I} V1. T1 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 &
+ L. ⓑ{I} V1 ⊢ T1 ➤* T2 &
+ U2 = ⓑ{a,I} V2. T2
+ ) ∨
+ ∃∃T. L.ⓓV1 ⊢ T1 ➤* T & ⇧[0, 1] U2 ≡ T & a = true & I = Abbr.
+#L #U1 #U2 * -L -U1 -U2
+[ #I #L #b #J #W1 #U1 #H destruct
+| #L #K #V #V2 #W2 #i #_ #_ #_ #b #J #W1 #U1 #H destruct
+| #a #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #b #J #W1 #U1 #H destruct /3 width=5/
+| #I #L #V1 #V2 #T1 #T2 #_ #_ #b #J #W1 #U1 #H destruct
+| #L #V #T1 #T #T2 #HT1 #HT2 #b #J #W1 #U1 #H destruct /3 width=3/
+| #L #V #T1 #T2 #_ #b #J #W1 #U1 #H destruct
+]
+qed-.
+
+lemma cpqs_inv_bind1: ∀a,I,L,V1,T1,U2. L ⊢ ⓑ{a,I} V1. T1 ➤* U2 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 &
+ L. ⓑ{I} V1 ⊢ T1 ➤* T2 &
+ U2 = ⓑ{a,I} V2. T2
+ ) ∨
+ ∃∃T. L.ⓓV1 ⊢ T1 ➤* T & ⇧[0, 1] U2 ≡ T & a = true & I = Abbr.
+/2 width=3 by cpqs_inv_bind1_aux/ qed-.
+
+lemma cpqs_inv_abbr1: ∀a,L,V1,T1,U2. L ⊢ ⓓ{a} V1. T1 ➤* U2 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 &
+ L. ⓓ V1 ⊢ T1 ➤* T2 &
+ U2 = ⓓ{a} V2. T2
+ ) ∨
+ ∃∃T. L.ⓓV1 ⊢ T1 ➤* T & ⇧[0, 1] U2 ≡ T & a = true.
+#a #L #V1 #T1 #U2 #H
+elim (cpqs_inv_bind1 … H) -H * /3 width=3/ /3 width=5/
+qed-.
+
+lemma cpqs_inv_abst1: ∀a,L,V1,T1,U2. L ⊢ ⓛ{a} V1. T1 ➤* U2 →
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 &
+ L. ⓛ V1 ⊢ T1 ➤* T2 &
+ U2 = ⓛ{a} V2. T2.
+#a #L #V1 #T1 #U2 #H
+elim (cpqs_inv_bind1 … H) -H *
+[ /3 width=5/
+| #T #_ #_ #_ #H destruct
+]
+qed-.
+
+fact cpqs_inv_flat1_aux: ∀L,U1,U2. L ⊢ U1 ➤* U2 →
+ ∀I,V1,T1. U1 = ⓕ{I} V1. T1 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 & L ⊢ T1 ➤* T2 &
+ U2 = ⓕ{I} V2. T2
+ ) ∨
+ (L ⊢ T1 ➤* U2 ∧ I = Cast).
+#L #U1 #U2 * -L -U1 -U2
+[ #I #L #J #W1 #U1 #H destruct
+| #L #K #V #V2 #W2 #i #_ #_ #_ #J #W1 #U1 #H destruct
+| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #W1 #U1 #H destruct
+| #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #J #W1 #U1 #H destruct /3 width=5/
+| #L #V #T1 #T #T2 #_ #_ #J #W1 #U1 #H destruct
+| #L #V #T1 #T2 #HT12 #J #W1 #U1 #H destruct /3 width=1/
+]
+qed-.
+
+lemma cpqs_inv_flat1: ∀I,L,V1,T1,U2. L ⊢ ⓕ{I} V1. T1 ➤* U2 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 & L ⊢ T1 ➤* T2 &
+ U2 = ⓕ{I} V2. T2
+ ) ∨
+ (L ⊢ T1 ➤* U2 ∧ I = Cast).
+/2 width=3 by cpqs_inv_flat1_aux/ qed-.
+
+lemma cpqs_inv_appl1: ∀L,V1,T1,U2. L ⊢ ⓐ V1. T1 ➤* U2 →
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 & L ⊢ T1 ➤* T2 &
+ U2 = ⓐ V2. T2.
+#L #V1 #T1 #U2 #H elim (cpqs_inv_flat1 … H) -H *
+[ /3 width=5/
+| #_ #H destruct
+]
+qed-.
+
+lemma cpqs_inv_cast1: ∀L,V1,T1,U2. L ⊢ ⓝ V1. T1 ➤* U2 → (
+ ∃∃V2,T2. L ⊢ V1 ➤* V2 & L ⊢ T1 ➤* T2 &
+ U2 = ⓝ V2. T2
+ ) ∨
+ L ⊢ T1 ➤* U2.
+#L #V1 #T1 #U2 #H elim (cpqs_inv_flat1 … H) -H * /2 width=1/ /3 width=5/
+qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma cpqs_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ➤* T →
+ ∃∃L2,T2. |L1| = |L2| & T = L2 @@ T2.
+#L1 @(lenv_ind_dx … L1) -L1 normalize
+[ #L #T1 #T #HT1
+ @(ex2_2_intro … (⋆)) // (**) (* explicit constructor *)
+| #I #L1 #V1 #IH #L #T1 #X
+ >shift_append_assoc normalize #H
+ elim (cpqs_inv_bind1 … H) -H *
+ [ #V0 #T0 #_ #HT10 #H destruct
+ elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct
+ >append_length >HL12 -HL12
+ @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *)
+ | #T #_ #_ #H destruct
+ ]
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop_ldrop.ma".
+include "basic_2/unfold/cpqs.ma".
+
+(* CONTEXT-SENSITIVE RESTRICTED PARALLEL COMPUTATION FOR TERMS **************)
+
+(* Relocation properties ****************************************************)
+
+lemma cpqs_lift: l_liftable cpqs.
+#K #T1 #T2 #H elim H -K -T1 -T2
+[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2
+ >(lift_mono … H1 … H2) -H1 -H2 //
+| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2
+ elim (lift_inv_lref1 … H) * #Hid #H destruct
+ [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // <minus_plus #W2 #HVW2 #HWU2
+ elim (ldrop_trans_le … HLK … HKV) -K /2 width=2/ #X #HLK #H
+ elim (ldrop_inv_skip2 … H) -H /2 width=1/ -Hid #K #Y #HKV #HVY #H destruct /3 width=8/
+ | lapply (lift_trans_be … HVW2 … HWU2 ? ?) -W2 // /2 width=1/ >plus_plus_comm_23 #HVU2
+ lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/
+ ]
+| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
+ elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
+ elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/
+| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
+ elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
+ elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/
+| #K #V #T1 #T #T2 #_ #HT2 #IHT1 #L #d #e #HLK #U1 #H #U2 #HTU2
+ elim (lift_inv_bind1 … H) -H #VV1 #TT1 #HVV1 #HTT1 #H destruct
+ elim (lift_conf_O1 … HTU2 … HT2) -T2 /4 width=5/
+| #K #V #T1 #T2 #_ #IHT12 #L #d #e #HLK #U1 #H #U2 #HTU2
+ elim (lift_inv_flat1 … H) -H #VV1 #TT1 #HVV1 #HTT1 #H destruct /3 width=5/
+]
+qed.
+
+lemma cpqs_inv_lift1: l_deliftable_sn cpqs.
+#L #U1 #U2 #H elim H -L -U1 -U2
+[ * #L #i #K #d #e #_ #T1 #H
+ [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/
+ | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/
+ | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/
+ ]
+| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H
+ elim (lift_inv_lref2 … H) -H * #Hid #H destruct
+ [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV
+ elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2
+ elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus <plus_minus_m_m // -Hid /3 width=8/
+ | elim (le_inv_plus_l … Hid) #Hdie #Hei
+ lapply (ldrop_conf_ge … HLK … HLV ?) -L // #HKLV
+ elim (lift_split … HVW2 d (i - e + 1)) -HVW2 [4: // |3: /2 width=1/ |2: /3 width=1/ ] -Hid -Hdie
+ #V1 #HV1 >plus_minus // <minus_minus // /2 width=1/ <minus_n_n <plus_n_O /3 width=8/
+ ]
+| #a #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
+ elim (lift_inv_bind2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHV12 … HLK … HWV1) -IHV12 #W2 #HW12 #HWV2
+ elim (IHU12 … HTU1) -IHU12 -HTU1 /3 width=5/
+| #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
+ elim (lift_inv_flat2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHV12 … HLK … HWV1) -V1
+ elim (IHU12 … HLK … HTU1) -U1 -HLK /3 width=5/
+| #L #V #U1 #U #U2 #_ #HU2 #IHU1 #K #d #e #HLK #X #H
+ elim (lift_inv_bind2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHU1 (K.ⓓW1) … HTU1) /2 width=1/ -L -U1 #T #HTU #HT1
+ elim (lift_div_le … HU2 … HTU) -U // /3 width=5/
+| #L #V #U1 #U2 #_ #IHU12 #K #d #e #HLK #X #H
+ elim (lift_inv_flat2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
+ elim (IHU12 … HLK … HTU1) -L -U1 /3 width=3/
+]
+qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_append.ma".
-
-(* CONTEXT-SENSITIVE PARALLEL UNFOLD FOR TERMS ******************************)
-
-inductive cpss: lenv → relation term ≝
-| cpss_atom : ∀I,L. cpss L (⓪{I}) (⓪{I})
-| cpss_delta: ∀L,K,V,V2,W2,i.
- ⇩[0, i] L ≡ K. ⓓV → cpss K V V2 →
- ⇧[0, i + 1] V2 ≡ W2 → cpss L (#i) W2
-| cpss_bind : ∀a,I,L,V1,V2,T1,T2.
- cpss L V1 V2 → cpss (L. ⓑ{I} V1) T1 T2 →
- cpss L (ⓑ{a,I} V1. T1) (ⓑ{a,I} V2. T2)
-| cpss_flat : ∀I,L,V1,V2,T1,T2.
- cpss L V1 V2 → cpss L T1 T2 →
- cpss L (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
-.
-
-interpretation "context-sensitive parallel unfold (term)"
- 'PSubstStar L T1 T2 = (cpss L T1 T2).
-
-(* Basic properties *********************************************************)
-
-(* Note: it does not hold replacing |L1| with |L2| *)
-lemma cpss_lsubr_trans: ∀L1,T1,T2. L1 ⊢ T1 ▶* T2 →
- ∀L2. L2 ⊑ [0, |L1|] L1 → L2 ⊢ T1 ▶* T2.
-#L1 #T1 #T2 #H elim H -L1 -T1 -T2
-[ //
-| #L1 #K1 #V1 #V2 #W2 #i #HLK1 #_ #HVW2 #IHV12 #L2 #HL12
- lapply (ldrop_fwd_ldrop2_length … HLK1) #Hi
- lapply (ldrop_fwd_O1_length … HLK1) #H2i
- elim (ldrop_lsubr_ldrop2_abbr … HL12 … HLK1 ? ?) -HL12 -HLK1 // -Hi
- <H2i -H2i <minus_plus_m_m /3 width=6/
-| /4 width=1/
-| /3 width=1/
-]
-qed-.
-
-(* Basic_1: was by definition: subst1_refl *)
-lemma cpss_refl: ∀T,L. L ⊢ T ▶* T.
-#T elim T -T //
-#I elim I -I /2 width=1/
-qed.
-
-(* Basic_1: was only: subst1_ex *)
-lemma cpss_delift: ∀K,V,T1,L,d. ⇩[0, d] L ≡ (K. ⓓV) →
- ∃∃T2,T. L ⊢ T1 ▶* T2 & ⇧[d, 1] T ≡ T2.
-#K #V #T1 elim T1 -T1
-[ * #i #L #d #HLK /2 width=4/
- elim (lt_or_eq_or_gt i d) #Hid /3 width=4/
- destruct
- elim (lift_total V 0 (i+1)) #W #HVW
- elim (lift_split … HVW i i ? ? ?) // /3 width=6/
-| * [ #a ] #I #W1 #U1 #IHW1 #IHU1 #L #d #HLK
- elim (IHW1 … HLK) -IHW1 #W2 #W #HW12 #HW2
- [ elim (IHU1 (L. ⓑ{I} W1) (d+1) ?) -IHU1 /2 width=1/ -HLK /3 width=9/
- | elim (IHU1 … HLK) -IHU1 -HLK /3 width=8/
- ]
-]
-qed-.
-
-lemma cpss_append: l_appendable_sn … cpss.
-#K #T1 #T2 #H elim H -K -T1 -T2 // /2 width=1/
-#K #K0 #V1 #V2 #W2 #i #HK0 #_ #HVW2 #IHV12 #L
-lapply (ldrop_fwd_ldrop2_length … HK0) #H
-@(cpss_delta … (L@@K0) V1 … HVW2) //
-@(ldrop_O1_append_sn_le … HK0) /2 width=2/ (**) (* /3/ does not work *)
-qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-fact cpss_inv_atom1_aux: ∀L,T1,T2. L ⊢ T1 ▶* T2 → ∀I. T1 = ⓪{I} →
- T2 = ⓪{I} ∨
- ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
- K ⊢ V ▶* V2 &
- ⇧[O, i + 1] V2 ≡ T2 &
- I = LRef i.
-#L #T1 #T2 * -L -T1 -T2
-[ #I #L #J #H destruct /2 width=1/
-| #L #K #V #V2 #T2 #i #HLK #HV2 #HVT2 #I #H destruct /3 width=8/
-| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
-| #I #L #V1 #V2 #T1 #T2 #_ #_ #J #H destruct
-]
-qed-.
-
-lemma cpss_inv_atom1: ∀I,L,T2. L ⊢ ⓪{I} ▶* T2 →
- T2 = ⓪{I} ∨
- ∃∃K,V,V2,i. ⇩[O, i] L ≡ K. ⓓV &
- K ⊢ V ▶* V2 &
- ⇧[O, i + 1] V2 ≡ T2 &
- I = LRef i.
-/2 width=3 by cpss_inv_atom1_aux/ qed-.
-
-(* Basic_1: was only: subst1_gen_sort *)
-lemma cpss_inv_sort1: ∀L,T2,k. L ⊢ ⋆k ▶* T2 → T2 = ⋆k.
-#L #T2 #k #H
-elim (cpss_inv_atom1 … H) -H //
-* #K #V #V2 #i #_ #_ #_ #H destruct
-qed-.
-
-(* Basic_1: was only: subst1_gen_lref *)
-lemma cpss_inv_lref1: ∀L,T2,i. L ⊢ #i ▶* T2 →
- T2 = #i ∨
- ∃∃K,V,V2. ⇩[O, i] L ≡ K. ⓓV &
- K ⊢ V ▶* V2 &
- ⇧[O, i + 1] V2 ≡ T2.
-#L #T2 #i #H
-elim (cpss_inv_atom1 … H) -H /2 width=1/
-* #K #V #V2 #j #HLK #HV2 #HVT2 #H destruct /3 width=6/
-qed-.
-
-lemma cpss_inv_gref1: ∀L,T2,p. L ⊢ §p ▶* T2 → T2 = §p.
-#L #T2 #p #H
-elim (cpss_inv_atom1 … H) -H //
-* #K #V #V2 #i #_ #_ #_ #H destruct
-qed-.
-
-fact cpss_inv_bind1_aux: ∀L,U1,U2. L ⊢ U1 ▶* U2 →
- ∀a,I,V1,T1. U1 = ⓑ{a,I} V1. T1 →
- ∃∃V2,T2. L ⊢ V1 ▶* V2 &
- L. ⓑ{I} V1 ⊢ T1 ▶* T2 &
- U2 = ⓑ{a,I} V2. T2.
-#L #U1 #U2 * -L -U1 -U2
-[ #I #L #b #J #W1 #U1 #H destruct
-| #L #K #V #V2 #W2 #i #_ #_ #_ #b #J #W1 #U1 #H destruct
-| #a #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #b #J #W1 #U1 #H destruct /2 width=5/
-| #I #L #V1 #V2 #T1 #T2 #_ #_ #b #J #W1 #U1 #H destruct
-]
-qed-.
-
-lemma cpss_inv_bind1: ∀a,I,L,V1,T1,U2. L ⊢ ⓑ{a,I} V1. T1 ▶* U2 →
- ∃∃V2,T2. L ⊢ V1 ▶* V2 &
- L. ⓑ{I} V1 ⊢ T1 ▶* T2 &
- U2 = ⓑ{a,I} V2. T2.
-/2 width=3 by cpss_inv_bind1_aux/ qed-.
-
-fact cpss_inv_flat1_aux: ∀L,U1,U2. L ⊢ U1 ▶* U2 →
- ∀I,V1,T1. U1 = ⓕ{I} V1. T1 →
- ∃∃V2,T2. L ⊢ V1 ▶* V2 & L ⊢ T1 ▶* T2 &
- U2 = ⓕ{I} V2. T2.
-#L #U1 #U2 * -L -U1 -U2
-[ #I #L #J #W1 #U1 #H destruct
-| #L #K #V #V2 #W2 #i #_ #_ #_ #J #W1 #U1 #H destruct
-| #a #I #L #V1 #V2 #T1 #T2 #_ #_ #J #W1 #U1 #H destruct
-| #I #L #V1 #V2 #T1 #T2 #HV12 #HT12 #J #W1 #U1 #H destruct /2 width=5/
-]
-qed-.
-
-lemma cpss_inv_flat1: ∀I,L,V1,T1,U2. L ⊢ ⓕ{I} V1. T1 ▶* U2 →
- ∃∃V2,T2. L ⊢ V1 ▶* V2 & L ⊢ T1 ▶* T2 &
- U2 = ⓕ{I} V2. T2.
-/2 width=3 by cpss_inv_flat1_aux/ qed-.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma cpss_fwd_tw: ∀L,T1,T2. L ⊢ T1 ▶* T2 → ♯{T1} ≤ ♯{T2}.
-#L #T1 #T2 #H elim H -L -T1 -T2 normalize
-/3 width=1 by monotonic_le_plus_l, le_plus/ (**) (* auto is too slow without trace *)
-qed-.
-
-lemma cpss_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ▶* T →
- ∃∃L2,T2. |L1| = |L2| & T = L2 @@ T2.
-#L1 @(lenv_ind_dx … L1) -L1 normalize
-[ #L #T1 #T #HT1
- @(ex2_2_intro … (⋆)) // (**) (* explicit constructor *)
-| #I #L1 #V1 #IH #L #T1 #X
- >shift_append_assoc normalize #H
- elim (cpss_inv_bind1 … H) -H
- #V0 #T0 #_ #HT10 #H destruct
- elim (IH … HT10) -IH -HT10 #L2 #T2 #HL12 #H destruct
- >append_length >HL12 -HL12
- @(ex2_2_intro … (⋆.ⓑ{I}V0@@L2) T2) [ >append_length ] // /2 width=3/ (**) (* explicit constructor *)
-]
-qed-.
-
-(* Basic_1: removed theorems 27:
- subst0_gen_sort subst0_gen_lref subst0_gen_head subst0_gen_lift_lt
- subst0_gen_lift_false subst0_gen_lift_ge subst0_refl subst0_trans
- subst0_lift_lt subst0_lift_ge subst0_lift_ge_S subst0_lift_ge_s
- subst0_subst0 subst0_subst0_back subst0_weight_le subst0_weight_lt
- subst0_confluence_neq subst0_confluence_eq subst0_tlt_head
- subst0_confluence_lift subst0_tlt
- subst1_head subst1_gen_head subst1_lift_S subst1_confluence_lift
- subst1_gen_lift_eq subst1_confluence_neq
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/ldrop_ldrop.ma".
-include "basic_2/unfold/cpss.ma".
-
-(* CONTEXT-SENSITIVE PARALLEL UNFOLD FOR TERMS ******************************)
-
-(* Relocation properties ****************************************************)
-
-(* Basic_1: was only: subst1_lift_lt subst1_lift_ge *)
-lemma cpss_lift: l_liftable cpss.
-#K #T1 #T2 #H elim H -K -T1 -T2
-[ #I #K #L #d #e #_ #U1 #H1 #U2 #H2
- >(lift_mono … H1 … H2) -H1 -H2 //
-| #K #KV #V #V2 #W2 #i #HKV #HV2 #HVW2 #IHV2 #L #d #e #HLK #U1 #H #U2 #HWU2
- elim (lift_inv_lref1 … H) * #Hid #H destruct
- [ elim (lift_trans_ge … HVW2 … HWU2) -W2 // <minus_plus #W2 #HVW2 #HWU2
- elim (ldrop_trans_le … HLK … HKV) -K /2 width=2/ #X #HLK #H
- elim (ldrop_inv_skip2 … H) -H /2 width=1/ -Hid #K #Y #HKV #HVY #H destruct /3 width=8/
- | lapply (lift_trans_be … HVW2 … HWU2 ? ?) -W2 // /2 width=1/ >plus_plus_comm_23 #HVU2
- lapply (ldrop_trans_ge_comm … HLK … HKV ?) -K // -Hid /3 width=6/
- ]
-| #a #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
- elim (lift_inv_bind1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
- elim (lift_inv_bind1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /4 width=5/
-| #I #K #V1 #V2 #T1 #T2 #_ #_ #IHV12 #IHT12 #L #d #e #HLK #U1 #H1 #U2 #H2
- elim (lift_inv_flat1 … H1) -H1 #VV1 #TT1 #HVV1 #HTT1 #H1 destruct
- elim (lift_inv_flat1 … H2) -H2 #VV2 #TT2 #HVV2 #HTT2 #H2 destruct /3 width=6/
-]
-qed.
-
-(* Basic_1: was only: subst1_gen_lift_lt subst1_gen_lift_ge *)
-lemma cpss_inv_lift1: l_deliftable_sn cpss.
-#L #U1 #U2 #H elim H -L -U1 -U2
-[ * #L #i #K #d #e #_ #T1 #H
- [ lapply (lift_inv_sort2 … H) -H #H destruct /2 width=3/
- | elim (lift_inv_lref2 … H) -H * #Hid #H destruct /3 width=3/
- | lapply (lift_inv_gref2 … H) -H #H destruct /2 width=3/
- ]
-| #L #LV #V #V2 #W2 #i #HLV #HV2 #HVW2 #IHV2 #K #d #e #HLK #T1 #H
- elim (lift_inv_lref2 … H) -H * #Hid #H destruct
- [ elim (ldrop_conf_lt … HLK … HLV) -L // #L #U #HKL #HLV #HUV
- elim (IHV2 … HLV … HUV) -V #U2 #HUV2 #HU2
- elim (lift_trans_le … HUV2 … HVW2) -V2 // >minus_plus <plus_minus_m_m // -Hid /3 width=8/
- | elim (le_inv_plus_l … Hid) #Hdie #Hei
- lapply (ldrop_conf_ge … HLK … HLV ?) -L // #HKLV
- elim (lift_split … HVW2 d (i - e + 1)) -HVW2 [4: // |3: /2 width=1/ |2: /3 width=1/ ] -Hid -Hdie
- #V1 #HV1 >plus_minus // <minus_minus // /2 width=1/ <minus_n_n <plus_n_O /3 width=8/
- ]
-| #a #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
- elim (lift_inv_bind2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
- elim (IHV12 … HLK … HWV1) -IHV12 #W2 #HW12 #HWV2
- elim (IHU12 … HTU1) -IHU12 -HTU1 /3 width=5/
-| #I #L #V1 #V2 #U1 #U2 #_ #_ #IHV12 #IHU12 #K #d #e #HLK #X #H
- elim (lift_inv_flat2 … H) -H #W1 #T1 #HWV1 #HTU1 #H destruct
- elim (IHV12 … HLK … HWV1) -V1
- elim (IHU12 … HLK … HTU1) -U1 -HLK /3 width=5/
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/fsup.ma".
-
-(* PLUS-ITERATED SUPCLOSURE *************************************************)
-
-definition fsupp: bi_relation lenv term ≝ bi_TC … fsup.
-
-interpretation "plus-iterated structural successor (closure)"
- 'SupTermPlus L1 T1 L2 T2 = (fsupp L1 T1 L2 T2).
-
-(* Basic eliminators ********************************************************)
-
-lemma fsupp_ind: ∀L1,T1. ∀R:relation2 lenv term.
- (∀L2,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → R L2 T2) →
- (∀L,T,L2,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ → R L T → R L2 T2) →
- ∀L2,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → R L2 T2.
-#L1 #T1 #R #IH1 #IH2 #L2 #T2 #H
-@(bi_TC_ind … IH1 IH2 ? ? H)
-qed-.
-
-lemma fsupp_ind_dx: ∀L2,T2. ∀R:relation2 lenv term.
- (∀L1,T1. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → R L1 T1) →
- (∀L1,L,T1,T. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ → R L T → R L1 T1) →
- ∀L1,T1. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → R L1 T1.
-#L2 #T2 #R #IH1 #IH2 #L1 #T1 #H
-@(bi_TC_ind_dx … IH1 IH2 ? ? H)
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma fsup_fsupp: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
-/2 width=1/ qed.
-
-lemma fsupp_strap1: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ →
- ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-lemma fsupp_strap2: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ →
- ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma fsupp_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → ♯{L2, T2} < ♯{L1, T1}.
-#L1 #L2 #T1 #T2 #H @(fsupp_ind … H) -L2 -T2
-/3 width=3 by fsup_fwd_cw, transitive_lt/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/fsupp.ma".
-
-(* PLUS-ITERATED SUPCLOSURE *************************************************)
-
-(* Main propertis ***********************************************************)
-
-theorem fsupp_trans: bi_transitive … fsupp.
-/2 width=4/ qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/fsupp.ma".
-
-(* STAR-ITERATED SUPCLOSURE *************************************************)
-
-definition fsups: bi_relation lenv term ≝ bi_star … fsup.
-
-interpretation "star-iterated structural successor (closure)"
- 'SupTermStar L1 T1 L2 T2 = (fsups L1 T1 L2 T2).
-
-(* Basic eliminators ********************************************************)
-
-lemma fsups_ind: ∀L1,T1. ∀R:relation2 lenv term. R L1 T1 →
- (∀L,L2,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ → R L T → R L2 T2) →
- ∀L2,T2. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → R L2 T2.
-#L1 #T1 #R #IH1 #IH2 #L2 #T2 #H
-@(bi_star_ind … IH1 IH2 ? ? H)
-qed-.
-
-lemma fsups_ind_dx: ∀L2,T2. ∀R:relation2 lenv term. R L2 T2 →
- (∀L1,L,T1,T. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃* ⦃L2, T2⦄ → R L T → R L1 T1) →
- ∀L1,T1. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → R L1 T1.
-#L2 #T2 #R #IH1 #IH2 #L1 #T1 #H
-@(bi_star_ind_dx … IH1 IH2 ? ? H)
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma fsups_refl: bi_reflexive … fsups.
-/2 width=1/ qed.
-
-lemma fsupp_fsups: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
-/2 width=1/ qed.
-
-lemma fsup_fsups: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
-/2 width=1/ qed.
-
-lemma fsups_strap1: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ → ⦃L, T⦄ ⊃ ⦃L2, T2⦄ →
- ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-lemma fsups_strap2: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃ ⦃L, T⦄ → ⦃L, T⦄ ⊃* ⦃L2, T2⦄ →
- ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-lemma fsups_fsupp_fsupp: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃* ⦃L, T⦄ →
- ⦃L, T⦄ ⊃+ ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-lemma fsupp_fsups_fsupp: ∀L1,L,L2,T1,T,T2. ⦃L1, T1⦄ ⊃+ ⦃L, T⦄ →
- ⦃L, T⦄ ⊃* ⦃L2, T2⦄ → ⦃L1, T1⦄ ⊃+ ⦃L2, T2⦄.
-/2 width=4/ qed.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma fsups_fwd_cw: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃* ⦃L2, T2⦄ → ♯{L2, T2} ≤ ♯{L1, T1}.
-#L1 #L2 #T1 #T2 #H @(fsups_ind … H) -L2 -T2 //
-/4 width=3 by fsup_fwd_cw, lt_to_le_to_lt, lt_to_le/ (**) (* slow even with trace *)
-qed-.
-(*
-(* Advanced inversion lemmas on plus-iterated supclosure ********************)
-
-lemma fsupp_inv_bind1_fsups: ∀b,J,L1,L2,W,U,T2. ⦃L1, ⓑ{b,J}W.U⦄ ⊃+ ⦃L2, T2⦄ →
- ⦃L1, W⦄ ⊃* ⦃L2, T2⦄ ∨ ⦃L1.ⓑ{J}W, U⦄ ⊃* ⦃L2, T2⦄.
-#b #J #L1 #L2 #W #U #T2 #H @(fsupp_ind … H) -L2 -T2
-[ #L2 #T2 #H
- elim (fsup_inv_bind1 … H) -H * #H1 #H2 destruct /2 width=1/
-| #L #T #L2 #T2 #_ #HT2 * /3 width=4/
-]
-qed-.
-
-lemma fsupp_inv_flat1_fsups: ∀J,L1,L2,W,U,T2. ⦃L1, ⓕ{J}W.U⦄ ⊃+ ⦃L2, T2⦄ →
- ⦃L1, W⦄ ⊃* ⦃L2, T2⦄ ∨ ⦃L1, U⦄ ⊃* ⦃L2, T2⦄.
-#J #L1 #L2 #W #U #T2 #H @(fsupp_ind … H) -L2 -T2
-[ #L2 #T2 #H
- elim (fsup_inv_flat1 … H) -H #H1 * #H2 destruct /2 width=1/
-| #L #T #L2 #T2 #_ #HT2 * /3 width=4/
-]
-qed-.
-*)
\ No newline at end of file
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/fsups.ma".
-
-(* STAR-ITERATED SUPCLOSURE *************************************************)
-
-(* Main properties **********************************************************)
-
-theorem fsups_trans: bi_transitive … fsups.
-/2 width=4/ qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/term_vector.ma".
-
-(* GENERIC RELOCATION WITH PAIRS ********************************************)
-
-inductive at: list2 nat nat → relation nat ≝
-| at_nil: ∀i. at ⟠ i i
-| at_lt : ∀des,d,e,i1,i2. i1 < d →
- at des i1 i2 → at ({d, e} @ des) i1 i2
-| at_ge : ∀des,d,e,i1,i2. d ≤ i1 →
- at des (i1 + e) i2 → at ({d, e} @ des) i1 i2
-.
-
-interpretation "application (generic relocation with pairs)"
- 'RAt i1 des i2 = (at des i1 i2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact at_inv_nil_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 → des = ⟠ → i1 = i2.
-#des #i1 #i2 * -des -i1 -i2
-[ //
-| #des #d #e #i1 #i2 #_ #_ #H destruct
-| #des #d #e #i1 #i2 #_ #_ #H destruct
-]
-qed.
-
-lemma at_inv_nil: ∀i1,i2. @⦃i1, ⟠⦄ ≡ i2 → i1 = i2.
-/2 width=3/ qed-.
-
-fact at_inv_cons_aux: ∀des,i1,i2. @⦃i1, des⦄ ≡ i2 →
- ∀d,e,des0. des = {d, e} @ des0 →
- i1 < d ∧ @⦃i1, des0⦄ ≡ i2 ∨
- d ≤ i1 ∧ @⦃i1 + e, des0⦄ ≡ i2.
-#des #i1 #i2 * -des -i1 -i2
-[ #i #d #e #des #H destruct
-| #des1 #d1 #e1 #i1 #i2 #Hid1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/
-| #des1 #d1 #e1 #i1 #i2 #Hdi1 #Hi12 #d2 #e2 #des2 #H destruct /3 width=1/
-]
-qed.
-
-lemma at_inv_cons: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
- i1 < d ∧ @⦃i1, des⦄ ≡ i2 ∨
- d ≤ i1 ∧ @⦃i1 + e, des⦄ ≡ i2.
-/2 width=3/ qed-.
-
-lemma at_inv_cons_lt: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
- i1 < d → @⦃i1, des⦄ ≡ i2.
-#des #d #e #i1 #e2 #H
-elim (at_inv_cons … H) -H * // #Hdi1 #_ #Hi1d
-lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd
-elim (lt_refl_false … Hd)
-qed-.
-
-lemma at_inv_cons_ge: ∀des,d,e,i1,i2. @⦃i1, {d, e} @ des⦄ ≡ i2 →
- d ≤ i1 → @⦃i1 + e, des⦄ ≡ i2.
-#des #d #e #i1 #e2 #H
-elim (at_inv_cons … H) -H * // #Hi1d #_ #Hdi1
-lapply (le_to_lt_to_lt … Hdi1 Hi1d) -Hdi1 -Hi1d #Hd
-elim (lt_refl_false … Hd)
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/gr2.ma".
-
-(* GENERIC RELOCATION WITH PAIRS ********************************************)
-
-(* Main properties **********************************************************)
-
-theorem at_mono: ∀des,i,i1. @⦃i, des⦄ ≡ i1 → ∀i2. @⦃i, des⦄ ≡ i2 → i1 = i2.
-#des #i #i1 #H elim H -des -i -i1
-[ #i #x #H <(at_inv_nil … H) -x //
-| #des #d #e #i #i1 #Hid #_ #IHi1 #x #H
- lapply (at_inv_cons_lt … H Hid) -H -Hid /2 width=1/
-| #des #d #e #i #i1 #Hdi #_ #IHi1 #x #H
- lapply (at_inv_cons_ge … H Hdi) -H -Hdi /2 width=1/
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/gr2.ma".
-
-(* GENERIC RELOCATION WITH PAIRS ********************************************)
-
-inductive minuss: nat → relation (list2 nat nat) ≝
-| minuss_nil: ∀i. minuss i ⟠ ⟠
-| minuss_lt : ∀des1,des2,d,e,i. i < d → minuss i des1 des2 →
- minuss i ({d, e} @ des1) ({d - i, e} @ des2)
-| minuss_ge : ∀des1,des2,d,e,i. d ≤ i → minuss (e + i) des1 des2 →
- minuss i ({d, e} @ des1) des2
-.
-
-interpretation "minus (generic relocation with pairs)"
- 'RMinus des1 i des2 = (minuss i des1 des2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact minuss_inv_nil1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 → des1 = ⟠ → des2 = ⟠.
-#des1 #des2 #i * -des1 -des2 -i
-[ //
-| #des1 #des2 #d #e #i #_ #_ #H destruct
-| #des1 #des2 #d #e #i #_ #_ #H destruct
-]
-qed.
-
-lemma minuss_inv_nil1: ∀des2,i. ⟠ ▭ i ≡ des2 → des2 = ⟠.
-/2 width=4/ qed-.
-
-fact minuss_inv_cons1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 →
- ∀d,e,des. des1 = {d, e} @ des →
- d ≤ i ∧ des ▭ e + i ≡ des2 ∨
- ∃∃des0. i < d & des ▭ i ≡ des0 &
- des2 = {d - i, e} @ des0.
-#des1 #des2 #i * -des1 -des2 -i
-[ #i #d #e #des #H destruct
-| #des1 #des #d1 #e1 #i1 #Hid1 #Hdes #d2 #e2 #des2 #H destruct /3 width=3/
-| #des1 #des #d1 #e1 #i1 #Hdi1 #Hdes #d2 #e2 #des2 #H destruct /3 width=1/
-]
-qed.
-
-lemma minuss_inv_cons1: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
- d ≤ i ∧ des1 ▭ e + i ≡ des2 ∨
- ∃∃des. i < d & des1 ▭ i ≡ des &
- des2 = {d - i, e} @ des.
-/2 width=3/ qed-.
-
-lemma minuss_inv_cons1_ge: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
- d ≤ i → des1 ▭ e + i ≡ des2.
-#des1 #des2 #d #e #i #H
-elim (minuss_inv_cons1 … H) -H * // #des #Hid #_ #_ #Hdi
-lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi
-elim (lt_refl_false … Hi)
-qed-.
-
-lemma minuss_inv_cons1_lt: ∀des1,des2,d,e,i. {d, e} @ des1 ▭ i ≡ des2 →
- i < d →
- ∃∃des. des1 ▭ i ≡ des & des2 = {d - i, e} @ des.
-#des1 #des2 #d #e #i #H
-elim (minuss_inv_cons1 … H) -H * /2 width=3/ #Hdi #_ #Hid
-lapply (lt_to_le_to_lt … Hid Hdi) -Hid -Hdi #Hi
-elim (lt_refl_false … Hi)
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/unfold/gr2_minus.ma".
-include "basic_2/unfold/lifts.ma".
-
-(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
-
-inductive ldrops: list2 nat nat → relation lenv ≝
-| ldrops_nil : ∀L. ldrops ⟠ L L
-| ldrops_cons: ∀L1,L,L2,des,d,e.
- ldrops des L1 L → ⇩[d,e] L ≡ L2 → ldrops ({d, e} @ des) L1 L2
-.
-
-interpretation "generic local environment slicing"
- 'RDropStar des T1 T2 = (ldrops des T1 T2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact ldrops_inv_nil_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → des = ⟠ → L1 = L2.
-#L1 #L2 #des * -L1 -L2 -des //
-#L1 #L #L2 #d #e #des #_ #_ #H destruct
-qed.
-
-(* Basic_1: was: drop1_gen_pnil *)
-lemma ldrops_inv_nil: ∀L1,L2. ⇩*[⟠] L1 ≡ L2 → L1 = L2.
-/2 width=3/ qed-.
-
-fact ldrops_inv_cons_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 →
- ∀d,e,tl. des = {d, e} @ tl →
- ∃∃L. ⇩*[tl] L1 ≡ L & ⇩[d, e] L ≡ L2.
-#L1 #L2 #des * -L1 -L2 -des
-[ #L #d #e #tl #H destruct
-| #L1 #L #L2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct
- /2 width=3/
-qed.
-
-(* Basic_1: was: drop1_gen_pcons *)
-lemma ldrops_inv_cons: ∀L1,L2,d,e,des. ⇩*[{d, e} @ des] L1 ≡ L2 →
- ∃∃L. ⇩*[des] L1 ≡ L & ⇩[d, e] L ≡ L2.
-/2 width=3/ qed-.
-
-lemma ldrops_inv_skip2: ∀I,des,i,des2. des ▭ i ≡ des2 →
- ∀L1,K2,V2. ⇩*[des2] L1 ≡ K2. ⓑ{I} V2 →
- ∃∃K1,V1,des1. des + 1 ▭ i + 1 ≡ des1 + 1 &
- ⇩*[des1] K1 ≡ K2 &
- ⇧*[des1] V2 ≡ V1 &
- L1 = K1. ⓑ{I} V1.
-#I #des #i #des2 #H elim H -des -i -des2
-[ #i #L1 #K2 #V2 #H
- >(ldrops_inv_nil … H) -L1 /2 width=7/
-| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H
- elim (ldrops_inv_cons … H) -H #L #HL1 #H
- elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ #K #V >minus_plus #HK2 #HV2 #H destruct
- elim (IHdes2 … HL1) -IHdes2 -HL1 #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct
- @(ex4_3_intro … K1 V1 … ) // [3,4: /2 width=7/ | skip ]
- normalize >plus_minus // @minuss_lt // /2 width=1/ (**) (* explicit constructors, /3 width=1/ is a bit slow *)
-| #des #des2 #d #e #i #Hid #_ #IHdes2 #L1 #K2 #V2 #H
- elim (IHdes2 … H) -IHdes2 -H #K1 #V1 #des1 #Hdes1 #HK1 #HV1 #X destruct
- /4 width=7/
-]
-qed-.
-
-(* Basic properties *********************************************************)
-
-(* Basic_1: was: drop1_skip_bind *)
-lemma ldrops_skip: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 → ∀V1,V2. ⇧*[des] V2 ≡ V1 →
- ∀I. ⇩*[des + 1] L1. ⓑ{I} V1 ≡ L2. ⓑ{I} V2.
-#L1 #L2 #des #H elim H -L1 -L2 -des
-[ #L #V1 #V2 #HV12 #I
- >(lifts_inv_nil … HV12) -HV12 //
-| #L1 #L #L2 #des #d #e #_ #HL2 #IHL #V1 #V2 #H #I
- elim (lifts_inv_cons … H) -H /3 width=5/
-].
-qed.
-
-(* Basic_1: removed theorems 1: drop1_getl_trans *)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/ldrop_ldrop.ma".
-include "basic_2/unfold/ldrops.ma".
-
-(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
-
-(* Properties concerning basic local environment slicing ********************)
-
-lemma ldrops_ldrop_trans: ∀L1,L,des. ⇩*[des] L1 ≡ L → ∀L2,i. ⇩[0, i] L ≡ L2 →
- ∃∃L0,des0,i0. ⇩[0, i0] L1 ≡ L0 & ⇩*[des0] L0 ≡ L2 &
- @⦃i, des⦄ ≡ i0 & des ▭ i ≡ des0.
-#L1 #L #des #H elim H -L1 -L -des
-[ /2 width=7/
-| #L1 #L3 #L #des3 #d #e #_ #HL3 #IHL13 #L2 #i #HL2
- elim (lt_or_ge i d) #Hid
- [ elim (ldrop_trans_le … HL3 … HL2 ?) -L /2 width=2/ #L #HL3 #HL2
- elim (IHL13 … HL3) -L3 /3 width=7/
- | lapply (ldrop_trans_ge … HL3 … HL2 ?) -L // #HL32
- elim (IHL13 … HL32) -L3 /3 width=7/
- ]
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/ldrops_ldrop.ma".
-
-(* GENERIC LOCAL ENVIRONMENT SLICING ****************************************)
-
-(* Main properties **********************************************************)
-
-(* Basic_1: was: drop1_trans *)
-theorem ldrops_trans: ∀L,L2,des2. ⇩*[des2] L ≡ L2 → ∀L1,des1. ⇩*[des1] L1 ≡ L →
- ⇩*[des2 @@ des1] L1 ≡ L2.
-#L #L2 #des2 #H elim H -L -L2 -des2 // /3 width=3/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lift.ma".
-include "basic_2/unfold/gr2_plus.ma".
-
-(* GENERIC TERM RELOCATION **************************************************)
-
-inductive lifts: list2 nat nat → relation term ≝
-| lifts_nil : ∀T. lifts ⟠ T T
-| lifts_cons: ∀T1,T,T2,des,d,e.
- ⇧[d,e] T1 ≡ T → lifts des T T2 → lifts ({d, e} @ des) T1 T2
-.
-
-interpretation "generic relocation (term)"
- 'RLiftStar des T1 T2 = (lifts des T1 T2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact lifts_inv_nil_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → des = ⟠ → T1 = T2.
-#T1 #T2 #des * -T1 -T2 -des //
-#T1 #T #T2 #d #e #des #_ #_ #H destruct
-qed.
-
-lemma lifts_inv_nil: ∀T1,T2. ⇧*[⟠] T1 ≡ T2 → T1 = T2.
-/2 width=3/ qed-.
-
-fact lifts_inv_cons_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 →
- ∀d,e,tl. des = {d, e} @ tl →
- ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[tl] T ≡ T2.
-#T1 #T2 #des * -T1 -T2 -des
-[ #T #d #e #tl #H destruct
-| #T1 #T #T2 #des #d #e #HT1 #HT2 #hd #he #tl #H destruct
- /2 width=3/
-qed.
-
-lemma lifts_inv_cons: ∀T1,T2,d,e,des. ⇧*[{d, e} @ des] T1 ≡ T2 →
- ∃∃T. ⇧[d, e] T1 ≡ T & ⇧*[des] T ≡ T2.
-/2 width=3/ qed-.
-
-(* Basic_1: was: lift1_sort *)
-lemma lifts_inv_sort1: ∀T2,k,des. ⇧*[des] ⋆k ≡ T2 → T2 = ⋆k.
-#T2 #k #des elim des -des
-[ #H <(lifts_inv_nil … H) -H //
-| #d #e #des #IH #H
- elim (lifts_inv_cons … H) -H #X #H
- >(lift_inv_sort1 … H) -H /2 width=1/
-]
-qed-.
-
-(* Basic_1: was: lift1_lref *)
-lemma lifts_inv_lref1: ∀T2,des,i1. ⇧*[des] #i1 ≡ T2 →
- ∃∃i2. @⦃i1, des⦄ ≡ i2 & T2 = #i2.
-#T2 #des elim des -des
-[ #i1 #H <(lifts_inv_nil … H) -H /2 width=3/
-| #d #e #des #IH #i1 #H
- elim (lifts_inv_cons … H) -H #X #H1 #H2
- elim (lift_inv_lref1 … H1) -H1 * #Hdi1 #H destruct
- elim (IH … H2) -IH -H2 /3 width=3/
-]
-qed-.
-
-lemma lifts_inv_gref1: ∀T2,p,des. ⇧*[des] §p ≡ T2 → T2 = §p.
-#T2 #p #des elim des -des
-[ #H <(lifts_inv_nil … H) -H //
-| #d #e #des #IH #H
- elim (lifts_inv_cons … H) -H #X #H
- >(lift_inv_gref1 … H) -H /2 width=1/
-]
-qed-.
-
-(* Basic_1: was: lift1_bind *)
-lemma lifts_inv_bind1: ∀a,I,T2,des,V1,U1. ⇧*[des] ⓑ{a,I} V1. U1 ≡ T2 →
- ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des + 1] U1 ≡ U2 &
- T2 = ⓑ{a,I} V2. U2.
-#a #I #T2 #des elim des -des
-[ #V1 #U1 #H
- <(lifts_inv_nil … H) -H /2 width=5/
-| #d #e #des #IHdes #V1 #U1 #H
- elim (lifts_inv_cons … H) -H #X #H #HT2
- elim (lift_inv_bind1 … H) -H #V #U #HV1 #HU1 #H destruct
- elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct
- /3 width=5/
-]
-qed-.
-
-(* Basic_1: was: lift1_flat *)
-lemma lifts_inv_flat1: ∀I,T2,des,V1,U1. ⇧*[des] ⓕ{I} V1. U1 ≡ T2 →
- ∃∃V2,U2. ⇧*[des] V1 ≡ V2 & ⇧*[des] U1 ≡ U2 &
- T2 = ⓕ{I} V2. U2.
-#I #T2 #des elim des -des
-[ #V1 #U1 #H
- <(lifts_inv_nil … H) -H /2 width=5/
-| #d #e #des #IHdes #V1 #U1 #H
- elim (lifts_inv_cons … H) -H #X #H #HT2
- elim (lift_inv_flat1 … H) -H #V #U #HV1 #HU1 #H destruct
- elim (IHdes … HT2) -IHdes -HT2 #V2 #U2 #HV2 #HU2 #H destruct
- /3 width=5/
-]
-qed-.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma lifts_simple_dx: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T1⦄ → 𝐒⦃T2⦄.
-#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_dx/
-qed-.
-
-lemma lifts_simple_sn: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 → 𝐒⦃T2⦄ → 𝐒⦃T1⦄.
-#T1 #T2 #des #H elim H -T1 -T2 -des // /3 width=5 by lift_simple_sn/
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma lifts_bind: ∀a,I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 →
- ∀T1. ⇧*[des + 1] T1 ≡ T2 →
- ⇧*[des] ⓑ{a,I} V1. T1 ≡ ⓑ{a,I} V2. T2.
-#a #I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des
-[ #V #T1 #H >(lifts_inv_nil … H) -H //
-| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H
- elim (lifts_inv_cons … H) -H /3 width=3/
-]
-qed.
-
-lemma lifts_flat: ∀I,T2,V1,V2,des. ⇧*[des] V1 ≡ V2 →
- ∀T1. ⇧*[des] T1 ≡ T2 →
- ⇧*[des] ⓕ{I} V1. T1 ≡ ⓕ{I} V2. T2.
-#I #T2 #V1 #V2 #des #H elim H -V1 -V2 -des
-[ #V #T1 #H >(lifts_inv_nil … H) -H //
-| #V1 #V #V2 #des #d #e #HV1 #_ #IHV #T1 #H
- elim (lifts_inv_cons … H) -H /3 width=3/
-]
-qed.
-
-lemma lifts_total: ∀des,T1. ∃T2. ⇧*[des] T1 ≡ T2.
-#des elim des -des /2 width=2/
-#d #e #des #IH #T1
-elim (lift_total T1 d e) #T #HT1
-elim (IH T) -IH /3 width=4/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lift_lift.ma".
-include "basic_2/unfold/gr2_minus.ma".
-include "basic_2/unfold/lifts.ma".
-
-(* GENERIC TERM RELOCATION **************************************************)
-
-(* Properties concerning basic term relocation ******************************)
-
-(* Basic_1: was: lift1_xhg (right to left) *)
-lemma lifts_lift_trans_le: ∀T1,T,des. ⇧*[des] T1 ≡ T → ∀T2. ⇧[0, 1] T ≡ T2 →
- ∃∃T0. ⇧[0, 1] T1 ≡ T0 & ⇧*[des + 1] T0 ≡ T2.
-#T1 #T #des #H elim H -T1 -T -des
-[ /2 width=3/
-| #T1 #T3 #T #des #d #e #HT13 #_ #IHT13 #T2 #HT2
- elim (IHT13 … HT2) -T #T #HT3 #HT2
- elim (lift_trans_le … HT13 … HT3 ?) -T3 // /3 width=5/
-]
-qed-.
-
-(* Basic_1: was: lift1_free (right to left) *)
-lemma lifts_lift_trans: ∀des,i,i0. @⦃i, des⦄ ≡ i0 →
- ∀des0. des + 1 ▭ i + 1 ≡ des0 + 1 →
- ∀T1,T0. ⇧*[des0] T1 ≡ T0 →
- ∀T2. ⇧[O, i0 + 1] T0 ≡ T2 →
- ∃∃T. ⇧[0, i + 1] T1 ≡ T & ⇧*[des] T ≡ T2.
-#des elim des -des normalize
-[ #i #x #H1 #des0 #H2 #T1 #T0 #HT10 #T2
- <(at_inv_nil … H1) -x #HT02
- lapply (minuss_inv_nil1 … H2) -H2 #H
- >(pluss_inv_nil2 … H) in HT10; -des0 #H
- >(lifts_inv_nil … H) -T1 /2 width=3/
-| #d #e #des #IHdes #i #i0 #H1 #des0 #H2 #T1 #T0 #HT10 #T2 #HT02
- elim (at_inv_cons … H1) -H1 * #Hid #Hi0
- [ elim (minuss_inv_cons1_lt … H2 ?) -H2 [2: /2 width=1/ ] #des1 #Hdes1 <minus_le_minus_minus_comm // <minus_plus_m_m #H
- elim (pluss_inv_cons2 … H) -H #des2 #H1 #H2 destruct
- elim (lifts_inv_cons … HT10) -HT10 #T >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 <plus_minus_m_m /2 width=1/ /3 width=5/
- | >commutative_plus in Hi0; #Hi0
- lapply (minuss_inv_cons1_ge … H2 ?) -H2 [ /2 width=1/ ] <associative_plus #Hdes0
- elim (IHdes … Hi0 … Hdes0 … HT10 … HT02) -IHdes -Hi0 -Hdes0 -T0 #T0 #HT0 #HT02
- elim (lift_split … HT0 d (i+1) ? ? ?) -HT0 /2 width=1/ /3 width=5/
- ]
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_vector.ma".
-include "basic_2/unfold/lifts_lift.ma".
-include "basic_2/unfold/lifts_vector.ma".
-
-(* GENERIC RELOCATION *******************************************************)
-
-(* Main properties **********************************************************)
-
-(* Basic_1: was: lifts1_xhg (right to left) *)
-lemma liftsv_liftv_trans_le: ∀T1s,Ts,des. ⇧*[des] T1s ≡ Ts →
- ∀T2s:list term. ⇧[0, 1] Ts ≡ T2s →
- ∃∃T0s. ⇧[0, 1] T1s ≡ T0s & ⇧*[des + 1] T0s ≡ T2s.
-#T1s #Ts #des #H elim H -T1s -Ts
-[ #T1s #H
- >(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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/lifts_lift.ma".
-
-(* GENERIC RELOCATION *******************************************************)
-
-(* Main properties **********************************************************)
-
-(* Basic_1: was: lift1_lift1 (left to right) *)
-theorem lifts_trans: ∀T1,T,des1. ⇧*[des1] T1 ≡ T → ∀T2:term. ∀des2. ⇧*[des2] T ≡ T2 →
- ⇧*[des1 @@ des2] T1 ≡ T2.
-#T1 #T #des1 #H elim H -T1 -T -des1 // /3 width=3/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/substitution/lift_vector.ma".
-include "basic_2/unfold/lifts.ma".
-
-(* GENERIC TERM VECTOR RELOCATION *******************************************)
-
-inductive liftsv (des:list2 nat nat) : relation (list term) ≝
-| liftsv_nil : liftsv des ◊ ◊
-| liftsv_cons: ∀T1s,T2s,T1,T2.
- ⇧*[des] T1 ≡ T2 → liftsv des T1s T2s →
- liftsv des (T1 @ T1s) (T2 @ T2s)
-.
-
-interpretation "generic relocation (vector)"
- 'RLiftStar des T1s T2s = (liftsv des T1s T2s).
-
-(* Basic inversion lemmas ***************************************************)
-
-(* Basic_1: was: lifts1_flat (left to right) *)
-lemma lifts_inv_applv1: ∀V1s,U1,T2,des. ⇧*[des] Ⓐ V1s. U1 ≡ T2 →
- ∃∃V2s,U2. ⇧*[des] V1s ≡ V2s & ⇧*[des] U1 ≡ U2 &
- T2 = Ⓐ V2s. U2.
-#V1s elim V1s -V1s normalize
-[ #T1 #T2 #des #HT12
- @(ex3_2_intro) [3,4: // |1,2: skip | // ] (**) (* explicit constructor *)
-| #V1 #V1s #IHV1s #T1 #X #des #H
- elim (lifts_inv_flat1 … H) -H #V2 #Y #HV12 #HY #H destruct
- elim (IHV1s … HY) -IHV1s -HY #V2s #T2 #HV12s #HT12 #H destruct
- @(ex3_2_intro) [4: // |3: /2 width=2/ |1,2: skip | // ] (**) (* explicit constructor *)
-]
-qed-.
-
-(* Basic properties *********************************************************)
-
-(* Basic_1: was: lifts1_flat (right to left) *)
-lemma lifts_applv: ∀V1s,V2s,des. ⇧*[des] V1s ≡ V2s →
- ∀T1,T2. ⇧*[des] T1 ≡ T2 →
- ⇧*[des] Ⓐ V1s. T1 ≡ Ⓐ V2s. T2.
-#V1s #V2s #des #H elim H -V1s -V2s // /3 width=1/
-qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/substitution/lpss.ma".
+include "basic_2/unfold/cpqs.ma".
+
+(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************)
+
+definition lpqs: relation lenv ≝ lpx_sn cpqs.
+
+interpretation "restricted parallel computation (local environment, sn variant)"
+ 'PRestStarSn L1 L2 = (lpqs L1 L2).
+
+(* Basic inversion lemmas ***************************************************)
+
+lemma lpqs_inv_atom1: ∀L2. ⋆ ⊢ ➤* L2 → L2 = ⋆.
+/2 width=4 by lpx_sn_inv_atom1_aux/ qed-.
+
+lemma lpqs_inv_pair1: ∀I,K1,V1,L2. K1. ⓑ{I} V1 ⊢ ➤* L2 →
+ ∃∃K2,V2. K1 ⊢ ➤* K2 & K1 ⊢ V1 ➤* V2 & L2 = K2. ⓑ{I} V2.
+/2 width=3 by lpx_sn_inv_pair1_aux/ qed-.
+
+lemma lpqs_inv_atom2: ∀L1. L1 ⊢ ➤* ⋆ → L1 = ⋆.
+/2 width=4 by lpx_sn_inv_atom2_aux/ qed-.
+
+lemma lpqs_inv_pair2: ∀I,L1,K2,V2. L1 ⊢ ➤* K2. ⓑ{I} V2 →
+ ∃∃K1,V1. K1 ⊢ ➤* K2 & K1 ⊢ V1 ➤* V2 & L1 = K1. ⓑ{I} V1.
+/2 width=3 by lpx_sn_inv_pair2_aux/ qed-.
+
+(* Basic properties *********************************************************)
+
+lemma lpqs_refl: ∀L. L ⊢ ➤* L.
+/2 width=1 by lpx_sn_refl/ qed.
+
+lemma lpqs_append: ∀K1,K2. K1 ⊢ ➤* K2 → ∀L1,L2. L1 ⊢ ➤* L2 →
+ L1 @@ K1 ⊢ ➤* L2 @@ K2.
+/3 width=1 by lpx_sn_append, cpqs_append/ qed.
+
+lemma lpss_lpqs: ∀L1,L2. L1 ⊢ ▶* L2 → L1 ⊢ ➤* L2.
+#L1 #L2 #H elim H -L1 -L2 // /3 width=1/
+qed.
+
+(* Basic forward lemmas *****************************************************)
+
+lemma lpqs_fwd_length: ∀L1,L2. L1 ⊢ ➤* L2 → |L1| = |L2|.
+/2 width=2 by lpx_sn_fwd_length/ qed-.
+
+(* Advanced forward lemmas **************************************************)
+
+lemma lpqs_fwd_append1: ∀K1,L1,L. K1 @@ L1 ⊢ ➤* L →
+ ∃∃K2,L2. K1 ⊢ ➤* K2 & L = K2 @@ L2.
+/2 width=2 by lpx_sn_fwd_append1/ qed-.
+
+lemma lpqs_fwd_append2: ∀L,K2,L2. L ⊢ ➤* K2 @@ L2 →
+ ∃∃K1,L1. K1 ⊢ ➤* K2 & L = K1 @@ L1.
+/2 width=2 by lpx_sn_fwd_append2/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/fsup.ma".
+include "basic_2/unfold/lpqs_ldrop.ma".
+
+(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************)
+
+(* Main properties on context-sensitive rest parallel computation for terms *)
+
+fact cpqs_conf_lpqs_atom_atom:
+ ∀I,L1,L2. ∃∃T. L1 ⊢ ⓪{I} ➤* T & L2 ⊢ ⓪{I} ➤* T.
+/2 width=3/ qed-.
+
+fact cpqs_conf_lpqs_atom_delta:
+ ∀L0,i. (
+ ∀L,T.♯{L, T} < ♯{L0, #i} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
+ ∀V2. K0 ⊢ V0 ➤* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ #i ➤* T & L2 ⊢ T2 ➤* T.
+#L0 #i #IH #K0 #V0 #HLK0 #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
+elim (lpqs_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
+elim (lpqs_inv_pair1 … H1) -H1 #K1 #V1 #HK01 #HV01 #H destruct
+elim (lpqs_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
+elim (lpqs_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
+elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
+elim (lift_total V 0 (i+1)) #T #HVT
+lapply (cpqs_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 /3 width=6/
+qed-.
+
+fact cpqs_conf_lpqs_delta_delta:
+ ∀L0,i. (
+ ∀L,T.♯{L, T} < ♯{L0, #i} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
+ ∀V1. K0 ⊢ V0 ➤* V1 → ∀T1. ⇧[O, i + 1] V1 ≡ T1 →
+ ∀KX,VX. ⇩[O, i] L0 ≡ KX.ⓓVX →
+ ∀V2. KX ⊢ VX ➤* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ T1 ➤* T & L2 ⊢ T2 ➤* T.
+#L0 #i #IH #K0 #V0 #HLK0 #V1 #HV01 #T1 #HVT1
+#KX #VX #H #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
+lapply (ldrop_mono … H … HLK0) -H #H destruct
+elim (lpqs_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
+elim (lpqs_inv_pair1 … H1) -H1 #K1 #W1 #HK01 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK1) -W1 #HLK1
+elim (lpqs_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
+elim (lpqs_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
+lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
+elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
+elim (lift_total V 0 (i+1)) #T #HVT
+lapply (cpqs_lift … HV1 … HLK1 … HVT1 … HVT) -K1 -V1
+lapply (cpqs_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 -V /2 width=3/
+qed-.
+
+fact cpqs_conf_lpqs_bind_bind:
+ ∀a,I,L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓑ{a,I}V0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0.ⓑ{I}V0 ⊢ T0 ➤* T1 →
+ ∀V2. L0 ⊢ V0 ➤* V2 → ∀T2. L0.ⓑ{I}V0 ⊢ T0 ➤* T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ ⓑ{a,I}V1.T1 ➤* T & L2 ⊢ ⓑ{a,I}V2.T2 ➤* T.
+#a #I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
+#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HV01 … HV02 … HL01 … HL02) //
+elim (IH … HT01 … HT02 (L1.ⓑ{I}V1) … (L2.ⓑ{I}V2)) -IH // /2 width=1/ /3 width=5/
+qed-.
+
+fact cpqs_conf_lpqs_bind_zeta:
+ ∀L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,+ⓓV0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0.ⓓV0 ⊢ T0 ➤* T1 →
+ ∀T2. L0.ⓓV0 ⊢ T0 ➤* T2 → ∀X2. ⇧[O, 1] X2 ≡ T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ +ⓓV1.T1 ➤* T & L2 ⊢ X2 ➤* T.
+#L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
+#T2 #HT02 #X2 #HXT2 #L1 #HL01 #L2 #HL02
+elim (IH … HT01 … HT02 (L1.ⓓV1) … (L2.ⓓV1)) -IH -HT01 -HT02 // /2 width=1/ -L0 -V0 -T0 #T #HT1 #HT2
+elim (cpqs_inv_lift1 … HT2 L2 … HXT2) -T2 /2 width=1/ /3 width=3/
+qed-.
+
+fact cpqs_conf_lpqs_zeta_zeta:
+ ∀L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,+ⓓV0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀T1. L0.ⓓV0 ⊢ T0 ➤* T1 → ∀X1. ⇧[O, 1] X1 ≡ T1 →
+ ∀T2. L0.ⓓV0 ⊢ T0 ➤* T2 → ∀X2. ⇧[O, 1] X2 ≡ T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ X1 ➤* T & L2 ⊢ X2 ➤* T.
+#L0 #V0 #T0 #IH #T1 #HT01 #X1 #HXT1
+#T2 #HT02 #X2 #HXT2 #L1 #HL01 #L2 #HL02
+elim (IH … HT01 … HT02 (L1.ⓓV0) … (L2.ⓓV0)) -IH -HT01 -HT02 // /2 width=1/ -L0 -T0 #T #HT1 #HT2
+elim (cpqs_inv_lift1 … HT1 L1 … HXT1) -T1 /2 width=1/ #T1 #HT1 #HXT1
+elim (cpqs_inv_lift1 … HT2 L2 … HXT2) -T2 /2 width=1/ #T2 #HT2 #HXT2
+lapply (lift_inj … HT2 … HT1) -T #H destruct /2 width=3/
+qed-.
+
+fact cpqs_conf_lpqs_flat_flat:
+ ∀I,L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓕ{I}V0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀V1. L0 ⊢ V0 ➤* V1 → ∀T1. L0 ⊢ T0 ➤* T1 →
+ ∀V2. L0 ⊢ V0 ➤* V2 → ∀T2. L0 ⊢ T0 ➤* T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ ⓕ{I}V1.T1 ➤* T & L2 ⊢ ⓕ{I}V2.T2 ➤* T.
+#I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
+#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HV01 … HV02 … HL01 … HL02) //
+elim (IH … HT01 … HT02 … HL01 … HL02) // /3 width=5/
+qed-.
+
+fact cpqs_conf_lpqs_flat_tau:
+ ∀L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓝV0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀V1,T1. L0 ⊢ T0 ➤* T1 → ∀T2. L0 ⊢ T0 ➤* T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ ⓝV1.T1 ➤* T & L2 ⊢ T2 ➤* T.
+#L0 #V0 #T0 #IH #V1 #T1 #HT01
+#T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HT01 … HT02 … HL01 … HL02) // -L0 -V0 -T0 /3 width=3/
+qed-.
+
+fact cpqs_conf_lpqs_tau_tau:
+ ∀L0,V0,T0. (
+ ∀L,T.♯{L,T} < ♯{L0,ⓝV0.T0} →
+ ∀T1. L ⊢ T ➤* T1 → ∀T2. L ⊢ T ➤* T2 →
+ ∀L1. L ⊢ ➤* L1 → ∀L2. L ⊢ ➤* L2 →
+ ∃∃T0. L1 ⊢ T1 ➤* T0 & L2 ⊢ T2 ➤* T0
+ ) →
+ ∀T1. L0 ⊢ T0 ➤* T1 → ∀T2. L0 ⊢ T0 ➤* T2 →
+ ∀L1. L0 ⊢ ➤* L1 → ∀L2. L0 ⊢ ➤* L2 →
+ ∃∃T. L1 ⊢ T1 ➤* T & L2 ⊢ T2 ➤* T.
+#L0 #V0 #T0 #IH #T1 #HT01
+#T2 #HT02 #L1 #HL01 #L2 #HL02
+elim (IH … HT01 … HT02 … HL01 … HL02) // -L0 -V0 -T0 /2 width=3/
+qed-.
+
+theorem cpqs_conf_lpqs: lpx_sn_confluent cpqs cpqs.
+#L0 #T0 @(f2_ind … fw … L0 T0) -L0 -T0 #n #IH #L0 * [|*]
+[ #I0 #Hn #T1 #H1 #T2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpqs_inv_atom1 … H1) -H1
+ elim (cpqs_inv_atom1 … H2) -H2
+ [ #H2 #H1 destruct
+ /2 width=1 by cpqs_conf_lpqs_atom_atom/
+ | * #K0 #V0 #V2 #i2 #HLK0 #HV02 #HVT2 #H2 #H1 destruct
+ /3 width=10 by cpqs_conf_lpqs_atom_delta/
+ | #H2 * #K0 #V0 #V1 #i1 #HLK0 #HV01 #HVT1 #H1 destruct
+ /4 width=10 by ex2_commute, cpqs_conf_lpqs_atom_delta/
+ | * #X #Y #V2 #z #H #HV02 #HVT2 #H2
+ * #K0 #V0 #V1 #i #HLK0 #HV01 #HVT1 #H1 destruct
+ /3 width=17 by cpqs_conf_lpqs_delta_delta/
+ ]
+| #a #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpqs_inv_bind1 … H1) -H1 *
+ [ #V1 #T1 #HV01 #HT01 #H1
+ | #T1 #HT01 #HXT1 #H11 #H12
+ ]
+ elim (cpqs_inv_bind1 … H2) -H2 *
+ [1,3: #V2 #T2 #HV02 #HT02 #H2
+ |2,4: #T2 #HT02 #HXT2 #H21 #H22
+ ] destruct
+ [ /3 width=10 by cpqs_conf_lpqs_bind_bind/
+ | /4 width=11 by ex2_commute, cpqs_conf_lpqs_bind_zeta/
+ | /3 width=11 by cpqs_conf_lpqs_bind_zeta/
+ | /3 width=12 by cpqs_conf_lpqs_zeta_zeta/
+ ]
+| #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
+ elim (cpqs_inv_flat1 … H1) -H1 *
+ [ #V1 #T1 #HV01 #HT01 #H1
+ | #HX1 #H1
+ ]
+ elim (cpqs_inv_flat1 … H2) -H2 *
+ [1,3: #V2 #T2 #HV02 #HT02 #H2
+ |2,4: #HX2 #H2
+ ] destruct
+ [ /3 width=10 by cpqs_conf_lpqs_flat_flat/
+ | /4 width=8 by ex2_commute, cpqs_conf_lpqs_flat_tau/
+ | /3 width=8 by cpqs_conf_lpqs_flat_tau/
+ | /3 width=7 by cpqs_conf_lpqs_tau_tau/
+ ]
+]
+qed-.
+
+theorem cpqs_conf: ∀L. confluent … (cpqs L).
+/2 width=6 by cpqs_conf_lpqs/ qed-.
+
+theorem cpqs_trans_lpqs: lpx_sn_transitive cpqs cpqs.
+#L1 #T1 @(f2_ind … fw … L1 T1) -L1 -T1 #n #IH #L1 * [|*]
+[ #I #Hn #T #H1 #L2 #HL12 #T2 #HT2 destruct
+ elim (cpqs_inv_atom1 … H1) -H1
+ [ #H destruct
+ elim (cpqs_inv_atom1 … HT2) -HT2
+ [ #H destruct //
+ | * #K2 #V #V2 #i #HLK2 #HV2 #HVT2 #H destruct
+ elim (lpqs_ldrop_trans_O1 … HL12 … HLK2) -L2 #X #HLK1 #H
+ elim (lpqs_inv_pair2 … H) -H #K1 #V1 #HK12 #HV1 #H destruct
+ lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
+ ]
+ | * #K1 #V1 #V #i #HLK1 #HV1 #HVT #H destruct
+ elim (lpqs_ldrop_conf … HLK1 … HL12) -HL12 #X #H #HLK2
+ elim (lpqs_inv_pair1 … H) -H #K2 #W2 #HK12 #_ #H destruct
+ lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
+ elim (cpqs_inv_lift1 … HT2 … HLK2 … HVT) -L2 -T
+ lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
+ ]
+| #a #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
+ elim (cpqs_inv_bind1 … H1) -H1 *
+ [ #V #T #HV1 #HT1 #H destruct
+ elim (cpqs_inv_bind1 … H2) -H2 *
+ [ #V2 #T2 #HV2 #HT2 #H destruct /4 width=5/
+ | #T2 #HT2 #HXT2 #H1 #H2 destruct /4 width=5/
+ ]
+ | #Y1 #HTY1 #HXY1 #H11 #H12 destruct
+ elim (lift_total X2 0 1) #Y2 #HXY2
+ lapply (cpqs_lift … H2 (L2.ⓓV1) … HXY1 … HXY2) /2 width=1/ -X1 /4 width=5/
+ ]
+| #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
+ elim (cpqs_inv_flat1 … H1) -H1 *
+ [ #V #T #HV1 #HT1 #H destruct
+ elim (cpqs_inv_flat1 … H2) -H2 *
+ [ #V2 #T2 #HV2 #HT2 #H destruct /3 width=5/
+ | #HX2 #H destruct /3 width=5/
+ ]
+ | #HX1 #H destruct /3 width=5/
+]
+qed-.
+
+theorem cpqs_trans: ∀L. Transitive … (cpqs L).
+/2 width=5 by cpqs_trans_lpqs/ qed-.
+
+(* Properties on context-sensitive rest. parallel computation for terms *****)
+
+lemma lpqs_cpqs_conf_dx: ∀L0,T0,T1. L0 ⊢ T0 ➤* T1 → ∀L1. L0 ⊢ ➤* L1 →
+ ∃∃T. L1 ⊢ T0 ➤* T & L1 ⊢ T1 ➤* T.
+#L0 #T0 #T1 #HT01 #L1 #HL01
+elim (cpqs_conf_lpqs … HT01 T0 … HL01 … HL01) // -L0 /2 width=3/
+qed-.
+
+lemma lpqs_cpqs_conf_sn: ∀L0,T0,T1. L0 ⊢ T0 ➤* T1 → ∀L1. L0 ⊢ ➤* L1 →
+ ∃∃T. L1 ⊢ T0 ➤* T & L0 ⊢ T1 ➤* T.
+#L0 #T0 #T1 #HT01 #L1 #HL01
+elim (cpqs_conf_lpqs … HT01 T0 … L0 … HL01) // -HT01 -HL01 /2 width=3/
+qed-.
+
+lemma lpqs_cpqs_trans: ∀L1,L2. L1 ⊢ ➤* L2 →
+ ∀T1,T2. L2 ⊢ T1 ➤* T2 → L1 ⊢ T1 ➤* T2.
+/2 width=5 by cpqs_trans_lpqs/ qed-.
+
+lemma fsup_cpqs_trans: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀U2. L2 ⊢ T2 ➤* U2 →
+ ∃∃L,U1. L1 ⊢ ➤* L & L ⊢ T1 ➤* U1 & ⦃L, U1⦄ ⊃ ⦃L2, U2⦄.
+#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 [1,2,3,4,5: /3 width=5/ ]
+#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #U2 #HTU2
+elim (IHT12 … HTU2) -IHT12 -HTU2 #K #T #HK1 #HT1 #HT2
+elim (lift_total T d e) #U #HTU
+elim (ldrop_lpqs_trans … HLK1 … HK1) -HLK1 -HK1 #L2 #HL12 #HL2K
+lapply (cpqs_lift … HT1 … HL2K … HTU1 … HTU) -HT1 -HTU1 /3 width=11/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/relocation/ldrop_lpx_sn.ma".
+include "basic_2/unfold/cpqs_lift.ma".
+include "basic_2/unfold/lpqs.ma".
+
+(* SN RESTRICTED PARALLEL COMPUTATION FOR LOCAL ENVIRONMENTS ****************)
+
+(* Properies on local environment slicing ***********************************)
+
+lemma lpqs_ldrop_conf: dropable_sn lpqs.
+/3 width=5 by lpx_sn_deliftable_dropable, cpqs_inv_lift1/ qed-.
+
+lemma ldrop_lpqs_trans: dedropable_sn lpqs.
+/3 width=9 by lpx_sn_liftable_dedropable, cpqs_lift/ qed-.
+
+lemma lpqs_ldrop_trans_O1: dropable_dx lpqs.
+/2 width=3 by lpx_sn_dropable/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/unfold/lpqs_cpqs.ma".
+
+(* SN RESTRICTED PARALLEL COMPUTATION ON LOCAL ENVIRONMENTS *****************)
+
+(* Main properties **********************************************************)
+
+theorem lpqs_conf: confluent … lpqs.
+/3 width=6 by lpx_sn_conf, cpqs_conf_lpqs/
+qed-.
+
+theorem lpqs_trans: Transitive … lpqs.
+/3 width=5 by lpx_sn_trans, cpqs_trans_lpqs/
+qed-.
+
+(* Advanced forward lemmas **************************************************)
+
+lemma cpqs_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ➤* T →
+ ∃∃L2,T2. L @@ L1 ⊢ ➤* L @@ L2 & L @@ L1 ⊢ T1 ➤* T2 &
+ T = L2 @@ T2.
+#L1 @(lenv_ind_dx … L1) -L1
+[ #L #T1 #T #HT1
+ @ex3_2_intro [3: // |4,5: // |1,2: skip ] (**) (* /2 width=4/ does not work *)
+| #I #L1 #V1 #IH #L #T1 #T >shift_append_assoc #H <append_assoc
+ elim (cpqs_inv_bind1 … H) -H *
+ [ #V2 #T2 #HV12 #HT12 #H destruct
+ elim (IH … HT12) -IH -HT12 #L2 #T #HL12 #HT1 #H destruct
+ lapply (lpqs_trans … HL12 (L.ⓑ{I}V2@@L2) ?) -HL12 /3 width=1/ #HL12
+ @(ex3_2_intro … (⋆.ⓑ{I}V2@@L2)) [4: /2 width=3/ | skip ] <append_assoc // (**) (* explicit constructor *)
+ | #T #_ #_ #H destruct
+ ]
+]
+qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/grammar/lenv_px_sn.ma".
-include "basic_2/unfold/cpss.ma".
-
-(* SN PARALLEL UNFOLD FOR LOCAL ENVIRONMENTS ********************************)
-
-(* Basic_1: includes: csubst1_bind *)
-definition lpss: relation lenv ≝ lpx_sn cpss.
-
-interpretation "parallel unfold (local environment, sn variant)"
- 'PSubstStarSn L1 L2 = (lpss L1 L2).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma lpss_inv_atom1: ∀L2. ⋆ ⊢ ▶* L2 → L2 = ⋆.
-/2 width=4 by lpx_sn_inv_atom1_aux/ qed-.
-
-lemma lpss_inv_pair1: ∀I,K1,V1,L2. K1. ⓑ{I} V1 ⊢ ▶* L2 →
- ∃∃K2,V2. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L2 = K2. ⓑ{I} V2.
-/2 width=3 by lpx_sn_inv_pair1_aux/ qed-.
-
-lemma lpss_inv_atom2: ∀L1. L1 ⊢ ▶* ⋆ → L1 = ⋆.
-/2 width=4 by lpx_sn_inv_atom2_aux/ qed-.
-
-lemma lpss_inv_pair2: ∀I,L1,K2,V2. L1 ⊢ ▶* K2. ⓑ{I} V2 →
- ∃∃K1,V1. K1 ⊢ ▶* K2 & K1 ⊢ V1 ▶* V2 & L1 = K1. ⓑ{I} V1.
-/2 width=3 by lpx_sn_inv_pair2_aux/ qed-.
-
-(* Basic properties *********************************************************)
-
-(* Basic_1: was by definition: csubst1_refl *)
-lemma lpss_refl: ∀L. L ⊢ ▶* L.
-/2 width=1 by lpx_sn_refl/ qed.
-
-lemma lpss_append: ∀K1,K2. K1 ⊢ ▶* K2 → ∀L1,L2. L1 ⊢ ▶* L2 →
- L1 @@ K1 ⊢ ▶* L2 @@ K2.
-/3 width=1 by lpx_sn_append, cpss_append/ qed.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma lpss_fwd_length: ∀L1,L2. L1 ⊢ ▶* L2 → |L1| = |L2|.
-/2 width=2 by lpx_sn_fwd_length/ qed-.
-
-(* Advanced forward lemmas **************************************************)
-
-lemma lpss_fwd_append1: ∀K1,L1,L. K1 @@ L1 ⊢ ▶* L →
- ∃∃K2,L2. K1 ⊢ ▶* K2 & L = K2 @@ L2.
-/2 width=2 by lpx_sn_fwd_append1/ qed-.
-
-lemma lpss_fwd_append2: ∀L,K2,L2. L ⊢ ▶* K2 @@ L2 →
- ∃∃K1,L1. K1 ⊢ ▶* K2 & L = K1 @@ L1.
-/2 width=2 by lpx_sn_fwd_append2/ qed-.
-
-(* Basic_1: removed theorems 28:
- csubst0_clear_O csubst0_drop_lt csubst0_drop_gt csubst0_drop_eq
- csubst0_clear_O_back csubst0_clear_S csubst0_clear_trans
- csubst0_drop_gt_back csubst0_drop_eq_back csubst0_drop_lt_back
- csubst0_gen_sort csubst0_gen_head csubst0_getl_ge csubst0_getl_lt
- csubst0_gen_S_bind_2 csubst0_getl_ge_back csubst0_getl_lt_back
- csubst0_snd_bind csubst0_fst_bind csubst0_both_bind
- csubst1_head csubst1_flat csubst1_gen_head
- csubst1_getl_ge csubst1_getl_lt csubst1_getl_ge_back getl_csubst1
- fsubst0_gen_base
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/fsup.ma".
-include "basic_2/unfold/lpss_ldrop.ma".
-
-(* SN PARALLEL UNFOLD FOR LOCAL ENVIRONMENTS ********************************)
-
-(* Main properties on context-sensitive parallel unfold for terms ***********)
-
-fact cpss_conf_lpss_atom_atom:
- ∀I,L1,L2. ∃∃T. L1 ⊢ ⓪{I} ▶* T & L2 ⊢ ⓪{I} ▶* T.
-/2 width=3/ qed-.
-
-fact cpss_conf_lpss_atom_delta:
- ∀L0,i. (
- ∀L,T.♯{L, T} < ♯{L0, #i} →
- ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
- ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
- ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
- ) →
- ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
- ∀V2. K0 ⊢ V0 ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
- ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
- ∃∃T. L1 ⊢ #i ▶* T & L2 ⊢ T2 ▶* T.
-#L0 #i #IH #K0 #V0 #HLK0 #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
-elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
-elim (lpss_inv_pair1 … H1) -H1 #K1 #V1 #HK01 #HV01 #H destruct
-elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
-elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
-lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
-lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
-elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
-elim (lift_total V 0 (i+1)) #T #HVT
-lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 /3 width=6/
-qed-.
-
-fact cpss_conf_lpss_delta_delta:
- ∀L0,i. (
- ∀L,T.♯{L, T} < ♯{L0, #i} →
- ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
- ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
- ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
- ) →
- ∀K0,V0. ⇩[O, i] L0 ≡ K0.ⓓV0 →
- ∀V1. K0 ⊢ V0 ▶* V1 → ∀T1. ⇧[O, i + 1] V1 ≡ T1 →
- ∀KX,VX. ⇩[O, i] L0 ≡ KX.ⓓVX →
- ∀V2. KX ⊢ VX ▶* V2 → ∀T2. ⇧[O, i + 1] V2 ≡ T2 →
- ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
- ∃∃T. L1 ⊢ T1 ▶* T & L2 ⊢ T2 ▶* T.
-#L0 #i #IH #K0 #V0 #HLK0 #V1 #HV01 #T1 #HVT1
-#KX #VX #H #V2 #HV02 #T2 #HVT2 #L1 #HL01 #L2 #HL02
-lapply (ldrop_mono … H … HLK0) -H #H destruct
-elim (lpss_ldrop_conf … HLK0 … HL01) -HL01 #X1 #H1 #HLK1
-elim (lpss_inv_pair1 … H1) -H1 #K1 #W1 #HK01 #_ #H destruct
-lapply (ldrop_fwd_ldrop2 … HLK1) -W1 #HLK1
-elim (lpss_ldrop_conf … HLK0 … HL02) -HL02 #X2 #H2 #HLK2
-elim (lpss_inv_pair1 … H2) -H2 #K2 #W2 #HK02 #_ #H destruct
-lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
-lapply (ldrop_pair2_fwd_fw … HLK0 (#i)) -HLK0 #HLK0
-elim (IH … HLK0 … HV01 … HV02 … HK01 … HK02) -L0 -K0 -V0 #V #HV1 #HV2
-elim (lift_total V 0 (i+1)) #T #HVT
-lapply (cpss_lift … HV1 … HLK1 … HVT1 … HVT) -K1 -V1
-lapply (cpss_lift … HV2 … HLK2 … HVT2 … HVT) -K2 -V2 -V /2 width=3/
-qed-.
-
-fact cpss_conf_lpss_bind_bind:
- ∀a,I,L0,V0,T0. (
- ∀L,T.♯{L,T} < ♯{L0,ⓑ{a,I}V0.T0} →
- ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
- ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
- ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
- ) →
- ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0.ⓑ{I}V0 ⊢ T0 ▶* T1 →
- ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0.ⓑ{I}V0 ⊢ T0 ▶* T2 →
- ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
- ∃∃T. L1 ⊢ ⓑ{a,I}V1.T1 ▶* T & L2 ⊢ ⓑ{a,I}V2.T2 ▶* T.
-#a #I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
-#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
-elim (IH … HV01 … HV02 … HL01 … HL02) //
-elim (IH … HT01 … HT02 (L1.ⓑ{I}V1) … (L2.ⓑ{I}V2)) -IH // /2 width=1/ /3 width=5/
-qed-.
-
-fact cpss_conf_lpss_flat_flat:
- ∀I,L0,V0,T0. (
- ∀L,T.♯{L,T} < ♯{L0,ⓕ{I}V0.T0} →
- ∀T1. L ⊢ T ▶* T1 → ∀T2. L ⊢ T ▶* T2 →
- ∀L1. L ⊢ ▶* L1 → ∀L2. L ⊢ ▶* L2 →
- ∃∃T0. L1 ⊢ T1 ▶* T0 & L2 ⊢ T2 ▶* T0
- ) →
- ∀V1. L0 ⊢ V0 ▶* V1 → ∀T1. L0 ⊢ T0 ▶* T1 →
- ∀V2. L0 ⊢ V0 ▶* V2 → ∀T2. L0 ⊢ T0 ▶* T2 →
- ∀L1. L0 ⊢ ▶* L1 → ∀L2. L0 ⊢ ▶* L2 →
- ∃∃T. L1 ⊢ ⓕ{I}V1.T1 ▶* T & L2 ⊢ ⓕ{I}V2.T2 ▶* T.
-#I #L0 #V0 #T0 #IH #V1 #HV01 #T1 #HT01
-#V2 #HV02 #T2 #HT02 #L1 #HL01 #L2 #HL02
-elim (IH … HV01 … HV02 … HL01 … HL02) //
-elim (IH … HT01 … HT02 … HL01 … HL02) // /3 width=5/
-qed-.
-
-theorem cpss_conf_lpss: lpx_sn_confluent cpss cpss.
-#L0 #T0 @(f2_ind … fw … L0 T0) -L0 -T0 #n #IH #L0 * [|*]
-[ #I0 #Hn #T1 #H1 #T2 #H2 #L1 #HL01 #L2 #HL02 destruct
- elim (cpss_inv_atom1 … H1) -H1
- elim (cpss_inv_atom1 … H2) -H2
- [ #H2 #H1 destruct
- /2 width=1 by cpss_conf_lpss_atom_atom/
- | * #K0 #V0 #V2 #i2 #HLK0 #HV02 #HVT2 #H2 #H1 destruct
- /3 width=10 by cpss_conf_lpss_atom_delta/
- | #H2 * #K0 #V0 #V1 #i1 #HLK0 #HV01 #HVT1 #H1 destruct
- /4 width=10 by ex2_commute, cpss_conf_lpss_atom_delta/
- | * #X #Y #V2 #z #H #HV02 #HVT2 #H2
- * #K0 #V0 #V1 #i #HLK0 #HV01 #HVT1 #H1 destruct
- /3 width=17 by cpss_conf_lpss_delta_delta/
- ]
-| #a #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
- elim (cpss_inv_bind1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct
- elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct
- /3 width=10 by cpss_conf_lpss_bind_bind/
-| #I #V0 #T0 #Hn #X1 #H1 #X2 #H2 #L1 #HL01 #L2 #HL02 destruct
- elim (cpss_inv_flat1 … H1) -H1 #V1 #T1 #HV01 #HT01 #H destruct
- elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV02 #HT02 #H destruct
- /3 width=10 by cpss_conf_lpss_flat_flat/
-]
-qed-.
-
-(* Basic_1: was only: subst1_confluence_eq *)
-theorem cpss_conf: ∀L. confluent … (cpss L).
-/2 width=6 by cpss_conf_lpss/ qed-.
-
-theorem cpss_trans_lpss: lpx_sn_transitive cpss cpss.
-#L1 #T1 @(f2_ind … fw … L1 T1) -L1 -T1 #n #IH #L1 * [|*]
-[ #I #Hn #T #H1 #L2 #HL12 #T2 #HT2 destruct
- elim (cpss_inv_atom1 … H1) -H1
- [ #H destruct
- elim (cpss_inv_atom1 … HT2) -HT2
- [ #H destruct //
- | * #K2 #V #V2 #i #HLK2 #HV2 #HVT2 #H destruct
- elim (lpss_ldrop_trans_O1 … HL12 … HLK2) -L2 #X #HLK1 #H
- elim (lpss_inv_pair2 … H) -H #K1 #V1 #HK12 #HV1 #H destruct
- lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
- ]
- | * #K1 #V1 #V #i #HLK1 #HV1 #HVT #H destruct
- elim (lpss_ldrop_conf … HLK1 … HL12) -HL12 #X #H #HLK2
- elim (lpss_inv_pair1 … H) -H #K2 #W2 #HK12 #_ #H destruct
- lapply (ldrop_fwd_ldrop2 … HLK2) -W2 #HLK2
- elim (cpss_inv_lift1 … HT2 … HLK2 … HVT) -L2 -T
- lapply (ldrop_pair2_fwd_fw … HLK1 (#i)) /3 width=9/
- ]
-| #a #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
- elim (cpss_inv_bind1 … H1) -H1 #V #T #HV1 #HT1 #H destruct
- elim (cpss_inv_bind1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /4 width=5/
-| #I #V1 #T1 #Hn #X1 #H1 #L2 #HL12 #X2 #H2
- elim (cpss_inv_flat1 … H1) -H1 #V #T #HV1 #HT1 #H destruct
- elim (cpss_inv_flat1 … H2) -H2 #V2 #T2 #HV2 #HT2 #H destruct /3 width=5/
-]
-qed-.
-
-(* Basic_1: was only: subst1_trans *)
-theorem cpss_trans: ∀L. Transitive … (cpss L).
-/2 width=5 by cpss_trans_lpss/ qed-.
-
-(* Properties on context-sensitive parallel unfold for terms ****************)
-
-(* Basic_1: was only: subst1_subst1_back *)
-lemma lpss_cpss_conf_dx: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 →
- ∃∃T. L1 ⊢ T0 ▶* T & L1 ⊢ T1 ▶* T.
-#L0 #T0 #T1 #HT01 #L1 #HL01
-elim (cpss_conf_lpss … HT01 T0 … HL01 … HL01) // -L0 /2 width=3/
-qed-.
-
-lemma lpss_cpss_conf_sn: ∀L0,T0,T1. L0 ⊢ T0 ▶* T1 → ∀L1. L0 ⊢ ▶* L1 →
- ∃∃T. L1 ⊢ T0 ▶* T & L0 ⊢ T1 ▶* T.
-#L0 #T0 #T1 #HT01 #L1 #HL01
-elim (cpss_conf_lpss … HT01 T0 … L0 … HL01) // -HT01 -HL01 /2 width=3/
-qed-.
-
-(* Basic_1: was only: subst1_subst1 *)
-lemma lpss_cpss_trans: ∀L1,L2. L1 ⊢ ▶* L2 →
- ∀T1,T2. L2 ⊢ T1 ▶* T2 → L1 ⊢ T1 ▶* T2.
-/2 width=5 by cpss_trans_lpss/ qed-.
-
-lemma fsup_cpss_trans: ∀L1,L2,T1,T2. ⦃L1, T1⦄ ⊃ ⦃L2, T2⦄ → ∀U2. L2 ⊢ T2 ▶* U2 →
- ∃∃L,U1. L1 ⊢ ▶* L & L ⊢ T1 ▶* U1 & ⦃L, U1⦄ ⊃ ⦃L2, U2⦄.
-#L1 #L2 #T1 #T2 #H elim H -L1 -L2 -T1 -T2 [1,2,3,4,5: /3 width=5/ ]
-#L1 #K1 #K2 #T1 #T2 #U1 #d #e #HLK1 #HTU1 #_ #IHT12 #U2 #HTU2
-elim (IHT12 … HTU2) -IHT12 -HTU2 #K #T #HK1 #HT1 #HT2
-elim (lift_total T d e) #U #HTU
-elim (ldrop_lpss_trans … HLK1 … HK1) -HLK1 -HK1 #L2 #HL12 #HL2K
-lapply (cpss_lift … HT1 … HL2K … HTU1 … HTU) -HT1 -HTU1 /3 width=11/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_lpx_sn.ma".
-include "basic_2/unfold/cpss_lift.ma".
-include "basic_2/unfold/lpss.ma".
-
-(* SN PARALLEL UNFOLD FOR LOCAL ENVIRONMENTS ********************************)
-
-(* Properies on local environment slicing ***********************************)
-
-lemma lpss_ldrop_conf: dropable_sn lpss.
-/3 width=5 by lpx_sn_deliftable_dropable, cpss_inv_lift1/ qed-.
-
-lemma ldrop_lpss_trans: dedropable_sn lpss.
-/3 width=9 by lpx_sn_liftable_dedropable, cpss_lift/ qed-.
-
-lemma lpss_ldrop_trans_O1: dropable_dx lpss.
-/2 width=3 by lpx_sn_dropable/ qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basic_2/unfold/lpss_cpss.ma".
-
-(* SN PARALLEL UNFOLD ON LOCAL ENVIRONMENTS *********************************)
-
-(* Main properties **********************************************************)
-
-theorem lpss_conf: confluent … lpss.
-/3 width=6 by lpx_sn_conf, cpss_conf_lpss/
-qed-.
-
-theorem lpss_trans: Transitive … lpss.
-/3 width=5 by lpx_sn_trans, cpss_trans_lpss/
-qed-.
-
-(* Advanced forward lemmas **************************************************)
-
-lemma cpss_fwd_shift1: ∀L1,L,T1,T. L ⊢ L1 @@ T1 ▶* T →
- ∃∃L2,T2. L @@ L1 ⊢ ▶* L @@ L2 & L @@ L1 ⊢ T1 ▶* T2 &
- T = L2 @@ T2.
-#L1 @(lenv_ind_dx … L1) -L1
-[ #L #T1 #T #HT1
- @ex3_2_intro [3: // |4,5: // |1,2: skip ] (**) (* /2 width=4/ does not work *)
-| #I #L1 #V1 #IH #L #T1 #T >shift_append_assoc #H <append_assoc
- elim (cpss_inv_bind1 … H) -H #V2 #T2 #HV12 #HT12 #H destruct
- elim (IH … HT12) -IH -HT12 #L2 #T #HL12 #HT1 #H destruct
- lapply (lpss_trans … HL12 (L.ⓑ{I}V2@@L2) ?) -HL12 /3 width=1/ #HL12
- @(ex3_2_intro … (⋆.ⓑ{I}V2@@L2)) [4: /2 width=3/ | skip ] <append_assoc // (**) (* explicit constructor *)
-]
-qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+
+(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************)
+
+(* Note: includes: stass_refl *)
+definition sstas: ∀h. sd h → lenv → relation term ≝
+ λh,g,L. star … (ssta_step h g L).
+
+interpretation "iterated stratified static type assignment (term)"
+ 'StaticTypeStar h g L T U = (sstas h g L T U).
+
+(* Basic eliminators ********************************************************)
+
+lemma sstas_ind: ∀h,g,L,T. ∀R:predicate term.
+ R T → (
+ ∀U1,U2,l. ⦃h, L⦄ ⊢ T •* [g] U1 → ⦃h, L⦄ ⊢ U1 •[g] ⦃l+1, U2⦄ →
+ R U1 → R U2
+ ) →
+ ∀U. ⦃h, L⦄ ⊢ T •*[g] U → R U.
+#h #g #L #T #R #IH1 #IH2 #U #H elim H -U //
+#U1 #U2 #H * /2 width=5/
+qed-.
+
+lemma sstas_ind_dx: ∀h,g,L,U2. ∀R:predicate term.
+ R U2 → (
+ ∀T,U1,l. ⦃h, L⦄ ⊢ T •[g] ⦃l+1, U1⦄ → ⦃h, L⦄ ⊢ U1 •* [g] U2 →
+ R U1 → R T
+ ) →
+ ∀T. ⦃h, L⦄ ⊢ T •*[g] U2 → R T.
+#h #g #L #U2 #R #IH1 #IH2 #T #H @(star_ind_l … T H) -T //
+#T #T0 * /2 width=5/
+qed-.
+
+(* Basic properties *********************************************************)
+
+lemma sstas_refl: ∀h,g,L. reflexive … (sstas h g L).
+// qed.
+
+lemma ssta_sstas: ∀h,g,L,T,U,l. ⦃h, L⦄ ⊢ T •[g] ⦃l+1, U⦄ → ⦃h, L⦄ ⊢ T •*[g] U.
+/3 width=2 by R_to_star, ex_intro/ qed. (**) (* auto fails without trace *)
+
+lemma sstas_strap1: ∀h,g,L,T1,T2,U2,l. ⦃h, L⦄ ⊢ T1 •*[g] T2 → ⦃h, L⦄ ⊢ T2 •[g] ⦃l+1, U2⦄ →
+ ⦃h, L⦄ ⊢ T1 •*[g] U2.
+/3 width=4 by sstep, ex_intro/ (**) (* auto fails without trace *)
+qed.
+
+lemma sstas_strap2: ∀h,g,L,T1,U1,U2,l. ⦃h, L⦄ ⊢ T1 •[g] ⦃l+1, U1⦄ → ⦃h, L⦄ ⊢ U1 •*[g] U2 →
+ ⦃h, L⦄ ⊢ T1 •*[g] U2.
+/3 width=3 by star_compl, ex_intro/ (**) (* auto fails without trace *)
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+lemma sstas_inv_bind1: ∀h,g,a,I,L,Y,X,U. ⦃h, L⦄ ⊢ ⓑ{a,I}Y.X •*[g] U →
+ ∃∃Z. ⦃h, L.ⓑ{I}Y⦄ ⊢ X •*[g] Z & U = ⓑ{a,I}Y.Z.
+#h #g #a #I #L #Y #X #U #H @(sstas_ind … H) -U /2 width=3/
+#T #U #l #_ #HTU * #Z #HXZ #H destruct
+elim (ssta_inv_bind1 … HTU) -HTU #Z0 #HZ0 #H destruct /3 width=4/
+qed-.
+
+lemma sstas_inv_appl1: ∀h,g,L,Y,X,U. ⦃h, L⦄ ⊢ ⓐY.X •*[g] U →
+ ∃∃Z. ⦃h, L⦄ ⊢ X •*[g] Z & U = ⓐY.Z.
+#h #g #L #Y #X #U #H @(sstas_ind … H) -U /2 width=3/
+#T #U #l #_ #HTU * #Z #HXZ #H destruct
+elim (ssta_inv_appl1 … HTU) -HTU #Z0 #HZ0 #H destruct /3 width=4/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_aaa.ma".
+include "basic_2/unfold/sstas.ma".
+
+(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************)
+
+(* Properties on atomic arity assignment for terms **************************)
+
+lemma sstas_aaa: ∀h,g,L,T,U. ⦃h, L⦄ ⊢ T •*[g] U →
+ ∀A. L ⊢ T ⁝ A → L ⊢ U ⁝ A.
+#h #g #L #T #U #H @(sstas_ind_dx … H) -T // /3 width=6/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_lift.ma".
+include "basic_2/unfold/sstas.ma".
+
+(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************)
+
+(* Advanced forward lemmas **************************************************)
+
+lemma sstas_fwd_correct: ∀h,g,L,T1,U1,l1. ⦃h, L⦄ ⊢ T1 •[g] ⦃l1, U1⦄ →
+ ∀T2. ⦃h, L⦄ ⊢ T1 •*[g] T2 →
+ ∃∃U2,l2. ⦃h, L⦄ ⊢ T2 •[g] ⦃l2, U2⦄.
+#h #g #L #T1 #U1 #l1 #HTU1 #T2 #H @(sstas_ind … H) -T2 [ /2 width=3/ ] -HTU1
+#T #T2 #l #_ #HT2 * #U #l0 #_ -l0
+elim (ssta_fwd_correct … HT2) -T /2 width=3/
+qed-.
+
+(* Properties on relocation *************************************************)
+
+lemma sstas_lift: ∀h,g,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 →
+ ∀L2,d,e. ⇩[d, e] L2 ≡ L1 → ∀T2. ⇧[d, e] T1 ≡ T2 →
+ ∀U2. ⇧[d, e] U1 ≡ U2 → ⦃h, L2⦄ ⊢ T2 •*[g] U2.
+#h #g #L1 #T1 #U1 #H @(sstas_ind_dx … H) -T1
+[ #L2 #d #e #HL21 #X #HX #U2 #HU12
+ >(lift_mono … HX … HU12) -X //
+| #T0 #U0 #l0 #HTU0 #_ #IHU01 #L2 #d #e #HL21 #T2 #HT02 #U2 #HU12
+ elim (lift_total U0 d e) /3 width=10/
+]
+qed.
+
+(* Inversion lemmas on relocation *******************************************)
+
+lemma sstas_inv_lift1: ∀h,g,L2,T2,U2. ⦃h, L2⦄ ⊢ T2 •*[g] U2 →
+ ∀L1,d,e. ⇩[d, e] L2 ≡ L1 → ∀T1. ⇧[d, e] T1 ≡ T2 →
+ ∃∃U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 & ⇧[d, e] U1 ≡ U2.
+#h #g #L2 #T2 #U2 #H @(sstas_ind_dx … H) -T2 /2 width=3/
+#T0 #U0 #l0 #HTU0 #_ #IHU01 #L1 #d #e #HL21 #U1 #HU12
+elim (ssta_inv_lift1 … HTU0 … HL21 … HU12) -HTU0 -HU12 #U #HU1 #HU0
+elim (IHU01 … HL21 … HU0) -IHU01 -HL21 -U0 /3 width=4/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/static/ssta_lpss.ma".
+include "basic_2/unfold/sstas.ma".
+
+(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************)
+
+(* Properties about sn parallel substitution ********************************)
+
+lemma sstas_tpss_lpss_conf: ∀h,g,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 •*[g] U1 →
+ ∀T2. L1 ⊢ T1 ▶* T2 → ∀L2. L1 ⊢ ▶* L2 →
+ ∃∃U2. ⦃h, L2⦄ ⊢ T2 •*[g] U2 & L1 ⊢ U1 ▶* U2.
+#h #g #L1 #T1 #U1 #H @(sstas_ind_dx … H) -T1 /2 width=3/
+#T0 #U0 #l0 #HTU0 #_ #IHU01 #T #HT0 #L2 #HL12
+elim (ssta_tpss_lpss_conf … HTU0 … HT0 … HL12) -HTU0 -HT0 #U #HTU #HU0
+elim (IHU01 … HU0 … HL12) -IHU01 -U0 -HL12 /3 width=4/
+qed-.
+
+lemma sstas_tpss_conf: ∀h,g,L,T1,U1. ⦃h, L⦄ ⊢ T1 •*[g] U1 →
+ ∀T2. L ⊢ T1 ▶* T2 →
+ ∃∃U2. ⦃h, L⦄ ⊢ T2 •*[g] U2 & L ⊢ U1 ▶* U2.
+/2 width=3 by sstas_tpss_lpss_conf/ qed-.
+
+lemma sstas_lpss_conf: ∀h,g,L1,T,U1. ⦃h, L1⦄ ⊢ T •*[g] U1 →
+ ∀L2. L1 ⊢ ▶* L2 →
+ ∃∃U2. ⦃h, L2⦄ ⊢ T •*[g] U2 & L1 ⊢ U1 ▶* U2.
+/2 width=3 by sstas_tpss_lpss_conf/ qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basic_2/static/ssta_ssta.ma".
+include "basic_2/unfold/sstas.ma".
+
+(* ITERATED STRATIFIED STATIC TYPE ASSIGNMENT FOR TERMS *********************)
+
+(* Advanced inversion lemmas ************************************************)
+
+lemma sstas_inv_O: ∀h,g,L,T,U. ⦃h, L⦄ ⊢ T •*[g] U →
+ ∀T0. ⦃h, L⦄ ⊢ T •[g] ⦃0, T0⦄ → U = T.
+#h #g #L #T #U #H @(sstas_ind_dx … H) -T //
+#T0 #U0 #l0 #HTU0 #_ #_ #T1 #HT01
+elim (ssta_mono … HTU0 … HT01) <plus_n_Sm #H destruct
+qed-.
+
+(* Advanced properties ******************************************************)
+
+lemma sstas_strip: ∀h,g,L,T,U1. ⦃h, L⦄ ⊢ T •*[g] U1 →
+ ∀U2,l. ⦃h, L⦄ ⊢ T •[g] ⦃l, U2⦄ →
+ T = U1 ∨ ⦃h, L⦄ ⊢ U2 •*[g] U1.
+#h #g #L #T #U1 #H1 @(sstas_ind_dx … H1) -T /2 width=1/
+#T #U #l0 #HTU #HU1 #_ #U2 #l #H2
+elim (ssta_mono … H2 … HTU) -H2 -HTU #H1 #H2 destruct /2 width=1/
+qed-.
+
+(* Main properties **********************************************************)
+
+theorem sstas_trans: ∀h,g,L,T1,U. ⦃h, L⦄ ⊢ T1 •*[g] U →
+ ∀T2. ⦃h, L⦄ ⊢ U •*[g] T2 → ⦃h, L⦄ ⊢ T1 •*[g] T2.
+/2 width=3/ qed-.
+
+theorem sstas_conf: ∀h,g,L,T,U1. ⦃h, L⦄ ⊢ T •*[g] U1 →
+ ∀U2. ⦃h, L⦄ ⊢ T •*[g] U2 →
+ ⦃h, L⦄ ⊢ U1 •*[g] U2 ∨ ⦃h, L⦄ ⊢ U2 •*[g] U1.
+#h #g #L #T #U1 #H1 @(sstas_ind_dx … H1) -T /2 width=1/
+#T #U #l #HTU #HU1 #IHU1 #U2 #H2
+elim (sstas_strip … H2 … HTU) #H destruct
+[ -H2 -IHU1 /3 width=4/
+| -T /2 width=1/
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+
+(* CONTEXT-SENSITIVE UNFOLD FOR TERMS ***************************************)
+
+inductive unfold: lenv → relation2 term lenv ≝
+| unfold_sort: ∀L,k. unfold L (⋆k) L
+| unfold_lref: ∀I,L1,L2,K1,K2,V,i. ⇩[0, i] L1 ≡ K1. ⓑ{I}V →
+ unfold K1 V K2 → ⇩[|L2|, i] L2 ≡ K2 →
+ unfold L1 (#i) (L1@@L2)
+| unfold_bind: ∀a,I,L1,L2,V,T.
+ unfold (L1.ⓑ{I}V) T L2 → unfold L1 (ⓑ{a,I}V.T) L2
+| unfold_flat: ∀I,L1,L2,V,T.
+ unfold L1 T L2 → unfold L1 (ⓕ{I}V.T) L2
+.
+
+interpretation "context-sensitive unfold (term)"
+ 'Unwind L1 T L2 = (unfold L1 T L2).
}
]
(*
- class "wine"
+ class "magenta"
[ { "higher order dynamic typing" * } {
[ { "higher order native type assignment" * } {
[ "ntas ( ⦃?,?⦄ ⊢ ? :* ? )" "nta_lift" * ]
}
]
*)
- class "magenta"
+ class "prune"
[ { "dynamic typing" * } {
(*
[ { "local env. ref. for native type assignment" * } {
]
}
]
- class "prune"
+ class "blue"
[ { "equivalence" * } {
[ { "focalized equivalence" * } {
[ "lfpcs ( ⦃?⦄ ⬌* ⦃?⦄ )" "lfpcs_aaa" + "lfpcs_fpcs" + "lfpcs_lfprs" + "lfpcs_lfpcs" * ]
]
}
]
- class "blue"
+ class "sky"
[ { "conversion" * } {
[ { "focalized conversion" * } {
[ "lfpc ( ⦃?⦄ ⬌ ⦃?⦄ )" "lfpc_lfpc" * ]
]
}
]
- class "sky"
+ class "cyan"
[ { "computation" * } {
[ { "focalized computation" * } {
[ "lfprs ( ⦃?⦄ ➡* ⦃?⦄ )" "lfprs_aaa" + "lfprs_ltprs" + "lfprs_cprs" + "lfprs_fprs" + "lfprs_lfprs" * ]
]
}
]
- class "cyan"
+ class "water"
[ { "reducibility" * } {
[ { "context-sensitive focalized reduction" * } {
[ "cfpr ( ? ⊢ ⦃?,?⦄ ➡ ⦃?,?⦄ )" "cnfpr_ltpss" + "cfpr_aaa" + "cfpr_cpr" + "cfpr_cfpr" * ]
]
}
]
- class "water"
- [ { "restricted computation" * } {
+ class "green"
+ [ { "unfold" * } {
[ { "restricted parallel computation" * } {
[ "lpqs ( ? ⊢ ➤* ? )" "lpqs_ldrop" + "lpqs_cpqs" + "lpqs_lpqs" * ]
[ "cpqs ( ? ⊢ ? ➤* ? )" "cpqs_lift" * ]
}
]
- }
- ]
- class "green"
- [ { "unwind" * } {
+ [ { "unfold" * } {
+ [ "unfold ( ? ⊢ ? ⧫* ? )" * ]
+ }
+ ]
[ { "iterated stratified static type assignment" * } {
[ "sstas ( ⦃?,?⦄ ⊢ ? •*[?] ? )" "sstas_lift" + "sstas_lpss" + "sstas_aaa" + "sstas_sstas" * ]
}
}
]
class "yellow"
- [ { "unfold" * } {
+ [ { "substitution" * } {
(*
[ { "basic local env. thinning" * } {
[ "thin ( ? ▼*[?,?] ≡ ? )" "thin_ldrop" + "thin_delift" * ]
}
]
class "orange"
- [ { "substitution" * } {
+ [ { "relocation" * } {
[ { "structural successor for closures" * } {
[ "fsup ( ⦃?,?⦄ ⊃ ⦃?,?⦄ )" * ]
}
projects / helm.git / commitdiff