matita/matita/contribs/lambdadelta/delayed_updating/syntax/path_head.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 "delayed_updating/syntax/path_labels.ma".
  16 include "delayed_updating/notation/functions/downarrowright_2.ma".
  17 include "ground/arith/nat_plus.ma".
  18 include "ground/arith/nat_pred_succ.ma".
  19
  20 (* HEAD FOR PATH ************************************************************)
  21
  22 rec definition path_head (n) (p) on p: path ≝
  23 match n with
  24 [ nzero  ⇒ 𝐞
  25 | ninj m ⇒
  26   match p with
  27   [ list_empty     ⇒ 𝗟∗∗n
  28   | list_lcons l q ⇒
  29     match l with
  30     [ label_d k ⇒ (path_head (n+k) q)◖l
  31     | label_m   ⇒ (path_head n q)◖l
  32     | label_L   ⇒ (path_head (↓m) q)◖l
  33     | label_A   ⇒ (path_head n q)◖l
  34     | label_S   ⇒ (path_head n q)◖l
  35     ]
  36   ]
  37 ].
  38
  39 interpretation
  40   "head (path)"
  41   'DownArrowRight n p = (path_head n p).
  42
  43 (* basic constructions ****************************************************)
  44
  45 lemma path_head_zero (p):
  46       (𝐞) = ↳[𝟎]p.
  47 * // qed.
  48
  49 lemma path_head_empty (n):
  50       (𝗟∗∗n) = ↳[n]𝐞.
  51 * // qed.
  52
  53 lemma path_head_d_dx (p) (n) (k:pnat):
  54       (↳[↑n+k]p)◖𝗱k = ↳[↑n](p◖𝗱k).
  55 // qed.
  56
  57 lemma path_head_m_dx (p) (n):
  58       (↳[↑n]p)◖𝗺 = ↳[↑n](p◖𝗺).
  59 // qed.
  60
  61 lemma path_head_L_dx (p) (n):
  62       (↳[n]p)◖𝗟 = ↳[↑n](p◖𝗟).
  63 #p #n
  64 whd in ⊢ (???%); //
  65 qed.
  66
  67 lemma path_head_A_dx (p) (n):
  68       (↳[↑n]p)◖𝗔 = ↳[↑n](p◖𝗔).
  69 // qed.
  70
  71 lemma path_head_S_dx (p) (n):
  72       (↳[↑n]p)◖𝗦 = ↳[↑n](p◖𝗦).
  73 // qed.
  74
  75 (* Basic inversions *********************************************************)
  76
  77 lemma eq_inv_path_head_zero_dx (q) (p):
  78       q = ↳[𝟎]p → 𝐞 = q.
  79 #q * //
  80 qed-.
  81
  82 lemma eq_inv_path_empty_head (p) (n):
  83       (𝐞) = ↳[n]p → 𝟎 = n.
  84 *
  85 [ #n <path_head_empty #H0
  86   <(eq_inv_empty_labels … H0) -n //
  87 | * [ #k ] #p #n @(nat_ind_succ … n) -n // #n #_
  88   [ <path_head_d_dx
  89   | <path_head_m_dx
  90   | <path_head_L_dx
  91   | <path_head_A_dx
  92   | <path_head_S_dx
  93   ] #H0 destruct
  94 ]
  95 qed-.
  96
  97 (* Constructions with path_append *******************************************)
  98
  99 lemma path_head_refl_append (p) (q) (n):
 100       q = ↳[n]q → q = ↳[n](p●q).
 101 #p #q elim q -q
 102 [ #n #Hn <(eq_inv_path_empty_head … Hn) -Hn //
 103 | #l #q #IH #n @(nat_ind_succ … n) -n
 104   [ #Hq | #n #_ cases l [ #k ] ]
 105   [ lapply (eq_inv_path_head_zero_dx … Hq) -Hq #Hq destruct
 106   | <path_head_d_dx <path_head_d_dx
 107   | <path_head_m_dx <path_head_m_dx
 108   | <path_head_L_dx <path_head_L_dx
 109   | <path_head_A_dx <path_head_A_dx
 110   | <path_head_S_dx <path_head_S_dx
 111   ] #Hq
 112   elim (eq_inv_list_lcons_bi ????? Hq) -Hq #_ #Hq
 113   /3 width=1 by eq_f/
 114 ]
 115 qed-.
 116
 117 (* Inversions with path_append **********************************************)
 118
 119 lemma eq_inv_path_head_refl_append (p) (q) (n):
 120       q = ↳[n](p●q) → q = ↳[n]q.
 121 #p #q elim q -q
 122 [ #n #Hn <(eq_inv_path_empty_head … Hn) -p //
 123 | #l #q #IH #n @(nat_ind_succ … n) -n //
 124   #n #_ cases l [ #k ]
 125   [ <path_head_d_dx <path_head_d_dx
 126   | <path_head_m_dx <path_head_m_dx
 127   | <path_head_L_dx <path_head_L_dx
 128   | <path_head_A_dx <path_head_A_dx
 129   | <path_head_S_dx <path_head_S_dx
 130   ] #Hq
 131   elim (eq_inv_list_lcons_bi ????? Hq) -Hq #_ #Hq
 132   /3 width=1 by eq_f/
 133 ]
 134 qed-.