Module ListTape.
Record ListES := {
l: list Σ;
r: list Σ;
m: Σ;
s: St;
}.
Definition ListES_toES(x:ListES):ExecState Σ :=
let (l0,r0,m0,s0):=x in
(s0,
fun x =>
match x with
| Zpos x0 => nth (Pos.to_nat x0) (m0::r0) Σ0
| Zneg x0 => nth (Pos.to_nat x0) (m0::l0) Σ0
| Z0 => m0
end).
Definition ListES_step(tm:TM Σ)(x:ListES):option ListES :=
let (l0,r0,m0,s0):=x in
match tm s0 m0 with
| None => None
| Some tr =>
let (s1,d,o) := tr in
Some
match d with
| Dpos =>
match r0 with
| m1::r1 => {| l:=o::l0; r:=r1; m:=m1; s:=s1 |}
| nil => {| l:=o::l0; r:=nil; m:=Σ0; s:=s1 |}
end
| Dneg =>
match l0 with
| m1::l1 => {| l:=l1; r:=o::r0; m:=m1; s:=s1 |}
| nil => {| l:=nil; r:=o::r0; m:=Σ0; s:=s1 |}
end
end
end.
Definition app_halftape(h:list Σ)(t:nat->Σ):nat->Σ :=
fun n =>
match nth_error h n with
| None => t (n-(length h))
| Some c => c
end.
Definition make_tape(l0:nat->Σ)(m0:Σ)(r0:nat->Σ):Z->Σ :=
fun x =>
match x with
| Z0 => m0
| Zpos x0 => r0 (Nat.pred (Pos.to_nat x0))
| Zneg x0 => l0 (Nat.pred (Pos.to_nat x0))
end.
Definition make_tape'(l1:nat->Σ)(l0:list Σ)(m0:Σ)(r0:list Σ)(r1:nat->Σ):Z->Σ :=
make_tape (app_halftape l0 l1) m0 (app_halftape r0 r1).
Definition makeES(st:ListES)(l1 r1:nat->Σ):ExecState Σ :=
let (l0,r0,m0,s0):=st in
(s0, make_tape' l1 l0 m0 r0 r1).
Definition addmul(x:Z)(d:Dir)(n:nat):Z := x+(Dir_to_Z d)*(Z.of_nat n).
Definition half_tape(f:Z->Σ)(x:Z)(d:Dir):nat->Σ :=
fun n =>
f (addmul x d n).
Definition tape_rev(f:Z->Σ):Z->Σ := fun x => f (-x)%Z.
Definition half_tape_cdr(f:nat->Σ):nat->Σ :=
fun n => f (S n).
Definition AbstractSteps tm n0 (st0 st1:ListES) :=
length st0.(l) + length st0.(r) = length st1.(l) + length st1.(r) /\
forall l1 r1,
Steps Σ tm n0 (makeES st0 l1 r1) (makeES st1 l1 r1).
Fixpoint getASteps(h:St*Σ*(Trans Σ))(ls:list (St*Σ*(Trans Σ))):ListES*ListES :=
match h with
| (s'',i'',tr'') =>
match ls with
| nil =>
let x:=Build_ListES nil nil i'' s'' in
(x,x)
| h0::t0 =>
let (st0,st1):=getASteps h0 t0 in
let (l0,r0,m0,s0):=st0 in
let (l1,r1,m1,s1):=st1 in
match h0 with
| (s',i',tr') =>
let (s_,d,o):=tr' in
match d with
| Dpos =>
match r1 with
| nil =>
(Build_ListES l0 (r0++i''::nil) m0 s0,
Build_ListES (o::l1) nil i'' s'')
| m2::r2 =>
(st0, Build_ListES (o::l1) r2 m2 s'')
end
| Dneg =>
match l1 with
| nil =>
(Build_ListES (l0++i''::nil) r0 m0 s0,
Build_ListES nil (o::r1) i'' s'')
| m2::l2 =>
(st0, Build_ListES l2 (o::r1) m2 s'')
end
end
end
end
end.
(* gen unique Asteps from (St,Σ) history *)
Inductive MoveDist: (TM Σ)->(nat)->(ExecState Σ)->(ExecState Σ)->Z->Prop :=
| MoveDist_O tm st: MoveDist tm O st st Z0
| MoveDist_S tm n st0 s1 t1 st2 d d' tr:
MoveDist tm n st0 (s1,t1) d ->
step Σ tm (s1,t1) = Some st2 ->
tm s1 (t1 Z0) = Some tr ->
(d'-d = (Dir_to_Z (dir _ tr)))%Z ->
MoveDist tm (S n) st0 st2 d'
.

Lemma getASteps_spec {tm:TM Σ} {n st0 st1 h ls}:
Steps _ tm n st0 st1 ->
length ls = n ->
(forall n0, n0<=n -> exists s2 t2, Steps _ tm n0 st0 (s2,t2) /\
match nth_error (h::ls) (n-n0) with
| None => False
| Some (s0,i0,tr) => tm s0 i0 = Some tr /\ s0 = s2 /\ i0 = t2 Z0
end) ->
let (st0',st1'):=getASteps h ls in
AbstractSteps tm n st0' st1' /\
(MoveDist tm n st0 st1 ((Z.of_nat (length (st1'.(l))))-(Z.of_nat (length (st0'.(l)))))) /\
exists l1 r1,
st0 = makeES st0' l1 r1 /\
st1 = makeES st1' l1 r1.