matita/matita/contribs/lambdadelta/basic_2A/computation/csx.ma

   1 (**************************************************************************)
   2 (*       ___                                                              *)
   3 (*      ||M||                                                             *)
   4 (*      ||A||       A project by Andrea Asperti                           *)
   5 (*      ||T||                                                             *)
   6 (*      ||I||       Developers:                                           *)
   7 (*      ||T||         The HELM team.                                      *)
   8 (*      ||A||         http://helm.cs.unibo.it                             *)
   9 (*      \   /                                                             *)
  10 (*       \ /        This file is distributed under the terms of the       *)
  11 (*        v         GNU General Public License Version 2                  *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 include "basic_2A/notation/relations/sn_5.ma".
  16 include "basic_2A/reduction/cnx.ma".
  17
  18 (* CONTEXT-SENSITIVE EXTENDED STRONGLY NORMALIZING TERMS ********************)
  19
  20 definition csx: ∀h. sd h → relation3 genv lenv term ≝
  21                 λh,g,G,L. SN … (cpx h g G L) (eq …).
  22
  23 interpretation
  24    "context-sensitive extended strong normalization (term)"
  25    'SN h g G L T = (csx h g G L T).
  26
  27 (* Basic eliminators ********************************************************)
  28
  29 lemma csx_ind: ∀h,g,G,L. ∀R:predicate term.
  30                (∀T1. ⦃G, L⦄ ⊢ ⬊*[h, g] T1 →
  31                      (∀T2. ⦃G, L⦄ ⊢ T1 ➡[h, g] T2 → (T1 = T2 → ⊥) → R T2) →
  32                      R T1
  33                ) →
  34                ∀T. ⦃G, L⦄ ⊢ ⬊*[h, g] T → R T.
  35 #h #g #G #L #R #H0 #T1 #H elim H -T1
  36 /5 width=1 by SN_intro/
  37 qed-.
  38
  39 (* Basic properties *********************************************************)
  40
  41 (* Basic_1: was just: sn3_pr2_intro *)
  42 lemma csx_intro: ∀h,g,G,L,T1.
  43                  (∀T2. ⦃G, L⦄ ⊢ T1 ➡[h, g] T2 → (T1 = T2 → ⊥) → ⦃G, L⦄ ⊢ ⬊*[h, g] T2) →
  44                  ⦃G, L⦄ ⊢ ⬊*[h, g] T1.
  45 /4 width=1 by SN_intro/ qed.
  46
  47 lemma csx_cpx_trans: ∀h,g,G,L,T1. ⦃G, L⦄ ⊢ ⬊*[h, g] T1 →
  48                      ∀T2. ⦃G, L⦄ ⊢ T1 ➡[h, g] T2 → ⦃G, L⦄ ⊢ ⬊*[h, g] T2.
  49 #h #g #G #L #T1 #H @(csx_ind … H) -T1 #T1 #HT1 #IHT1 #T2 #HLT12
  50 elim (eq_term_dec T1 T2) #HT12 destruct /3 width=4 by/
  51 qed-.
  52
  53 (* Basic_1: was just: sn3_nf2 *)
  54 lemma cnx_csx: ∀h,g,G,L,T. ⦃G, L⦄ ⊢ ➡[h, g] 𝐍⦃T⦄ → ⦃G, L⦄ ⊢ ⬊*[h, g] T.
  55 /2 width=1 by NF_to_SN/ qed.
  56
  57 lemma csx_sort: ∀h,g,G,L,k. ⦃G, L⦄ ⊢ ⬊*[h, g] ⋆k.
  58 #h #g #G #L #k elim (deg_total h g k)
  59 #d generalize in match k; -k @(nat_ind_plus … d) -d /3 width=6 by cnx_csx, cnx_sort/
  60 #d #IHd #k #Hkd lapply (deg_next_SO … Hkd) -Hkd
  61 #Hkd @csx_intro #X #H #HX elim (cpx_inv_sort1 … H) -H
  62 [ #H destruct elim HX //
  63 | -HX * #d0 #_ #H destruct -d0 /2 width=1 by/
  64 ]
  65 qed.
  66
  67 (* Basic_1: was just: sn3_cast *)
  68 lemma csx_cast: ∀h,g,G,L,W. ⦃G, L⦄ ⊢ ⬊*[h, g] W →
  69                 ∀T. ⦃G, L⦄ ⊢ ⬊*[h, g] T → ⦃G, L⦄ ⊢ ⬊*[h, g] ⓝW.T.
  70 #h #g #G #L #W #HW @(csx_ind … HW) -W #W #HW #IHW #T #HT @(csx_ind … HT) -T #T #HT #IHT
  71 @csx_intro #X #H1 #H2
  72 elim (cpx_inv_cast1 … H1) -H1
  73 [ * #W0 #T0 #HLW0 #HLT0 #H destruct
  74   elim (eq_false_inv_tpair_sn … H2) -H2
  75   [ /3 width=3 by csx_cpx_trans/
  76   | -HLW0 * #H destruct /3 width=1 by/
  77   ]
  78 |2,3: /3 width=3 by csx_cpx_trans/
  79 ]
  80 qed.
  81
  82 (* Basic forward lemmas *****************************************************)
  83
  84 fact csx_fwd_pair_sn_aux: ∀h,g,G,L,U. ⦃G, L⦄ ⊢ ⬊*[h, g] U →
  85                           ∀I,V,T. U = ②{I}V.T → ⦃G, L⦄ ⊢ ⬊*[h, g] V.
  86 #h #g #G #L #U #H elim H -H #U0 #_ #IH #I #V #T #H destruct
  87 @csx_intro #V2 #HLV2 #HV2
  88 @(IH (②{I}V2.T)) -IH /2 width=3 by cpx_pair_sn/ -HLV2
  89 #H destruct /2 width=1 by/
  90 qed-.
  91
  92 (* Basic_1: was just: sn3_gen_head *)
  93 lemma csx_fwd_pair_sn: ∀h,g,I,G,L,V,T. ⦃G, L⦄ ⊢ ⬊*[h, g] ②{I}V.T → ⦃G, L⦄ ⊢ ⬊*[h, g] V.
  94 /2 width=5 by csx_fwd_pair_sn_aux/ qed-.
  95
  96 fact csx_fwd_bind_dx_aux: ∀h,g,G,L,U. ⦃G, L⦄ ⊢ ⬊*[h, g] U →
  97                           ∀a,I,V,T. U = ⓑ{a,I}V.T → ⦃G, L.ⓑ{I}V⦄ ⊢ ⬊*[h, g] T.
  98 #h #g #G #L #U #H elim H -H #U0 #_ #IH #a #I #V #T #H destruct
  99 @csx_intro #T2 #HLT2 #HT2
 100 @(IH (ⓑ{a,I}V.T2)) -IH /2 width=3 by cpx_bind/ -HLT2
 101 #H destruct /2 width=1 by/
 102 qed-.
 103
 104 (* Basic_1: was just: sn3_gen_bind *)
 105 lemma csx_fwd_bind_dx: ∀h,g,a,I,G,L,V,T. ⦃G, L⦄ ⊢ ⬊*[h, g] ⓑ{a,I}V.T → ⦃G, L.ⓑ{I}V⦄ ⊢ ⬊*[h, g] T.
 106 /2 width=4 by csx_fwd_bind_dx_aux/ qed-.
 107
 108 fact csx_fwd_flat_dx_aux: ∀h,g,G,L,U. ⦃G, L⦄ ⊢ ⬊*[h, g] U →
 109                           ∀I,V,T. U = ⓕ{I}V.T → ⦃G, L⦄ ⊢ ⬊*[h, g] T.
 110 #h #g #G #L #U #H elim H -H #U0 #_ #IH #I #V #T #H destruct
 111 @csx_intro #T2 #HLT2 #HT2
 112 @(IH (ⓕ{I}V.T2)) -IH /2 width=3 by cpx_flat/ -HLT2
 113 #H destruct /2 width=1 by/
 114 qed-.
 115
 116 (* Basic_1: was just: sn3_gen_flat *)
 117 lemma csx_fwd_flat_dx: ∀h,g,I,G,L,V,T. ⦃G, L⦄ ⊢ ⬊*[h, g] ⓕ{I}V.T → ⦃G, L⦄ ⊢ ⬊*[h, g] T.
 118 /2 width=5 by csx_fwd_flat_dx_aux/ qed-.
 119
 120 lemma csx_fwd_bind: ∀h,g,a,I,G,L,V,T. ⦃G, L⦄ ⊢ ⬊*[h, g] ⓑ{a,I}V.T →
 121                     ⦃G, L⦄ ⊢ ⬊*[h, g] V ∧ ⦃G, L.ⓑ{I}V⦄ ⊢ ⬊*[h, g] T.
 122 /3 width=3 by csx_fwd_pair_sn, csx_fwd_bind_dx, conj/ qed-.
 123
 124 lemma csx_fwd_flat: ∀h,g,I,G,L,V,T. ⦃G, L⦄ ⊢ ⬊*[h, g] ⓕ{I}V.T →
 125                     ⦃G, L⦄ ⊢ ⬊*[h, g] V ∧ ⦃G, L⦄ ⊢ ⬊*[h, g] T.
 126 /3 width=3 by csx_fwd_pair_sn, csx_fwd_flat_dx, conj/ qed-.
 127
 128 (* Basic_1: removed theorems 14:
 129             sn3_cdelta
 130             sn3_gen_cflat sn3_cflat sn3_cpr3_trans sn3_shift sn3_change
 131             sn3_appl_cast sn3_appl_beta sn3_appl_lref sn3_appl_abbr
 132             sn3_appl_appls sn3_bind sn3_appl_bind sn3_appls_bind
 133 *)