matita/matita/lib/turing/universal/uni_step.ma

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department of the University of Bologna, Italy.
   5     ||I||
   6     ||T||
   7     ||A||
   8     \   /  This file is distributed under the terms of the
   9      \ /   GNU General Public License Version 2
  10       V_____________________________________________________________*)
  11
  12
  13 (* COMPARE BIT
  14
  15 *)
  16
  17 include "turing/universal/copy.ma".
  18 include "turing/universal/move_tape.ma".
  19 include "turing/universal/match_machines.ma".
  20
  21 (*
  22
  23 step :
  24
  25 if is_true(current) (* current state is final *)
  26    then nop
  27    else
  28    (* init_match *)
  29    mark;
  30    adv_to_grid_r;
  31    move_r;
  32    mark;
  33    move_l;
  34    adv_to_mark_l
  35    (* /init_match *)
  36    match_tuple;
  37    if is_marked(current) = false (* match ok *)
  38       then
  39            (* init_copy *)
  40            move_l;
  41            init_current;
  42            move_r;
  43            adv_to_mark_r;
  44            adv_mark_r;
  45            (* /init_copy *)
  46            copy;
  47            move_r;
  48            (* move_tape *)
  49            by cases on current:
  50              case bit false: move_tape_l
  51              case bit true: move_tape_r
  52              case null: adv_to_grid_l; move_l; adv_to_grid_l;
  53            move_r;
  54            (* /move_tape *)
  55       else sink;
  56
  57 *)
  58
  59 definition init_match ≝
  60   mark ? · adv_to_mark_r ? (λc:STape.is_grid (\fst c)) · move_r ? ·
  61     move_r ? · mark ? · move_l ? · adv_to_mark_l ? (is_marked ?).
  62
  63 definition R_init_match ≝ λt1,t2.
  64   ∀ls,l,rs,c,d. no_grids (〈c,false〉::l) → no_marks l →
  65   t1 = midtape STape ls 〈c,false〉 (l@〈grid,false〉::〈bar,false〉::〈d,false〉::rs) →
  66   t2 = midtape STape ls 〈c,true〉 (l@〈grid,false〉::〈bar,false〉::〈d,true〉::rs).
  67
  68 lemma sem_init_match : Realize ? init_match R_init_match.
  69 #intape
  70 cases (sem_seq ????? (sem_mark ?)
  71        (sem_seq ????? (sem_adv_to_mark_r ? (λc:STape.is_grid (\fst c)))
  72         (sem_seq ????? (sem_move_r ?)
  73          (sem_seq ????? (sem_move_r ?)
  74           (sem_seq ????? (sem_mark ?)
  75            (sem_seq ????? (sem_move_l ?)
  76             (sem_adv_to_mark_l ? (is_marked ?))))))) intape)
  77 #k * #outc * #Hloop #HR
  78 @(ex_intro ?? k) @(ex_intro ?? outc) % [@Hloop] -Hloop
  79 #ls #l #rs #c #d #Hnogrids #Hnomarks #Hintape
  80 cases HR -HR
  81 #ta * whd in ⊢ (%→?); #Hta lapply (Hta … Hintape) -Hta -Hintape #Hta
  82 * #tb * whd in ⊢ (%→?); #Htb cases (Htb … Hta) -Htb -Hta
  83   [* #Hgridc @False_ind @(absurd … Hgridc) @eqnot_to_noteq
  84    @(Hnogrids 〈c,false〉) @memb_hd ]
  85 * #Hgrdic #Htb lapply (Htb l 〈grid,false〉 (〈bar,false〉::〈d,false〉::rs) (refl …) (refl …) ?)
  86   [#x #membl @Hnogrids @memb_cons @membl] -Htb #Htb
  87 * #tc * whd in ⊢ (%→?); #Htc lapply (Htc … Htb) -Htc -Htb #Htc
  88 * #td * whd in ⊢ (%→?); #Htd lapply (Htd … Htc) -Htd -Htc #Htd
  89 * #te * whd in ⊢ (%→?); #Hte lapply (Hte … Htd) -Hte -Htd #Hte
  90 * #tf * whd in ⊢ (%→?); #Htf lapply (Htf … Hte) -Htf -Hte #Htf
  91 whd in ⊢ (%→?); #Htg cases (Htg … Htf) -Htg -Htf
  92   [* whd in ⊢ ((??%?)→?); #Habs destruct (Habs)]
  93 * #_ #Htg lapply (Htg (〈grid,false〉::reverse ? l) 〈c,true〉 ls (refl …) (refl …) ?)
  94   [#x #membl @Hnomarks @daemon] -Htg #Htg >Htg >reverse_cons >reverse_reverse
  95    >associative_append %
  96 qed.
  97
  98 (* init_copy
  99
 100            init_current_on_match; (* no marks in current *)
 101            move_r;
 102            adv_to_mark_r;
 103            adv_mark_r;
 104
 105 *)
 106
 107 definition init_copy ≝
 108   init_current_on_match · move_r ? ·
 109     adv_to_mark_r ? (is_marked ?) · adv_mark_r ?.
 110
 111 definition R_init_copy ≝ λt1,t2.
 112   ∀l1,l2,c,ls,d,rs.
 113   no_marks l1 → no_grids l1 →
 114   no_marks l2 → is_grid c = false →
 115   t1 = midtape STape (l1@〈c,false〉::〈grid,false〉::ls) 〈grid,false〉 (l2@〈comma,true〉::〈d,false〉::rs) →
 116   t2 = midtape STape (〈comma,false〉::(reverse ? l2)@〈grid,false〉::l1@〈c,true〉::〈grid,false〉::ls) 〈d,true〉 rs.
 117
 118 lemma list_last: ∀A.∀l:list A.
 119   l = [ ] ∨ ∃a,l1. l = l1@[a].
 120 #A #l <(reverse_reverse ? l) cases (reverse A l)
 121   [%1 //
 122   |#a #l1 %2 @(ex_intro ?? a) @(ex_intro ?? (reverse ? l1)) //
 123   ]
 124 qed.
 125
 126 lemma sem_init_copy : Realize ? init_copy R_init_copy.
 127 #intape
 128 cases (sem_seq ????? sem_init_current_on_match
 129         (sem_seq ????? (sem_move_r ?)
 130           (sem_seq ????? (sem_adv_to_mark_r ? (is_marked ?))
 131             (sem_adv_mark_r ?))) intape)
 132 #k * #outc * #Hloop #HR
 133 @(ex_intro ?? k) @(ex_intro ?? outc) % [@Hloop] -Hloop
 134 #l1 #l2 #c #ls #d #rs #Hl1marks #Hl1grids #Hl2marks #Hc #Hintape
 135 cases HR -HR
 136 #ta * whd in ⊢ (%→?); #Hta lapply (Hta … Hl1grids Hc Hintape) -Hta -Hintape #Hta
 137 * #tb * whd in ⊢ (%→?); #Htb lapply (Htb  … Hta) -Htb -Hta
 138 generalize in match Hl1marks; -Hl1marks cases (list_last ? l1)
 139   [#eql1 >eql1 #Hl1marks whd in ⊢ ((???%)→?); whd in ⊢ ((???(????%))→?); #Htb
 140    * #tc * whd in ⊢ (%→?); #Htc lapply (Htc  … Htb) -Htc -Htb *
 141     [* whd in ⊢ ((??%?)→?); #Htemp destruct (Htemp)]
 142    * #_ #Htc lapply (Htc … (refl …) (refl …) ?)
 143     [#x #membx @Hl2marks @membx]
 144    #Htc whd in ⊢ (%→?); #Houtc lapply (Houtc … Htc) -Houtc -Htc #Houtc
 145    >Houtc %
 146   |* #c1 * #tl #eql1 >eql1 #Hl1marks >reverse_append >reverse_single
 147    whd in ⊢ ((???%)→?); whd in ⊢ ((???(????%))→?);
 148    >associative_append whd in ⊢ ((???(????%))→?); #Htb
 149    * #tc * whd in ⊢ (%→?); #Htc lapply (Htc  … Htb) -Htc -Htb *
 150     [* >Hl1marks [#Htemp destruct (Htemp)] @memb_append_l2 @memb_hd]
 151    * #_ >append_cons <associative_append #Htc lapply (Htc … (refl …) (refl …) ?)
 152     [#x #membx cases (memb_append … membx) -membx #membx
 153       [cases (memb_append … membx) -membx #membx
 154         [@Hl1marks @memb_append_l1 @daemon
 155         |>(memb_single … membx) %
 156         ]
 157       |@Hl2marks @membx
 158       ]]
 159   #Htc whd in ⊢ (%→?); #Houtc lapply (Houtc … Htc) -Houtc -Htc #Houtc
 160   >Houtc >reverse_append >reverse_append >reverse_single
 161   >reverse_reverse >associative_append >associative_append
 162   >associative_append %
 163 qed.
 164
 165 (* OLD
 166 definition init_copy ≝
 167   seq ? (adv_mark_r ?)
 168     (seq ? init_current_on_match
 169       (seq ? (move_r ?)
 170         (adv_to_mark_r ? (is_marked ?)))).
 171
 172 definition R_init_copy ≝ λt1,t2.
 173   ∀l1,l2,c,l3,d,rs.
 174   no_marks l1 → no_grids l1 →
 175   no_marks l2 → no_grids l2 → is_grid c = false → is_grid d =false →
 176   t1 = midtape STape (l1@〈grid,false〉::l2@〈c,false〉::〈grid,false〉::l3) 〈comma,true〉 (〈d,false〉::rs) →
 177   t2 = midtape STape (〈comma,false〉::l1@〈grid,false〉::l2@〈c,true〉::〈grid,false〉::l3) 〈d,true〉 rs.
 178
 179 lemma list_last: ∀A.∀l:list A.
 180   l = [ ] ∨ ∃a,l1. l = l1@[a].
 181 #A #l <(reverse_reverse ? l) cases (reverse A l)
 182   [%1 //
 183   |#a #l1 %2 @(ex_intro ?? a) @(ex_intro ?? (reverse ? l1)) //
 184   ]
 185 qed.
 186
 187 lemma sem_init_copy : Realize ? init_copy R_init_copy.
 188 #intape
 189 cases (sem_seq ????? (sem_adv_mark_r ?)
 190        (sem_seq ????? sem_init_current_on_match
 191         (sem_seq ????? (sem_move_r ?)
 192          (sem_adv_to_mark_r ? (is_marked ?)))) intape)
 193 #k * #outc * #Hloop #HR
 194 @(ex_intro ?? k) @(ex_intro ?? outc) % [@Hloop] -Hloop
 195 #l1 #l2 #c #l3 #d #rs #Hl1marks #Hl1grids #Hl2marks #Hl2grids #Hc #Hd #Hintape
 196 cases HR -HR
 197 #ta * whd in ⊢ (%→?); #Hta lapply (Hta … Hintape) -Hta -Hintape #Hta
 198 * #tb * whd in ⊢ (%→?);
 199 >append_cons #Htb lapply (Htb (〈comma,false〉::l1) l2 c … Hta)
 200   [@Hd |@Hc |@Hl2grids
 201    |#x #membx cases (orb_true_l … membx) -membx #membx
 202      [>(\P membx) // | @Hl1grids @membx]
 203   ] -Htb #Htb
 204 * #tc * whd in ⊢ (%→?); #Htc lapply (Htc … Htb) -Htc -Htb
 205 >reverse_append >reverse_cons cases (list_last ? l2)
 206   [#Hl2 >Hl2 >associative_append whd in ⊢ ((???(??%%%))→?); #Htc
 207    whd in ⊢ (%→?); #Htd cases (Htd … Htc) -Htd -Htc
 208     [* whd in ⊢ ((??%?)→?); #Habs destruct (Habs)]
 209    * #_ #Htf lapply (Htf … (refl …) (refl …) ?)
 210     [#x >reverse_cons #membx cases (memb_append … membx) -membx #membx
 211       [@Hl1marks @daemon |>(memb_single … membx) //]
 212     -Htf
 213     |#Htf >Htf >reverse_reverse >associative_append %
 214     ]
 215   |* #a * #l21 #Heq >Heq >reverse_append >reverse_single
 216    >associative_append >associative_append >associative_append whd in ⊢ ((???(??%%%))→?); #Htc
 217    whd in ⊢ (%→?); #Htd cases (Htd … Htc) -Htd -Htc
 218     [* >Hl2marks [#Habs destruct (Habs) |>Heq @memb_append_l2 @memb_hd]]
 219    * #_ <associative_append <associative_append #Htf lapply (Htf … (refl …) (refl …) ?)
 220     [#x >reverse_cons #membx cases (memb_append … membx) -membx #membx
 221       [cases (memb_append … membx) -membx #membx
 222         [@Hl2marks >Heq @memb_append_l1 @daemon
 223         |>(memb_single … membx) //]
 224       |cases (memb_append … membx) -membx #membx
 225         [@Hl1marks @daemon |>(memb_single … membx) //]
 226       ]
 227     | #Htf >Htf >reverse_append >reverse_reverse
 228       >reverse_append >reverse_reverse >associative_append
 229       >reverse_single >associative_append >associative_append
 230       >associative_append %
 231     ]
 232   ]
 233 qed. *)
 234
 235 definition exec_action ≝
 236   init_copy · copy · move_r … · move_tape.
 237
 238 definition map_move ≝
 239   λc,mv.match c with [ null ⇒ None ? | _ ⇒ Some ? 〈c,false,move_of_unialpha mv〉 ].
 240
 241 (* - aggiungere a legal_tape le condizioni
 242        only_bits ls, rs; bit_or_null c
 243    - ci vuole un lemma che dimostri
 244        bit_or_null c1 = true    bit_or_null mv = true
 245        mv ≠ null → c1 ≠ null
 246      dal fatto che c1 e mv sono contenuti nella table
 247  *)
 248 definition R_exec_action ≝ λt1,t2.
 249   ∀n,curconfig,ls,rs,c0,c1,s0,s1,table1,newconfig,mv,table2.
 250   table_TM n (table1@〈comma,false〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2) →
 251   no_marks curconfig → only_bits (curconfig@[〈s0,false〉]) →
 252   only_bits (〈s1,false〉::newconfig) → bit_or_null c1 = true →
 253   |curconfig| = |newconfig| →
 254   legal_tape ls 〈c0,false〉 rs →
 255   t1 = midtape STape (〈c0,false〉::curconfig@〈s0,false〉::〈grid,false〉::ls) 〈grid,false〉
 256     (table1@〈comma,true〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs) →
 257   ∀t1'.t1' = lift_tape ls 〈c0,false〉 rs →
 258   ∃ls1,rs1,c2.
 259   t2 = midtape STape ls1 〈grid,false〉
 260     (〈s1,false〉::newconfig@〈c2,false〉::〈grid,false〉::
 261      table1@〈comma,false〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs1) ∧
 262   lift_tape ls1 〈c2,false〉 rs1 =
 263   tape_move STape t1' (map_move c1 mv) ∧ legal_tape ls1 〈c2,false〉 rs1.
 264
 265 (* move the following 2 lemmata to mono.ma *)
 266 lemma tape_move_left_eq :
 267   ∀A.∀t:tape A.∀c.
 268   tape_move ? t (Some ? 〈c,L〉) =
 269   tape_move_left ? (left ? t) c (right ? t).
 270 //
 271 qed.
 272
 273 lemma tape_move_right_eq :
 274   ∀A.∀t:tape A.∀c.
 275   tape_move ? t (Some ? 〈c,R〉) =
 276   tape_move_right ? (left ? t) c (right ? t).
 277 //
 278 qed.
 279
 280 lemma lift_tape_not_null :
 281  ∀ls,c,bc,rs.c ≠ null → lift_tape ls 〈c,bc〉 rs = midtape ? ls 〈c,bc〉 rs.
 282 #ls #c #bc #rs cases c //
 283 #Hfalse @False_ind /2/
 284 qed.
 285
 286 lemma merge_char_not_null :
 287   ∀c1,c2.c1 ≠ null → merge_char c1 c2 ≠ null.
 288 #c1 #c2 @not_to_not cases c2
 289 [ #c1' normalize #Hfalse destruct (Hfalse)
 290 | normalize //
 291 | *: normalize #Hfalse destruct (Hfalse)
 292 ]
 293 qed.
 294
 295 lemma merge_char_null : ∀c.merge_char null c = c.
 296 * //
 297 qed.
 298
 299 lemma merge_char_cases : ∀c1,c2.merge_char c1 c2 = c1 ∨ merge_char c1 c2 = c2.
 300 #c1 *
 301 [ #c1' %2 %
 302 | % %
 303 | *: %2 % ]
 304 qed.
 305
 306 (* lemma merge_char_c_bit :
 307   ∀c1,c2.is_bit c2 = true → merge_char c1 c2 = c2.
 308 #c1 *
 309 [ #c2' #_ %
 310 |*: normalize #Hfalse destruct (Hfalse) ]
 311 qed.
 312
 313 lemma merge_char_c_bit :
 314   ∀c1,c2.is_null c2 = true → merge_char c1 c2 = c1.
 315 #c1 *
 316 [ #c2' #_ %
 317 |*: normalize #Hfalse destruct (Hfalse) ]
 318 qed.
 319
 320 *)
 321
 322 lemma sem_exec_action : Realize ? exec_action R_exec_action.
 323 #intape
 324 cases (sem_seq … sem_init_copy
 325         (sem_seq … sem_copy
 326           (sem_seq … (sem_move_r …) sem_move_tape )) intape)
 327 #k * #outc * #Hloop #HR
 328 @(ex_intro ?? k) @(ex_intro ?? outc) % [ @Hloop ] -Hloop
 329 #n #curconfig #ls #rs #c0 #c1 #s0 #s1 #table1 #newconfig #mv #table2
 330 #Htable #Hcurconfig1 #Hcurconfig2 #Hnewconfig #Hc1 #Hlen #Htape #Hintape #t1' #Ht1'
 331 cases HR -HR #ta * whd in ⊢ (%→?); #Hta
 332 lapply (Hta (〈c0,false〉::curconfig) table1 s0 ls s1
 333         (newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs) … Hintape) -Hta
 334 [ (*Hcurconfig2*) @daemon
 335 | (*Htable*) @daemon
 336 | (*bit_or_null c0 = true *) @daemon
 337 | (*Hcurconfig1*) @daemon
 338 | #Hta * #tb * whd in ⊢ (%→?); #Htb
 339   lapply (Htb (〈grid,false〉::ls) s0 s1 c0 c1 (〈mv,false〉::table2@〈grid,false〉::rs) newconfig (〈comma,false〉::reverse ? table1) curconfig Hta ????????) -Htb
 340   [9:|*:(* bit_or_null c0,c1; |curconfig| = |newconfig|*) @daemon ]
 341   #Htb * #tc * whd in ⊢ (%→?); #Htc lapply (Htc … Htb) -Htc whd in ⊢(???(??%%%)→?);#Htc
 342   whd in ⊢ (%→?); #Houtc whd in Htc:(???%); whd in Htc:(???(??%%%));
 343   lapply (Houtc rs n
 344     (〈comma,false〉::〈c1,false〉::reverse ? newconfig@〈s1,false〉::〈comma,false〉::reverse ? table1)
 345     mv table2 (merge_char c0 c1) (reverse ? newconfig@[〈s1,false〉]) ls ????????)
 346   [3: cases Htape -Htape * * #Hnomarks #Hbits #Hc0 #Hlsrs % [ % [ %
 347     [ #x #Hx cases (orb_true_l … Hx) #Hx'
 348       [ >(\P Hx') %
 349       | @Hnomarks @memb_cons // ]
 350     | @Hbits ]
 351     | cases (merge_char_cases c0 c1) #Hmerge >Hmerge // ]
 352     | cases (true_or_false (c0 == null)) #Hc0'
 353       [ cases Hlsrs -Hlsrs
 354         [ *
 355           [ >(\P Hc0') * #Hfalse @False_ind /2/
 356           | #Hlsnil % %2 // ]
 357         | #Hrsnil %2 // ]
 358       | % % @merge_char_not_null @(\Pf Hc0') ] ]
 359   |4:>Htc @(eq_f3 … (midtape ?))
 360     [ @eq_f @eq_f >associative_append >associative_append %
 361     | %
 362     | % ]
 363   | %
 364   || >reverse_cons >reverse_cons >reverse_append >reverse_reverse
 365      >reverse_cons >reverse_cons >reverse_reverse
 366      >associative_append >associative_append >associative_append
 367      >associative_append >associative_append
 368      @Htable
 369   | (* well formedness of table *) @daemon
 370   | (* Hnewconfig *) @daemon
 371   | (* bit_or_null mv = true (well formedness of table) *) @daemon
 372   | -Houtc * #ls1 * #rs1 * #newc * #Hnewtapelegal * #Houtc *
 373     [ *
 374       [ * #Hmv #Htapemove
 375         @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc)
 376         %
 377         [ %
 378           [ >Houtc -Houtc >reverse_append
 379             >reverse_reverse >reverse_single @eq_f
 380             >reverse_cons >reverse_cons >reverse_append >reverse_cons
 381             >reverse_cons >reverse_reverse >reverse_reverse
 382             >associative_append >associative_append
 383             >associative_append >associative_append
 384             >associative_append >associative_append %
 385           | >Hmv >Ht1' >Htapemove
 386             (* mv = bit false -→ c1 = bit ? *)
 387             cut (∃c1'.c1 = bit c1') [ @daemon ] * #c1' #Hc1
 388             >Hc1 >tape_move_left_eq >(legal_tape_left … Htape)
 389             >(legal_tape_right … Htape) %
 390           ]
 391         | //
 392         ]
 393       | * #Hmv #Htapemove
 394         @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc) %
 395         [ %
 396           [ >Houtc -Houtc >reverse_append
 397             >reverse_reverse >reverse_single @eq_f
 398             >reverse_cons >reverse_cons >reverse_append >reverse_cons
 399             >reverse_cons >reverse_reverse >reverse_reverse
 400             >associative_append >associative_append
 401             >associative_append >associative_append
 402             >associative_append >associative_append %
 403           |>Hmv >Ht1' >Htapemove
 404             cut (∃c1'.c1 = bit c1') [ @daemon ] * #c1' #Hc1
 405             >Hc1 >tape_move_right_eq >(legal_tape_left … Htape)
 406             >(legal_tape_right … Htape) %
 407           ]
 408         | //
 409         ]
 410       ]
 411     | * * * #Hmv #Hlseq #Hrseq #Hnewc
 412       @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc) %
 413       [ %
 414         [ >Houtc -Houtc >reverse_append
 415           >reverse_reverse >reverse_single @eq_f
 416           >reverse_cons >reverse_cons >reverse_append >reverse_cons
 417           >reverse_cons >reverse_reverse >reverse_reverse
 418           >associative_append >associative_append
 419           >associative_append >associative_append
 420           >associative_append >associative_append %
 421         |>Hmv >Ht1' cases c1 in Hnewc;
 422           [ #c1' whd in ⊢ (??%?→?);#Hnewc <Hnewc
 423             >Hlseq >Hrseq whd in ⊢ (??%%);
 424             >(legal_tape_left … Htape) >(legal_tape_right … Htape) %
 425           | whd in ⊢ (??%?→?); #Hnewc >Hnewc >Hlseq >Hrseq %
 426           |*: whd in ⊢ (??%?→?);#Hnewc <Hnewc
 427             >Hlseq >Hrseq whd in ⊢ (??%%);
 428             >(legal_tape_left … Htape) >(legal_tape_right … Htape) %
 429           ]
 430         ]
 431       | //
 432       ]
 433     ]
 434   ]
 435 ]
 436 qed.
 437
 438 (*
 439 if is_false(current) (* current state is not final *)
 440    then init_match;
 441     match_tuple;
 442     if is_marked(current) = false (* match ok *)
 443       then
 444            exec_action
 445            move_r;
 446       else sink;
 447    else nop;
 448 *)
 449
 450 definition uni_step ≝
 451   ifTM ? (test_char STape (λc.\fst c == bit false))
 452     (single_finalTM ?
 453       (init_match · match_tuple ·
 454         (ifTM ? (test_char ? (λc.¬is_marked ? c))
 455           (exec_action · move_r …)
 456           (nop ?) tc_true)))
 457     (nop ?) tc_true.
 458
 459 definition R_uni_step_true ≝ λt1,t2.
 460   ∀n,table,s0,s1,c0,c1,ls,rs,curconfig,newconfig,mv.
 461   0 < |table| → table_TM (S n) table →
 462   match_in_table (S n) (〈s0,false〉::curconfig) 〈c0,false〉
 463     (〈s1,false〉::newconfig) 〈c1,false〉 〈mv,false〉 table →
 464   legal_tape ls 〈c0,false〉 rs →
 465   t1 = midtape STape (〈grid,false〉::ls) 〈s0,false〉
 466     (curconfig@〈c0,false〉::〈grid,false〉::table@〈grid,false〉::rs) →
 467   ∀t1'.t1' = lift_tape ls 〈c0,false〉 rs →
 468   s0 = bit false ∧
 469   ∃ls1,rs1,c2.
 470   (t2 = midtape STape (〈grid,false〉::ls1) 〈s1,false〉
 471     (newconfig@〈c2,false〉::〈grid,false〉::table@〈grid,false〉::rs1) ∧
 472    lift_tape ls1 〈c2,false〉 rs1 =
 473    tape_move STape t1' (map_move c1 mv) ∧ legal_tape ls1 〈c2,false〉 rs1).
 474
 475 definition R_uni_step_false ≝ λt1,t2.
 476   ∀b. current STape t1 = Some ? 〈bit b,false〉 → b = true ∧ t2 = t1.
 477
 478 axiom sem_match_tuple : Realize ? match_tuple R_match_tuple.
 479
 480 definition us_acc : states ? uni_step ≝ (inr … (inl … (inr … start_nop))).
 481
 482 lemma sem_uni_step :
 483   accRealize ? uni_step us_acc
 484      R_uni_step_true R_uni_step_false.
 485 @(acc_sem_if_app STape … (sem_test_char ? (λc:STape.\fst c == bit false))
 486    (sem_seq … sem_init_match
 487      (sem_seq … sem_match_tuple
 488        (sem_if … (* ????????? (sem_test_char …  (λc.¬is_marked FSUnialpha c)) *)
 489           (sem_seq … sem_exec_action (sem_move_r …))
 490           (sem_nop …))))
 491    (sem_nop …)
 492    …)
 493 [@sem_test_char||]
 494 [ #intape #outtape
 495   #ta whd in ⊢ (%→?); #Hta #HR
 496   #n #fulltable #s0 #s1 #c0 #c1 #ls #rs #curconfig #newconfig #mv
 497   #Htable_len cut (∃t0,table. fulltable =〈bar,false〉::〈t0,false〉::table) [(* 0 < |table| *) @daemon]
 498   * #t0 * #table #Hfulltable >Hfulltable -fulltable
 499   #Htable #Hmatch #Htape #Hintape #t1' #Ht1'
 500   >Hintape in Hta; #Hta cases (Hta ? (refl ??)) -Hta
 501   #Hs0 lapply (\P Hs0) -Hs0 #Hs0 #Hta % //
 502   cases HR -HR
 503   #tb * whd in ⊢ (%→?); #Htb
 504   lapply (Htb (〈grid,false〉::ls) (curconfig@[〈c0,false〉]) (table@〈grid,false〉::rs) s0 t0 ???)
 505   [ >Hta >associative_append %
 506   | @daemon
 507   | @daemon
 508   | -Hta -Htb #Htb *
 509     #tc * whd in ⊢ (%→?); #Htc cases (Htc … Htable … Htb) -Htb -Htc
 510     [| * #Hcurrent #Hfalse @False_ind
 511       (* absurd by Hmatch *) @daemon
 512     | >Hs0 %
 513     | (* Htable (con lemma) *) @daemon
 514     | (* Hmatch *) @daemon
 515     | (* Htable *) @daemon
 516     | (* Htable, Hmatch → |config| = n
 517        necessaria modifica in R_match_tuple, le dimensioni non corrispondono
 518       *) @daemon
 519     ]
 520     * #table1 * #newc * #mv1 * #table2 * #Htableeq #Htc *
 521     [ * #td * whd in ⊢ (%→?); >Htc -Htc #Htd
 522       cases (Htd ? (refl ??)) #_ -Htd
 523       cut (newc = 〈s1,false〉::newconfig@[〈c1,false〉]) [@daemon] #Hnewc
 524       >Hnewc #Htd cut (mv1 = 〈mv,false〉)
 525       [@daemon] #Hmv1
 526       * #te * whd in ⊢ (%→?); #Hte
 527       cut (td = midtape STape (〈c0,false〉::reverse STape curconfig@〈s0,false〉::〈grid,false〉::ls)
 528               〈grid,false〉
 529               ((table1@〈bar,false〉::〈s0,false〉::curconfig@[〈c0,false〉])@〈comma,true〉::〈s1,false〉::
 530                newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs))
 531       [ >Htd @eq_f3 //
 532         [ >reverse_append >reverse_single %
 533         | >associative_append >associative_append normalize
 534           >associative_append >associative_append >Hmv1 %
 535         ]
 536       ]
 537       -Htd #Htd lapply (Hte … (S n) … Htd … Ht1') -Htd -Hte
 538       [ //
 539       | (*|curconfig| = |newconfig|*) @daemon
 540       | (* Htable → bit_or_null c1 = true *) @daemon
 541       | (* only_bits (〈s1,false〉::newconfig) *) @daemon
 542       | (* only_bits (curconfig@[〈s0,false〉]) *) @daemon
 543       | (* no_marks (reverse ? curconfig) *) @daemon
 544       | >Hmv1 in Htableeq; >Hnewc
 545         >associative_append >associative_append normalize
 546         >associative_append >associative_append
 547         #Htableeq <Htableeq // ]
 548       * #ls1 * #rs1 * #c2 * * #Hte #Hliftte #Hlegalte
 549       whd in ⊢ (%→?); #Houttape lapply (Houttape … Hte) -Houttape #Houttape
 550       whd in Houttape:(???%); whd in Houttape:(???(??%%%));
 551       @ex_intro [| @(ex_intro ?? rs1) @ex_intro [| % [ %
 552       [ >Houttape @eq_f @eq_f @eq_f @eq_f
 553         change with ((〈bar,false〉::〈t0,false〉::table)@?) in ⊢ (???%);
 554         >Htableeq >associative_append >associative_append
 555         >associative_append normalize >associative_append
 556         >associative_append normalize >Hnewc <Hmv1
 557         >associative_append normalize >associative_append
 558         >Hmv1 %
 559       | @Hliftte
 560       ]
 561      | //
 562      ]
 563     ]
 564    ]
 565   | * #td * whd in ⊢ (%→%→?); >Htc #Htd
 566     cases (Htd ? (refl ??)) normalize in ⊢ (%→?);
 567     #Hfalse destruct (Hfalse)
 568   ]
 569  ]
 570 | #t1 #t2 #t3 whd in ⊢ (%→%→?); #Ht1 #Ht2
 571   #b #Hb cases (Ht1 ? Hb) #Hb' #Ht3 >Ht2 % //
 572   cases b in Hb'; normalize #H1 //
 573 ]
 574 qed.