Section Fix_Sigma.
Variable sig : Type.
Notation tape := (tape sig).
(* ** Definition of the tape *)
(* A tape is essentially a triple 〈left,current,right〉 where, however, the current symbol could be missing. This may happen for three different reasons: both tapes are empty, we are on the left extremity of a non-empty tape (left overflow), or we are on the right extremity of a non-empty tape (right overflow). *)
(* Note that the alphabet has type [Type], not [finType]. *)
(* Print tape. *)
Definition tapes n := Vector.t tape n.
Definition tapeToList (t : tape) : list sig :=
match t with
| niltape => []
| leftof s r => s :: r
| rightof s l => List.rev (s :: l)
| midtape l c r => (List.rev l) ++ [c] ++ r
end.
Definition sizeOfTape t := |tapeToList t|.
Definition sizeOfmTapes n (v : tapes n) :=
Vector.fold_left max 0 (Vector.map sizeOfTape v).
Definition left :=
fun (t : tape) =>
match t with
| niltape => []
| leftof _ _ => []
| rightof s l => s :: l
| midtape l _ _ => l
end.
Definition right :=
fun (t : tape) =>
match t with
| niltape => []
| leftof s r => s :: r
| rightof _ _ => []
| midtape _ _ r => r
end.
(* ** Machine step *)
(* Writing on the tape *)
Definition tape_write (t : tape) (s : option sig) :=
match s with
| None => t
| Some s' => midtape (left t) s' (right t)
end.
(* A single step of the machine *)
Definition doAct (t : tape) (mv : option sig * move) :=
tape_move (tape_write t (fst mv)) (snd mv).
(* One step on each tape *)
Definition doAct_multi (n : nat) (ts : tapes n) (actions : Vector.t (option sig * move) n) :=
Vector.map2 doAct ts actions.
(* Read characters on all tapes *)
Definition current_chars (n : nat) (tapes : tapes n) := Vector.map current tapes.
End Fix_Sigma.
(* ** Rewriting tactics *)
(* Tactic to destruct a vector of tapes of known size *)
Ltac destruct_tapes := unfold tapes in *; destruct_vector.
(* Simplification Database for tapes and vectors *)
Create HintDb tape.
Create HintDb vector.
(* We use [rewrite_strat] instead of [autorewrite], because it is faster. *)
Tactic Notation "simpl_tape" :=
repeat rewrite_strat (topdown (choice (hints tape) (hints vector))).
Tactic Notation "simpl_tape" "in" ident(H) :=
repeat rewrite_strat (topdown (choice (hints tape) (hints vector))) in H.
Tactic Notation "simpl_tape" "in" "*" :=
repeat multimatch goal with
| [ H : _ |- _ ] => simpl_tape in H
end;
simpl_tape.
Tactic Notation "simpl_vector" :=
repeat rewrite_strat (topdown (hints vector)).
Tactic Notation "simpl_vector" "in" ident(H) :=
repeat rewrite_strat (topdown (hints vector)) in H.
Tactic Notation "simpl_vector" "in" "*" :=
repeat multimatch goal with
| [ H : _ |- _ ] => simpl_vector in H
end;
simpl_vector.
Hint Rewrite tapeToList_move : tape.
Hint Rewrite tapeToList_move_R : tape.
Hint Rewrite tapeToList_move_L : tape.
Hint Rewrite tape_move_right_left using eauto : tape.
Hint Rewrite tape_move_left_right using eauto : tape.
Arguments current_chars : simpl never.
Hint Unfold current_chars : tape.

Lemma nth_map' (A B : Type) (f : A -> B) (n : nat) (v : Vector.t A n) (k : Fin.t n) :
(VectorDef.map f v)[@k] = f v[@k].