Section Write_String.
Variable sig : finType.
Variable D : move.
Fixpoint WriteString (l : list sig) : pTM sig unit 1 :=
match l with
| [] => Nop
| [x] => Write x
| x :: xs => WriteMove x D;; WriteString xs
end.
Fixpoint WriteString_Fun (sig' : Type) (t : tape sig') (str : list sig') :=
match str with
| nil => t
| [x] => tape_write t (Some x)
| x :: str' => WriteString_Fun (doAct t (Some x, D)) str'
end.
Definition WriteString_Rel str : Rel (tapes sig 1) (unit * tapes sig 1) :=
Mono.Mk_R_p (ignoreParam (fun tin tout => tout = WriteString_Fun tin str)).
End Write_String.
Arguments WriteString : simpl never.
Arguments WriteString_Rel {sig} (D) (str) x y/.
(* Compute skipn 3 (tl [1;2;3;4;5;6;7]). Compute tl (skipn 3 [1;2;3;4;5;6;7]). *)
(* Section Test. Let t : tape nat := midtape [3;2;1] 4 [5;6;7]. Let str := [3;2;1]. Compute WriteString_Fun Lmove t str. Compute (left t). Compute (left (WriteString_Fun Lmove t str)). Compute (skipn (length str - 1) (left t)). End Test. *)

Lemma WriteString_L_current (sig : Type) (str : list sig) t :
current (WriteString_Fun Lmove t str) = hd None (map Some (rev str ++ tape_local t)).