- predefined_virtuals: nwe characters

[helm.git] / matita / matita / contribs / lambda_delta / basic_2 / substitution / ldrop.ma

diff --git a/matita/matita/contribs/lambda_delta/basic_2/substitution/ldrop.ma b/matita/matita/contribs/lambda_delta/basic_2/substitution/ldrop.ma
index 9ab903f1e48055d3f85ef41473ceb6b9e8d8de54..9511648aab81cad4032fb903dc4ef76ebd340216 100644 (file)
--- a/matita/matita/contribs/lambda_delta/basic_2/substitution/ldrop.ma
+++ b/matita/matita/contribs/lambda_delta/basic_2/substitution/ldrop.ma
@@ -30,6 +30,27 @@ inductive ldrop: nat → nat → relation lenv ≝
 
 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.
@@ -141,20 +162,35 @@ lemma ldrop_ldrop_lt: ∀L1,L2,I,V,e.
 #L1 #L2 #I #V #e #HL12 #He >(plus_minus_m_m e 1) // /2 width=1/
 qed.
 
-lemma ldrop_O1: ∀L,i. i < |L| → ∃∃I,K,V. ⇩[0, i] L ≡ K.ⓑ{I}V.
+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 #_ #H
-  lapply (lt_plus_to_lt_l … H) -H #Hi
-  elim (IHL i ?) // /3 width=4/
+| #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.   
+qed.
 
-lemma ldrop_lsubs_ldrop1_abbr: ∀L1,L2,d,e. L1 ≼ [d, e] L2 →
-                               ∀K1,V,i. ⇩[0, i] L1 ≡ K1. ⓓV →
+lemma ldrop_lsubs_ldrop2_abbr: ∀L1,L2,d,e. L1 ≼ [d, e] L2 →
+                               ∀K2,V,i. ⇩[0, i] L2 ≡ K2. ⓓV →
                                d ≤ i → i < d + e →
-                               ∃∃K2. K1 ≼ [0, d + e - i - 1] K2 &
-                                     ⇩[0, i] L2 ≡ K2. ⓓV.
+                               ∃∃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
@@ -179,6 +215,34 @@ lemma ldrop_lsubs_ldrop1_abbr: ∀L1,L2,d,e. L1 ≼ [d, e] L2 →
 ]
 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 *)
@@ -194,7 +258,7 @@ lemma ldrop_fwd_ldrop2: ∀L1,I2,K2,V2,e. ⇩[O, e] L1 ≡ K2. ⓑ{I2} V2 →
 ]
 qed-.
 
-lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → #[L2] ≤ #[L1].
+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
@@ -202,8 +266,8 @@ lemma ldrop_fwd_lw: ∀L1,L2,d,e. ⇩[d, e] L1 ≡ L2 → #[L2] ≤ #[L1].
 ]
 qed-. 
 
-lemma ldrop_pair2_fwd_cw: ∀I,L,K,V,d,e. ⇩[d, e] L ≡ K. ⓑ{I} V →
-                          ∀T. #[K, V] < #[L, T].
+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/