]> matita.cs.unibo.it Git - helm.git/commitdiff
- lib: some additions
authorFerruccio Guidi <ferruccio.guidi@unibo.it>
Thu, 10 May 2012 10:58:45 +0000 (10:58 +0000)
committerFerruccio Guidi <ferruccio.guidi@unibo.it>
Thu, 10 May 2012 10:58:45 +0000 (10:58 +0000)
- lambda_delta: more properties on native type assignment
                change of notation for consand append

43 files changed:
matita/matita/contribs/lambda_delta/apps_2/functional/rtm_step.ma
matita/matita/contribs/lambda_delta/basic_2/basic_1.txt
matita/matita/contribs/lambda_delta/basic_2/computation/acp_aaa.ma
matita/matita/contribs/lambda_delta/basic_2/computation/acp_cr.ma
matita/matita/contribs/lambda_delta/basic_2/computation/cprs_delift.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/computation/csn_tstc_vector.ma
matita/matita/contribs/lambda_delta/basic_2/computation/csn_vector.ma
matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_alt.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_delift.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_lift.ma
matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_nta.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/equivalence/cpcs.ma
matita/matita/contribs/lambda_delta/basic_2/equivalence/cpcs_delift.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/grammar/cl_weight.ma
matita/matita/contribs/lambda_delta/basic_2/notation.ma
matita/matita/contribs/lambda_delta/basic_2/reducibility/cpr_cpr.ma
matita/matita/contribs/lambda_delta/basic_2/reducibility/cpr_delift.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/reducibility/tpr_delift.ma [new file with mode: 0644]
matita/matita/contribs/lambda_delta/basic_2/reducibility/tpr_tpss.ma
matita/matita/contribs/lambda_delta/basic_2/substitution/lift_vector.ma
matita/matita/contribs/lambda_delta/basic_2/substitution/tps_lift.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift_alt.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift_delift.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift_lift.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift_ltpss.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/delift_tpss.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/gr2.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/gr2_minus.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/gr2_plus.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/ldrops.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/ldrops_ldrops.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/lifts.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/lifts_lifts.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/lifts_vector.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/thin.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/thin_delift.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/thin_ldrop.ma
matita/matita/contribs/lambda_delta/basic_2/unfold/tpss_lift.ma
matita/matita/contribs/lambda_delta/ground_2/list.ma
matita/matita/contribs/lambda_delta/ground_2/notation.ma
matita/matita/lib/arithmetics/nat.ma
matita/matita/lib/basics/star.ma

index f67d9dc1f681bef81e33ae52ff0f14cfaef258c5..9a04c807041a46972bbfae728301d3984b5de430 100644 (file)
@@ -41,9 +41,9 @@ inductive rtm_step: relation rtm ≝
                        (mk_rtm G u E S T)
 | rtm_appl  : ∀G,u,E,S,V,T.
               rtm_step (mk_rtm G u E S (ⓐV. T))
-                       (mk_rtm G u E ({E, V} :: S) T)
+                       (mk_rtm G u E ({E, V} @ S) T)
 | rtm_beta  : ∀G,u,E,F,V,S,W,T.
-              rtm_step (mk_rtm G u E ({F, V} :: S) (ⓛW. T))
+              rtm_step (mk_rtm G u E ({F, V} @ S) (ⓛW. T))
                        (mk_rtm G u (E. ④{Abbr} {u, F, V}) S T)
 | rtm_push  : ∀G,u,E,W,T.
               rtm_step (mk_rtm G u E ⟠ (ⓛW. T))
index 1b6aaa13f0d78844cee8fbe7d9a5bfe6080fc8aa..0c6fcb34aa99204ce878ce04cc9a12cec8247448 100644 (file)
@@ -180,7 +180,6 @@ pc3/props pc3_pr2_pr2_t
 pc3/props pc3_pr2_pr3_t
 pc3/props pc3_pr3_pc3_t
 pc3/props pc3_eta
-pc3/subst1 pc3_gen_cabbr
 pc3/wcpr0 pc3_wcpr0__pc3_wcpr0_t_aux
 pc3/wcpr0 pc3_wcpr0_t
 pc3/wcpr0 pc3_wcpr0
@@ -198,11 +197,9 @@ pr1/props pr1_head_2
 pr1/props pr1_comp
 pr1/props pr1_eta
 pr2/fwd pr2_gen_void
-pr2/subst1 pr2_gen_cabbr
 pr3/fwd pr3_gen_void
 pr3/pr1 pr3_pr1
 pr3/props pr3_eta
-pr3/subst1 pr3_gen_cabbr
 sn3/props sns3_lifts
 sty1/cnt sty1_cnt
 sty1/props sty1_trans
@@ -260,7 +257,6 @@ ty3/pr3_props ty3_tred
 ty3/pr3_props ty3_sconv_pc3
 ty3/pr3_props ty3_sred_back
 ty3/pr3_props ty3_sconv
-ty3/props ty3_unique
 ty3/props ty3_gen_abst_abst
 ty3/sty0 ty3_sty0
 ty3/subst1 ty3_gen_cabbr
index 190a595cf0ade578b4e1c387ad13e7c1d8bc263a..788c3990255c29e9b74ea884b5cd4eba18d67343 100644 (file)
@@ -73,8 +73,8 @@ theorem aacr_aaa_csubc_lifts: ∀RR,RS,RP.
     #L3 #V3 #T3 #des3 #HL32 #HT03 #HB
     elim (lifts_total des3 W0) #W2 #HW02
     elim (ldrops_lsubc_trans … H1RP H2RP … HL32 … HL02) -L2 #L2 #HL32 #HL20
-    lapply (aaa_lifts … L2 W2 … (des @ des3) … HLWB) -HLWB /2 width=3/ #HLW2B
-    @(IHA (L2. ⓛW2) … (des + 1 @ des3 + 1)) -IHA
+    lapply (aaa_lifts … L2 W2 … (des @@ des3) … HLWB) -HLWB /2 width=3/ #HLW2B
+    @(IHA (L2. ⓛW2) … (des + 1 @@ des3 + 1)) -IHA
     /2 width=3/ /3 width=5/
   ]
 | #L #V #T #B #A #_ #_ #IHB #IHA #L0 #des #HL0 #X #H #L2 #HL20
index c300d19de779e4283014d3a3118b076b9db8fa3e..222f00da811fc09daadae3a893afcaf08786c875 100644 (file)
@@ -119,12 +119,12 @@ lemma aacr_acr: ∀RR,RS,RP. acp RR RS RP → acr RR RS RP (λL,T. RP L T) →
 | #L #Vs #HVs #T #H1T #H2T #L0 #V0 #X #des #HB #HL0 #H
   elim (lifts_inv_applv1 … H) -H #V0s #T0 #HV0s #HT0 #H destruct
   lapply (s1 … IHB … HB) #HV0
-  @(s2 … IHA … (V0 :: V0s)) /2 width=4 by lifts_simple_dx/ /3 width=6/
+  @(s2 … IHA … (V0 @ V0s)) /2 width=4 by lifts_simple_dx/ /3 width=6/
 | #L #Vs #U #T #W #HA #HW #L0 #V0 #X #des #HB #HL0 #H
   elim (lifts_inv_applv1 … H) -H #V0s #Y #HV0s #HY #H destruct
   elim (lifts_inv_flat1 … HY) -HY #U0 #X #HU0 #HX #H destruct
   elim (lifts_inv_bind1 … HX) -HX #W0 #T0 #HW0 #HT0 #H destruct
-  @(s3 … IHA … (V0 :: V0s)) /2 width=6 by rp_lifts/ /4 width=5/
+  @(s3 … IHA … (V0 @ V0s)) /2 width=6 by rp_lifts/ /4 width=5/
 | #L #K #Vs #V1 #V2 #i #HA #HV12 #HLK #L0 #V0 #X #des #HB #HL0 #H
   elim (lifts_inv_applv1 … H) -H #V0s #Y #HV0s #HY #H destruct
   elim (lifts_inv_lref1 … HY) -HY #i0 #Hi0 #H destruct
@@ -134,13 +134,13 @@ lemma aacr_acr: ∀RR,RS,RP. acp RR RS RP → acr RR RS RP (λL,T. RP L T) →
   elim (lift_total W1 0 (i0 + 1)) #W2 #HW12
   elim (lifts_lift_trans  … Hdes0 … HVW1 … HW12) // -Hdes0 -Hi0 #V3 #HV13 #HVW2
   >(lift_mono … HV13 … HV12) in HVW2; -V3 #HVW2
-  @(s4 … IHA … (V0 :: V0s) … HW12 HL02) /3 width=4/
+  @(s4 … IHA … (V0 @ V0s) … HW12 HL02) /3 width=4/
 | #L #V1s #V2s #HV12s #V #T #HA #HV #L0 #V10 #X #des #HB #HL0 #H
   elim (lifts_inv_applv1 … H) -H #V10s #Y #HV10s #HY #H destruct
   elim (lifts_inv_bind1 … HY) -HY #V0 #T0 #HV0 #HT0 #H destruct
   elim (lift_total V10 0 1) #V20 #HV120
   elim (liftv_total 0 1 V10s) #V20s #HV120s
-  @(s5 … IHA … (V10 :: V10s) (V20 :: V20s)) /2 width=1/ /2 width=6 by rp_lifts/
+  @(s5 … IHA … (V10 @ V10s) (V20 @ V20s)) /2 width=1/ /2 width=6 by rp_lifts/
   @(HA … (des + 1)) /2 width=1/
   [ @(s7 … IHB … HB … HV120) /2 width=1/
   | @lifts_applv //
@@ -150,7 +150,7 @@ lemma aacr_acr: ∀RR,RS,RP. acp RR RS RP → acr RR RS RP (λL,T. RP L T) →
 | #L #Vs #T #W #HA #HW #L0 #V0 #X #des #HB #HL0 #H
   elim (lifts_inv_applv1 … H) -H #V0s #Y #HV0s #HY #H destruct
   elim (lifts_inv_flat1 … HY) -HY #W0 #T0 #HW0 #HT0 #H destruct
-  @(s6 … IHA … (V0 :: V0s)) /2 width=6 by rp_lifts/ /3 width=4/
+  @(s6 … IHA … (V0 @ V0s)) /2 width=6 by rp_lifts/ /3 width=4/
 | /3 width=7/
 ]
 qed.
