Section DoActions.
Variable (acts : Vector.t (option sig * move) n).
(* Abuse [UNKNOWN] as a special marker, to return to the place where we inserted the symbol with shifting *)
Definition isReturnMarker (s : sigSim) : bool :=
match s with
| inl UNKNOWN => true
| _ => false
end.
(* The more complicated part is writing, because we may have to alocate more memory by shifting *)
Definition DoWrite_Rel (d : option move) (s : sig) : pRel sigSim unit 1 :=
ignoreParam
(fun tin tout =>
forall tps1 tps2 tp,
tape_dir tp = d ->
atCons_current tin[@Fin0] tps1 tps2 tp ->
atCons_current tout[@Fin0] tps1 tps2 (tape_write tp (Some s))).
Definition DoWrite (d : option move) (s : sig) : pTM sigSim unit 1 :=
match d with
| Some Lmove => (* [leftof] ~> shift left and change boundary symbol to [LeftBlank false] *)
Shift_L (fun _ => false) (inl UNKNOWN);;
MoveToSymbol isReturnMarker id;;
WriteMove (inr (sigList_X (MarkedSymbol s))) Lmove;;
WriteMove (inr (sigList_X (LeftBlank false))) Rmove
| Some Rmove => (* [rightof] ~> shift right and change boundary symbol to [RightBlank false] *)
Shift (fun _ => false) (inl UNKNOWN);;
MoveToSymbol_L isReturnMarker id;;
WriteMove (inr (sigList_X (MarkedSymbol s))) Rmove;;
WriteMove (inr (sigList_X (RightBlank false))) Lmove
| Some Nmove => (* [midtape] ~> just write the symbol *)
Write (inr (sigList_X (MarkedSymbol s)))
| None => (* [midtape] ~> we need to shift left and right and insert [RightBlank false] and [LeftBlank false] *)
Shift (fun _ => false) (inl UNKNOWN);;
MoveToSymbol_L isReturnMarker id;;
Shift_L (fun _ => false) (inr (sigList_X (MarkedSymbol s)));;
MoveToSymbol isReturnMarker id;;
WriteMove (inr (sigList_X (LeftBlank false))) Rmove;;
Move Rmove;;
WriteMove (inr (sigList_X (RightBlank false))) Lmove
end.
Definition DoWrite_steps (d : option move) (tps1 tps2 : list (tape sig)) :=
match d with
| Some Lmove => 37 + 8 * length (encode_list _ tps1)
| Some Rmove => 37 + 8 * length (encode_list _ tps2)
| Some Nmove => 1
| None => 73 + 8 * length (encode_list _ tps1) + 8 * length (encode_list _ tps2)
end.
Definition DoWrite_T (d : option move) : tRel sigSim 1 :=
fun tin k => exists tps1 tps2 tp, tape_dir tp = d /\ atCons_current tin[@Fin0] tps1 tps2 tp /\ DoWrite_steps d tps1 tps2 <= k.
Definition DoMove_Rel (d : option move) (m : move) : pRel sigSim unit 1 :=
ignoreParam
(fun tin tout =>
forall tps1 tps2 tp,
tape_dir tp = d ->
atCons_current tin[@Fin0] tps1 tps2 tp ->
atCons_current tout[@Fin0] tps1 tps2 (tape_move tp m)).
Definition toggle_marked (s : sigTape sig) : sigTape sig :=
match s with
| UnmarkedSymbol s => MarkedSymbol s
| MarkedSymbol s => UnmarkedSymbol s
| LeftBlank b => LeftBlank (negb b)
| RightBlank b => RightBlank (negb b)
| NilBlank => NilBlank
end.
Definition ToggleMarked_Rel : pRel sigSim unit 1 :=
ignoreParam (fun tin tout => forall ls m rs,
tin[@Fin0] = midtape ls (inr (sigList_X m)) rs ->
tout[@Fin0] = midtape ls (inr (sigList_X (toggle_marked m))) rs).
Definition ToggleMarked : pTM sigSim unit 1 :=
Switch ReadChar
(fun (s : option sigSim) =>
match s with
| Some (inr (sigList_X m)) => Write (inr (sigList_X (toggle_marked m)))
| _ => Nop
end).
(* this should take constant time *)
Definition DoMove (d : option move) (m : move) : pTM sigSim unit 1 :=
match d with
| Some Lmove => match m with
| Nmove => Nop
| Lmove => Nop
| Rmove => ToggleMarked;; Move Rmove;; ToggleMarked
end
| Some Rmove => match m with
| Nmove => Nop
| Rmove => Nop
| Lmove => ToggleMarked;; Move Lmove;; ToggleMarked
end
| Some Nmove => match m with
| Nmove => Nop
| Rmove => ToggleMarked;; Move Rmove;; ToggleMarked
| Lmove => ToggleMarked;; Move Lmove;; ToggleMarked
end
| None => Nop
end.
Definition DoMove_steps := 9.
Arguments DoMove : simpl never.
(* First write, then move *)
Definition DoAction_Rel (d : option move) (a : option sig * move) : pRel sigSim unit 1 :=
ignoreParam
(fun tin tout =>
forall (tps1 tps2 : list (tape sig)) (tp : tape sig),
tape_dir tp = d ->
atCons_current tin[@Fin0] tps1 tps2 tp ->
atCons_current tout[@Fin0] tps1 tps2 (doAct tp a)).
Definition DoAction (d : option move) (a : option sig * move) : pTM sigSim unit 1 :=
match (fst a) with
| Some s => DoWrite d s;; DoMove (Some Nmove) (snd a) (* after wrting, we have a [midtape] *)
| None => DoMove d (snd a)
end.
Definition DoAction_steps (d : option move) (a : option sig * move) (tps1 tps2 : list (tape sig)) :=
match (fst a) with
| Some s => 1 + DoWrite_steps d tps1 tps2 + DoMove_steps
| None => DoMove_steps
end.
Definition DoAction_T (d : option move) (a : option sig * move) : tRel sigSim 1 :=
fun tin k => exists tps1 tps2 tp, tape_dir tp = d /\ atCons_current tin[@Fin0] tps1 tps2 tp /\ DoAction_steps d a tps1 tps2 <= k.

Lemma DoAction_Terminates (d : option move) (a : option sig * move) : projT1 (DoAction d a) ↓ DoAction_T d a.