+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.
+