diff --git a/matita/matita/contribs/lambda_delta/basic_2/computation/cprs_delift.ma b/matita/matita/contribs/lambda_delta/basic_2/computation/cprs_delift.ma
new file mode 100644 (file)
index 0000000..65488a7
--- /dev/null
@@ -0,0 +1,30 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM team.                                      *)
+(*      ||A||         http://helm.cs.unibo.it                             *)
+(*      \   /                                                             *)
+(*       \ /        This file is distributed under the terms of the       *)
+(*        v         GNU General Public License Version 2                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+include "basic_2/reducibility/cpr_delift.ma".
+include "basic_2/computation/cprs.ma".
+
+(* CONTEXT-SENSITIVE PARALLEL COMPUTATION ON TERMS **************************)
+
+(* Properties on inverse basic term relocation ******************************)
+
+(* Basic_1: was only: pr3_gen_cabbr *)
+lemma thin_cprs_delift_conf: ∀L,U1,U2. L ⊢ U1 ➡* U2 →
+                             ∀K,d,e. L [d, e] ≡ K → ∀T1. L ⊢ U1 [d, e] ≡ T1 →
+                             ∃∃T2. K ⊢ T1 ➡* T2 & L ⊢ U2 [d, e] ≡ T2.
+#L #U1 #U2 #H @(cprs_ind … H) -U2 /2 width=3/
+#U #U2 #_ #HU2 #IHU1 #K #d #e #HLK #T1 #HTU1
+elim (IHU1 … HLK … HTU1) -U1 #T #HT1 #HUT
+elim (thin_cpr_delift_conf … HU2 … HLK … HUT) -U -HLK /3 width=3/
+qed.
index 3aa7170f50da7ca220c06e2c529fa290cf4636b6..e1a64150599580ba687f254c81f3e33ce4ebe60c 100644 (file)
@@ -81,7 +81,7 @@ lapply (csn_appl_theta … HW12 … H) -H -HW12 #H
 lapply (csn_fwd_pair_sn … H) #HW1
 lapply (csn_fwd_flat_dx … H) #H1
 @csn_appl_simple_tstc // -HW1 /2 width=3/ -IHV12s -HV -H1 #X #H1 #H2
-elim (cprs_fwd_theta_vector … (V2::V2s) … H1) -H1 /2 width=1/ -HV12s -HV12
+elim (cprs_fwd_theta_vector … (V2@V2s) … H1) -H1 /2 width=1/ -HV12s -HV12
 [ -H #H elim (H2 ?) -H2 //
 | -H2 #H1 @(csn_cprs_trans … H) -H /2 width=1/
 ]
index a8663d8ba7138e98830de9c1048d0ef95229c4bd..92aae546597bc4f10801ceec56163efd70575b8f 100644 (file)
@@ -26,5 +26,5 @@ interpretation
 
 (* Basic inversion lemmas ***************************************************)
 
-lemma csnv_inv_cons: ∀L,T,Ts. L ⊢ ⬇* T :: Ts → L ⊢ ⬇* T ∧ L ⊢ ⬇* Ts.
+lemma csnv_inv_cons: ∀L,T,Ts. L ⊢ ⬇* T @ Ts → L ⊢ ⬇* T ∧ L ⊢ ⬇* Ts.
 normalize // qed-.
diff --git a/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_alt.ma b/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_alt.ma
new file mode 100644 (file)
index 0000000..9c15674
--- /dev/null
@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM 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/equivalence/cpcs_cpcs.ma".
+include "basic_2/dynamic/nta.ma".
+
+(* NATIVE TYPE ASSIGNMENT ON TERMS ******************************************)
+
+(* alternative definition of nta *)
+inductive ntaa (h:sh): lenv → relation term ≝
+| ntaa_sort: ∀L,k. ntaa h L (⋆k) (⋆(next h k))
+| ntaa_ldef: ∀L,K,V,W,U,i. ⇩[0, i] L ≡ K. ⓓV → ntaa h K V W →
+             ⇧[0, i + 1] W ≡ U → ntaa h L (#i) U
+| ntaa_ldec: ∀L,K,W,V,U,i. ⇩[0, i] L ≡ K. ⓛW → ntaa h K W V →
+             ⇧[0, i + 1] W ≡ U → ntaa h L (#i) U
+| ntaa_bind: ∀I,L,V,W,T,U. ntaa h L V W → ntaa h (L. ⓑ{I} V) T U →
+             ntaa h L (ⓑ{I}V.T) (ⓑ{I}V.U)
+| ntaa_appl: ∀L,V,W,T,U. ntaa h L V W → ntaa h L (ⓛW.T) (ⓛW.U) →
+             ntaa h L (ⓐV.ⓛW.T) (ⓐV.ⓛW.U)
+| ntaa_pure: ∀L,V,W,T,U. ntaa h L T U → ntaa h L (ⓐV.U) W →
+             ntaa h L (ⓐV.T) (ⓐV.U)
+| ntaa_cast: ∀L,T,U,W. ntaa h L T U → ntaa h L U W → ntaa h L (ⓣU. T) U
+| ntaa_conv: ∀L,T,U1,U2,V2. ntaa h L T U1 → L ⊢ U1 ⬌* U2 → ntaa h L U2 V2 →
+             ntaa h L T U2
+.
+
+interpretation "native type assignment (term) alternative"
+   'NativeTypeAlt h L T U = (ntaa h L T U).
+
+(* Advanced inversion lemmas ************************************************)
+
+fact ntaa_inv_bind1_aux: ∀h,L,T,U. ⦃h, L⦄ ⊢ T :: U → ∀J,X,Y. T = ⓑ{J}Y.X →
+                         ∃∃Z1,Z2. ⦃h, L⦄ ⊢ Y :: Z1 & ⦃h, L.ⓑ{J}Y⦄ ⊢ X :: Z2 &
+                                  L ⊢ ⓑ{J}Y.Z2 ⬌* U.
+#h #L #T #U #H elim H -L -T -U
+[ #L #k #J #X #Y #H destruct
+| #L #K #V #W #U #i #_ #_ #_ #_ #J #X #Y #H destruct
+| #L #K #W #V #U #i #_ #_ #_ #_ #J #X #Y #H destruct
+| #I #L #V #W #T #U #HVW #HTU #_ #_ #J #X #Y #H destruct /2 width=3/
+| #L #V #W #T #U #_ #_ #_ #_ #J #X #Y #H destruct
+| #L #V #W #T #U #_ #_ #_ #_ #J #X #Y #H destruct
+| #L #T #U #W #_ #_ #_ #_ #J #X #Y #H destruct
+| #L #T #U1 #U2 #V2 #_ #HU12 #_ #IHTU1 #_ #J #X #Y #H destruct
+  elim (IHTU1 ????) -IHTU1 [5: // |2,3,4: skip ] #Z1 #Z2 #HZ1 #HZ2 #HU1
+  lapply (cpcs_trans … HU1 … HU12) -U1 /2 width=3/
+]
+qed.
+
+lemma ntaa_inv_bind1: ∀h,J,L,Y,X,U. ⦃h, L⦄ ⊢ ⓑ{J}Y.X :: U →
+                      ∃∃Z1,Z2. ⦃h, L⦄ ⊢ Y :: Z1 & ⦃h, L.ⓑ{J}Y⦄ ⊢ X :: Z2 &
+                               L ⊢ ⓑ{J}Y.Z2 ⬌* U.
+/2 width=3/ qed-.                            
+
+lemma ntaa_nta: ∀h,L,T,U. ⦃h, L⦄ ⊢ T :: U → ⦃h, L⦄ ⊢ T : U.
+#h #L #T #U #H elim H -L -T -U
+// /2 width=1/ /2 width=2/ /2 width=3/ /2 width=6/
+qed-.
+
+(* Properties on relocation *************************************************)
+
+lemma ntaa_lift: ∀h,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 :: U1 → ∀L2,d,e. ⇩[d, e] L2 ≡ L1 →
+                 ∀T2. ⇧[d, e] T1 ≡ T2 → ∀U2. ⇧[d, e] U1 ≡ U2 → ⦃h, L2⦄ ⊢ T2 :: U2.
+#h #L1 #T1 #U1 #H elim H -L1 -T1 -U1
+[ #L1 #k #L2 #d #e #HL21 #X1 #H1 #X2 #H2
+  >(lift_inv_sort1 … H1) -X1
+  >(lift_inv_sort1 … H2) -X2 //
+| #L1 #K1 #V1 #W1 #W #i #HLK1 #_ #HW1 #IHVW1 #L2 #d #e #HL21 #X #H #U2 #HWU2
+  elim (lift_inv_lref1 … H) * #Hid #H destruct
+  [ elim (lift_trans_ge … HW1 … HWU2 ?) -W // #W2 #HW12 #HWU2
+    elim (ldrop_trans_le … HL21 … HLK1 ?) -L1 /2 width=2/ #X #HLK2 #H
+    elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K2 #V2 #HK21 #HV12 #H destruct
+    /3 width=8/
+  | lapply (lift_trans_be … HW1 … HWU2 ? ?) -W // /2 width=1/ #HW1U2
+    lapply (ldrop_trans_ge … HL21 … HLK1 ?) -L1 // -Hid /3 width=8/
+  ]
+| #L1 #K1 #W1 #V1 #W #i #HLK1 #_ #HW1 #IHWV1 #L2 #d #e #HL21 #X #H #U2 #HWU2
+  elim (lift_inv_lref1 … H) * #Hid #H destruct
+  [ elim (lift_trans_ge … HW1 … HWU2 ?) -W // <minus_plus #W #HW1 #HWU2
+    elim (ldrop_trans_le … HL21 … HLK1 ?) -L1 /2 width=2/ #X #HLK2 #H
+    elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K2 #W2 #HK21 #HW12 #H destruct
+    lapply (lift_mono … HW1 … HW12) -HW1 #H destruct
+    elim (lift_total V1 (d-i-1) e) /3 width=8/
+  | lapply (lift_trans_be … HW1 … HWU2 ? ?) -W // /2 width=1/ #HW1U2
+    lapply (ldrop_trans_ge … HL21 … HLK1 ?) -L1 // -Hid /3 width=8/
+  ]
+| #I #L1 #V1 #W1 #T1 #U1 #_ #_ #IHVW1 #IHTU1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
+  elim (lift_inv_bind1 … H1) -H1 #V2 #T2 #HV12 #HT12 #H destruct
+  elim (lift_inv_bind1 … H2) -H2 #X #U2 #H1 #HU12 #H2 destruct
+  lapply (lift_mono … H1 … HV12) -H1 #H destruct
+  elim (lift_total W1 d e) /4 width=6/
+| #L1 #V1 #W1 #T1 #U1 #_ #_ #IHVW1 #IHTU1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
+  elim (lift_inv_flat1 … H1) -H1 #V2 #X #HV12 #H1 #H destruct
+  elim (lift_inv_bind1 … H1) -H1 #W2 #T2 #HW12 #HT12 #H destruct
+  elim (lift_inv_flat1 … H2) -H2 #Y2 #X #HY #H2 #H destruct
+  elim (lift_inv_bind1 … H2) -H2 #X2 #U2 #HX #HU12 #H destruct
+  lapply (lift_mono … HY … HV12) -HY #H destruct
+  lapply (lift_mono … HX … HW12) -HX #H destruct /4 width=6/
+| #L1 #V1 #W1 #T1 #U1 #_ #_ #IHTU1 #IHUW1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
+  elim (lift_inv_flat1 … H1) -H1 #V2 #T2 #HV12 #HT12 #H destruct
+  elim (lift_inv_flat1 … H2) -H2 #X #U2 #H1 #HU12 #H2 destruct
+  lapply (lift_mono … H1 … HV12) -H1 #H destruct
+  elim (lift_total W1 d e) /4 width=6/
+| #L1 #T1 #U1 #W1 #_ #_ #IHTU1 #IHUW1 #L2 #d #e #HL21 #X #H #U2 #HU12
+  elim (lift_inv_flat1 … H) -H #X2 #T2 #HUX2 #HT12 #H destruct
+  lapply (lift_mono … HUX2 … HU12) -HUX2 #H destruct
+  elim (lift_total W1 d e) /3 width=6/
+| #L1 #T1 #U11 #U12 #V12 #_ #HU112 #_ #IHTU11 #IHUV12 #L2 #d #e #HL21 #U1 #HTU1 #U2 #HU12
+  elim (lift_total U11 d e) #U #HU11
+  elim (lift_total V12 d e) #V22 #HV122
+  lapply (cpcs_lift … HL21 … HU11 … HU12 HU112) -HU112 /3 width=6/
+]
+qed.
+
+(* Advanced forvard lemmas **************************************************)
+
+lemma ntaa_fwd_correct: ∀h,L,T,U. ⦃h, L⦄ ⊢ T :: U → ∃T0. ⦃h, L⦄ ⊢ U :: T0.
+#h #L #T #U #H elim H -L -T -U
+[ /2 width=2/
+| #L #K #V #W #W0 #i #HLK #_ #HW0 * #V0 #HWV0
+  lapply (ldrop_fwd_ldrop2 … HLK) -HLK #HLK
+  elim (lift_total V0 0 (i+1)) /3 width=10/
+| #L #K #W #V #V0 #i #HLK #HWV #HWV0 #_
+  lapply (ldrop_fwd_ldrop2 … HLK) -HLK #HLK
+  elim (lift_total V 0 (i+1)) /3 width=10/
+| #I #L #V #W #T #U #HVW #_ #_ * /3 width=2/
+| #L #V #W #T #U #HVW #_ #_ * #X #H
+  elim (ntaa_inv_bind1 … H) -H /4 width=2/
+| #L #V #W #T #U #_ #HUW * #T0 #HUT0 /3 width=2/
+| /2 width=2/
+| /2 width=2/
+]
+qed-.
+
+(* Advanced properties ******************************************************)
+
+lemma nta_ntaa: ∀h,L,T,U. ⦃h, L⦄ ⊢ T : U → ⦃h, L⦄ ⊢ T :: U.
+#h #L #T #U #H elim H -L -T -U
+// /2 width=1/ /2 width=2/ /2 width=3/ /2 width=6/
+#L #T #U #_ #HTU
+elim (ntaa_fwd_correct … HTU) /2 width=2/
+qed.
+
+(* Advanced eliminators *****************************************************)
+
+lemma nta_ind_alt: ∀h. ∀R:lenv→relation term.
+   (∀L,k. R L ⋆k ⋆(next h k)) →
+   (∀L,K,V,W,U,i.
+      ⇩[O, i] L ≡ K.ⓓV → ⦃h, K⦄ ⊢ V : W → ⇧[O, i + 1] W ≡ U →
+      R K V W → R L (#i) U 
+   ) →
+   (∀L,K,W,V,U,i.
+      ⇩[O, i] L ≡ K.ⓛW → ⦃h, K⦄ ⊢ W : V → ⇧[O, i + 1] W ≡ U →
+      R K W V → R L (#i) U
+   ) →
+   (∀I,L,V,W,T,U.
+      ⦃h, L⦄ ⊢ V : W → ⦃h, L.ⓑ{I}V⦄ ⊢ T : U →
+      R L V W → R (L.ⓑ{I}V) T U → R L (ⓑ{I}V.T) (ⓑ{I}V.U)
+   ) →
+   (∀L,V,W,T,U.
+      ⦃h, L⦄ ⊢ V : W → ⦃h, L⦄ ⊢ (ⓛW.T):(ⓛW.U) →
+      R L V W →R L (ⓛW.T) (ⓛW.U) →R L (ⓐV.ⓛW.T) (ⓐV.ⓛW.U)
+   ) →
+   (∀L,V,W,T,U.
+      ⦃h, L⦄ ⊢ T : U → ⦃h, L⦄ ⊢ (ⓐV.U) : W →
+      R L T U → R L (ⓐV.U) W → R L (ⓐV.T) (ⓐV.U)
+   ) →
+   (∀L,T,U,W.
+      ⦃h, L⦄ ⊢ T : U → ⦃h, L⦄ ⊢ U : W →
+      R L T U → R L U W → R L (ⓣU.T) U
+   ) →
+   (∀L,T,U1,U2,V2.
+      ⦃h, L⦄ ⊢ T : U1 → L ⊢ U1 ⬌* U2 → ⦃h, L⦄ ⊢ U2 : V2 →
+      R L T U1 →R L U2 V2 →R L T U2
+   ) →
+   ∀L,T,U. ⦃h, L⦄ ⊢ T : U → R L T U.
+#h #R #H1 #H2 #H3 #H4 #H5 #H6 #H7 #H8 #L #T #U #H elim (nta_ntaa … H) -L -T -U
+// /3 width=1 by ntaa_nta/ /3 width=3 by ntaa_nta/ /3 width=4 by ntaa_nta/
+/3 width=7 by ntaa_nta/
+qed-.
diff --git a/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_delift.ma b/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_delift.ma
new file mode 100644 (file)
index 0000000..e366950
--- /dev/null
@@ -0,0 +1,84 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM 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/delift_lift.ma".
+include "basic_2/unfold/thin_ldrop.ma".
+include "basic_2/equivalence/cpcs_delift.ma".
+include "basic_2/dynamic/nta_nta.ma".
+
+(* NATIVE TYPE ASSIGNMENT ON TERMS ******************************************)
+
+(* Properties on reverse basic term relocation ******************************)
+
+(* Basic_1: was only: ty3_gen_cabbr *)
+axiom thin_nta_delift_conf: ∀h,L1,T1,X1. ⦃h, L1⦄ ⊢ T1 : X1 →
+                            ∀L2,d,e. L1 [d, e] ≡ L2 →
+                            ∀T2. L1 ⊢ T1 [d, e] ≡ T2 →
+                            ∃∃U1,U2. ⦃h, L2⦄ ⊢ T2 : U2 & L1 ⊢ U1 [d, e] ≡ U2 &
+                                     L1 ⊢ U1 ⬌* X1.
+(*
+#h #L1 #T1 #U1 #H @(nta_ind_alt … H) -L1 -T1 -U1
+[ #L1 #k #L2 #d #e #HL12 #X #H
+  >(delift_inv_sort1 … H) -X /2 width=5/
+| #L1 #K1 #V1 #W1 #U1 #i #HLK1 #_ #HWU1 #IHVW1 #L2 #d #e #HL12 #X #H
+(*
+  elim (delift_inv_lref1 … H) -H *
+  [ #Hid #H destruct
+    elim (thin_ldrop_conf_le … HL12 … HLK1 ?) -HL12 /2 width=2/ #X #H #HLK2
+    lapply (ldrop_fwd_ldrop2 … HLK1) -HLK1 #HLK1
+    elim (thin_inv_delift1 … H ?) -H /2 width=1/ #K2 #V2 #HK12 #HV12 #H destruct
+    elim (IHVW1 … HK12 … HV12) -IHVW1 -HK12 -HV12 #W2 #HVW2 #HW12
+    elim (lift_total W2 0 (i+1)) #U2 #HWU2
+    @(ex2_1_intro … U2)
+    [ /2 width=6/
+    | -HVW2 -HLK2 
+    ]
+  |
+  |
+  ]
+*)
+|
+|
+|
+| #L1 #V1 #W1 #T1 #U1 #_ #_ #IHTU1 #IHVW1 #L2 #d #e #HL12 #X #H
+  elim (delift_inv_flat1 … H) -H #V2 #T2 #HV12 #HT12 #H destruct
+(*  
+  elim (IHTU1 … HL12 … HT12) -T1 #U2 #HTU2 #HU12
+  elim (IHVW1 … HL12 (ⓐV2.U2) ?) -IHVW1 -HL12
+  [ /3 width=5/ | /2 width=1/ ]
+*)
+| #L1 #T1 #X1 #Y1 #_ #_ #IHTX1 #IHXY1 #L2 #d #e #HL12 #X #H
+  elim (delift_inv_flat1 … H) -H #X2 #T2 #HX12 #HT12 #H destruct
+  elim (IHTX1 … HL12 … HT12) -T1 #U1 #U2 #HTU2 #HU12 #HUX1
+  elim (IHXY1 … HL12 … HX12) -IHXY1 #W1 #W2 #HXW2 #_ #_ -Y1 -W1
+  lapply (thin_cpcs_delift_mono … HUX1 … HL12 … HU12 … HX12) -HL12 -HX12 /4 width=5/
+| #L1 #T1 #X11 #X12 #V1 #_ #HX112 #_ #IHT1 #_ #L2 #d #e #HL12 #T2 #HT12
+  elim (IHT1 … HL12 … HT12) -T1 -HL12 #U21 #U22 #HTU22 #HU212 #HUX211
+  lapply (cpcs_trans … HUX211 … HX112) -X11 /2 width=5/
+]
+*)
+lemma nta_inv_lift1_delift: ∀h,L1,T1,X. ⦃h, L1⦄ ⊢ T1 : X →
+                            ∀L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀T2. ⇧[d, e] T2 ≡ T1 →
+                            ∃∃U1,U2. ⦃h, L2⦄ ⊢ T2 : U2 & L1 ⊢ U1 [d, e] ≡ U2 &
+                                     L1 ⊢ U1 ⬌* X.
+/3 width=3/ qed-.
+
+lemma nta_inv_lift1: ∀h,L1,T1,X. ⦃h, L1⦄ ⊢ T1 : X →
+                     ∀L2,d,e. ⇩[d, e] L1 ≡ L2 → ∀T2. ⇧[d, e] T2 ≡ T1 →
+                     ∃∃U1,U2. ⦃h, L2⦄ ⊢ T2 : U2 & ⇧[d, e] U2 ≡ U1 &
+                              L1 ⊢ U1 ⬌* X.
+#h #L1 #T1 #X #H #L2 #d #e #HL12 #T2 #HT21
+elim (nta_inv_lift1_delift … H … HL12 … HT21) -T1 -HL12 #U1 #U2 #HTU2 * #U #HU1 #HU2 #HU1X
+lapply (cpcs_cpr_conf … U … HU1X) -HU1X /2 width=3/ -U1 /2 width=5/
+qed-.
index 1bdb9b1ac3903c16cf28ef0cb5f03dfa844afa18..294c1710e8ea4388d279ac1acc50ee0926beadb7 100644 (file)
@@ -12,8 +12,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include "basic_2/equivalence/cpcs_cpcs.ma".
-include "basic_2/dynamic/nta.ma".
+include "basic_2/dynamic/nta_alt.ma".
 
 (* NATIVE TYPE ASSIGNMENT ON TERMS ******************************************)
 
@@ -70,28 +69,13 @@ lemma nta_inv_lref1: ∀h,L,U,i. ⦃h, L⦄ ⊢ #i : U →
                      ).
 /2 width=3/ qed-.
 
-fact nta_inv_bind1_aux: ∀h,L,T,U. ⦃h, L⦄ ⊢ T : U → ∀J,X,Y. T = ⓑ{J}Y.X →
-                        ∃∃Z1,Z2. ⦃h, L⦄ ⊢ Y : Z1 & ⦃h, L.ⓑ{J}Y⦄ ⊢ X : Z2 &
-                                 L ⊢ ⓑ{J}Y.Z2 ⬌* U.
-#h #L #T #U #H elim H -L -T -U
-[ #L #k #J #X #Y #H destruct
-| #L #K #V #W #U #i #_ #_ #_ #_ #J #X #Y #H destruct
-| #L #K #W #V #U #i #_ #_ #_ #_ #J #X #Y #H destruct
-| #I #L #V #W #T #U #HVW #HTU #_ #_ #J #X #Y #H destruct /2 width=3/
-| #L #V #W #T #U #_ #_ #_ #_ #J #X #Y #H destruct
-| #L #V #W #T #U #_ #_ #_ #_ #J #X #Y #H destruct
-| #L #T #U #_ #_ #J #X #Y #H destruct
-| #L #T #U1 #U2 #V2 #_ #HU12 #_ #IHTU1 #_ #J #X #Y #H destruct
-  elim (IHTU1 ????) -IHTU1 [5: // |2,3,4: skip ] #Z1 #Z2 #HZ1 #HZ2 #HU1
-  lapply (cpcs_trans … HU1 … HU12) -U1 /2 width=3/
-]
-qed.
-
 (* Basic_1: was: ty3_gen_bind *)
-lemma nta_inv_bind1: ∀h,J,L,Y,X,U. ⦃h, L⦄ ⊢ ⓑ{J}Y.X : U →
-                     ∃∃Z1,Z2. ⦃h, L⦄ ⊢ Y : Z1 & ⦃h, L.ⓑ{J}Y⦄ ⊢ X : Z2 &
-                              L ⊢ ⓑ{J}Y.Z2 ⬌* U.
-/2 width=3/ qed-.                            
+lemma nta_inv_bind1: ∀h,I,L,Y,X,U. ⦃h, L⦄ ⊢ ⓑ{I}Y.X : U →
+                     ∃∃Z1,Z2. ⦃h, L⦄ ⊢ Y : Z1 & ⦃h, L.ⓑ{I}Y⦄ ⊢ X : Z2 &
+                              L ⊢ ⓑ{I}Y.Z2 ⬌* U.
+#h #I #L #Y #X #U #H
+elim (ntaa_inv_bind1 … (nta_ntaa … H)) -H /3 width=3 by ntaa_nta, ex3_2_intro/
+qed-.
 
 fact nta_inv_cast1_aux: ∀h,L,T,U. ⦃h, L⦄ ⊢ T : U → ∀X,Y. T = ⓣY.X →
                      ⦃h, L⦄ ⊢ X : Y ∧ L ⊢ Y ⬌* U.
@@ -113,80 +97,33 @@ qed.
 lemma nta_inv_cast1: ∀h,L,X,Y,U. ⦃h, L⦄ ⊢ ⓣY.X : U →  ⦃h, L⦄ ⊢ X : Y ∧ L ⊢ Y ⬌* U.
 /2 width=3/ qed-.
 
-(* Properties on relocation *************************************************)
+(* Advanced forvard lemmas **************************************************)
 
-(* Basic_1: was: ty3_lift *)
-lemma nta_lift: ∀h,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 : U1 → ∀L2,d,e. ⇩[d, e] L2 ≡ L1 →
-                ∀T2. ⇧[d, e] T1 ≡ T2 → ∀U2. ⇧[d, e] U1 ≡ U2 → ⦃h, L2⦄ ⊢ T2 : U2.
-#h #L1 #T1 #U1 #H elim H -L1 -T1 -U1
-[ #L1 #k #L2 #d #e #HL21 #X1 #H1 #X2 #H2
-  >(lift_inv_sort1 … H1) -X1
-  >(lift_inv_sort1 … H2) -X2 //
-| #L1 #K1 #V1 #W1 #W #i #HLK1 #_ #HW1 #IHVW1 #L2 #d #e #HL21 #X #H #U2 #HWU2
-  elim (lift_inv_lref1 … H) * #Hid #H destruct
-  [ elim (lift_trans_ge … HW1 … HWU2 ?) -W // #W2 #HW12 #HWU2
-    elim (ldrop_trans_le … HL21 … HLK1 ?) -L1 /2 width=2/ #X #HLK2 #H
-    elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K2 #V2 #HK21 #HV12 #H destruct
-    /3 width=8/
-  | lapply (lift_trans_be … HW1 … HWU2 ? ?) -W // /2 width=1/ #HW1U2
-    lapply (ldrop_trans_ge … HL21 … HLK1 ?) -L1 // -Hid /3 width=8/
-  ]
-| #L1 #K1 #W1 #V1 #W #i #HLK1 #_ #HW1 #IHWV1 #L2 #d #e #HL21 #X #H #U2 #HWU2
-  elim (lift_inv_lref1 … H) * #Hid #H destruct
-  [ elim (lift_trans_ge … HW1 … HWU2 ?) -W // <minus_plus #W #HW1 #HWU2
-    elim (ldrop_trans_le … HL21 … HLK1 ?) -L1 /2 width=2/ #X #HLK2 #H
-    elim (ldrop_inv_skip2 … H ?) -H /2 width=1/ -Hid #K2 #W2 #HK21 #HW12 #H destruct
-    lapply (lift_mono … HW1 … HW12) -HW1 #H destruct
-    elim (lift_total V1 (d-i-1) e) /3 width=8/
-  | lapply (lift_trans_be … HW1 … HWU2 ? ?) -W // /2 width=1/ #HW1U2
-    lapply (ldrop_trans_ge … HL21 … HLK1 ?) -L1 // -Hid /3 width=8/
-  ]
-| #I #L1 #V1 #W1 #T1 #U1 #_ #_ #IHVW1 #IHTU1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
-  elim (lift_inv_bind1 … H1) -H1 #V2 #T2 #HV12 #HT12 #H destruct
-  elim (lift_inv_bind1 … H2) -H2 #X #U2 #H1 #HU12 #H2 destruct
-  lapply (lift_mono … H1 … HV12) -H1 #H destruct
-  elim (lift_total W1 d e) /4 width=6/
-| #L1 #V1 #W1 #T1 #U1 #_ #_ #IHVW1 #IHTU1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
-  elim (lift_inv_flat1 … H1) -H1 #V2 #X #HV12 #H1 #H destruct
-  elim (lift_inv_bind1 … H1) -H1 #W2 #T2 #HW12 #HT12 #H destruct
-  elim (lift_inv_flat1 … H2) -H2 #Y2 #X #HY #H2 #H destruct
-  elim (lift_inv_bind1 … H2) -H2 #X2 #U2 #HX #HU12 #H destruct
-  lapply (lift_mono … HY … HV12) -HY #H destruct
-  lapply (lift_mono … HX … HW12) -HX #H destruct /4 width=6/
-| #L1 #V1 #W1 #T1 #U1 #_ #_ #IHTU1 #IHUW1 #L2 #d #e #HL21 #X1 #H1 #X2 #H2
-  elim (lift_inv_flat1 … H1) -H1 #V2 #T2 #HV12 #HT12 #H destruct
-  elim (lift_inv_flat1 … H2) -H2 #X #U2 #H1 #HU12 #H2 destruct
-  lapply (lift_mono … H1 … HV12) -H1 #H destruct
-  elim (lift_total W1 d e) /4 width=6/
-| #L1 #T1 #U1 #_ #IHTU1 #L2 #d #e #HL21 #X #H #U2 #HU12
-  elim (lift_inv_flat1 … H) -H #X2 #T2 #HUX2 #HT12 #H destruct
-  lapply (lift_mono … HUX2 … HU12) -HUX2 #H destruct /3 width=5/
-| #L1 #T1 #U11 #U12 #V12 #_ #HU112 #_ #IHTU11 #IHUV12 #L2 #d #e #HL21 #U1 #HTU1 #U2 #HU12
-  elim (lift_total U11 d e) #U #HU11
-  elim (lift_total V12 d e) #V22 #HV122
-  lapply (cpcs_lift … HL21 … HU11 … HU12 HU112) -HU112 /3 width=6/
+fact nta_fwd_appl1_aux: ∀h,L,T,U. ⦃h, L⦄ ⊢ T : U → ∀X,Y. T = ⓐY.X →
+                        ∃∃V,W. ⦃h, L⦄ ⊢ Y : W & ⦃h, L⦄ ⊢ X : V & L ⊢ ⓐY.V ⬌* U.
+#h #L #T #U #H elim H -L -T -U
+[ #L #k #X #Y #H destruct
+| #L #K #V #W #U #i #_ #_ #_ #_ #X #Y #H destruct
+| #L #K #W #V #U #i #_ #_ #_ #_ #X #Y #H destruct
+| #I #L #V #W #T #U #_ #_ #_ #_ #X #Y #H destruct
+| #L #V #W #T #U #HVW #HTU #_ #_ #X #Y #H destruct /2 width=3/
+| #L #V #W #T #U #HTU #_ #_ #IHUW #X #Y #H destruct
+  elim (IHUW U Y ?) -IHUW // /2 width=3/
+| #L #T #U #_ #_ #X #Y #H destruct
+| #L #T #U1 #U2 #V2 #_ #HU12 #_ #IHTU1 #_ #X #Y #H destruct
+  elim (IHTU1 ???) -IHTU1 [4: // |2,3: skip ] #V #W #HYW #HXV #HU1
+  lapply (cpcs_trans … HU1 … HU12) -U1 /2 width=3/
 ]
 qed.
 
-(* Advanced forvard lemmas **************************************************)
+lemma nta_fwd_appl1: ∀h,L,X,Y,U. ⦃h, L⦄ ⊢ ⓐY.X : U →
+                     ∃∃V,W. ⦃h, L⦄ ⊢ Y : W & ⦃h, L⦄ ⊢ X : V & L ⊢ ⓐY.V ⬌* U.
+/2 width=3/ qed-.
 
 (* Basic_1: was: ty3_correct *)
 lemma nta_fwd_correct: ∀h,L,T,U. ⦃h, L⦄ ⊢ T : U → ∃T0. ⦃h, L⦄ ⊢ U : T0.
-#h #L #T #U #H elim H -L -T -U
-[ /2 width=2/
-| #L #K #V #W #W0 #i #HLK #_ #HW0 * #V0 #HWV0
-  lapply (ldrop_fwd_ldrop2 … HLK) -HLK #HLK
-  elim (lift_total V0 0 (i+1)) /3 width=10/
-| #L #K #W #V #V0 #i #HLK #HWV #HWV0 #_
-  lapply (ldrop_fwd_ldrop2 … HLK) -HLK #HLK
-  elim (lift_total V 0 (i+1)) /3 width=10/
-| #I #L #V #W #T #U #HVW #_ #_ * /3 width=2/
-| #L #V #W #T #U #HVW #_ #_ * #X #H
-  elim (nta_inv_bind1 … H) -H /4 width=2/
-| #L #V #W #T #U #_ #HUW * #T0 #HUT0 /3 width=2/
-| #L #T #U #_ * /2 width=2/
-| /2 width=2/
-]
+#h #L #T #U #H
+elim (ntaa_fwd_correct … (nta_ntaa … H)) -H /3 width=2 by ntaa_nta, ex_intro/
 qed-.
 
 (* Advanced properties ******************************************************)
@@ -198,3 +135,10 @@ lemma nta_appl_old: ∀h,L,V,W,T,U. ⦃h, L⦄ ⊢ V : W → ⦃h, L⦄ ⊢ T :
 elim (nta_fwd_correct … HTU) #X #H
 elim (nta_inv_bind1 … H) -H /4 width=2/
 qed.
+
+(* Properties on relocation *************************************************)
+
+(* Basic_1: was: ty3_lift *)
+lemma nta_lift: ∀h,L1,T1,U1. ⦃h, L1⦄ ⊢ T1 : U1 → ∀L2,d,e. ⇩[d, e] L2 ≡ L1 →
+                ∀T2. ⇧[d, e] T1 ≡ T2 → ∀U2. ⇧[d, e] U1 ≡ U2 → ⦃h, L2⦄ ⊢ T2 : U2.
+/4 width=9 by ntaa_nta, nta_ntaa, ntaa_lift/ qed.
diff --git a/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_nta.ma b/matita/matita/contribs/lambda_delta/basic_2/dynamic/nta_nta.ma
new file mode 100644 (file)
index 0000000..f0bf711
--- /dev/null
@@ -0,0 +1,59 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM team.                                      *)
+(*      ||A||         http://helm.cs.unibo.it                             *)
+(*      \   /                                                             *)
+(*       \ /        This file is distributed under the terms of the       *)
+(*        v         GNU General Public License Version 2                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+include "basic_2/dynamic/nta_lift.ma".
+
+(* NATIVE TYPE ASSIGNMENT ON TERMS ******************************************)
+
+(* Main properties **********************************************************)
+
+(* Basic_1: was: ty3_unique *)
+theorem nta_mono: ∀h,L,T,U1. ⦃h, L⦄ ⊢ T : U1 → ∀U2. ⦃h, L⦄ ⊢ T : U2 →
+                  L ⊢ U1 ⬌* U2.
+#h #L #T #U1 #H elim H -L -T -U1
+[ #L #k #X #H
+  lapply (nta_inv_sort1 … H) -H //
+| #L #K #V #W11 #W12 #i #HLK #_ #HW112 #IHVW11 #X #H
+  elim (nta_inv_lref1 … H) -H * #K0 #V0 #W21 #W22 #HLK0 #HVW21 #HW212 #HX
+  lapply (ldrop_mono … HLK0 … HLK) -HLK0 #H destruct
+  lapply (ldrop_fwd_ldrop2 … HLK) -HLK #HLK
+  @(cpcs_trans … HX) -X /3 width=9 by cpcs_lift/ (**) (* to slow without trace *)
+| #L #K #W #V1 #V #i #HLK #_ #HWV #_ #X #H
+  elim (nta_inv_lref1 … H) -H * #K0 #W0 #V2 #V0 #HLK0 #_ #HWV0 #HX
+  lapply (ldrop_mono … HLK0 … HLK) -HLK0 -HLK #H destruct
+  lapply (lift_mono … HWV0 … HWV) -HWV0 -HWV #H destruct //
+| #I #L #V #W1 #T #U1 #_ #_ #_ #IHTU1 #X #H
+  elim (nta_inv_bind1 … H) -H #W2 #U2 #_ #HTU2 #H
+  @(cpcs_trans … H) -X /3 width=1/
+| #L #V #W1 #T #U1 #_ #_ #_ #IHTU1 #X #H
+  elim (nta_fwd_appl1 … H) -H #U2 #W2 #_ #HTU2 #H
+  @(cpcs_trans … H) -X /3 width=1/
+| #L #V #W1 #T #U1 #_ #_ #IHTU1 #_ #X #H
+  elim (nta_fwd_appl1 … H) -H #U2 #W2 #_ #HTU2 #H
+  @(cpcs_trans … H) -X /3 width=1/
+| #L #T #U1 #_ #_ #X #H
+  elim (nta_inv_cast1 … H) -H //
+| #L #T #U11 #U12 #V12 #_ #HU112 #_ #IHTU11 #_ #U2 #HTU2
+  @(cpcs_canc_sn … HU112) -U12 /2 width=1/
+]
+qed-.
+
+(* Advanced properties ******************************************************)
+
+lemma nta_cast_alt: ∀h,L,T,W,U. ⦃h, L⦄ ⊢ T : W → ⦃h, L⦄ ⊢ T : U →
+             ⦃h, L⦄ ⊢ ⓣW.T : U.
+#h #L #T #W #U #HTW #HTU
+lapply (nta_mono … HTW … HTU) #HWU
+elim (nta_fwd_correct … HTU) -HTU /3 width=3/
+qed.
index e38825fe1a2bbf1ad0a83143b4c2b0c7cfd1cc2a..5ee8d16966f881ba137b25ccb035aed17f9f8840 100644 (file)
@@ -43,6 +43,9 @@ qed-.
 lemma cpcs_refl: ∀L,T. L ⊢ T ⬌* T.
 /2 width=1/ qed.
 
+lemma cpcs_sym: ∀L,T1,T2. L ⊢ T1 ⬌* T2 → L ⊢ T2 ⬌* T1.
+/3 width=1/ qed.
+
 lemma cpcs_strap1: ∀L,T1,T,T2. L ⊢ T1 ⬌* T → L ⊢ T ⬌ T2 → L ⊢ T1 ⬌* T2.
 /2 width=3/ qed.
 
diff --git a/matita/matita/contribs/lambda_delta/basic_2/equivalence/cpcs_delift.ma b/matita/matita/contribs/lambda_delta/basic_2/equivalence/cpcs_delift.ma
new file mode 100644 (file)
index 0000000..58697b9
--- /dev/null
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM team.                                      *)
+(*      ||A||         http://helm.cs.unibo.it                             *)
+(*      \   /                                                             *)
+(*       \ /        This file is distributed under the terms of the       *)
+(*        v         GNU General Public License Version 2                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+include "basic_2/unfold/delift_delift.ma".
+include "basic_2/computation/cprs_delift.ma".
+include "basic_2/equivalence/cpcs_cpcs.ma".
+
+(* CONTEXT-SENSITIVE PARALLEL EQUIVALENCE ON TERMS **************************)
+
+(* Properties on inverse basic term relocation ******************************)
+
+(* Basic_1: was only: pc3_gen_cabbr *)
+lemma thin_cpcs_delift_mono: ∀L,U1,U2. L ⊢ U1 ⬌* U2 →
+                             ∀K,d,e. L [d, e] ≡ K → ∀T1. L ⊢ U1 [d, e] ≡ T1 →
+                             ∀T2. L ⊢ U2 [d, e] ≡ T2 → K ⊢ T1 ⬌* T2.
+#L #U1 #U2 #H #K #d #e #HLK #T1 #HTU1 #T2 #HTU2
+elim (cpcs_inv_cprs … H) -H #U #HU1 #HU2
+elim (thin_cprs_delift_conf … HU1 … HLK … HTU1) -U1 #T #HT1 #HUT
+elim (thin_cprs_delift_conf … HU2 … HLK … HTU2) -U2 -HLK #X #HT2 #H
+lapply (delift_mono … H … HUT) -L #H destruct /2 width=3/
+qed.
index e3dee1e0bac03c0764bf5854c1b1a9fdc3d25160..69f76386b5b59b3a04b0cf34dc50cc6ae1c8e18f 100644 (file)
@@ -35,7 +35,7 @@ lemma cw_shift: ∀K,I,V,T. #[K. ⓑ{I} V, T] < #[K, ②{I} V. T].
 normalize //
 qed.
 
-lemma tw_shift: ∀L,T. #[L, T] ≤ #[L @ T].
+lemma tw_shift: ∀L,T. #[L, T] ≤ #[L @@ T].
 #L elim L //
 #K #I #V #IHL #T
 @transitive_le [3: @IHL |2: /2 width=2/ | skip ]
index ae40690e7d1c5244358bff126bab163720f4d6fb..1e1daa375fff6dc7d4de6d56da76cde95d55153a 100644 (file)
@@ -346,6 +346,10 @@ notation "hvbox( ⦃ h , break L ⦄ ⊢ break term 46 T1 : break term 46 T2 )"
    non associative with precedence 45
    for @{ 'NativeType $h $L $T1 $T2 }.
 
+notation "hvbox( ⦃ h , break L ⦄ ⊢ break term 46 T1 :: break term 46 T2 )"
+   non associative with precedence 45
+   for @{ 'NativeTypeAlt $h $L $T1 $T2 }.
+
 notation "hvbox( h ⊢ break term 46 L1 : ⊑ break term 46 L2 )"
    non associative with precedence 45
    for @{ 'CrSubEqN $h $L1 $L2 }.
index 4fa94673eb8f97a7dcf89a9118bd3fc882fbce39..aadf05b82bf4d9775b47def00d1c0ab9019875dd 100644 (file)
@@ -43,7 +43,7 @@ qed.
 
 (* Advanced forward lemmas **************************************************)
 
-lemma cpr_shift_fwd: ∀L,T1,T2. L ⊢ T1 ➡ T2 → L @ T1 ➡ L @ T2.
+lemma cpr_shift_fwd: ∀L,T1,T2. L ⊢ T1 ➡ T2 → L @@ T1 ➡ L @@ T2.
 #L elim L -L
 [ #T1 #T2 #HT12 @(cpr_inv_atom … HT12)
 | normalize /3 width=1/
diff --git a/matita/matita/contribs/lambda_delta/basic_2/reducibility/cpr_delift.ma b/matita/matita/contribs/lambda_delta/basic_2/reducibility/cpr_delift.ma
new file mode 100644 (file)
index 0000000..7437e6a
--- /dev/null
@@ -0,0 +1,37 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM 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/thin_delift.ma".
+include "basic_2/reducibility/tpr_delift.ma".
+include "basic_2/reducibility/cpr.ma".
+
+(* CONTEXT-SENSITIVE PARALLEL REDUCTION ON TERMS ****************************)
+
+(* Properties on inverse basic term relocation ******************************)
+
+(* Basic_1: was only: pr2_gen_cabbr *)
+lemma thin_cpr_delift_conf: ∀L,U1,U2. L ⊢ U1 ➡ U2 →
+                            ∀K,d,e. L [d, e] ≡ K → ∀T1. L ⊢ U1 [d, e] ≡ T1 →
+                            ∃∃T2. K ⊢ T1 ➡ T2 & L ⊢ U2 [d, e] ≡ T2.
+#L #U1 #U2 * #U #HU1 #HU2 #K #d #e #HLK #T1 #HTU1
+elim (tpr_delift_conf … HU1 … HTU1) -U1 #T #HT1 #HUT
+elim (le_or_ge (|L|) d) #Hd
+[ elim (thin_delift_tpss_conf_le … HU2 … HUT … HLK ?)
+| elim (le_or_ge (|L|) (d+e)) #Hde
+  [ elim (thin_delift_tpss_conf_le_up … HU2 … HUT … HLK ? ? ?)
+  | elim (thin_delift_tpss_conf_be … HU2 … HUT … HLK ? ?)
+  ]
+] -U -HLK // -Hd [2,3: -Hde] #T2 #HT2
+lapply (cpr_intro … HT1 HT2) -T /2 width=3/
+qed.
diff --git a/matita/matita/contribs/lambda_delta/basic_2/reducibility/tpr_delift.ma b/matita/matita/contribs/lambda_delta/basic_2/reducibility/tpr_delift.ma
new file mode 100644 (file)
index 0000000..3cbff71
--- /dev/null
@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*       ___                                                              *)
+(*      ||M||                                                             *)
+(*      ||A||       A project by Andrea Asperti                           *)
+(*      ||T||                                                             *)
+(*      ||I||       Developers:                                           *)
+(*      ||T||         The HELM 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/delift.ma".
+include "basic_2/reducibility/tpr_tpss.ma".
+
+(* CONTEXT-FREE PARALLEL REDUCTION ON TERMS *********************************)
+
+(* Properties on inverse basic term relocation ******************************)
+
+lemma tpr_delift_conf: ∀U1,U2. U1 ➡ U2 → ∀L,T1,d,e. L ⊢ U1 [d, e] ≡ T1 →
+                       ∃∃T2. T1 ➡ T2 & L ⊢ U2 [d, e] ≡ T2.
+#U1 #U2 #HU12 #L #T1 #d #e * #W1 #HUW1 #HTW1
+elim (tpr_tpss_conf … HU12 … HUW1) -U1 #U1 #HWU1 #HU21
+elim (tpr_inv_lift … HWU1 … HTW1) -W1 /3 width=5/
+qed. 
index ec95afc02fd9e29cb097295469e13ac1f38dd6e5..40032ef8abf5184b0459e893010df61ab97703de 100644 (file)
@@ -91,3 +91,8 @@ lemma tpr_tpss_ltpr: ∀L1,L2. L1 ➡ L2 → ∀T1,T2. T1 ➡ T2 →
   lapply (tpss_trans_eq … HT2 … HTU2) -T /2 width=3/
 ]
 qed.
+
+lemma tpr_tpss_conf: ∀T1,T2. T1 ➡ T2 →
+                     ∀L,U1,d,e. L ⊢ T1 [d, e] ▶* U1 →
+                     ∃∃U2. U1 ➡ U2 & L ⊢ T2 [d, e] ▶* U2.
+/2 width=5/ qed. 
index d812f1cda8b3a94d8ffe71d90bdfcca90805bd52..35ecb653533012cf4692f4663a560bab3c1dbe35 100644 (file)
@@ -21,7 +21,7 @@ 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)
+              liftv d e (T1 @ T1s) (T2 @ T2s)
 .
 
 interpretation "relocation (vector)" 'RLift d e T1s T2s = (liftv d e T1s T2s).
@@ -37,18 +37,18 @@ 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 →
+                          ∀U1,U1s. T1s = U1 @ U1s →
                           ∃∃U2,U2s. ⇧[d, e] U1 ≡ U2 & ⇧[d, e] U1s ≡ U2s &
-                                    T2s = U2 :: 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 →
+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.
+                                 T2s = U2 @ U2s.
 /2 width=3/ qed-.
 
 (* Basic properties *********************************************************)
index 581f1fda5bf28546e707711bf83891cefe859f77..ce4c5815b5285c7ec69c3bab58a3da5632c0bd23 100644 (file)
@@ -262,10 +262,10 @@ qed.
                                         (le d i) -> (lt i (plus d h)) ->
                                        (EX u1 | t1 = (lift (minus (plus d h) (S i)) (S i) u1)).
 *)
-lemma tps_inv_lift1_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶ U2 →
-                        ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
-                        d ≤ dt → dt ≤ d + e → d + e ≤ dt + et →
-                        ∃∃T2. K ⊢ T1 [d, dt + et - (d + e)] ▶ T2 & ⇧[d, e] T2 ≡ U2.
+lemma tps_inv_lift1_ge_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶ U2 →
+                           ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
+                           d ≤ dt → dt ≤ d + e → d + e ≤ dt + et →
+                           ∃∃T2. K ⊢ T1 [d, dt + et - (d + e)] ▶ T2 & ⇧[d, e] T2 ≡ U2.
 #L #U1 #U2 #dt #et #HU12 #K #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet
 elim (tps_split_up … HU12 (d + e) ? ?) -HU12 // -Hdedet #U #HU1 #HU2
 lapply (tps_weak … HU1 d e ? ?) -HU1 // [ >commutative_plus /2 width=1/ ] -Hddt -Hdtde #HU1
@@ -281,3 +281,14 @@ lemma tps_inv_lift1_be_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶ U2 →
 lapply (tps_weak … HU12 dt (d + e - dt) ? ?) -HU12 // /2 width=3/ -Hdetde #HU12
 elim (tps_inv_lift1_be … HU12 … HLK … HTU1 ? ?) -U1 -L // /2 width=3/
 qed.
+
+lemma tps_inv_lift1_le_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶ U2 →
+                           ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
+                           dt ≤ d → d ≤ dt + et → dt + et ≤ d + e →
+                           ∃∃T2. K ⊢ T1 [dt, d - dt] ▶ T2 & ⇧[d, e] T2 ≡ U2.
+#L #U1 #U2 #dt #et #HU12 #K #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde
+elim (tps_split_up … HU12 d ? ?) -HU12 // #U #HU1 #HU2
+elim (tps_inv_lift1_le … HU1 … HLK … HTU1 ?) -U1 [2: >commutative_plus /2 width=1/ ] -Hdtd #T #HT1 #HTU
+lapply (tps_weak … HU2 d e ? ?) -HU2 // [ >commutative_plus <plus_minus_m_m // ] -Hddet -Hdetde #HU2
+lapply (tps_inv_lift1_eq … HU2 … HTU) -L #H destruct /2 width=3/
+qed.
index 7fbf16fbd8b339f5e2085881fe3d90b31776e01d..eb9124089f6163307954b27a7d141f78671588eb 100644 (file)
 
 include "basic_2/unfold/tpss.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
 definition delift: nat → nat → lenv → relation term ≝
                    λd,e,L,T1,T2. ∃∃T. L ⊢ T1 [d, e] ▶* T & ⇧[d, e] T2 ≡ T.
 
-interpretation "inverse relocation (term)"
+interpretation "inverse basic relocation (term)"
    'TSubst L T1 d e T2 = (delift d e L T1 T2).
 
 (* Basic properties *********************************************************)
index a53fd9f5dd7253dace4b41daa3d7abc25db46eda..25d13702aeb01b81747070d1305799ab987e8260 100644 (file)
@@ -14,9 +14,9 @@
 
 include "basic_2/unfold/delift_lift.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
-(* alternative definition of inverse relocation *)
+(* alternative definition of inverse basic term relocation *)
 inductive delifta: nat → nat → lenv → relation term ≝
 | delifta_sort   : ∀L,d,e,k. delifta d e L (⋆k) (⋆k)
 | delifta_lref_lt: ∀L,d,e,i. i < d → delifta d e L (#i) (#i)
@@ -33,7 +33,7 @@ inductive delifta: nat → nat → lenv → relation term ≝
                    delifta d e L (ⓕ{I} V1. T1) (ⓕ{I} V2. T2)
 .
 
-interpretation "inverse relocation (term) alternative"
+interpretation "inverse basic relocation (term) alternative"
    'TSubstAlt L T1 d e T2 = (delifta d e L T1 T2).
 
 (* Basic properties *********************************************************)
index a235016534e9823f9f3d50abe03f1a54d1232c30..753e88796c8ed9f6e54bc5cb1df5a24ad8c3103b 100644 (file)
@@ -15,7 +15,7 @@
 include "basic_2/unfold/tpss_tpss.ma".
 include "basic_2/unfold/delift.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
 (* Main properties **********************************************************)
 
index a7f31fb809643badd7894803607de1d22ed3d1d1..837e160e66440a7853c74e4a347a405bd648e8fd 100644 (file)
@@ -15,7 +15,7 @@
 include "basic_2/unfold/tpss_lift.ma".
 include "basic_2/unfold/delift.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
 (* Advanced properties ******************************************************)
 
@@ -28,7 +28,7 @@ lapply (lift_trans_be … HV2 … HVU ? ?) -HV2 // >minus_plus <plus_minus_m_m
 /2 width=1/ /3 width=6/
 qed.
  
-(* Advanced forward lemmas **************************************************)
+(* Advanced inversion lemmas ************************************************)
 
 lemma delift_inv_lref1_lt: ∀L,U2,i,d,e. L ⊢ #i [d, e] ≡ U2 → i < d → U2 = #i.
 #L #U2 #i #d #e * #U #HU #HU2 #Hid
@@ -82,7 +82,7 @@ elim (lt_or_ge i d) #Hdi
 ]
 qed-.
 
-(* Relocation properties ****************************************************)
+(* Properties on basic term relocation **************************************)
 
 lemma delift_lift_le: ∀K,T1,T2,dt,et. K ⊢ T1 [dt, et] ≡ T2 →
                       ∀L,U1,d,e. dt + et ≤ d → ⇩[d, e] L ≡ K →
index 7bcab46fa747d4ba4dc466ed0ab32a3ffa34d579..a6d39c1c9145a042fad5af7219f4a7c6574e9919 100644 (file)
@@ -15,7 +15,7 @@
 include "basic_2/unfold/ltpss_ltpss.ma".
 include "basic_2/unfold/delift.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
 (* Properties on partial unfold on local environments ***********************)
 
index b7bc126df8d48e8d78ce0f11be1be18a337e33c9..5ba077c6d45bb7d6b478f25558702650a85f7c8e 100644 (file)
 include "basic_2/unfold/tpss_tpss.ma".
 include "basic_2/unfold/delift.ma".
 
-(* INVERSE TERM RELOCATION  *************************************************)
+(* INVERSE BASIC TERM RELOCATION  *******************************************)
 
 (* Properties on partial unfold on terms ************************************)
 
+lemma delift_tpss_conf_le: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
+                           ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                           ∀K. ⇩[dd, ee] L ≡ K → d + e ≤ dd →
+                           ∃∃T2. K ⊢ T1 [d, e] ▶* T2 & L ⊢ U2 [dd, ee] ≡ T2.
+#L #U1 #U2 #d #e #HU12 #T1 #dd #ee * #X1 #HUX1 #HTX1 #K #HLK #H1
+elim (tpss_conf_eq … HU12 … HUX1) -U1 #U1 #HU21 #HXU1
+elim (tpss_inv_lift1_le … HXU1 … HLK … HTX1 ?) -X1 -HLK // -H1 /3 width=5/
+qed.
+
+lemma delift_tps_conf_le: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶ U2 →
+                          ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                          ∀K. ⇩[dd, ee] L ≡ K → d + e ≤ dd →
+                          ∃∃T2. K ⊢ T1 [d, e] ▶* T2 & L ⊢ U2 [dd, ee] ≡ T2.
+/3 width=3/ qed.
+
+lemma delift_tpss_conf_le_up: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
+                              ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                              ∀K. ⇩[dd, ee] L ≡ K →
+                              d ≤ dd → dd ≤ d + e → d + e ≤ dd + ee →
+                              ∃∃T2. K ⊢ T1 [d, dd - d] ▶* T2 &
+                                    L ⊢ U2 [dd, ee] ≡ T2.
+#L #U1 #U2 #d #e #HU12 #T1 #dd #ee * #X1 #HUX1 #HTX1 #K #HLK #H1 #H2 #H3
+elim (tpss_conf_eq … HU12 … HUX1) -U1 #U1 #HU21 #HXU1
+elim (tpss_inv_lift1_le_up … HXU1 … HLK … HTX1 ? ? ?) -X1 -HLK // -H1 -H2 -H3 /3 width=5/
+qed.
+
+lemma delift_tps_conf_le_up: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶ U2 →
+                             ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                             ∀K. ⇩[dd, ee] L ≡ K →
+                             d ≤ dd → dd ≤ d + e → d + e ≤ dd + ee →
+                             ∃∃T2. K ⊢ T1 [d, dd - d] ▶* T2 &
+                                   L ⊢ U2 [dd, ee] ≡ T2.
+/3 width=6/ qed.
+
 lemma delift_tpss_conf_be: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
                            ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
                            ∀K. ⇩[dd, ee] L ≡ K → d ≤ dd → dd + ee ≤ d + e →
@@ -26,7 +60,7 @@ lemma delift_tpss_conf_be: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
                                  L ⊢ U2 [dd, ee] ≡ T2.
 #L #U1 #U2 #d #e #HU12 #T1 #dd #ee * #X1 #HUX1 #HTX1 #K #HLK #H1 #H2
 elim (tpss_conf_eq … HU12 … HUX1) -U1 #U1 #HU21 #HXU1
-elim (tpss_inv_lift1_be … HXU1 … HLK … HTX1 ? ?) -X1 -HLK // /3 width=5/
+elim (tpss_inv_lift1_be … HXU1 … HLK … HTX1 ? ?) -X1 -HLK // -H1 -H2 /3 width=5/
 qed.
 
 lemma delift_tps_conf_be: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶ U2 →
index b8dab57aea8efc8659e9fd1c15028e9fd7a248af..1168e52dffd4860f5a76601ea844c1f7c9068cd5 100644 (file)
@@ -19,9 +19,9 @@ include "basic_2/grammar/term_vector.ma".
 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 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
+          at des (i1 + e) i2 → at ({d, e} @ des) i1 i2
 .
 
 interpretation "application (generic relocation with pairs)"
@@ -41,7 +41,7 @@ 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 →
+                      ∀d,e,des0. des = {d, e} @ des0 →
                       i1 < d ∧ @[i1] des0 ≡ i2 ∨
                       d ≤ i1 ∧ @[i1 + e] des0 ≡ i2.
 #des #i1 #i2 * -des -i1 -i2
@@ -51,12 +51,12 @@ fact at_inv_cons_aux: ∀des,i1,i2. @[i1] des ≡ i2 →
 ]
 qed.
 
-lemma at_inv_cons: ∀des,d,e,i1,i2. @[i1] {d, e} :: des ≡ i2 →
+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 →
+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
@@ -64,7 +64,7 @@ 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 →
+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
index 5287e0f664f044ecc54ce077b6b6d6b9103b8f8f..6138548cde489a0f34bd2c6d464b1cde337f3cde 100644 (file)
@@ -19,9 +19,9 @@ include "basic_2/unfold/gr2.ma".
 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 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
+              minuss i ({d, e} @ des1) des2
 .
 
 interpretation "minus (generic relocation with pairs)"
@@ -41,10 +41,10 @@ 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,e,des. des1 = {d, e} @ des →
                            d ≤ i ∧ des ▭ e + i ≡ des2 ∨
                            ∃∃des0. i < d & des ▭ i ≡ des0 &
-                                   des2 = {d - i, e} :: 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/
@@ -52,13 +52,13 @@ fact minuss_inv_cons1_aux: ∀des1,des2,i. des1 ▭ i ≡ des2 →
 ]
 qed.
 
-lemma minuss_inv_cons1: ∀des1,des2,d,e,i. {d, e} :: des1 ▭ i ≡ des2 →
+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.
+                               des2 = {d - i, e} @ des.
 /2 width=3/ qed-.
 
-lemma minuss_inv_cons1_ge: ∀des1,des2,d,e,i. {d, e} :: des1 ▭ i ≡ des2 →
+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
@@ -66,9 +66,9 @@ 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 →
+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.
+                           ∃∃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
index 6d66f0dabc57e8dea90ffb7ab183ad685e51dafb..bd8d1a9be416f9203208d8505408c1a116a2629d 100644 (file)
@@ -18,7 +18,7 @@ include "basic_2/unfold/gr2.ma".
 
 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
+| cons2 d e des ⇒ {d + i, e} @ pluss des i
 ].
 
 interpretation "plus (generic relocation with pairs)"
@@ -31,8 +31,8 @@ lemma pluss_inv_nil2: ∀i,des. des + i = ⟠ → des = ⟠.
 #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.
+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/ 
index 70c09b1f504ea414f99a2e5e668f2464f3dbc0ae..b899bd27383e2db78271ed88b6cc4210d522a1d3 100644 (file)
@@ -21,7 +21,7 @@ include "basic_2/unfold/lifts.ma".
 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
+               ldrops des L1 L → ⇩[d,e] L ≡ L2 → ldrops ({d, e} @ des) L1 L2
 .
 
 interpretation "generic local environment slicing"
@@ -39,7 +39,7 @@ 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 →
+                          ∀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
@@ -48,7 +48,7 @@ fact ldrops_inv_cons_aux: ∀L1,L2,des. ⇩*[des] L1 ≡ L2 →
 qed.
 
 (* Basic_1: was: drop1_gen_pcons *)
-lemma ldrops_inv_cons: ∀L1,L2,d,e,des. ⇩*[{d, e} :: des] L1 ≡ L2 →
+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-.
 
index 1cb1724fdaa2184d5633c842213ba89176f4cf5c..7709561a29f7fbbc1b9371d5e7c90d563eb41a7d 100644 (file)
@@ -20,6 +20,6 @@ include "basic_2/unfold/ldrops_ldrop.ma".
 
 (* Basic_1: was: drop1_trans *)
 theorem ldrops_trans: ∀L,L2,des2. ⇩*[des2] L ≡ L2 → ∀L1,des1. ⇩*[des1] L1 ≡ L →
-                      ⇩*[des2 @ des1] L1 ≡ L2.
+                      ⇩*[des2 @@ des1] L1 ≡ L2.
 #L #L2 #des2 #H elim H -L -L2 -des2 // /3 width=3/
 qed.
index 492ffdcbeb8fd3310eb853a96bf624e937c2fe14..3f26426e3db1c00518236d420078692b6b1b02c2 100644 (file)
@@ -20,7 +20,7 @@ include "basic_2/unfold/gr2_plus.ma".
 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
+              ⇧[d,e] T1 ≡ T → lifts des T T2 → lifts ({d, e} @ des) T1 T2
 .
 
 interpretation "generic relocation (term)"
@@ -37,7 +37,7 @@ 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 →
+                         ∀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
@@ -45,7 +45,7 @@ fact lifts_inv_cons_aux: ∀T1,T2,des. ⇧*[des] T1 ≡ T2 →
   /2 width=3/
 qed.
 
-lemma lifts_inv_cons: ∀T1,T2,d,e,des. ⇧*[{d, e} :: des] T1 ≡ T2 →
+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-.
 
index 0ea0a2186c46daedd367b2ab8001179788410cc4..72948f04b618bac45ab397b9c1efe8f451259a7f 100644 (file)
@@ -20,6 +20,6 @@ include "basic_2/unfold/lifts_lift.ma".
 
 (* 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.
+                     ⇧*[des1 @@ des2] T1 ≡ T2.
 #T1 #T #des1 #H elim H -T1 -T -des1 // /3 width=3/
 qed.
index 1690c9f6639c772281fabc0a70da8e29a0c5660c..9ea173a567a4f0a45d36f7f26d7193728402d864 100644 (file)
@@ -21,7 +21,7 @@ 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)
+               liftsv des (T1 @ T1s) (T2 @ T2s)
 .
 
 interpretation "generic relocation (vector)"
index 39d4d12c405f292063c49a67cb38ae2c3261b64b..d3eb56c8ef1fac86be3c272e28bdc9971aece7dc 100644 (file)
 
 include "basic_2/unfold/ltpss.ma".
 
-(* LOCAL ENVIRONMENT THINNING ***********************************************)
+(* BASIC LOCAL ENVIRONMENT THINNING *****************************************)
 
 definition thin: nat → nat → relation lenv ≝
                  λd,e,L1,L2. ∃∃L. L1 [d, e] ▶* L & ⇩[d, e] L ≡ L2.
 
-interpretation "thinning (local environment)"
+interpretation "basic thinning (local environment)"
    'TSubst L1 d e L2 = (thin d e L1 L2).
 
 (* Basic properties *********************************************************)
index a28bf53e8b6ea054704a1ec53ea5e5d450ed8f6e..0653266ee7fc1c818e63109cf4304f75556fafcd 100644 (file)
@@ -16,9 +16,21 @@ include "basic_2/unfold/delift_tpss.ma".
 include "basic_2/unfold/delift_ltpss.ma".
 include "basic_2/unfold/thin.ma".
 
-(* DELIFT ON LOCAL ENVIRONMENTS *********************************************)
+(* BASIC DELIFT ON LOCAL ENVIRONMENTS ***************************************)
 
-(* Properties on inverse term relocation ************************************)
+(* Inversion lemmas on inverse basic term relocation ************************)
+
+lemma thin_inv_delift1: ∀I,K1,V1,L2,d,e. K1. ⓑ{I} V1 [d, e] ≡ L2 → 0 < d →
+                        ∃∃K2,V2. K1 [d - 1, e] ≡ K2 &
+                                 K1 ⊢ V1 [d - 1, e] ≡ V2 &
+                                 L2 = K2. ⓑ{I} V2.
+#I #K1 #V1 #L2 #d #e * #X #HK1 #HL2 #e
+elim (ltpss_inv_tpss11 … HK1 ?) -HK1 // #K #V #HK1 #HV1 #H destruct
+elim (ldrop_inv_skip1 … HL2 ?) -HL2 // #K2 #V2 #HK2 #HV2 #H destruct
+lapply (ltpss_tpss_trans_eq … HV1 … HK1) -HV1 /3 width=5/
+qed-.
+
+(* Properties on inverse basic term relocation ******************************)
 
 lemma thin_delift1: ∀L1,L2,d,e. L1 [d, e] ≡ L2 → ∀V1,V2. L1 ⊢ V1 [d, e] ≡ V2 →
                     ∀I. L1.ⓑ{I}V1 [d + 1, e] ≡ L2.ⓑ{I}V2.
@@ -29,6 +41,48 @@ lapply (tpss_inv_refl_O2 … H1) -H1 #H destruct
 lapply (lift_mono … H2 … HV2) -H2 #H destruct /3 width=5/
 qed.
 
+lemma thin_delift_tpss_conf_le: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
+                                ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                                ∀K. L [dd, ee] ≡ K → d + e ≤ dd →
+                                ∃∃T2. K ⊢ T1 [d, e] ▶* T2 &
+                                      L ⊢ U2 [dd, ee] ≡ T2.
+#L #U1 #U2 #d #e #HU12 #T1 #dd #ee #HUT1 #K * #Y #HLY #HYK #Hdedd
+lapply (delift_ltpss_conf_eq … HUT1 … HLY) -HUT1 #HUT1
+elim (ltpss_tpss_conf … HU12 … HLY) -HU12 #U #HU1 #HU2
+elim (delift_tpss_conf_le … HU1 … HUT1 … HYK ?) -HU1 -HUT1 // -Hdedd #T #HT1 #HUT
+lapply (tpss_delift_trans_eq … HU2 … HUT) -U #HU2T
+lapply (ltpss_delift_trans_eq … HLY … HU2T) -Y /2 width=3/
+qed.
+
+lemma thin_delift_tps_conf_le: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶ U2 →
+                               ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                               ∀K. L [dd, ee] ≡ K → d + e ≤ dd →
+                               ∃∃T2. K ⊢ T1 [d, e] ▶* T2 &
+                                     L ⊢ U2 [dd, ee] ≡ T2.
+/3 width=3/ qed.
+
+lemma thin_delift_tpss_conf_le_up: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
+                                   ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                                   ∀K. L [dd, ee] ≡ K →
+                                   d ≤ dd → dd ≤ d + e → d + e ≤ dd + ee →
+                                   ∃∃T2. K ⊢ T1 [d, dd - d] ▶* T2 &
+                                         L ⊢ U2 [dd, ee] ≡ T2.
+#L #U1 #U2 #d #e #HU12 #T1 #dd #ee #HUT1 #K * #Y #HLY #HYK #Hdd #Hdde #Hddee
+lapply (delift_ltpss_conf_eq … HUT1 … HLY) -HUT1 #HUT1
+elim (ltpss_tpss_conf … HU12 … HLY) -HU12 #U #HU1 #HU2
+elim (delift_tpss_conf_le_up … HU1 … HUT1 … HYK ? ? ?) -HU1 -HUT1 // -Hdd -Hdde -Hddee #T #HT1 #HUT
+lapply (tpss_delift_trans_eq … HU2 … HUT) -U #HU2T
+lapply (ltpss_delift_trans_eq … HLY … HU2T) -Y /2 width=3/
+qed.
+
+lemma thin_delift_tps_conf_le_up: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶ U2 →
+                                  ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
+                                  ∀K. L [dd, ee] ≡ K →
+                                  d ≤ dd → dd ≤ d + e → d + e ≤ dd + ee →
+                                  ∃∃T2. K ⊢ T1 [d, dd - d] ▶* T2 &
+                                        L ⊢ U2 [dd, ee] ≡ T2.
+/3 width=6 by thin_delift_tpss_conf_le_up, tpss_strap/ qed. (**) (* too slow without trace *)
+
 lemma thin_delift_tpss_conf_be: ∀L,U1,U2,d,e. L ⊢ U1 [d, e] ▶* U2 →
                                 ∀T1,dd,ee. L ⊢ U1 [dd, ee] ≡ T1 →
                                 ∀K. L [dd, ee] ≡ K → d ≤ dd → dd + ee ≤ d + e →
index ef0f9f8c94ce60e1597ab2a0753169822eda9c5d..971031a5e70241dabf49267ce7ba8411bb2add96 100644 (file)
@@ -16,7 +16,7 @@ include "basic_2/substitution/ldrop_ldrop.ma".
 include "basic_2/unfold/ltpss_ldrop.ma".
 include "basic_2/unfold/thin.ma".
 
-(* LOCAL ENVIRONMENT THINNING ***********************************************)
+(* BASIC LOCAL ENVIRONMENT THINNING *****************************************)
 
 (* Properties on local environment slicing **********************************)
 
index b54a68e7c25bcaa79d8c8214af13affb83b40bcb..b5244430024b5adb5022007d39b43f017610d177 100644 (file)
@@ -50,7 +50,7 @@ lemma tpss_inv_atom1: ∀L,T2,I,d,e. L ⊢ ⓪{I} [d, e] ▶* T2 →
     elim (tps_inv_atom1 … HT2) -HT2 [ /2 width=1/ | * /3 width=10/ ]
   | * #K #V1 #V #i #Hdi #Hide #HLK #HV1 #HVT #HI
     lapply (ldrop_fwd_ldrop2 … HLK) #H
-    elim (tps_inv_lift1_up … HT2 … H … HVT ? ? ?) normalize -HT2 -H -HVT [2,3,4: /2 width=1/ ] #V2 <minus_plus #HV2 #HVT2
+    elim (tps_inv_lift1_ge_up … HT2 … H … HVT ? ? ?) normalize -HT2 -H -HVT [2,3,4: /2 width=1/ ] #V2 <minus_plus #HV2 #HVT2
     @or_intror @(ex6_4_intro … Hdi Hide HLK … HVT2 HI) /2 width=3/ (**) (* /4 width=10/ is too slow *)
   ]
 ]
@@ -161,6 +161,18 @@ lemma tpss_inv_lift1_eq: ∀L,U1,U2,d,e.
 <(tps_inv_lift1_eq … HU2 … HTU1) -HU2 -HTU1 //
 qed.
 
+lemma tpss_inv_lift1_ge_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶* U2 →
+                            ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
+                            d ≤ dt → dt ≤ d + e → d + e ≤ dt + et →
+                            ∃∃T2. K ⊢ T1 [d, dt + et - (d + e)] ▶* T2 &
+                                 ⇧[d, e] T2 ≡ U2.
+#L #U1 #U2 #dt #et #H #K #d #e #HLK #T1 #HTU1 #Hddt #Hdtde #Hdedet @(tpss_ind … H) -U2
+[ /2 width=3/
+| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU
+  elim (tps_inv_lift1_ge_up … HU2 … HLK … HTU ? ? ?) -HU2 -HLK -HTU // /3 width=3/
+]
+qed.
+
 lemma tpss_inv_lift1_be_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶* U2 →
                             ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
                             dt ≤ d → dt + et ≤ d + e →
@@ -171,3 +183,14 @@ lemma tpss_inv_lift1_be_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶* U2 →
   elim (tps_inv_lift1_be_up … HU2 … HLK … HTU ? ?) -HU2 -HLK -HTU // /3 width=3/
 ]
 qed.
+
+lemma tpss_inv_lift1_le_up: ∀L,U1,U2,dt,et. L ⊢ U1 [dt, et] ▶* U2 →
+                            ∀K,d,e. ⇩[d, e] L ≡ K → ∀T1. ⇧[d, e] T1 ≡ U1 →
+                            dt ≤ d → d ≤ dt + et → dt + et ≤ d + e →
+                            ∃∃T2. K ⊢ T1 [dt, d - dt] ▶* T2 & ⇧[d, e] T2 ≡ U2.
+#L #U1 #U2 #dt #et #H #K #d #e #HLK #T1 #HTU1 #Hdtd #Hddet #Hdetde @(tpss_ind … H) -U2
+[ /2 width=3/
+| -HTU1 #U #U2 #_ #HU2 * #T #HT1 #HTU
+  elim (tps_inv_lift1_le_up … HU2 … HLK … HTU ? ? ?) -HU2 -HLK -HTU // /3 width=3/
+]
+qed.
index 010c49f2bb9a2aeb6c29720dda4e58460b8e20f4..0d15cfe4f225df1f4810b4ca3f6d5065be8c8bb3 100644 (file)
@@ -40,7 +40,7 @@ interpretation "cons (list of pairs)" 'Cons hd1 hd2 tl = (cons2 ? ? hd1 hd2 tl).
 
 let rec append2 (A1,A2:Type[0]) (l1,l2:list2 A1 A2) on l1 ≝ match l1 with
 [ nil2           ⇒ l2
-| cons2 a1 a2 tl ⇒ {a1, a2} :: append2 A1 A2 tl l2
+| cons2 a1 a2 tl ⇒ {a1, a2} @ append2 A1 A2 tl l2
 ].
 
 interpretation "append (list of pairs)"
index 71fbbe0c2c65c0a1965a8e0527f690b89fd0b0c9..574bd3c595c4c3daba77eac86da095f243603604 100644 (file)
@@ -20,11 +20,11 @@ notation "hvbox( ◊ )"
   non associative with precedence 90
   for @{'Nil}.
 
-notation "hvbox( hd :: break tl )"
+notation "hvbox( hd @ break tl )"
   right associative with precedence 47
   for @{'Cons $hd $tl}.
 
-notation "hvbox( l1 @ break l2 )"
+notation "hvbox( l1 @@ break l2 )"
   right associative with precedence 47
   for @{'Append $l1 $l2 }.
 
@@ -32,6 +32,6 @@ notation "hvbox( ⟠ )"
   non associative with precedence 90
   for @{'Nil2}.
 
-notation "hvbox( { hd1 , break hd2 } :: break tl )"
+notation "hvbox( { hd1 , break hd2 } @ break tl )"
   non associative with precedence 47
   for @{'Cons $hd1 $hd2 $tl}.
index b937c077f12ad01a563bb984ba957a5c0ad5d868..81d6c9310247dc42c5f2d0d76e66a986ae1d45fc 100644 (file)
@@ -450,6 +450,10 @@ lemma lt_or_ge: ∀m,n. m < n ∨ n ≤ m.
 #m #n elim (decidable_lt m n) /2 width=1/ /3 width=1/
 qed-.
 
+lemma le_or_ge: ∀m,n. m ≤ n ∨ n ≤ m.
+#m #n elim (decidable_le m n) /2 width=1/ /4 width=2/
+qed-.
+
 (* More general conclusion **************************************************)
 
 theorem nat_ind_plus: ∀R:predicate nat.
index 04d2d7317e4416b7031d18f5125f2ce78eeb72bc..a80ccbea0451ed8ca3216bfe494d51cde8d2050c 100644 (file)
@@ -223,23 +223,35 @@ lemma TC_dx_to_TC: ∀A. ∀R: relation A.
 #A #R #a1 #a2 #Ha12 elim Ha12 -a1 -a2 /2 width=3/
 qed.
 
-fact TC_star_ind_dx_aux: ∀A,R. reflexive A R →
-                         ∀a2. ∀P:predicate A. P a2 →
-                         (∀a1,a. R a1 a → TC … R a a2 → P a → P a1) →
-                         ∀a1,a. TC … R a1 a → a = a2 → P a1.
-#A #R #HR #a2 #P #Ha2 #H #a1 #a #Ha1
+fact TC_ind_dx_aux: ∀A,R,a2. ∀P:predicate A.
+                    (∀a1. R a1 a2 → P a1) →
+                    (∀a1,a. R a1 a → TC … R a a2 → P a → P a1) →
+                    ∀a1,a. TC … R a1 a → a = a2 → P a1.
+#A #R #a2 #P #H1 #H2 #a1 #a #Ha1
 elim (TC_to_TC_dx ???? Ha1) -a1 -a
-[ #a #c #Hac #H destruct /3 width=4/
+[ #a #c #Hac #H destruct /2 width=1/
 | #a #b #c #Hab #Hbc #IH #H destruct /3 width=4/
 ]
 qed-.
 
+lemma TC_ind_dx: ∀A,R,a2. ∀P:predicate A.
+                 (∀a1. R a1 a2 → P a1) →
+                 (∀a1,a. R a1 a → TC … R a a2 → P a → P a1) →
+                 ∀a1. TC … R a1 a2 → P a1.
+#A #R #a2 #P #H1 #H2 #a1 #Ha12
+@(TC_ind_dx_aux … H1 H2 … Ha12) //
+qed-.
+
+lemma TC_symmetric: ∀A,R. symmetric A R → symmetric A (TC … R).
+#A #R #HR #x #y #H @(TC_ind_dx ??????? H) -x /3 width=1/ /3 width=3/
+qed.
+
 lemma TC_star_ind_dx: ∀A,R. reflexive A R →
                       ∀a2. ∀P:predicate A. P a2 →
                       (∀a1,a. R a1 a → TC … R a a2 → P a → P a1) →
                       ∀a1. TC … R a1 a2 → P a1.
 #A #R #HR #a2 #P #Ha2 #H #a1 #Ha12
-@(TC_star_ind_dx_aux … HR … Ha2 H … Ha12) //
+@(TC_ind_dx … P ? H … Ha12) /3 width=4/
 qed-.
 
 definition Conf3: ∀A,B. relation2 A B → relation A → Prop ≝ λA,B,S,R.