Section StateWhile.
Variable n : nat.
Variable sig : finType.
Variable F1 F2 : finType.
Variable pM : F1 -> pTM sig (F1 + F2) n.
Definition StateWhile_states : Type := { l : F1 & state (projT1 (pM l)) }.
Definition liftState {l : F1} (q : state (projT1 (pM l))) : StateWhile_states := ltac:(eexists; apply q). (* existT _ l q *)
Definition lift {l : F1} (c : mconfig sig (state (projT1 (pM l))) n) : mconfig sig (FinType(EqType StateWhile_states)) n :=
{|
cstate := liftState (cstate c);
ctapes := ctapes c;
|}.
Definition StateWhile_trans : StateWhile_states * Vector.t (option sig) n -> StateWhile_states * Vector.t (option sig * move) n :=
fun '(q, s) =>
if halt (projT2 q)
then match projT2 (pM (projT1 q)) (projT2 q) with
| inl l1 => (liftState (start (projT1 (pM l1))), nop_action)
| inr _ => (q, nop_action) (* terminating state, transition is irrelevant *)
end
else let (q', a) := trans (projT2 q, s) in (liftState q', a).
Definition StateWhile_halt : StateWhile_states -> bool :=
fun q => halt (projT2 q) &&
match projT2 (pM (projT1 q)) (projT2 q) with
| inl _ => false
| inr l2 => true
end.
Definition StateWhileTM (l1 : F1) : TM sig n :=
{|
start := liftState (start (projT1 (pM l1)));
trans := StateWhile_trans;
halt := StateWhile_halt;
|}.
Hypothesis (defF : inhabitedC F2).
Definition StateWhile_part : StateWhile_states -> F2 :=
fun q => match projT2 (pM (projT1 q)) (projT2 q) with
| inl _ => default
| inr l2 => l2
end.
Definition StateWhile (l1 : F1) : pTM sig F2 n :=
(StateWhileTM l1; StateWhile_part).
Local Arguments loopM {_ _} _ _ _.
Local Arguments halt {_ _} _ _.
Local Arguments step {_ _} _ _.

Lemma StateWhile_merge_repeat k1 k2 l l1 (c1 : mconfig sig (state (projT1 (pM l))) n) (c2 : mconfig sig (state (projT1 (pM l))) n) c3 :
loopM (projT1 (pM l)) c1 k1 = Some c2 ->
haltConf c2 = true ->
projT2 (pM l) (cstate c2) = inl l1 ->
loopM (StateWhileTM l) (lift (initc (projT1 (pM l1)) (ctapes c2))) k2 = Some c3 ->
loopM (StateWhileTM l) (lift c1) (k1 + (1 + k2)) = Some c3.