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 #_ #Htg cases (Htg (refl …)) -Htg #Htg #_
  93 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 #_ cases (Houtc (reverse ? l2@〈grid,false〉::〈c,true〉::〈grid,false〉::ls) comma)
 145    -Houtc #Houtc lapply (Houtc … Htc) -Houtc -Htc #Houtc #_
 146    >Houtc %
 147   |* #c1 * #tl #eql1 >eql1 #Hl1marks >reverse_append >reverse_single
 148    whd in ⊢ ((???%)→?); whd in ⊢ ((???(????%))→?);
 149    >associative_append whd in ⊢ ((???(????%))→?); #Htb
 150    * #tc * whd in ⊢ (%→?); * #_ #Htc lapply (Htc  … Htb) -Htc -Htb *
 151     [* >Hl1marks [#Htemp destruct (Htemp)] @memb_append_l2 @memb_hd]
 152    * * #_ >append_cons <associative_append #Htc lapply (Htc … (refl …) (refl …) ?)
 153     [#x #membx cases (memb_append … membx) -membx #membx
 154       [cases (memb_append … membx) -membx #membx
 155         [@Hl1marks @memb_append_l1 @daemon
 156         |>(memb_single … membx) %
 157         ]
 158       |@Hl2marks @membx
 159       ]]
 160   -Htc #Htc #_ whd in ⊢ (%→?); * #Houtc #_ cases (Houtc (reverse (FinProd FSUnialpha FinBool) ((reverse STape tl@[〈grid,false〉])@l2)
 161      @c1::〈c,true〉::〈grid,false〉::ls) comma)
 162   -Houtc #Houtc lapply (Houtc … Htc) -Houtc -Htc #Houtc #_
 163   >Houtc >reverse_append >reverse_append >reverse_single
 164   >reverse_reverse >associative_append >associative_append
 165   >associative_append %
 166 qed.
 167
 168 (* OLD
 169 definition init_copy ≝
 170   seq ? (adv_mark_r ?)
 171     (seq ? init_current_on_match
 172       (seq ? (move_r ?)
 173         (adv_to_mark_r ? (is_marked ?)))).
 174
 175 definition R_init_copy ≝ λt1,t2.
 176   ∀l1,l2,c,l3,d,rs.
 177   no_marks l1 → no_grids l1 →
 178   no_marks l2 → no_grids l2 → is_grid c = false → is_grid d =false →
 179   t1 = midtape STape (l1@〈grid,false〉::l2@〈c,false〉::〈grid,false〉::l3) 〈comma,true〉 (〈d,false〉::rs) →
 180   t2 = midtape STape (〈comma,false〉::l1@〈grid,false〉::l2@〈c,true〉::〈grid,false〉::l3) 〈d,true〉 rs.
 181
 182 lemma list_last: ∀A.∀l:list A.
 183   l = [ ] ∨ ∃a,l1. l = l1@[a].
 184 #A #l <(reverse_reverse ? l) cases (reverse A l)
 185   [%1 //
 186   |#a #l1 %2 @(ex_intro ?? a) @(ex_intro ?? (reverse ? l1)) //
 187   ]
 188 qed.
 189
 190 lemma sem_init_copy : Realize ? init_copy R_init_copy.
 191 #intape
 192 cases (sem_seq ????? (sem_adv_mark_r ?)
 193        (sem_seq ????? sem_init_current_on_match
 194         (sem_seq ????? (sem_move_r ?)
 195          (sem_adv_to_mark_r ? (is_marked ?)))) intape)
 196 #k * #outc * #Hloop #HR
 197 @(ex_intro ?? k) @(ex_intro ?? outc) % [@Hloop] -Hloop
 198 #l1 #l2 #c #l3 #d #rs #Hl1marks #Hl1grids #Hl2marks #Hl2grids #Hc #Hd #Hintape
 199 cases HR -HR
 200 #ta * whd in ⊢ (%→?); #Hta lapply (Hta … Hintape) -Hta -Hintape #Hta
 201 * #tb * whd in ⊢ (%→?);
 202 >append_cons #Htb lapply (Htb (〈comma,false〉::l1) l2 c … Hta)
 203   [@Hd |@Hc |@Hl2grids
 204    |#x #membx cases (orb_true_l … membx) -membx #membx
 205      [>(\P membx) // | @Hl1grids @membx]
 206   ] -Htb #Htb
 207 * #tc * whd in ⊢ (%→?); #Htc lapply (Htc … Htb) -Htc -Htb
 208 >reverse_append >reverse_cons cases (list_last ? l2)
 209   [#Hl2 >Hl2 >associative_append whd in ⊢ ((???(??%%%))→?); #Htc
 210    whd in ⊢ (%→?); #Htd cases (Htd … Htc) -Htd -Htc
 211     [* whd in ⊢ ((??%?)→?); #Habs destruct (Habs)]
 212    * #_ #Htf lapply (Htf … (refl …) (refl …) ?)
 213     [#x >reverse_cons #membx cases (memb_append … membx) -membx #membx
 214       [@Hl1marks @daemon |>(memb_single … membx) //]
 215     -Htf
 216     |#Htf >Htf >reverse_reverse >associative_append %
 217     ]
 218   |* #a * #l21 #Heq >Heq >reverse_append >reverse_single
 219    >associative_append >associative_append >associative_append whd in ⊢ ((???(??%%%))→?); #Htc
 220    whd in ⊢ (%→?); #Htd cases (Htd … Htc) -Htd -Htc
 221     [* >Hl2marks [#Habs destruct (Habs) |>Heq @memb_append_l2 @memb_hd]]
 222    * #_ <associative_append <associative_append #Htf lapply (Htf … (refl …) (refl …) ?)
 223     [#x >reverse_cons #membx cases (memb_append … membx) -membx #membx
 224       [cases (memb_append … membx) -membx #membx
 225         [@Hl2marks >Heq @memb_append_l1 @daemon
 226         |>(memb_single … membx) //]
 227       |cases (memb_append … membx) -membx #membx
 228         [@Hl1marks @daemon |>(memb_single … membx) //]
 229       ]
 230     | #Htf >Htf >reverse_append >reverse_reverse
 231       >reverse_append >reverse_reverse >associative_append
 232       >reverse_single >associative_append >associative_append
 233       >associative_append %
 234     ]
 235   ]
 236 qed. *)
 237
 238 definition exec_action ≝
 239   init_copy · copy · move_r … · move_tape.
 240
 241 definition map_move ≝
 242   λc,mv.match c with [ null ⇒ None ? | _ ⇒ Some ? 〈c,false,move_of_unialpha mv〉 ].
 243
 244 (* - aggiungere a legal_tape le condizioni
 245        only_bits ls, rs; bit_or_null c
 246    - ci vuole un lemma che dimostri
 247        bit_or_null c1 = true    bit_or_null mv = true
 248        mv ≠ null → c1 ≠ null
 249      dal fatto che c1 e mv sono contenuti nella table
 250  *)
 251
 252 definition Pre_exec_action ≝ λt1.
 253   ∃n,curconfig,ls,rs,c0,c1,s0,s1,table1,newconfig,mv,table2.
 254   table_TM n (table1@〈comma,false〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2) ∧
 255   no_marks curconfig ∧ only_bits (curconfig@[〈s0,false〉]) ∧
 256   only_bits (〈s1,false〉::newconfig) ∧ bit_or_null c1 = true ∧
 257   |curconfig| = |newconfig| ∧
 258   legal_tape ls 〈c0,false〉 rs ∧
 259   t1 = midtape STape (〈c0,false〉::curconfig@〈s0,false〉::〈grid,false〉::ls) 〈grid,false〉
 260     (table1@〈comma,true〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs).
 261
 262 definition R_exec_action ≝ λt1,t2.
 263   ∀n,curconfig,ls,rs,c0,c1,s0,s1,table1,newconfig,mv,table2.
 264   table_TM n (table1@〈comma,false〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2) →
 265   no_marks curconfig → only_bits (curconfig@[〈s0,false〉]) →
 266   only_bits (〈s1,false〉::newconfig) → bit_or_null c1 = true →
 267   |curconfig| = |newconfig| →
 268   legal_tape ls 〈c0,false〉 rs →
 269   t1 = midtape STape (〈c0,false〉::curconfig@〈s0,false〉::〈grid,false〉::ls) 〈grid,false〉
 270     (table1@〈comma,true〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs) →
 271   ∀t1'.t1' = lift_tape ls 〈c0,false〉 rs →
 272   ∃ls1,rs1,c2.
 273   t2 = midtape STape ls1 〈grid,false〉
 274     (〈s1,false〉::newconfig@〈c2,false〉::〈grid,false〉::
 275      table1@〈comma,false〉::〈s1,false〉::newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs1) ∧
 276   lift_tape ls1 〈c2,false〉 rs1 =
 277   tape_move STape t1' (map_move c1 mv) ∧ legal_tape ls1 〈c2,false〉 rs1.
 278
 279 (* move the following 2 lemmata to mono.ma *)
 280 lemma tape_move_left_eq :
 281   ∀A.∀t:tape A.∀c.
 282   tape_move ? t (Some ? 〈c,L〉) =
 283   tape_move_left ? (left ? t) c (right ? t).
 284 //
 285 qed.
 286
 287 lemma tape_move_right_eq :
 288   ∀A.∀t:tape A.∀c.
 289   tape_move ? t (Some ? 〈c,R〉) =
 290   tape_move_right ? (left ? t) c (right ? t).
 291 //
 292 qed.
 293
 294 lemma lift_tape_not_null :
 295  ∀ls,c,bc,rs.c ≠ null → lift_tape ls 〈c,bc〉 rs = midtape ? ls 〈c,bc〉 rs.
 296 #ls #c #bc #rs cases c //
 297 #Hfalse @False_ind /2/
 298 qed.
 299
 300 lemma merge_char_not_null :
 301   ∀c1,c2.c1 ≠ null → merge_char c1 c2 ≠ null.
 302 #c1 #c2 @not_to_not cases c2
 303 [ #c1' normalize #Hfalse destruct (Hfalse)
 304 | normalize //
 305 | *: normalize #Hfalse destruct (Hfalse)
 306 ]
 307 qed.
 308
 309 lemma merge_char_null : ∀c.merge_char null c = c.
 310 * //
 311 qed.
 312
 313 lemma merge_char_cases : ∀c1,c2.merge_char c1 c2 = c1 ∨ merge_char c1 c2 = c2.
 314 #c1 *
 315 [ #c1' %2 %
 316 | % %
 317 | *: %2 % ]
 318 qed.
 319
 320 (* lemma merge_char_c_bit :
 321   ∀c1,c2.is_bit c2 = true → merge_char c1 c2 = c2.
 322 #c1 *
 323 [ #c2' #_ %
 324 |*: normalize #Hfalse destruct (Hfalse) ]
 325 qed.
 326
 327 lemma merge_char_c_bit :
 328   ∀c1,c2.is_null c2 = true → merge_char c1 c2 = c1.
 329 #c1 *
 330 [ #c2' #_ %
 331 |*: normalize #Hfalse destruct (Hfalse) ]
 332 qed.
 333
 334 *)
 335
 336 (*lemma GRealize_to_Realize :
 337   ∀sig,M,R.GRealize sig M (λx.True) R → Realize sig M R.
 338 #sig #M #R #HR #t @HR //
 339 qed.*)
 340
 341 lemma sem_exec_action : GRealize ? exec_action Pre_exec_action R_exec_action.
 342 @(sem_seq_app_guarded … (Realize_to_GRealize … sem_init_copy) ???)
 343 [3:@(sem_seq_app_guarded … sem_copy)
 344  [3:@(sem_seq_app_guarded … (Realize_to_GRealize … (sem_move_r STape)))
 345   [3:@(Realize_to_GRealize … (sem_move_tape …))
 346   |@(λt.True)
 347   |4://
 348   |5:@sub_reflexive]
 349  |@(λt.True)
 350  |4://
 351  |5:@sub_reflexive]
 352 |4:#t1 #t2
 353    * #n * #curconfig * #ls * #rs * #c0 * #c1 * #s0 * #s1 * #table1 * #newconfig
 354    * #mv * #table2 * * * * * * *
 355    #Htable #Hcurconfig1 #Hcurconfig2 #Hnewconfig #Hc1 #Hlen #Htape #Ht1
 356    whd in ⊢ (%→?); >Ht1 #HR
 357    lapply (HR (〈c0,false〉::curconfig) table1 s0 ls s1
 358               (newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs) ???? (refl ??))
 359    [(*Hcurconfig2*) @daemon
 360    |(*by Htable *) @daemon
 361    |(*Hcurconfig2*) @daemon
 362    |(*Hcurconfig1*) @daemon ]
 363    -HR #Ht2 whd
 364    %{(〈grid,false〉::ls)} %{s0} %{s1} %{c0} %{c1} %{(〈mv,false〉::table2@〈grid,false〉::rs)}
 365    %{newconfig} %{(〈comma,false〉::reverse ? table1)} %{curconfig} >Ht2
 366    % [ % [ % [ % [ % [ % [ % [ %
 367    [ %
 368    |(*by Htabel*) @daemon ]
 369    |(*by Htable*) @daemon ]
 370    |// ]
 371    |>Hlen % ]
 372    |@Hcurconfig2 ]
 373    |@Hnewconfig ]
 374    |cases Htape * * // ]
 375    | // ]
 376    |1,2:skip]
 377 #ta #outtape #HR #n #curconfig #ls #rs #c0 #c1 #s0 #s1 #table1 #newconfig #mv
 378 #table2 #Htable #Hcurconfig1 #Hcurconfig2 #Hnewconfig #Hbitnullc1 #Hlen #Htape
 379 #Hta #ta' #Hta'
 380 cases HR -HR #tb * whd in ⊢ (%→?); #Htb
 381 lapply (Htb (〈c0,false〉::curconfig) table1 s0 ls s1
 382             (newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs)
 383             ???? Hta) -Htb
 384 [ (*Hcurconfig2*) @daemon
 385 | (*Htable*) @daemon
 386 | (* by Htape bit_or_null c0 = true, moreover Hcurconfig2 *) @daemon
 387 | (*Hcurconfig1*) @daemon ]
 388 #Htb * #tc * whd in ⊢ (%→?); #Htc
 389 lapply (Htc (〈grid,false〉::ls) s0 s1 c0 c1 (〈mv,false〉::table2@〈grid,false〉::rs) newconfig (〈comma,false〉::reverse ? table1) curconfig Htb ????????) -Htc
 390 [9:|*:(* bit_or_null c0,c1; |curconfig| = |newconfig|*) @daemon ]
 391 #Htc * #td * whd in ⊢ (%→?); * #_ #Htd lapply (Htd … Htc) -Htd whd in ⊢(???(??%%%)→?);#Htd
 392 whd in ⊢ (%→?); #Houtc whd in Htd:(???%); whd in Htd:(???(??%%%));
 393 lapply (Houtc rs n
 394   (〈comma,false〉::〈c1,false〉::reverse ? newconfig@〈s1,false〉::〈comma,false〉::reverse ? table1)
 395   mv table2 (merge_char c0 c1) (reverse ? newconfig@[〈s1,false〉]) ls ????????)
 396 [3: cases Htape -Htape * * #Hnomarks #Hbits #Hc0 #Hlsrs % [ % [ %
 397   [ #x #Hx cases (orb_true_l … Hx) #Hx'
 398     [ >(\P Hx') %
 399     | @Hnomarks @memb_cons // ]
 400   | @Hbits ]
 401   | cases (merge_char_cases c0 c1) #Hmerge >Hmerge // ]
 402   | cases (true_or_false (c0 == null)) #Hc0'
 403     [ cases Hlsrs -Hlsrs
 404       [ *
 405         [ >(\P Hc0') * #Hfalse @False_ind /2/
 406         | #Hlsnil % %2 // ]
 407       | #Hrsnil %2 // ]
 408     | % % @merge_char_not_null @(\Pf Hc0') ] ]
 409 |4:>Htd @(eq_f3 … (midtape ?))
 410   [ @eq_f @eq_f >associative_append >associative_append %
 411   | %
 412   | % ]
 413 | %
 414 || >reverse_cons >reverse_cons >reverse_append >reverse_reverse
 415    >reverse_cons >reverse_cons >reverse_reverse
 416    >associative_append >associative_append >associative_append
 417    >associative_append >associative_append
 418    @Htable
 419 | (* well formedness of table *) @daemon
 420 | (* Hnewconfig *) @daemon
 421 | (* bit_or_null mv = true (well formedness of table) *) @daemon
 422 | -Houtc * #ls1 * #rs1 * #newc * #Hnewtapelegal * #Houtc *
 423   [ *
 424     [ * #Hmv #Htapemove
 425       @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc)
 426       %
 427       [ %
 428         [ >Houtc -Houtc >reverse_append
 429           >reverse_reverse >reverse_single @eq_f
 430           >reverse_cons >reverse_cons >reverse_append >reverse_cons
 431           >reverse_cons >reverse_reverse >reverse_reverse
 432           >associative_append >associative_append
 433           >associative_append >associative_append
 434           >associative_append >associative_append %
 435         | >Hmv >Hta' >Htapemove
 436           (* mv = bit false -→ c1 = bit ? *)
 437           cut (∃c1'.c1 = bit c1') [ @daemon ] * #c1' #Hc1
 438           >Hc1 >tape_move_left_eq >(legal_tape_left … Htape)
 439           >(legal_tape_right … Htape) %
 440         ]
 441       | //
 442       ]
 443     | * #Hmv #Htapemove
 444       @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc) %
 445       [ %
 446         [ >Houtc -Houtc >reverse_append
 447           >reverse_reverse >reverse_single @eq_f
 448           >reverse_cons >reverse_cons >reverse_append >reverse_cons
 449           >reverse_cons >reverse_reverse >reverse_reverse
 450           >associative_append >associative_append
 451           >associative_append >associative_append
 452           >associative_append >associative_append %
 453         |>Hmv >Hta' >Htapemove
 454           cut (∃c1'.c1 = bit c1') [ @daemon ] * #c1' #Hc1
 455           >Hc1 >tape_move_right_eq >(legal_tape_left … Htape)
 456           >(legal_tape_right … Htape) %
 457         ]
 458       | //
 459       ]
 460     ]
 461   | * * * #Hmv #Hlseq #Hrseq #Hnewc
 462     @(ex_intro ?? ls1) @(ex_intro ?? rs1) @(ex_intro ?? newc) %
 463     [ %
 464       [ >Houtc -Houtc >reverse_append
 465         >reverse_reverse >reverse_single @eq_f
 466         >reverse_cons >reverse_cons >reverse_append >reverse_cons
 467         >reverse_cons >reverse_reverse >reverse_reverse
 468         >associative_append >associative_append
 469         >associative_append >associative_append
 470         >associative_append >associative_append %
 471       |>Hmv >Hta' cases c1 in Hnewc;
 472         [ #c1' whd in ⊢ (??%?→?);#Hnewc <Hnewc
 473           >Hlseq >Hrseq whd in ⊢ (??%%);
 474           >(legal_tape_left … Htape) >(legal_tape_right … Htape) %
 475         | whd in ⊢ (??%?→?); #Hnewc >Hnewc >Hlseq >Hrseq %
 476         |*: whd in ⊢ (??%?→?);#Hnewc <Hnewc
 477           >Hlseq >Hrseq whd in ⊢ (??%%);
 478           >(legal_tape_left … Htape) >(legal_tape_right … Htape) %
 479         ]
 480       ]
 481     | //
 482     ]
 483   ]
 484 ]
 485 qed.
 486
 487 (*
 488 if is_false(current) (* current state is not final *)
 489    then init_match;
 490     match_tuple;
 491     if is_marked(current) = false (* match ok *)
 492       then
 493            exec_action
 494            move_r;
 495       else sink;
 496    else nop;
 497 *)
 498
 499 definition uni_step ≝
 500   ifTM ? (test_char STape (λc.\fst c == bit false))
 501     (single_finalTM ?
 502       (init_match · match_tuple ·
 503         (ifTM ? (test_char ? (λc.¬is_marked ? c))
 504           (exec_action · move_r …)
 505           (nop ?) tc_true)))
 506     (nop ?) tc_true.
 507
 508 definition R_uni_step_true ≝ λt1,t2.
 509   ∀n,table,s0,s1,c0,c1,ls,rs,curconfig,newconfig,mv.
 510   0 < |table| → table_TM (S n) table →
 511   match_in_table (S n) (〈s0,false〉::curconfig) 〈c0,false〉
 512     (〈s1,false〉::newconfig) 〈c1,false〉 〈mv,false〉 table →
 513   legal_tape ls 〈c0,false〉 rs →
 514   t1 = midtape STape (〈grid,false〉::ls) 〈s0,false〉
 515     (curconfig@〈c0,false〉::〈grid,false〉::table@〈grid,false〉::rs) →
 516   ∀t1'.t1' = lift_tape ls 〈c0,false〉 rs →
 517   s0 = bit false ∧
 518   ∃ls1,rs1,c2.
 519   (t2 = midtape STape (〈grid,false〉::ls1) 〈s1,false〉
 520     (newconfig@〈c2,false〉::〈grid,false〉::table@〈grid,false〉::rs1) ∧
 521    lift_tape ls1 〈c2,false〉 rs1 =
 522    tape_move STape t1' (map_move c1 mv) ∧ legal_tape ls1 〈c2,false〉 rs1).
 523
 524 definition R_uni_step_false ≝ λt1,t2.
 525   ∀b. current STape t1 = Some ? 〈bit b,false〉 → b = true ∧ t2 = t1.
 526
 527 (*axiom sem_match_tuple : Realize ? match_tuple R_match_tuple.*)
 528
 529 definition us_acc : states ? uni_step ≝ (inr … (inl … (inr … start_nop))).
 530
 531 definition Pre_uni_step ≝ λt1.
 532   ∃n,table,s0,s1,c0,c1,ls,rs,curconfig,newconfig,mv.
 533   0 < |table| ∧ table_TM (S n) table ∧
 534   match_in_table (S n) (〈s0,false〉::curconfig) 〈c0,false〉
 535     (〈s1,false〉::newconfig) 〈c1,false〉 〈mv,false〉 table ∧
 536   legal_tape ls 〈c0,false〉 rs ∧
 537   t1 = midtape STape (〈grid,false〉::ls) 〈s0,false〉
 538     (curconfig@〈c0,false〉::〈grid,false〉::table@〈grid,false〉::rs).
 539
 540 lemma sem_uni_step :
 541   accGRealize ? uni_step us_acc Pre_uni_step
 542      R_uni_step_true R_uni_step_false.
 543 @daemon (* this no longer works: TODO *) (*
 544 @(acc_sem_if_app_guarded STape … (sem_test_char ? (λc:STape.\fst c == bit false))
 545   ? (test_char_inv …) (sem_nop …) …)
 546 [| @(sem_seq_app_guarded … (Realize_to_GRealize … sem_init_match) ???)
 547   [ 5: @sub_reflexive
 548   | 3: @(sem_seq_app_guarded … sem_match_tuple
 549          (Realize_to_GRealize … (sem_if ????????? (sem_test_char …  (λc.¬is_marked FSUnialpha c))
 550           (sem_seq … sem_exec_action (sem_move_r …))
 551           (sem_nop …))))
 552      [@(λx.True)
 553      |//
 554      |@sub_reflexive]
 555   ||| #t1 #t2 * #n * #table * #s0 * #s1 * #c0 * #c1 * #ls * #rs * #curconfig
 556       * #newconfig * #mv * * * *
 557       #Hlen1 #Htable #Hmatch #Hlegal #Ht1
 558       whd in ⊢ (%→?);
 559       cut (∃tup,table0.table = tup@table0 ∧ tuple_TM (S n) tup)
 560       [@daemon]
 561       * #tup * #table0 * #Htableeq * #qin * #cin * #qout * #cout * #mv0
 562       * * * * * * * * * *
 563       #Hqinnomarks #_ #Hqinbits #_ #_ #_ #_ #_ #Hqinlen #_ #Htupeq
 564       cut (∃d,qin0.qin = 〈d,false〉::qin0)
 565       [ lapply Hqinlen lapply Hqinnomarks -Hqinlen -Hqinnomarks cases qin
 566         [ #_ normalize in ⊢ (%→?); #Hfalse destruct (Hfalse)
 567         | * #d #bd #qin0 #Hqinnomarks #_ %{d} %{qin0}
 568           >(?:bd=false) [%]
 569           @(Hqinnomarks 〈d,bd〉) @memb_hd ] ]
 570       * #d * #qin0 #Hqineq
 571       #Ht2
 572       lapply (Ht2 (〈grid,false〉::ls) (curconfig@[〈c0,false〉])
 573                (qin0@〈cin,false〉::〈comma,false〉::qout@〈cout,false〉::〈comma,false〉::〈mv0,false〉::table0@〈grid,false〉::rs) s0 d ???)
 574       [ >Ht1 @eq_f >associative_append @eq_f @eq_f @eq_f
 575         >Htableeq >Htupeq >associative_append whd in ⊢ (??%?);
 576         @eq_f >Hqineq >associative_append @eq_f whd in ⊢ (??%?);
 577         @eq_f whd in ⊢ (??%?); @eq_f
 578         >associative_append %
 579       | @daemon
 580       | @daemon
 581       ]
 582       #Ht2 % [| % [| % [| % [ @Ht2 ]
 583         %2
 584         (* ls0 = ls
 585            c = s0
 586            l1 = curconfig@[〈c0,false〉]
 587            l2 = [〈bar,false〉]
 588            c10 = d
 589            l3 = qin0@[〈cin,false〉]
 590            l4 = qout@〈cout,false〉::〈comma,false〉::〈mv0,false〉::table0
 591            rs00 = rs
 592            n0 = S n ?
 593          *)
 594         %{ls} %{s0} %{(curconfig@[〈c0,false〉])}
 595         %{([〈bar,false〉])} %{d} %{(qin0@[〈cin,false〉])}
 596         %{(qout@〈cout,false〉::〈comma,false〉::〈mv0,false〉::table0)}
 597         %{rs} %{n} @daemon (* TODO *)
 598       ]
 599      ]
 600     ]
 601    ]
 602  | #intape #outtape
 603   #ta whd in ⊢ (%→?); #Hta #HR
 604   #n #fulltable #s0 #s1 #c0 #c1 #ls #rs #curconfig #newconfig #mv
 605   #Htable_len cut (∃t0,table. fulltable =〈bar,false〉::〈t0,false〉::table) [(* 0 < |table| *) @daemon]
 606   * #t0 * #table #Hfulltable >Hfulltable -fulltable
 607   #Htable #Hmatch #Htape #Hintape #t1' #Ht1'
 608   >Hintape in Hta; * * * #c #bc *
 609   whd in ⊢ (??%?→?); #HSome destruct (HSome) #Hc #Hta % [@(\P Hc)]
 610   cases HR -HR
 611   #tb * whd in ⊢ (%→?); #Htb
 612   lapply (Htb (〈grid,false〉::ls) (curconfig@[〈c0,false〉]) (table@〈grid,false〉::rs) c t0 ???)
 613   [ >Hta >associative_append %
 614   | @daemon
 615   | @daemon
 616   | -Hta -Htb #Htb *
 617     #tc * whd in ⊢ (%→?); #Htc cases (Htc … Htable … Htb) -Htb -Htc
 618     [| * #Hcurrent #Hfalse @False_ind
 619       (* absurd by Hmatch *) @daemon
 620     | >(\P Hc) %
 621     | (* Htable (con lemma) *) @daemon
 622     | (* Hmatch *) @daemon
 623     | (* Htable *) @daemon
 624     | (* Htable, Hmatch → |config| = n
 625        necessaria modifica in R_match_tuple, le dimensioni non corrispondono
 626       *) @daemon
 627     ]
 628     * #table1 * #newc * #mv1 * #table2 * #Htableeq #Htc *
 629     [ * #td * whd in ⊢ (%→?); >Htc -Htc * * #c2 * whd in ⊢ (??%?→?); #Hc2 destruct (Hc2)
 630       #_ #Htd
 631       cut (newc = 〈s1,false〉::newconfig@[〈c1,false〉]) [@daemon] #Hnewc
 632       >Hnewc cut (mv1 = 〈mv,false〉)
 633       [@daemon] #Hmv1
 634       * #te * whd in ⊢ (%→?); #Hte
 635       cut (td = midtape STape (〈c0,false〉::reverse STape curconfig@〈c,false〉::〈grid,false〉::ls)
 636               〈grid,false〉
 637               ((table1@〈bar,false〉::〈c,false〉::curconfig@[〈c0,false〉])@〈comma,true〉::〈s1,false〉::
 638                newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs))
 639       [ >Htd @eq_f3 //
 640         [ >reverse_append >reverse_single %
 641         | >associative_append >associative_append normalize
 642           >associative_append >Hmv1 >Hnewc @eq_f @eq_f @eq_f @eq_f @eq_f @eq_f
 643           whd in ⊢ (??%?); >associative_append %
 644         ]
 645       ]
 646       -Htd #Htd lapply (Hte … (S n) … Htd … Ht1') -Htd -Hte
 647       [ //
 648       | (*|curconfig| = |newconfig|*) @daemon
 649       | (* Htable → bit_or_null c1 = true *) @daemon
 650       | (* only_bits (〈s1,false〉::newconfig) *) @daemon
 651       | (* only_bits (curconfig@[〈s0,false〉]) *) @daemon
 652       | (* no_marks (reverse ? curconfig) *) @daemon
 653       | >Hmv1 in Htableeq; >Hnewc
 654         >associative_append >associative_append normalize
 655         >associative_append >associative_append
 656         #Htableeq <Htableeq // ]
 657       * #ls1 * #rs1 * #c2 * * #Hte #Hliftte #Hlegalte
 658       whd in ⊢ (%→?); * #_ #Houttape lapply (Houttape … Hte) -Houttape #Houttape
 659       whd in Houttape:(???%); whd in Houttape:(???(??%%%));
 660       @ex_intro [| @(ex_intro ?? rs1) @ex_intro [| % [ %
 661       [ >Houttape @eq_f @eq_f @eq_f @eq_f
 662         change with ((〈bar,false〉::〈t0,false〉::table)@?) in ⊢ (???%);
 663         >Htableeq >associative_append >associative_append
 664         >associative_append normalize >associative_append
 665         >associative_append normalize >Hnewc <Hmv1
 666         >associative_append normalize >associative_append
 667         >Hmv1 %
 668       | @Hliftte
 669       ]
 670      | //
 671      ]
 672     ]
 673    ]
 674   | * #td * whd in ⊢ (%→%→?); >Htc * #Htd
 675     lapply (Htd ? (refl ??)) normalize in ⊢ (%→?);
 676     #Hfalse destruct (Hfalse)
 677   ]
 678  ]
 679 | #t1 #t2 #t3 whd in ⊢ (%→%→?); #Ht1 #Ht2
 680   #b #Hb >Hb in Ht1; * #Hc #Ht1 lapply (Hc ? (refl ??)) -Hc #Hb' %
 681   // cases b in Hb'; normalize #H1 //
 682 ]
 683 *)
 684 qed.
 685
 686 (*
 687 @(acc_sem_if_app STape … (sem_test_char ? (λc:STape.\fst c == bit false))
 688    (sem_seq … sem_init_match
 689      (sem_seq … sem_match_tuple
 690        (sem_if … (* ????????? (sem_test_char …  (λc.¬is_marked FSUnialpha c)) *)
 691           (sem_seq … sem_exec_action (sem_move_r …))
 692           (sem_nop …))))
 693    (sem_nop …)
 694    …)
 695 [@sem_test_char||]
 696 [ #intape #outtape
 697   #ta whd in ⊢ (%→?); #Hta #HR
 698   #n #fulltable #s0 #s1 #c0 #c1 #ls #rs #curconfig #newconfig #mv
 699   #Htable_len cut (∃t0,table. fulltable =〈bar,false〉::〈t0,false〉::table) [(* 0 < |table| *) @daemon]
 700   * #t0 * #table #Hfulltable >Hfulltable -fulltable
 701   #Htable #Hmatch #Htape #Hintape #t1' #Ht1'
 702   >Hintape in Hta; * * * #c #bc *
 703   whd in ⊢ (??%?→?); #HSome destruct (HSome) #Hc #Hta % [@(\P Hc)]
 704   cases HR -HR
 705   #tb * whd in ⊢ (%→?); #Htb
 706   lapply (Htb (〈grid,false〉::ls) (curconfig@[〈c0,false〉]) (table@〈grid,false〉::rs) c t0 ???)
 707   [ >Hta >associative_append %
 708   | @daemon
 709   | @daemon
 710   | -Hta -Htb #Htb *
 711     #tc * whd in ⊢ (%→?); #Htc cases (Htc … Htable … Htb) -Htb -Htc
 712     [| * #Hcurrent #Hfalse @False_ind
 713       (* absurd by Hmatch *) @daemon
 714     | >(\P Hc) %
 715     | (* Htable (con lemma) *) @daemon
 716     | (* Hmatch *) @daemon
 717     | (* Htable *) @daemon
 718     | (* Htable, Hmatch → |config| = n
 719        necessaria modifica in R_match_tuple, le dimensioni non corrispondono
 720       *) @daemon
 721     ]
 722     * #table1 * #newc * #mv1 * #table2 * #Htableeq #Htc *
 723     [ * #td * whd in ⊢ (%→?); >Htc -Htc * * #c2 * whd in ⊢ (??%?→?); #Hc2 destruct (Hc2)
 724       #_ #Htd
 725       cut (newc = 〈s1,false〉::newconfig@[〈c1,false〉]) [@daemon] #Hnewc
 726       >Hnewc cut (mv1 = 〈mv,false〉)
 727       [@daemon] #Hmv1
 728       * #te * whd in ⊢ (%→?); #Hte
 729       cut (td = midtape STape (〈c0,false〉::reverse STape curconfig@〈c,false〉::〈grid,false〉::ls)
 730               〈grid,false〉
 731               ((table1@〈bar,false〉::〈c,false〉::curconfig@[〈c0,false〉])@〈comma,true〉::〈s1,false〉::
 732                newconfig@〈c1,false〉::〈comma,false〉::〈mv,false〉::table2@〈grid,false〉::rs))
 733       [ >Htd @eq_f3 //
 734         [ >reverse_append >reverse_single %
 735         | >associative_append >associative_append normalize
 736           >associative_append >Hmv1 >Hnewc @eq_f @eq_f @eq_f @eq_f @eq_f @eq_f
 737           whd in ⊢ (??%?); >associative_append %
 738         ]
 739       ]
 740       -Htd #Htd lapply (Hte … (S n) … Htd … Ht1') -Htd -Hte
 741       [ //
 742       | (*|curconfig| = |newconfig|*) @daemon
 743       | (* Htable → bit_or_null c1 = true *) @daemon
 744       | (* only_bits (〈s1,false〉::newconfig) *) @daemon
 745       | (* only_bits (curconfig@[〈s0,false〉]) *) @daemon
 746       | (* no_marks (reverse ? curconfig) *) @daemon
 747       | >Hmv1 in Htableeq; >Hnewc
 748         >associative_append >associative_append normalize
 749         >associative_append >associative_append
 750         #Htableeq <Htableeq // ]
 751       * #ls1 * #rs1 * #c2 * * #Hte #Hliftte #Hlegalte
 752       whd in ⊢ (%→?); * #_ #Houttape lapply (Houttape … Hte) -Houttape #Houttape
 753       whd in Houttape:(???%); whd in Houttape:(???(??%%%));
 754       @ex_intro [| @(ex_intro ?? rs1) @ex_intro [| % [ %
 755       [ >Houttape @eq_f @eq_f @eq_f @eq_f
 756         change with ((〈bar,false〉::〈t0,false〉::table)@?) in ⊢ (???%);
 757         >Htableeq >associative_append >associative_append
 758         >associative_append normalize >associative_append
 759         >associative_append normalize >Hnewc <Hmv1
 760         >associative_append normalize >associative_append
 761         >Hmv1 %
 762       | @Hliftte
 763       ]
 764      | //
 765      ]
 766     ]
 767    ]
 768   | * #td * whd in ⊢ (%→%→?); >Htc * #Htd
 769     lapply (Htd ? (refl ??)) normalize in ⊢ (%→?);
 770     #Hfalse destruct (Hfalse)
 771   ]
 772  ]
 773 | #t1 #t2 #t3 whd in ⊢ (%→%→?); #Ht1 #Ht2
 774   #b #Hb >Hb in Ht1; * #Hc #Ht1 lapply (Hc ? (refl ??)) -Hc #Hb' %
 775   // cases b in Hb'; normalize #H1 //
 776 ]
 777 qed.
 778 *)