+definition R_tape_move_obj' ≝ λt1,t2:Vector (tape FSUnialpha) 3.
+ (current ? (nth prg ? t1 (niltape ?)) = Some ? (bit false) →
+ t2 = change_vec ?? t1 (tape_move ? (nth obj ? t1 (niltape ?)) L) obj) ∧
+ (current ? (nth prg ? t1 (niltape ?)) = Some ? (bit true) →
+ t2 = change_vec ?? t1 (tape_move ? (nth obj ? t1 (niltape ?)) R) obj) ∧
+ (current ? (nth prg ? t1 (niltape ?)) ≠ Some ? (bit false) →
+ current ? (nth prg ? t1 (niltape ?)) ≠ Some ? (bit true) →
+ t2 = t1).
+
+lemma sem_tape_move_obj' : tape_move_obj ⊨ R_tape_move_obj'.
+#ta cases (sem_if ??????????
+ (acc_sem_inject ?????? prg ? (sem_test_char ? (λc:FSUnialpha.c == bit false)))
+ (sem_move_multi ? 2 obj L ?)
+ (sem_if ??????????
+ (acc_sem_inject ?????? prg ? (sem_test_char ? (λc:FSUnialpha.c == bit true)))
+ (sem_move_multi ? 2 obj R ?)
+ (sem_nop …)) ta) //
+#i * #outc * #Hloop #HR %{i} %{outc} % [@Hloop] -i
+cases HR -HR
+[ * #tb * * * * #c * #Hcurta_prg #Hc lapply (\P Hc) -Hc #Hc #Htb1 #Htb2
+ whd in ⊢ (%→%); #Houtc >Houtc -Houtc % [ %
+ [ >Hcurta_prg #H destruct (H) >(?:tb = ta)
+ [| lapply (eq_vec_change_vec ??????? Htb1 Htb2)
+ >change_vec_same // ] %
+ | >Hcurta_prg #H destruct (H) destruct (Hc) ]
+ | >Hcurta_prg >Hc * #H @False_ind /2/ ]
+| * #tb * * * #Hnotfalse #Htb1 #Htb2 cut (tb = ta)
+ [ lapply (eq_vec_change_vec ??????? Htb1 Htb2)
+ >change_vec_same // ] -Htb1 -Htb2 #Htb destruct (Htb) *
+ [ * #tc * * * * #c * #Hcurta_prg #Hc lapply (\P Hc) -Hc #Hc #Htc1 #Htc2
+ whd in ⊢ (%→%); #Houtc >Houtc -Houtc % [ %
+ [ >Hcurta_prg #H destruct (H) destruct (Hc)
+ | >Hcurta_prg #H destruct (H) >(?:tc = ta)
+ [| lapply (eq_vec_change_vec ??????? Htc1 Htc2)
+ >change_vec_same // ] % ]
+ | >Hcurta_prg >Hc #_ * #H @False_ind /2/ ]
+ | * #tc * * * #Hnottrue #Htc1 #Htc2 cut (tc = ta)
+ [ lapply (eq_vec_change_vec ??????? Htc1 Htc2)
+ >change_vec_same // ] -Htc1 -Htc2
+ #Htc destruct (Htc) whd in ⊢ (%→?); #Houtc % [ %
+ [ #Hcurta_prg lapply (\Pf (Hnotfalse ? Hcurta_prg)) * #H @False_ind /2/
+ | #Hcurta_prg lapply (\Pf (Hnottrue ? Hcurta_prg)) * #H @False_ind /2/ ]
+ | #_ #_ @Houtc ]
+ ]
+]
+qed.
+
+definition R_tape_move_obj ≝ λt1,t2:Vector (tape FSUnialpha) 3.
+ ∀c. current ? (nth prg ? t1 (niltape ?)) = Some ? c →
+ t2 = change_vec ?? t1 (tape_move ? (nth obj ? t1 (niltape ?)) (char_to_move c)) obj.
+
+lemma sem_tape_move_obj : tape_move_obj ⊨ R_tape_move_obj.
+@(Realize_to_Realize … sem_tape_move_obj')
+#ta #tb * * #Htb1 #Htb2 #Htb3 * [ *
+[ @Htb2 | @Htb1 ]
+| #Hcurta_prg change with (nth obj ? ta (niltape ?)) in match (tape_move ???);
+ >change_vec_same @Htb3 >Hcurta_prg % #H destruct (H)
+| #Hcurta_prg change with (nth obj ? ta (niltape ?)) in match (tape_move ???);
+ >change_vec_same @Htb3 >Hcurta_prg % #H destruct (H)
+]
+qed.
+
+(************** list of tape ******************)
+definition list_of_tape ≝ λsig.λt:tape sig.
+ reverse ? (left ? t)@option_cons ? (current ? t) (right ? t).
+
+lemma list_of_midtape: ∀sig,ls,c,rs.
+ list_of_tape sig (midtape ? ls c rs) = reverse ? ls@c::rs.
+// qed-.
+
+lemma list_of_rightof: ∀sig,ls,c.
+ list_of_tape sig (rightof ? c ls) = reverse ? (c::ls).
+#sig #ls #c <(append_nil ? (reverse ? (c::ls)))
+// qed-.
+
+lemma list_of_tape_move: ∀sig,t,m.
+ list_of_tape sig t = list_of_tape sig (tape_move ? t m).
+#sig #t * // cases t //
+ [(* rightof, move L *) #a #l >list_of_midtape
+ >append_cons <reverse_single <reverse_append %
+ |(* midtape, move L *) * //
+ #a #ls #c #rs >list_of_midtape >list_of_midtape
+ >reverse_cons >associative_append %
+ |(* midtape, move R *) #ls #c *
+ [>list_of_midtape >list_of_rightof >reverse_cons %
+ |#a #rs >list_of_midtape >list_of_midtape >reverse_cons
+ >associative_append %
+ ]
+ ]
+qed.
+
+lemma list_of_tape_write: ∀sig,cond,t,c.
+(∀b. c = Some ? b → cond b =true) →
+(∀x. mem ? x (list_of_tape ? t) → cond x =true ) →
+∀x. mem ? x (list_of_tape sig (tape_write ? t c)) → cond x =true.
+#sig #cond #t #c #Hc #Htape #x lapply Hc cases c
+ [(* c is None *) #_ whd in match (tape_write ???); @Htape
+ |#b #Hb lapply (Hb … (refl ??)) -Hb #Hb
+ whd in match (tape_write ???); >list_of_midtape
+ #Hx cases(mem_append ???? Hx) -Hx
+ [#Hx @Htape @mem_append_l1 @Hx
+ |* [//]
+ #Hx @Htape @mem_append_l2 cases (current sig t)
+ [@Hx | #c1 %2 @Hx]
+ ]
+ ]
+qed.
+
+lemma current_in_list: ∀sig,t,b.
+ current sig t = Some ? b → mem ? b (list_of_tape sig t).
+#sig #t #b cases t
+ [whd in ⊢ (??%?→?); #Htmp destruct
+ |#l #b whd in ⊢ (??%?→?); #Htmp destruct
+ |#l #b whd in ⊢ (??%?→?); #Htmp destruct
+ |#ls #c #rs whd in ⊢ (??%?→?); #Htmp destruct
+ >list_of_midtape @mem_append_l2 % %
+ ]
+qed.
+
+definition restart_tape ≝ λi,n.
+ mmove i FSUnialpha n L ·
+ inject_TM ? (move_to_end FSUnialpha L) n i ·
+ mmove i FSUnialpha n R.
+
+definition R_restart_tape ≝ λi,n.λint,outt:Vector (tape FSUnialpha) (S n).
+ ∀t.t = nth i ? int (niltape ?) →
+ outt = change_vec ?? int
+ (mk_tape ? [ ] (option_hd ? (list_of_tape ? t)) (tail ? (list_of_tape ? t))) i.
+
+lemma sem_restart_tape : ∀i,n.i < S n → restart_tape i n ⊨ R_restart_tape i n.
+#i #n #Hleq
+@(sem_seq_app ??????? (sem_move_multi ? n i L ?)
+ (sem_seq ?????? (sem_inject ???? i ? (sem_move_to_end_l ?))
+ (sem_move_multi ? n i R ?))) [1,2,3:@le_S_S_to_le //]
+#ta #tb * #tc * whd in ⊢ (%→?); #Htc
+* #td * * * #Htd1 #Htd2 #Htd3
+whd in ⊢ (%→?); #Htb *
+[ #Hta_i <Hta_i in Htc; whd in ⊢ (???(????%?)→?); #Htc
+ cut (td = tc)
+ [ <(change_vec_same … tc … i … (niltape ?))
+ @(eq_vec_change_vec … (niltape ?))
+ [ @Htd1 >Htc >nth_change_vec //
+ | @Htd3 ] ]
+ (* >Htc in Htd1; >nth_change_vec // *) -Htd1 -Htd2 -Htd3
+ #Htd >Htd in Htb; >Htc >change_vec_change_vec >nth_change_vec //
+ #Htb >Htb %
+| #r0 #rs0 #Hta_i <Hta_i in Htc; whd in ⊢ (???(????%?)→?); #Htc
+ cut (td = tc)
+ [ <(change_vec_same … tc … i … (niltape ?))
+ @(eq_vec_change_vec … (niltape ?))
+ [ @Htd1 >Htc >nth_change_vec //
+ | @Htd3 ] ]
+ (* >Htc in Htd1; >nth_change_vec // *) -Htd1 -Htd2 -Htd3
+ #Htd >Htd in Htb; >Htc >change_vec_change_vec >nth_change_vec //
+ #Htb >Htb %
+| #l0 #ls0 #Hta_i <Hta_i in Htc; whd in ⊢ (???(????%?)→?); #Htc
+ cut (td = change_vec ?? tc (mk_tape ? [ ] (None ?) (reverse ? ls0@[l0])) i)
+ [ <(change_vec_same … tc … i … (niltape ?))
+ @(eq_vec_change_vec … (niltape ?))
+ [ @Htd2 >Htc >nth_change_vec //
+ | #j #Hij >nth_change_vec_neq // @Htd3 // ]]
+ #Htd >Htd in Htb; >Htc >change_vec_change_vec >change_vec_change_vec
+ >nth_change_vec // #Htb >Htb <(reverse_reverse ? ls0) in ⊢ (???%);
+ cases (reverse ? ls0)
+ [ %
+ | #l1 #ls1 >reverse_cons
+ >(?: list_of_tape ? (rightof ? l0 (reverse ? ls1@[l1])) =
+ l1::ls1@[l0])
+ [|change with (reverse ??@?) in ⊢ (??%?);
+ whd in match (left ??); >reverse_cons >reverse_append
+ whd in ⊢ (??%?); @eq_f >reverse_reverse normalize >append_nil % ] % ]
+| *
+ [ #c #rs #Hta_i <Hta_i in Htc; whd in ⊢ (???(????%?)→?); #Htc
+ cut (td = tc)
+ [ <(change_vec_same … tc … i … (niltape ?))
+ @(eq_vec_change_vec … (niltape ?))
+ [ @Htd1 >Htc >nth_change_vec //
+ | @Htd3 ] ]
+ (* >Htc in Htd1; >nth_change_vec // *) -Htd1 -Htd2 -Htd3
+ #Htd >Htd in Htb; >Htc >change_vec_change_vec >nth_change_vec //
+ #Htb >Htb %
+ | #l0 #ls0 #c #rs #Hta_i <Hta_i in Htc; whd in ⊢ (???(????%?)→?); #Htc
+ cut (td = change_vec ?? tc (mk_tape ? [ ] (None ?) (reverse ? ls0@l0::c::rs)) i)
+ [ @(eq_vec_change_vec … (niltape ?))
+ [ @Htd2 >Htc >nth_change_vec //
+ | @Htd3 ] ]
+ #Htd >Htd in Htb; >Htc >change_vec_change_vec >change_vec_change_vec
+ >nth_change_vec // #Htb >Htb <(reverse_reverse ? ls0) in ⊢ (???%);
+ cases (reverse ? ls0)
+ [ %
+ | #l1 #ls1 >reverse_cons
+ >(?: list_of_tape ? (midtape ? (l0::reverse ? ls1@[l1]) c rs) =
+ l1::ls1@l0::c::rs)
+ [|change with (reverse ??@?) in ⊢ (??%?);
+ whd in match (left ??); >reverse_cons >reverse_append
+ whd in ⊢ (??%?); @eq_f >reverse_reverse normalize
+ >associative_append % ] % ]
+ ]
+]
+qed.