Section ReadCurrentSymbols.
Local Arguments insertKnownSymbol : simpl never.
(* Local Arguments insertKnownSymbols : simpl never. *)
Definition ReadCurrent : pTM sigSim (option sig) 1 :=
Switch ReadChar
(fun (s : option sigSim) =>
match s with
| Some (inr (sigList_X (MarkedSymbol s))) => Return Nop (Some s)
| _ => Return Nop None
end).
Definition ReadCurrent_Rel : pRel sigSim (option sig) 1 :=
fun tin '(yout, tout) =>
forall tps1 tps2 tp,
atCons_current tin[@Fin0] tps1 tps2 tp ->
atCons_current tout[@Fin0] tps1 tps2 tp /\
yout = current tp.
Definition ReadCurrent_steps := 2.
Definition ReadCurrentSymbols_Step_Rel (st : Vector.t (option sig) n * Fin.t n) :
pRel sigSim (Vector.t (option sig) n * Fin.t n + Vector.t (option sig) n) 1 :=
fun tin '(yout, tout) =>
(forall tps1 tps2 tp ,
(length tps1 =? fin_to_nat (snd st)) = true ->
(length tps1 + (1 + length tps2) =? n) = true ->
atCons tin[@Fin0] tps1 tps2 tp ->
knowsFirstSymbols (fst st) tps1 ->
match tps2 with
| nil =>
atNil tout[@Fin0] (tps1 ++ [tp]) /\
yout = inr (insertKnownSymbol (fst st) (snd st) (current tp))
| tp' :: tps2' =>
atCons tout[@Fin0] (tps1 ++ [tp]) tps2' tp' /\
match finSucc_opt (snd st) with
| Some i' =>
yout = inl (insertKnownSymbol (fst st) (snd st) (current tp), i')
| None => False
end
end) /\
(forall tps,
atNil tin[@Fin0] tps ->
atNil tout[@Fin0] tps /\
yout = inr (fst st)).
Definition ReadCurrentSymbols_Step : forall (st : Vector.t (option sig) n * Fin.t n),
pTM sigSim (Vector.t (option sig) n * Fin.t n + Vector.t (option sig) n) 1 :=
fun '(readSymbols, i) =>
If IsCons
(GoToCurrent;;
Switch (ReadCurrent)
(fun (c : option sig) =>
Return (GoToNext)
(match finSucc_opt i with
| None =>
inr (insertKnownSymbol readSymbols i c)
| Some i' =>
inl (insertKnownSymbol readSymbols i c, i')
end)))
(Return Nop (inr readSymbols)).
Definition ReadCurrentSymbols_Step_steps_cons tp :=
3 + IsCons_steps + GoToCurrent_steps tp + ReadCurrent_steps + GoToNext_steps tp.
Definition ReadCurrentSymbols_Step_steps_nil := 1 + IsCons_steps.
Definition ReadCurrentSymbols_Step_T : tRel sigSim 1 :=
fun tin k =>
(exists tps1 tps2 tp, atCons tin[@Fin0] tps1 tps2 tp /\ ReadCurrentSymbols_Step_steps_cons tp <= k) \/
(exists tps, atNil tin[@Fin0] tps /\ ReadCurrentSymbols_Step_steps_nil <= k).
Definition ReadCurrentSymbols_Loop := StateWhile ReadCurrentSymbols_Step.
Definition ReadCurrentSymbols_Loop_Rel (st : Vector.t (option sig) n * Fin.t n) :
pRel sigSim (Vector.t (option sig) n) 1 :=
fun tin '(yout, tout) =>
(forall tps1 tp tps2,
(length tps1 =? fin_to_nat (snd st)) = true ->
(length tps1 + (1 + length tps2) =? n) = true ->
atCons tin[@Fin0] tps1 tps2 tp ->
knowsFirstSymbols (fst st) tps1 ->
atNil tout[@Fin0] (tps1 ++ tp :: tps2) /\
yout = insertKnownSymbols (fst st) (snd st) (current tp :: map (@current _) tps2)) /\
(forall tps,
(length tps =? n) = true ->
atNil tin[@Fin0] tps ->
knowsFirstSymbols (fst st) tps ->
atNil tout[@Fin0] tps /\
yout = (fst st)).
Definition ReadCurrentSymbols_Loop_steps_nil := ReadCurrentSymbols_Step_steps_nil.
Fixpoint ReadCurrentSymbols_Loop_steps_cons tps2 tp :=
match tps2 with
| nil => ReadCurrentSymbols_Step_steps_cons tp
| tp' :: tps2' => 1 + ReadCurrentSymbols_Step_steps_cons tp + ReadCurrentSymbols_Loop_steps_cons tps2' tp'
end.
Definition ReadCurrentSymbols_Loop_T (st : Vector.t (option sig) n * Fin.t n) : tRel sigSim 1 :=
fun tin k =>
(exists tps1 tps2 tp,
(length tps1 =? fin_to_nat (snd st)) = true /\
(length tps1 + (1 + length tps2) =? n) = true /\
knowsFirstSymbols (fst st) tps1 /\
atCons tin[@Fin0] tps1 tps2 tp /\ ReadCurrentSymbols_Loop_steps_cons tps2 tp <= k) \/
(exists tps, atNil tin[@Fin0] tps /\ ReadCurrentSymbols_Loop_steps_nil <= k).
Definition ReadCurrentSymbols :=
match (finMin_opt n) with
| None => Return (Move Rmove) (Vector.const None n) (* Nothing to do, just move from the start to the nil symbol *)
| Some min =>
Move Rmove;; ReadCurrentSymbols_Loop (Vector.const None n, min)
end.
Definition ReadCurrentSymbols_Rel : pRel sigSim (Vector.t (option sig) n) 1 :=
fun tin '(yout, tout) =>
forall T,
tin[@Fin0] ≃ T ->
atNil tout[@Fin0] (vector_to_list T) /\
yout = current_chars T.

Lemma ReadCurrentSymbols_Realise : ReadCurrentSymbols ⊨ ReadCurrentSymbols_Rel.