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'
.
Definition half_tape_all0:nat->Σ :=
(fun _=>Σ0).
Definition ListES_step'(tr:Trans Σ)(x:ListES):ListES :=
let (l0,r0,m0,s0):=x in
let (s1,d,o) := tr in
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.
Fixpoint verify_loop1(h0 h1:ListES*Z)(ls0 ls1:list (ListES*Z))(n:nat)(dpos:Z):bool :=
let (es0,d0):=h0 in
let (es1,d1):=h1 in
St_eqb es0.(s) es1.(s) &&&
Σ_eqb es0.(m) es1.(m) &&&
(
match n with
| O =>
match dpos with
| Z0 => Z.eqb d1 d0
| Zpos _ =>
match es1.(r) with
| nil => Z.ltb d1 d0
| _ => false
end
| Zneg _ =>
match es1.(l) with
| nil => Z.ltb d0 d1
| _ => false
end
end
| _ => false
end |||
match ls0,ls1 with
| h0'::ls0',h1'::ls1' =>
verify_loop1 h0' h1' ls0' ls1' (Nat.pred n) dpos
| _,_ => false
end
).
Fixpoint find_loop1(h0 h1 h2:ListES*Z)(ls0 ls1 ls2:list (ListES*Z))(n:nat){struct ls1}:bool :=
(
(let (es0,d0):=h0 in
let (es1,d1):=h1 in
St_eqb es0.(s) es1.(s) &&&
let (es2,d2):=h2 in
St_eqb es0.(s) es2.(s) &&&
Σ_eqb es0.(m) es1.(m) &&&
Σ_eqb es0.(m) es2.(m) &&&
(verify_loop1 h0 h1 ls0 ls1 (S n) (d0-d1)))
)|||
match ls2,ls1 with
| h3::h2'::ls2',h1'::ls1' =>
find_loop1 h0 h1' h2' ls0 ls1' ls2' (S n)
| _,_ => false
end.
Definition find_loop1_0(h0 h1:ListES*Z)(ls:list (ListES*Z)):bool :=
match ls with
| h2::ls' => find_loop1 h0 h1 h2 (h1::ls) ls ls' O
| nil => false
end.
Definition sidpos_history_WF tm (h:ListES*Z)(ls:list (ListES*Z)):=
forall n, n<=(length ls) ->
match nth_error (h::ls) ((length ls)-n) with
| Some (es,d) => MoveDist tm n (InitES Σ Σ0) (ListES_toES es) d
| None => False
end.
Definition sidpos_history_period (h:ListES*Z)(ls:list (ListES*Z))(n1 T:nat):=
forall n, n<n1 ->
match nth_error (h::ls) n,nth_error (h::ls) (T+n) with
| Some (es1,d1),Some (es2,d2) => es1.(s) = es2.(s) /\ es1.(m) = es2.(m)
| _,_ => False
end.
Ltac Σ_eq_dec s1 s2 :=
eq_dec Σ_eqb_spec Σ_eqb s1 s2.
Fixpoint loop1_decider0(tm:TM Σ)(n:nat)(es:ListES)(d:Z)(ls:list (ListES*Z))(n0:nat)(ns:list nat):HaltDecideResult :=
match n with
| O => Result_Unknown
| S n0 =>
match tm es.(s) es.(m) with
| None => Result_Halt es.(s) es.(m)
| Some tr =>
let es' := ListES_step' tr es in
let d' := (d+Dir_to_Z tr.(dir _))%Z in
let ls' := ((es,d)::ls) in
match n0 with
| S n0' =>
loop1_decider0 tm n0 es' d' ls' n0' ns
| O =>
if find_loop1_0 (es',d') (es,d) ls then Result_NonHalt else
loop1_decider0 tm n0 es' d' ls' (hd O ns) (tl ns)
end
end
end.
Fixpoint halt_decider0(tm:TM Σ)(n:nat)(es:ListES):HaltDecideResult :=
match n with
| O => Result_Unknown
| S n0 =>
match tm es.(s) es.(m) with
| None => Result_Halt es.(s) es.(m)
| Some tr =>
halt_decider0 tm n0 (ListES_step' tr es)
end
end.
Definition halt_decider(n:nat)(tm:TM Σ):HaltDecideResult :=
halt_decider0 tm n {| l:=nil; r:=nil; m:=Σ0; s:=St0 |}.
Definition loop1_decider(n:nat)(ns:list nat)(tm:TM Σ):HaltDecideResult :=
loop1_decider0 tm n {| l:=nil; r:=nil; m:=Σ0; s:=St0 |} Z0 nil (hd O ns) (tl ns).

Lemma loop1_decider_WF BB n ns:
n<=S BB ->
HaltDecider_WF BB (loop1_decider n ns).