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

Lemma WriteString_Sem str :
WriteString str ⊨c(WriteString_steps (length str)) (WriteString_Rel str).